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