Category : C Source Code
Archive : CEPHES22.ZIP
Filename : QCALC.C
Output of file : QCALC.C contained in archive : CEPHES22.ZIP
/* Keyboard command interpreter */
/* Copyright 1985 by S. L. Moshier */
#include
#include "qhead.h"
/*
*#include "config.h"
*/
/* length of command line: */
#define LINLEN 128
#define XON 0x11
#define XOFF 0x13
#define SALONE 1
#define DECPDP 0
#define INTLOGIN 0
#define INTHELP 1
#ifndef TRUE
#define TRUE 1
#endif
/* initialize printf: */
#define INIPRINTF 0
#if DECPDP
#define TRUE 1
#endif
static char idterp[] = {
"\n\nSteve Moshier's command interpreter V1.3\n"};
#define ISLOWER(c) ((c >= 'a') && (c <= 'z'))
#define ISUPPER(c) ((c >= 'A') && (c <= 'Z'))
#define ISALPHA(c) (ISLOWER(c) || ISUPPER(c))
#define ISDIGIT(c) ((c >= '0') && (c <= '9'))
#define ISATF(c) (((c >= 'a')&&(c <= 'f')) || ((c >= 'A')&&(c <= 'F')))
#define ISXDIGIT(c) (ISDIGIT(c) || ISATF(c))
#define ISOCTAL(c) ((c >= '0') && (c < '8'))
#define ISALNUM(c) (ISALPHA(c) || (ISDIGIT(c))
FILE *fopen();
/* I/O log file: */
static char *savnam = 0;
static FILE *savfil = 0;
#include "qcalc.h"
/* space for double precision numbers */
static int vsp = 13;
static short vs[22][NQ] = {0};
/* the symbol table of temporary variables: */
#define NTEMP 4
struct varent temp[NTEMP] = {
"T", OPR | TEMP, &vs[14][0],
"T", OPR | TEMP, &vs[15][0],
"T", OPR | TEMP, &vs[16][0],
"\0", OPR | TEMP, &vs[17][0]
};
/* the symbol table of operators */
/* EOL is interpreted on null, newline, or ; */
struct symbol oprtbl[] = {
"BOL", OPR | BOL, 0,
"EOL", OPR | EOL, 0,
"-", OPR | UMINUS, 8,
/*"~", OPR | COMP, 8,*/
",", OPR | EOE, 1,
"=", OPR | EQU, 2,
/*"|", OPR | LOR, 3,*/
/*"^", OPR | LXOR, 4,*/
/*"&", OPR | LAND, 5,*/
"+", OPR | PLUS, 6,
"-", OPR | MINUS, 6,
"*", OPR | MULT, 7,
"/", OPR | DIV, 7,
/*"%", OPR | MOD, 7,*/
"(", OPR | LPAREN, 11,
")", OPR | RPAREN, 11,
"\0", ILLEG, 0
};
#define NOPR 8
/* the symbol table of indirect variables: */
extern short qpi[];
struct varent indtbl[] = {
"t", VAR | IND, &vs[21][0],
"u", VAR | IND, &vs[20][0],
"v", VAR | IND, &vs[19][0],
"w", VAR | IND, &vs[18][0],
"x", VAR | IND, &vs[10][0],
"y", VAR | IND, &vs[11][0],
"z", VAR | IND, &vs[12][0],
"pi", VAR | IND, &qpi[0],
"\0", ILLEG, 0
};
/* the symbol table of constants: */
#define NCONST 10
struct varent contbl[NCONST] = {
"C",CONST,&vs[0][0],
"C",CONST,&vs[1][0],
"C",CONST,&vs[2][0],
"C",CONST,&vs[3][0],
"C",CONST,&vs[4][0],
"C",CONST,&vs[5][0],
"C",CONST,&vs[6][0],
"C",CONST,&vs[7][0],
"C",CONST,&vs[8][0],
"\0",CONST,&vs[9][0]
};
/* the symbol table of string variables: */
static char strngs[4][40] = {0};
#define NSTRNG 5
struct strent strtbl[NSTRNG] = {
#if DECPDP
&strngs[0][0], VAR | STRING, &strngs[0][0],
&strngs[1][0], VAR | STRING, &strngs[1][0],
&strngs[2][0], VAR | STRING, &strngs[2][0],
&strngs[3][0], VAR | STRING, &strngs[3][0],
#else
&strngs[0][0], VAR | STRING, &strngs[0][0],
&strngs[1][0], VAR | STRING, &strngs[1][0],
&strngs[2][0], VAR | STRING, &strngs[2][0],
&strngs[3][0], VAR | STRING, &strngs[3][0],
#endif
"\0",ILLEG,0,
};
/* Help messages */
#if INTHELP
static char *intmsg[] = {
"?",
"Unkown symbol",
"Expression ends in illegal operator",
"Precede ( by operator",
")( is illegal",
"Unmatched )",
"Missing )",
"Illegal left hand side",
"Missing symbol",
"Must assign to a variable",
"Divide by zero",
"Missing symbol",
"Missing operator",
"Precede quantity by operator",
"Quantity preceded by )",
"Function syntax",
"Too many function args",
"No more temps",
"Arg list"
};
#endif
/* the symbol table of functions: */
#if SALONE
int hex(), cmdh(), cmdhlp();
/*int view();*/
int cmddm(), cmdtm(), cmdem();
/*int printf();*/
int take(), mxit(), exit(), bits();
int cmddig(), qfloor(), todbl();
int qsqrt(), qlog(), qexp(), qtanh(), qpow();
int qsave(), qsys();
/*
int qsin(), qcos(), qatn(), qjn(), qyn();
int qasin(), qtan(), qcosh(), qsinh(), qasinh(), qacosh();
int qacos(), qatanh(), qcot(), qgamma(), qcbrt(), qfac();
*/
/* log10(), exp10(), ndtr(), ndtri();*/
struct funent funtbl[] = {
"h", OPR | FUNC, cmdh,
"help", OPR | FUNC, cmdhlp,
"hex", OPR | FUNC, hex,
/*"view", OPR | FUNC, view,*/
/*
"acos", OPR | FUNC, qacos,
"acosh", OPR | FUNC, qacosh,
"asin", OPR | FUNC, qasin,
"asinh", OPR | FUNC, qasinh,
"atan", OPR | FUNC, qatn,
"atanh", OPR | FUNC, qatanh,
"cbrt", OPR | FUNC, qcbrt,
"cos", OPR | FUNC, qcos,
"cosh", OPR | FUNC, qcosh,
"cot", OPR | FUNC, qcot,
*/
"exp", OPR | FUNC, qexp,
/*"fac", OPR | FUNC, qfac,*/
"floor", OPR | FUNC, qfloor,
/*
"gamma", OPR | FUNC, qgamma,
"jv", OPR | FUNC, qjn,
"yn", OPR | FUNC, qyn,
"logten", OPR | FUNC, qlog10,
"expten", OPR | FUNC, qexp10,
*/
"log", OPR | FUNC, qlog,
/*
"ndtr", OPR | FUNC, ndtr,
"ndtri", OPR | FUNC, ndtri,
*/
"pow", OPR | FUNC, qpow,
/*
"sin", OPR | FUNC, qsin,
"sinh", OPR | FUNC, qsinh,
*/
"sqrt", OPR | FUNC, qsqrt,
/*"tan", OPR | FUNC, qtan,*/
"tanh", OPR | FUNC, qtanh,
"bits", OPR | FUNC, bits,
"digits", OPR | FUNC, cmddig,
"dm", OPR | FUNC, cmddm,
"tm", OPR | FUNC, cmdtm,
"em", OPR | FUNC, cmdem,
"take", OPR | FUNC | COMMAN, take,
"save", OPR | FUNC | COMMAN, qsave,
"system", OPR | FUNC | COMMAN, qsys,
"exit", OPR | FUNC, mxit,
"\0", OPR | FUNC, 0
};
/* the symbol table of key words */
struct funent keytbl[] = {
"\0", ILLEG, 0
};
#endif
/* Number of decimals to display */
#define DEFDIS 70
static int ndigits = DEFDIS;
/* Menu stack */
struct funent *menstk[5] = {&funtbl[0], NULL, NULL, NULL, NULL};
int menptr = 0;
/* Take file stack */
FILE *takstk[10] = {0};
int takptr = -1;
/* size of the expression scan list: */
#define NSCAN 20
/* previous token, saved for syntax checking: */
struct symbol *lastok = 0;
/* variables used by parser: */
static char str[128] = {0};
int uposs = 0; /* possible unary operator */
double nc = 0; /* numeric value of symbol */
static short qnc[NQ] = {0};
char lc[40] = { '\n' }; /* ASCII string of token symbol */
static char line[LINLEN] = { '\n','\0' }; /* input command line */
static char maclin[LINLEN] = { '\n','\0' }; /* macro command */
char *interl = line; /* pointer into line */
extern char *interl;
static int maccnt = 0; /* number of times to execute macro command */
static int comptr = 0; /* comma stack pointer */
static int comstk[5][NQ] = {0}; /* comma argument stack */
static int narptr = 0; /* pointer to number of args */
static int narstk[5] = {0}; /* stack of number of function args */
/* main() */
/* Entire program starts here */
main()
{
/* the scan table: */
/* array of pointers to symbols which have been parsed: */
struct symbol *ascsym[NSCAN];
/* current place in ascsym: */
register struct symbol **as;
/* array of attributes of operators parsed: */
int ascopr[NSCAN];
/* current place in ascopr: */
register int *ao;
#if LARGEMEM
/* array of precedence levels of operators: */
long asclev[NSCAN];
/* current place in asclev: */
long *al;
long symval; /* value of symbol just parsed */
#else
int asclev[NSCAN];
int *al;
int symval;
#endif
short acc[NQ]; /* the accumulator, for arithmetic */
int accflg; /* flags accumulator in use */
int val[NQ]; /* value to be combined into accumulator */
register struct symbol *psym; /* pointer to symbol just parsed */
struct varent *pvar; /* pointer to an indirect variable symbol */
struct funent *pfun; /* pointer to a function symbol */
struct strent *pstr; /* pointer to a string symbol */
int att; /* attributes of symbol just parsed */
int i; /* counter */
int offset; /* parenthesis level */
int lhsflg; /* kluge to detect illegal assignments */
struct symbol *tsym; /* pointer to temporary symbol */
struct symbol *parser(); /* parser returns pointer to symbol */
int errcod; /* for syntax error printout */
/* Perform general initialization */
init();
menstk[0] = &funtbl[0];
menptr = 0;
cmdhlp(); /* print out list of symbols */
/* Return here to get next command line to execute */
getcmd:
/* initialize registers and mutable symbols */
accflg = 0; /* Accumulator not in use */
qclear(acc); /* Clear the accumulator */
offset = 0; /* Parenthesis level zero */
comptr = 0; /* Start of comma stack */
narptr = -1; /* Start of function arg counter stack */
psym = (struct symbol *)&contbl[0];
for( i=0; i
psym->attrib = CONST; /* clearing the busy bit */
++psym;
}
psym = (struct symbol *)&temp[0];
for( i=0; i
psym->attrib = VAR | TEMP; /* clearing the busy bit */
++psym;
}
psym = (struct symbol *)&strtbl[0];
for( i=0; i
psym->attrib = STRING | VAR;
++psym;
}
/* List of scanned symbols is empty: */
as = &ascsym[0];
*as = 0;
--as;
/* First item in scan list is Beginning of Line operator */
ao = &ascopr[0];
*ao = oprtbl[0].attrib & 0xf; /* BOL */
/* value of first item: */
al = &asclev[0];
*al = oprtbl[0].sym;
lhsflg = 0; /* illegal left hand side flag */
psym = &oprtbl[0]; /* pointer to current token */
/* get next token from input string */
gettok:
lastok = psym; /* last token = current token */
psym = parser(); /* get a new current token */
/*printf( "%s attrib %7o value %7o\n", psym->spel, psym->attrib & 0xffff,
psym->sym );*/
/* Examine attributes of the symbol returned by the parser */
att = psym->attrib;
if( att == ILLEG )
{
errcod = 1;
goto synerr;
}
/* Push functions onto scan list without analyzing further */
if( att & FUNC )
{
/* A command is a function whose argument is
* a pointer to the rest of the input line.
* A second argument is also passed: the address
* of the last token parsed.
*/
if( att & COMMAN )
{
pfun = (struct funent *)psym;
( *(pfun->fun))( interl, lastok );
abmac(); /* scrub the input line */
goto getcmd; /* and ask for more input */
}
++narptr; /* offset to number of args */
narstk[narptr] = 0;
i = lastok->attrib & 0xffff; /* attrib=short, i=int */
if( ((i & OPR) == 0)
|| (i == (OPR | RPAREN))
|| (i == (OPR | FUNC)) )
{
errcod = 15;
goto synerr;
}
++lhsflg;
++as;
*as = psym;
++ao;
*ao = FUNC;
++al;
*al = offset + UMINUS;
goto gettok;
}
/* deal with operators */
if( att & OPR )
{
att &= 0xf;
/* expression cannot end with an operator other than
* (, ), BOL, or a function
*/
if( (att == RPAREN) || (att == EOL) || (att == EOE))
{
i = lastok->attrib & 0xffff; /* attrib=short, i=int */
if( (i & OPR)
&& (i != (OPR | RPAREN))
&& (i != (OPR | LPAREN))
&& (i != (OPR | FUNC))
&& (i != (OPR | BOL)) )
{
errcod = 2;
goto synerr;
}
}
++lhsflg; /* any operator but ( and = is not a legal lhs */
/* operator processing, continued */
switch( att )
{
case EOE:
lhsflg = 0;
break;
case LPAREN:
/* ( must be preceded by an operator of some sort. */
if( ((lastok->attrib & OPR) == 0) )
{
errcod = 3;
goto synerr;
}
/* also, a preceding ) is illegal */
if( (unsigned short )lastok->attrib == (OPR|RPAREN))
{
errcod = 4;
goto synerr;
}
/* Begin looking for illegal left hand sides: */
lhsflg = 0;
offset += RPAREN; /* new parenthesis level */
goto gettok;
case RPAREN:
offset -= RPAREN; /* parenthesis level */
if( offset < 0 )
{
errcod = 5; /* parenthesis error */
goto synerr;
}
goto gettok;
case EOL:
if( offset != 0 )
{
errcod = 6; /* parenthesis error */
goto synerr;
}
break;
case EQU:
if( --lhsflg ) /* was incremented before switch{} */
{
errcod = 7;
goto synerr;
}
case UMINUS:
case COMP:
goto pshopr; /* evaluate right to left */
default: ;
}
/* evaluate expression whenever precedence is not increasing */
symval = psym->sym + offset;
while( symval <= *al )
{
/* if just starting, must fill accumulator with last
* thing on the line
*/
if( (accflg == 0) && (as >= ascsym) && (((*as)->attrib & FUNC) == 0 ))
{
pvar = (struct varent *)*as;
qmov( pvar->value, acc );
--as;
accflg = 1;
}
/* handle beginning of line type cases, where the symbol
* list ascsym[] may be empty.
*/
switch( *ao )
{
case BOL:
qtoasc( acc, str, ndigits );
printf( "%s\n", str ); /* This is the answer */
if( savfil )
fprintf( savfil, "%s\n", str );
goto getcmd; /* all finished */
case UMINUS:
qneg( acc );
goto nochg;
/*
case COMP:
acc = ~acc;
goto nochg;
*/
default: ;
}
/* Now it is illegal for symbol list to be empty,
* because we are going to need a symbol below.
*/
if( as < &ascsym[0] )
{
errcod = 8;
goto synerr;
}
/* get attributes and value of current symbol */
att = (*as)->attrib;
pvar = (struct varent *)*as;
if( att & FUNC )
qclear( val );
else
qmov( pvar->value, val );
/* Expression evaluation, continued. */
switch( *ao )
{
case FUNC:
pfun = (struct funent *)*as;
/* Call the function with appropriate number of args */
i = narstk[ narptr ];
--narptr;
switch(i)
{
case 0:
( *(pfun->fun) )(acc, acc);
break;
case 1:
( *(pfun->fun) )(acc,comstk[comptr-1],acc);
break;
case 2:
( *(pfun->fun) )(acc, comstk[comptr-2],
comstk[comptr-1],acc);
break;
case 3:
( *(pfun->fun) )(acc, comstk[comptr-3],
comstk[comptr-2], comstk[comptr-1],acc);
break;
default:
errcod = 16;
goto synerr;
}
comptr -= i;
accflg = 1; /* in case at end of line */
break;
case EQU:
if( ( att & TEMP) || ((att & VAR) == 0) || (att & STRING) )
{
errcod = 9;
goto synerr; /* can only assign to a variable */
}
pvar = (struct varent *)*as;
qmov( acc, pvar->value );
break;
case PLUS:
qadd( acc, val, acc ); break;
case MINUS:
qsub( acc, val, acc ); break;
case MULT:
qmul( acc, val, acc ); break;
case DIV:
if( acc[1] == 0 )
{
divzer:
errcod = 10;
goto synerr;
}
qdiv( acc, val, acc ); break;
/*
case MOD:
if( acc == 0 )
goto divzer;
acc = val % acc; break;
case LOR:
acc |= val; break;
case LXOR:
acc ^= val; break;
case LAND:
acc &= val; break;
*/
case EOE:
if( narptr < 0 )
{
errcod = 18;
goto synerr;
}
narstk[narptr] += 1;
qmov( acc, comstk[comptr++] );
/* printf( "\ncomptr: %d narptr: %d %d\n", comptr, narptr, acc );*/
qmov( val, acc );
break;
}
/* expression evaluation, continued */
/* Pop evaluated tokens from scan list: */
/* make temporary variable not busy */
if( att & TEMP )
(*as)->attrib &= ~BUSY;
if( as < &ascsym[0] ) /* can this happen? */
{
errcod = 11;
goto synerr;
}
--as;
nochg:
--ao;
--al;
if( ao < &ascopr[0] ) /* can this happen? */
{
errcod = 12;
goto synerr;
}
noval:
/* If precedence level will now increase, then */
/* save accumulator in a temporary location */
if( symval > *al )
{
/* find a free temp location */
pvar = &temp[0];
for( i=0; i
if( (pvar->attrib & BUSY) == 0)
goto temfnd;
++pvar;
}
errcod = 17;
printf( "no more temps\n" );
pvar = &temp[0];
goto synerr;
temfnd:
pvar->attrib |= BUSY;
qmov( acc, pvar->value );
/*printf( "temp %d\n", acc );*/
accflg = 0;
++as; /* push the temp onto the scan list */
*as = (struct symbol *)pvar;
}
} /* End of evaluation loop */
/* Push operator onto scan list when precedence increases */
pshopr:
++ao;
*ao = psym->attrib & 0xf;
++al;
*al = psym->sym + offset;
goto gettok;
} /* end of OPR processing */
/* Token was not an operator. Push symbol onto scan list. */
if( (lastok->attrib & OPR) == 0 )
{
errcod = 13;
goto synerr; /* quantities must be preceded by an operator */
}
if( (unsigned short )lastok->attrib == (OPR | RPAREN) ) /* ...but not by ) */
{
errcod = 14;
goto synerr;
}
++as;
*as = psym;
goto gettok;
synerr:
#if INTHELP
printf( "%s ", intmsg[errcod] );
#endif
printf( " error %d\n", errcod );
if( savfil )
fprintf( savfil, " error %d\n", errcod );
abmac(); /* flush the command line */
goto getcmd;
} /* end of program */
/* parser() */
/* Get token from input string and identify it. */
static char number[40] = {0};
struct symbol *parser( )
{
register struct symbol *psym;
register char *pline;
struct varent *pvar;
struct strent *pstr;
char *cp, *plc, *pn;
int i;
/* reference for old Whitesmiths compiler: */
/*
*extern FILE *stdout;
*/
pline = interl; /* get current location in command string */
/* If at beginning of string, must ask for more input */
if( pline == line )
{
if( maccnt > 0 )
{
--maccnt;
cp = maclin;
plc = pline;
while( (*plc++ = *cp++) != 0 )
;
goto mstart;
}
if( takptr < 0 )
{ /* no take file active: prompt keyboard input */
printf("* ");
if( savfil )
fprintf( savfil, "* " );
}
/* Various ways of typing in a command line. */
/*
* Old Whitesmiths call to print "*" immediately
* use RT11 .GTLIN to get command string
* from command file or terminal
*/
/*
* fflush(stdout);
* gtlin(line);
*/
zgets( line, TRUE ); /* keyboard input for other systems: */
mstart:
uposs = 1; /* unary operators possible at start of line */
}
ignore:
/* Skip over spaces */
while( *pline == ' ' )
++pline;
/* unary minus after operator */
if( uposs && (*pline == '-') )
{
psym = &oprtbl[2]; /* UMINUS */
++pline;
goto pdon3;
}
/* COMP */
/*
if( uposs && (*pline == '~') )
{
psym = &oprtbl[3];
++pline;
goto pdon3;
}
*/
if( uposs && (*pline == '+') ) /* ignore leading plus sign */
{
++pline;
goto ignore;
}
/* end of null terminated input */
if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
{
pline = line;
goto endlin;
}
if( *pline == ';' )
{
++pline;
endlin:
psym = &oprtbl[1]; /* EOL */
goto pdon2;
}
/* parser() */
/* Test for numeric input */
if( (ISDIGIT(*pline)) || (*pline == '.') )
{
nc = 0.0; /* initialize numeric input to zero */
qclear( qnc );
/*******/
if( *pline == '0' )
{ /* leading "0" may mean octal or hex radix */
++pline;
if( *pline == '.' )
goto decimal; /* 0.ddd */
/* leading "0x" means hexadecimal radix */
if( (*pline == 'x') || (*pline == 'X') )
{
++pline;
while( ISXDIGIT(*pline) )
{
i = *pline++ & 0xff;
if( i >= 'a' )
i -= 047;
if( i >= 'A' )
i -= 07;
i -= 060;
nc = (nc * 16.0) + i;
etoq( &nc, qnc );
}
goto numdon;
}
else
{
while( ISOCTAL( *pline ) )
{
i = *pline++ & 0xff - 060;
nc = ( nc * 8.0) + i;
etoq( &nc, qnc );
}
goto numdon;
}
}
else
{
/* no leading "0" means decimal radix */
/******/
decimal:
pn = number;
while( (ISDIGIT(*pline)) || (*pline == '.') )
*pn++ = *pline++;
/* get possible exponent field */
if( (*pline == 'e') || (*pline == 'E') )
*pn++ = *pline++;
else
goto numcvt;
if( (*pline == '-') || (*pline == '+') )
*pn++ = *pline++;
while( ISDIGIT(*pline) )
*pn++ = *pline++;
numcvt:
*pn++ = ' ';
*pn++ = 0;
asctoq( number, qnc );
/* sscanf( number, "%le", &nc );*/
}
/* output the number */
numdon:
/* search the symbol table of constants */
pvar = &contbl[0];
for( i=0; i
if( (pvar->attrib & BUSY) == 0 )
goto confnd;
if( qcmp( pvar->value, qnc) == 0 )
{
psym = (struct symbol *)pvar;
goto pdon2;
}
++pvar;
}
printf( "no room for constant\n" );
psym = (struct symbol *)&contbl[0];
goto pdon2;
confnd:
pvar->spel= contbl[0].spel;
pvar->attrib = CONST | BUSY;
qmov( qnc, pvar->value );
psym = (struct symbol *)pvar;
goto pdon2;
}
/* check for operators */
psym = &oprtbl[3];
for( i=0; i
if( *pline == *(psym->spel) )
goto pdon1;
++psym;
}
/* if quoted, it is a string variable */
if( *pline == '"' )
{
/* find an empty slot for the string */
pstr = strtbl; /* string table */
for( i=0; i
if( (pstr->attrib & BUSY) == 0 )
goto fndstr;
++pstr;
}
printf( "No room for string\n" );
pstr->attrib |= ILLEG;
psym = (struct symbol *)pstr;
goto pdon0;
fndstr:
plc = (char *)(pstr->string);
++pline;
for( i=0; i<39; i++ )
{
*plc++ = *pline;
if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
{
illstr:
pstr = &strtbl[NSTRNG-1];
pstr->attrib |= ILLEG;
printf( "Missing string terminator\n" );
psym = (struct symbol *)pstr;
goto pdon0;
}
if( *pline++ == '"' )
goto finstr;
}
goto illstr; /* no terminator found */
finstr:
*(--plc) = '\0';
pstr->attrib |= BUSY;
psym = (struct symbol *)pstr;
goto pdon2;
}
/* If none of the above, search function and symbol tables: */
/* copy character string to array lc[] */
plc = &lc[0];
while( ISALPHA(*pline) )
{
/* convert to lower case characters */
if( ISUPPER( *pline ) )
*pline += 040;
*plc++ = *pline++;
}
*plc = 0; /* Null terminate the output string */
/* parser() */
psym = (struct symbol *)menstk[menptr]; /* function table */
plc = &lc[0];
cp = psym->spel;
do
{
if( strcmp( plc, cp ) == 0 )
goto pdon3; /* following unary minus is possible */
++psym;
cp = psym->spel;
}
while( *cp != '\0' );
psym = (struct symbol *)&indtbl[0]; /* indirect symbol table */
plc = &lc[0];
cp = psym->spel;
do
{
if( strcmp( plc, cp ) == 0 )
goto pdon2;
++psym;
cp = psym->spel;
}
while( *cp != '\0' );
pdon0:
pline = line; /* scrub line if illegal symbol */
goto pdon2;
pdon1:
++pline;
if( (psym->attrib & 0xf) == RPAREN )
pdon2: uposs = 0;
else
pdon3: uposs = 1;
interl = pline;
return( psym );
} /* end of parser */
/* exit from current menu */
cmdex()
{
if( menptr == 0 )
{
printf( "Main menu is active.\n" );
}
else
--menptr;
cmdh();
return(0);
}
/* gets() */
zgets( gline, echo )
char *gline;
int echo;
{
register char *pline;
register int i;
scrub:
pline = gline;
getsl:
if( (pline - gline) >= LINLEN )
{
printf( "\nLine too long\n *" );
goto scrub;
}
if( takptr < 0 )
{ /* get character from keyboard */
#if DECPDP
gtlin( gline );
return(0);
#else
*pline = getchar();
#endif
}
else
{ /* get a character from take file */
i = fgetc( takstk[takptr] );
if( i == -1 )
{ /* end of take file */
if( takptr >= 0 )
{ /* close file and bump take stack */
fclose( takstk[takptr] );
takptr -= 1;
}
if( takptr < 0 ) /* no more take files: */
printf( "*" ); /* prompt keyboard input */
goto scrub; /* start a new input line */
}
*pline = i;
}
*pline &= 0x7f;
/* xon or xoff characters need filtering out. */
if ( *pline == XON || *pline == XOFF )
goto getsl;
/* control U or control C */
if( (*pline == 025) || (*pline == 03) )
{
printf( "\n" );
goto scrub;
}
/* Backspace or rubout */
if( (*pline == 010) || (*pline == 0177) )
{
pline -= 1;
if( pline >= gline )
{
if ( echo )
printf( "\010\040\010" );
goto getsl;
}
else
goto scrub;
}
if ( echo )
printf( "%c", *pline );
if( (*pline != '\n') && (*pline != '\r') )
{
++pline;
goto getsl;
}
*pline = 0;
if ( echo )
printf( "%c", '\n' ); /* \r already echoed */
if( savfil )
fprintf( savfil, "%s\n", gline );
}
/* help function */
cmdhlp()
{
printf( "%s", idterp );
printf( "\nFunctions:\n" );
prhlst( &funtbl[0] );
printf( "\nVariables:\n" );
prhlst( &indtbl[0] );
printf( "\nOperators:\n" );
prhlst( &oprtbl[2] );
printf("\n");
return(0.0);
}
cmdh()
{
prhlst( menstk[menptr] );
printf( "\n" );
return(0.0);
}
/* print keyword spellings */
prhlst(ps)
register struct symbol *ps;
{
register int j, k;
int m;
j = 0;
while( *(ps->spel) != '\0' )
{
k = strlen( ps->spel ) - 1;
/* size of a tab field is 2**3 chars */
m = ((k >> 3) + 1) << 3;
j += m;
if( j > 72 )
{
printf( "\n" );
j = m;
}
printf( "%s\t", ps->spel );
++ps;
}
}
#if SALONE
init(){}
#endif
/* macro commands */
/* define macro */
cmddm(arg)
int arg;
{
zgets( maclin, TRUE );
return(0.0);
}
/* type (i.e., display) macro */
cmdtm(arg)
int arg;
{
printf( "%s\n", maclin );
return(0.0);
}
/* execute macro # times */
cmdem( arg )
int *arg;
{
double dn;
int n;
qtoe( arg, &dn );
n = dn;
if( n <= 0 )
n = 1;
maccnt = n;
return( n );
}
/* open a take file */
take( fname )
char *fname;
{
FILE *f;
register int i;
while( *fname == ' ' )
fname += 1;
f = fopen( fname, "r" );
if( f == 0 )
{
takerr:
printf( "Can't open take file %s\n", fname );
takptr = -1; /* terminate all take file input */
return(-1);
}
takptr += 1;
takstk[ takptr ] = f;
printf( "Running %s\n", fname );
return(0.0);
}
/* abort macro execution */
abmac()
{
maccnt = 0;
interl = line;
}
/* display integer part in hex, octal, and decimal
*/
hex(qx)
short *qx;
{
long z;
double x;
double fabs();
qtoe( qx, &x );
if( fabs(x) >= 2.147483648e9 )
{
printf( "hex: too large\n" );
return(x);
}
z = x;
printf( "0%lo 0x%lx %ld.\n", z, z, z );
return(x);
}
int bits( x )
short x[];
{
int i, j;
j = 0;
for( i=0; i
printf( "0x%04x,", x[i] & 0xffff );
if( ++j > 7 )
{
j = 0;
printf( "\n" );
}
}
printf( "\n" );
/* display IEEE format double precision version */
todbl( x );
return(0);
}
/* Exit to monitor. */
mxit()
{
if( savfil )
fclose( savfil );
exit(0);
}
cmddig( x )
short x[];
{
double dx;
qtoe( x, &dx );
ndigits = dx;
if( ndigits <= 0 )
ndigits = DEFDIS;
return(0);
}
todbl( u )
short u[];
{
short x[NQ+1];
long e;
int i;
qmovz( u, x );
shup1(x);
shup1(x);
shup1(x);
shup1(x);
shup1(x);
e = x[1];
e = e - 040001 + 0x3ff;
if( e < -101 )
{
qclear(x );
goto display;
}
/* denormalize if exponent is nonpositive */
if( e <= 0 )
{
while( e <= 0 )
{
shdn1(x);
e += 1;
}
e = 0;
}
e = (e << 4) & 0x7ff0;
if( x[0] )
e |= 0x8000;
x[2] &= 0xf;
x[2] |= e;
display:
for( i=0; i<6; i++ )
printf( "%04x ", x[7-i] & 0xffff );
printf( "\n" );
qtoe( u, x );
for( i=0; i<4; i++ )
printf( "%04x ", x[i] & 0xffff );
printf( "\n" );
}
qsave(x)
char *x;
{
if( savfil )
fclose( savfil );
while( *x == ' ' )
x += 1;
if( *x == '\0' )
savnam = "calc.sav";
else
savnam = x;
savfil = fopen( savnam, "w" );
if( savfil <= 0 )
printf( "Error opening %s\n", savnam );
}
qsys(x)
char *x;
{
system( x+1 );
cmdh();
}
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/