home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / online / source / c / compilers / C_Interp.sit.hqx / C_Interp / Interp.c < prev    next >
Text File  |  1992-04-29  |  36KB  |  1,593 lines
  1. /*
  2.     Terminal 2.2
  3.     "Interp.c"
  4. */
  5.  
  6. #include "Compatibility.h"
  7. #include "Interp.h"
  8. #include <string.h>
  9.  
  10. #define LINE    256        /* Maximum line size */
  11.  
  12. Byte EmptyStr[1] = {0};    /* Empty string */
  13.  
  14. /* ----- Error codes -------------------------------------------------- */
  15.  
  16. enum errs {
  17.     EARLYEOF = 1,        /* Unexpected end of file */
  18.     UNRECOGNIZED,        /* ... unrecognized */
  19.     DUPL_DECLARE,        /* ... duplicate identifier */
  20.     TABLEOVERFLOW,        /* Symbol table full */
  21.     MEMERR,                /* Out of heap memory */
  22.     UNDECLARED,            /* ... undeclared identifier */
  23.     SYNTAX,                /* Syntax error */
  24.     MATCHERR,            /* ... unmatched */
  25.     MISSING,            /* ... missing */
  26.     NOTFUNC,            /* Not a function */
  27.     OUTOFPLACE,            /* ... out of place */
  28.     BUFFULL,            /* Token buffer overflow */
  29.     DIVIDEERR,            /* Divide by zero */
  30.     POINTERERR,            /* Pointer error */
  31.     PARAMERR            /* Parameter error */
  32. };
  33.  
  34. char *errstr[] = {
  35.     " ",
  36.     "Unexpected end of file",
  37.     "unrecognized",
  38.     "duplicate identifier",
  39.     "Symbol table full",
  40.     "Out of heap memory",
  41.     "undeclared identifier",
  42.     "Syntax error",
  43.     "unmatched",
  44.     "missing",
  45.     "Not a function",
  46.     "out of place",
  47.     "Token buffer overflow",
  48.     "Divide by zero",
  49.     "Pointer error",
  50.     "Parameter error",
  51.     0
  52. };
  53.  
  54. /* ----- Symbol table structure ---------------------------------------- */
  55.  
  56. typedef struct {
  57.     Byte *name;            /* Points to symbol name (in token buffer) */
  58.     INTEGER value;        /* Value (integer or pointer) */
  59.     Byte size;            /* 0: function, 1: char, 4: int */
  60.     Byte ind;            /* Indirection level */
  61. } SYMBOL;
  62.  
  63. /* ----- Environment for expression evaluation ------------------------- */
  64.  
  65. typedef struct {
  66.     SYMBOL *sp;            /* Local symbol table pointer */
  67.     INTEGER value;        /* Value or address of variable */
  68.     Byte size;            /* 0: function, 1: char, 4: int */
  69.     Byte ind;            /* Indirection level */
  70.     Byte adr;            /* 0: value, 1: address */
  71. } ENV;
  72.  
  73. /* ----- Function macros ----------------------------------------------- */
  74.  
  75. #define bypass()            tptr += strlen((char *)tptr) + 1
  76. #define iswhite(c)            (c == ' ' || c == '\t')
  77. #define iscsymf(c)            (isalpha(c) || c == '_')
  78. #define iscsym(c)            (isalnum(c) || c == '_')
  79.  
  80. /* ----- Function prototypes ------------------------------------------- */
  81.  
  82. static Byte *allocate(long);
  83. static void x2str(long, Byte *);
  84. long a2x(Byte *);
  85. static Byte *token2str(short);
  86. static Byte gettoken(void);
  87. static Byte getok(void);
  88. static Byte iskeyword(void);
  89. static Byte isident(void);
  90. static Byte istoken(void);
  91. static Byte getword(void);
  92. static Byte getcx(void);
  93. static SYMBOL *addsymbol(SYMBOL *, Byte *, INTEGER, Byte, Byte);
  94. static SYMBOL *findsymbol(SYMBOL *, Byte *, SYMBOL *);
  95. static SYMBOL *ifsymbol(SYMBOL *, Byte *, SYMBOL *);
  96. static void error(enum errs, Byte *);
  97. static Boolean iftoken(Byte);
  98. static void skippair(Byte, Byte);
  99. static void needtoken(Byte);
  100. static Byte nexttoken(void);
  101. static Byte escseq(void);
  102. static Byte h2(void);
  103.  
  104. static void compound_statement(SYMBOL *);
  105. static void statement(SYMBOL *);
  106. static void statements(SYMBOL *);
  107. static void skip_statements(SYMBOL *);
  108. static INTEGER pfunction(Byte *, SYMBOL *);
  109.  
  110. static INTEGER expression(SYMBOL *);
  111. static void assign(ENV *);
  112. static void or(ENV *);
  113. static void and(ENV *);
  114. static void eq(ENV *);
  115. static void le(ENV *);
  116. static void plus(ENV *);
  117. static void mult(ENV *);
  118. static void unary(ENV *);
  119. static void variable(ENV *);
  120. static void primary(ENV *);
  121. static void rvalue(ENV *);
  122. static void store(ENV *, INTEGER);
  123.  
  124. /* ----- Characters in source, not copied to token buffer -------------- */
  125.  
  126. #define COMMENT1    '/'
  127. #define COMMENT2    '*'
  128. #define QUOTES        '"'
  129. #define QUOTE        '\''
  130.  
  131. /* ----- Tokens (found in token buffer) -------------------------------- */
  132.  
  133. #define LINENO        127        /* '\015', must be unique */
  134. #define BREAK        'b'        /* break */
  135. #define CHAR        'c'        /* char */
  136. #define ELSE        'e'        /* else */
  137. #define FOR            'f'        /* for */
  138. #define IF            'i'        /* if */
  139. #define INT            'l'        /* int */
  140. #define RETURN        'r'        /* return */
  141. #define WHILE        'w'        /* while */
  142.  
  143. #define IDENT        'I'        /* <identifier> */
  144. #define CONSTANT    'C'        /* <constant> */
  145. #define STRING        'S'        /* <string> */
  146.  
  147. #define AUTOINC        'P'        /* ++ */
  148. #define AUTODEC        'D'        /* -- */
  149. #define EQUALTO        'E'        /* == */
  150. #define NOTEQUAL    'N'        /* != */
  151. #define GE            'G'        /* >= */
  152. #define LE            'L'        /* <= */
  153. #define AUTOADD        'A'        /* += */
  154. #define AUTOSUB        'B'        /* -= */
  155. #define AUTOMUL        'M'        /* *= */
  156. #define AUTODIV        'V'        /* /= */
  157. #define AUTOMOD        'M'        /* %= */
  158. #define ADDRESS        '@'        /* &  */
  159.  
  160. #define AND            '&'        /* && */
  161. #define OR            '|'        /* || */
  162. #define POINTER        '*'        /* pointer */
  163. #define PLUS        '+'
  164. #define    MINUS        '-'
  165. #define MULTIPLY    '*'
  166. #define DIVIDE        '/'
  167. #define MODULO        '%'
  168. #define EQUAL        '='
  169. #define LESS        '<'
  170. #define GREATER        '>'
  171. #define NOT            '!'
  172. #define LPAREN        '('
  173. #define RPAREN        ')'
  174. #define LBRACE        '{'
  175. #define RBRACE        '}'
  176. #define LBRACKET    '['
  177. #define RBRACKET    ']'
  178. #define COMMA        ','
  179. #define SEMICOLON    ';'
  180.  
  181. /* ----- Table of keywords and their tokens ---------------------------- */
  182.  
  183. static struct keywords {
  184.     Byte *kw;
  185.     Byte kwtoken;
  186. } kwds[] = {
  187.     (Byte *)EOLNS,        LINENO,
  188.     (Byte *)"break",    BREAK,
  189.     (Byte *)"char",        CHAR,
  190.     (Byte *)"else",        ELSE,
  191.     (Byte *)"for",        FOR,
  192.     (Byte *)"if",        IF,
  193.     (Byte *)"int",        INT,
  194.     (Byte *)"return",    RETURN,
  195.     (Byte *)"while",    WHILE,
  196.     NULL,                0
  197. };
  198.  
  199. /* ----- Table of direct translate tokens ------------------------------ */
  200.  
  201. static Byte tokens[] = {
  202.     COMMA, LBRACE, RBRACE, LPAREN, RPAREN, EQUAL, NOT, POINTER,
  203.     LESS, GREATER, AND, OR, SEMICOLON, LBRACKET, RBRACKET,
  204.     MULTIPLY, DIVIDE, MODULO, PLUS, MINUS, T_EOF, 0
  205. };
  206.  
  207. /* ----- Local data ---------------------------------------------------- */
  208.  
  209. /*
  210.     Memory layout:                         <- Globals
  211.     High addr    +---------------------+
  212.                 | global symbols      |
  213.                 |.....................| <- EndGlobals
  214.                 |                     |
  215.                 | local symbol        |
  216.                 | (function params)   |    <- SymTop (grows down)
  217.                 +---------------------+
  218.                 |                     |
  219.                 | free memory         |
  220.                 |                     | <- StackPtr (grows up)
  221.                 +---------------------+
  222.                 |                     | 
  223.                 | arrays and function |
  224.                 | parameters          | <- LoMem
  225.                 +---------------------+
  226.                 |                     |
  227.                 | token buffer        |
  228.                 |                     | <- TokenBuffer
  229.     Low addr    +---------------------+
  230.  
  231. */
  232.  
  233. static SYMBOL *Globals;        /* Function/variable symbol table */
  234. static SYMBOL *EndGlobals;    /* Last global symbol */
  235. static SYMBOL *SymTop;        /* Last symbol in table */
  236. static Byte *StackPtr;        /* Arrays and function parameters */
  237. static Byte *LoMem;            /* Array allocation starts here */
  238. static Byte *tptr;            /* Running token pointer */
  239. static Byte *TokenBuffer;    /* Compiled token buffer */
  240. static short skipping;        /* Semaphore used for skipping statements */
  241. static short breaking;        /* TRUE if "break" statement executed */
  242. static short returning;        /* TRUE if "return" statement executed */
  243. static INTEGER frtn;        /* Return value from a function */
  244. static long linenumber;        /* Line number in source file */
  245.  
  246. /* ----- Return remaining stack space ---------------------------------- */
  247.  
  248. INTEGER SI_stack(params)    /* Used by shell as intrinsic function */
  249. INTEGER *params;
  250. {
  251. #pragma unused(params)
  252.     return (Byte *)SymTop - StackPtr;
  253. }
  254.  
  255. /* ----- Allocate memory on the stack ---------------------------------- */
  256.  
  257. static Byte *allocate(size)
  258. register long size;
  259. {
  260.     register Byte *sp = StackPtr;
  261.  
  262.     if (size & 1)    /* Make sure stack pointer remains even */
  263.         size++;
  264.     if ((StackPtr += size) >= (Byte *)SymTop)
  265.         error (MEMERR, EmptyStr);
  266.     return sp;
  267. }
  268.  
  269. /* ----- Lexical scan and call linker ---------------------------------- */
  270.  
  271. void SI_Load(intrinsics, memory, size)
  272. register INTRINSIC *intrinsics;    /* Intrinsic functions provided by shell */
  273. Byte *memory;                    /* Start of memory provided by shell */
  274. long size;                        /* Size of memory provided by shell */
  275. {
  276.     register short tok;
  277.     register short n;
  278.  
  279.     /* Set up memory pointers */
  280.  
  281.     if (size & 1)        /* Make sure address is even */
  282.         size--;
  283.     LoMem = (Byte *)(SymTop = Globals =
  284.         (SYMBOL *)((tptr = TokenBuffer = memory) + size)) - LINE;
  285.  
  286.     /* Load token buffer */
  287.  
  288.     linenumber = 1;
  289.     do {
  290.         if (tptr >= LoMem)
  291.             error(BUFFULL, EmptyStr);
  292.         n = linenumber;
  293.  
  294.         /* *tptr++ = tok = gettoken();     Ok in THINK C but not in MPW! */
  295.         tptr++; tok = gettoken(); *(tptr - 1) = tok;
  296.  
  297.         n = linenumber - n;
  298.         switch (tok) {
  299.             case CONSTANT:
  300.             case IDENT:
  301.             case STRING:
  302.                 bypass();
  303.                 break;
  304.             case LINENO:
  305.                 ++linenumber;
  306.                 break;
  307.         }
  308.         while (n--) {
  309.             if (tptr >= LoMem)
  310.                 error(BUFFULL, EmptyStr);
  311.             *tptr++ = LINENO;
  312.         }
  313.     } while (tok != T_EOF);
  314.     if ((long)tptr & 1)    /* Make sure address is even */
  315.         tptr++;
  316.     linenumber = 0;    /* From now on error() must count LINENO tokens */
  317.  
  318.     /* Add intrinsic functions to symbol table */
  319.  
  320.     StackPtr = LoMem = tptr;
  321.     for ( ; intrinsics->fn; intrinsics++)
  322.         addsymbol(Globals,intrinsics->fname,(INTEGER)intrinsics->fn,0,0);
  323.  
  324.     /* Link the global variables and functions */
  325.  
  326.     tptr = TokenBuffer;
  327.     while ((tok = nexttoken()) != T_EOF) {
  328.         if (tok == CHAR || tok == INT) {        /* Variable declaration */
  329.             do {
  330.                 register SYMBOL *symbole;
  331.                 short ind = 0;
  332.                 while (iftoken(POINTER))
  333.                     ind++;                        /* char *xyz */
  334.                 needtoken(IDENT);
  335.                 symbole = addsymbol(Globals, tptr, 0,
  336.                     (tok == CHAR) ? 1 : sizeof(INTEGER), ind);
  337.                 bypass();
  338.                 if (iftoken(LBRACKET)) {
  339.                     if (iftoken(RBRACKET))        /* xyz[] */
  340.                         (symbole->ind)++;
  341.                     else {                        /* xyz[...] */
  342.                         short size;
  343.                         size = (symbole->size == 1 && symbole->ind == 0) ?
  344.                             1 : sizeof(INTEGER);
  345.                         symbole->value =
  346.                             (INTEGER)allocate(size * expression(Globals));
  347.                         (symbole->ind)++;
  348.                         needtoken(RBRACKET);
  349.                     }
  350.                 }
  351.                 if (iftoken(EQUAL)) {
  352.                     if (iftoken(LBRACE)) {        /* x = { xxx, ... } */
  353.                         INTEGER *p;
  354.                         symbole->value = (INTEGER)StackPtr;
  355.                         do {
  356.                             p = (INTEGER *)allocate(sizeof(INTEGER));
  357.                             *p = expression(Globals);
  358.                         } while (iftoken(COMMA));
  359.                         needtoken(RBRACE);
  360.                     } else {                    /* x = xxx */
  361.                         symbole->value = expression(Globals);
  362.                     }
  363.                 }
  364.             } while (iftoken(COMMA));
  365.             needtoken(SEMICOLON);
  366.         } else if (tok == IDENT) {        /* Function definition */
  367.             Byte *name = tptr;
  368.             bypass();
  369.             addsymbol(Globals, name, (INTEGER)tptr, 0, 0);
  370.             skippair(LPAREN, RPAREN);
  371.             skippair(LBRACE, RBRACE);            /* xyz(...) {...} */
  372.         } else
  373.             error(EARLYEOF, (Byte *) "SI_Load");
  374.     }
  375.     EndGlobals = SymTop;
  376. }
  377.  
  378. /* ----- Start the interpreter ----------------------------------------- */
  379.  
  380. INTEGER SI_Interpret()
  381. {
  382.     skipping = 0;
  383.     breaking = returning = FALSE;
  384.     tptr = (Byte *)"Imain\0();";
  385.     return expression(SymTop);
  386. }
  387.  
  388. /* ----- Return the next token ----------------------------------------- */
  389.  
  390. static Byte gettoken()
  391. {
  392.     register Byte tok;
  393.  
  394.     tok = getword();
  395.     if (!tok)                        /* Not a char/string constant */
  396.         if (!(tok = iskeyword()))    /* No keyword */
  397.             if (!(tok = istoken()))    /* No one character token */
  398.                 tok = isident();    /* Then should be ident. or constant */
  399.     if (!tok)
  400.         error(UNRECOGNIZED, tptr);
  401.     return tok;
  402. }
  403.  
  404. /* ----- Test to see if current word is a one character token ---------- */
  405.  
  406. static Byte istoken()
  407. {
  408.     register Byte *t = tokens;    /* Single character tokens */
  409.     register Byte t2;
  410.  
  411.     if (strlen((char *)tptr) != 1)
  412.         return 0;
  413.     while (*t)
  414.         if (*tptr == *t++) {
  415.             switch ((char) *tptr) {
  416.                 case T_EOF:
  417.                     break;
  418.                 case AND:        /* Distinction between & and && */
  419.                     if ((t2 = getcx()) != AND) {
  420.                         *tptr = ADDRESS;
  421.                         SI_UngetSource(t2);
  422.                     }
  423.                     break;
  424.                 case OR:        /* Must be || */
  425.                     if (getcx() != OR)
  426.                         error(MISSING, tptr);
  427.                     break;
  428.                 case PLUS:        /* Distinction between +, ++ and += */
  429.                 case MINUS:        /* Distinction between -, -- and -= */
  430.                     if ((t2 = getcx()) == *tptr)
  431.                         *tptr = (*tptr == PLUS) ? AUTOINC : AUTODEC;
  432.                     else if (t2 == EQUAL)
  433.                         *tptr = (*tptr == PLUS) ? AUTOADD : AUTOSUB;
  434.                     else
  435.                         SI_UngetSource(t2);
  436.                     break;
  437.                 case RBRACE:    /* May be last token */
  438.                 case SEMICOLON:
  439.                     break;
  440.                 default:
  441.                     if ((t2 = getcx()) == EQUAL) {
  442.                         switch (*tptr) {
  443.                             case EQUAL:                /* == */
  444.                                 return EQUALTO;
  445.                             case NOT:                /* != */
  446.                                 return NOTEQUAL;
  447.                             case LESS:                /* <= */
  448.                                 return LE;
  449.                             case GREATER:            /* >= */
  450.                                 return GE;
  451.                             case MULTIPLY:            /* *= */
  452.                                 return AUTOMUL;
  453.                             case DIVIDE:            /* /= */
  454.                                 return AUTODIV;
  455.                             case MODULO:            /* %= */
  456.                                 return AUTOMOD;
  457.                         }
  458.                     }
  459.                     SI_UngetSource(t2);
  460.                     break;
  461.             }
  462.             return *tptr;
  463.         }
  464.     return 0;
  465. }
  466.  
  467. /* ----- Test word for a keyword --------------------------------------- */
  468.  
  469. static Byte iskeyword()
  470. {
  471.     register struct keywords *k = kwds;
  472.  
  473.     while (k->kw)
  474.         if (!strcmp((char *)k->kw, (char *)tptr))
  475.             return k->kwtoken;
  476.         else
  477.             k++;
  478.     return 0;
  479. }
  480.  
  481. /* ----- Test for an ident (or constant) ------------------------------- */
  482.  
  483. static Byte isident()
  484. {
  485.     register Byte *wd = tptr;
  486.     register long n = 0;
  487.  
  488.     if (iscsymf(*wd))            /* Letter or underscore */
  489.         return IDENT;
  490.     if (!strncmp((char *)wd, "0x", 2) || !strncmp((char *)wd, "0X", 2)) {
  491.         wd += 2;                /* 0x... hex constant */
  492.         while (*wd) {
  493.             if (!isxdigit(*wd))
  494.                 return 0;        /* Not a hex digit */
  495.             n = (n << 4) + (isdigit(*wd) ? *wd - '0':
  496.                 tolower(*wd) - 'a' + 10);
  497.             wd++;
  498.         }
  499.     } else
  500.         while (*wd) {
  501.             if (!isdigit(*wd))
  502.                 return 0;        /* Not a digit */
  503.             n = (n * 10) + (*wd -'0');
  504.             wd++;
  505.         }
  506.     x2str(n, (Byte *)tptr);        /* Converted constant */
  507.     return CONSTANT;
  508. }
  509.  
  510. /* ----- Get the next word from the input stream ----------------------- */
  511.  
  512. static Byte getword()
  513. {
  514.     register Byte *wd = tptr;
  515.     register Byte c;
  516.     register Byte tok;
  517.  
  518.     do
  519.         c = getok();                /* Bypass white space */
  520.     while (iswhite(c));
  521.     if (c == QUOTE) {
  522.         register unsigned long n = 0;
  523.         register short max = 4;        /* Maximum 4 characters */
  524.         while ((c = getcx()) != QUOTE) {
  525.             if (!max)
  526.                 error(MISSING, (Byte *)"'");/* Needs the other quote */
  527.             max--;
  528.             if (c  == '\\')            /* Escape sequence (\015) */
  529.                 c = escseq();
  530.             n = (n << 8) | (c & ((Byte) 0xFF));
  531.         }
  532.         x2str(n, (Byte *)tptr);        /* Build the constant value */
  533.         return CONSTANT;
  534.     }
  535.     if (c == QUOTES) {
  536.         tok = STRING;                /* Quoted string "abc" */
  537.         while ((c = getcx()) != QUOTES)
  538.             *wd++ = (c == '\\') ? escseq() : c;
  539.     } else {
  540.         tok = 0;
  541.         *wd++ = c;                    /* 1st char of word */
  542.         while (iscsym(c)) {            /* Build an ident */
  543.             c = getok();
  544.             if (iscsym(c))
  545.                 *wd++ = c;
  546.             else
  547.                 SI_UngetSource(c);
  548.         }
  549.     }
  550.     *wd = '\0';        /* Null terminate the string or word */
  551.     return tok;
  552. }
  553.  
  554. /* ----- Escape sequence in litteral constant or string ---------------- */
  555.  
  556. static Byte h2()
  557. {
  558.     register Byte v = 0;
  559.     register short n = 2;
  560.     register Byte c;
  561.  
  562.     while (n--) {
  563.         c = getcx();
  564.         if (!isxdigit(c)) {
  565.             Byte s[2];
  566.             s[0] = c;
  567.             s[1] = 0;
  568.             error(OUTOFPLACE, s);    /* Not a hex digit */
  569.         }
  570.         v = (v << 4) + (isdigit(c) ? c - '0': tolower(c) - 'a' + 10);
  571.     }
  572.     return v;
  573. }
  574.  
  575. static Byte escseq()
  576. {
  577.     register Byte c = getcx();
  578.  
  579.     return (c == 'n' ? '\012' :                /* 0x0A (LF)    */
  580.         c == 't' ? '\011' :                    /* 0x09 (TAB)    */
  581.         c == 'f' ? '\014' :                    /* 0x0C (FF)    */
  582.         c == 'a' ? '\007' :                    /* 0x07 (BEL)    */
  583.         c == 'b' ? '\010' :                    /* 0x08 (BS)    */
  584.         c == 'r' ? '\015' :                    /* 0x0D (CR)    */
  585.         c == 'v' ? '\013' :                    /* 0x0B    (VT)    */
  586.         c == '0' ? '\0' :                    /* 0x00 (NUL)    */
  587.         (c == 'x') || (c == 'X') ? h2() :    /* 2 hex digits */
  588.         c);
  589. }
  590.  
  591. /* ----- Get a character from the input stream ------------------------- */
  592.  
  593. static Byte getok()
  594. {
  595.     register short c;
  596.     register short c1;
  597.  
  598.     while ((c = SI_GetSource()) == COMMENT1) {
  599.         if ((c1 = SI_GetSource()) != COMMENT2) {
  600.             SI_UngetSource(c1);
  601.             break;
  602.         }
  603.         do {
  604.             while ((c1 = getcx()) != COMMENT2)
  605.                 if (c1 == EOLN)
  606.                     ++linenumber;
  607.             c1 = getcx();
  608.             if (c1 == EOLN)
  609.                 ++linenumber;
  610.         } while (c1 != COMMENT1);
  611.     }
  612.     return c;
  613. }
  614.  
  615. /* ----- Read a character from input, error if EOF --------------------- */
  616.  
  617. static Byte getcx()
  618. {
  619.     register short c;
  620.  
  621.     if ((c = SI_GetSource()) == -1)
  622.         error(EARLYEOF, (Byte *) "getcx");
  623.     return c;
  624. }
  625.  
  626. /* ----- A function is called thru a pointer --------------------------- */
  627.  
  628. static INTEGER pfunction(fp, sp)
  629. register Byte *fp;                    /* Points to function definition */
  630. SYMBOL *sp;
  631. {
  632.     register short i;
  633.     register short p = 0;            /* Number of parameters */
  634.     Byte *savetptr;                    /* Will be saved and restored */
  635.     Byte *ap = StackPtr;            /* Start of local arrays */
  636.     register INTEGER *pp;
  637.  
  638.     needtoken(LPAREN);
  639.     if (!iftoken(RPAREN)) {            /* Scan for actual parameters */
  640.         do {
  641.             pp = (INTEGER *)allocate(sizeof(INTEGER));
  642.             *pp = expression(sp);    /* Evaluate parameter */
  643.             p++;
  644.         } while (iftoken(COMMA));
  645.         needtoken(RPAREN);
  646.     }
  647.     savetptr = tptr;
  648.     if (*fp == LPAREN) {            /* Call token function */
  649.         tptr = fp;
  650.         needtoken(LPAREN);
  651.         sp = SymTop;                /* Local symbols start here */
  652.         pp = (INTEGER *)ap;
  653.         for (i = 0; i < p; i++) {    /* Params into local symbol table */
  654.             short size;
  655.             short ind = 0;
  656.             if (iftoken(CHAR))
  657.                 size = 1;
  658.             else if (iftoken(INT))
  659.                 size = sizeof(INTEGER);
  660.             else
  661.                 error(PARAMERR, EmptyStr);
  662.             while (iftoken(POINTER))
  663.                 ind++;
  664.             needtoken(IDENT);
  665.             addsymbol(sp, tptr, *pp++, size, ind);
  666.             bypass();
  667.             if (i < p-1)
  668.                 needtoken(COMMA);
  669.         }
  670.         StackPtr = ap;                /* Remove parameters from stack */
  671.         needtoken(RPAREN);
  672.         compound_statement(sp);        /* Execute the function */
  673.         SymTop = sp;                /* Release the local symbols */
  674.         breaking = returning = FALSE;
  675.     } else {                        /* Call intrinisic function */
  676. #ifdef THINK_C
  677.            if (*fp != 0x4E || (long)fp & 1)/* Check for LINK instruction */
  678.             error(NOTFUNC, EmptyStr);    /* ...on an even address */
  679. #endif
  680.         frtn = (*(IFUNC)fp)((INTEGER *) ap);
  681.         StackPtr = ap;                /* Remove parameters from stack */
  682.     }
  683.     tptr = savetptr;
  684.     return frtn;                    /* The function's return value */
  685. }
  686.  
  687. /* ----- Execute one statement or a {} block --------------------------- */
  688.  
  689. static void statements(sp)
  690. register SYMBOL *sp;
  691. {
  692.     if (iftoken(LBRACE)) {
  693.         --tptr;
  694.         compound_statement(sp);
  695.     } else
  696.         statement(sp);
  697. }
  698.  
  699. /* ----- Execute a {} statement block ---------------------------------- */
  700.  
  701. static void compound_statement(sp)
  702. register SYMBOL *sp;
  703. {
  704.     register short tok;
  705.  
  706.     if (!skipping) {
  707.         register Byte *svtptr = tptr;
  708.         register SYMBOL *spp = SymTop;    /* Local symbol table */
  709.         Byte *app = StackPtr;
  710.  
  711.         needtoken(LBRACE);
  712.         do {                            /* Local variables in block */
  713.             register SYMBOL *symbole;
  714.             short size = 1;
  715.             switch (tok = nexttoken()) {
  716.                 case INT:
  717.                     size = sizeof(INTEGER);
  718.                 case CHAR:
  719.                     do {
  720.                         short ind = 0;
  721.                         while (iftoken(POINTER))
  722.                             ind++;
  723.                         needtoken(IDENT);
  724.                         symbole = addsymbol(spp, tptr, 0, size, ind);
  725.                         bypass();
  726.                         if (iftoken(EQUAL))        /* Handle assignments */
  727.                             symbole->value = expression(sp);
  728.                         else if (iftoken(LBRACKET)) {    /* Array */
  729.                             short n =
  730.                                 (symbole->size == 1 && symbole->ind == 0) ?
  731.                                 1 : sizeof(INTEGER);
  732.                             symbole->value =
  733.                                 (INTEGER)allocate(n * expression(sp));
  734.                             (symbole->ind)++;
  735.                             needtoken(RBRACKET);
  736.                         }
  737.                     } while (iftoken(COMMA));
  738.                     needtoken(SEMICOLON);
  739.                     break;
  740.                 default:
  741.                     tptr--;
  742.                     tok = 0;
  743.             }
  744.         } while (tok);
  745.         while (!iftoken(RBRACE) && !breaking && !returning)
  746.             statements(sp);
  747.         SymTop = spp;                /* Free the local symbols */
  748.         StackPtr = app;                /* Free the local arrays */
  749.         tptr = svtptr;                /* Point to the opening brace */
  750.     }
  751.     skippair(LBRACE, RBRACE);        /* Skip to end of block */
  752. }
  753.  
  754. /* ----- Execute a single statement ------------------------------------ */
  755.  
  756. static void statement(sp)
  757. register SYMBOL *sp;
  758. {
  759.     register INTEGER rtn;
  760.     register short tok;
  761.  
  762.     switch (tok = nexttoken()) {
  763.         case IF:
  764.             /* if ( expression ) statements                 */
  765.             /* if ( expression ) statements else statements */
  766.             if (skipping) {
  767.                 skippair(LPAREN, RPAREN);
  768.                 skip_statements(sp);
  769.                 while (iftoken(ELSE))
  770.                     skip_statements(sp);
  771.                 break;
  772.             }
  773.             needtoken(LPAREN);
  774.             rtn = expression(sp);        /* Condidtion beeing tested */
  775.             needtoken(RPAREN);
  776.             if (rtn)
  777.                 statements(sp);            /* Condition is TRUE */
  778.             else
  779.                 skip_statements(sp);    /* Condition is FALSE */
  780.             while (iftoken(ELSE))
  781.                 if (rtn)                /* Do the reverse for else */
  782.                     skip_statements(sp);
  783.                 else
  784.                     statements(sp);
  785.             break;
  786.         case WHILE:
  787.             /* while ( expression) statements */
  788.             if (skipping) {
  789.                 skippair(LPAREN, RPAREN);
  790.                 skip_statements(sp);
  791.                 break;
  792.             }
  793.             {
  794.                 Byte *svtptr = tptr;
  795.                 breaking = returning = FALSE;
  796.                 do {
  797.                     tptr = svtptr;
  798.                     needtoken(LPAREN);
  799.                     rtn = expression(sp);        /* The condition tested */
  800.                     needtoken(RPAREN);
  801.                     if (rtn)                    /* Condition is TRUE */
  802.                         statements(sp);
  803.                     else                        /* Condition is FALSE */
  804.                         skip_statements(sp);
  805.                 } while (rtn && !breaking && !returning);
  806.                 breaking = FALSE;
  807.             }
  808.             break;
  809.         case FOR:
  810.             /* for (expression ; expression ; expression) statements */
  811.             if (skipping) {
  812.                 skippair(LPAREN, RPAREN);
  813.                 skip_statements(sp);
  814.                 break;
  815.             }
  816.             {
  817.                 Byte *fortest, *forloop, *forblock;
  818.                 Byte *svtptr = tptr;        /* svtptr -> 1st ( after for */
  819.  
  820.                 needtoken(LPAREN);
  821.                 if (!iftoken(SEMICOLON)) {
  822.                     expression(sp);            /* Initial expression */
  823.                     needtoken(SEMICOLON);
  824.                 }
  825.                 fortest = tptr;                /* fortest:terminating test */
  826.                 tptr = svtptr;
  827.                 skippair(LPAREN, RPAREN);
  828.                 forblock = tptr;            /* forblock: block to run */
  829.                 tptr = fortest;
  830.                 breaking = returning = FALSE;
  831.                 while (TRUE) {
  832.                     if (!iftoken(SEMICOLON)) {
  833.                         if (!expression(sp))    /* Terminating test */
  834.                             break;
  835.                         needtoken(SEMICOLON);
  836.                     }
  837.                     forloop = tptr;
  838.                     tptr = forblock;
  839.                     statements(sp);            /* The loop statement(s) */
  840.                     if (breaking || returning)
  841.                         break;
  842.                     tptr = forloop;
  843.                     if (!iftoken(RPAREN)) {
  844.                         expression(sp);        /* End of loop expression */
  845.                         needtoken(RPAREN);
  846.                     }
  847.                     tptr = fortest;
  848.                 }
  849.                 tptr = forblock;
  850.                 skip_statements(sp);        /* Skip past the block */
  851.                 breaking = FALSE;
  852.             }
  853.             break;
  854.         case RETURN:
  855.             /* return ;            */
  856.             /* return expression ; */
  857.             if (!iftoken(SEMICOLON)) {
  858.                 frtn = expression(sp);        /* Function return value */
  859.                 needtoken(SEMICOLON);
  860.             }
  861.             returning = !skipping;
  862.             break;
  863.         case BREAK:
  864.             /* break ; */
  865.             needtoken(SEMICOLON);
  866.             breaking = !skipping;
  867.             break;
  868.         case IDENT:
  869.         case POINTER:
  870.         case AUTOINC:
  871.         case AUTODEC:
  872.         case LPAREN:
  873.             /* expression ; */
  874.             --tptr;
  875.             expression(sp);
  876.             needtoken(SEMICOLON);
  877.             break;
  878.         case SEMICOLON:
  879.             /* ; */
  880.             break;
  881.         default:
  882.             error(OUTOFPLACE, token2str(tok));
  883.     }
  884. }
  885.  
  886. /* ----- Bypass statement(s) ------------------------------------------- */
  887.  
  888. static void skip_statements(sp)
  889. register SYMBOL *sp;
  890. {
  891.     skipping++;            /* Semaphore that suppresses assignments, */
  892.     statements(sp);        /* ...breaks, returns, ++, --, function calls */
  893.     --skipping;            /* Turn off semaphore */
  894. }
  895.  
  896. /* ----- Recursive descent expression analyzer ------------------------- */
  897.  
  898. static void rvalue(env)            /* Read value */
  899. register ENV *env;
  900. {
  901.     register short character;
  902.  
  903.     if (skipping) {
  904.         env->value = 1;
  905.         env->adr = FALSE;
  906.         return;
  907.     }
  908.     if (env->adr) {
  909.         switch (env->size) {
  910.             case 1:
  911.                 character = (env->ind) ? FALSE: TRUE;
  912.                 break;
  913.             case 0:
  914.             case sizeof(INTEGER):
  915.                 character = FALSE;
  916.                 break;
  917.             default:
  918.                 error(SYNTAX, EmptyStr);
  919.         }
  920.         if (character) {
  921.             register Byte *v = (Byte *)env->value;
  922.             env->value = *v;
  923.         } else {
  924.             register INTEGER *v = (INTEGER *)env->value;
  925.             env->value = *v;
  926.         }
  927.         env->adr = FALSE;
  928.     }
  929. }
  930.  
  931. static void store(env, val)        /* Store value */
  932. register ENV *env;
  933. register INTEGER val;
  934. {
  935.     register short character;
  936.  
  937.     if (skipping)
  938.         return;
  939.     if (env->adr) {
  940.         switch (env->size) {
  941.             case 1:
  942.                 character = (env->ind) ? FALSE: TRUE;
  943.                 break;
  944.             case sizeof(INTEGER):
  945.                 character = FALSE;
  946.                 break;
  947.             default:
  948.                 error(SYNTAX, EmptyStr);
  949.         }
  950.         if (character) {
  951.             register Byte *v = (Byte *)env->value;
  952.             *v = val;
  953.         } else {
  954.             register INTEGER *v = (INTEGER *)env->value;
  955.             *v = val;
  956.         }
  957.     } else
  958.         error(SYNTAX, EmptyStr);
  959. }
  960.  
  961. static INTEGER expression(sp)    /* Evaluate expression */
  962. register SYMBOL *sp;
  963. {
  964.     ENV env;
  965.  
  966.     env.sp = sp;
  967.     assign(&env);
  968.     rvalue(&env);
  969.     return env.value;        /* Return expression result */
  970. }
  971.  
  972. static void assign(env)        /* Handle assignments (=) */
  973. register ENV *env;
  974. {
  975.     ENV env2;
  976.  
  977.     or(env);
  978.     while (iftoken(EQUAL)) {
  979.         env2.sp = env->sp;
  980.         assign(&env2);
  981.         rvalue(&env2);
  982.         store(env, env2.value);
  983.     }
  984. }
  985.  
  986. static void or(env)        /* Handle logical or (||) */
  987. register ENV *env;
  988. {
  989.     ENV env2;
  990.  
  991.     and(env);
  992.     while (iftoken(OR)) {
  993.         rvalue(env);
  994.         env2.sp = env->sp;
  995.         or(&env2);
  996.         rvalue(&env2);
  997.         env->value = env->value || env2.value;
  998.     }
  999. }
  1000.  
  1001. static void and(env)    /* Handle logical and (&&) */
  1002. register ENV *env;
  1003. {
  1004.     ENV env2;
  1005.  
  1006.     eq(env);
  1007.     while (iftoken(AND)) {
  1008.         rvalue(env);
  1009.         env2.sp = env->sp;
  1010.         and(&env2);
  1011.         rvalue(&env2);
  1012.         env->value = env->value && env2.value;
  1013.     }
  1014. }
  1015.  
  1016. static void eq(env)        /* Handle equal (==) and not equal (!=) */
  1017. register ENV *env;
  1018. {
  1019.     register short tok;
  1020.     ENV env2;
  1021.  
  1022.     le(env);
  1023.     while (TRUE)
  1024.         switch (tok = nexttoken()) {
  1025.             case EQUALTO:
  1026.                 rvalue(env);
  1027.                 env2.sp = env->sp;
  1028.                 eq(&env2);
  1029.                 rvalue(&env2);
  1030.                 env->value = env->value == env2.value;
  1031.                 break;
  1032.             case NOTEQUAL:
  1033.                 rvalue(env);
  1034.                 env2.sp = env->sp;
  1035.                 eq(&env2);
  1036.                 rvalue(&env2);
  1037.                 env->value = env->value != env2.value;
  1038.                 break;
  1039.             default:
  1040.                 tptr--;
  1041.                 return;
  1042.         }
  1043. }
  1044.  
  1045. static void le(env)        /* Handle relational operators: <= >= < > */
  1046. register ENV *env;
  1047. {
  1048.     register short tok;
  1049.     ENV env2;
  1050.  
  1051.     plus(env);
  1052.     while (TRUE)
  1053.         switch (tok = nexttoken()) {
  1054.             case LE:
  1055.                 rvalue(env);
  1056.                 env2.sp = env->sp;
  1057.                 le(&env2);
  1058.                 rvalue(&env2);
  1059.                 env->value = env->value <= env2.value;
  1060.                 break;
  1061.             case GE:
  1062.                 rvalue(env);
  1063.                 env2.sp = env->sp;
  1064.                 le(&env2);
  1065.                 rvalue(&env2);
  1066.                 env->value = env->value >= env2.value;
  1067.                 break;
  1068.             case LESS:
  1069.                 rvalue(env);
  1070.                 env2.sp = env->sp;
  1071.                 le(&env2);
  1072.                 rvalue(&env2);
  1073.                 env->value = env->value < env2.value;
  1074.                 break;
  1075.             case GREATER:
  1076.                 rvalue(env);
  1077.                 env2.sp = env->sp;
  1078.                 le(&env2);
  1079.                 rvalue(&env2);
  1080.                 env->value = env->value > env2.value;
  1081.                 break;
  1082.             default:
  1083.                 tptr--;
  1084.                 return;
  1085.         }
  1086. }
  1087.  
  1088. static void plus(env)            /* Handle addition and substraction */
  1089. register ENV *env;
  1090. {
  1091.     register short tok;
  1092.     register short scale;
  1093.     ENV env2;
  1094.  
  1095.     mult(env);
  1096.     while (TRUE)
  1097.         switch (tok = nexttoken()) {
  1098.             case PLUS:
  1099.                 rvalue(env);
  1100.                 env2.sp = env->sp;
  1101.                 plus(&env2);
  1102.                 rvalue(&env2);
  1103.                 scale = ((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1104.                     env->ind > 1) ? sizeof(INTEGER) : 1;
  1105.                 env->value += scale * env2.value;
  1106.                 break;
  1107.             case MINUS:
  1108.                 rvalue(env);
  1109.                 env2.sp = env->sp;
  1110.                 plus(&env2);
  1111.                 rvalue(&env2);
  1112.                 if (env->ind && env2.ind) {        /* Pointer difference */
  1113.                     if (env->ind != env2.ind)
  1114.                         error(POINTERERR, EmptyStr);
  1115.                     scale = ((env->ind == 1 &&
  1116.                         env->size == sizeof(INTEGER)) ||
  1117.                         env->ind > 1) ? sizeof(INTEGER) : 1;
  1118.                     env->value = (env->value - env2.value) / scale;
  1119.                     env->size = sizeof(INTEGER);
  1120.                     env->ind = 0;
  1121.                 } else {
  1122.                     scale = ((env->ind == 1 &&
  1123.                         env->size == sizeof(INTEGER)) ||
  1124.                         env->ind > 1) ? sizeof(INTEGER) : 1;
  1125.                     env->value -= scale * env2.value;
  1126.                 }
  1127.                 break;
  1128.             default:
  1129.                 tptr--;
  1130.                 return;
  1131.         }
  1132. }
  1133.  
  1134. static void mult(env)        /* Handle multiplication, division, modulo */
  1135. register ENV *env;
  1136. {
  1137.     register short tok;
  1138.     ENV env2;
  1139.  
  1140.     unary(env);
  1141.     while (TRUE)
  1142.         switch (tok = nexttoken()) {
  1143.             case MULTIPLY:
  1144.                 rvalue(env);
  1145.                 env2.sp = env->sp;
  1146.                 mult(&env2);
  1147.                 rvalue(&env2);
  1148.                 env->value *= env2.value;
  1149.                 break;
  1150.             case DIVIDE:
  1151.                 rvalue(env);
  1152.                 env2.sp = env->sp;
  1153.                 mult(&env2);
  1154.                 rvalue(&env2);
  1155.                  if (!env2.value)
  1156.                     error(DIVIDEERR, EmptyStr);
  1157.                 env->value /= env2.value;
  1158.                 break;
  1159.             case MODULO:
  1160.                 rvalue(env);
  1161.                 env2.sp = env->sp;
  1162.                 mult(&env2);
  1163.                 rvalue(&env2);
  1164.                  if (!env2.value)
  1165.                     error(DIVIDEERR, EmptyStr);
  1166.                 env->value %= env2.value;
  1167.                 break;
  1168.             default:
  1169.                 tptr--;
  1170.                 return;
  1171.         }
  1172. }
  1173.  
  1174. /*
  1175.     Check for:
  1176.     leading ++
  1177.     leading --
  1178.     unary -
  1179.     pointer indicator (*)
  1180.     address operator (&)
  1181.     trailing ++
  1182.     trailing --
  1183. */
  1184.  
  1185. static void unary(env)
  1186. register ENV *env;
  1187. {
  1188.     ENV env2;
  1189.  
  1190.     if (iftoken(AUTOINC)) {
  1191.         unary(env);
  1192.         env2 = *env;
  1193.         rvalue(&env2);
  1194.         env2.value += ((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1195.             env->ind > 1) ? sizeof(INTEGER) : 1;
  1196.         store(env, env2.value);
  1197.         return;
  1198.     }
  1199.  
  1200.     if (iftoken(AUTODEC)) {
  1201.         unary(env);
  1202.         env2 = *env;
  1203.         rvalue(&env2);
  1204.         env2.value -= ((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1205.             env->ind > 1) ? sizeof(INTEGER) : 1;
  1206.         store(env, env2.value);
  1207.         return;
  1208.     }
  1209.  
  1210.     if (iftoken(NOT)) {
  1211.         unary(env);
  1212.         rvalue(env);
  1213.         env->value = !env->value;
  1214.         env->size = sizeof(INTEGER);
  1215.         env->ind = 0;
  1216.         env->adr = FALSE;
  1217.         return;
  1218.     }
  1219.  
  1220.     if (iftoken(MINUS)) {
  1221.         unary(env);
  1222.         rvalue(env);
  1223.         env->value = -env->value;
  1224.         env->size = sizeof(INTEGER);
  1225.         env->ind = 0;
  1226.         env->adr = FALSE;
  1227.         return;
  1228.     }
  1229.  
  1230.     if (iftoken(POINTER)) {
  1231.         unary(env);
  1232.         rvalue(env);
  1233.         if (!env->ind)
  1234.             error(POINTERERR, EmptyStr);
  1235.         --(env->ind);
  1236.         switch (env->size) {
  1237.             case 1:
  1238.                 env->size = (env->ind) ? sizeof(INTEGER) : 1;
  1239.                 break;
  1240.             case sizeof(INTEGER):
  1241.                 env->size = sizeof(INTEGER);
  1242.                 break;
  1243.             default:
  1244.                 error(SYNTAX, EmptyStr);
  1245.         }
  1246.         env->adr = TRUE;
  1247.         return;
  1248.     }
  1249.  
  1250.     if (iftoken(ADDRESS)) {
  1251.         unary(env);
  1252.         if (!env->adr)
  1253.             error(SYNTAX, EmptyStr);
  1254.         env->size = sizeof(INTEGER);
  1255.         env->ind = 0;
  1256.         env->adr = FALSE;
  1257.         return;
  1258.     }
  1259.  
  1260.     variable(env);
  1261.  
  1262.     if (iftoken(AUTOINC)) {
  1263.         register INTEGER value;
  1264.         env2 = *env;
  1265.         rvalue(&env2);
  1266.         value = env2.value +
  1267.             (((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1268.             env->ind > 1) ? sizeof(INTEGER) : 1);
  1269.         store(env, value);
  1270.         *env = env2;
  1271.         return;
  1272.     }
  1273.  
  1274.     if (iftoken(AUTODEC)) {
  1275.         register INTEGER value;
  1276.         env2 = *env;
  1277.         rvalue(&env2);
  1278.         value = env2.value -
  1279.             (((env->ind == 1 && env->size == sizeof(INTEGER)) ||
  1280.             env->ind > 1) ? sizeof(INTEGER) : 1);
  1281.         store(env, value);
  1282.         *env = env2;
  1283.         return;
  1284.     }
  1285. }
  1286.  
  1287. static void variable(env)    /* Variables, arrays and functions */
  1288. register ENV *env;
  1289. {
  1290.     register short tok;
  1291.     register INTEGER index;
  1292.     register short size;
  1293.  
  1294.     primary(env);
  1295.     switch (tok = nexttoken()) {
  1296.         case LPAREN:
  1297.             tptr--;
  1298.             rvalue(env);
  1299.             if (skipping) {
  1300.                 skippair(LPAREN, RPAREN);
  1301.                 env->value = 1;
  1302.             } else
  1303.                 env->value = pfunction((Byte *)env->value, env->sp);
  1304.             env->ind = 0;
  1305.             env->size = sizeof(INTEGER);
  1306.             env->adr = FALSE;
  1307.             break;
  1308.         case LBRACKET:
  1309.             index = expression(env->sp);
  1310.             needtoken(RBRACKET);
  1311.             rvalue(env);
  1312.             if (!env->ind)
  1313.                 error(SYNTAX, EmptyStr);
  1314.             --(env->ind);
  1315.             switch (env->size) {
  1316.                 case 1:
  1317.                     size = (env->ind) ? sizeof(INTEGER) : 1;
  1318.                     break;
  1319.                 case sizeof(INTEGER):
  1320.                     size = sizeof(INTEGER);
  1321.                     break;
  1322.                 default:
  1323.                     error(SYNTAX, EmptyStr);
  1324.             }
  1325.             env->value += index * size;
  1326.             env->adr = TRUE;
  1327.             break;
  1328.         default:
  1329.             tptr--;
  1330.     }
  1331. }
  1332.  
  1333. static void primary(env)    /* Constants, strings and identifiers */
  1334. register ENV *env;
  1335. {
  1336.     short tok;
  1337.     register SYMBOL *sym;
  1338.  
  1339.     switch (tok = nexttoken()) {
  1340.         case LPAREN:
  1341.             assign(env);
  1342.             needtoken(RPAREN);
  1343.             break;
  1344.         case CONSTANT:
  1345.             env->value = a2x((Byte *)tptr);
  1346.             bypass();
  1347.             env->ind = 0;
  1348.             env->size = sizeof(INTEGER);
  1349.             env->adr = FALSE;
  1350.             break;
  1351.         case STRING:
  1352.             env->value = (INTEGER)tptr;
  1353.             bypass();
  1354.             env->ind = 0;
  1355.             env->size = sizeof(INTEGER);
  1356.             env->adr = FALSE;
  1357.             break;
  1358.         case IDENT:
  1359.             /* First check locals, then globals */
  1360.             if (!(sym = ifsymbol(env->sp, tptr, SymTop)))
  1361.                 sym = findsymbol(Globals, tptr, EndGlobals);
  1362.             bypass();
  1363.             env->value = (INTEGER)&sym->value;
  1364.             /* Adjust address of char variables */
  1365.             if (sym->size == 1 && sym->ind == 0)
  1366.                 env->value += sizeof(INTEGER) - 1;
  1367.             env->ind = sym->ind;
  1368.             env->size = sym->size;
  1369.             env->adr = TRUE;
  1370.             break;
  1371.         default:
  1372.             error(OUTOFPLACE, token2str(tok));
  1373.     }
  1374. }
  1375.  
  1376. /* ----- Skip the tokens between a matched pair ------------------------ */
  1377.  
  1378. static void skippair(register Byte ltok, register Byte rtok)
  1379. {
  1380.     register short pairct = 0;
  1381.     register Byte tok;
  1382.  
  1383.     needtoken(tok = ltok);
  1384.     while (TRUE) {
  1385.         if (tok == ltok)
  1386.             pairct++;
  1387.         if (tok == rtok)
  1388.             if (--pairct == 0)
  1389.                 break;
  1390.         if ((tok = nexttoken()) == T_EOF)
  1391.             error(MATCHERR, token2str(ltok));
  1392.     }
  1393. }
  1394.  
  1395. /* ----- A specified token is required next ---------------------------- */
  1396.  
  1397. static void needtoken(register Byte tk)
  1398. {
  1399.     if (nexttoken() != tk)
  1400.         error(MISSING, token2str(tk));
  1401. }
  1402.  
  1403. /* ----- Test for a specified token next in line ----------------------- */
  1404.  
  1405. static Boolean iftoken(register Byte tk)
  1406. {
  1407.     if (nexttoken() == tk)
  1408.         return TRUE;
  1409.     --tptr;
  1410.     return FALSE;
  1411. }
  1412.  
  1413. /* ----- Get the next token from the buffer ---------------------------- */
  1414.  
  1415. static Byte nexttoken()
  1416. {
  1417.     while (*tptr == LINENO)
  1418.         tptr++;
  1419.     return *tptr++;
  1420. }
  1421.  
  1422. /* ----- Add a symbol to the symbol table ------------------------------ */
  1423.  
  1424. static SYMBOL *addsymbol(
  1425. register SYMBOL *s,            /* Start of local symbol table */
  1426. register Byte *name,            /* Pointer to symbol name */
  1427. register INTEGER value,            /* Value of symbol */
  1428. register Byte size,                /* Size of value */
  1429. register Byte ind                /* Indirection level */
  1430. )
  1431. {
  1432.     if (ifsymbol(s, name, SymTop))
  1433.         error(DUPL_DECLARE, name);        /* Already declared */
  1434.     s = --SymTop;
  1435.     if ((Byte *)s < StackPtr)
  1436.         error(TABLEOVERFLOW, name);        /* Symbol table full */
  1437.     s->name = name;
  1438.     s->value = value;
  1439.     s->size = size;
  1440.     s->ind = ind;
  1441.     return s;
  1442. }
  1443.  
  1444. /* ----- Find a symbol on the symbol table (error if not found) -------- */
  1445.  
  1446. static SYMBOL *findsymbol(s, sym, ends)
  1447. register SYMBOL *s;                /* Start of local symbol table */
  1448. register Byte *sym;                /* Symbol name */
  1449. register SYMBOL *ends;            /* End of local symbol table */
  1450. {
  1451.     if (!(s = ifsymbol(s, sym, ends)))
  1452.         error(UNDECLARED, sym);
  1453.     return s;
  1454. }
  1455.  
  1456. /* ----- Test for a symbol on the symbol table ------------------------- */
  1457.  
  1458. static SYMBOL *ifsymbol(s, sym, sp)
  1459. register SYMBOL *s;                /* Start of local symbol table */
  1460. register Byte *sym;                /* Symbol name */
  1461. register SYMBOL *sp;            /* End of local symbol table */
  1462. {
  1463.     while (sp < s) {
  1464.         if (!strcmp((char *)sym, (char *)sp->name))
  1465.             return sp;
  1466.         sp++;
  1467.     }
  1468.     return NULL;
  1469. }
  1470.  
  1471. /* ----- Post an error to the shell ------------------------------------ */
  1472.  
  1473. static void error(erno, s)
  1474. register enum errs erno;
  1475. register Byte *s;
  1476. {
  1477.     register Byte *p;
  1478.     register n;
  1479.     char str[256];
  1480.     
  1481.     if (linenumber)
  1482.         n = linenumber;
  1483.     else {
  1484.         if (tptr < TokenBuffer || tptr >= LoMem)
  1485.             n = 0;    /* Happens if main() is not found */
  1486.         else {
  1487.             for (n = 1, p = TokenBuffer; p <= tptr; p++)
  1488.                 if (*p == LINENO)
  1489.                     n++;
  1490.         }
  1491.     }
  1492.     strcpy(str, errstr[erno]);
  1493.     strcat(str, " :");
  1494.     strcat(str, (char *) s);
  1495.     SI_Error(erno, (Byte *) str, n);
  1496. }
  1497.  
  1498. /* ----- Convert token to string (for error messages) ------------------ */
  1499.  
  1500. static Byte *token2str(
  1501. register short token)
  1502. {
  1503.     static Byte s[2];
  1504.     register Byte *p = s;
  1505.  
  1506.     switch (token) {
  1507.         case AUTOINC:
  1508.             *p++ = '+';
  1509.             *p++ = '+';
  1510.             break;
  1511.         case AUTODEC:
  1512.             *p++ = '-';
  1513.             *p++ = '-';
  1514.             break;
  1515.         case EQUALTO:
  1516.             *p++ = '=';
  1517.             *p++ = '=';
  1518.             break;
  1519.         case NOTEQUAL:
  1520.             *p++ = '!';
  1521.             *p++ = '=';
  1522.             break;
  1523.         case GE:
  1524.             *p++ = '>';
  1525.             *p++ = '=';
  1526.             break;
  1527.         case LE:
  1528.             *p++ = '<';
  1529.             *p++ = '=';
  1530.             break;
  1531.         case AUTOADD:
  1532.             *p++ = '+';
  1533.             *p++ = '=';
  1534.             break;
  1535.         case AUTOSUB:
  1536.             *p++ = '-';
  1537.             *p++ = '=';
  1538.             break;
  1539.         case AUTOMUL:
  1540.             *p++ = '*';
  1541.             *p++ = '=';
  1542.             break;
  1543.         case AUTODIV:
  1544.             *p++ = '/';
  1545.             *p++ = '=';
  1546.             break;
  1547.         case AND:
  1548.             *p++ = '&';
  1549.         case ADDRESS:
  1550.             *p++ = '&';
  1551.             break;
  1552.         case OR:
  1553.             *p++ = '|';
  1554.         default:
  1555.             *p++ = token;
  1556.     }
  1557.     *p = '\0';
  1558.     return s;
  1559. }
  1560.  
  1561. /* ----- Convert long to string ---------------------------------------- */
  1562.  
  1563. static void x2str(num, str)
  1564. register long num;                /* Number to convert */
  1565. register Byte *str;                /* String for result */
  1566. {
  1567.     register short n;
  1568.     register Byte nibble;
  1569.     register short flg = FALSE;
  1570.  
  1571.     for (n = 28; n >=0 ; n -= 4) {
  1572.         if (nibble = (num >> n) & ((Byte) 0x0F))
  1573.             flg = TRUE;
  1574.         if (flg)
  1575.             *str++ = nibble | ((Byte) 0x30);
  1576.         }
  1577.     *str = 0;
  1578. }
  1579.  
  1580. /* ----- Convert string to long ---------------------------------------- */
  1581.  
  1582. long a2x(s)
  1583. register Byte *s;
  1584. {
  1585.     register unsigned long v = 0;
  1586.  
  1587.     while (isspace(*s))
  1588.         s++;
  1589.     while (*s >= (Byte) 0x30 && *s <= ((Byte) 0x3F))    /* '0' .. '?' */
  1590.         v = (v << 4) + (*s++ & ((Byte) 0x0F));
  1591.     return (long)v;
  1592. }
  1593.