home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / lex3.c < prev    next >
C/C++ Source or Header  |  1990-03-13  |  36KB  |  1,316 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  4.  
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  8.  
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  13.  
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  17.  
  18. #define PROTO_LEX3_C
  19. #include "trans.h"
  20.  
  21. /* Define LEXDEBUG for a token trace */
  22. #define LEXDEBUG
  23.  
  24. #define EOFMARK 1
  25.  
  26. extern char dollar_flag;
  27. extern char lex_initialized;
  28. extern int if_flag;
  29. extern int if_skip;
  30. extern int commenting_flag;
  31. extern char *commenting_ptr;
  32. extern int skipflag;
  33. extern char modulenotation;
  34. extern short inputkind;
  35. extern Strlist *instrlist;
  36. extern char inbuf[300];
  37. extern char *oldinfname;
  38. extern char *oldctxname;
  39. extern Strlist *endnotelist;
  40.  
  41. #define INP_FILE     0
  42. #define INP_INCFILE  1
  43. #define INP_STRLIST  2
  44.  
  45. extern struct inprec {
  46.     struct inprec *next;
  47.     short kind;
  48.     char *fname, *inbufptr;
  49.     int lnum;
  50.     FILE *filep;
  51.     Strlist *strlistp, *tempopts;
  52.     Token curtok, saveblockkind;
  53.     Symbol *curtoksym;
  54.     Meaning *curtokmeaning;
  55. } *topinput;
  56.  
  57. Static void comment(starparen)
  58. int starparen;    /* 0={ }, 1=(* *), 2=C comments*/
  59. {
  60.     register char ch;
  61.     int nestcount = 1, startlnum = inf_lnum, trailing;
  62.     int i, cmtindent, cmtindent2;
  63.     char *cp;
  64.  
  65.     cp = inbuf;
  66.     while (isspace(*cp))
  67.     cp++;
  68.     trailing = (*cp != '{' && ((*cp != '(' && *cp != '/') || cp[1] != '*'));
  69.     cmtindent = inbufindent;
  70.     cmtindent2 = cmtindent + 1 + (starparen != 0);
  71.     cp = inbufptr;
  72.     while (isspace(*cp))
  73.     cmtindent2++, cp++;
  74.     cp = curtokbuf;
  75.     for (;;) {
  76.         ch = *inbufptr++;
  77.         switch (ch) {
  78.  
  79.             case '}':
  80.                 if ((!starparen || nestedcomments == 0) &&
  81.             starparen != 2 &&
  82.                     --nestcount <= 0) {
  83.                     *cp = 0;
  84.             if (!commenting_flag)
  85.             commentline(trailing ? CMT_TRAIL : CMT_POST);
  86.                     return;
  87.                 }
  88.                 break;
  89.  
  90.             case '{':
  91.                 if (nestedcomments == 1 && starparen != 2)
  92.                     nestcount++;
  93.                 break;
  94.  
  95.             case '*':
  96.                 if ((*inbufptr == ((starparen == 2) ? '/' : ')') &&
  97.              (starparen || nestedcomments == 0)) &&
  98.                     --nestcount <= 0) {
  99.                     inbufptr++;
  100.                     *cp = 0;
  101.             if (!commenting_flag)
  102.             commentline(trailing ? CMT_TRAIL : CMT_POST);
  103.                     return;
  104.                 }
  105.                 break;
  106.  
  107.             case '(':
  108.                 if (*inbufptr == '*' && nestedcomments == 1 &&
  109.             starparen != 2) {
  110.             *cp++ = ch;
  111.             ch = *inbufptr++;
  112.                     nestcount++;
  113.         }
  114.                 break;
  115.  
  116.             case 0:
  117.                 *cp = 0;
  118.             if (commenting_flag)
  119.             saveinputcomment(inbufptr-1);
  120.         else
  121.             commentline(CMT_POST);
  122.         trailing = 0;
  123.                 getline();
  124.         i = 0;
  125.         for (;;) {
  126.             if (*inbufptr == ' ') {
  127.             inbufptr++;
  128.             i++;
  129.             } else if (*inbufptr == '\t') {
  130.             inbufptr++;
  131.             i++;
  132.             if (intabsize)
  133.                 i = (i / intabsize + 1) * intabsize;
  134.             } else
  135.             break;
  136.         }
  137.         cp = curtokbuf;
  138.         if (*inbufptr) {
  139.             if (i == cmtindent2 && !starparen)
  140.             cmtindent--;
  141.             cmtindent2 = -1;
  142.             if (i >= cmtindent) {
  143.             *cp++ = '\002';
  144.             i -= cmtindent;
  145.             } else {
  146.             *cp++ = '\003';
  147.             }
  148.             while (--i >= 0)
  149.             *cp++ = ' ';
  150.         } else
  151.             *cp++ = '\003';
  152.                 continue;
  153.  
  154.             case EOFMARK:
  155.                 error(format_d("Runaway comment from line %d", startlnum));
  156.                 return;     /* unnecessary */
  157.  
  158.         }
  159.         *cp++ = ch;
  160.     }
  161. }
  162.  
  163.  
  164.  
  165. char *getinlinepart()
  166. {
  167.     char *cp, *buf;
  168.  
  169.     for (;;) {
  170.         if (isspace(*inbufptr)) {
  171.             inbufptr++;
  172.         } else if (!*inbufptr) {
  173.             getline();
  174.         } else if (*inbufptr == '{') {
  175.             inbufptr++;
  176.             comment(0);
  177.         } else if (*inbufptr == '(' && inbufptr[1] == '*') {
  178.             inbufptr += 2;
  179.             comment(1);
  180.         } else
  181.             break;
  182.     }
  183.     cp = inbufptr;
  184.     while (isspace(*cp) || isalnum(*cp) ||
  185.            *cp == '_' || *cp == '$' || 
  186.            *cp == '+' || *cp == '-' ||
  187.            *cp == '<' || *cp == '>')
  188.         cp++;
  189.     if (cp == inbufptr)
  190.         return "";
  191.     while (isspace(cp[-1]))
  192.         cp--;
  193.     buf = format_s("%s", inbufptr);
  194.     buf[cp-inbufptr] = 0;     /* truncate the string */
  195.     inbufptr = cp;
  196.     return buf;
  197. }
  198.  
  199.  
  200.  
  201.  
  202. Static int getflag()
  203. {
  204.     int res = 1;
  205.  
  206.     gettok();
  207.     if (curtok == TOK_IDENT) {
  208.         res = (strcmp(curtokbuf, "OFF") != 0);
  209.         gettok();
  210.     }
  211.     return res;
  212. }
  213.  
  214.  
  215.  
  216.  
  217. char getchartok()
  218. {
  219.     if (!*inbufptr) {
  220.         warning("Unexpected end of line [236]");
  221.         return ' ';
  222.     }
  223.     if (isspace(*inbufptr)) {
  224.         warning("Whitespace not allowed here [237]");
  225.         return ' ';
  226.     }
  227.     return *inbufptr++;
  228. }
  229.  
  230.  
  231.  
  232. char *getparenstr(buf)
  233. char *buf;
  234. {
  235.     int count = 0;
  236.     char *cp;
  237.  
  238.     if (inbufptr < buf)    /* this will get most bad cases */
  239.         error("Can't handle a line break here");
  240.     while (isspace(*buf))
  241.         buf++;
  242.     cp = buf;
  243.     for (;;) {
  244.         if (!*cp)
  245.             error("Can't handle a line break here");
  246.         if (*cp == '(')
  247.             count++;
  248.         if (*cp == ')')
  249.             if (--count < 0)
  250.                 break;
  251.         cp++;
  252.     }
  253.     inbufptr = cp + 1;
  254.     while (cp > buf && isspace(cp[-1]))
  255.         cp--;
  256.     return format_ds("%.*s", (int)(cp - buf), buf);
  257. }
  258.  
  259.  
  260.  
  261. void leadingcomments()
  262. {
  263.     for (;;) {
  264.         switch (*inbufptr++) {
  265.  
  266.             case 0:
  267.                 getline();
  268.                 break;
  269.  
  270.             case ' ':
  271.             case '\t':
  272.             case 26:
  273.                 /* ignore whitespace */
  274.                 break;
  275.  
  276.             case '{':
  277.                 if (!parsecomment(1, 0)) {
  278.                     inbufptr--;
  279.                     return;
  280.                 }
  281.                 break;
  282.  
  283.         case '(':
  284.         if (*inbufptr == '*') {
  285.             inbufptr++;
  286.             if (!parsecomment(1, 1)) {
  287.             inbufptr -= 2;
  288.             return;
  289.             }
  290.             break;
  291.         }
  292.         /* fall through */
  293.  
  294.             default:
  295.                 inbufptr--;
  296.                 return;
  297.  
  298.         }
  299.     }
  300. }
  301.  
  302.  
  303.  
  304.  
  305. void get_C_string(term)
  306. int term;
  307. {
  308.     char *cp = curtokbuf;
  309.     char ch;
  310.     int i;
  311.  
  312.     while ((ch = *inbufptr++)) {
  313.         if (ch == term) {
  314.             *cp = 0;
  315.             curtokint = cp - curtokbuf;
  316.             return;
  317.         } else if (ch == '\\') {
  318.             if (isdigit(*inbufptr)) {
  319.                 i = (*inbufptr++) - '0';
  320.                 if (isdigit(*inbufptr))
  321.                     i = i*8 + (*inbufptr++) - '0';
  322.                 if (isdigit(*inbufptr))
  323.                     i = i*8 + (*inbufptr++) - '0';
  324.                 *cp++ = i;
  325.             } else {
  326.                 ch = *inbufptr++;
  327.                 switch (tolower(ch)) {
  328.                     case 'n':
  329.                         *cp++ = '\n';
  330.                         break;
  331.                     case 't':
  332.                         *cp++ = '\t';
  333.                         break;
  334.                     case 'v':
  335.                         *cp++ = '\v';
  336.                         break;
  337.                     case 'b':
  338.                         *cp++ = '\b';
  339.                         break;
  340.                     case 'r':
  341.                         *cp++ = '\r';
  342.                         break;
  343.                     case 'f':
  344.                         *cp++ = '\f';
  345.                         break;
  346.                     case '\\':
  347.                         *cp++ = '\\';
  348.                         break;
  349.                     case '\'':
  350.                         *cp++ = '\'';
  351.                         break;
  352.                     case '"':
  353.                         *cp++ = '"';
  354.                         break;
  355.                     case 'x':
  356.                         if (isxdigit(*inbufptr)) {
  357.                             if (isdigit(*inbufptr))
  358.                                 i = (*inbufptr++) - '0';
  359.                             else
  360.                                 i = (toupper(*inbufptr++)) - 'A' + 10;
  361.                             if (isdigit(*inbufptr))
  362.                                 i = i*16 + (*inbufptr++) - '0';
  363.                             else if (isxdigit(*inbufptr))
  364.                                 i = i*16 + (toupper(*inbufptr++)) - 'A' + 10;
  365.                             *cp++ = i;
  366.                             break;
  367.                         }
  368.                         /* fall through */
  369.                     default:
  370.                         warning("Strange character in C string [238]");
  371.                 }
  372.             }
  373.         } else
  374.             *cp++ = ch;
  375.     }
  376.     *cp = 0;
  377.     curtokint = cp - curtokbuf;
  378.     warning("Unterminated C string [239]");
  379. }
  380.  
  381.  
  382.  
  383.  
  384.  
  385. void begincommenting(cp)
  386. char *cp;
  387. {
  388.     if (!commenting_flag) {
  389.     commenting_ptr = cp;
  390.     }
  391.     commenting_flag++;
  392. }
  393.  
  394.  
  395. void saveinputcomment(cp)
  396. char *cp;
  397. {
  398.     if (commenting_ptr)
  399.     sprintf(curtokbuf, "%.*s", (int)(cp - commenting_ptr), commenting_ptr);
  400.     else
  401.     sprintf(curtokbuf, "\003%.*s", (int)(cp - inbuf), inbuf);
  402.     commentline(CMT_POST);
  403.     commenting_ptr = NULL;
  404. }
  405.  
  406.  
  407. void endcommenting(cp)
  408. char *cp;
  409. {
  410.     commenting_flag--;
  411.     if (!commenting_flag) {
  412.     saveinputcomment(cp);
  413.     }
  414. }
  415.  
  416.  
  417.  
  418.  
  419. int peeknextchar()
  420. {
  421.     char *cp;
  422.  
  423.     cp = inbufptr;
  424.     while (isspace(*cp))
  425.     cp++;
  426.     return *cp;
  427. }
  428.  
  429.  
  430.  
  431.  
  432. #ifdef LEXDEBUG
  433. Static void zgettok();
  434. void gettok()
  435. {
  436.     zgettok();
  437.     if (tokentrace) {
  438.         printf("gettok() found %s", tok_name(curtok));
  439.         switch (curtok) {
  440.             case TOK_HEXLIT:
  441.             case TOK_OCTLIT:
  442.             case TOK_INTLIT:
  443.             case TOK_MININT:
  444.                 printf(", curtokint = %d", curtokint);
  445.                 break;
  446.             case TOK_REALLIT:
  447.             case TOK_STRLIT:
  448.                 printf(", curtokbuf = %s", makeCstring(curtokbuf, curtokint));
  449.                 break;
  450.         default:
  451.         break;
  452.         }
  453.         putchar('\n');
  454.     }
  455. }
  456. Static void zgettok()
  457. #else
  458. void gettok()
  459. #endif
  460. {
  461.     register char ch;
  462.     register char *cp;
  463.     char ch2;
  464.     char *startcp;
  465.     int i;
  466.  
  467.     debughook();
  468.     for (;;) {
  469.         switch ((ch = *inbufptr++)) {
  470.  
  471.             case 0:
  472.             if (commenting_flag)
  473.             saveinputcomment(inbufptr-1);
  474.                 getline();
  475.         cp = curtokbuf;
  476.         for (;;) {
  477.             inbufindent = 0;
  478.             for (;;) {
  479.             if (*inbufptr == '\t') {
  480.                 inbufindent++;
  481.                 if (intabsize)
  482.                 inbufindent = (inbufindent / intabsize + 1) * intabsize;
  483.             } else if (*inbufptr == ' ')
  484.                 inbufindent++;
  485.             else if (*inbufptr != 26)
  486.                 break;
  487.             inbufptr++;
  488.             }
  489.             if (!*inbufptr && !commenting_flag) {   /* blank line */
  490.             *cp++ = '\001';
  491.             getline();
  492.             } else
  493.             break;
  494.         }
  495.         if (cp > curtokbuf) {
  496.             *cp = 0;
  497.             commentline(CMT_POST);
  498.         }
  499.                 break;
  500.  
  501.             case '\t':
  502.             case ' ':
  503.             case 26:    /* ignore ^Z's in Turbo files */
  504.                 while (*inbufptr++ == ch) ;
  505.                 inbufptr--;
  506.                 break;
  507.  
  508.             case '$':
  509.         if (dollar_idents)
  510.             goto ident;
  511.                 if (dollar_flag) {
  512.                     dollar_flag = 0;
  513.                     curtok = TOK_DOLLAR;
  514.                     return;
  515.         }
  516.         startcp = inbufptr-1;
  517.         while (isspace(*inbufptr))
  518.             inbufptr++;
  519.         cp = inbufptr;
  520.         while (isxdigit(*cp))
  521.             cp++;
  522.         if (cp > inbufptr && cp <= inbufptr+8 && !isalnum(*cp)) {
  523.             while (isspace(*cp))
  524.             cp++;
  525.             if (!isdigit(*cp) && *cp != '\'') {
  526.             cp = curtokbuf;    /* Turbo hex constant */
  527.             while (isxdigit(*inbufptr))
  528.                 *cp++ = *inbufptr++;
  529.             *cp = 0;
  530.             curtok = TOK_HEXLIT;
  531.             curtokint = my_strtol(curtokbuf, NULL, 16);
  532.             return;
  533.             }
  534.                 }
  535.         dollar_flag++;     /* HP Pascal compiler directive */
  536.         do {
  537.             gettok();
  538.             if (curtok == TOK_IF) {             /* $IF expr$ */
  539.             Expr *ex;
  540.             Value val;
  541.             if (!skipping_module) {
  542.                 if (!setup_complete)
  543.                 error("$IF$ not allowed at top of program");
  544.  
  545.                 /* Even though HP Pascal doesn't let these nest,
  546.                    there's no harm in supporting it. */
  547.                 if (if_flag) {
  548.                 skiptotoken(TOK_DOLLAR);
  549.                 if_flag++;
  550.                 break;
  551.                 }
  552.                 gettok();
  553.                 ex = p_expr(tp_boolean);
  554.                 val = eval_expr_consts(ex);
  555.                 freeexpr(ex);
  556.                 i = (val.type == tp_boolean && val.i);
  557.                 free_value(&val);
  558.                 if (!i) {
  559.                 if (curtok != TOK_DOLLAR) {
  560.                     warning("Syntax error in $IF$ expression [240]");
  561.                     skiptotoken(TOK_DOLLAR);
  562.                 }
  563.                 begincommenting(startcp);
  564.                 if_flag++;
  565.                 while (if_flag > 0)
  566.                     gettok();
  567.                 endcommenting(inbufptr);
  568.                 }
  569.             } else {
  570.                 skiptotoken(TOK_DOLLAR);
  571.             }
  572.             } else if (curtok == TOK_END) {     /* $END$ */
  573.             if (if_flag) {
  574.                 gettok();
  575.                 if (!wexpecttok(TOK_DOLLAR))
  576.                 skiptotoken(TOK_DOLLAR);
  577.                 curtok = TOK_ENDIF;
  578.                 if_flag--;
  579.                 return;
  580.             } else {
  581.                 gettok();
  582.                 if (!wexpecttok(TOK_DOLLAR))
  583.                 skiptotoken(TOK_DOLLAR);
  584.             }
  585.             } else if (curtok == TOK_IDENT) {
  586.             if (!strcmp(curtokbuf, "INCLUDE") &&
  587.                  !if_flag && !skipping_module) {
  588.                 char *fn;
  589.                 gettok();
  590.                 if (curtok == TOK_IDENT) {
  591.                 fn = stralloc(curtokcase);
  592.                 gettok();
  593.                 } else if (wexpecttok(TOK_STRLIT)) {
  594.                 fn = stralloc(curtokbuf);
  595.                 gettok();
  596.                 } else
  597.                 fn = "";
  598.                 if (!wexpecttok(TOK_DOLLAR)) {
  599.                 skiptotoken(TOK_DOLLAR);
  600.                 } else {
  601.                 if (handle_include(fn))
  602.                     return;
  603.                 }
  604.             } else if (ignore_directives ||
  605.                    if_flag ||
  606.                    !strcmp(curtokbuf, "SEARCH") ||
  607.                    !strcmp(curtokbuf, "REF") ||
  608.                    !strcmp(curtokbuf, "DEF")) {
  609.                 skiptotoken(TOK_DOLLAR);
  610.             } else if (!strcmp(curtokbuf, "SWITCH_STRPOS")) {
  611.                 switch_strpos = getflag();
  612.             } else if (!strcmp(curtokbuf, "SYSPROG")) {
  613.                 if (getflag())
  614.                 sysprog_flag |= 1;
  615.                 else
  616.                 sysprog_flag &= ~1;
  617.             } else if (!strcmp(curtokbuf, "MODCAL")) {
  618.                 if (getflag())
  619.                 sysprog_flag |= 2;
  620.                 else
  621.                 sysprog_flag &= ~2;
  622.             } else if (!strcmp(curtokbuf, "PARTIAL_EVAL")) {
  623.                 if (shortcircuit < 0)
  624.                 partial_eval_flag = getflag();
  625.             } else if (!strcmp(curtokbuf, "IOCHECK")) {
  626.                 iocheck_flag = getflag();
  627.             } else if (!strcmp(curtokbuf, "RANGE")) {
  628.                 if (getflag()) {
  629.                 if (!range_flag)
  630.                     note("Range checking is ON [216]");
  631.                 range_flag = 1;
  632.                 } else {
  633.                 if (range_flag)
  634.                     note("Range checking is OFF [216]");
  635.                 range_flag = 0;
  636.                 }
  637.             } else if (!strcmp(curtokbuf, "OVFLCHECK")) {
  638.                 if (getflag()) {
  639.                 if (!ovflcheck_flag)
  640.                     note("Overflow checking is ON [219]");
  641.                 ovflcheck_flag = 1;
  642.                 } else {
  643.                 if (ovflcheck_flag)
  644.                     note("Overflow checking is OFF [219]");
  645.                 ovflcheck_flag = 0;
  646.                 }
  647.             } else if (!strcmp(curtokbuf, "STACKCHECK")) {
  648.                 if (getflag()) {
  649.                 if (!stackcheck_flag)
  650.                     note("Stack checking is ON [217]");
  651.                 stackcheck_flag = 1;
  652.                 } else {
  653.                 if (stackcheck_flag)
  654.                     note("Stack checking is OFF [217]");
  655.                 stackcheck_flag = 0;
  656.                 }
  657.             }
  658.             skiptotoken2(TOK_DOLLAR, TOK_COMMA);
  659.             } else {
  660.             warning("Mismatched '$' signs [241]");
  661.             dollar_flag = 0;    /* got out of sync */
  662.             return;
  663.             }
  664.         } while (curtok == TOK_COMMA);
  665.                 break;
  666.  
  667.             case '"':
  668.         if (C_lex) {
  669.             get_C_string(ch);
  670.             curtok = TOK_STRLIT;
  671.             return;
  672.         }
  673.         goto stringLiteral;
  674.  
  675.             case '#':
  676.         if (modula2) {
  677.             curtok = TOK_NE;
  678.             return;
  679.         }
  680.         cp = inbufptr;
  681.         while (isspace(*cp)) cp++;
  682.         if (!strcincmp(cp, "INCLUDE", 7)) {
  683.             char *cp2, *cp3;
  684.             cp += 7;
  685.             while (isspace(*cp)) cp++;
  686.             cp2 = cp + strlen(cp) - 1;
  687.             while (isspace(*cp2)) cp2--;
  688.             if ((*cp == '"' && *cp2 == '"' && cp2 > cp) ||
  689.             (*cp == '<' && *cp2 == '>')) {
  690.             inbufptr = cp2 + 1;
  691.             cp3 = stralloc(cp + 1);
  692.             cp3[cp2 - cp - 1] = 0;
  693.             if (handle_include(cp3))
  694.                 return;
  695.             else
  696.                 break;
  697.             }
  698.         }
  699.         /* fall through */
  700.  
  701.             case '\'':
  702.                 if (C_lex && ch == '\'') {
  703.                     get_C_string(ch);
  704.                     if (curtokint != 1)
  705.                         warning("Character constant has length != 1 [242]");
  706.                     curtokint = *curtokbuf;
  707.                     curtok = TOK_CHARLIT;
  708.                     return;
  709.                 }
  710.           stringLiteral:
  711.                 cp = curtokbuf;
  712.         ch2 = (ch == '"') ? '"' : '\'';
  713.                 do {
  714.                     if (ch == ch2) {
  715.                         while ((ch = *inbufptr++) != '\n' &&
  716.                                ch != EOF) {
  717.                             if (ch == ch2) {
  718.                                 if (*inbufptr != ch2 || modula2)
  719.                                     break;
  720.                                 else
  721.                                     inbufptr++;
  722.                             }
  723.                             *cp++ = ch;
  724.                         }
  725.                         if (ch != ch2)
  726.                             warning("Error in string literal [243]");
  727.                     } else {
  728.                         ch = *inbufptr++;
  729.                         if (isdigit(ch)) {
  730.                             i = 0;
  731.                             while (isdigit(ch)) {
  732.                                 i = i*10 + ch - '0';
  733.                                 ch = *inbufptr++;
  734.                             }
  735.                             inbufptr--;
  736.                             *cp++ = i;
  737.                         } else {
  738.                             *cp++ = ch & 0x1f;
  739.                         }
  740.                     }
  741.                     while (*inbufptr == ' ' || *inbufptr == '\t')
  742.                         inbufptr++;
  743.                 } while ((ch = *inbufptr++) == ch2 || ch == '#');
  744.                 inbufptr--;
  745.                 *cp = 0;
  746.                 curtokint = cp - curtokbuf;
  747.                 curtok = TOK_STRLIT;
  748.                 return;
  749.  
  750.             case '(':
  751.                 if (*inbufptr == '*' && !C_lex) {
  752.                     inbufptr++;
  753.             switch (commenting_flag ? 0 : parsecomment(0, 1)) {
  754.                 case 0:
  755.                             comment(1);
  756.                 break;
  757.                 case 2:
  758.                 return;
  759.             }
  760.                     break;
  761.                 } else if (*inbufptr == '.') {
  762.                     curtok = TOK_LBR;
  763.                     inbufptr++;
  764.                 } else {
  765.                     curtok = TOK_LPAR;
  766.                 }
  767.                 return;
  768.  
  769.             case '{':
  770.                 if (C_lex || modula2) {
  771.                     curtok = TOK_LBRACE;
  772.                     return;
  773.                 }
  774.                 switch (commenting_flag ? 0 : parsecomment(0, 0)) {
  775.                     case 0:
  776.                         comment(0);
  777.                         break;
  778.                     case 2:
  779.                         return;
  780.                 }
  781.                 break;
  782.  
  783.             case '}':
  784.                 if (C_lex || modula2) {
  785.                     curtok = TOK_RBRACE;
  786.                     return;
  787.                 }
  788.         if (skipflag > 0) {
  789.             skipflag = 0;
  790.         } else
  791.             warning("Unmatched '}' in input file [244]");
  792.                 break;
  793.  
  794.             case ')':
  795.                 curtok = TOK_RPAR;
  796.                 return;
  797.  
  798.             case '*':
  799.         if (*inbufptr == (C_lex ? '/' : ')')) {
  800.             inbufptr++;
  801.             if (skipflag > 0) {
  802.             skipflag = 0;
  803.             } else
  804.             warning("Unmatched '*)' in input file [245]");
  805.             break;
  806.         } else if (*inbufptr == '*' && !C_lex) {
  807.             curtok = TOK_STARSTAR;
  808.             inbufptr++;
  809.         } else
  810.             curtok = TOK_STAR;
  811.                 return;
  812.  
  813.             case '+':
  814.                 if (C_lex && *inbufptr == '+') {
  815.                     curtok = TOK_PLPL;
  816.                     inbufptr++;
  817.                 } else
  818.                     curtok = TOK_PLUS;
  819.                 return;
  820.  
  821.             case ',':
  822.                 curtok = TOK_COMMA;
  823.                 return;
  824.  
  825.             case '-':
  826.                 if (C_lex && *inbufptr == '-') {
  827.                     curtok = TOK_MIMI;
  828.                     inbufptr++;
  829.                 } else if (*inbufptr == '>') {
  830.                     curtok = TOK_ARROW;
  831.                     inbufptr++;
  832.                 } else
  833.                     curtok = TOK_MINUS;
  834.                 return;
  835.  
  836.             case '.':
  837.                 if (*inbufptr == '.') {
  838.                     curtok = TOK_DOTS;
  839.                     inbufptr++;
  840.                 } else if (*inbufptr == ')') {
  841.                     curtok = TOK_RBR;
  842.                     inbufptr++;
  843.                 } else
  844.                     curtok = TOK_DOT;
  845.                 return;
  846.  
  847.             case '/':
  848.         if (C_lex && *inbufptr == '*') {
  849.             inbufptr++;
  850.             comment(2);
  851.             break;
  852.         }
  853.                 curtok = TOK_SLASH;
  854.                 return;
  855.  
  856.             case ':':
  857.                 if (*inbufptr == '=') {
  858.                     curtok = TOK_ASSIGN;
  859.                     inbufptr++;
  860.         } else if (*inbufptr == ':') {
  861.                     curtok = TOK_COLONCOLON;
  862.                     inbufptr++;
  863.                 } else
  864.                     curtok = TOK_COLON;
  865.                 return;
  866.  
  867.             case ';':
  868.                 curtok = TOK_SEMI;
  869.                 return;
  870.  
  871.             case '<':
  872.                 if (*inbufptr == '=') {
  873.                     curtok = TOK_LE;
  874.                     inbufptr++;
  875.                 } else if (*inbufptr == '>') {
  876.                     curtok = TOK_NE;
  877.                     inbufptr++;
  878.                 } else if (*inbufptr == '<') {
  879.                     curtok = TOK_LTLT;
  880.                     inbufptr++;
  881.                 } else
  882.                     curtok = TOK_LT;
  883.                 return;
  884.  
  885.             case '>':
  886.                 if (*inbufptr == '=') {
  887.                     curtok = TOK_GE;
  888.                     inbufptr++;
  889.                 } else if (*inbufptr == '>') {
  890.                     curtok = TOK_GTGT;
  891.                     inbufptr++;
  892.                 } else
  893.                     curtok = TOK_GT;
  894.                 return;
  895.  
  896.             case '=':
  897.         if (*inbufptr == '=') {
  898.             curtok = TOK_EQEQ;
  899.             inbufptr++;
  900.         } else
  901.             curtok = TOK_EQ;
  902.                 return;
  903.  
  904.             case '[':
  905.                 curtok = TOK_LBR;
  906.                 return;
  907.  
  908.             case ']':
  909.                 curtok = TOK_RBR;
  910.                 return;
  911.  
  912.             case '^':
  913.                 curtok = TOK_HAT;
  914.                 return;
  915.  
  916.             case '&':
  917.                 if (*inbufptr == '&') {
  918.                     curtok = TOK_ANDAND;
  919.                     inbufptr++;
  920.                 } else
  921.                     curtok = TOK_AMP;
  922.                 return;
  923.  
  924.             case '|':
  925.                 if (*inbufptr == '|') {
  926.                     curtok = TOK_OROR;
  927.                     inbufptr++;
  928.                 } else
  929.                     curtok = TOK_VBAR;
  930.                 return;
  931.  
  932.             case '~':
  933.                 curtok = TOK_TWIDDLE;
  934.                 return;
  935.  
  936.             case '!':
  937.                 if (*inbufptr == '=') {
  938.                     curtok = TOK_BANGEQ;
  939.                     inbufptr++;
  940.                 } else
  941.                     curtok = TOK_BANG;
  942.                 return;
  943.  
  944.             case '%':
  945.         if (C_lex) {
  946.             curtok = TOK_PERC;
  947.             return;
  948.         }
  949.         goto ident;
  950.  
  951.             case '?':
  952.                 curtok = TOK_QM;
  953.                 return;
  954.  
  955.             case '@':
  956.         curtok = TOK_ADDR;
  957.                 return;
  958.  
  959.             case EOFMARK:
  960.                 if (curtok == TOK_EOF) {
  961.                     if (inputkind == INP_STRLIST)
  962.                         error("Unexpected end of macro");
  963.                     else
  964.                         error("Unexpected end of file");
  965.                 }
  966.                 curtok = TOK_EOF;
  967.                 return;
  968.  
  969.             default:
  970.                 if (isdigit(ch)) {
  971.             cp = inbufptr;
  972.             while (isxdigit(*cp))
  973.             cp++;
  974.             if (*cp == '#' && isxdigit(cp[1])) {
  975.             i = atoi(inbufptr-1);
  976.             inbufptr = cp+1;
  977.             } else if (toupper(cp[-1]) == 'B' ||
  978.                    toupper(cp[-1]) == 'C') {
  979.                         inbufptr--;
  980.             i = 8;
  981.             } else if (toupper(*cp) == 'H') {
  982.                         inbufptr--;
  983.             i = 16;
  984.             } else if ((ch == '0' && toupper(*inbufptr) == 'X' &&
  985.                 isxdigit(inbufptr[1]))) {
  986.             inbufptr++;
  987.             i = 16;
  988.             } else {
  989.             i = 10;
  990.             }
  991.             if (i != 10) {
  992.                         curtokint = 0;
  993.                         while (isdigit(*inbufptr) ||
  994.                    (i > 10 && isxdigit(*inbufptr))) {
  995.                             ch = toupper(*inbufptr++);
  996.                             curtokint *= i;
  997.                             if (ch <= '9')
  998.                                 curtokint += ch - '0';
  999.                             else
  1000.                                 curtokint += ch - 'A' + 10;
  1001.                         }
  1002.                         sprintf(curtokbuf, "%ld", curtokint);
  1003.             if ((toupper(*inbufptr) == 'B' && i == 8) ||
  1004.                 (toupper(*inbufptr) == 'H' && i == 16))
  1005.                 inbufptr++;
  1006.             if (toupper(*inbufptr) == 'C' && i == 8) {
  1007.                 inbufptr++;
  1008.                 curtok = TOK_STRLIT;
  1009.                 curtokbuf[0] = curtokint;
  1010.                 curtokbuf[1] = 0;
  1011.                 curtokint = 1;
  1012.                 return;
  1013.             }
  1014.                         if (toupper(*inbufptr) == 'L') {
  1015.                             strcat(curtokbuf, "L");
  1016.                             inbufptr++;
  1017.                         }
  1018.                         curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
  1019.                         return;
  1020.                     }
  1021.                     cp = curtokbuf;
  1022.                     i = 0;
  1023.                     while (ch == '0')
  1024.                         ch = *inbufptr++;
  1025.                     if (isdigit(ch)) {
  1026.                         while (isdigit(ch)) {
  1027.                             *cp++ = ch;
  1028.                             ch = *inbufptr++;
  1029.                         }
  1030.                     } else
  1031.                         *cp++ = '0';
  1032.                     if (ch == '.') {
  1033.                         if (isdigit(*inbufptr)) {
  1034.                             *cp++ = ch;
  1035.                             ch = *inbufptr++;
  1036.                             i = 1;
  1037.                             while (isdigit(ch)) {
  1038.                                 *cp++ = ch;
  1039.                                 ch = *inbufptr++;
  1040.                             }
  1041.                         }
  1042.                     }
  1043.                     if (ch == 'e' || ch == 'E' ||
  1044.             ch == 'd' || ch == 'D' ||
  1045.             ch == 'q' || ch == 'Q') {
  1046.                         ch = *inbufptr;
  1047.                         if (isdigit(ch) || ch == '+' || ch == '-') {
  1048.                             *cp++ = 'e';
  1049.                             inbufptr++;
  1050.                             i = 1;
  1051.                             do {
  1052.                                 *cp++ = ch;
  1053.                                 ch = *inbufptr++;
  1054.                             } while (isdigit(ch));
  1055.                         }
  1056.                     }
  1057.                     inbufptr--;
  1058.                     *cp = 0;
  1059.                     if (i) {
  1060.                         curtok = TOK_REALLIT;
  1061.                         curtokint = cp - curtokbuf;
  1062.                     } else {
  1063.                         if (cp >= curtokbuf+10) {
  1064.                             i = strcmp(curtokbuf, "2147483648");
  1065.                             if (cp > curtokbuf+10 || i > 0) {
  1066.                 curtok = TOK_REALLIT;
  1067.                 curtokint = cp - curtokbuf + 2;
  1068.                 strcat(curtokbuf, ".0");
  1069.                 return;
  1070.                 }
  1071.                             if (i == 0) {
  1072.                                 curtok = TOK_MININT;
  1073.                                 curtokint = -2147483648;
  1074.                                 return;
  1075.                             }
  1076.                         }
  1077.                         curtok = TOK_INTLIT;
  1078.                         curtokint = atol(curtokbuf);
  1079.                         if (toupper(*inbufptr) == 'L') {
  1080.                             strcat(curtokbuf, "L");
  1081.                             inbufptr++;
  1082.                         }
  1083.                     }
  1084.                     return;
  1085.                 } else if (isalpha(ch) || ch == '_') {
  1086. ident:
  1087.                     {
  1088.                         register char *cp2;
  1089.                         curtoksym = NULL;
  1090.                         cp = curtokbuf;
  1091.                         cp2 = curtokcase;
  1092.             *cp2++ = symcase ? ch : tolower(ch);
  1093.             *cp++ = pascalcasesens ? ch : toupper(ch);
  1094.             while (isalnum((ch = *inbufptr++)) ||
  1095.                    ch == '_' ||
  1096.                    (ch == '%' && !C_lex) ||
  1097.                    (ch == '$' && dollar_idents)) {
  1098.                 *cp2++ = symcase ? ch : tolower(ch);
  1099.                 if (!ignorenonalpha || isalnum(ch))
  1100.                 *cp++ = pascalcasesens ? ch : toupper(ch);
  1101.             }
  1102.                         inbufptr--;
  1103.                         *cp2 = 0;
  1104.                         *cp = 0;
  1105.             if (pascalsignif > 0)
  1106.                 curtokbuf[pascalsignif] = 0;
  1107.                     }
  1108.             if (*curtokbuf == '%') {
  1109.             if (!strcicmp(curtokbuf, "%INCLUDE")) {
  1110.                 char *cp2 = inbufptr;
  1111.                 while (isspace(*cp2)) cp2++;
  1112.                 if (*cp2 == '\'')
  1113.                 cp2++;
  1114.                 cp = curtokbuf;
  1115.                 while (*cp2 && *cp2 != '\'' &&
  1116.                    *cp2 != ';' && !isspace(*cp2)) {
  1117.                 *cp++ = *cp2++;
  1118.                 }
  1119.                 *cp = 0;
  1120.                 cp = my_strrchr(curtokbuf, '/');
  1121.                 if (cp && (!strcicmp(cp, "/LIST") ||
  1122.                        !strcicmp(cp, "/NOLIST")))
  1123.                 *cp = 0;
  1124.                 if (*cp2 == '\'')
  1125.                 cp2++;
  1126.                 while (isspace(*cp2)) cp2++;
  1127.                 if (*cp2 == ';')
  1128.                 cp2++;
  1129.                 while (isspace(*cp2)) cp2++;
  1130.                 if (!*cp2) {
  1131.                 inbufptr = cp2;
  1132.                 (void) handle_include(stralloc(curtokbuf));
  1133.                 return;
  1134.                 }
  1135.             } else if (!strcicmp(curtokbuf, "%TITLE") ||
  1136.                    !strcicmp(curtokbuf, "%SUBTITLE")) {
  1137.                 gettok();   /* string literal */
  1138.                 break;
  1139.             } else if (!strcicmp(curtokbuf, "%PAGE")) {
  1140.                 /* should store a special page-break comment? */
  1141.                 break;   /* ignore token */
  1142.             } else if ((i = 2, !strcicmp(curtokbuf, "%B")) ||
  1143.                    (i = 8, !strcicmp(curtokbuf, "%O")) ||
  1144.                    (i = 16, !strcicmp(curtokbuf, "%X"))) {
  1145.                 while (isspace(*inbufptr)) inbufptr++;
  1146.                 if (*inbufptr == '\'') {
  1147.                 inbufptr++;
  1148.                 curtokint = 0;
  1149.                 while (*inbufptr && *inbufptr != '\'') {
  1150.                     ch = toupper(*inbufptr++);
  1151.                     if (isxdigit(ch)) {
  1152.                     curtokint *= i;
  1153.                     if (ch <= '9')
  1154.                         curtokint += ch - '0';
  1155.                     else
  1156.                         curtokint += ch - 'A' + 10;
  1157.                     } else if (!isspace(ch))
  1158.                     warning("Bad digit in literal [246]");
  1159.                 }
  1160.                 if (*inbufptr)
  1161.                     inbufptr++;
  1162.                 sprintf(curtokbuf, "%ld", curtokint);
  1163.                 curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
  1164.                 return;
  1165.                 }
  1166.                         }
  1167.             }
  1168.                     {
  1169.                         register unsigned int hash;
  1170.                         register Symbol *sp;
  1171.  
  1172.                         hash = 0;
  1173.                         for (cp = curtokbuf; *cp; cp++)
  1174.                             hash = hash*3 + *cp;
  1175.                         sp = symtab[hash % SYMHASHSIZE];
  1176.                         while (sp && (i = strcmp(sp->name, curtokbuf)) != 0) {
  1177.                             if (i < 0)
  1178.                                 sp = sp->left;
  1179.                             else
  1180.                                 sp = sp->right;
  1181.                         }
  1182.                         if (!sp)
  1183.                             sp = findsymbol(curtokbuf);
  1184.             if (sp->flags & SSYNONYM) {
  1185.                 i = 100;
  1186.                 while (--i > 0 && sp && (sp->flags & SSYNONYM)) {
  1187.                 Strlist *sl;
  1188.                 sl = strlist_find(sp->symbolnames, "===");
  1189.                 if (sl)
  1190.                     sp = (Symbol *)sl->value;
  1191.                 else
  1192.                     sp = NULL;
  1193.                 }
  1194.                 if (!sp)
  1195.                 break;    /* ignore token */
  1196.             }
  1197.             if (sp->kwtok && !(sp->flags & KWPOSS) &&
  1198.                 (pascalcasesens != 2 || !islower(*curtokbuf)) &&
  1199.                 (pascalcasesens != 3 || !isupper(*curtokbuf))) {
  1200.                 curtok = sp->kwtok;
  1201.                 return;
  1202.             }
  1203.             curtok = TOK_IDENT;
  1204.                         curtoksym = sp;
  1205.                         if ((i = withlevel) != 0 && sp->fbase) {
  1206.                             while (--i >= 0) {
  1207.                                 curtokmeaning = sp->fbase;
  1208.                                 while (curtokmeaning) {
  1209.                                     if (curtokmeaning->rectype == withlist[i]) {
  1210.                                         curtokint = i;
  1211.                                         return;
  1212.                                     }
  1213.                                     curtokmeaning = curtokmeaning->snext;
  1214.                                 }
  1215.                             }
  1216.                         }
  1217.                         curtokmeaning = sp->mbase;
  1218.                         while (curtokmeaning && !curtokmeaning->isactive)
  1219.                             curtokmeaning = curtokmeaning->snext;
  1220.             if (!curtokmeaning)
  1221.                 return;
  1222.             while (curtokmeaning->kind == MK_SYNONYM)
  1223.                 curtokmeaning = curtokmeaning->xnext;
  1224.             /* look for unit.ident notation */
  1225.                         if (curtokmeaning->kind == MK_MODULE ||
  1226.                 curtokmeaning->kind == MK_FUNCTION) {
  1227.                             for (cp = inbufptr; isspace(*cp); cp++) ;
  1228.                             if (*cp == '.') {
  1229.                                 for (cp++; isspace(*cp); cp++) ;
  1230.                                 if (isalpha(*cp)) {
  1231.                                     Meaning *mp = curtokmeaning;
  1232.                                     Symbol *sym = curtoksym;
  1233.                                     char *saveinbufptr = inbufptr;
  1234.                                     gettok();
  1235.                                     if (curtok == TOK_DOT)
  1236.                     gettok();
  1237.                     else
  1238.                     curtok = TOK_END;
  1239.                                     if (curtok == TOK_IDENT) {
  1240.                     curtokmeaning = curtoksym->mbase;
  1241.                     while (curtokmeaning &&
  1242.                            curtokmeaning->ctx != mp)
  1243.                         curtokmeaning = curtokmeaning->snext;
  1244.                     if (!curtokmeaning &&
  1245.                         !strcmp(sym->name, "SYSTEM")) {
  1246.                         curtokmeaning = curtoksym->mbase;
  1247.                         while (curtokmeaning &&
  1248.                            curtokmeaning->ctx != nullctx)
  1249.                         curtokmeaning = curtokmeaning->snext;
  1250.                     }
  1251.                     } else
  1252.                     curtokmeaning = NULL;
  1253.                                     if (!curtokmeaning) {
  1254.                                         /* oops, was probably funcname.field */
  1255.                                         inbufptr = saveinbufptr;
  1256.                                         curtokmeaning = mp;
  1257.                                         curtoksym = sym;
  1258.                                     }
  1259.                                 }
  1260.                             }
  1261.                         }
  1262.                         return;
  1263.                     }
  1264.                 } else {
  1265.                     warning("Unrecognized character in file [247]");
  1266.                 }
  1267.         }
  1268.     }
  1269. }
  1270.  
  1271. void checkkeyword(tok)
  1272. Token tok;
  1273. {
  1274.     if (curtok == TOK_IDENT &&
  1275.     curtoksym->kwtok == tok) {
  1276.     curtoksym->flags &= ~KWPOSS;
  1277.     curtok = tok;
  1278.     }
  1279. }
  1280.  
  1281. void checkmodulewords()
  1282. {
  1283.     if (modula2) {
  1284.     checkkeyword(TOK_FROM);
  1285.     checkkeyword(TOK_DEFINITION);
  1286.     checkkeyword(TOK_IMPLEMENT);
  1287.     checkkeyword(TOK_MODULE);
  1288.     checkkeyword(TOK_IMPORT);
  1289.     checkkeyword(TOK_EXPORT);
  1290.     } else if (curtok == TOK_IDENT &&
  1291.            (curtoksym->kwtok == TOK_MODULE ||
  1292.         curtoksym->kwtok == TOK_IMPORT ||
  1293.         curtoksym->kwtok == TOK_EXPORT ||
  1294.         curtoksym->kwtok == TOK_IMPLEMENT)) {
  1295.     if (!strcmp(curtokbuf, "UNIT") ||
  1296.         !strcmp(curtokbuf, "USES") ||
  1297.         !strcmp(curtokbuf, "INTERFACE") ||
  1298.         !strcmp(curtokbuf, "IMPLEMENTATION")) {
  1299.         modulenotation = 0;
  1300.         findsymbol("UNIT")->flags &= ~KWPOSS;
  1301.         findsymbol("USES")->flags &= ~KWPOSS;
  1302.         findsymbol("INTERFACE")->flags &= ~KWPOSS;
  1303.         findsymbol("IMPLEMENTATION")->flags &= ~KWPOSS;
  1304.     } else {
  1305.         modulenotation = 1;
  1306.         findsymbol("MODULE")->flags &= ~KWPOSS;
  1307.         findsymbol("EXPORT")->flags &= ~KWPOSS;
  1308.         findsymbol("IMPORT")->flags &= ~KWPOSS;
  1309.         findsymbol("IMPLEMENT")->flags &= ~KWPOSS;
  1310.     }
  1311.     curtok = curtoksym->kwtok;
  1312.     }
  1313. }
  1314.  
  1315. /* End. */
  1316.