home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD2.mdf / c / library / dos / math / cephes / qfloat / qcalc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-17  |  25.2 KB  |  1,404 lines
  1. /*    calc.c */
  2. /* Keyboard command interpreter        */
  3. /* Copyright 1985 by S. L. Moshier    */
  4.  
  5. #include <stdio.h>
  6. #include "qhead.h"
  7.  
  8. /*
  9.  *#include "config.h"
  10.  */
  11.  
  12. /* length of command line: */
  13. #define LINLEN 128
  14.  
  15. #define XON 0x11
  16. #define XOFF 0x13
  17.  
  18. #define SALONE 1
  19. #define DECPDP 0
  20. #define INTLOGIN 0
  21. #define INTHELP 1
  22. #ifndef TRUE
  23. #define TRUE 1
  24. #endif
  25.  
  26. /* initialize printf: */
  27. #define INIPRINTF 0
  28.  
  29. #if DECPDP
  30. #define TRUE 1
  31. #endif
  32.  
  33.  
  34. static char idterp[] = {
  35. "\n\nSteve Moshier's command interpreter V1.3\n"};
  36. #define ISLOWER(c) ((c >= 'a') && (c <= 'z'))
  37. #define ISUPPER(c) ((c >= 'A') && (c <= 'Z'))
  38. #define ISALPHA(c) (ISLOWER(c) || ISUPPER(c))
  39. #define ISDIGIT(c) ((c >= '0') && (c <= '9'))
  40. #define ISATF(c) (((c >= 'a')&&(c <= 'f')) || ((c >= 'A')&&(c <= 'F')))
  41. #define ISXDIGIT(c) (ISDIGIT(c) || ISATF(c))
  42. #define ISOCTAL(c) ((c >= '0') && (c < '8'))
  43. #define ISALNUM(c) (ISALPHA(c) || (ISDIGIT(c))
  44.  
  45. FILE *fopen();
  46. /* I/O log file: */
  47. static char *savnam = 0;
  48. static FILE *savfil = 0;
  49.  
  50.  
  51. #include "qcalc.h"
  52.  
  53. /* space for double precision numbers */
  54. static int vsp = 13;
  55. static short vs[22][NQ] = {0};
  56.  
  57. /*    the symbol table of temporary variables: */
  58.  
  59. #define NTEMP 4
  60. struct varent temp[NTEMP] = {
  61. "T",    OPR | TEMP, &vs[14][0],
  62. "T",    OPR | TEMP, &vs[15][0],
  63. "T",    OPR | TEMP, &vs[16][0],
  64. "\0",    OPR | TEMP, &vs[17][0]
  65. };
  66.  
  67. /*    the symbol table of operators        */
  68. /* EOL is interpreted on null, newline, or ;    */
  69. struct symbol oprtbl[] = {
  70. "BOL",        OPR | BOL,    0,
  71. "EOL",        OPR | EOL,    0,
  72. "-",        OPR | UMINUS,    8,
  73. /*"~",        OPR | COMP,    8,*/
  74. ",",        OPR | EOE,    1,
  75. "=",        OPR | EQU,    2,
  76. /*"|",        OPR | LOR,    3,*/
  77. /*"^",        OPR | LXOR,    4,*/
  78. /*"&",        OPR | LAND,    5,*/
  79. "+",        OPR | PLUS,    6,
  80. "-",        OPR | MINUS, 6,
  81. "*",        OPR | MULT,    7,
  82. "/",        OPR | DIV,    7,
  83. /*"%",        OPR | MOD,    7,*/
  84. "(",        OPR | LPAREN,    11,
  85. ")",        OPR | RPAREN,    11,
  86. "\0",        ILLEG, 0
  87. };
  88.  
  89. #define NOPR 8
  90.  
  91. /*    the symbol table of indirect variables: */
  92. extern short qpi[];
  93. struct varent indtbl[] = {
  94. "t",        VAR | IND,    &vs[21][0],
  95. "u",        VAR | IND,    &vs[20][0],    
  96. "v",        VAR | IND,    &vs[19][0],
  97. "w",        VAR | IND,    &vs[18][0],    
  98. "x",        VAR | IND,    &vs[10][0],
  99. "y",        VAR | IND,    &vs[11][0],
  100. "z",        VAR | IND,    &vs[12][0],
  101. "pi",        VAR | IND,    &qpi[0],
  102. "\0",        ILLEG,        0
  103. };
  104.  
  105. /*    the symbol table of constants:    */
  106.  
  107. #define NCONST 10
  108. struct varent contbl[NCONST] = {
  109. "C",CONST,&vs[0][0],
  110. "C",CONST,&vs[1][0],
  111. "C",CONST,&vs[2][0],
  112. "C",CONST,&vs[3][0],
  113. "C",CONST,&vs[4][0],
  114. "C",CONST,&vs[5][0],
  115. "C",CONST,&vs[6][0],
  116. "C",CONST,&vs[7][0],
  117. "C",CONST,&vs[8][0],
  118. "\0",CONST,&vs[9][0]
  119. };
  120.  
  121. /* the symbol table of string variables: */
  122.  
  123. static char strngs[4][40] = {0};
  124.  
  125. #define NSTRNG 5
  126. struct strent strtbl[NSTRNG] = {
  127. #if DECPDP
  128. &strngs[0][0], VAR | STRING, &strngs[0][0],
  129. &strngs[1][0], VAR | STRING, &strngs[1][0],
  130. &strngs[2][0], VAR | STRING, &strngs[2][0],
  131. &strngs[3][0], VAR | STRING, &strngs[3][0],
  132. #else
  133. &strngs[0][0], VAR | STRING, &strngs[0][0],
  134. &strngs[1][0], VAR | STRING, &strngs[1][0],
  135. &strngs[2][0], VAR | STRING, &strngs[2][0],
  136. &strngs[3][0], VAR | STRING, &strngs[3][0],
  137. #endif
  138. "\0",ILLEG,0,
  139. };
  140.  
  141.  
  142. /* Help messages */
  143. #if INTHELP
  144. static char *intmsg[] = {
  145. "?",
  146. "Unkown symbol",
  147. "Expression ends in illegal operator",
  148. "Precede ( by operator",
  149. ")( is illegal",
  150. "Unmatched )",
  151. "Missing )",
  152. "Illegal left hand side",
  153. "Missing symbol",
  154. "Must assign to a variable",
  155. "Divide by zero",
  156. "Missing symbol",
  157. "Missing operator",
  158. "Precede quantity by operator",
  159. "Quantity preceded by )",
  160. "Function syntax",
  161. "Too many function args",
  162. "No more temps",
  163. "Arg list"
  164. };
  165. #endif
  166.  
  167. /*    the symbol table of functions:    */
  168. #if SALONE
  169. int hex(), cmdh(), cmdhlp();
  170. /*int view();*/
  171. int cmddm(), cmdtm(), cmdem();
  172. /*int printf();*/
  173. int take(), mxit(), exit(), bits();
  174. int cmddig(), qfloor(), todbl();
  175. int qsqrt(), qlog(), qexp(), qtanh(), qpow();
  176. int qsave(), qsys();
  177. /*
  178. int qsin(), qcos(), qatn(), qjn(), qyn();
  179. int qasin(), qtan(), qcosh(), qsinh(), qasinh(), qacosh();
  180. int qacos(), qatanh(), qcot(), qgamma(), qcbrt(), qfac();
  181. */
  182. /* log10(), exp10(), ndtr(), ndtri();*/
  183.  
  184. struct funent funtbl[] = {
  185. "h",        OPR | FUNC, cmdh,
  186. "help",        OPR | FUNC, cmdhlp,
  187. "hex",        OPR | FUNC, hex,
  188. /*"view",        OPR | FUNC, view,*/
  189. /*
  190. "acos",        OPR | FUNC, qacos,
  191. "acosh",    OPR | FUNC, qacosh,
  192. "asin",        OPR | FUNC, qasin,
  193. "asinh",    OPR | FUNC, qasinh,
  194. "atan",        OPR | FUNC, qatn,
  195. "atanh",    OPR | FUNC, qatanh,
  196. "cbrt",        OPR | FUNC, qcbrt,
  197. "cos",        OPR | FUNC, qcos,
  198. "cosh",        OPR | FUNC, qcosh,
  199. "cot",        OPR | FUNC, qcot,
  200. */
  201. "exp",        OPR | FUNC, qexp,
  202. /*"fac",        OPR | FUNC, qfac,*/
  203. "floor",    OPR | FUNC, qfloor,
  204. /*
  205. "gamma",    OPR | FUNC, qgamma,
  206. "jv",        OPR | FUNC, qjn,
  207. "yn",        OPR | FUNC, qyn,
  208. "logten",    OPR | FUNC, qlog10,
  209. "expten",    OPR | FUNC, qexp10,
  210. */
  211. "log",        OPR | FUNC, qlog,
  212. /*
  213. "ndtr",        OPR | FUNC, ndtr,
  214. "ndtri",    OPR | FUNC, ndtri,
  215. */
  216. "pow",        OPR | FUNC, qpow,
  217. /*
  218. "sin",        OPR | FUNC, qsin,
  219. "sinh",        OPR | FUNC, qsinh,
  220. */
  221. "sqrt",        OPR | FUNC, qsqrt,
  222. /*"tan",        OPR | FUNC, qtan,*/
  223. "tanh",        OPR | FUNC, qtanh,
  224. "bits",        OPR | FUNC, bits,
  225. "digits",    OPR | FUNC, cmddig,
  226. "dm",        OPR | FUNC, cmddm,
  227. "tm",        OPR | FUNC, cmdtm,
  228. "em",        OPR | FUNC, cmdem,
  229. "take",        OPR | FUNC | COMMAN, take,
  230. "save",        OPR | FUNC | COMMAN, qsave,
  231. "system",    OPR | FUNC | COMMAN, qsys,
  232. "exit",        OPR | FUNC, mxit,
  233. "\0",        OPR | FUNC,    0
  234. };
  235.  
  236. /*    the symbol table of key words */
  237. struct funent keytbl[] = {
  238. "\0",        ILLEG,    0
  239. };
  240. #endif
  241.  
  242. /* Number of decimals to display */
  243. #define DEFDIS 70
  244. static int ndigits = DEFDIS;
  245.  
  246. /* Menu stack */
  247. struct funent *menstk[5] = {&funtbl[0], NULL, NULL, NULL, NULL};
  248. int menptr = 0;
  249.  
  250. /* Take file stack */
  251. FILE *takstk[10] = {0};
  252. int takptr = -1;
  253.  
  254. /* size of the expression scan list: */
  255. #define NSCAN 20
  256.  
  257. /* previous token, saved for syntax checking: */
  258. struct symbol *lastok = 0;
  259.  
  260. /*    variables used by parser: */
  261. static char str[128] = {0};
  262. int uposs = 0;        /* possible unary operator */
  263. double nc = 0;        /*    numeric value of symbol        */
  264. static short qnc[NQ] = {0};
  265. char lc[40] = { '\n' };    /*    ASCII string of token    symbol    */
  266. static char line[LINLEN] = { '\n','\0' };    /* input command line */
  267. static char maclin[LINLEN] = { '\n','\0' };    /* macro command */
  268. char *interl = line;        /* pointer into line */
  269. extern char *interl;
  270. static int maccnt = 0;    /* number of times to execute macro command */
  271. static int comptr = 0;    /* comma stack pointer */
  272. static int comstk[5][NQ] = {0};    /* comma argument stack */
  273. static int narptr = 0;    /* pointer to number of args */
  274. static int narstk[5] = {0};    /* stack of number of function args */
  275.  
  276. /*                            main()        */
  277.  
  278. /*    Entire program starts here    */
  279.  
  280. main()
  281. {
  282.  
  283. /*    the scan table:            */
  284.  
  285. /*    array of pointers to symbols which have been parsed:    */
  286. struct symbol *ascsym[NSCAN];
  287.  
  288. /*    current place in ascsym:            */
  289. register struct symbol **as;
  290.  
  291. /*    array of attributes of operators parsed:        */
  292. int ascopr[NSCAN];
  293.  
  294. /*    current place in ascopr:            */
  295. register int *ao;
  296.  
  297. #if LARGEMEM
  298. /*    array of precedence levels of operators:        */
  299. long asclev[NSCAN];
  300. /*    current place in asclev:            */
  301. long *al;
  302. long symval;    /* value of symbol just parsed */
  303. #else
  304. int asclev[NSCAN];
  305. int *al;
  306. int symval;
  307. #endif
  308.  
  309. short acc[NQ];    /* the accumulator, for arithmetic */
  310. int accflg;    /* flags accumulator in use    */
  311. int val[NQ];    /* value to be combined into accumulator */
  312. register struct symbol *psym;    /* pointer to symbol just parsed */
  313. struct varent *pvar;    /* pointer to an indirect variable symbol */
  314. struct funent *pfun;    /* pointer to a function symbol */
  315. struct strent *pstr;    /* pointer to a string symbol */
  316. int att;    /* attributes of symbol just parsed */
  317. int i;        /* counter    */
  318. int offset;    /* parenthesis level */
  319. int lhsflg;    /* kluge to detect illegal assignments */
  320. struct symbol *tsym;    /* pointer to temporary symbol */
  321. struct symbol *parser();    /* parser returns pointer to symbol */
  322. int errcod;    /* for syntax error printout */
  323.  
  324.  
  325. /* Perform general initialization */
  326.  
  327. init();
  328.  
  329. menstk[0] = &funtbl[0];
  330. menptr = 0;
  331. cmdhlp();        /* print out list of symbols */
  332.  
  333.  
  334. /*    Return here to get next command line to execute    */
  335. getcmd:
  336.  
  337. /* initialize registers and mutable symbols */
  338.  
  339. accflg = 0;    /* Accumulator not in use                */
  340. qclear(acc);    /* Clear the accumulator                */
  341. offset = 0;    /* Parenthesis level zero                */
  342. comptr = 0;    /* Start of comma stack                    */
  343. narptr = -1;    /* Start of function arg counter stack    */
  344.  
  345. psym = (struct symbol *)&contbl[0];
  346. for( i=0; i<NCONST; i++ )
  347.     {
  348.     psym->attrib = CONST;    /* clearing the busy bit */
  349.     ++psym;
  350.     }
  351. psym = (struct symbol *)&temp[0];
  352. for( i=0; i<NTEMP; i++ )
  353.     {
  354.     psym->attrib = VAR | TEMP;    /* clearing the busy bit */
  355.     ++psym;
  356.     }
  357.  
  358. psym = (struct symbol *)&strtbl[0];
  359. for( i=0; i<NSTRNG; i++ )
  360.     {
  361.     psym->attrib = STRING | VAR;
  362.     ++psym;
  363.     }
  364.  
  365. /*    List of scanned symbols is empty:    */
  366. as = &ascsym[0];
  367. *as = 0;
  368. --as;
  369. /*    First item in scan list is Beginning of Line operator    */
  370. ao = &ascopr[0];
  371. *ao = oprtbl[0].attrib & 0xf;    /* BOL */
  372. /*    value of first item: */
  373. al = &asclev[0];
  374. *al = oprtbl[0].sym;
  375.  
  376. lhsflg = 0;        /* illegal left hand side flag */
  377. psym = &oprtbl[0];    /* pointer to current token */
  378.  
  379. /*    get next token from input string    */
  380.  
  381. gettok:
  382. lastok = psym;        /* last token = current token */
  383. psym = parser();    /* get a new current token */
  384. /*printf( "%s attrib %7o value %7o\n", psym->spel, psym->attrib & 0xffff,
  385.         psym->sym );*/
  386.  
  387. /* Examine attributes of the symbol returned by the parser    */
  388. att = psym->attrib;
  389. if( att == ILLEG )
  390.     {
  391.     errcod = 1;
  392.     goto synerr;
  393.     }
  394.  
  395. /*    Push functions onto scan list without analyzing further */
  396. if( att & FUNC )
  397.     {
  398.     /* A command is a function whose argument is
  399.      * a pointer to the rest of the input line.
  400.      * A second argument is also passed: the address
  401.      * of the last token parsed.
  402.      */
  403.     if( att & COMMAN )
  404.         {
  405.         pfun = (struct funent *)psym;
  406.         ( *(pfun->fun))( interl, lastok );
  407.         abmac();    /* scrub the input line */
  408.         goto getcmd;    /* and ask for more input */
  409.         }
  410.     ++narptr;    /* offset to number of args */
  411.     narstk[narptr] = 0;
  412.     i = lastok->attrib & 0xffff; /* attrib=short, i=int */
  413.     if( ((i & OPR) == 0)
  414.             || (i == (OPR | RPAREN))
  415.             || (i == (OPR | FUNC)) )
  416.         {
  417.         errcod = 15;
  418.         goto synerr;
  419.         }
  420.  
  421.     ++lhsflg;
  422.     ++as;
  423.     *as = psym;
  424.     ++ao;
  425.     *ao = FUNC;
  426.     ++al;
  427.     *al = offset + UMINUS;
  428.     goto gettok;
  429.     }
  430.  
  431. /* deal with operators */
  432. if( att & OPR )
  433.     {
  434.     att &= 0xf;
  435.     /* expression cannot end with an operator other than
  436.      * (, ), BOL, or a function
  437.      */
  438.     if( (att == RPAREN) || (att == EOL) || (att == EOE))
  439.         {
  440.         i = lastok->attrib & 0xffff; /* attrib=short, i=int */
  441.         if( (i & OPR) 
  442.             && (i != (OPR | RPAREN))
  443.             && (i != (OPR | LPAREN))
  444.             && (i != (OPR | FUNC))
  445.             && (i != (OPR | BOL)) )
  446.                 {
  447.                 errcod = 2;
  448.                 goto synerr;
  449.                 }
  450.         }
  451.     ++lhsflg;    /* any operator but ( and = is not a legal lhs */
  452.  
  453. /*    operator processing, continued */
  454.  
  455.     switch( att )
  456.         {
  457.      case EOE:
  458.         lhsflg = 0;
  459.         break; 
  460.     case LPAREN:
  461.         /* ( must be preceded by an operator of some sort. */
  462.         if( ((lastok->attrib & OPR) == 0) )
  463.             {
  464.             errcod = 3;
  465.             goto synerr;
  466.             }
  467.         /* also, a preceding ) is illegal */
  468.         if( (unsigned short )lastok->attrib == (OPR|RPAREN))
  469.             {
  470.             errcod = 4;
  471.             goto synerr;
  472.             }
  473.         /* Begin looking for illegal left hand sides: */
  474.         lhsflg = 0;
  475.         offset += RPAREN;    /* new parenthesis level */
  476.         goto gettok;
  477.     case RPAREN:
  478.         offset -= RPAREN;    /* parenthesis level */
  479.         if( offset < 0 )
  480.             {
  481.             errcod = 5;    /* parenthesis error */
  482.             goto synerr;
  483.             }
  484.         goto gettok;
  485.     case EOL:
  486.         if( offset != 0 )
  487.             {
  488.             errcod = 6;    /* parenthesis error */
  489.             goto synerr;
  490.             }
  491.         break;
  492.     case EQU:
  493.         if( --lhsflg )    /* was incremented before switch{} */
  494.             {
  495.             errcod = 7;
  496.             goto synerr;
  497.             }
  498.     case UMINUS:
  499.     case COMP:
  500.         goto pshopr;    /* evaluate right to left */
  501.     default:    ;
  502.         }
  503.  
  504.  
  505. /*    evaluate expression whenever precedence is not increasing    */
  506.  
  507. symval = psym->sym + offset;
  508.  
  509. while( symval <= *al )
  510.     {
  511.     /* if just starting, must fill accumulator with last
  512.      * thing on the line
  513.      */
  514.     if( (accflg == 0) && (as >= ascsym) && (((*as)->attrib & FUNC) == 0 ))
  515.         {
  516.         pvar = (struct varent *)*as;
  517.         qmov( pvar->value, acc );
  518.         --as;
  519.         accflg = 1;
  520.         }
  521.  
  522. /* handle beginning of line type cases, where the symbol
  523.  * list ascsym[] may be empty.
  524.  */
  525.     switch( *ao )
  526.         {
  527.     case BOL:    
  528.         qtoasc( acc, str, ndigits );
  529.         printf( "%s\n", str ); /* This is the answer */
  530.         if( savfil )
  531.             fprintf( savfil, "%s\n", str );
  532.         goto getcmd;    /* all finished */
  533.     case UMINUS:
  534.         qneg( acc );
  535.         goto nochg;
  536. /*
  537.     case COMP:
  538.         acc = ~acc;
  539.         goto nochg;
  540. */
  541.     default:    ;
  542.         }
  543. /* Now it is illegal for symbol list to be empty,
  544.  * because we are going to need a symbol below.
  545.  */
  546.     if( as < &ascsym[0] )
  547.         {
  548.         errcod = 8;
  549.         goto synerr;
  550.         }
  551. /* get attributes and value of current symbol */
  552.     att = (*as)->attrib;
  553.     pvar = (struct varent *)*as;
  554.     if( att & FUNC )
  555.         qclear( val );
  556.     else
  557.         qmov( pvar->value, val );
  558.  
  559. /* Expression evaluation, continued. */
  560.  
  561.     switch( *ao )
  562.         {
  563.     case FUNC:
  564.         pfun = (struct funent *)*as;
  565.     /* Call the function with appropriate number of args */
  566.     i = narstk[ narptr ];
  567.     --narptr;
  568.     switch(i)
  569.             {
  570.             case 0:
  571.             ( *(pfun->fun) )(acc, acc);
  572.             break;
  573.             case 1:
  574.             ( *(pfun->fun) )(acc,comstk[comptr-1],acc);
  575.             break;
  576.             case 2:
  577.             ( *(pfun->fun) )(acc, comstk[comptr-2],
  578.                 comstk[comptr-1],acc);
  579.             break;
  580.             case 3:
  581.             ( *(pfun->fun) )(acc, comstk[comptr-3],
  582.                 comstk[comptr-2], comstk[comptr-1],acc);
  583.             break;
  584.             default:
  585.             errcod = 16;
  586.             goto synerr;
  587.             }
  588.         comptr -= i;
  589.         accflg = 1;    /* in case at end of line */
  590.         break;
  591.     case EQU:
  592.         if( ( att & TEMP) || ((att & VAR) == 0) || (att & STRING) )
  593.             {
  594.             errcod = 9;
  595.             goto synerr;    /* can only assign to a variable */
  596.             }
  597.         pvar = (struct varent *)*as;
  598.         qmov( acc, pvar->value );
  599.         break;
  600.     case PLUS:
  601.         qadd( acc, val, acc );    break;
  602.     case MINUS:
  603.         qsub( acc, val, acc );    break;
  604.     case MULT:
  605.         qmul( acc, val, acc );    break;
  606.     case DIV:
  607.         if( acc[1] == 0 )
  608.             {
  609. divzer:
  610.             errcod = 10;
  611.             goto synerr;
  612.             }
  613.         qdiv( acc, val, acc );    break;
  614. /*
  615.     case MOD:
  616.         if( acc == 0 )
  617.             goto divzer;
  618.         acc = val % acc;    break;
  619.     case LOR:
  620.         acc |= val;        break;
  621.     case LXOR:
  622.         acc ^= val;        break;
  623.     case LAND:
  624.         acc &= val;        break;
  625. */
  626.     case EOE:
  627.         if( narptr < 0 )
  628.             {
  629.             errcod = 18;
  630.             goto synerr;
  631.             }
  632.         narstk[narptr] += 1;
  633.         qmov( acc, comstk[comptr++] );
  634. /*    printf( "\ncomptr: %d narptr: %d %d\n", comptr, narptr, acc );*/
  635.         qmov( val, acc );
  636.         break;
  637.         }
  638.  
  639.  
  640. /*    expression evaluation, continued        */
  641.  
  642. /* Pop evaluated tokens from scan list:        */
  643.     /* make temporary variable not busy    */
  644.     if( att & TEMP )
  645.         (*as)->attrib &= ~BUSY;
  646.     if( as < &ascsym[0] )    /* can this happen? */
  647.         {
  648.         errcod = 11;
  649.         goto synerr;
  650.         }
  651.     --as;
  652. nochg:
  653.     --ao;
  654.     --al;
  655.     if( ao < &ascopr[0] )    /* can this happen? */
  656.         {
  657.         errcod = 12;
  658.         goto synerr;
  659.         }
  660. noval:
  661. /* If precedence level will now increase, then            */
  662. /* save accumulator in a temporary location            */
  663.     if( symval > *al )
  664.         {
  665.         /* find a free temp location */
  666.         pvar = &temp[0];
  667.         for( i=0; i<NTEMP; i++ )
  668.             {
  669.             if( (pvar->attrib & BUSY) == 0)
  670.                 goto temfnd;
  671.             ++pvar;
  672.             }
  673.         errcod = 17;
  674.         printf( "no more temps\n" );
  675.         pvar = &temp[0];
  676.         goto synerr;
  677.  
  678.     temfnd:
  679.         pvar->attrib |= BUSY;
  680.         qmov( acc, pvar->value );
  681.         /*printf( "temp %d\n", acc );*/
  682.         accflg = 0;
  683.         ++as;    /* push the temp onto the scan list */
  684.         *as = (struct symbol *)pvar;
  685.         }
  686.     }    /* End of evaluation loop */
  687.  
  688.  
  689. /*    Push operator onto scan list when precedence increases    */
  690.  
  691. pshopr:
  692.     ++ao;
  693.     *ao = psym->attrib & 0xf;
  694.     ++al;
  695.     *al = psym->sym + offset;
  696.     goto gettok;
  697.     }    /* end of OPR processing */
  698.  
  699.  
  700. /* Token was not an operator.  Push symbol onto scan list.    */
  701. if( (lastok->attrib & OPR) == 0 )
  702.     {
  703.     errcod = 13;
  704.     goto synerr;    /* quantities must be preceded by an operator */
  705.     }
  706. if( (unsigned short )lastok->attrib == (OPR | RPAREN) )    /* ...but not by ) */
  707.     {
  708.     errcod = 14;
  709.     goto synerr;
  710.     }
  711. ++as;
  712. *as = psym;
  713. goto gettok;
  714.  
  715. synerr:
  716.  
  717. #if INTHELP
  718. printf( "%s ", intmsg[errcod] );
  719. #endif
  720. printf( " error %d\n", errcod );
  721. if( savfil )
  722.     fprintf( savfil, " error %d\n", errcod );
  723. abmac();    /* flush the command line */
  724. goto getcmd;
  725. }    /* end of program */
  726.  
  727. /*                        parser()    */
  728.  
  729. /* Get token from input string and identify it.        */
  730.  
  731.  
  732. static char number[40] = {0};
  733.  
  734. struct symbol *parser( )
  735. {
  736. register struct symbol *psym;
  737. register char *pline;
  738. struct varent *pvar;
  739. struct strent *pstr;
  740. char *cp, *plc, *pn;
  741. int i;
  742. /* reference for old Whitesmiths compiler: */
  743. /*
  744.  *extern FILE *stdout;
  745.  */
  746.  
  747. pline = interl;        /* get current location in command string    */
  748.  
  749.  
  750. /*    If at beginning of string, must ask for more input    */
  751. if( pline == line )
  752.     {
  753.  
  754.     if( maccnt > 0 )
  755.         {
  756.         --maccnt;
  757.         cp = maclin;
  758.         plc = pline;
  759.         while( (*plc++ = *cp++) != 0 )
  760.             ;
  761.         goto mstart;
  762.         }
  763.     if( takptr < 0 )
  764.         {    /* no take file active: prompt keyboard input */
  765.         printf("* ");
  766.         if( savfil )
  767.             fprintf( savfil, "* " );
  768.         }
  769. /*     Various ways of typing in a command line. */
  770.  
  771. /*
  772.  * Old Whitesmiths call to print "*" immediately
  773.  * use RT11 .GTLIN to get command string
  774.  * from command file or terminal
  775.  */
  776.  
  777. /*
  778.  *    fflush(stdout);
  779.  *    gtlin(line);
  780.  */
  781.  
  782.  
  783.     zgets( line, TRUE );    /* keyboard input for other systems: */
  784.  
  785.  
  786. mstart:
  787.     uposs = 1;    /* unary operators possible at start of line */
  788.     }
  789.  
  790. ignore:
  791. /* Skip over spaces */
  792. while( *pline == ' ' )
  793.     ++pline;
  794.  
  795. /* unary minus after operator */
  796. if( uposs && (*pline == '-') )
  797.     {
  798.     psym = &oprtbl[2];    /* UMINUS */
  799.     ++pline;
  800.     goto pdon3;
  801.     }
  802.     /* COMP */
  803. /*
  804. if( uposs && (*pline == '~') )
  805.     {
  806.     psym = &oprtbl[3];
  807.     ++pline;
  808.     goto pdon3;
  809.     }
  810. */
  811. if( uposs && (*pline == '+') )    /* ignore leading plus sign */
  812.     {
  813.     ++pline;
  814.     goto ignore;
  815.     }
  816.  
  817. /* end of null terminated input */
  818. if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
  819.     {
  820.     pline = line;
  821.     goto endlin;
  822.     }
  823. if( *pline == ';' )
  824.     {
  825.     ++pline;
  826. endlin:
  827.     psym = &oprtbl[1];    /* EOL */
  828.     goto pdon2;
  829.     }
  830.  
  831.  
  832. /*                        parser()    */
  833.  
  834.  
  835. /* Test for numeric input */
  836. if( (ISDIGIT(*pline)) || (*pline == '.') )
  837.     {
  838.     nc = 0.0;    /* initialize numeric input to zero */
  839.     qclear( qnc );
  840. /*******/
  841.     if( *pline == '0' )
  842.         { /* leading "0" may mean octal or hex radix */
  843.         ++pline;
  844.         if( *pline == '.' )
  845.             goto decimal; /* 0.ddd */
  846.         /* leading "0x" means hexadecimal radix */
  847.         if( (*pline == 'x') || (*pline == 'X') )
  848.             {
  849.             ++pline;
  850.             while( ISXDIGIT(*pline) )
  851.                 {
  852.                 i = *pline++ & 0xff;
  853.                 if( i >= 'a' )
  854.                     i -= 047;
  855.                 if( i >= 'A' )
  856.                     i -= 07;
  857.                 i -= 060;
  858.                 nc = (nc * 16.0) + i;
  859.                 etoq( &nc, qnc );
  860.                 }
  861.             goto numdon;
  862.             }
  863.         else
  864.             {
  865.             while( ISOCTAL( *pline ) )
  866.                 {
  867.                 i = *pline++ & 0xff - 060;
  868.                 nc = ( nc * 8.0) + i;
  869.                 etoq( &nc, qnc );
  870.                 }
  871.             goto numdon;
  872.             }
  873.         }
  874.     else
  875.         {
  876.         /* no leading "0" means decimal radix */
  877. /******/
  878. decimal:
  879.         pn = number;
  880.         while( (ISDIGIT(*pline)) || (*pline == '.') )
  881.             *pn++ = *pline++;
  882. /* get possible exponent field */
  883.         if( (*pline == 'e') || (*pline == 'E') )
  884.             *pn++ = *pline++;
  885.         else
  886.             goto numcvt;
  887.         if( (*pline == '-') || (*pline == '+') )
  888.             *pn++ = *pline++;
  889.         while( ISDIGIT(*pline) )
  890.             *pn++ = *pline++;
  891. numcvt:
  892.         *pn++ = ' ';
  893.         *pn++ = 0;
  894.         asctoq( number, qnc );
  895. /*        sscanf( number, "%le", &nc );*/
  896.         }
  897. /* output the number    */
  898. numdon:
  899.     /* search the symbol table of constants     */
  900.     pvar = &contbl[0];
  901.     for( i=0; i<NCONST; i++ )
  902.         {
  903.         if( (pvar->attrib & BUSY) == 0 )
  904.             goto confnd;
  905.         if( qcmp( pvar->value, qnc) == 0 )
  906.             {
  907.             psym = (struct symbol *)pvar;
  908.             goto pdon2;
  909.             }
  910.         ++pvar;
  911.         }
  912.     printf( "no room for constant\n" );
  913.     psym = (struct symbol *)&contbl[0];
  914.     goto pdon2;
  915.  
  916. confnd:
  917.     pvar->spel= contbl[0].spel;
  918.     pvar->attrib = CONST | BUSY;
  919.     qmov( qnc, pvar->value );
  920.     psym = (struct symbol *)pvar;
  921.     goto pdon2;
  922.     }
  923.  
  924. /* check for operators */
  925. psym = &oprtbl[3];
  926. for( i=0; i<NOPR; i++ )
  927.     {
  928.     if( *pline == *(psym->spel) )
  929.         goto pdon1;
  930.     ++psym;
  931.     }
  932.  
  933. /* if quoted, it is a string variable */
  934. if( *pline == '"' )
  935.     {
  936.     /* find an empty slot for the string */
  937.     pstr = strtbl;    /* string table    */
  938.     for( i=0; i<NSTRNG-1; i++ ) 
  939.         {
  940.         if( (pstr->attrib & BUSY) == 0 )
  941.             goto fndstr;
  942.         ++pstr;
  943.         }
  944.     printf( "No room for string\n" );
  945.     pstr->attrib |= ILLEG;
  946.     psym = (struct symbol *)pstr;
  947.     goto pdon0;
  948.  
  949. fndstr:
  950.     plc = (char *)(pstr->string);
  951.     ++pline;
  952.     for( i=0; i<39; i++ )
  953.         {
  954.         *plc++ = *pline;
  955.         if( (*pline == '\n') || (*pline == '\0') || (*pline == '\r') )
  956.             {
  957. illstr:
  958.             pstr = &strtbl[NSTRNG-1];
  959.             pstr->attrib |= ILLEG;
  960.             printf( "Missing string terminator\n" );
  961.             psym = (struct symbol *)pstr;
  962.             goto pdon0;
  963.             }
  964.         if( *pline++ == '"' )
  965.             goto finstr;
  966.         }
  967.  
  968.     goto illstr;    /* no terminator found */
  969.  
  970. finstr:
  971.     *(--plc) = '\0';
  972.     pstr->attrib |= BUSY;
  973.     psym = (struct symbol *)pstr;
  974.     goto pdon2;
  975.     }
  976. /* If none of the above, search function and symbol tables:    */
  977.  
  978. /* copy character string to array lc[] */
  979. plc = &lc[0];
  980. while( ISALPHA(*pline) )
  981.     {
  982.     /* convert to lower case characters */
  983.     if( ISUPPER( *pline ) )
  984.         *pline += 040;
  985.     *plc++ = *pline++;
  986.     }
  987. *plc = 0;    /* Null terminate the output string */
  988.  
  989. /*                        parser()    */
  990.  
  991. psym = (struct symbol *)menstk[menptr];    /* function table    */
  992. plc = &lc[0];
  993. cp = psym->spel;
  994. do
  995.     {
  996.     if( strcmp( plc, cp ) == 0 )
  997.         goto pdon3;    /* following unary minus is possible */
  998.     ++psym;
  999.     cp = psym->spel;
  1000.     }
  1001. while( *cp != '\0' );
  1002.  
  1003. psym = (struct symbol *)&indtbl[0];    /* indirect symbol table */
  1004. plc = &lc[0];
  1005. cp = psym->spel;
  1006. do
  1007.     {
  1008.     if( strcmp( plc, cp ) == 0 )
  1009.         goto pdon2;
  1010.     ++psym;
  1011.     cp = psym->spel;
  1012.     }
  1013. while( *cp != '\0' );
  1014.  
  1015. pdon0:
  1016. pline = line;    /* scrub line if illegal symbol */
  1017. goto pdon2;
  1018.  
  1019. pdon1:
  1020. ++pline;
  1021. if( (psym->attrib & 0xf) == RPAREN )
  1022. pdon2:    uposs = 0;
  1023. else
  1024. pdon3:    uposs = 1;
  1025.  
  1026. interl = pline;
  1027. return( psym );
  1028. }        /* end of parser */
  1029.  
  1030. /*    exit from current menu */
  1031.  
  1032. cmdex()
  1033. {
  1034.  
  1035. if( menptr == 0 )
  1036.     {
  1037.     printf( "Main menu is active.\n" );
  1038.     }
  1039. else
  1040.     --menptr;
  1041.  
  1042. cmdh();
  1043. return(0);
  1044. }
  1045.  
  1046.  
  1047. /*            gets()        */
  1048.  
  1049. zgets( gline, echo )
  1050. char *gline;
  1051. int echo;
  1052. {
  1053. register char *pline;
  1054. register int i;
  1055.  
  1056.  
  1057. scrub:
  1058. pline = gline;
  1059. getsl:
  1060.     if( (pline - gline) >= LINLEN )
  1061.         {
  1062.         printf( "\nLine too long\n *" );
  1063.         goto scrub;
  1064.         }
  1065.     if( takptr < 0 )
  1066.         {    /* get character from keyboard */
  1067. #if DECPDP
  1068.         gtlin( gline );
  1069.         return(0);
  1070. #else
  1071.         *pline = getchar();
  1072. #endif
  1073.         }
  1074.     else
  1075.         {    /* get a character from take file */
  1076.         i = fgetc( takstk[takptr] );
  1077.         if( i == -1 )
  1078.             {    /* end of take file */
  1079.             if( takptr >= 0 )
  1080.                 {    /* close file and bump take stack */
  1081.                 fclose( takstk[takptr] );
  1082.                 takptr -= 1;
  1083.                 }
  1084.             if( takptr < 0 )    /* no more take files:   */
  1085.                 printf( "*" ); /* prompt keyboard input */
  1086.             goto scrub;    /* start a new input line */
  1087.             }
  1088.         *pline = i;
  1089.         }
  1090.  
  1091.     *pline &= 0x7f;
  1092.     /* xon or xoff characters need filtering out. */
  1093.     if ( *pline == XON || *pline == XOFF )
  1094.         goto getsl;
  1095.  
  1096.     /*    control U or control C    */
  1097.     if( (*pline == 025) || (*pline == 03) )
  1098.         {
  1099.         printf( "\n" );
  1100.         goto scrub;
  1101.         }
  1102.  
  1103.     /*  Backspace or rubout */
  1104.     if( (*pline == 010) || (*pline == 0177) )
  1105.         {
  1106.         pline -= 1;
  1107.         if( pline >= gline )
  1108.             {
  1109.             if ( echo )
  1110.                 printf( "\010\040\010" );
  1111.             goto getsl;
  1112.             }
  1113.         else
  1114.             goto scrub;
  1115.         }
  1116.     if ( echo )
  1117.         printf( "%c", *pline );
  1118.     if( (*pline != '\n') && (*pline != '\r') )
  1119.         {
  1120.         ++pline;
  1121.         goto getsl;
  1122.         }
  1123.     *pline = 0;
  1124.     if ( echo )
  1125.         printf( "%c", '\n' );    /* \r already echoed */
  1126.     if( savfil )
  1127.         fprintf( savfil, "%s\n", gline );
  1128. }
  1129.  
  1130.  
  1131. /*        help function  */
  1132. cmdhlp()
  1133. {
  1134.  
  1135. printf( "%s", idterp );
  1136. printf( "\nFunctions:\n" );
  1137. prhlst( &funtbl[0] );
  1138. printf( "\nVariables:\n" );
  1139. prhlst( &indtbl[0] );
  1140. printf( "\nOperators:\n" );
  1141. prhlst( &oprtbl[2] );
  1142. printf("\n");
  1143. return(0.0);
  1144. }
  1145.  
  1146.  
  1147. cmdh()
  1148. {
  1149.  
  1150. prhlst( menstk[menptr] );
  1151. printf( "\n" );
  1152. return(0.0);
  1153. }
  1154.  
  1155. /* print keyword spellings */
  1156.  
  1157. prhlst(ps)
  1158. register struct symbol *ps;
  1159. {
  1160. register int j, k;
  1161. int m;
  1162.  
  1163. j = 0;
  1164. while( *(ps->spel) != '\0' )
  1165.     {
  1166.     k = strlen( ps->spel )  -  1;
  1167. /* size of a tab field is 2**3 chars */
  1168.     m = ((k >> 3) + 1) << 3;
  1169.     j += m;
  1170.     if( j > 72 )
  1171.         {
  1172.         printf( "\n" );
  1173.         j = m;
  1174.         }
  1175.     printf( "%s\t", ps->spel );
  1176.     ++ps;
  1177.     }
  1178. }
  1179.  
  1180.  
  1181. #if SALONE
  1182. init(){}
  1183. #endif
  1184.  
  1185.  
  1186. /*    macro commands */
  1187.  
  1188. /*    define macro */
  1189. cmddm(arg)
  1190. int arg;
  1191. {
  1192.  
  1193. zgets( maclin, TRUE );
  1194. return(0.0);
  1195. }
  1196.  
  1197. /*    type (i.e., display) macro */
  1198. cmdtm(arg)
  1199. int arg;
  1200. {
  1201.  
  1202. printf( "%s\n", maclin );
  1203. return(0.0);
  1204. }
  1205.  
  1206. /*    execute macro # times */
  1207. cmdem( arg )
  1208. int *arg;
  1209. {
  1210. double dn;
  1211. int n;
  1212.  
  1213. qtoe( arg, &dn );
  1214. n = dn;
  1215. if( n <= 0 )
  1216.     n = 1;
  1217. maccnt = n;
  1218. return( n );
  1219. }
  1220.  
  1221.  
  1222. /* open a take file */
  1223.  
  1224. take( fname )
  1225. char *fname;
  1226. {
  1227. FILE *f;
  1228. register int i;
  1229.  
  1230. while( *fname == ' ' )
  1231.     fname += 1;
  1232. f = fopen( fname, "r" );
  1233.  
  1234. if( f == 0 )
  1235.     {
  1236. takerr:
  1237.     printf( "Can't open take file %s\n", fname );
  1238.     takptr = -1;    /* terminate all take file input */
  1239.     return(-1);
  1240.     }
  1241. takptr += 1;
  1242. takstk[ takptr ]  =  f;
  1243. printf( "Running %s\n", fname );
  1244. return(0.0);
  1245. }
  1246.  
  1247.  
  1248. /*    abort macro execution */
  1249. abmac()
  1250. {
  1251.  
  1252. maccnt = 0;
  1253. interl = line;
  1254. }
  1255.  
  1256.  
  1257. /* display integer part in hex, octal, and decimal
  1258.  */
  1259.  
  1260. hex(qx)
  1261. short *qx;
  1262. {
  1263. long z;
  1264. double x;
  1265. double fabs();
  1266.  
  1267. qtoe( qx, &x );
  1268. if( fabs(x) >= 2.147483648e9 )
  1269.     {
  1270.     printf( "hex: too large\n" );
  1271.     return(x);
  1272.     }
  1273.  
  1274. z = x;
  1275. printf( "0%lo  0x%lx  %ld.\n", z, z, z );
  1276. return(x);
  1277. }
  1278.  
  1279.  
  1280. int bits( x )
  1281. short x[];
  1282. {
  1283. int i, j;
  1284.  
  1285. j = 0;
  1286. for( i=0; i<NQ; i++ )
  1287.     {
  1288.     printf( "0x%04x,", x[i] & 0xffff );
  1289.     if( ++j > 7 )
  1290.         {
  1291.         j = 0;
  1292.         printf( "\n" );
  1293.         }
  1294.     }
  1295. printf( "\n" );
  1296.  
  1297. /* display IEEE format double precision version */
  1298. todbl( x );
  1299.  
  1300. return(0);
  1301. }
  1302.  
  1303.  
  1304. /* Exit to monitor. */
  1305. mxit()
  1306. {
  1307.  
  1308. if( savfil )
  1309.     fclose( savfil );
  1310. exit(0);
  1311. }
  1312.  
  1313.  
  1314. cmddig( x )
  1315. short x[];
  1316. {
  1317. double dx;
  1318.  
  1319. qtoe( x, &dx );
  1320. ndigits = dx;
  1321. if( ndigits <= 0 )
  1322.     ndigits = DEFDIS;
  1323. return(0);
  1324. }
  1325.  
  1326.  
  1327.  
  1328. todbl( u )
  1329. short u[];
  1330. {
  1331. short x[NQ+1];
  1332. long e;
  1333. int i;
  1334.  
  1335. qmovz( u, x );
  1336. shup1(x);
  1337. shup1(x);
  1338. shup1(x);
  1339. shup1(x);
  1340. shup1(x);
  1341.  
  1342. e = x[1];
  1343. e = e - 040001 + 0x3ff;
  1344. if( e < -101 )
  1345.     {
  1346.     qclear(x );
  1347.     goto display;
  1348.     }
  1349. /* denormalize if exponent is nonpositive */
  1350. if( e <= 0 )
  1351.     {
  1352.     while( e <= 0 )
  1353.         {
  1354.         shdn1(x);
  1355.         e += 1;
  1356.         }
  1357.     e = 0;
  1358.     }
  1359. e = (e << 4) & 0x7ff0;
  1360. if( x[0] )
  1361.     e |= 0x8000;
  1362. x[2] &= 0xf;
  1363. x[2] |= e;
  1364.  
  1365. display:
  1366.  
  1367. for( i=0; i<6; i++ )
  1368.     printf( "%04x ", x[7-i] & 0xffff );
  1369. printf( "\n" );
  1370.  
  1371. qtoe( u, x );
  1372. for( i=0; i<4; i++ )
  1373.     printf( "%04x ", x[i] & 0xffff );
  1374. printf( "\n" );
  1375. }
  1376.  
  1377.  
  1378. qsave(x)
  1379. char *x;
  1380. {
  1381.  
  1382. if( savfil )
  1383.     fclose( savfil );
  1384. while( *x == ' ' )
  1385.     x += 1;
  1386. if( *x == '\0' )
  1387.     savnam = "calc.sav";
  1388. else
  1389.     savnam    = x;
  1390. savfil = fopen( savnam, "w" );
  1391. if( savfil <= 0 )
  1392.     printf( "Error opening %s\n", savnam );
  1393. }
  1394.  
  1395.  
  1396.  
  1397. qsys(x)
  1398. char *x;
  1399. {
  1400.  
  1401. system( x+1 );
  1402. cmdh();
  1403. }
  1404.