/* calc.c */ /* Keyboard command interpreter */ /* by Stephen L. Moshier */ /* Include functions for IEEE special values */ #define NANS 1 /* 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 squirrel printf: */ #define INIPRINTF 0 #if DECPDP #define TRUE 1 #endif #include <stdio.h> #include <string.h> 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(); #include "lcalc.h" #include "ehead.h" /* space for working precision numbers */ static long double vs[22]; /* the symbol table of temporary variables: */ #define NTEMP 4 struct varent temp[NTEMP] = { {"T", OPR | TEMP, &vs[14]}, {"T", OPR | TEMP, &vs[15]}, {"T", OPR | TEMP, &vs[16]}, {"\0", OPR | TEMP, &vs[17]} }; /* 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 long double PIL; struct varent indtbl[] = { {"t", VAR | IND, &vs[21]}, {"u", VAR | IND, &vs[20]}, {"v", VAR | IND, &vs[19]}, {"w", VAR | IND, &vs[18]}, {"x", VAR | IND, &vs[10]}, {"y", VAR | IND, &vs[11]}, {"z", VAR | IND, &vs[12]}, {"pi", VAR | IND, &PIL}, {"\0", ILLEG, 0} }; /* the symbol table of constants: */ #define NCONST 10 struct varent contbl[NCONST] = { {"C",CONST,&vs[0]}, {"C",CONST,&vs[1]}, {"C",CONST,&vs[2]}, {"C",CONST,&vs[3]}, {"C",CONST,&vs[4]}, {"C",CONST,&vs[5]}, {"C",CONST,&vs[6]}, {"C",CONST,&vs[7]}, {"C",CONST,&vs[8]}, {"\0",CONST,&vs[9]} }; /* the symbol table of string variables: */ static char strngs[160] = {0}; #define NSTRNG 5 struct strent strtbl[NSTRNG] = { {0, VAR | STRING, 0}, {0, VAR | STRING, 0}, {0, VAR | STRING, 0}, {0, VAR | STRING, 0}, {"\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 long double hex(), cmdh(), cmdhlp(); long double cmddm(), cmdtm(), cmdem(); long double take(), mxit(), exit(), bits(), csys(); long double cmddig(), prhlst(), abmac(); long double ifrac(), xcmpl(); long double floorl(), logl(), powl(), sqrtl(), tanhl(), expl(); long double ellpel(), ellpkl(), incbetl(), incbil(); long double stdtrl(), stdtril(), zstdtrl(), zstdtril(); long double sinl(), cosl(), tanl(), asinl(), acosl(), atanl(), atan2l(); long double tanhl(), atanhl(); #ifdef NANS int isnanl(), isfinitel(), signbitl(); long double zisnan(), zisfinite(), zsignbit(); #endif struct funent funtbl[] = { {"h", OPR | FUNC, cmdh}, {"help", OPR | FUNC, cmdhlp}, {"hex", OPR | FUNC, hex}, /*"view", OPR | FUNC, view,*/ {"exp", OPR | FUNC, expl}, {"floor", OPR | FUNC, floorl}, {"log", OPR | FUNC, logl}, {"pow", OPR | FUNC, powl}, {"sqrt", OPR | FUNC, sqrtl}, {"tanh", OPR | FUNC, tanhl}, {"sin", OPR | FUNC, sinl}, {"cos", OPR | FUNC, cosl}, {"tan", OPR | FUNC, tanl}, {"asin", OPR | FUNC, asinl}, {"acos", OPR | FUNC, acosl}, {"atan", OPR | FUNC, atanl}, {"atantwo", OPR | FUNC, atan2l}, {"tanh", OPR | FUNC, tanhl}, {"atanh", OPR | FUNC, atanhl}, {"ellpe", OPR | FUNC, ellpel}, {"ellpk", OPR | FUNC, ellpkl}, {"incbet", OPR | FUNC, incbetl}, {"incbi", OPR | FUNC, incbil}, {"stdtr", OPR | FUNC, zstdtrl}, {"stdtri", OPR | FUNC, zstdtril}, {"ifrac", OPR | FUNC, ifrac}, {"cmp", OPR | FUNC, xcmpl}, #ifdef NANS {"isnan", OPR | FUNC, zisnan}, {"isfinite", OPR | FUNC, zisfinite}, {"signbit", OPR | FUNC, zsignbit}, #endif {"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}, {"system", OPR | FUNC | COMMAN, csys}, {"exit", OPR | FUNC, mxit}, /* "remain", OPR | FUNC, eremain, */ {"\0", OPR | FUNC, 0} }; /* the symbol table of key words */ struct funent keytbl[] = { {"\0", ILLEG, 0} }; #endif void zgets(), init(); /* 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 */ static long double qnc; 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 long double comstk[5]; /* 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 */ int 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 long double acc; /* the accumulator, for arithmetic */ int accflg; /* flags accumulator in use */ long double val; /* 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 *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 */ acc = 0.0L; /* 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<NCONST; i++ ) { psym->attrib = CONST; /* clearing the busy bit */ ++psym; } psym = (struct symbol *)&temp[0]; for( i=0; i<NTEMP; i++ ) { psym->attrib = VAR | TEMP; /* clearing the busy bit */ ++psym; } pstr = &strtbl[0]; for( i=0; i<NSTRNG; i++ ) { pstr->spel = &strngs[ 40*i ]; pstr->attrib = STRING | VAR; pstr->string = &strngs[ 40*i ]; ++pstr; } /* 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; /* if( pvar->attrib & STRING ) strcpy( (char *)&acc, (char *)pvar->value ); else */ acc = *pvar->value; --as; accflg = 1; } /* handle beginning of line type cases, where the symbol * list ascsym[] may be empty. */ switch( *ao ) { case BOL: /* printf( "%.16e\n", (double )acc ); */ #if NE == 6 e64toasc( &acc, str, 100 ); #else e113toasc( &acc, str, 100 ); #endif printf( "%s\n", str ); goto getcmd; /* all finished */ case UMINUS: acc = -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 ) val = 0.0L; else { /* if( att & STRING ) strcpy( (char *)&val, (char *)pvar->value ); else */ val = *pvar->value; } /* 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: acc = ( *(pfun->fun) )(acc); break; case 1: acc = ( *(pfun->fun) )(acc, comstk[comptr-1]); break; case 2: acc = ( *(pfun->fun) )(acc, comstk[comptr-2], comstk[comptr-1]); break; case 3: acc = ( *(pfun->fun) )(acc, comstk[comptr-3], comstk[comptr-2], comstk[comptr-1]); 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; *pvar->value = acc; break; case PLUS: acc = acc + val; break; case MINUS: acc = val - acc; break; case MULT: acc = acc * val; break; case DIV: if( acc == 0.0L ) { /* divzer: */ errcod = 10; goto synerr; } 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; comstk[comptr++] = acc; /* printf( "\ncomptr: %d narptr: %d %d\n", comptr, narptr, acc );*/ acc = val; 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; } /* 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<NTEMP; 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; *pvar->value = acc; /*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 ); abmac(); /* flush the command line */ goto getcmd; } /* end of program */ /* parser() */ /* Get token from input string and identify it. */ static char number[128]; struct symbol *parser( ) { register struct symbol *psym; register char *pline; struct varent *pvar; struct strent *pstr; char *cp, *plc, *pn; long lnc; int i; long double tem; /* 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("* "); } /* 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 == '.') ) { lnc = 0; /* initialize numeric input to zero */ qnc = 0.0L; 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; lnc = (lnc << 4) + i; qnc = lnc; } goto numdon; } else { while( ISOCTAL( *pline ) ) { i = ((*pline++) & 0xff) - 060; lnc = (lnc << 3) + i; qnc = lnc; } 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; #if NE == 6 asctoe64( number, &qnc ); #else asctoe113( number, &qnc ); #endif /* sscanf( number, "%le", &nc ); */ } /* output the number */ numdon: /* search the symbol table of constants */ pvar = &contbl[0]; for( i=0; i<NCONST; i++ ) { if( (pvar->attrib & BUSY) == 0 ) goto confnd; tem = *pvar->value; if( tem == qnc ) { 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; *pvar->value = qnc; psym = (struct symbol *)pvar; goto pdon2; } /* check for operators */ psym = &oprtbl[3]; for( i=0; i<NOPR; 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<NSTRNG-1; 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: pstr->attrib |= BUSY; plc = 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; *plc = '\0'; 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 */ long double cmdex() { if( menptr == 0 ) { printf( "Main menu is active.\n" ); } else --menptr; cmdh(); return(0.0L); } /* gets() */ void 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 */ } /* help function */ long double 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.0L); } long double cmdh() { prhlst( menstk[menptr] ); printf( "\n" ); return(0.0L); } /* print keyword spellings */ long double 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; } return(0.0L); } #if SALONE void init(){} #endif /* macro commands */ /* define macro */ long double cmddm() { zgets( maclin, TRUE ); return(0.0L); } /* type (i.e., display) macro */ long double cmdtm() { printf( "%s\n", maclin ); return(0.0L); } /* execute macro # times */ long double cmdem( arg ) long double arg; { long double f; long n; long double floorl(); f = floorl(arg); n = f; if( n <= 0 ) n = 1; maccnt = n; return(0.0L); } /* open a take file */ long double take( fname ) char *fname; { FILE *f; while( *fname == ' ' ) fname += 1; f = fopen( fname, "r" ); if( f == 0 ) { printf( "Can't open take file %s\n", fname ); takptr = -1; /* terminate all take file input */ return(0.0L); } takptr += 1; takstk[ takptr ] = f; printf( "Running %s\n", fname ); return(0.0L); } /* abort macro execution */ long double abmac() { maccnt = 0; interl = line; return(0.0L); } /* display integer part in hex, octal, and decimal */ long double hex(qx) long double qx; { long double f; long z; long double floorl(); f = floorl(qx); z = f; printf( "0%lo 0x%lx %ld.\n", z, z, z ); return(qx); } #define NASC 16 long double bits( x ) long double x; { int i, j; unsigned short dd[4], ee[10]; char strx[40]; unsigned short *p; p = (unsigned short *) &x; for( i=0; i<NE; i++ ) ee[i] = *p++; j = 0; for( i=0; i<NE; i++ ) { printf( "0x%04x,", ee[i] & 0xffff ); if( ++j > 7 ) { j = 0; printf( "\n" ); } } printf( "\n" ); /* double conversions */ *((double *)dd) = x; printf( "double: " ); for( i=0; i<4; i++ ) printf( "0x%04x,", dd[i] & 0xffff ); printf( "\n" ); #if 1 printf( "double -> long double: " ); *(long double *)ee = *(double *)dd; for( i=0; i<6; i++ ) printf( "0x%04x,", ee[i] & 0xffff ); printf( "\n" ); e53toasc( dd, strx, NASC ); printf( "e53toasc: %s\n", strx ); printf( "Native printf: %.17e\n", *(double *)dd ); /* float conversions */ *((float *)dd) = x; printf( "float: " ); for( i=0; i<2; i++ ) printf( "0x%04x,", dd[i] & 0xffff ); printf( "\n" ); e24toe( dd, ee ); printf( "e24toe: " ); for( i=0; i<NE; i++ ) printf( "0x%04x,", ee[i] & 0xffff ); printf( "\n" ); e24toasc( dd, strx, NASC ); printf( "e24toasc: %s\n", strx ); /* printf( "Native printf: %.16e\n", (double) *(float *)dd ); */ #ifdef DEC printf( "etodec: " ); etodec( x, dd ); for( i=0; i<4; i++ ) printf( "0x%04x,", dd[i] & 0xffff ); printf( "\n" ); printf( "dectoe: " ); dectoe( dd, ee ); for( i=0; i<NE; i++ ) printf( "0x%04x,", ee[i] & 0xffff ); printf( "\n" ); printf( "DEC printf: %.16e\n", *(double *)dd ); #endif #endif /* 0 */ return(x); } /* Exit to monitor. */ long double mxit() { exit(0); return(0.0L); } long double cmddig( x ) long double x; { long double f; long lx; f = floorl(x); lx = f; ndigits = lx; if( ndigits <= 0 ) ndigits = DEFDIS; return(f); } long double csys(x) char *x; { void system(); system( x+1 ); cmdh(); return(0.0L); } long double ifrac(x) long double x; { unsigned long lx; long double y, z; z = floorl(x); lx = z; y = x - z; printf( " int = %lx\n", lx ); return(y); } long double xcmpl(x,y) long double x,y; { long double ans; char str[40]; #if NE == 6 e64toasc( &x, str, 100 ); printf( "x = %s\n", str ); e64toasc( &y, str, 100 ); printf( "y = %s\n", str ); #else e113toasc( &x, str, 100 ); printf( "x = %s\n", str ); e113toasc( &y, str, 100 ); printf( "y = %s\n", str ); #endif ans = -2.0; if( x == y ) { printf( "x == y " ); ans = 0.0; } if( x < y ) { printf( "x < y" ); ans = -1.0; } if( x > y ) { printf( "x > y" ); ans = 1.0; } return( ans ); } long double zstdtrl(k,t) long double k, t; { int ki; long double y; ki = k; y = stdtrl(ki,t); return(y); } long double zstdtril(k,t) long double k, t; { int ki; long double y; ki = k; y = stdtril(ki,t); return(y); } #ifdef NANS long double zisnan(x) long double x; { long double y; int k; k = isnanl(x); y = k; return(y); } long double zisfinite(x) long double x; { long double y; int k; k = isfinitel(x); y = k; return(y); } long double zsignbit(x) long double x; { long double y; int k; k = signbitl(x); y = k; return(y); } #endif