/* calc.c */ /* 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; iattrib = CONST; /* clearing the busy bit */ ++psym; } psym = (struct symbol *)&temp[0]; for( i=0; iattrib = VAR | TEMP; /* clearing the busy bit */ ++psym; } psym = (struct symbol *)&strtbl[0]; for( i=0; iattrib = 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; iattrib & 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; iattrib & 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; ispel) ) 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; iattrib & 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 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(); }