home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / pascal2c / basic.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-03  |  54.4 KB  |  2,798 lines
  1. /* Output from p2c, the Pascal-to-C translator */
  2. /* From input file "dist/examples/basic.p" */
  3.  
  4.  
  5. /*$ debug$*/
  6.  
  7.  
  8.  
  9. #include <p2c/p2c.h>
  10.  
  11.  
  12.  
  13. #define checking        true
  14.  
  15. #define varnamelen      20
  16. #define maxdims         4
  17.  
  18.  
  19.  
  20.  
  21. typedef Char varnamestring[varnamelen + 1];
  22.  
  23.  
  24. typedef Char string255[256];
  25.  
  26. #define tokvar          0
  27. #define toknum          1
  28. #define tokstr          2
  29. #define toksnerr        3
  30. #define tokplus         4
  31. #define tokminus        5
  32. #define toktimes        6
  33. #define tokdiv          7
  34. #define tokup           8
  35. #define toklp           9
  36. #define tokrp           10
  37. #define tokcomma        11
  38. #define toksemi         12
  39. #define tokcolon        13
  40. #define tokeq           14
  41. #define toklt           15
  42. #define tokgt           16
  43. #define tokle           17
  44. #define tokge           18
  45. #define tokne           19
  46. #define tokand          20
  47. #define tokor           21
  48. #define tokxor          22
  49. #define tokmod          23
  50. #define toknot          24
  51. #define toksqr          25
  52. #define toksqrt         26
  53. #define toksin          27
  54. #define tokcos          28
  55. #define toktan          29
  56. #define tokarctan       30
  57. #define toklog          31
  58. #define tokexp          32
  59. #define tokabs          33
  60. #define toksgn          34
  61. #define tokstr_         35
  62. #define tokval          36
  63. #define tokchr_         37
  64. #define tokasc          38
  65. #define toklen          39
  66. #define tokmid_         40
  67. #define tokpeek         41
  68. #define tokrem          42
  69. #define toklet          43
  70. #define tokprint        44
  71. #define tokinput        45
  72. #define tokgoto         46
  73. #define tokif           47
  74. #define tokend          48
  75. #define tokstop         49
  76. #define tokfor          50
  77. #define toknext         51
  78. #define tokwhile        52
  79. #define tokwend         53
  80. #define tokgosub        54
  81. #define tokreturn       55
  82. #define tokread         56
  83. #define tokdata         57
  84. #define tokrestore      58
  85. #define tokgotoxy       59
  86. #define tokon           60
  87. #define tokdim          61
  88. #define tokpoke         62
  89. #define toklist         63
  90. #define tokrun          64
  91. #define toknew          65
  92. #define tokload         66
  93. #define tokmerge        67
  94. #define toksave         68
  95. #define tokbye          69
  96. #define tokdel          70
  97. #define tokrenum        71
  98. #define tokthen         72
  99. #define tokelse         73
  100. #define tokto           74
  101. #define tokstep         75
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109. typedef double numarray[];
  110. typedef Char *strarray[];
  111.  
  112. #define forloop         0
  113. #define whileloop       1
  114. #define gosubloop       2
  115.  
  116.  
  117. typedef struct tokenrec {
  118.   struct tokenrec *next;
  119.   short kind;
  120.   union {
  121.     struct varrec *vp;
  122.     double num;
  123.     Char *sp;
  124.     Char snch;
  125.   } UU;
  126. } tokenrec;
  127.  
  128. typedef struct linerec {
  129.   long num, num2;
  130.   tokenrec *txt;
  131.   struct linerec *next;
  132. } linerec;
  133.  
  134. typedef struct varrec {
  135.   varnamestring name;
  136.   struct varrec *next;
  137.   long dims[maxdims];
  138.   char numdims;
  139.   boolean stringvar;
  140.   union {
  141.     struct {
  142.       double *arr;
  143.       double *val, rv;
  144.     } U0;
  145.     struct {
  146.       Char **sarr;
  147.       Char **sval, *sv;
  148.     } U1;
  149.   } UU;
  150. } varrec;
  151.  
  152. typedef struct valrec {
  153.   boolean stringval;
  154.   union {
  155.     double val;
  156.     Char *sval;
  157.   } UU;
  158. } valrec;
  159.  
  160. typedef struct looprec {
  161.   struct looprec *next;
  162.   linerec *homeline;
  163.   tokenrec *hometok;
  164.   short kind;
  165.   union {
  166.     struct {
  167.       varrec *vp;
  168.       double max, step;
  169.     } U0;
  170.   } UU;
  171. } looprec;
  172.  
  173.  
  174.  
  175.  
  176. Static Char *inbuf;
  177.  
  178. Static linerec *linebase;
  179. Static varrec *varbase;
  180. Static looprec *loopbase;
  181.  
  182. Static long curline;
  183. Static linerec *stmtline, *dataline;
  184. Static tokenrec *stmttok, *datatok, *buf;
  185.  
  186. Static boolean exitflag;
  187.  
  188. extern long EXCP_LINE;
  189.  
  190.  
  191.  
  192. /*$if not checking$
  193.    $range off$
  194. $end$*/
  195.  
  196.  
  197.  
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206. Static Void restoredata()
  207. {
  208.   dataline = NULL;
  209.   datatok = NULL;
  210. }
  211.  
  212.  
  213.  
  214. Static Void clearloops()
  215. {
  216.   looprec *l;
  217.  
  218.   while (loopbase != NULL) {
  219.     l = loopbase->next;
  220.     Free(loopbase);
  221.     loopbase = l;
  222.   }
  223. }
  224.  
  225.  
  226.  
  227. Static long arraysize(v)
  228. varrec *v;
  229. {
  230.   long i, j, FORLIM;
  231.  
  232.   if (v->stringvar)
  233.     j = 4;
  234.   else
  235.     j = 8;
  236.   FORLIM = v->numdims;
  237.   for (i = 0; i < FORLIM; i++)
  238.     j *= v->dims[i];
  239.   return j;
  240. }
  241.  
  242.  
  243. Static Void clearvar(v)
  244. varrec *v;
  245. {
  246.   if (v->numdims != 0)
  247.     Free(v->UU.U0.arr);
  248.   else if (v->stringvar && v->UU.U1.sv != NULL)
  249.     Free(v->UU.U1.sv);
  250.   v->numdims = 0;
  251.   if (v->stringvar) {
  252.     v->UU.U1.sv = NULL;
  253.     v->UU.U1.sval = &v->UU.U1.sv;
  254.   } else {
  255.     v->UU.U0.rv = 0.0;
  256.     v->UU.U0.val = &v->UU.U0.rv;
  257.   }
  258. }
  259.  
  260.  
  261. Static Void clearvars()
  262. {
  263.   varrec *v;
  264.  
  265.   v = varbase;
  266.   while (v != NULL) {
  267.     clearvar(v);
  268.     v = v->next;
  269.   }
  270. }
  271.  
  272.  
  273.  
  274. Static Char *numtostr(Result, n)
  275. Char *Result;
  276. double n;
  277. {
  278.   string255 s;
  279.   long i;
  280.  
  281.   s[255] = '\0';
  282.   if (n != 0 && fabs(n) < 1e-2 || fabs(n) >= 1e12) {
  283.     sprintf(s, "% .5E", n);
  284.     i = strlen(s) + 1;
  285.     s[i - 1] = '\0';
  286. /* p2c: dist/examples/basic.p, line 237:
  287.  * Note: Modification of string length may translate incorrectly [146] */
  288.     return strcpy(Result, s);
  289.   } else {
  290.     sprintf(s, "%30.10f", n);
  291.     i = strlen(s) + 1;
  292.     do {
  293.       i--;
  294.     } while (s[i - 1] == '0');
  295.     if (s[i - 1] == '.')
  296.       i--;
  297.     s[i] = '\0';
  298. /* p2c: dist/examples/basic.p, line 248:
  299.  * Note: Modification of string length may translate incorrectly [146] */
  300.     return strcpy(Result, strltrim(s));
  301.   }
  302. }
  303.  
  304.  
  305. #define toklength       20
  306.  
  307.  
  308. typedef long chset[9];
  309.  
  310.  
  311.  
  312.  
  313.  
  314. Static Void parse(inbuf, buf)
  315. Char *inbuf;
  316. tokenrec **buf;
  317. {
  318.   long i, j, k;
  319.   Char token[toklength + 1];
  320.   tokenrec *t, *tptr;
  321.   varrec *v;
  322.   Char ch;
  323.   double n, d, d1;
  324.  
  325.   tptr = NULL;
  326.   *buf = NULL;
  327.   i = 1;
  328.   do {
  329.     ch = ' ';
  330.     while (i <= strlen(inbuf) && ch == ' ') {
  331.       ch = inbuf[i - 1];
  332.       i++;
  333.     }
  334.     if (ch != ' ') {
  335.       t = (tokenrec *)Malloc(sizeof(tokenrec));
  336.       if (tptr == NULL)
  337.     *buf = t;
  338.       else
  339.     tptr->next = t;
  340.       tptr = t;
  341.       t->next = NULL;
  342.       switch (ch) {
  343.  
  344.       case '"':
  345.       case '\'':
  346.     t->kind = tokstr;
  347.     t->UU.sp = (Char *)Malloc(256);
  348.     t->UU.sp[255] = '\0';
  349.     j = 0;
  350.     while (i <= strlen(inbuf) && inbuf[i - 1] != ch) {
  351.       j++;
  352.       t->UU.sp[j - 1] = inbuf[i - 1];
  353.       i++;
  354.     }
  355.     t->UU.sp[j] = '\0';
  356. /* p2c: dist/examples/basic.p, line 415:
  357.  * Note: Modification of string length may translate incorrectly [146] */
  358.     i++;
  359.     break;
  360.  
  361.       case '+':
  362.     t->kind = tokplus;
  363.     break;
  364.  
  365.       case '-':
  366.     t->kind = tokminus;
  367.     break;
  368.  
  369.       case '*':
  370.     t->kind = toktimes;
  371.     break;
  372.  
  373.       case '/':
  374.     t->kind = tokdiv;
  375.     break;
  376.  
  377.       case '^':
  378.     t->kind = tokup;
  379.     break;
  380.  
  381.       case '(':
  382.       case '[':
  383.     t->kind = toklp;
  384.     break;
  385.  
  386.       case ')':
  387.       case ']':
  388.     t->kind = tokrp;
  389.     break;
  390.  
  391.       case ',':
  392.     t->kind = tokcomma;
  393.     break;
  394.  
  395.       case ';':
  396.     t->kind = toksemi;
  397.     break;
  398.  
  399.       case ':':
  400.     t->kind = tokcolon;
  401.     break;
  402.  
  403.       case '?':
  404.     t->kind = tokprint;
  405.     break;
  406.  
  407.       case '=':
  408.     t->kind = tokeq;
  409.     break;
  410.  
  411.       case '<':
  412.     if (i <= strlen(inbuf) && inbuf[i - 1] == '=') {
  413.       t->kind = tokle;
  414.       i++;
  415.     } else if (i <= strlen(inbuf) && inbuf[i - 1] == '>') {
  416.       t->kind = tokne;
  417.       i++;
  418.     } else
  419.       t->kind = toklt;
  420.     break;
  421.  
  422.       case '>':
  423.     if (i <= strlen(inbuf) && inbuf[i - 1] == '=') {
  424.       t->kind = tokge;
  425.       i++;
  426.     } else
  427.       t->kind = tokgt;
  428.     break;
  429.  
  430.       default:
  431.     if (isalpha(ch)) {
  432.       i--;
  433.       j = 0;
  434.       token[toklength] = '\0';
  435.       while (i <= strlen(inbuf) &&
  436.          (inbuf[i - 1] == '$' || inbuf[i - 1] == '_' ||
  437.           isalnum(inbuf[i - 1]))) {
  438.         if (j < toklength) {
  439.           j++;
  440.           token[j - 1] = inbuf[i - 1];
  441.         }
  442.         i++;
  443.       }
  444.       token[j] = '\0';
  445. /* p2c: dist/examples/basic.p, line 309:
  446.  * Note: Modification of string length may translate incorrectly [146] */
  447.       if (!strcmp(token, "and") || !strcmp(token, "AND"))
  448.         t->kind = tokand;
  449.       else if (!strcmp(token, "or") || !strcmp(token, "OR"))
  450.         t->kind = tokor;
  451.       else if (!strcmp(token, "xor") || !strcmp(token, "XOR"))
  452.         t->kind = tokxor;
  453.       else if (!strcmp(token, "not") || !strcmp(token, "NOT"))
  454.         t->kind = toknot;
  455.       else if (!strcmp(token, "mod") || !strcmp(token, "MOD"))
  456.         t->kind = tokmod;
  457.       else if (!strcmp(token, "sqr") || !strcmp(token, "SQR"))
  458.         t->kind = toksqr;
  459.       else if (!strcmp(token, "sqrt") || !strcmp(token, "SQRT"))
  460.         t->kind = toksqrt;
  461.       else if (!strcmp(token, "sin") || !strcmp(token, "SIN"))
  462.         t->kind = toksin;
  463.       else if (!strcmp(token, "cos") || !strcmp(token, "COS"))
  464.         t->kind = tokcos;
  465.       else if (!strcmp(token, "tan") || !strcmp(token, "TAN"))
  466.         t->kind = toktan;
  467.       else if (!strcmp(token, "arctan") || !strcmp(token, "ARCTAN"))
  468.         t->kind = tokarctan;
  469.       else if (!strcmp(token, "log") || !strcmp(token, "LOG"))
  470.         t->kind = toklog;
  471.       else if (!strcmp(token, "exp") || !strcmp(token, "EXP"))
  472.         t->kind = tokexp;
  473.       else if (!strcmp(token, "abs") || !strcmp(token, "ABS"))
  474.         t->kind = tokabs;
  475.       else if (!strcmp(token, "sgn") || !strcmp(token, "SGN"))
  476.         t->kind = toksgn;
  477.       else if (!strcmp(token, "str$") || !strcmp(token, "STR$"))
  478.         t->kind = tokstr_;
  479.       else if (!strcmp(token, "val") || !strcmp(token, "VAL"))
  480.         t->kind = tokval;
  481.       else if (!strcmp(token, "chr$") || !strcmp(token, "CHR$"))
  482.         t->kind = tokchr_;
  483.       else if (!strcmp(token, "asc") || !strcmp(token, "ASC"))
  484.         t->kind = tokasc;
  485.       else if (!strcmp(token, "len") || !strcmp(token, "LEN"))
  486.         t->kind = toklen;
  487.       else if (!strcmp(token, "mid$") || !strcmp(token, "MID$"))
  488.         t->kind = tokmid_;
  489.       else if (!strcmp(token, "peek") || !strcmp(token, "PEEK"))
  490.         t->kind = tokpeek;
  491.       else if (!strcmp(token, "let") || !strcmp(token, "LET"))
  492.         t->kind = toklet;
  493.       else if (!strcmp(token, "print") || !strcmp(token, "PRINT"))
  494.         t->kind = tokprint;
  495.       else if (!strcmp(token, "input") || !strcmp(token, "INPUT"))
  496.         t->kind = tokinput;
  497.       else if (!strcmp(token, "goto") || !strcmp(token, "GOTO"))
  498.         t->kind = tokgoto;
  499.       else if (!strcmp(token, "go to") || !strcmp(token, "GO TO"))
  500.         t->kind = tokgoto;
  501.       else if (!strcmp(token, "if") || !strcmp(token, "IF"))
  502.         t->kind = tokif;
  503.       else if (!strcmp(token, "end") || !strcmp(token, "END"))
  504.         t->kind = tokend;
  505.       else if (!strcmp(token, "stop") || !strcmp(token, "STOP"))
  506.         t->kind = tokstop;
  507.       else if (!strcmp(token, "for") || !strcmp(token, "FOR"))
  508.         t->kind = tokfor;
  509.       else if (!strcmp(token, "next") || !strcmp(token, "NEXT"))
  510.         t->kind = toknext;
  511.       else if (!strcmp(token, "while") || !strcmp(token, "WHILE"))
  512.         t->kind = tokwhile;
  513.       else if (!strcmp(token, "wend") || !strcmp(token, "WEND"))
  514.         t->kind = tokwend;
  515.       else if (!strcmp(token, "gosub") || !strcmp(token, "GOSUB"))
  516.         t->kind = tokgosub;
  517.       else if (!strcmp(token, "return") || !strcmp(token, "RETURN"))
  518.         t->kind = tokreturn;
  519.       else if (!strcmp(token, "read") || !strcmp(token, "READ"))
  520.         t->kind = tokread;
  521.       else if (!strcmp(token, "data") || !strcmp(token, "DATA"))
  522.         t->kind = tokdata;
  523.       else if (!strcmp(token, "restore") || !strcmp(token, "RESTORE"))
  524.         t->kind = tokrestore;
  525.       else if (!strcmp(token, "gotoxy") || !strcmp(token, "GOTOXY"))
  526.         t->kind = tokgotoxy;
  527.       else if (!strcmp(token, "on") || !strcmp(token, "ON"))
  528.         t->kind = tokon;
  529.       else if (!strcmp(token, "dim") || !strcmp(token, "DIM"))
  530.         t->kind = tokdim;
  531.       else if (!strcmp(token, "poke") || !strcmp(token, "POKE"))
  532.         t->kind = tokpoke;
  533.       else if (!strcmp(token, "list") || !strcmp(token, "LIST"))
  534.         t->kind = toklist;
  535.       else if (!strcmp(token, "run") || !strcmp(token, "RUN"))
  536.         t->kind = tokrun;
  537.       else if (!strcmp(token, "new") || !strcmp(token, "NEW"))
  538.         t->kind = toknew;
  539.       else if (!strcmp(token, "load") || !strcmp(token, "LOAD"))
  540.         t->kind = tokload;
  541.       else if (!strcmp(token, "merge") || !strcmp(token, "MERGE"))
  542.         t->kind = tokmerge;
  543.       else if (!strcmp(token, "save") || !strcmp(token, "SAVE"))
  544.         t->kind = toksave;
  545.       else if (!strcmp(token, "bye") || !strcmp(token, "BYE"))
  546.         t->kind = tokbye;
  547.       else if (!strcmp(token, "quit") || !strcmp(token, "QUIT"))
  548.         t->kind = tokbye;
  549.       else if (!strcmp(token, "del") || !strcmp(token, "DEL"))
  550.         t->kind = tokdel;
  551.       else if (!strcmp(token, "renum") || !strcmp(token, "RENUM"))
  552.         t->kind = tokrenum;
  553.       else if (!strcmp(token, "then") || !strcmp(token, "THEN"))
  554.         t->kind = tokthen;
  555.       else if (!strcmp(token, "else") || !strcmp(token, "ELSE"))
  556.         t->kind = tokelse;
  557.       else if (!strcmp(token, "to") || !strcmp(token, "TO"))
  558.         t->kind = tokto;
  559.       else if (!strcmp(token, "step") || !strcmp(token, "STEP"))
  560.         t->kind = tokstep;
  561.       else if (!strcmp(token, "rem") || !strcmp(token, "REM")) {
  562.         t->kind = tokrem;
  563.         t->UU.sp = (Char *)Malloc(256);
  564.         sprintf(t->UU.sp, "%.*s",
  565.             (int)(strlen(inbuf) - i + 1), inbuf + i - 1);
  566.         i = strlen(inbuf) + 1;
  567.       } else {
  568.         t->kind = tokvar;
  569.         v = varbase;
  570.         while (v != NULL && strcmp(v->name, token))
  571.           v = v->next;
  572.         if (v == NULL) {
  573.           v = (varrec *)Malloc(sizeof(varrec));
  574.           v->next = varbase;
  575.           varbase = v;
  576.           strcpy(v->name, token);
  577.           v->numdims = 0;
  578.           if (token[strlen(token) - 1] == '$') {
  579.         v->stringvar = true;
  580.         v->UU.U1.sv = NULL;
  581.         v->UU.U1.sval = &v->UU.U1.sv;
  582.           } else {
  583.         v->stringvar = false;
  584.         v->UU.U0.rv = 0.0;
  585.         v->UU.U0.val = &v->UU.U0.rv;
  586.           }
  587.         }
  588.         t->UU.vp = v;
  589.       }
  590.     } else if (isdigit(ch) || ch == '.') {
  591.       t->kind = toknum;
  592.       n = 0.0;
  593.       d = 1.0;
  594.       d1 = 1.0;
  595.       i--;
  596.       while (i <= strlen(inbuf) &&
  597.          (isdigit(inbuf[i - 1]) || inbuf[i - 1] == '.' && d1 == 1)) {
  598.         if (inbuf[i - 1] == '.')
  599.           d1 = 10.0;
  600.         else {
  601.           n = n * 10 + inbuf[i - 1] - 48;
  602.           d *= d1;
  603.         }
  604.         i++;
  605.       }
  606.       n /= d;
  607.       if (i <= strlen(inbuf) &&
  608.           (inbuf[i - 1] == 'E' || inbuf[i - 1] == 'e')) {
  609.         i++;
  610.         d1 = 10.0;
  611.         if (i <= strlen(inbuf) &&
  612.         (inbuf[i - 1] == '-' || inbuf[i - 1] == '+')) {
  613.           if (inbuf[i - 1] == '-')
  614.         d1 = 0.1;
  615.           i++;
  616.         }
  617.         j = 0;
  618.         while (i <= strlen(inbuf) && isdigit(inbuf[i - 1])) {
  619.           j = j * 10 + inbuf[i - 1] - 48;
  620.           i++;
  621.         }
  622.         for (k = 1; k <= j; k++)
  623.           n *= d1;
  624.       }
  625.       t->UU.num = n;
  626.     } else {
  627.       t->kind = toksnerr;
  628.       t->UU.snch = ch;
  629.     }
  630.     break;
  631.       }
  632.     }
  633.   } while (i <= strlen(inbuf));
  634. }
  635.  
  636. #undef toklength
  637.  
  638.  
  639.  
  640. Static Void listtokens(f, buf)
  641. FILE *f;
  642. tokenrec *buf;
  643. {
  644.   boolean ltr;
  645.   Char STR1[256];
  646.  
  647.   ltr = false;
  648.   while (buf != NULL) {
  649.     if ((long)buf->kind >= toknot && (long)buf->kind <= tokrenum ||
  650.     buf->kind == toknum || buf->kind == tokvar) {
  651.       if (ltr)
  652.     putc(' ', f);
  653.       ltr = (buf->kind != toknot);
  654.     } else
  655.       ltr = false;
  656.     switch (buf->kind) {
  657.  
  658.     case tokvar:
  659.       fputs(buf->UU.vp->name, f);
  660.       break;
  661.  
  662.     case toknum:
  663.       fputs(numtostr(STR1, buf->UU.num), f);
  664.       break;
  665.  
  666.     case tokstr:
  667.       fprintf(f, "\"%s\"", buf->UU.sp);
  668.       break;
  669.  
  670.     case toksnerr:
  671.       fprintf(f, "{%c}", buf->UU.snch);
  672.       break;
  673.  
  674.     case tokplus:
  675.       putc('+', f);
  676.       break;
  677.  
  678.     case tokminus:
  679.       putc('-', f);
  680.       break;
  681.  
  682.     case toktimes:
  683.       putc('*', f);
  684.       break;
  685.  
  686.     case tokdiv:
  687.       putc('/', f);
  688.       break;
  689.  
  690.     case tokup:
  691.       putc('^', f);
  692.       break;
  693.  
  694.     case toklp:
  695.       putc('(', f);
  696.       break;
  697.  
  698.     case tokrp:
  699.       putc(')', f);
  700.       break;
  701.  
  702.     case tokcomma:
  703.       putc(',', f);
  704.       break;
  705.  
  706.     case toksemi:
  707.       putc(';', f);
  708.       break;
  709.  
  710.     case tokcolon:
  711.       fprintf(f, " : ");
  712.       break;
  713.  
  714.     case tokeq:
  715.       fprintf(f, " = ");
  716.       break;
  717.  
  718.     case toklt:
  719.       fprintf(f, " < ");
  720.       break;
  721.  
  722.     case tokgt:
  723.       fprintf(f, " > ");
  724.       break;
  725.  
  726.     case tokle:
  727.       fprintf(f, " <= ");
  728.       break;
  729.  
  730.     case tokge:
  731.       fprintf(f, " >= ");
  732.       break;
  733.  
  734.     case tokne:
  735.       fprintf(f, " <> ");
  736.       break;
  737.  
  738.     case tokand:
  739.       fprintf(f, " AND ");
  740.       break;
  741.  
  742.     case tokor:
  743.       fprintf(f, " OR ");
  744.       break;
  745.  
  746.     case tokxor:
  747.       fprintf(f, " XOR ");
  748.       break;
  749.  
  750.     case tokmod:
  751.       fprintf(f, " MOD ");
  752.       break;
  753.  
  754.     case toknot:
  755.       fprintf(f, "NOT ");
  756.       break;
  757.  
  758.     case toksqr:
  759.       fprintf(f, "SQR");
  760.       break;
  761.  
  762.     case toksqrt:
  763.       fprintf(f, "SQRT");
  764.       break;
  765.  
  766.     case toksin:
  767.       fprintf(f, "SIN");
  768.       break;
  769.  
  770.     case tokcos:
  771.       fprintf(f, "COS");
  772.       break;
  773.  
  774.     case toktan:
  775.       fprintf(f, "TAN");
  776.       break;
  777.  
  778.     case tokarctan:
  779.       fprintf(f, "ARCTAN");
  780.       break;
  781.  
  782.     case toklog:
  783.       fprintf(f, "LOG");
  784.       break;
  785.  
  786.     case tokexp:
  787.       fprintf(f, "EXP");
  788.       break;
  789.  
  790.     case tokabs:
  791.       fprintf(f, "ABS");
  792.       break;
  793.  
  794.     case toksgn:
  795.       fprintf(f, "SGN");
  796.       break;
  797.  
  798.     case tokstr_:
  799.       fprintf(f, "STR$");
  800.       break;
  801.  
  802.     case tokval:
  803.       fprintf(f, "VAL");
  804.       break;
  805.  
  806.     case tokchr_:
  807.       fprintf(f, "CHR$");
  808.       break;
  809.  
  810.     case tokasc:
  811.       fprintf(f, "ASC");
  812.       break;
  813.  
  814.     case toklen:
  815.       fprintf(f, "LEN");
  816.       break;
  817.  
  818.     case tokmid_:
  819.       fprintf(f, "MID$");
  820.       break;
  821.  
  822.     case tokpeek:
  823.       fprintf(f, "PEEK");
  824.       break;
  825.  
  826.     case toklet:
  827.       fprintf(f, "LET");
  828.       break;
  829.  
  830.     case tokprint:
  831.       fprintf(f, "PRINT");
  832.       break;
  833.  
  834.     case tokinput:
  835.       fprintf(f, "INPUT");
  836.       break;
  837.  
  838.     case tokgoto:
  839.       fprintf(f, "GOTO");
  840.       break;
  841.  
  842.     case tokif:
  843.       fprintf(f, "IF");
  844.       break;
  845.  
  846.     case tokend:
  847.       fprintf(f, "END");
  848.       break;
  849.  
  850.     case tokstop:
  851.       fprintf(f, "STOP");
  852.       break;
  853.  
  854.     case tokfor:
  855.       fprintf(f, "FOR");
  856.       break;
  857.  
  858.     case toknext:
  859.       fprintf(f, "NEXT");
  860.       break;
  861.  
  862.     case tokwhile:
  863.       fprintf(f, "WHILE");
  864.       break;
  865.  
  866.     case tokwend:
  867.       fprintf(f, "WEND");
  868.       break;
  869.  
  870.     case tokgosub:
  871.       fprintf(f, "GOSUB");
  872.       break;
  873.  
  874.     case tokreturn:
  875.       fprintf(f, "RETURN");
  876.       break;
  877.  
  878.     case tokread:
  879.       fprintf(f, "READ");
  880.       break;
  881.  
  882.     case tokdata:
  883.       fprintf(f, "DATA");
  884.       break;
  885.  
  886.     case tokrestore:
  887.       fprintf(f, "RESTORE");
  888.       break;
  889.  
  890.     case tokgotoxy:
  891.       fprintf(f, "GOTOXY");
  892.       break;
  893.  
  894.     case tokon:
  895.       fprintf(f, "ON");
  896.       break;
  897.  
  898.     case tokdim:
  899.       fprintf(f, "DIM");
  900.       break;
  901.  
  902.     case tokpoke:
  903.       fprintf(f, "POKE");
  904.       break;
  905.  
  906.     case toklist:
  907.       fprintf(f, "LIST");
  908.       break;
  909.  
  910.     case tokrun:
  911.       fprintf(f, "RUN");
  912.       break;
  913.  
  914.     case toknew:
  915.       fprintf(f, "NEW");
  916.       break;
  917.  
  918.     case tokload:
  919.       fprintf(f, "LOAD");
  920.       break;
  921.  
  922.     case tokmerge:
  923.       fprintf(f, "MERGE");
  924.       break;
  925.  
  926.     case toksave:
  927.       fprintf(f, "SAVE");
  928.       break;
  929.  
  930.     case tokdel:
  931.       fprintf(f, "DEL");
  932.       break;
  933.  
  934.     case tokbye:
  935.       fprintf(f, "BYE");
  936.       break;
  937.  
  938.     case tokrenum:
  939.       fprintf(f, "RENUM");
  940.       break;
  941.  
  942.     case tokthen:
  943.       fprintf(f, " THEN ");
  944.       break;
  945.  
  946.     case tokelse:
  947.       fprintf(f, " ELSE ");
  948.       break;
  949.  
  950.     case tokto:
  951.       fprintf(f, " TO ");
  952.       break;
  953.  
  954.     case tokstep:
  955.       fprintf(f, " STEP ");
  956.       break;
  957.  
  958.     case tokrem:
  959.       fprintf(f, "REM%s", buf->UU.sp);
  960.       break;
  961.     }
  962.     buf = buf->next;
  963.   }
  964. }
  965.  
  966.  
  967.  
  968. Static Void disposetokens(tok)
  969. tokenrec **tok;
  970. {
  971.   tokenrec *tok1;
  972.  
  973.   while (*tok != NULL) {
  974.     tok1 = (*tok)->next;
  975.     if ((*tok)->kind == tokrem || (*tok)->kind == tokstr)
  976.       Free((*tok)->UU.sp);
  977.     Free(*tok);
  978.     *tok = tok1;
  979.   }
  980. }
  981.  
  982.  
  983.  
  984. Static Void parseinput(buf)
  985. tokenrec **buf;
  986. {
  987.   linerec *l, *l0, *l1;
  988.   Char STR1[256];
  989.  
  990.   strcpy(STR1, strltrim(inbuf));
  991.   strcpy(inbuf, STR1);
  992.   curline = 0;
  993.   while (*inbuf != '\0' && isdigit(inbuf[0])) {
  994.     curline = curline * 10 + inbuf[0] - 48;
  995.     strcpy(inbuf, inbuf + 1);
  996.   }
  997.   parse(inbuf, buf);
  998.   if (curline == 0)
  999.     return;
  1000.   l = linebase;
  1001.   l0 = NULL;
  1002.   while (l != NULL && l->num < curline) {
  1003.     l0 = l;
  1004.     l = l->next;
  1005.   }
  1006.   if (l != NULL && l->num == curline) {
  1007.     l1 = l;
  1008.     l = l->next;
  1009.     if (l0 == NULL)
  1010.       linebase = l;
  1011.     else
  1012.       l0->next = l;
  1013.     disposetokens(&l1->txt);
  1014.     Free(l1);
  1015.   }
  1016.   if (*buf != NULL) {
  1017.     l1 = (linerec *)Malloc(sizeof(linerec));
  1018.     l1->next = l;
  1019.     if (l0 == NULL)
  1020.       linebase = l1;
  1021.     else
  1022.       l0->next = l1;
  1023.     l1->num = curline;
  1024.     l1->txt = *buf;
  1025.   }
  1026.   clearloops();
  1027.   restoredata();
  1028. }
  1029.  
  1030.  
  1031.  
  1032.  
  1033.  
  1034. Static Void errormsg(s)
  1035. Char *s;
  1036. {
  1037.   printf("\007%s", s);
  1038.   _Escape(42);
  1039. }
  1040.  
  1041.  
  1042. Static Void snerr()
  1043. {
  1044.   errormsg("Syntax error");
  1045. }
  1046.  
  1047.  
  1048. Static Void tmerr()
  1049. {
  1050.   errormsg("Type mismatch error");
  1051. }
  1052.  
  1053.  
  1054. Static Void badsubscr()
  1055. {
  1056.   errormsg("Bad subscript");
  1057. }
  1058.  
  1059.  
  1060. /* Local variables for exec: */
  1061. struct LOC_exec {
  1062.   boolean gotoflag, elseflag;
  1063.   tokenrec *t;
  1064. } ;
  1065.  
  1066. Local valrec factor PP((struct LOC_exec *LINK));
  1067. Local valrec expr PP((struct LOC_exec *LINK));
  1068.  
  1069. Local double realfactor(LINK)
  1070. struct LOC_exec *LINK;
  1071. {
  1072.   valrec n;
  1073.  
  1074.   n = factor(LINK);
  1075.   if (n.stringval)
  1076.     tmerr();
  1077.   return (n.UU.val);
  1078. }
  1079.  
  1080. Local Char *strfactor(LINK)
  1081. struct LOC_exec *LINK;
  1082. {
  1083.   valrec n;
  1084.  
  1085.   n = factor(LINK);
  1086.   if (!n.stringval)
  1087.     tmerr();
  1088.   return (n.UU.sval);
  1089. }
  1090.  
  1091. Local Char *stringfactor(Result, LINK)
  1092. Char *Result;
  1093. struct LOC_exec *LINK;
  1094. {
  1095.   valrec n;
  1096.  
  1097.   n = factor(LINK);
  1098.   if (!n.stringval)
  1099.     tmerr();
  1100.   strcpy(Result, n.UU.sval);
  1101.   Free(n.UU.sval);
  1102.   return Result;
  1103. }
  1104.  
  1105. Local long intfactor(LINK)
  1106. struct LOC_exec *LINK;
  1107. {
  1108.   return ((long)floor(realfactor(LINK) + 0.5));
  1109. }
  1110.  
  1111. Local double realexpr(LINK)
  1112. struct LOC_exec *LINK;
  1113. {
  1114.   valrec n;
  1115.  
  1116.   n = expr(LINK);
  1117.   if (n.stringval)
  1118.     tmerr();
  1119.   return (n.UU.val);
  1120. }
  1121.  
  1122. Local Char *strexpr(LINK)
  1123. struct LOC_exec *LINK;
  1124. {
  1125.   valrec n;
  1126.  
  1127.   n = expr(LINK);
  1128.   if (!n.stringval)
  1129.     tmerr();
  1130.   return (n.UU.sval);
  1131. }
  1132.  
  1133. Local Char *stringexpr(Result, LINK)
  1134. Char *Result;
  1135. struct LOC_exec *LINK;
  1136. {
  1137.   valrec n;
  1138.  
  1139.   n = expr(LINK);
  1140.   if (!n.stringval)
  1141.     tmerr();
  1142.   strcpy(Result, n.UU.sval);
  1143.   Free(n.UU.sval);
  1144.   return Result;
  1145. }
  1146.  
  1147. Local long intexpr(LINK)
  1148. struct LOC_exec *LINK;
  1149. {
  1150.   return ((long)floor(realexpr(LINK) + 0.5));
  1151. }
  1152.  
  1153.  
  1154. Local Void require(k, LINK)
  1155. short k;
  1156. struct LOC_exec *LINK;
  1157. {
  1158.   if (LINK->t == NULL || LINK->t->kind != k)
  1159.     snerr();
  1160.   LINK->t = LINK->t->next;
  1161. }
  1162.  
  1163.  
  1164. Local Void skipparen(LINK)
  1165. struct LOC_exec *LINK;
  1166. {
  1167.   do {
  1168.     if (LINK->t == NULL)
  1169.       snerr();
  1170.     if (LINK->t->kind == tokrp || LINK->t->kind == tokcomma)
  1171.       goto _L1;
  1172.     if (LINK->t->kind == toklp) {
  1173.       LINK->t = LINK->t->next;
  1174.       skipparen(LINK);
  1175.     }
  1176.     LINK->t = LINK->t->next;
  1177.   } while (true);
  1178. _L1: ;
  1179. }
  1180.  
  1181.  
  1182. Local varrec *findvar(LINK)
  1183. struct LOC_exec *LINK;
  1184. {
  1185.   varrec *v;
  1186.   long i, j, k;
  1187.   tokenrec *tok;
  1188.   long FORLIM;
  1189.  
  1190.   if (LINK->t == NULL || LINK->t->kind != tokvar)
  1191.     snerr();
  1192.   v = LINK->t->UU.vp;
  1193.   LINK->t = LINK->t->next;
  1194.   if (LINK->t == NULL || LINK->t->kind != toklp) {
  1195.     if (v->numdims != 0)
  1196.       badsubscr();
  1197.     return v;
  1198.   }
  1199.   if (v->numdims == 0) {
  1200.     tok = LINK->t;
  1201.     i = 0;
  1202.     j = 1;
  1203.     do {
  1204.       if (i >= maxdims)
  1205.     badsubscr();
  1206.       LINK->t = LINK->t->next;
  1207.       skipparen(LINK);
  1208.       j *= 11;
  1209.       i++;
  1210.       v->dims[i - 1] = 11;
  1211.     } while (LINK->t->kind != tokrp);
  1212.     v->numdims = i;
  1213.     if (v->stringvar) {
  1214.       v->UU.U1.sarr = (Char **)Malloc(j * 4);
  1215.       for (k = 0; k < j; k++)
  1216.     v->UU.U1.sarr[k] = NULL;
  1217.     } else {
  1218.       v->UU.U0.arr = (double *)Malloc(j * 8);
  1219.       for (k = 0; k < j; k++)
  1220.     v->UU.U0.arr[k] = 0.0;
  1221.     }
  1222.     LINK->t = tok;
  1223.   }
  1224.   k = 0;
  1225.   LINK->t = LINK->t->next;
  1226.   FORLIM = v->numdims;
  1227.   for (i = 1; i <= FORLIM; i++) {
  1228.     j = intexpr(LINK);
  1229.     if ((unsigned long)j >= v->dims[i - 1])
  1230.       badsubscr();
  1231.     k = k * v->dims[i - 1] + j;
  1232.     if (i < v->numdims)
  1233.       require(tokcomma, LINK);
  1234.   }
  1235.   require(tokrp, LINK);
  1236.   if (v->stringvar)
  1237.     v->UU.U1.sval = &v->UU.U1.sarr[k];
  1238.   else
  1239.     v->UU.U0.val = &v->UU.U0.arr[k];
  1240.   return v;
  1241. }
  1242.  
  1243.  
  1244. Local long inot(i, LINK)
  1245. long i;
  1246. struct LOC_exec *LINK;
  1247. {
  1248.   return (-i - 1);
  1249. }
  1250.  
  1251. Local long ixor(a, b, LINK)
  1252. long a, b;
  1253. struct LOC_exec *LINK;
  1254. {
  1255.   return ((a & (~b)) | ((~a) & b));
  1256. }
  1257.  
  1258.  
  1259. Local valrec factor(LINK)
  1260. struct LOC_exec *LINK;
  1261. {
  1262.   varrec *v;
  1263.   tokenrec *facttok;
  1264.   valrec n;
  1265.   long i, j;
  1266.   tokenrec *tok, *tok1;
  1267.   Char *s;
  1268.   union {
  1269.     long i;
  1270.     Char *c;
  1271.   } trick;
  1272.   double TEMP;
  1273.   Char STR1[256];
  1274.  
  1275.   if (LINK->t == NULL)
  1276.     snerr();
  1277.   facttok = LINK->t;
  1278.   LINK->t = LINK->t->next;
  1279.   n.stringval = false;
  1280.   switch (facttok->kind) {
  1281.  
  1282.   case toknum:
  1283.     n.UU.val = facttok->UU.num;
  1284.     break;
  1285.  
  1286.   case tokstr:
  1287.     n.stringval = true;
  1288.     n.UU.sval = (Char *)Malloc(256);
  1289.     strcpy(n.UU.sval, facttok->UU.sp);
  1290.     break;
  1291.  
  1292.   case tokvar:
  1293.     LINK->t = facttok;
  1294.     v = findvar(LINK);
  1295.     n.stringval = v->stringvar;
  1296.     if (n.stringval) {
  1297.       n.UU.sval = (Char *)Malloc(256);
  1298.       strcpy(n.UU.sval, *v->UU.U1.sval);
  1299.     } else
  1300.       n.UU.val = *v->UU.U0.val;
  1301.     break;
  1302.  
  1303.   case toklp:
  1304.     n = expr(LINK);
  1305.     require(tokrp, LINK);
  1306.     break;
  1307.  
  1308.   case tokminus:
  1309.     n.UU.val = -realfactor(LINK);
  1310.     break;
  1311.  
  1312.   case tokplus:
  1313.     n.UU.val = realfactor(LINK);
  1314.     break;
  1315.  
  1316.   case toknot:
  1317.     n.UU.val = ~intfactor(LINK);
  1318.     break;
  1319.  
  1320.   case toksqr:
  1321.     TEMP = realfactor(LINK);
  1322.     n.UU.val = TEMP * TEMP;
  1323.     break;
  1324.  
  1325.   case toksqrt:
  1326.     n.UU.val = sqrt(realfactor(LINK));
  1327.     break;
  1328.  
  1329.   case toksin:
  1330.     n.UU.val = sin(realfactor(LINK));
  1331.     break;
  1332.  
  1333.   case tokcos:
  1334.     n.UU.val = cos(realfactor(LINK));
  1335.     break;
  1336.  
  1337.   case toktan:
  1338.     n.UU.val = realfactor(LINK);
  1339.     n.UU.val = sin(n.UU.val) / cos(n.UU.val);
  1340.     break;
  1341.  
  1342.   case tokarctan:
  1343.     n.UU.val = atan(realfactor(LINK));
  1344.     break;
  1345.  
  1346.   case toklog:
  1347.     n.UU.val = log(realfactor(LINK));
  1348.     break;
  1349.  
  1350.   case tokexp:
  1351.     n.UU.val = exp(realfactor(LINK));
  1352.     break;
  1353.  
  1354.   case tokabs:
  1355.     n.UU.val = fabs(realfactor(LINK));
  1356.     break;
  1357.  
  1358.   case toksgn:
  1359.     n.UU.val = realfactor(LINK);
  1360.     n.UU.val = (n.UU.val > 0) - (n.UU.val < 0);
  1361.     break;
  1362.  
  1363.   case tokstr_:
  1364.     n.stringval = true;
  1365.     n.UU.sval = (Char *)Malloc(256);
  1366.     numtostr(n.UU.sval, realfactor(LINK));
  1367.     break;
  1368.  
  1369.   case tokval:
  1370.     s = strfactor(LINK);
  1371.     tok1 = LINK->t;
  1372.     parse(s, &LINK->t);
  1373.     tok = LINK->t;
  1374.     if (tok == NULL)
  1375.       n.UU.val = 0.0;
  1376.     else
  1377.       n = expr(LINK);
  1378.     disposetokens(&tok);
  1379.     LINK->t = tok1;
  1380.     Free(s);
  1381.     break;
  1382.  
  1383.   case tokchr_:
  1384.     n.stringval = true;
  1385.     n.UU.sval = (Char *)Malloc(256);
  1386.     strcpy(n.UU.sval, " ");
  1387.     n.UU.sval[0] = (Char)intfactor(LINK);
  1388.     break;
  1389.  
  1390.   case tokasc:
  1391.     s = strfactor(LINK);
  1392.     if (*s == '\0')
  1393.       n.UU.val = 0.0;
  1394.     else
  1395.       n.UU.val = s[0];
  1396.     Free(s);
  1397.     break;
  1398.  
  1399.   case tokmid_:
  1400.     n.stringval = true;
  1401.     require(toklp, LINK);
  1402.     n.UU.sval = strexpr(LINK);
  1403.     require(tokcomma, LINK);
  1404.     i = intexpr(LINK);
  1405.     if (i < 1)
  1406.       i = 1;
  1407.     j = 255;
  1408.     if (LINK->t != NULL && LINK->t->kind == tokcomma) {
  1409.       LINK->t = LINK->t->next;
  1410.       j = intexpr(LINK);
  1411.     }
  1412.     if (j > strlen(n.UU.sval) - i + 1)
  1413.       j = strlen(n.UU.sval) - i + 1;
  1414.     if (i > strlen(n.UU.sval))
  1415.       *n.UU.sval = '\0';
  1416.     else {
  1417.       sprintf(STR1, "%.*s", (int)j, n.UU.sval + i - 1);
  1418.       strcpy(n.UU.sval, STR1);
  1419.     }
  1420.     require(tokrp, LINK);
  1421.     break;
  1422.  
  1423.   case toklen:
  1424.     s = strfactor(LINK);
  1425.     n.UU.val = strlen(s);
  1426.     Free(s);
  1427.     break;
  1428.  
  1429.   case tokpeek:
  1430. /* p2c: dist/examples/basic.p, line 1029:
  1431.  * Note: Range checking is OFF [216] */
  1432.     trick.i = intfactor(LINK);
  1433.     n.UU.val = *trick.c;
  1434. /* p2c: dist/examples/basic.p, line 1032:
  1435.  * Note: Range checking is ON [216] */
  1436.     break;
  1437.  
  1438.   default:
  1439.     snerr();
  1440.     break;
  1441.   }
  1442.   return n;
  1443. }
  1444.  
  1445. Local valrec upexpr(LINK)
  1446. struct LOC_exec *LINK;
  1447. {
  1448.   valrec n, n2;
  1449.  
  1450.   n = factor(LINK);
  1451.   while (LINK->t != NULL && LINK->t->kind == tokup) {
  1452.     if (n.stringval)
  1453.       tmerr();
  1454.     LINK->t = LINK->t->next;
  1455.     n2 = upexpr(LINK);
  1456.     if (n2.stringval)
  1457.       tmerr();
  1458.     if (n.UU.val >= 0) {
  1459.       n.UU.val = exp(n2.UU.val * log(n.UU.val));
  1460.       continue;
  1461.     }
  1462.     if (n2.UU.val != (long)n2.UU.val)
  1463.       n.UU.val = log(n.UU.val);
  1464.     n.UU.val = exp(n2.UU.val * log(-n.UU.val));
  1465.     if (((long)n2.UU.val) & 1)
  1466.       n.UU.val = -n.UU.val;
  1467.   }
  1468.   return n;
  1469. }
  1470.  
  1471. Local valrec term(LINK)
  1472. struct LOC_exec *LINK;
  1473. {
  1474.   valrec n, n2;
  1475.   short k;
  1476.  
  1477.   n = upexpr(LINK);
  1478.   while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
  1479.      ((1L << ((long)LINK->t->kind)) & ((1L << ((long)toktimes)) |
  1480.         (1L << ((long)tokdiv)) | (1L << ((long)tokmod)))) != 0) {
  1481.     k = LINK->t->kind;
  1482.     LINK->t = LINK->t->next;
  1483.     n2 = upexpr(LINK);
  1484.     if (n.stringval || n2.stringval)
  1485.       tmerr();
  1486.     if (k == tokmod) {
  1487.       n.UU.val = (long)floor(n.UU.val + 0.5) % (long)floor(n2.UU.val + 0.5);
  1488. /* p2c: dist/examples/basic.p, line 1078:
  1489.  * Note: Using % for possibly-negative arguments [317] */
  1490.     } else if (k == toktimes)
  1491.       n.UU.val *= n2.UU.val;
  1492.     else
  1493.       n.UU.val /= n2.UU.val;
  1494.   }
  1495.   return n;
  1496. }
  1497.  
  1498. Local valrec sexpr(LINK)
  1499. struct LOC_exec *LINK;
  1500. {
  1501.   valrec n, n2;
  1502.   short k;
  1503.  
  1504.   n = term(LINK);
  1505.   while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
  1506.      ((1L << ((long)LINK->t->kind)) &
  1507.       ((1L << ((long)tokplus)) | (1L << ((long)tokminus)))) != 0) {
  1508.     k = LINK->t->kind;
  1509.     LINK->t = LINK->t->next;
  1510.     n2 = term(LINK);
  1511.     if (n.stringval != n2.stringval)
  1512.       tmerr();
  1513.     if (k == tokplus) {
  1514.       if (n.stringval) {
  1515.     strcat(n.UU.sval, n2.UU.sval);
  1516.     Free(n2.UU.sval);
  1517.       } else
  1518.     n.UU.val += n2.UU.val;
  1519.     } else {
  1520.       if (n.stringval)
  1521.     tmerr();
  1522.       else
  1523.     n.UU.val -= n2.UU.val;
  1524.     }
  1525.   }
  1526.   return n;
  1527. }
  1528.  
  1529. Local valrec relexpr(LINK)
  1530. struct LOC_exec *LINK;
  1531. {
  1532.   valrec n, n2;
  1533.   boolean f;
  1534.   short k;
  1535.  
  1536.   n = sexpr(LINK);
  1537.   while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
  1538.      ((1L << ((long)LINK->t->kind)) &
  1539.       ((1L << ((long)tokne + 1)) - (1L << ((long)tokeq)))) != 0) {
  1540.     k = LINK->t->kind;
  1541.     LINK->t = LINK->t->next;
  1542.     n2 = sexpr(LINK);
  1543.     if (n.stringval != n2.stringval)
  1544.       tmerr();
  1545.     if (n.stringval) {
  1546.       f = ((!strcmp(n.UU.sval, n2.UU.sval) && (unsigned long)k < 32 &&
  1547.         ((1L << ((long)k)) & ((1L << ((long)tokeq)) |
  1548.           (1L << ((long)tokge)) | (1L << ((long)tokle)))) != 0) ||
  1549.       (strcmp(n.UU.sval, n2.UU.sval) < 0 && (unsigned long)k < 32 &&
  1550.         ((1L << ((long)k)) & ((1L << ((long)toklt)) |
  1551.           (1L << ((long)tokle)) | (1L << ((long)tokne)))) != 0) ||
  1552.       (strcmp(n.UU.sval, n2.UU.sval) > 0 && (unsigned long)k < 32 &&
  1553.         ((1L << ((long)k)) & ((1L << ((long)tokgt)) |
  1554.           (1L << ((long)tokge)) | (1L << ((long)tokne)))) != 0));
  1555. /* p2c: dist/examples/basic.p, line 2175: Note:
  1556.  * Line breaker spent 0.0+8.00 seconds, 5000 tries on line 1554 [251] */
  1557.       Free(n.UU.sval);
  1558.       Free(n2.UU.sval);
  1559.     } else
  1560.       f = ((n.UU.val == n2.UU.val && (unsigned long)k < 32 && ((1L <<
  1561.           ((long)k)) & ((1L << ((long)tokeq)) |
  1562.           (1L << ((long)tokge)) | (1L << ((long)tokle)))) != 0) ||
  1563.       (n.UU.val < n2.UU.val && (unsigned long)k < 32 &&
  1564.         ((1L << ((long)k)) & ((1L << ((long)toklt)) |
  1565.           (1L << ((long)tokle)) | (1L << ((long)tokne)))) != 0) ||
  1566.       (n.UU.val > n2.UU.val && (unsigned long)k < 32 &&
  1567.         ((1L << ((long)k)) & ((1L << ((long)tokgt)) |
  1568.           (1L << ((long)tokge)) | (1L << ((long)tokne)))) != 0));
  1569. /* p2c: dist/examples/basic.p, line 2175: Note:
  1570.  * Line breaker spent 0.0+9.00 seconds, 5000 tries on line 1568 [251] */
  1571.     n.stringval = false;
  1572.     n.UU.val = f;
  1573.   }
  1574.   return n;
  1575. }
  1576.  
  1577. Local valrec andexpr(LINK)
  1578. struct LOC_exec *LINK;
  1579. {
  1580.   valrec n, n2;
  1581.  
  1582.   n = relexpr(LINK);
  1583.   while (LINK->t != NULL && LINK->t->kind == tokand) {
  1584.     LINK->t = LINK->t->next;
  1585.     n2 = relexpr(LINK);
  1586.     if (n.stringval || n2.stringval)
  1587.       tmerr();
  1588.     n.UU.val = ((long)n.UU.val) & ((long)n2.UU.val);
  1589.   }
  1590.   return n;
  1591. }
  1592.  
  1593. Local valrec expr(LINK)
  1594. struct LOC_exec *LINK;
  1595. {
  1596.   valrec n, n2;
  1597.   short k;
  1598.  
  1599.   n = andexpr(LINK);
  1600.   while (LINK->t != NULL && (unsigned long)LINK->t->kind < 32 &&
  1601.      ((1L << ((long)LINK->t->kind)) &
  1602.       ((1L << ((long)tokor)) | (1L << ((long)tokxor)))) != 0) {
  1603.     k = LINK->t->kind;
  1604.     LINK->t = LINK->t->next;
  1605.     n2 = andexpr(LINK);
  1606.     if (n.stringval || n2.stringval)
  1607.       tmerr();
  1608.     if (k == tokor)
  1609.       n.UU.val = ((long)n.UU.val) | ((long)n2.UU.val);
  1610.     else
  1611.       n.UU.val = ((long)n.UU.val) ^ ((long)n2.UU.val);
  1612.   }
  1613.   return n;
  1614. }
  1615.  
  1616.  
  1617. Local Void checkextra(LINK)
  1618. struct LOC_exec *LINK;
  1619. {
  1620.   if (LINK->t != NULL)
  1621.     errormsg("Extra information on line");
  1622. }
  1623.  
  1624.  
  1625. Local boolean iseos(LINK)
  1626. struct LOC_exec *LINK;
  1627. {
  1628.   return (LINK->t == NULL || LINK->t->kind == tokelse ||
  1629.       LINK->t->kind == tokcolon);
  1630. }
  1631.  
  1632.  
  1633. Local Void skiptoeos(LINK)
  1634. struct LOC_exec *LINK;
  1635. {
  1636.   while (!iseos(LINK))
  1637.     LINK->t = LINK->t->next;
  1638. }
  1639.  
  1640.  
  1641. Local linerec *findline(n, LINK)
  1642. long n;
  1643. struct LOC_exec *LINK;
  1644. {
  1645.   linerec *l;
  1646.  
  1647.   l = linebase;
  1648.   while (l != NULL && l->num != n)
  1649.     l = l->next;
  1650.   return l;
  1651. }
  1652.  
  1653.  
  1654. Local linerec *mustfindline(n, LINK)
  1655. long n;
  1656. struct LOC_exec *LINK;
  1657. {
  1658.   linerec *l;
  1659.  
  1660.   l = findline(n, LINK);
  1661.   if (l == NULL)
  1662.     errormsg("Undefined line");
  1663.   return l;
  1664. }
  1665.  
  1666.  
  1667. Local Void cmdend(LINK)
  1668. struct LOC_exec *LINK;
  1669. {
  1670.   stmtline = NULL;
  1671.   LINK->t = NULL;
  1672. }
  1673.  
  1674.  
  1675. Local Void cmdnew(LINK)
  1676. struct LOC_exec *LINK;
  1677. {
  1678.   Anyptr p;
  1679.  
  1680.   cmdend(LINK);
  1681.   clearloops();
  1682.   restoredata();
  1683.   while (linebase != NULL) {
  1684.     p = (Anyptr)linebase->next;
  1685.     disposetokens(&linebase->txt);
  1686.     Free(linebase);
  1687.     linebase = (linerec *)p;
  1688.   }
  1689.   while (varbase != NULL) {
  1690.     p = (Anyptr)varbase->next;
  1691.     if (varbase->stringvar) {
  1692.       if (*varbase->UU.U1.sval != NULL)
  1693.     Free(*varbase->UU.U1.sval);
  1694.     }
  1695.     Free(varbase);
  1696.     varbase = (varrec *)p;
  1697.   }
  1698. }
  1699.  
  1700.  
  1701. Local Void cmdlist(LINK)
  1702. struct LOC_exec *LINK;
  1703. {
  1704.   linerec *l;
  1705.   long n1, n2;
  1706.  
  1707.   do {
  1708.     n1 = 0;
  1709.     n2 = LONG_MAX;
  1710.     if (LINK->t != NULL && LINK->t->kind == toknum) {
  1711.       n1 = (long)LINK->t->UU.num;
  1712.       LINK->t = LINK->t->next;
  1713.       if (LINK->t == NULL || LINK->t->kind != tokminus)
  1714.     n2 = n1;
  1715.     }
  1716.     if (LINK->t != NULL && LINK->t->kind == tokminus) {
  1717.       LINK->t = LINK->t->next;
  1718.       if (LINK->t != NULL && LINK->t->kind == toknum) {
  1719.     n2 = (long)LINK->t->UU.num;
  1720.     LINK->t = LINK->t->next;
  1721.       } else
  1722.     n2 = LONG_MAX;
  1723.     }
  1724.     l = linebase;
  1725.     while (l != NULL && l->num <= n2) {
  1726.       if (l->num >= n1) {
  1727.     printf("%ld ", l->num);
  1728.     listtokens(stdout, l->txt);
  1729.     putchar('\n');
  1730.       }
  1731.       l = l->next;
  1732.     }
  1733.     if (!iseos(LINK))
  1734.       require(tokcomma, LINK);
  1735.   } while (!iseos(LINK));
  1736. }
  1737.  
  1738.  
  1739. Local Void cmdload(merging, name, LINK)
  1740. boolean merging;
  1741. Char *name;
  1742. struct LOC_exec *LINK;
  1743. {
  1744.   FILE *f;
  1745.   tokenrec *buf;
  1746.   Char STR1[256];
  1747.   Char *TEMP;
  1748.  
  1749.   f = NULL;
  1750.   if (!merging)
  1751.     cmdnew(LINK);
  1752.   if (f != NULL) {
  1753.     sprintf(STR1, "%s.TEXT", name);
  1754.     f = freopen(STR1, "r", f);
  1755.   } else {
  1756.     sprintf(STR1, "%s.TEXT", name);
  1757.     f = fopen(STR1, "r");
  1758.   }
  1759.   if (f == NULL)
  1760.     _EscIO(FileNotFound);
  1761.   while (fgets(inbuf, 256, f) != NULL) {
  1762.     TEMP = strchr(inbuf, '\n');
  1763.     if (TEMP != NULL)
  1764.       *TEMP = 0;
  1765.     parseinput(&buf);
  1766.     if (curline == 0) {
  1767.       printf("Bad line in file\n");
  1768.       disposetokens(&buf);
  1769.     }
  1770.   }
  1771.   if (f != NULL)
  1772.     fclose(f);
  1773.   f = NULL;
  1774.   if (f != NULL)
  1775.     fclose(f);
  1776. }
  1777.  
  1778.  
  1779. Local Void cmdrun(LINK)
  1780. struct LOC_exec *LINK;
  1781. {
  1782.   linerec *l;
  1783.   long i;
  1784.   string255 s;
  1785.  
  1786.   l = linebase;
  1787.   if (!iseos(LINK)) {
  1788.     if (LINK->t->kind == toknum)
  1789.       l = mustfindline(intexpr(LINK), LINK);
  1790.     else {
  1791.       stringexpr(s, LINK);
  1792.       i = 0;
  1793.       if (!iseos(LINK)) {
  1794.     require(tokcomma, LINK);
  1795.     i = intexpr(LINK);
  1796.       }
  1797.       checkextra(LINK);
  1798.       cmdload(false, s, LINK);
  1799.       if (i == 0)
  1800.     l = linebase;
  1801.       else
  1802.     l = mustfindline(i, LINK);
  1803.     }
  1804.   }
  1805.   stmtline = l;
  1806.   LINK->gotoflag = true;
  1807.   clearvars();
  1808.   clearloops();
  1809.   restoredata();
  1810. }
  1811.  
  1812.  
  1813. Local Void cmdsave(LINK)
  1814. struct LOC_exec *LINK;
  1815. {
  1816.   FILE *f;
  1817.   linerec *l;
  1818.   Char STR1[256], STR2[256];
  1819.  
  1820.   f = NULL;
  1821.   if (f != NULL) {
  1822.     sprintf(STR2, "%s.TEXT", stringexpr(STR1, LINK));
  1823.     f = freopen(STR2, "w", f);
  1824.   } else {
  1825.     sprintf(STR2, "%s.TEXT", stringexpr(STR1, LINK));
  1826.     f = fopen(STR2, "w");
  1827.   }
  1828.   if (f == NULL)
  1829.     _EscIO(FileNotFound);
  1830.   l = linebase;
  1831.   while (l != NULL) {
  1832.     fprintf(f, "%ld ", l->num);
  1833.     listtokens(f, l->txt);
  1834.     putc('\n', f);
  1835.     l = l->next;
  1836.   }
  1837.   if (f != NULL)
  1838.     fclose(f);
  1839.   f = NULL;
  1840.   if (f != NULL)
  1841.     fclose(f);
  1842. }
  1843.  
  1844.  
  1845. Local Void cmdbye(LINK)
  1846. struct LOC_exec *LINK;
  1847. {
  1848.   exitflag = true;
  1849. }
  1850.  
  1851.  
  1852. Local Void cmddel(LINK)
  1853. struct LOC_exec *LINK;
  1854. {
  1855.   linerec *l, *l0, *l1;
  1856.   long n1, n2;
  1857.  
  1858.   do {
  1859.     if (iseos(LINK))
  1860.       snerr();
  1861.     n1 = 0;
  1862.     n2 = LONG_MAX;
  1863.     if (LINK->t != NULL && LINK->t->kind == toknum) {
  1864.       n1 = (long)LINK->t->UU.num;
  1865.       LINK->t = LINK->t->next;
  1866.       if (LINK->t == NULL || LINK->t->kind != tokminus)
  1867.     n2 = n1;
  1868.     }
  1869.     if (LINK->t != NULL && LINK->t->kind == tokminus) {
  1870.       LINK->t = LINK->t->next;
  1871.       if (LINK->t != NULL && LINK->t->kind == toknum) {
  1872.     n2 = (long)LINK->t->UU.num;
  1873.     LINK->t = LINK->t->next;
  1874.       } else
  1875.     n2 = LONG_MAX;
  1876.     }
  1877.     l = linebase;
  1878.     l0 = NULL;
  1879.     while (l != NULL && l->num <= n2) {
  1880.       l1 = l->next;
  1881.       if (l->num >= n1) {
  1882.     if (l == stmtline) {
  1883.       cmdend(LINK);
  1884.       clearloops();
  1885.       restoredata();
  1886.     }
  1887.     if (l0 == NULL)
  1888.       linebase = l->next;
  1889.     else
  1890.       l0->next = l->next;
  1891.     disposetokens(&l->txt);
  1892.     Free(l);
  1893.       } else
  1894.     l0 = l;
  1895.       l = l1;
  1896.     }
  1897.     if (!iseos(LINK))
  1898.       require(tokcomma, LINK);
  1899.   } while (!iseos(LINK));
  1900. }
  1901.  
  1902.  
  1903. Local Void cmdrenum(LINK)
  1904. struct LOC_exec *LINK;
  1905. {
  1906.   linerec *l, *l1;
  1907.   tokenrec *tok;
  1908.   long lnum, step;
  1909.  
  1910.   lnum = 10;
  1911.   step = 10;
  1912.   if (!iseos(LINK)) {
  1913.     lnum = intexpr(LINK);
  1914.     if (!iseos(LINK)) {
  1915.       require(tokcomma, LINK);
  1916.       step = intexpr(LINK);
  1917.     }
  1918.   }
  1919.   l = linebase;
  1920.   if (l == NULL)
  1921.     return;
  1922.   while (l != NULL) {
  1923.     l->num2 = lnum;
  1924.     lnum += step;
  1925.     l = l->next;
  1926.   }
  1927.   l = linebase;
  1928.   do {
  1929.     tok = l->txt;
  1930.     do {
  1931.       if (tok->kind == tokdel || tok->kind == tokrestore ||
  1932.       tok->kind == toklist || tok->kind == tokrun ||
  1933.       tok->kind == tokelse || tok->kind == tokthen ||
  1934.       tok->kind == tokgosub || tok->kind == tokgoto) {
  1935.     while (tok->next != NULL && tok->next->kind == toknum) {
  1936.       tok = tok->next;
  1937.       lnum = (long)floor(tok->UU.num + 0.5);
  1938.       l1 = linebase;
  1939.       while (l1 != NULL && l1->num != lnum)
  1940.         l1 = l1->next;
  1941.       if (l1 == NULL)
  1942.         printf("Undefined line %ld in line %ld\n", lnum, l->num2);
  1943.       else
  1944.         tok->UU.num = l1->num2;
  1945.       if (tok->next != NULL && tok->next->kind == tokcomma)
  1946.         tok = tok->next;
  1947.     }
  1948.       }
  1949.       tok = tok->next;
  1950.     } while (tok != NULL);
  1951.     l = l->next;
  1952.   } while (l != NULL);
  1953.   l = linebase;
  1954.   while (l != NULL) {
  1955.     l->num = l->num2;
  1956.     l = l->next;
  1957.   }
  1958. }
  1959.  
  1960.  
  1961. Local Void cmdprint(LINK)
  1962. struct LOC_exec *LINK;
  1963. {
  1964.   boolean semiflag;
  1965.   valrec n;
  1966.   Char STR1[256];
  1967.  
  1968.   semiflag = false;
  1969.   while (!iseos(LINK)) {
  1970.     semiflag = false;
  1971.     if ((unsigned long)LINK->t->kind < 32 &&
  1972.     ((1L << ((long)LINK->t->kind)) &
  1973.      ((1L << ((long)toksemi)) | (1L << ((long)tokcomma)))) != 0) {
  1974.       semiflag = true;
  1975.       LINK->t = LINK->t->next;
  1976.       continue;
  1977.     }
  1978.     n = expr(LINK);
  1979.     if (n.stringval) {
  1980.       fputs(n.UU.sval, stdout);
  1981.       Free(n.UU.sval);
  1982.     } else
  1983.       printf("%s ", numtostr(STR1, n.UU.val));
  1984.   }
  1985.   if (!semiflag)
  1986.     putchar('\n');
  1987. }
  1988.  
  1989.  
  1990. Local Void cmdinput(LINK)
  1991. struct LOC_exec *LINK;
  1992. {
  1993.   varrec *v;
  1994.   string255 s;
  1995.   tokenrec *tok, *tok0, *tok1;
  1996.   boolean strflag;
  1997.  
  1998.   if (LINK->t != NULL && LINK->t->kind == tokstr) {
  1999.     fputs(LINK->t->UU.sp, stdout);
  2000.     LINK->t = LINK->t->next;
  2001.     require(toksemi, LINK);
  2002.   } else
  2003.     printf("? ");
  2004.   tok = LINK->t;
  2005.   if (LINK->t == NULL || LINK->t->kind != tokvar)
  2006.     snerr();
  2007.   strflag = LINK->t->UU.vp->stringvar;
  2008.   do {
  2009.     if (LINK->t != NULL && LINK->t->kind == tokvar) {
  2010.       if (LINK->t->UU.vp->stringvar != strflag)
  2011.     snerr();
  2012.     }
  2013.     LINK->t = LINK->t->next;
  2014.   } while (!iseos(LINK));
  2015.   LINK->t = tok;
  2016.   if (strflag) {
  2017.     do {
  2018.       gets(s);
  2019.       v = findvar(LINK);
  2020.       if (*v->UU.U1.sval != NULL)
  2021.     Free(*v->UU.U1.sval);
  2022.       *v->UU.U1.sval = (Char *)Malloc(256);
  2023.       strcpy(*v->UU.U1.sval, s);
  2024.       if (!iseos(LINK)) {
  2025.     require(tokcomma, LINK);
  2026.     printf("?? ");
  2027.       }
  2028.     } while (!iseos(LINK));
  2029.     return;
  2030.   }
  2031.   gets(s);
  2032.   parse(s, &tok);
  2033.   tok0 = tok;
  2034.   do {
  2035.     v = findvar(LINK);
  2036.     while (tok == NULL) {
  2037.       printf("?? ");
  2038.       gets(s);
  2039.       disposetokens(&tok0);
  2040.       parse(s, &tok);
  2041.       tok0 = tok;
  2042.     }
  2043.     tok1 = LINK->t;
  2044.     LINK->t = tok;
  2045.     *v->UU.U0.val = realexpr(LINK);
  2046.     if (LINK->t != NULL) {
  2047.       if (LINK->t->kind == tokcomma)
  2048.     LINK->t = LINK->t->next;
  2049.       else
  2050.     snerr();
  2051.     }
  2052.     tok = LINK->t;
  2053.     LINK->t = tok1;
  2054.     if (!iseos(LINK))
  2055.       require(tokcomma, LINK);
  2056.   } while (!iseos(LINK));
  2057.   disposetokens(&tok0);
  2058. }
  2059.  
  2060.  
  2061. Local Void cmdlet(implied, LINK)
  2062. boolean implied;
  2063. struct LOC_exec *LINK;
  2064. {
  2065.   varrec *v;
  2066.   Char *old;
  2067.  
  2068.   if (implied)
  2069.     LINK->t = stmttok;
  2070.   v = findvar(LINK);
  2071.   require(tokeq, LINK);
  2072.   if (!v->stringvar) {
  2073.     *v->UU.U0.val = realexpr(LINK);
  2074.     return;
  2075.   }
  2076.   old = *v->UU.U1.sval;
  2077.   *v->UU.U1.sval = strexpr(LINK);
  2078.   if (old != NULL)
  2079.     Free(old);
  2080. }
  2081.  
  2082.  
  2083. Local Void cmdgoto(LINK)
  2084. struct LOC_exec *LINK;
  2085. {
  2086.   stmtline = mustfindline(intexpr(LINK), LINK);
  2087.   LINK->t = NULL;
  2088.   LINK->gotoflag = true;
  2089. }
  2090.  
  2091.  
  2092. Local Void cmdif(LINK)
  2093. struct LOC_exec *LINK;
  2094. {
  2095.   double n;
  2096.   long i;
  2097.  
  2098.   n = realexpr(LINK);
  2099.   require(tokthen, LINK);
  2100.   if (n == 0) {
  2101.     i = 0;
  2102.     do {
  2103.       if (LINK->t != NULL) {
  2104.     if (LINK->t->kind == tokif)
  2105.       i++;
  2106.     if (LINK->t->kind == tokelse)
  2107.       i--;
  2108.     LINK->t = LINK->t->next;
  2109.       }
  2110.     } while (LINK->t != NULL && i >= 0);
  2111.   }
  2112.   if (LINK->t != NULL && LINK->t->kind == toknum)
  2113.     cmdgoto(LINK);
  2114.   else
  2115.     LINK->elseflag = true;
  2116. }
  2117.  
  2118.  
  2119. Local Void cmdelse(LINK)
  2120. struct LOC_exec *LINK;
  2121. {
  2122.   LINK->t = NULL;
  2123. }
  2124.  
  2125.  
  2126. Local boolean skiploop(up, dn, LINK)
  2127. short up, dn;
  2128. struct LOC_exec *LINK;
  2129. {
  2130.   boolean Result;
  2131.   long i;
  2132.   linerec *saveline;
  2133.  
  2134.   saveline = stmtline;
  2135.   i = 0;
  2136.   do {
  2137.     while (LINK->t == NULL) {
  2138.       if (stmtline == NULL || stmtline->next == NULL) {
  2139.     Result = false;
  2140.     stmtline = saveline;
  2141.     goto _L1;
  2142.       }
  2143.       stmtline = stmtline->next;
  2144.       LINK->t = stmtline->txt;
  2145.     }
  2146.     if (LINK->t->kind == up)
  2147.       i++;
  2148.     if (LINK->t->kind == dn)
  2149.       i--;
  2150.     LINK->t = LINK->t->next;
  2151.   } while (i >= 0);
  2152.   Result = true;
  2153. _L1:
  2154.   return Result;
  2155. }
  2156.  
  2157.  
  2158. Local Void cmdfor(LINK)
  2159. struct LOC_exec *LINK;
  2160. {
  2161.   looprec *l, lr;
  2162.   linerec *saveline;
  2163.   long i, j;
  2164.  
  2165.   lr.UU.U0.vp = findvar(LINK);
  2166.   if (lr.UU.U0.vp->stringvar)
  2167.     snerr();
  2168.   require(tokeq, LINK);
  2169.   *lr.UU.U0.vp->UU.U0.val = realexpr(LINK);
  2170.   require(tokto, LINK);
  2171.   lr.UU.U0.max = realexpr(LINK);
  2172.   if (LINK->t != NULL && LINK->t->kind == tokstep) {
  2173.     LINK->t = LINK->t->next;
  2174.     lr.UU.U0.step = realexpr(LINK);
  2175.   } else
  2176.     lr.UU.U0.step = 1.0;
  2177.   lr.homeline = stmtline;
  2178.   lr.hometok = LINK->t;
  2179.   lr.kind = forloop;
  2180.   lr.next = loopbase;
  2181.   if (lr.UU.U0.step >= 0 && *lr.UU.U0.vp->UU.U0.val > lr.UU.U0.max ||
  2182.       lr.UU.U0.step <= 0 && *lr.UU.U0.vp->UU.U0.val < lr.UU.U0.max) {
  2183.     saveline = stmtline;
  2184.     i = 0;
  2185.     j = 0;
  2186.     do {
  2187.       while (LINK->t == NULL) {
  2188.     if (stmtline == NULL || stmtline->next == NULL) {
  2189.       stmtline = saveline;
  2190.       errormsg("FOR without NEXT");
  2191.     }
  2192.     stmtline = stmtline->next;
  2193.     LINK->t = stmtline->txt;
  2194.       }
  2195.       if (LINK->t->kind == tokfor) {
  2196.     if (LINK->t->next != NULL && LINK->t->next->kind == tokvar &&
  2197.         LINK->t->next->UU.vp == lr.UU.U0.vp)
  2198.       j++;
  2199.     else
  2200.       i++;
  2201.       }
  2202.       if (LINK->t->kind == toknext) {
  2203.     if (LINK->t->next != NULL && LINK->t->next->kind == tokvar &&
  2204.         LINK->t->next->UU.vp == lr.UU.U0.vp)
  2205.       j--;
  2206.     else
  2207.       i--;
  2208.       }
  2209.       LINK->t = LINK->t->next;
  2210.     } while (i >= 0 && j >= 0);
  2211.     skiptoeos(LINK);
  2212.     return;
  2213.   }
  2214.   l = (looprec *)Malloc(sizeof(looprec));
  2215.   *l = lr;
  2216.   loopbase = l;
  2217. }
  2218.  
  2219.  
  2220. Local Void cmdnext(LINK)
  2221. struct LOC_exec *LINK;
  2222. {
  2223.   varrec *v;
  2224.   boolean found;
  2225.   looprec *l, *WITH;
  2226.  
  2227.   if (!iseos(LINK))
  2228.     v = findvar(LINK);
  2229.   else
  2230.     v = NULL;
  2231.   do {
  2232.     if (loopbase == NULL || loopbase->kind == gosubloop)
  2233.       errormsg("NEXT without FOR");
  2234.     found = (loopbase->kind == forloop &&
  2235.          (v == NULL || loopbase->UU.U0.vp == v));
  2236.     if (!found) {
  2237.       l = loopbase->next;
  2238.       Free(loopbase);
  2239.       loopbase = l;
  2240.     }
  2241.   } while (!found);
  2242.   WITH = loopbase;
  2243.   *WITH->UU.U0.vp->UU.U0.val += WITH->UU.U0.step;
  2244.   if ((WITH->UU.U0.step < 0 || *WITH->UU.U0.vp->UU.U0.val <= WITH->UU.U0.max) &&
  2245.       (WITH->UU.U0.step > 0 || *WITH->UU.U0.vp->UU.U0.val >= WITH->UU.U0.max)) {
  2246.     stmtline = WITH->homeline;
  2247.     LINK->t = WITH->hometok;
  2248.     return;
  2249.   }
  2250.   l = loopbase->next;
  2251.   Free(loopbase);
  2252.   loopbase = l;
  2253. }
  2254.  
  2255.  
  2256. Local Void cmdwhile(LINK)
  2257. struct LOC_exec *LINK;
  2258. {
  2259.   looprec *l;
  2260.  
  2261.   l = (looprec *)Malloc(sizeof(looprec));
  2262.   l->next = loopbase;
  2263.   loopbase = l;
  2264.   l->kind = whileloop;
  2265.   l->homeline = stmtline;
  2266.   l->hometok = LINK->t;
  2267.   if (iseos(LINK))
  2268.     return;
  2269.   if (realexpr(LINK) != 0)
  2270.     return;
  2271.   if (!skiploop(tokwhile, tokwend, LINK))
  2272.     errormsg("WHILE without WEND");
  2273.   l = loopbase->next;
  2274.   Free(loopbase);
  2275.   loopbase = l;
  2276.   skiptoeos(LINK);
  2277. }
  2278.  
  2279.  
  2280. Local Void cmdwend(LINK)
  2281. struct LOC_exec *LINK;
  2282. {
  2283.   tokenrec *tok;
  2284.   linerec *tokline;
  2285.   looprec *l;
  2286.   boolean found;
  2287.  
  2288.   do {
  2289.     if (loopbase == NULL || loopbase->kind == gosubloop)
  2290.       errormsg("WEND without WHILE");
  2291.     found = (loopbase->kind == whileloop);
  2292.     if (!found) {
  2293.       l = loopbase->next;
  2294.       Free(loopbase);
  2295.       loopbase = l;
  2296.     }
  2297.   } while (!found);
  2298.   if (!iseos(LINK)) {
  2299.     if (realexpr(LINK) != 0)
  2300.       found = false;
  2301.   }
  2302.   tok = LINK->t;
  2303.   tokline = stmtline;
  2304.   if (found) {
  2305.     stmtline = loopbase->homeline;
  2306.     LINK->t = loopbase->hometok;
  2307.     if (!iseos(LINK)) {
  2308.       if (realexpr(LINK) == 0)
  2309.     found = false;
  2310.     }
  2311.   }
  2312.   if (found)
  2313.     return;
  2314.   LINK->t = tok;
  2315.   stmtline = tokline;
  2316.   l = loopbase->next;
  2317.   Free(loopbase);
  2318.   loopbase = l;
  2319. }
  2320.  
  2321.  
  2322. Local Void cmdgosub(LINK)
  2323. struct LOC_exec *LINK;
  2324. {
  2325.   looprec *l;
  2326.  
  2327.   l = (looprec *)Malloc(sizeof(looprec));
  2328.   l->next = loopbase;
  2329.   loopbase = l;
  2330.   l->kind = gosubloop;
  2331.   l->homeline = stmtline;
  2332.   l->hometok = LINK->t;
  2333.   cmdgoto(LINK);
  2334. }
  2335.  
  2336.  
  2337. Local Void cmdreturn(LINK)
  2338. struct LOC_exec *LINK;
  2339. {
  2340.   looprec *l;
  2341.   boolean found;
  2342.  
  2343.   do {
  2344.     if (loopbase == NULL)
  2345.       errormsg("RETURN without GOSUB");
  2346.     found = (loopbase->kind == gosubloop);
  2347.     if (!found) {
  2348.       l = loopbase->next;
  2349.       Free(loopbase);
  2350.       loopbase = l;
  2351.     }
  2352.   } while (!found);
  2353.   stmtline = loopbase->homeline;
  2354.   LINK->t = loopbase->hometok;
  2355.   l = loopbase->next;
  2356.   Free(loopbase);
  2357.   loopbase = l;
  2358.   skiptoeos(LINK);
  2359. }
  2360.  
  2361.  
  2362. Local Void cmdread(LINK)
  2363. struct LOC_exec *LINK;
  2364. {
  2365.   varrec *v;
  2366.   tokenrec *tok;
  2367.   boolean found;
  2368.  
  2369.   do {
  2370.     v = findvar(LINK);
  2371.     tok = LINK->t;
  2372.     LINK->t = datatok;
  2373.     if (dataline == NULL) {
  2374.       dataline = linebase;
  2375.       LINK->t = dataline->txt;
  2376.     }
  2377.     if (LINK->t == NULL || LINK->t->kind != tokcomma) {
  2378.       do {
  2379.     while (LINK->t == NULL) {
  2380.       if (dataline == NULL || dataline->next == NULL)
  2381.         errormsg("Out of Data");
  2382.       dataline = dataline->next;
  2383.       LINK->t = dataline->txt;
  2384.     }
  2385.     found = (LINK->t->kind == tokdata);
  2386.     LINK->t = LINK->t->next;
  2387.       } while (!found || iseos(LINK));
  2388.     } else
  2389.       LINK->t = LINK->t->next;
  2390.     if (v->stringvar) {
  2391.       if (*v->UU.U1.sval != NULL)
  2392.     Free(*v->UU.U1.sval);
  2393.       *v->UU.U1.sval = strexpr(LINK);
  2394.     } else
  2395.       *v->UU.U0.val = realexpr(LINK);
  2396.     datatok = LINK->t;
  2397.     LINK->t = tok;
  2398.     if (!iseos(LINK))
  2399.       require(tokcomma, LINK);
  2400.   } while (!iseos(LINK));
  2401. }
  2402.  
  2403.  
  2404. Local Void cmddata(LINK)
  2405. struct LOC_exec *LINK;
  2406. {
  2407.   skiptoeos(LINK);
  2408. }
  2409.  
  2410.  
  2411. Local Void cmdrestore(LINK)
  2412. struct LOC_exec *LINK;
  2413. {
  2414.   if (iseos(LINK))
  2415.     restoredata();
  2416.   else {
  2417.     dataline = mustfindline(intexpr(LINK), LINK);
  2418.     datatok = dataline->txt;
  2419.   }
  2420. }
  2421.  
  2422.  
  2423. Local Void cmdgotoxy(LINK)
  2424. struct LOC_exec *LINK;
  2425. {
  2426.   long i;
  2427.  
  2428.   i = intexpr(LINK);
  2429.   require(tokcomma, LINK);
  2430. }
  2431.  
  2432.  
  2433. Local Void cmdon(LINK)
  2434. struct LOC_exec *LINK;
  2435. {
  2436.   long i;
  2437.   looprec *l;
  2438.  
  2439.   i = intexpr(LINK);
  2440.   if (LINK->t != NULL && LINK->t->kind == tokgosub) {
  2441.     l = (looprec *)Malloc(sizeof(looprec));
  2442.     l->next = loopbase;
  2443.     loopbase = l;
  2444.     l->kind = gosubloop;
  2445.     l->homeline = stmtline;
  2446.     l->hometok = LINK->t;
  2447.     LINK->t = LINK->t->next;
  2448.   } else
  2449.     require(tokgoto, LINK);
  2450.   if (i < 1) {
  2451.     skiptoeos(LINK);
  2452.     return;
  2453.   }
  2454.   while (i > 1 && !iseos(LINK)) {
  2455.     require(toknum, LINK);
  2456.     if (!iseos(LINK))
  2457.       require(tokcomma, LINK);
  2458.     i--;
  2459.   }
  2460.   if (!iseos(LINK))
  2461.     cmdgoto(LINK);
  2462. }
  2463.  
  2464.  
  2465. Local Void cmddim(LINK)
  2466. struct LOC_exec *LINK;
  2467. {
  2468.   long i, j, k;
  2469.   varrec *v;
  2470.   boolean done;
  2471.  
  2472.   do {
  2473.     if (LINK->t == NULL || LINK->t->kind != tokvar)
  2474.       snerr();
  2475.     v = LINK->t->UU.vp;
  2476.     LINK->t = LINK->t->next;
  2477.     if (v->numdims != 0)
  2478.       errormsg("Array already dimensioned");
  2479.     j = 1;
  2480.     i = 0;
  2481.     require(toklp, LINK);
  2482.     do {
  2483.       k = intexpr(LINK) + 1;
  2484.       if (k < 1)
  2485.     badsubscr();
  2486.       if (i >= maxdims)
  2487.     badsubscr();
  2488.       i++;
  2489.       v->dims[i - 1] = k;
  2490.       j *= k;
  2491.       done = (LINK->t != NULL && LINK->t->kind == tokrp);
  2492.       if (!done)
  2493.     require(tokcomma, LINK);
  2494.     } while (!done);
  2495.     LINK->t = LINK->t->next;
  2496.     v->numdims = i;
  2497.     if (v->stringvar) {
  2498.       v->UU.U1.sarr = (Char **)Malloc(j * 4);
  2499.       for (i = 0; i < j; i++)
  2500.     v->UU.U1.sarr[i] = NULL;
  2501.     } else {
  2502.       v->UU.U0.arr = (double *)Malloc(j * 8);
  2503.       for (i = 0; i < j; i++)
  2504.     v->UU.U0.arr[i] = 0.0;
  2505.     }
  2506.     if (!iseos(LINK))
  2507.       require(tokcomma, LINK);
  2508.   } while (!iseos(LINK));
  2509. }
  2510.  
  2511.  
  2512. Local Void cmdpoke(LINK)
  2513. struct LOC_exec *LINK;
  2514. {
  2515.   union {
  2516.     long i;
  2517.     Char *c;
  2518.   } trick;
  2519.  
  2520. /* p2c: dist/examples/basic.p, line 2073:
  2521.  * Note: Range checking is OFF [216] */
  2522.   trick.i = intexpr(LINK);
  2523.   require(tokcomma, LINK);
  2524.   *trick.c = (Char)intexpr(LINK);
  2525. /* p2c: dist/examples/basic.p, line 2077:
  2526.  * Note: Range checking is ON [216] */
  2527. }
  2528.  
  2529.  
  2530.  
  2531.  
  2532.  
  2533.  
  2534.  
  2535.  
  2536.  
  2537. Static Void exec()
  2538. {
  2539.   struct LOC_exec V;
  2540.   Char *ioerrmsg;
  2541.   Char STR1[256];
  2542.  
  2543.  
  2544.   TRY(try1);
  2545.     do {
  2546.       do {
  2547.     V.gotoflag = false;
  2548.     V.elseflag = false;
  2549.     while (stmttok != NULL && stmttok->kind == tokcolon)
  2550.       stmttok = stmttok->next;
  2551.     V.t = stmttok;
  2552.     if (V.t != NULL) {
  2553.       V.t = V.t->next;
  2554.       switch (stmttok->kind) {
  2555.  
  2556.       case tokrem:
  2557.         /* blank case */
  2558.         break;
  2559.  
  2560.       case toklist:
  2561.         cmdlist(&V);
  2562.         break;
  2563.  
  2564.       case tokrun:
  2565.         cmdrun(&V);
  2566.         break;
  2567.  
  2568.       case toknew:
  2569.         cmdnew(&V);
  2570.         break;
  2571.  
  2572.       case tokload:
  2573.         cmdload(false, stringexpr(STR1, &V), &V);
  2574.         break;
  2575.  
  2576.       case tokmerge:
  2577.         cmdload(true, stringexpr(STR1, &V), &V);
  2578.         break;
  2579.  
  2580.       case toksave:
  2581.         cmdsave(&V);
  2582.         break;
  2583.  
  2584.       case tokbye:
  2585.         cmdbye(&V);
  2586.         break;
  2587.  
  2588.       case tokdel:
  2589.         cmddel(&V);
  2590.         break;
  2591.  
  2592.       case tokrenum:
  2593.         cmdrenum(&V);
  2594.         break;
  2595.  
  2596.       case toklet:
  2597.         cmdlet(false, &V);
  2598.         break;
  2599.  
  2600.       case tokvar:
  2601.         cmdlet(true, &V);
  2602.         break;
  2603.  
  2604.       case tokprint:
  2605.         cmdprint(&V);
  2606.         break;
  2607.  
  2608.       case tokinput:
  2609.         cmdinput(&V);
  2610.         break;
  2611.  
  2612.       case tokgoto:
  2613.         cmdgoto(&V);
  2614.         break;
  2615.  
  2616.       case tokif:
  2617.         cmdif(&V);
  2618.         break;
  2619.  
  2620.       case tokelse:
  2621.         cmdelse(&V);
  2622.         break;
  2623.  
  2624.       case tokend:
  2625.         cmdend(&V);
  2626.         break;
  2627.  
  2628.       case tokstop:
  2629.         P_escapecode = -20;
  2630.         goto _Ltry1;
  2631.         break;
  2632.  
  2633.       case tokfor:
  2634.         cmdfor(&V);
  2635.         break;
  2636.  
  2637.       case toknext:
  2638.         cmdnext(&V);
  2639.         break;
  2640.  
  2641.       case tokwhile:
  2642.         cmdwhile(&V);
  2643.         break;
  2644.  
  2645.       case tokwend:
  2646.         cmdwend(&V);
  2647.         break;
  2648.  
  2649.       case tokgosub:
  2650.         cmdgosub(&V);
  2651.         break;
  2652.  
  2653.       case tokreturn:
  2654.         cmdreturn(&V);
  2655.         break;
  2656.  
  2657.       case tokread:
  2658.         cmdread(&V);
  2659.         break;
  2660.  
  2661.       case tokdata:
  2662.         cmddata(&V);
  2663.         break;
  2664.  
  2665.       case tokrestore:
  2666.         cmdrestore(&V);
  2667.         break;
  2668.  
  2669.       case tokgotoxy:
  2670.         cmdgotoxy(&V);
  2671.         break;
  2672.  
  2673.       case tokon:
  2674.         cmdon(&V);
  2675.         break;
  2676.  
  2677.       case tokdim:
  2678.         cmddim(&V);
  2679.         break;
  2680.  
  2681.       case tokpoke:
  2682.         cmdpoke(&V);
  2683.         break;
  2684.  
  2685.       default:
  2686.         errormsg("Illegal command");
  2687.         break;
  2688.       }
  2689.     }
  2690.     if (!V.elseflag && !iseos(&V))
  2691.       checkextra(&V);
  2692.     stmttok = V.t;
  2693.       } while (V.t != NULL);
  2694.       if (stmtline != NULL) {
  2695.     if (!V.gotoflag)
  2696.       stmtline = stmtline->next;
  2697.     if (stmtline != NULL)
  2698.       stmttok = stmtline->txt;
  2699.       }
  2700.     } while (stmtline != NULL);
  2701.   RECOVER2(try1,_Ltry1);
  2702.     if (P_escapecode == -20)
  2703.       printf("Break");
  2704.     else if (P_escapecode != 42) {
  2705.       switch (P_escapecode) {
  2706.  
  2707.       case -4:
  2708.     printf("\007Integer overflow");
  2709.     break;
  2710.  
  2711.       case -5:
  2712.     printf("\007Divide by zero");
  2713.     break;
  2714.  
  2715.       case -6:
  2716.     printf("\007Real math overflow");
  2717.     break;
  2718.  
  2719.       case -7:
  2720.     printf("\007Real math underflow");
  2721.     break;
  2722.  
  2723.       case -8:
  2724.       case -19:
  2725.       case -18:
  2726.       case -17:
  2727.       case -16:
  2728.       case -15:
  2729.     printf("\007Value range error");
  2730.     break;
  2731.  
  2732.       case -10:
  2733.     ioerrmsg = (Char *)Malloc(256);
  2734.     sprintf(ioerrmsg, "I/O Error %d", (int)P_ioresult);
  2735.     printf("\007%s", ioerrmsg);
  2736.     Free(ioerrmsg);
  2737.     break;
  2738.  
  2739.       default:
  2740.     if (EXCP_LINE != -1)
  2741.       printf("%12ld\n", EXCP_LINE);
  2742.     _Escape(P_escapecode);
  2743.     break;
  2744.       }
  2745.     }
  2746.     if (stmtline != NULL)
  2747.       printf(" in %ld", stmtline->num);
  2748.     putchar('\n');
  2749.   ENDTRY(try1);
  2750. }  /*exec*/
  2751.  
  2752.  
  2753.  
  2754.  
  2755.  
  2756. main(argc, argv)
  2757. int argc;
  2758. Char *argv[];
  2759. {  /*main*/
  2760.   PASCAL_MAIN(argc, argv);
  2761.   inbuf = (Char *)Malloc(256);
  2762.   linebase = NULL;
  2763.   varbase = NULL;
  2764.   loopbase = NULL;
  2765.   printf("Chipmunk BASIC 1.0\n\n");
  2766.   exitflag = false;
  2767.   do {
  2768.     TRY(try2);
  2769.       do {
  2770.     putchar('>');
  2771.     gets(inbuf);
  2772.     parseinput(&buf);
  2773.     if (curline == 0) {
  2774.       stmtline = NULL;
  2775.       stmttok = buf;
  2776.       if (stmttok != NULL)
  2777.         exec();
  2778.       disposetokens(&buf);
  2779.     }
  2780.       } while (!(exitflag || P_eof(stdin)));
  2781.     RECOVER(try2);
  2782.       if (P_escapecode != -20)
  2783.     printf("Error %d/%d!\n", (int)P_escapecode, (int)P_ioresult);
  2784.       else
  2785.     putchar('\n');
  2786.     ENDTRY(try2);
  2787.   } while (!(exitflag || P_eof(stdin)));
  2788.   exit(EXIT_SUCCESS);
  2789. }
  2790.  
  2791.  
  2792.  
  2793.  
  2794.  
  2795.  
  2796.  
  2797. /* End. */
  2798.