home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / dev / misc / p2c / src / lex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-12-21  |  85.3 KB  |  3,422 lines
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989, 1990, 1991 Free Software Foundation.
  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.  
  19.  
  20. #define PROTO_LEX_C
  21. #include "trans.h"
  22.  
  23.  
  24. /* Define LEXDEBUG for a token trace */
  25. #define LEXDEBUG
  26.  
  27.  
  28.  
  29.  
  30. #define EOFMARK 1
  31.  
  32.  
  33. Static char dollar_flag, lex_initialized;
  34. Static int if_flag, if_skip;
  35. Static int commenting_flag;
  36. Static char *commenting_ptr;
  37. Static int skipflag;
  38. Static char modulenotation;
  39. Static short inputkind;
  40. Static Strlist *instrlist;
  41. Static char inbuf[300];
  42. Static char *oldinfname, *oldctxname;
  43. Static Strlist *endnotelist;
  44.  
  45.  
  46.  
  47. #define INP_FILE     0
  48. #define INP_INCFILE  1
  49. #define INP_STRLIST  2
  50.  
  51. Static struct inprec {
  52.     struct inprec *next;
  53.     short kind;
  54.     char *fname, *inbufptr;
  55.     int lnum;
  56.     FILE *filep;
  57.     Strlist *strlistp, *tempopts;
  58.     Token curtok, saveblockkind;
  59.     Symbol *curtoksym;
  60.     Meaning *curtokmeaning;
  61.     char *curtokbuf, *curtokcase;
  62. } *topinput;
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69. char *fixpascalname(name)
  70. char *name;
  71. {
  72.     char *cp, *cp2;
  73.  
  74.     if (pascalsignif > 0) {
  75.         name = format_ds("%.*s", pascalsignif, name);
  76.         if (!pascalcasesens)
  77.             upc(name);
  78.     else if (pascalcasesens == 3)
  79.         lwc(name);
  80.     } else if (!pascalcasesens)
  81.         name = strupper(name);
  82.     else if (pascalcasesens == 3)
  83.     name = strlower(name);
  84.     if (ignorenonalpha) {
  85.     for (cp = cp2 = name; *cp; cp++)
  86.         if (isalnum(*cp))
  87.         *cp2++ = *cp;
  88.     }
  89.     return name;
  90. }
  91.  
  92.  
  93.  
  94. Static void makekeyword(name)
  95. char *name;
  96. {
  97.     Symbol *sym;
  98.  
  99.     if (*name) {
  100.         sym = findsymbol(name);
  101.         sym->flags |= AVOIDNAME;
  102.     }
  103. }
  104.  
  105.  
  106. Static void makeglobword(name)
  107. char *name;
  108. {
  109.     Symbol *sym;
  110.  
  111.     if (*name) {
  112.         sym = findsymbol(name);
  113.         sym->flags |= AVOIDGLOB;
  114.     }
  115. }
  116.  
  117.  
  118.  
  119. Static void makekeywords()
  120. {
  121.     makekeyword("auto");
  122.     makekeyword("break");
  123.     makekeyword("char");
  124.     makekeyword("continue");
  125.     makekeyword("default");
  126.     makekeyword("defined");   /* is this one really necessary? */
  127.     makekeyword("double");
  128.     makekeyword("enum");
  129.     makekeyword("extern");
  130.     makekeyword("float");
  131.     makekeyword("int");
  132.     makekeyword("long");
  133.     makekeyword("noalias");
  134.     makekeyword("register");
  135.     makekeyword("return");
  136.     makekeyword("short");
  137.     makekeyword("signed");
  138.     makekeyword("sizeof");
  139.     makekeyword("static");
  140.     makekeyword("struct");
  141.     makekeyword("switch");
  142.     makekeyword("typedef");
  143.     makekeyword("union");
  144.     makekeyword("unsigned");
  145.     makekeyword("void");
  146.     makekeyword("volatile");
  147.     makekeyword("asm");
  148.     makekeyword("fortran");
  149.     makekeyword("entry");
  150.     makekeyword("pascal");
  151.     if (cplus != 0) {
  152.         makekeyword("class");
  153.         makekeyword("delete");
  154.         makekeyword("friend");
  155.         makekeyword("inline");
  156.         makekeyword("new");
  157.         makekeyword("operator");
  158.         makekeyword("overload");
  159.         makekeyword("public");
  160.         makekeyword("this");
  161.         makekeyword("virtual");
  162.     }
  163.     makekeyword(name_UCHAR);
  164.     makekeyword(name_SCHAR);    /* any others? */
  165.     makekeyword(name_BOOLEAN);
  166.     makekeyword(name_PROCEDURE);
  167.     makekeyword(name_ESCAPE);
  168.     makekeyword(name_ESCIO);
  169.     makekeyword(name_CHKIO);
  170.     makekeyword(name_SETIO);
  171.     makeglobword("main");
  172.     makeglobword("vextern");     /* used in generated .h files */
  173.     makeglobword("argc");
  174.     makeglobword("argv");
  175.     makekeyword("TRY");
  176.     makekeyword("RECOVER");
  177.     makekeyword("RECOVER2");
  178.     makekeyword("ENDTRY");
  179. }
  180.  
  181.  
  182.  
  183. Static Symbol *Pkeyword(name, tok)
  184. char *name;
  185. Token tok;
  186. {
  187.     Symbol *sp = NULL;
  188.  
  189.     if (pascalcasesens != 2) {
  190.     sp = findsymbol(strlower(name));
  191.     sp->kwtok = tok;
  192.     }
  193.     if (pascalcasesens != 3) {
  194.     sp = findsymbol(strupper(name));
  195.     sp->kwtok = tok;
  196.     }
  197.     return sp;
  198. }
  199.  
  200.  
  201. Static Symbol *Pkeywordposs(name, tok)
  202. char *name;
  203. Token tok;
  204. {
  205.     Symbol *sp = NULL;
  206.  
  207.     if (pascalcasesens != 2) {
  208.     sp = findsymbol(strlower(name));
  209.     sp->kwtok = tok;
  210.     sp->flags |= KWPOSS;
  211.     }
  212.     if (pascalcasesens != 3) {
  213.     sp = findsymbol(strupper(name));
  214.     sp->kwtok = tok;
  215.     sp->flags |= KWPOSS;
  216.     }
  217.     return sp;
  218. }
  219.  
  220.  
  221. Static void makePascalwords()
  222. {
  223.     Pkeyword("AND", TOK_AND);
  224.     Pkeyword("ARRAY", TOK_ARRAY);
  225.     Pkeywordposs("ANYVAR", TOK_ANYVAR);
  226.     Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
  227.     Pkeyword("BEGIN", TOK_BEGIN);
  228.     Pkeywordposs("BY", TOK_BY);
  229.     Pkeyword("CASE", TOK_CASE);
  230.     Pkeyword("CONST", TOK_CONST);
  231.     Pkeyword("DIV", TOK_DIV);
  232.     Pkeywordposs("DEFINITION", TOK_DEFINITION);
  233.     Pkeyword("DO", TOK_DO);
  234.     Pkeyword("DOWNTO", TOK_DOWNTO);
  235.     Pkeyword("ELSE", TOK_ELSE);
  236.     Pkeywordposs("ELSIF", TOK_ELSIF);
  237.     Pkeyword("END", TOK_END);
  238.     Pkeywordposs("EXPORT", TOK_EXPORT);
  239.     Pkeyword("FILE", TOK_FILE);
  240.     Pkeyword("FOR", TOK_FOR);
  241.     Pkeywordposs("FROM", TOK_FROM);
  242.     Pkeyword("FUNCTION", TOK_FUNCTION);
  243.     Pkeyword("GOTO", TOK_GOTO);
  244.     Pkeyword("IF", TOK_IF);
  245.     Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
  246.     Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
  247.     Pkeywordposs("IMPORT", TOK_IMPORT);
  248.     Pkeyword("IN", TOK_IN);
  249.     Pkeywordposs("INLINE", TOK_INLINE);
  250.     Pkeywordposs("INTERFACE", TOK_EXPORT);
  251.     Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
  252.     Pkeyword("LABEL", TOK_LABEL);
  253.     Pkeywordposs("LOOP", TOK_LOOP);
  254.     Pkeyword("MOD", TOK_MOD);
  255.     Pkeywordposs("MODULE", TOK_MODULE);
  256.     Pkeyword("NIL", TOK_NIL);
  257.     Pkeyword("NOT", TOK_NOT);
  258.     Pkeyword("OF", TOK_OF);
  259.     Pkeyword("OR", TOK_OR);
  260.     Pkeywordposs("ORIGIN", TOK_ORIGIN);
  261.     Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
  262.     Pkeywordposs("OVERLAY", TOK_SEGMENT);
  263.     Pkeyword("PACKED", TOK_PACKED);
  264.     Pkeywordposs("POINTER", TOK_POINTER);
  265.     Pkeyword("PROCEDURE", TOK_PROCEDURE);
  266.     Pkeyword("PROGRAM", TOK_PROGRAM);
  267.     Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
  268.     Pkeyword("RECORD", TOK_RECORD);
  269.     Pkeywordposs("RECOVER", TOK_RECOVER);
  270.     Pkeywordposs("REM", TOK_REM);
  271.     Pkeyword("REPEAT", TOK_REPEAT);
  272.     Pkeywordposs("RETURN", TOK_RETURN);
  273.     if (which_lang == LANG_UCSD)
  274.     Pkeyword("SEGMENT", TOK_SEGMENT);
  275.     else
  276.     Pkeywordposs("SEGMENT", TOK_SEGMENT);
  277.     Pkeyword("SET", TOK_SET);
  278.     Pkeywordposs("SHL", TOK_SHL);
  279.     Pkeywordposs("SHR", TOK_SHR);
  280.     Pkeyword("THEN", TOK_THEN);
  281.     Pkeyword("TO", TOK_TO);
  282.     Pkeywordposs("TRY", TOK_TRY);
  283.     Pkeyword("TYPE", TOK_TYPE);
  284.     Pkeyword("UNTIL", TOK_UNTIL);
  285.     Pkeywordposs("USES", TOK_IMPORT);
  286.     Pkeywordposs("UNIT", TOK_MODULE);
  287.     if (which_lang == LANG_VAX)
  288.     Pkeyword("VALUE", TOK_VALUE);
  289.     else
  290.     Pkeywordposs("VALUE", TOK_VALUE);
  291.     Pkeyword("VAR", TOK_VAR);
  292.     Pkeywordposs("VARYING", TOK_VARYING);
  293.     Pkeyword("WHILE", TOK_WHILE);
  294.     Pkeyword("WITH", TOK_WITH);
  295.     Pkeywordposs("XOR", TOK_XOR);
  296.     Pkeyword("__MODULE", TOK_MODULE);
  297.     Pkeyword("__IMPORT", TOK_IMPORT);
  298.     Pkeyword("__EXPORT", TOK_EXPORT);
  299.     Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
  300. }
  301.  
  302.  
  303.  
  304. Static void deterministic(name)
  305. char *name;
  306. {
  307.     Symbol *sym;
  308.  
  309.     if (*name) {
  310.         sym = findsymbol(name);
  311.         sym->flags |= DETERMF;
  312.     }
  313. }
  314.  
  315.  
  316. Static void nosideeff(name)
  317. char *name;
  318. {
  319.     Symbol *sym;
  320.  
  321.     if (*name) {
  322.         sym = findsymbol(name);
  323.         sym->flags |= NOSIDEEFF;
  324.     }
  325. }
  326.  
  327.  
  328.  
  329. Static void recordsideeffects()
  330. {
  331.     deterministic("abs");
  332.     deterministic("acos");
  333.     deterministic("asin");
  334.     deterministic("atan");
  335.     deterministic("atan2");
  336.     deterministic("atof");
  337.     deterministic("atoi");
  338.     deterministic("atol");
  339.     deterministic("ceil");
  340.     deterministic("cos");
  341.     deterministic("cosh");
  342.     deterministic("exp");
  343.     deterministic("fabs");
  344.     deterministic("feof");
  345.     deterministic("feoln");
  346.     deterministic("ferror");
  347.     deterministic("floor");
  348.     deterministic("fmod");
  349.     deterministic("ftell");
  350.     deterministic("isalnum");
  351.     deterministic("isalpha");
  352.     deterministic("isdigit");
  353.     deterministic("islower");
  354.     deterministic("isspace");
  355.     deterministic("isupper");
  356.     deterministic("labs");
  357.     deterministic("ldexp");
  358.     deterministic("log");
  359.     deterministic("log10");
  360.     deterministic("memcmp");
  361.     deterministic("memchr");
  362.     deterministic("pow");
  363.     deterministic("sin");
  364.     deterministic("sinh");
  365.     deterministic("sqrt");
  366.     deterministic("strchr");
  367.     deterministic("strcmp");
  368.     deterministic("strcspn");
  369.     deterministic("strlen");
  370.     deterministic("strncmp");
  371.     deterministic("strpbrk");
  372.     deterministic("strrchr");
  373.     deterministic("strspn");
  374.     deterministic("strstr");
  375.     deterministic("tan");
  376.     deterministic("tanh");
  377.     deterministic("tolower");
  378.     deterministic("toupper");
  379.     deterministic(setequalname);
  380.     deterministic(subsetname);
  381.     deterministic(signextname);
  382. }
  383.  
  384.  
  385.  
  386.  
  387.  
  388. void init_lex()
  389. {
  390.     int i;
  391.  
  392.     inputkind = INP_FILE;
  393.     inf_lnum = 0;
  394.     inf_ltotal = 0;
  395.     *inbuf = 0;
  396.     inbufptr = inbuf;
  397.     keepingstrlist = NULL;
  398.     tempoptionlist = NULL;
  399.     switch_strpos = 0;
  400.     dollar_flag = 0;
  401.     if_flag = 0;
  402.     if_skip = 0;
  403.     commenting_flag = 0;
  404.     skipflag = 0;
  405.     inbufindent = 0;
  406.     modulenotation = 1;
  407.     notephase = 0;
  408.     endnotelist = NULL;
  409.     for (i = 0; i < SYMHASHSIZE; i++)
  410.         symtab[i] = 0;
  411.     C_lex = 0;
  412.     lex_initialized = 0;
  413. }
  414.  
  415.  
  416. void setup_lex()
  417. {
  418.     lex_initialized = 1;
  419.     if (!strcmp(language, "MODCAL"))
  420.         sysprog_flag = 2;
  421.     else
  422.         sysprog_flag = 0;
  423.     if (shortcircuit < 0)
  424.         partial_eval_flag = (which_lang == LANG_TURBO ||
  425.                  which_lang == LANG_VAX ||
  426.                  which_lang == LANG_OREGON ||
  427.                  modula2 ||
  428.                  hpux_lang);
  429.     else
  430.         partial_eval_flag = shortcircuit;
  431.     iocheck_flag = 1;
  432.     range_flag = 1;
  433.     ovflcheck_flag = 1;
  434.     stackcheck_flag = 1;
  435.     fixedflag = 0;
  436.     withlevel = 0;
  437.     makekeywords();
  438.     makePascalwords();
  439.     recordsideeffects();
  440.     topinput = 0;
  441.     ignore_directives = 0;
  442.     skipping_module = 0;
  443.     blockkind = TOK_END;
  444.     gettok();
  445. }
  446.  
  447.  
  448.  
  449.  
  450. int checkeatnote(msg)
  451. char *msg;
  452. {
  453.     Strlist *lp;
  454.     char *cp;
  455.     int len;
  456.  
  457.     for (lp = eatnotes; lp; lp = lp->next) {
  458.     if (!strcmp(lp->s, "1")) {
  459.         echoword("[*]", 0);
  460.         return 1;
  461.     }
  462.     if (!strcmp(lp->s, "0"))
  463.         return 0;
  464.     len = strlen(lp->s);
  465.     cp = msg;
  466.     while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
  467.         cp++;
  468.     if (*cp) {
  469.         cp = lp->s;
  470.         if (*cp != '[')
  471.         cp = format_s("[%s", cp);
  472.         if (cp[strlen(cp)-1] != ']')
  473.         cp = format_s("%s]", cp);
  474.         echoword(cp, 0);
  475.         return 1;
  476.     }
  477.     }
  478.     return 0;
  479. }
  480.  
  481.  
  482.  
  483. void beginerror()
  484. {
  485.     end_source();
  486.     if (showprogress) {
  487.         fprintf(stderr, "\r%60s\r", "");
  488.         clearprogress();
  489.     } else
  490.     echobreak();
  491. }
  492.  
  493.  
  494. void counterror()
  495. {
  496.     if (maxerrors > 0) {
  497.     if (--maxerrors == 0) {
  498.         fprintf(outf, "\n/* Translation aborted: Too many errors. */\n");
  499.         fprintf(outf,   "-------------------------------------------\n");
  500.         if (outf != stdout)
  501.         printf("Translation aborted: Too many errors.\n");
  502.         if (verbose)
  503.         fprintf(logf, "Translation aborted: Too many errors.\n");
  504.         closelogfile();
  505.         exit(EXIT_FAILURE);
  506.     }
  507.     }
  508. }
  509.  
  510.  
  511. void error(msg)     /* does not return */
  512. char *msg;
  513. {
  514.     flushcomments(NULL, -1, -1);
  515.     beginerror();
  516.     fprintf(outf, "/* %s, line %d: %s */\n", infname, inf_lnum, msg);
  517.     fprintf(outf, "/* Translation aborted. */\n");
  518.     fprintf(outf, "--------------------------\n");
  519.     if (outf != stdout) {
  520.         printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
  521.         printf("Translation aborted.\n");
  522.     }
  523.     if (verbose) {
  524.     fprintf(logf, "%s, line %d/%d: %s\n",
  525.         infname, inf_lnum, outf_lnum, msg);
  526.     fprintf(logf, "Translation aborted.\n");
  527.     }
  528.     closelogfile();
  529.     exit(EXIT_FAILURE);
  530. }
  531.  
  532.  
  533. void interror(proc, msg)      /* does not return */
  534. char *proc, *msg;
  535. {
  536.     error(format_ss("Internal error in %s: %s", proc, msg));
  537. }
  538.  
  539.  
  540. void warning(msg)
  541. char *msg;
  542. {
  543.     if (checkeatnote(msg)) {
  544.     if (verbose)
  545.         fprintf(logf, "%s, %d/%d: Omitted warning: %s\n",
  546.             infname, inf_lnum, outf_lnum, msg);
  547.     return;
  548.     }
  549.     beginerror();
  550.     addnote(format_s("Warning: %s", msg), curserial);
  551.     counterror();
  552. }
  553.  
  554.  
  555. void intwarning(proc, msg)
  556. char *proc, *msg;
  557. {
  558.     if (checkeatnote(msg)) {
  559.     if (verbose)
  560.         fprintf(logf, "%s, %d/%d: Omitted internal error in %s: %s\n",
  561.             infname, inf_lnum, outf_lnum, proc, msg);
  562.     return;
  563.     }
  564.     beginerror();
  565.     addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
  566.     if (error_crash)
  567.         exit(EXIT_FAILURE);
  568.     counterror();
  569. }
  570.  
  571.  
  572.  
  573.  
  574. void note(msg)
  575. char *msg;
  576. {
  577.     if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
  578.     if (verbose)
  579.         fprintf(logf, "%s, %d/%d: Omitted note: %s\n",
  580.             infname, inf_lnum, outf_lnum, msg);
  581.     return;
  582.     }
  583.     beginerror();
  584.     addnote(format_s("Note: %s", msg), curserial);
  585.     counterror();
  586. }
  587.  
  588.  
  589.  
  590. void endnote(msg)
  591. char *msg;
  592. {
  593.     if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
  594.     if (verbose)
  595.         fprintf(logf, "%s, %d/%d: Omitted end-note: %s\n",
  596.             infname, inf_lnum, outf_lnum, msg);
  597.     return;
  598.     }
  599.     if (verbose)
  600.     fprintf(logf, "%s, %d/%d: Recorded end-note: %s\n",
  601.         infname, inf_lnum, outf_lnum, msg);
  602.     (void) strlist_add(&endnotelist, msg);
  603. }
  604.  
  605.  
  606. void showendnotes()
  607. {
  608.     while (initialcalls) {
  609.     if (initialcalls->value)
  610.         endnote(format_s("Remember to call %s in main program [215]",
  611.                  initialcalls->s));
  612.     strlist_eat(&initialcalls);
  613.     }
  614.     if (endnotelist) {
  615.     end_source();
  616.     while (endnotelist) {
  617.         if (outf != stdout) {
  618.         beginerror();
  619.         printf("Note: %s\n", endnotelist->s);
  620.         }
  621.         fprintf(outf, "/* p2c: Note: %s */\n", endnotelist->s);
  622.         outf_lnum++;
  623.         strlist_eat(&endnotelist);
  624.     }
  625.     }
  626. }
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633.  
  634. char *tok_name(tok)
  635. Token tok;
  636. {
  637.     if (tok == TOK_END && inputkind == INP_STRLIST)
  638.     return "end of macro";
  639.     if (tok == curtok && tok == TOK_IDENT)
  640.         return format_s("'%s'", curtokcase);
  641.     if (!modulenotation) {
  642.         switch (tok) {
  643.             case TOK_MODULE:    return "UNIT";
  644.             case TOK_IMPORT:    return "USES";
  645.             case TOK_EXPORT:    return "INTERFACE";
  646.             case TOK_IMPLEMENT: return "IMPLEMENTATION";
  647.         default:        break;
  648.         }
  649.     }
  650.     return toknames[(int) tok];
  651. }
  652.  
  653.  
  654.  
  655. void expected(msg)
  656. char *msg;
  657. {
  658.     error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
  659. }
  660.  
  661.  
  662. void expecttok(tok)
  663. Token tok;
  664. {
  665.     if (curtok != tok)
  666.         expected(tok_name(tok));
  667. }
  668.  
  669.  
  670. void needtok(tok)
  671. Token tok;
  672. {
  673.     if (curtok != tok)
  674.         expected(tok_name(tok));
  675.     gettok();
  676. }
  677.  
  678.  
  679. int wexpected(msg)
  680. char *msg;
  681. {
  682.     warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
  683.     return 0;
  684. }
  685.  
  686.  
  687. int wexpecttok(tok)
  688. Token tok;
  689. {
  690.     if (curtok != tok)
  691.         return wexpected(tok_name(tok));
  692.     else
  693.     return 1;
  694. }
  695.  
  696.  
  697. int wneedtok(tok)
  698. Token tok;
  699. {
  700.     if (wexpecttok(tok)) {
  701.     gettok();
  702.     return 1;
  703.     } else
  704.     return 0;
  705. }
  706.  
  707.  
  708. void alreadydef(sym)
  709. Symbol *sym;
  710. {
  711.     warning(format_s("Symbol '%s' was already defined [220]", sym->name));
  712. }
  713.  
  714.  
  715. void undefsym(sym)
  716. Symbol *sym;
  717. {
  718.     warning(format_s("Symbol '%s' is not defined [221]", sym->name));
  719. }
  720.  
  721.  
  722. void symclass(sym)
  723. Symbol *sym;
  724. {
  725.     warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
  726. }
  727.  
  728.  
  729. void badtypes()
  730. {
  731.     warning("Type mismatch [223]");
  732. }
  733.  
  734.  
  735. void valrange()
  736. {
  737.     warning("Value range error [224]");
  738. }
  739.  
  740.  
  741.  
  742. void skipparens()
  743. {
  744.     Token begintok;
  745.  
  746.     if (curtok == TOK_LPAR) {
  747.         gettok();
  748.         while (curtok != TOK_RPAR)
  749.             skipparens();
  750.     } else if (curtok == TOK_LBR) {
  751.         gettok();
  752.         while (curtok != TOK_RBR)
  753.             skipparens();
  754.     } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
  755.            curtok == TOK_CASE) {
  756.     begintok = curtok;
  757.         gettok();
  758.         while (curtok != TOK_END)
  759.         if (curtok == TOK_CASE && begintok == TOK_RECORD)
  760.         gettok();
  761.         else
  762.         skipparens();
  763.     }
  764.     gettok();
  765. }
  766.  
  767.  
  768. void skiptotoken2(tok1, tok2)
  769. Token tok1, tok2;
  770. {
  771.     while (curtok != tok1 && curtok != tok2 &&
  772.        curtok != TOK_END && curtok != TOK_RPAR &&
  773.        curtok != TOK_RBR && curtok != TOK_EOF)
  774.     skipparens();
  775. }
  776.  
  777.  
  778. void skippasttoken2(tok1, tok2)
  779. Token tok1, tok2;
  780. {
  781.     skiptotoken2(tok1, tok2);
  782.     if (curtok == tok1 || curtok == tok2)
  783.     gettok();
  784. }
  785.  
  786.  
  787. void skippasttotoken(tok1, tok2)
  788. Token tok1, tok2;
  789. {
  790.     skiptotoken2(tok1, tok2);
  791.     if (curtok == tok1)
  792.     gettok();
  793. }
  794.  
  795.  
  796. void skiptotoken(tok)
  797. Token tok;
  798. {
  799.     skiptotoken2(tok, tok);
  800. }
  801.  
  802.  
  803. void skippasttoken(tok)
  804. Token tok;
  805. {
  806.     skippasttoken2(tok, tok);
  807. }
  808.  
  809.  
  810.  
  811. int skipopenparen()
  812. {
  813.     if (wneedtok(TOK_LPAR))
  814.     return 1;
  815.     skiptotoken(TOK_SEMI);
  816.     return 0;
  817. }
  818.  
  819.  
  820. int skipcloseparen()
  821. {
  822.     if (curtok == TOK_COMMA)
  823.     warning("Too many arguments for built-in routine [225]");
  824.     else
  825.     if (wneedtok(TOK_RPAR))
  826.         return 1;
  827.     skippasttotoken(TOK_RPAR, TOK_SEMI);
  828.     return 0;
  829. }
  830.  
  831.  
  832. int skipcomma()
  833. {
  834.     if (curtok == TOK_RPAR)
  835.     warning("Too few arguments for built-in routine [226]");
  836.     else
  837.     if (wneedtok(TOK_COMMA))
  838.         return 1;
  839.     skippasttotoken(TOK_RPAR, TOK_SEMI);
  840.     return 0;
  841. }
  842.  
  843.  
  844.  
  845.  
  846.  
  847. char *findaltname(name, num)
  848. char *name;
  849. int num;
  850. {
  851.     char *cp;
  852.  
  853.     if (num <= 0)
  854.         return name;
  855.     if (num == 1 && *alternatename1)
  856.         return format_s(alternatename1, name);
  857.     if (num == 2 && *alternatename2)
  858.         return format_s(alternatename2, name);
  859.     if (*alternatename)
  860.         return format_sd(alternatename, name, num);
  861.     cp = name;
  862.     if (*alternatename1) {
  863.         while (--num >= 0)
  864.         cp = format_s(alternatename1, cp);
  865.     } else {
  866.     while (--num >= 0)
  867.         cp = format_s("%s_", cp);
  868.     }
  869.     return cp;
  870. }
  871.  
  872.  
  873.  
  874.  
  875. Symbol *findsymbol_opt(name)
  876. char *name;
  877. {
  878.     register int i;
  879.     register unsigned int hash;
  880.     register char *cp;
  881.     register Symbol *sp;
  882.  
  883.     hash = 0;
  884.     for (cp = name; *cp; cp++)
  885.         hash = hash*3 + *cp;
  886.     sp = symtab[hash % SYMHASHSIZE];
  887.     while (sp && (i = strcmp(sp->name, name)) != 0) {
  888.         if (i < 0)
  889.             sp = sp->left;
  890.         else
  891.             sp = sp->right;
  892.     }
  893.     return sp;
  894. }
  895.  
  896.  
  897.  
  898. Symbol *findsymbol(name)
  899. char *name;
  900. {
  901.     register int i;
  902.     register unsigned int hash;
  903.     register char *cp;
  904.     register Symbol **prev, *sp;
  905.  
  906.     hash = 0;
  907.     for (cp = name; *cp; cp++)
  908.         hash = hash*3 + *cp;
  909.     prev = symtab + (hash % SYMHASHSIZE);
  910.     while ((sp = *prev) != 0 &&
  911.            (i = strcmp(sp->name, name)) != 0) {
  912.         if (i < 0)
  913.             prev = &(sp->left);
  914.         else
  915.             prev = &(sp->right);
  916.     }
  917.     if (!sp) {
  918.         sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
  919.         sp->mbase = sp->fbase = NULL;
  920.         sp->left = sp->right = NULL;
  921.         strcpy(sp->name, name);
  922.         sp->flags = 0;
  923.     sp->kwtok = TOK_NONE;
  924.         sp->symbolnames = NULL;
  925.         *prev = sp;
  926.     }
  927.     return sp;
  928. }
  929.  
  930.  
  931.  
  932.  
  933. void clearprogress()
  934. {
  935.     oldinfname = NULL;
  936. }
  937.  
  938.  
  939. void progress()
  940. {
  941.     char *ctxname;
  942.     int needrefr;
  943.     static int prevlen;
  944.  
  945.     if (showprogress) {
  946.         if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
  947.             !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
  948.             ctxname = "";
  949.         else
  950.             ctxname = curctx->name;
  951.         needrefr = (inf_lnum & 15) == 0;
  952.         if (oldinfname != infname || oldctxname != ctxname) {
  953.         if (oldinfname != infname)
  954.         prevlen = 60;
  955.             fprintf(stderr, "\r%*s", prevlen + 2, "");
  956.             oldinfname = infname;
  957.             oldctxname = ctxname;
  958.             needrefr = 1;
  959.         }
  960.         if (needrefr) {
  961.             fprintf(stderr, "\r%5d %s  %s", inf_lnum, infname, ctxname);
  962.         prevlen = 8 + strlen(infname) + strlen(ctxname);
  963.         } else {
  964.             fprintf(stderr, "\r%5d", inf_lnum);
  965.         prevlen = 5;
  966.     }
  967.     }
  968. }
  969.  
  970.  
  971.  
  972. void getline()
  973. {
  974.     char *cp, *cp2;
  975.  
  976.     switch (inputkind) {
  977.  
  978.         case INP_FILE:
  979.         case INP_INCFILE:
  980.             inf_lnum++;
  981.         inf_ltotal++;
  982.             if (fgets(inbuf, 300, inf)) {
  983.                 cp = inbuf + strlen(inbuf);
  984.                 if (*inbuf && cp[-1] == '\n')
  985.                     cp[-1] = 0;
  986.         if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
  987.             cp = inbuf + 2;    /* in case input text came */
  988.             inf_lnum = 0;      /*  from the C preprocessor */
  989.             while (isdigit(*cp))
  990.             inf_lnum = inf_lnum*10 + (*cp++) - '0';
  991.             inf_lnum--;
  992.             while (isspace(*cp)) cp++;
  993.             if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
  994.             cp++;
  995.             infname = stralloc(cp);
  996.             infname[cp2 - cp] = 0;
  997.             }
  998.             getline();
  999.             return;
  1000.         }
  1001.         if (copysource && *inbuf) {
  1002.             start_source();
  1003.             fprintf(outf, "%s\n", inbuf);
  1004.         }
  1005.                 if (keepingstrlist) {
  1006.                     strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
  1007.                 }
  1008.                 if (showprogress && inf_lnum % showprogress == 0)
  1009.                     progress();
  1010.             } else {
  1011.                 if (showprogress)
  1012.                     fprintf(stderr, "\n");
  1013.                 if (inputkind == INP_INCFILE) {
  1014.                     pop_input();
  1015.                     getline();
  1016.                 } else
  1017.                     strcpy(inbuf, "\001");
  1018.             }
  1019.             break;
  1020.  
  1021.         case INP_STRLIST:
  1022.             if (instrlist) {
  1023.                 strcpy(inbuf, instrlist->s);
  1024.                 if (instrlist->value)
  1025.                     inf_lnum = instrlist->value;
  1026.                 else
  1027.                     inf_lnum++;
  1028.                 instrlist = instrlist->next;
  1029.             } else
  1030.                 strcpy(inbuf, "\001");
  1031.             break;
  1032.     }
  1033.     inbufptr = inbuf;
  1034.     inbufindent = 0;
  1035. }
  1036.  
  1037.  
  1038.  
  1039.  
  1040. Static void push_input()
  1041. {
  1042.     struct inprec *inp;
  1043.  
  1044.     inp = ALLOC(1, struct inprec, inprecs);
  1045.     inp->kind = inputkind;
  1046.     inp->fname = infname;
  1047.     inp->lnum = inf_lnum;
  1048.     inp->filep = inf;
  1049.     inp->strlistp = instrlist;
  1050.     inp->inbufptr = stralloc(inbufptr);
  1051.     inp->curtok = curtok;
  1052.     inp->curtoksym = curtoksym;
  1053.     inp->curtokmeaning = curtokmeaning;
  1054.     inp->curtokbuf = stralloc(curtokbuf);
  1055.     inp->curtokcase = stralloc(curtokcase);
  1056.     inp->saveblockkind = TOK_NIL;
  1057.     inp->next = topinput;
  1058.     topinput = inp;
  1059.     inbufptr = inbuf + strlen(inbuf);
  1060. }
  1061.  
  1062.  
  1063.  
  1064. void push_input_file(fp, fname, isinclude)
  1065. FILE *fp;
  1066. char *fname;
  1067. int isinclude;
  1068. {
  1069.     push_input();
  1070.     inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
  1071.     inf = fp;
  1072.     inf_lnum = 0;
  1073.     infname = fname;
  1074.     *inbuf = 0;
  1075.     inbufptr = inbuf;
  1076.     topinput->tempopts = tempoptionlist;
  1077.     tempoptionlist = NULL;
  1078.     if (isinclude != 2)
  1079.         gettok();
  1080. }
  1081.  
  1082.  
  1083. void include_as_import()
  1084. {
  1085.     if (inputkind == INP_INCFILE) {
  1086.     if (topinput->saveblockkind == TOK_NIL)
  1087.         topinput->saveblockkind = blockkind;
  1088.     blockkind = TOK_IMPORT;
  1089.     } else
  1090.     warning(format_s("%s ignored except in include files [228]",
  1091.              interfacecomment));
  1092. }
  1093.  
  1094.  
  1095. void push_input_strlist(sp, fname)
  1096. Strlist *sp;
  1097. char *fname;
  1098. {
  1099.     push_input();
  1100.     inputkind = INP_STRLIST;
  1101.     instrlist = sp;
  1102.     if (fname) {
  1103.         infname = fname;
  1104.         inf_lnum = 0;
  1105.     } else
  1106.         inf_lnum--;     /* adjust for extra getline() */
  1107.     *inbuf = 0;
  1108.     inbufptr = inbuf;
  1109.     gettok();
  1110. }
  1111.  
  1112.  
  1113.  
  1114. void pop_input()
  1115. {
  1116.     struct inprec *inp;
  1117.  
  1118.     if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
  1119.     while (tempoptionlist) {
  1120.         undooption(tempoptionlist->value, tempoptionlist->s);
  1121.         strlist_eat(&tempoptionlist);
  1122.     }
  1123.     tempoptionlist = topinput->tempopts;
  1124.     if (inf)
  1125.         fclose(inf);
  1126.     }
  1127.     inp = topinput;
  1128.     topinput = inp->next;
  1129.     if (inp->saveblockkind != TOK_NIL)
  1130.     blockkind = inp->saveblockkind;
  1131.     inputkind = inp->kind;
  1132.     infname = inp->fname;
  1133.     inf_lnum = inp->lnum;
  1134.     inf = inp->filep;
  1135.     curtok = inp->curtok;
  1136.     curtoksym = inp->curtoksym;
  1137.     curtokmeaning = inp->curtokmeaning;
  1138.     strcpy(curtokbuf, inp->curtokbuf);
  1139.     FREE(inp->curtokbuf);
  1140.     strcpy(curtokcase, inp->curtokcase);
  1141.     FREE(inp->curtokcase);
  1142.     strcpy(inbuf, inp->inbufptr);
  1143.     FREE(inp->inbufptr);
  1144.     inbufptr = inbuf;
  1145.     instrlist = inp->strlistp;
  1146.     FREE(inp);
  1147. }
  1148.  
  1149.  
  1150.  
  1151.  
  1152. int undooption(i, name)
  1153. int i;
  1154. char *name;
  1155. {
  1156.     char kind = rctable[i].kind;
  1157.  
  1158.     switch (kind) {
  1159.  
  1160.         case 'S':
  1161.     case 'B':
  1162.         if (rcprevvalues[i]) {
  1163.                 *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
  1164.                 strlist_eat(&rcprevvalues[i]);
  1165.                 return 1;
  1166.             }
  1167.             break;
  1168.  
  1169.         case 'I':
  1170.         case 'D':
  1171.             if (rcprevvalues[i]) {
  1172.                 *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
  1173.                 strlist_eat(&rcprevvalues[i]);
  1174.                 return 1;
  1175.             }
  1176.             break;
  1177.  
  1178.         case 'L':
  1179.             if (rcprevvalues[i]) {
  1180.                 *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
  1181.                 strlist_eat(&rcprevvalues[i]);
  1182.                 return 1;
  1183.             }
  1184.             break;
  1185.  
  1186.     case 'R':
  1187.         if (rcprevvalues[i]) {
  1188.         *((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
  1189.         strlist_eat(&rcprevvalues[i]);
  1190.         return 1;
  1191.         }
  1192.         break;
  1193.  
  1194.         case 'C':
  1195.         case 'U':
  1196.             if (rcprevvalues[i]) {
  1197.                 strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
  1198.                 strlist_eat(&rcprevvalues[i]);
  1199.                 return 1;
  1200.             }
  1201.             break;
  1202.  
  1203.         case 'A':
  1204.             strlist_remove((Strlist **)rctable[i].ptr, name);
  1205.             return 1;
  1206.  
  1207.         case 'X':
  1208.             if (rctable[i].def == 1) {
  1209.                 strlist_remove((Strlist **)rctable[i].ptr, name);
  1210.                 return 1;
  1211.             }
  1212.             break;
  1213.  
  1214.     }
  1215.     return 0;
  1216. }
  1217.  
  1218.  
  1219.  
  1220.  
  1221. void badinclude()
  1222. {
  1223.     warning("Can't handle an \"include\" directive here [229]");
  1224.     inputkind = INP_INCFILE;     /* expand it in-line */
  1225.     gettok();
  1226. }
  1227.  
  1228.  
  1229.  
  1230. int handle_include(fn)
  1231. char *fn;
  1232. {
  1233.     FILE *fp = NULL;
  1234.     Strlist *sl;
  1235.  
  1236.     for (sl = includedirs; sl; sl = sl->next) {
  1237.     fp = fopen(format_s(sl->s, fn), "r");
  1238.     if (fp) {
  1239.         fn = stralloc(format_s(sl->s, fn));
  1240.         break;
  1241.     }
  1242.     }
  1243.     if (!fp) {
  1244.         perror(fn);
  1245.         warning(format_s("Could not open include file %s [230]", fn));
  1246.         return 0;
  1247.     } else {
  1248.         if (!quietmode && !showprogress)
  1249.         if (outf == stdout)
  1250.         fprintf(stderr, "Reading include file \"%s\"\n", fn);
  1251.         else
  1252.         printf("Reading include file \"%s\"\n", fn);
  1253.     if (verbose)
  1254.         fprintf(logf, "Reading include file \"%s\"\n", fn);
  1255.         if (expandincludes == 0) {
  1256.             push_input_file(fp, fn, 2);
  1257.             curtok = TOK_INCLUDE;
  1258.             strcpy(curtokbuf, fn);
  1259.         } else {
  1260.             push_input_file(fp, fn, 1);
  1261.         }
  1262.         return 1;
  1263.     }
  1264. }
  1265.  
  1266.  
  1267.  
  1268. int turbo_directive(closing, after)
  1269. char *closing, *after;
  1270. {
  1271.     char *cp, *cp2;
  1272.     int i, result;
  1273.  
  1274.     if (!strcincmp(inbufptr, "$double", 7)) {
  1275.     cp = inbufptr + 7;
  1276.     while (isspace(*cp)) cp++;
  1277.     if (cp == closing) {
  1278.         inbufptr = after;
  1279.         doublereals = 1;
  1280.         return 1;
  1281.     }
  1282.     } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
  1283.     cp = inbufptr + 9;
  1284.     while (isspace(*cp)) cp++;
  1285.     if (cp == closing) {
  1286.         inbufptr = after;
  1287.         doublereals = 0;
  1288.         return 1;
  1289.     }
  1290.     }
  1291.     switch (inbufptr[2]) {
  1292.  
  1293.         case '+':
  1294.         case '-':
  1295.             result = 1;
  1296.             cp = inbufptr + 1;
  1297.             for (;;) {
  1298.                 if (!isalpha(*cp++))
  1299.                     return 0;
  1300.                 if (*cp != '+' && *cp != '-')
  1301.                     return 0;
  1302.                 if (++cp == closing)
  1303.                     break;
  1304.                 if (*cp++ != ',')
  1305.                     return 0;
  1306.             }
  1307.             cp = inbufptr + 1;
  1308.             do {
  1309.                 switch (*cp++) {
  1310.  
  1311.                     case 'b':
  1312.                     case 'B':
  1313.                         if (shortcircuit < 0 && which_lang != LANG_MPW)
  1314.                             partial_eval_flag = (*cp == '-');
  1315.                         break;
  1316.  
  1317.                     case 'i':
  1318.                     case 'I':
  1319.                         iocheck_flag = (*cp == '+');
  1320.                         break;
  1321.  
  1322.                     case 'r':
  1323.                     case 'R':
  1324.                         if (*cp == '+') {
  1325.                             if (!range_flag)
  1326.                                 note("Range checking is ON [216]");
  1327.                             range_flag = 1;
  1328.                         } else {
  1329.                             if (range_flag)
  1330.                                 note("Range checking is OFF [216]");
  1331.                             range_flag = 0;
  1332.                         }
  1333.                         break;
  1334.  
  1335.                     case 's':
  1336.                     case 'S':
  1337.                         if (*cp == '+') {
  1338.                             if (!stackcheck_flag)
  1339.                                 note("Stack checking is ON [217]");
  1340.                             stackcheck_flag = 1;
  1341.                         } else {
  1342.                             if (stackcheck_flag)
  1343.                                 note("Stack checking is OFF [217]");
  1344.                             stackcheck_flag = 0;
  1345.                         }
  1346.                         break;
  1347.  
  1348.                     default:
  1349.                         result = 0;
  1350.                         break;
  1351.                 }
  1352.                 cp++;
  1353.             } while (*cp++ == ',');
  1354.             if (result)
  1355.                 inbufptr = after;
  1356.             return result;
  1357.  
  1358.     case 'c':
  1359.     case 'C':
  1360.         if (toupper(inbufptr[1]) == 'S' &&
  1361.         (inbufptr[3] == '+' || inbufptr[3] == '-') &&
  1362.         inbufptr + 4 == closing) {
  1363.         if (shortcircuit < 0)
  1364.             partial_eval_flag = (inbufptr[3] == '+');
  1365.         inbufptr = after;
  1366.         return 1;
  1367.         }
  1368.         return 0;
  1369.  
  1370.         case ' ':
  1371.             switch (inbufptr[1]) {
  1372.  
  1373.                 case 'i':
  1374.                 case 'I':
  1375.                     if (skipping_module)
  1376.                         break;
  1377.                     cp = inbufptr + 3;
  1378.                     while (isspace(*cp)) cp++;
  1379.                     cp2 = cp;
  1380.                     i = 0;
  1381.                     while (*cp2 && cp2 != closing)
  1382.                         i++, cp2++;
  1383.                     if (cp2 != closing)
  1384.                         return 0;
  1385.                     while (isspace(cp[i-1]))
  1386.                         if (--i <= 0)
  1387.                             return 0;
  1388.                     inbufptr = after;
  1389.                     cp2 = ALLOC(i + 1, char, strings);
  1390.                     strncpy(cp2, cp, i);
  1391.                     cp2[i] = 0;
  1392.                     if (handle_include(cp2))
  1393.             return 2;
  1394.             break;
  1395.  
  1396.         case 's':
  1397.         case 'S':
  1398.             cp = inbufptr + 3;
  1399.             outsection(minorspace);
  1400.             if (cp == closing) {
  1401.             output("#undef __SEG__\n");
  1402.             } else {
  1403.             output("#define __SEG__ ");
  1404.             while (*cp && cp != closing)
  1405.                 cp++;
  1406.             if (*cp) {
  1407.                 i = *cp;
  1408.                 *cp = 0;
  1409.                 output(inbufptr + 3);
  1410.                 *cp = i;
  1411.             }
  1412.             output("\n");
  1413.             }
  1414.             outsection(minorspace);
  1415.             inbufptr = after;
  1416.             return 1;
  1417.  
  1418.             }
  1419.             return 0;
  1420.  
  1421.     case '}':
  1422.     case '*':
  1423.         if (inbufptr + 2 == closing) {
  1424.         switch (inbufptr[1]) {
  1425.             
  1426.           case 's':
  1427.           case 'S':
  1428.             outsection(minorspace);
  1429.             output("#undef __SEG__\n");
  1430.             outsection(minorspace);
  1431.             inbufptr = after;
  1432.             return 1;
  1433.  
  1434.         }
  1435.         }
  1436.         return 0;
  1437.  
  1438.         case 'f':   /* $ifdef etc. */
  1439.         case 'F':
  1440.             if (toupper(inbufptr[1]) == 'I' &&
  1441.                 ((toupper(inbufptr[3]) == 'O' &&
  1442.                   toupper(inbufptr[4]) == 'P' &&
  1443.                   toupper(inbufptr[5]) == 'T') ||
  1444.                  (toupper(inbufptr[3]) == 'D' &&
  1445.                   toupper(inbufptr[4]) == 'E' &&
  1446.                   toupper(inbufptr[5]) == 'F') ||
  1447.                  (toupper(inbufptr[3]) == 'N' &&
  1448.                   toupper(inbufptr[4]) == 'D' &&
  1449.                   toupper(inbufptr[5]) == 'E' &&
  1450.                   toupper(inbufptr[6]) == 'F'))) {
  1451.                 note("Turbo Pascal conditional compilation directive was ignored [218]");
  1452.             }
  1453.             return 0;
  1454.  
  1455.     }
  1456.     return 0;
  1457. }
  1458.  
  1459.  
  1460.  
  1461.  
  1462. extern Strlist *addmacros;
  1463.  
  1464. void defmacro(name, kind, fname, lnum)
  1465. char *name, *fname;
  1466. long kind;
  1467. int lnum;
  1468. {
  1469.     Strlist *defsl, *sl, *sl2;
  1470.     Symbol *sym, *sym2;
  1471.     Meaning *mp;
  1472.     Expr *ex;
  1473.  
  1474.     defsl = NULL;
  1475.     sl = strlist_append(&defsl, name);
  1476.     C_lex++;
  1477.     if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
  1478.         fname = curtoksym->name;
  1479.     push_input_strlist(defsl, fname);
  1480.     if (fname)
  1481.         inf_lnum = lnum;
  1482.     switch (kind) {
  1483.  
  1484.         case MAC_VAR:
  1485.             if (!wexpecttok(TOK_IDENT))
  1486.         break;
  1487.         for (mp = curtoksym->mbase; mp; mp = mp->snext) {
  1488.         if (mp->kind == MK_VAR)
  1489.             warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
  1490.         }
  1491.             sl = strlist_append(&varmacros, curtoksym->name);
  1492.             gettok();
  1493.             if (!wneedtok(TOK_EQ))
  1494.         break;
  1495.             sl->value = (long)pc_expr();
  1496.             break;
  1497.  
  1498.         case MAC_CONST:
  1499.             if (!wexpecttok(TOK_IDENT))
  1500.         break;
  1501.         for (mp = curtoksym->mbase; mp; mp = mp->snext) {
  1502.         if (mp->kind == MK_CONST)
  1503.             warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
  1504.         }
  1505.             sl = strlist_append(&constmacros, curtoksym->name);
  1506.             gettok();
  1507.             if (!wneedtok(TOK_EQ))
  1508.         break;
  1509.             sl->value = (long)pc_expr();
  1510.             break;
  1511.  
  1512.         case MAC_FIELD:
  1513.             if (!wexpecttok(TOK_IDENT))
  1514.         break;
  1515.             sym = curtoksym;
  1516.             gettok();
  1517.             if (!wneedtok(TOK_DOT))
  1518.         break;
  1519.             if (!wexpecttok(TOK_IDENT))
  1520.         break;
  1521.         sym2 = curtoksym;
  1522.             gettok();
  1523.         if (!wneedtok(TOK_EQ))
  1524.         break;
  1525.             funcmacroargs = NULL;
  1526.             sym->flags |= FMACREC;
  1527.             ex = pc_expr();
  1528.             sym->flags &= ~FMACREC;
  1529.         for (mp = sym2->fbase; mp; mp = mp->snext) {
  1530.         if (mp->rectype && mp->rectype->meaning &&
  1531.             mp->rectype->meaning->sym == sym)
  1532.             break;
  1533.         }
  1534.         if (mp) {
  1535.         mp->constdefn = ex;
  1536.         } else {
  1537.         sl = strlist_append(&fieldmacros, 
  1538.                     format_ss("%s.%s", sym->name, sym2->name));
  1539.         sl->value = (long)ex;
  1540.         }
  1541.             break;
  1542.  
  1543.         case MAC_FUNC:
  1544.             if (!wexpecttok(TOK_IDENT))
  1545.         break;
  1546.             sym = curtoksym;
  1547.             if (sym->mbase &&
  1548.         (sym->mbase->kind == MK_FUNCTION ||
  1549.          sym->mbase->kind == MK_SPECIAL))
  1550.                 sl = NULL;
  1551.             else
  1552.                 sl = strlist_append(&funcmacros, sym->name);
  1553.             gettok();
  1554.             funcmacroargs = NULL;
  1555.             if (curtok == TOK_LPAR) {
  1556.                 do {
  1557.                     gettok();
  1558.             if (curtok == TOK_RPAR && !funcmacroargs)
  1559.             break;
  1560.                     if (!wexpecttok(TOK_IDENT)) {
  1561.             skiptotoken2(TOK_COMMA, TOK_RPAR);
  1562.             continue;
  1563.             }
  1564.                     sl2 = strlist_append(&funcmacroargs, curtoksym->name);
  1565.                     sl2->value = (long)curtoksym;
  1566.                     curtoksym->flags |= FMACREC;
  1567.                     gettok();
  1568.                 } while (curtok == TOK_COMMA);
  1569.                 if (!wneedtok(TOK_RPAR))
  1570.             skippasttotoken(TOK_RPAR, TOK_EQ);
  1571.             }
  1572.             if (!wneedtok(TOK_EQ))
  1573.         break;
  1574.             if (sl)
  1575.                 sl->value = (long)pc_expr();
  1576.             else
  1577.                 sym->mbase->constdefn = pc_expr();
  1578.             for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
  1579.                 sym2 = (Symbol *)sl2->value;
  1580.                 sym2->flags &= ~FMACREC;
  1581.             }
  1582.             strlist_empty(&funcmacroargs);
  1583.             break;
  1584.  
  1585.     }
  1586.     if (curtok != TOK_EOF)
  1587.         warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
  1588.     pop_input();
  1589.     C_lex--;
  1590.     strlist_empty(&defsl);
  1591. }
  1592.  
  1593.  
  1594.  
  1595. void check_unused_macros()
  1596. {
  1597.     Strlist *sl;
  1598.  
  1599.     if (warnmacros) {
  1600.         for (sl = varmacros; sl; sl = sl->next)
  1601.             warning(format_s("VarMacro %s was never used [234]", sl->s));
  1602.         for (sl = constmacros; sl; sl = sl->next)
  1603.             warning(format_s("ConstMacro %s was never used [234]", sl->s));
  1604.         for (sl = fieldmacros; sl; sl = sl->next)
  1605.             warning(format_s("FieldMacro %s was never used [234]", sl->s));
  1606.         for (sl = funcmacros; sl; sl = sl->next)
  1607.             warning(format_s("FuncMacro %s was never used [234]", sl->s));
  1608.     }
  1609. }
  1610.  
  1611.  
  1612.  
  1613.  
  1614.  
  1615. #define skipspc(cp)   while (isspace(*cp)) cp++
  1616.  
  1617. Static int parsecomment(p2c_only, starparen)
  1618. int p2c_only, starparen;
  1619. {
  1620.     char namebuf[302];
  1621.     char *cp, *cp2 = namebuf, *closing, *after;
  1622.     char kind, chgmode, upcflag;
  1623.     long val, oldval, sign;
  1624.     double dval;
  1625.     int i, tempopt, hassign;
  1626.     Strlist *sp;
  1627.     Symbol *sym;
  1628.  
  1629.     if (if_flag)
  1630.         return 0;
  1631.     if (!p2c_only) {
  1632.         if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
  1633.          *noskipcomment) {
  1634.             inbufptr += strlen(noskipcomment);
  1635.         if (skipflag < 0) {
  1636.         if (skipflag < -1) {
  1637.             skipflag++;
  1638.         } else {
  1639.             curtok = TOK_ENDIF;
  1640.             skipflag = 1;
  1641.             return 2;
  1642.         }
  1643.         } else {
  1644.         skipflag = 1;
  1645.         return 1;
  1646.         }
  1647.         }
  1648.     }
  1649.     closing = inbufptr;
  1650.     while (*closing && (starparen
  1651.             ? (closing[0] != '*' || closing[1] != ')')
  1652.             : (closing[0] != '}')))
  1653.     closing++;
  1654.     if (!*closing)
  1655.     return 0;
  1656.     after = closing + (starparen ? 2 : 1);
  1657.     cp = inbufptr;
  1658.     while (cp < closing && (*cp != '#' || cp[1] != '#'))
  1659.     cp++;    /* Ignore comments */
  1660.     if (cp < closing) {
  1661.     while (isspace(cp[-1]))
  1662.         cp--;
  1663.     *cp = '#';   /* avoid skipping spaces past closing! */
  1664.     closing = cp;
  1665.     }
  1666.     if (!p2c_only) {
  1667.         if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
  1668.          closing == inbufptr + 12) {
  1669.             wrapup();
  1670.             inbufptr = after;
  1671.             return 1;
  1672.         }
  1673.         if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
  1674.          *fixedcomment &&
  1675.          inbufptr + strlen(fixedcomment) == closing) {
  1676.             fixedflag++;
  1677.             inbufptr = after;
  1678.             return 1;
  1679.         }
  1680.         if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
  1681.          *permanentcomment &&
  1682.          inbufptr + strlen(permanentcomment) == closing) {
  1683.             permflag = 1;
  1684.             inbufptr = after;
  1685.             return 1;
  1686.         }
  1687.         if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
  1688.          *interfacecomment &&
  1689.          inbufptr + strlen(interfacecomment) == closing) {
  1690.             inbufptr = after;
  1691.         curtok = TOK_INTFONLY;
  1692.             return 2;
  1693.         }
  1694.         if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
  1695.          *skipcomment &&
  1696.          inbufptr + strlen(skipcomment) == closing) {
  1697.             inbufptr = after;
  1698.         skipflag--;
  1699.         if (skipflag == -1) {
  1700.         skipping_module++;    /* eat comments in skipped portion */
  1701.         do {
  1702.             gettok();
  1703.         } while (curtok != TOK_ENDIF);
  1704.         skipping_module--;
  1705.         }
  1706.             return 1;
  1707.         }
  1708.     if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
  1709.          *signedcomment && !p2c_only &&
  1710.          inbufptr + strlen(signedcomment) == closing) {
  1711.         inbufptr = after;
  1712.         gettok();
  1713.         if (curtok == TOK_IDENT && curtokmeaning &&
  1714.         curtokmeaning->kind == MK_TYPE &&
  1715.         curtokmeaning->type == tp_char) {
  1716.         curtokmeaning = mp_schar;
  1717.         } else
  1718.         warning("{SIGNED} applied to type other than CHAR [314]");
  1719.         return 2;
  1720.     }
  1721.     if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
  1722.          *unsignedcomment && !p2c_only &&
  1723.          inbufptr + strlen(unsignedcomment) == closing) {
  1724.         inbufptr = after;
  1725.         gettok();
  1726.         if (curtok == TOK_IDENT && curtokmeaning &&
  1727.         curtokmeaning->kind == MK_TYPE &&
  1728.         curtokmeaning->type == tp_char) {
  1729.         curtokmeaning = mp_uchar;
  1730.         } else if (curtok == TOK_IDENT && curtokmeaning &&
  1731.                curtokmeaning->kind == MK_TYPE &&
  1732.                curtokmeaning->type == tp_integer) {
  1733.         curtokmeaning = mp_unsigned;
  1734.         } else if (curtok == TOK_IDENT && curtokmeaning &&
  1735.                curtokmeaning->kind == MK_TYPE &&
  1736.                curtokmeaning->type == tp_int) {
  1737.         curtokmeaning = mp_uint;
  1738.         } else
  1739.         warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
  1740.         return 2;
  1741.     }
  1742.         if (*inbufptr == '$') {
  1743.             i = turbo_directive(closing, after);
  1744.             if (i)
  1745.                 return i;
  1746.         }
  1747.     }
  1748.     tempopt = 0;
  1749.     cp = inbufptr;
  1750.     if (*cp == '*') {
  1751.         cp++;
  1752.         tempopt = 1;
  1753.     }
  1754.     if (!isalpha(*cp))
  1755.         return 0;
  1756.     while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
  1757.         *cp2++ = toupper(*cp++);
  1758.     *cp2 = 0;
  1759.     i = numparams;
  1760.     while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
  1761.     if (i < 0)
  1762.         return 0;
  1763.     kind = rctable[i].kind;
  1764.     chgmode = rctable[i].chgmode;
  1765.     if (chgmode == ' ')    /* allowed in p2crc only */
  1766.         return 0;
  1767.     if (chgmode == 'T' && lex_initialized) {
  1768.         if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
  1769.             warning(format_s("%s works only at top of program [235]",
  1770.                              rctable[i].name));
  1771.     }
  1772.     if (cp == closing) {
  1773.         if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
  1774.         kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
  1775.             undooption(i, "");
  1776.             inbufptr = after;
  1777.             return 1;
  1778.         }
  1779.     }
  1780.     switch (kind) {
  1781.  
  1782.         case 'S':
  1783.         case 'I':
  1784.         case 'L':
  1785.             val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
  1786.                            (kind == 'S') ? *((short *)rctable[i].ptr) :
  1787.                                            *((  int *)rctable[i].ptr);
  1788.             switch (*cp) {
  1789.  
  1790.                 case '=':
  1791.                     skipspc(cp);
  1792.             hassign = (*++cp == '-' || *cp == '+');
  1793.                     sign = (*cp == '-') ? -1 : 1;
  1794.             cp += hassign;
  1795.                     if (isdigit(*cp)) {
  1796.                         val = 0;
  1797.                         while (isdigit(*cp))
  1798.                             val = val * 10 + (*cp++) - '0';
  1799.                         val *= sign;
  1800.             if (kind == 'D' && !hassign)
  1801.                 val += 10000;
  1802.                     } else if (toupper(cp[0]) == 'D' &&
  1803.                                toupper(cp[1]) == 'E' &&
  1804.                                toupper(cp[2]) == 'F') {
  1805.                         val = rctable[i].def;
  1806.                         cp += 3;
  1807.                     }
  1808.                     break;
  1809.  
  1810.                 case '+':
  1811.                 case '-':
  1812.                     if (chgmode != 'R')
  1813.                         return 0;
  1814.                     for (;;) {
  1815.                         if (*cp == '+')
  1816.                             val++;
  1817.                         else if (*cp == '-')
  1818.                             val--;
  1819.                         else
  1820.                             break;
  1821.                         cp++;
  1822.                     }
  1823.                     break;
  1824.  
  1825.             }
  1826.             skipspc(cp);
  1827.             if (cp != closing)
  1828.                 return 0;
  1829.             strlist_insert(&rcprevvalues[i], "")->value = oldval;
  1830.             if (tempopt)
  1831.                 strlist_insert(&tempoptionlist, "")->value = i;
  1832.             if (kind == 'L')
  1833.                 *((long *)rctable[i].ptr) = val;
  1834.             else if (kind == 'S')
  1835.                 *((short *)rctable[i].ptr) = val;
  1836.             else
  1837.                 *((int *)rctable[i].ptr) = val;
  1838.             inbufptr = after;
  1839.             return 1;
  1840.  
  1841.     case 'D':
  1842.             val = oldval = *((int *)rctable[i].ptr);
  1843.         if (*cp++ != '=')
  1844.         return 0;
  1845.         skipspc(cp);
  1846.         if (toupper(cp[0]) == 'D' &&
  1847.         toupper(cp[1]) == 'E' &&
  1848.         toupper(cp[2]) == 'F') {
  1849.         val = rctable[i].def;
  1850.         cp += 3;
  1851.         } else {
  1852.                 cp2 = namebuf;
  1853.                 while (*cp && cp != closing && !isspace(*cp))
  1854.                     *cp2++ = *cp++;
  1855.         *cp2 = 0;
  1856.         val = parsedelta(namebuf, -1);
  1857.         if (!val)
  1858.             return 0;
  1859.         }
  1860.         skipspc(cp);
  1861.             if (cp != closing)
  1862.                 return 0;
  1863.             strlist_insert(&rcprevvalues[i], "")->value = oldval;
  1864.             if (tempopt)
  1865.                 strlist_insert(&tempoptionlist, "")->value = i;
  1866.             *((int *)rctable[i].ptr) = val;
  1867.             inbufptr = after;
  1868.             return 1;
  1869.  
  1870.         case 'R':
  1871.         if (*cp++ != '=')
  1872.         return 0;
  1873.         skipspc(cp);
  1874.         if (toupper(cp[0]) == 'D' &&
  1875.         toupper(cp[1]) == 'E' &&
  1876.         toupper(cp[2]) == 'F') {
  1877.         dval = rctable[i].def / 100.0;
  1878.         cp += 3;
  1879.         } else {
  1880.         cp2 = cp;
  1881.         while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
  1882.                *cp == '.' || toupper(*cp) == 'E')
  1883.             cp++;
  1884.         if (cp == cp2)
  1885.             return 0;
  1886.         dval = atof(cp2);
  1887.         }
  1888.         skipspc(cp);
  1889.         if (cp != closing)
  1890.         return 0;
  1891.         sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
  1892.             strlist_insert(&rcprevvalues[i], namebuf);
  1893.             if (tempopt)
  1894.                 strlist_insert(&tempoptionlist, namebuf)->value = i;
  1895.         *((double *)rctable[i].ptr) = dval;
  1896.             inbufptr = after;
  1897.             return 1;
  1898.  
  1899.         case 'B':
  1900.         if (*cp++ != '=')
  1901.         return 0;
  1902.         skipspc(cp);
  1903.         if (toupper(cp[0]) == 'D' &&
  1904.         toupper(cp[1]) == 'E' &&
  1905.         toupper(cp[2]) == 'F') {
  1906.         val = rctable[i].def;
  1907.         cp += 3;
  1908.         } else {
  1909.         val = parse_breakstr(cp);
  1910.         while (*cp && cp != closing && !isspace(*cp))
  1911.             cp++;
  1912.         }
  1913.         skipspc(cp);
  1914.         if (cp != closing || val == -1)
  1915.         return 0;
  1916.             strlist_insert(&rcprevvalues[i], "")->value =
  1917.         *((short *)rctable[i].ptr);
  1918.             if (tempopt)
  1919.                 strlist_insert(&tempoptionlist, "")->value = i;
  1920.         *((short *)rctable[i].ptr) = val;
  1921.             inbufptr = after;
  1922.             return 1;
  1923.  
  1924.         case 'C':
  1925.         case 'U':
  1926.             if (*cp == '=') {
  1927.                 cp++;
  1928.                 skipspc(cp);
  1929.                 for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
  1930.                     if (!*cp2 || cp2-cp >= rctable[i].def)
  1931.                         return 0;
  1932.                 cp2 = (char *)rctable[i].ptr;
  1933.                 sp = strlist_insert(&rcprevvalues[i], cp2);
  1934.                 if (tempopt)
  1935.                     strlist_insert(&tempoptionlist, "")->value = i;
  1936.                 while (cp != closing && !isspace(*cp2))
  1937.                     *cp2++ = *cp++;
  1938.                 *cp2 = 0;
  1939.                 if (kind == 'U')
  1940.                     upc((char *)rctable[i].ptr);
  1941.                 skipspc(cp);
  1942.                 if (cp != closing)
  1943.                     return 0;
  1944.                 inbufptr = after;
  1945.                 if (!strcmp(rctable[i].name, "LANGUAGE") &&
  1946.                     !strcmp((char *)rctable[i].ptr, "MODCAL"))
  1947.                     sysprog_flag |= 2;
  1948.                 return 1;
  1949.             }
  1950.             return 0;
  1951.  
  1952.         case 'F':
  1953.         case 'G':
  1954.             if (*cp == '=' || *cp == '+' || *cp == '-') {
  1955.                 upcflag = (kind == 'F' && !pascalcasesens);
  1956.                 chgmode = *cp++;
  1957.                 skipspc(cp);
  1958.                 cp2 = namebuf;
  1959.                 while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
  1960.                     *cp2++ = *cp++;
  1961.                 *cp2++ = 0;
  1962.         if (!*namebuf)
  1963.             return 0;
  1964.                 skipspc(cp);
  1965.                 if (cp != closing)
  1966.                     return 0;
  1967.                 if (upcflag)
  1968.                     upc(namebuf);
  1969.                 sym = findsymbol(namebuf);
  1970.         if (rctable[i].def & FUNCBREAK)
  1971.             sym->flags &= ~FUNCBREAK;
  1972.                 if (chgmode == '-')
  1973.                     sym->flags &= ~rctable[i].def;
  1974.                 else
  1975.                     sym->flags |= rctable[i].def;
  1976.                 inbufptr = after;
  1977.                 return 1;
  1978.            }
  1979.            return 0;
  1980.  
  1981.         case 'A':
  1982.             if (*cp == '=' || *cp == '+' || *cp == '-') {
  1983.                 chgmode = *cp++;
  1984.                 skipspc(cp);
  1985.                 cp2 = namebuf;
  1986.                 while (cp != closing && !isspace(*cp) && *cp)
  1987.                     *cp2++ = *cp++;
  1988.                 *cp2++ = 0;
  1989.                 skipspc(cp);
  1990.                 if (cp != closing)
  1991.                     return 0;
  1992.                 if (chgmode != '+')
  1993.                     strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  1994.                 if (chgmode != '-')
  1995.                     sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
  1996.                 if (tempopt)
  1997.                     strlist_insert(&tempoptionlist, namebuf)->value = i;
  1998.                 inbufptr = after;
  1999.                 return 1;
  2000.             }
  2001.             return 0;
  2002.  
  2003.         case 'M':
  2004.             if (!isspace(*cp))
  2005.                 return 0;
  2006.             skipspc(cp);
  2007.             if (!isalpha(*cp))
  2008.                 return 0;
  2009.             for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
  2010.             if (cp2 > cp && cp2 == closing) {
  2011.                 inbufptr = after;
  2012.                 cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
  2013.                 if (tp_integer != NULL) {
  2014.                     defmacro(cp2, rctable[i].def, NULL, 0);
  2015.                 } else {
  2016.                     sp = strlist_append(&addmacros, cp2);
  2017.                     sp->value = rctable[i].def;
  2018.                 }
  2019.                 return 1;
  2020.             }
  2021.             return 0;
  2022.  
  2023.         case 'X':
  2024.             switch (rctable[i].def) {
  2025.  
  2026.                 case 1:     /* strlist with string values */
  2027.                     if (!isspace(*cp) && *cp != '=' && 
  2028.                         *cp != '+' && *cp != '-')
  2029.                         return 0;
  2030.                     chgmode = *cp++;
  2031.                     skipspc(cp);
  2032.                     cp2 = namebuf;
  2033.                     while (isalnum(*cp) || *cp == '_' ||
  2034.                *cp == '$' || *cp == '%' ||
  2035.                *cp == '.' || *cp == '-' ||
  2036.                (*cp == '\'' && cp[1] && cp[2] == '\'' &&
  2037.                 cp+1 != closing && cp[1] != '=')) {
  2038.             if (*cp == '\'') {
  2039.                 *cp2++ = *cp++;
  2040.                 *cp2++ = *cp++;
  2041.             }                
  2042.                         *cp2++ = *cp++;
  2043.             }
  2044.                     *cp2++ = 0;
  2045.                     if (chgmode == '-') {
  2046.                         skipspc(cp);
  2047.                         if (cp != closing)
  2048.                             return 0;
  2049.                         strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  2050.                     } else {
  2051.                         if (!isspace(*cp) && *cp != '=')
  2052.                             return 0;
  2053.                         skipspc(cp);
  2054.                         if (*cp == '=') {
  2055.                             cp++;
  2056.                             skipspc(cp);
  2057.                         }
  2058.                         if (chgmode == '=' || isspace(chgmode))
  2059.                             strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  2060.                         sp = strlist_append((Strlist **)rctable[i].ptr, namebuf);
  2061.                         if (tempopt)
  2062.                             strlist_insert(&tempoptionlist, namebuf)->value = i;
  2063.                         cp2 = namebuf;
  2064.                         while (*cp && cp != closing && !isspace(*cp))
  2065.                             *cp2++ = *cp++;
  2066.                         *cp2++ = 0;
  2067.                         skipspc(cp);
  2068.                         if (cp != closing)
  2069.                             return 0;
  2070.                         sp->value = (long)stralloc(namebuf);
  2071.                     }
  2072.                     inbufptr = after;
  2073.                     if (lex_initialized)
  2074.                         handle_nameof();        /* as good a place to do this as any! */
  2075.                     return 1;
  2076.  
  2077.                 case 3:     /* Synonym parameter */
  2078.             if (isspace(*cp) || *cp == '=' ||
  2079.             *cp == '+' || *cp == '-') {
  2080.             chgmode = *cp++;
  2081.             skipspc(cp);
  2082.             cp2 = namebuf;
  2083.             while (isalnum(*cp) || *cp == '_' ||
  2084.                    *cp == '$' || *cp == '%')
  2085.                 *cp2++ = *cp++;
  2086.             *cp2++ = 0;
  2087.             if (!*namebuf)
  2088.                 return 0;
  2089.             skipspc(cp);
  2090.             if (!pascalcasesens)
  2091.                 upc(namebuf);
  2092.             sym = findsymbol(namebuf);
  2093.             if (chgmode == '-') {
  2094.                 if (cp != closing)
  2095.                 return 0;
  2096.                 sym->flags &= ~SSYNONYM;
  2097.                 inbufptr = after;
  2098.                 return 1;
  2099.             }
  2100.             if (*cp == '=') {
  2101.                 cp++;
  2102.                 skipspc(cp);
  2103.             }
  2104.             cp2 = namebuf;
  2105.             while (isalnum(*cp) || *cp == '_' ||
  2106.                    *cp == '$' || *cp == '%')
  2107.                 *cp2++ = *cp++;
  2108.             *cp2++ = 0;
  2109.             skipspc(cp);
  2110.             if (cp != closing)
  2111.                 return 0;
  2112.             sym->flags |= SSYNONYM;
  2113.             if (!pascalcasesens)
  2114.                 upc(namebuf);
  2115.             if (*namebuf)
  2116.                 strlist_append(&sym->symbolnames, "===")->value =
  2117.                 (long)findsymbol(namebuf);
  2118.             else
  2119.                 strlist_append(&sym->symbolnames, "===")->value=0;
  2120.             inbufptr = after;
  2121.             return 1;
  2122.             }
  2123.             return 0;
  2124.  
  2125.             }
  2126.             return 0;
  2127.  
  2128.     }
  2129.     return 0;
  2130. }
  2131.  
  2132.  
  2133.  
  2134. Static void comment(starparen)
  2135. int starparen;    /* 0={ }, 1=(* *), 2=C comments*/
  2136. {
  2137.     register char ch;
  2138.     int nestcount = 1, startlnum = inf_lnum, wasrel = 0, trailing;
  2139.     int i, cmtindent, cmtindent2, saveeat = eatcomments;
  2140.     char *cp;
  2141.  
  2142.     if (!strncmp(inbufptr, embedcomment, strlen(embedcomment)) &&
  2143.     *embedcomment)
  2144.     eatcomments = 0;
  2145.     cp = inbuf;
  2146.     while (isspace(*cp))
  2147.     cp++;
  2148.     trailing = (*cp != '{' && ((*cp != '(' && *cp != '/') || cp[1] != '*'));
  2149.     cmtindent = inbufindent;
  2150.     cmtindent2 = cmtindent + 1 + (starparen != 0);
  2151.     cp = inbufptr;
  2152.     while (isspace(*cp))
  2153.     cmtindent2++, cp++;
  2154.     cp = curtokbuf;
  2155.     for (;;) {
  2156.         ch = *inbufptr++;
  2157.         switch (ch) {
  2158.  
  2159.             case '}':
  2160.                 if ((!starparen || nestedcomments == 0) &&
  2161.             starparen != 2 &&
  2162.                     --nestcount <= 0) {
  2163.                     *cp = 0;
  2164.             if (wasrel && !strcmp(curtokbuf, "\003"))
  2165.             *curtokbuf = '\002';
  2166.             if (!commenting_flag)
  2167.             commentline(trailing ? CMT_TRAIL : CMT_POST);
  2168.             eatcomments = saveeat;
  2169.                     return;
  2170.                 }
  2171.                 break;
  2172.  
  2173.             case '{':
  2174.                 if (nestedcomments == 1 && starparen != 2)
  2175.                     nestcount++;
  2176.                 break;
  2177.  
  2178.             case '*':
  2179.                 if ((*inbufptr == ((starparen == 2) ? '/' : ')') &&
  2180.              (starparen || nestedcomments == 0)) &&
  2181.                     --nestcount <= 0) {
  2182.                     inbufptr++;
  2183.                     *cp = 0;
  2184.             if (wasrel && !strcmp(curtokbuf, "\003"))
  2185.             *curtokbuf = '\002';
  2186.             if (!commenting_flag)
  2187.             commentline(trailing ? CMT_TRAIL : CMT_POST);
  2188.             eatcomments = saveeat;
  2189.                     return;
  2190.                 }
  2191.                 break;
  2192.  
  2193.             case '(':
  2194.                 if (*inbufptr == '*' && nestedcomments == 1 &&
  2195.             starparen != 2) {
  2196.             *cp++ = ch;
  2197.             ch = *inbufptr++;
  2198.                     nestcount++;
  2199.         }
  2200.                 break;
  2201.  
  2202.             case 0:
  2203.                 *cp = 0;
  2204.             if (commenting_flag)
  2205.             saveinputcomment(inbufptr-1);
  2206.         else
  2207.             commentline(CMT_POST);
  2208.         trailing = 0;
  2209.                 getline();
  2210.         i = 0;
  2211.         for (;;) {
  2212.             if (*inbufptr == ' ') {
  2213.             inbufptr++;
  2214.             i++;
  2215.             } else if (*inbufptr == '\t') {
  2216.             inbufptr++;
  2217.             i++;
  2218.             if (intabsize)
  2219.                 i = (i / intabsize + 1) * intabsize;
  2220.             } else
  2221.             break;
  2222.         }
  2223.         cp = curtokbuf;
  2224.         if (*inbufptr) {
  2225.             if (i == cmtindent2 && !starparen)
  2226.             cmtindent--;
  2227.             cmtindent2 = -1;
  2228.             if (i >= cmtindent && i > 0) {
  2229.             *cp++ = '\002';
  2230.             i -= cmtindent;
  2231.             wasrel = 1;
  2232.             } else {
  2233.             *cp++ = '\003';
  2234.             }
  2235.             while (--i >= 0)
  2236.             *cp++ = ' ';
  2237.         } else
  2238.             *cp++ = '\003';
  2239.                 continue;
  2240.  
  2241.             case EOFMARK:
  2242.                 error(format_d("Runaway comment from line %d", startlnum));
  2243.         eatcomments = saveeat;
  2244.                 return;     /* unnecessary */
  2245.  
  2246.         }
  2247.         *cp++ = ch;
  2248.     }
  2249. }
  2250.  
  2251.  
  2252.  
  2253. char *getinlinepart()
  2254. {
  2255.     char *cp, *buf;
  2256.  
  2257.     for (;;) {
  2258.         if (isspace(*inbufptr)) {
  2259.             inbufptr++;
  2260.         } else if (!*inbufptr) {
  2261.             getline();
  2262.         } else if (*inbufptr == '{') {
  2263.             inbufptr++;
  2264.             comment(0);
  2265.         } else if (*inbufptr == '(' && inbufptr[1] == '*') {
  2266.             inbufptr += 2;
  2267.             comment(1);
  2268.         } else
  2269.             break;
  2270.     }
  2271.     cp = inbufptr;
  2272.     while (isspace(*cp) || isalnum(*cp) ||
  2273.            *cp == '_' || *cp == '$' || 
  2274.            *cp == '+' || *cp == '-' ||
  2275.            *cp == '<' || *cp == '>')
  2276.         cp++;
  2277.     if (cp == inbufptr)
  2278.         return "";
  2279.     while (isspace(cp[-1]))
  2280.         cp--;
  2281.     buf = format_s("%s", inbufptr);
  2282.     buf[cp-inbufptr] = 0;     /* truncate the string */
  2283.     inbufptr = cp;
  2284.     return buf;
  2285. }
  2286.  
  2287.  
  2288.  
  2289.  
  2290. Static int getflag()
  2291. {
  2292.     int res = 1;
  2293.  
  2294.     gettok();
  2295.     if (curtok == TOK_IDENT) {
  2296.         res = (strcmp(curtokbuf, "OFF") != 0);
  2297.         gettok();
  2298.     }
  2299.     return res;
  2300. }
  2301.  
  2302.  
  2303.  
  2304.  
  2305. char getchartok()
  2306. {
  2307.     if (!*inbufptr) {
  2308.         warning("Unexpected end of line [236]");
  2309.         return ' ';
  2310.     }
  2311.     if (isspace(*inbufptr)) {
  2312.         warning("Whitespace not allowed here [237]");
  2313.         return ' ';
  2314.     }
  2315.     return *inbufptr++;
  2316. }
  2317.  
  2318.  
  2319.  
  2320. char *getparenstr(buf)
  2321. char *buf;
  2322. {
  2323.     int count = 0;
  2324.     char *cp;
  2325.  
  2326.     if (inbufptr < buf)    /* this will get most bad cases */
  2327.         error("Can't handle a line break here");
  2328.     while (isspace(*buf))
  2329.         buf++;
  2330.     cp = buf;
  2331.     for (;;) {
  2332.         if (!*cp)
  2333.             error("Can't handle a line break here");
  2334.         if (*cp == '(')
  2335.             count++;
  2336.         if (*cp == ')')
  2337.             if (--count < 0)
  2338.                 break;
  2339.         cp++;
  2340.     }
  2341.     inbufptr = cp + 1;
  2342.     while (cp > buf && isspace(cp[-1]))
  2343.         cp--;
  2344.     return format_ds("%.*s", (int)(cp - buf), buf);
  2345. }
  2346.  
  2347.  
  2348.  
  2349. void leadingcomments()
  2350. {
  2351.     for (;;) {
  2352.         switch (*inbufptr++) {
  2353.  
  2354.             case 0:
  2355.                 getline();
  2356.                 break;
  2357.  
  2358.             case ' ':
  2359.             case '\t':
  2360.             case 26:
  2361.                 /* ignore whitespace */
  2362.                 break;
  2363.  
  2364.             case '{':
  2365.                 if (!parsecomment(1, 0)) {
  2366.                     inbufptr--;
  2367.                     return;
  2368.                 }
  2369.                 break;
  2370.  
  2371.         case '(':
  2372.         if (*inbufptr == '*') {
  2373.             inbufptr++;
  2374.             if (!parsecomment(1, 1)) {
  2375.             inbufptr -= 2;
  2376.             return;
  2377.             }
  2378.             break;
  2379.         }
  2380.         /* fall through */
  2381.  
  2382.             default:
  2383.                 inbufptr--;
  2384.                 return;
  2385.  
  2386.         }
  2387.     }
  2388. }
  2389.  
  2390.  
  2391.  
  2392.  
  2393. void get_C_string(term)
  2394. int term;
  2395. {
  2396.     char *cp = curtokbuf;
  2397.     char ch;
  2398.     int i;
  2399.  
  2400.     while ((ch = *inbufptr++)) {
  2401.         if (ch == term) {
  2402.             *cp = 0;
  2403.             curtokint = cp - curtokbuf;
  2404.             return;
  2405.         } else if (ch == '\\') {
  2406.             if (isdigit(*inbufptr)) {
  2407.                 i = (*inbufptr++) - '0';
  2408.                 if (isdigit(*inbufptr))
  2409.                     i = i*8 + (*inbufptr++) - '0';
  2410.                 if (isdigit(*inbufptr))
  2411.                     i = i*8 + (*inbufptr++) - '0';
  2412.                 *cp++ = i;
  2413.             } else {
  2414.                 ch = *inbufptr++;
  2415.                 switch (tolower(ch)) {
  2416.                     case 'n':
  2417.                         *cp++ = '\n';
  2418.                         break;
  2419.                     case 't':
  2420.                         *cp++ = '\t';
  2421.                         break;
  2422.                     case 'v':
  2423.                         *cp++ = '\v';
  2424.                         break;
  2425.                     case 'b':
  2426.                         *cp++ = '\b';
  2427.                         break;
  2428.                     case 'r':
  2429.                         *cp++ = '\r';
  2430.                         break;
  2431.                     case 'f':
  2432.                         *cp++ = '\f';
  2433.                         break;
  2434.                     case '\\':
  2435.                         *cp++ = '\\';
  2436.                         break;
  2437.                     case '\'':
  2438.                         *cp++ = '\'';
  2439.                         break;
  2440.                     case '"':
  2441.                         *cp++ = '"';
  2442.                         break;
  2443.                     case 'x':
  2444.                         if (isxdigit(*inbufptr)) {
  2445.                             if (isdigit(*inbufptr))
  2446.                                 i = (*inbufptr++) - '0';
  2447.                             else
  2448.                                 i = (toupper(*inbufptr++)) - 'A' + 10;
  2449.                             if (isdigit(*inbufptr))
  2450.                                 i = i*16 + (*inbufptr++) - '0';
  2451.                             else if (isxdigit(*inbufptr))
  2452.                                 i = i*16 + (toupper(*inbufptr++)) - 'A' + 10;
  2453.                             *cp++ = i;
  2454.                             break;
  2455.                         }
  2456.                         /* fall through */
  2457.                     default:
  2458.                         warning("Strange character in C string [238]");
  2459.                 }
  2460.             }
  2461.         } else
  2462.             *cp++ = ch;
  2463.     }
  2464.     *cp = 0;
  2465.     curtokint = cp - curtokbuf;
  2466.     warning("Unterminated C string [239]");
  2467. }
  2468.  
  2469.  
  2470.  
  2471.  
  2472.  
  2473. void begincommenting(cp)
  2474. char *cp;
  2475. {
  2476.     if (!commenting_flag) {
  2477.     commenting_ptr = cp;
  2478.     }
  2479.     commenting_flag++;
  2480. }
  2481.  
  2482.  
  2483. void saveinputcomment(cp)
  2484. char *cp;
  2485. {
  2486.     if (commenting_ptr)
  2487.     sprintf(curtokbuf, "%.*s", (int)(cp - commenting_ptr), commenting_ptr);
  2488.     else
  2489.     sprintf(curtokbuf, "\003%.*s", (int)(cp - inbuf), inbuf);
  2490.     commentline(CMT_POST);
  2491.     commenting_ptr = NULL;
  2492. }
  2493.  
  2494.  
  2495. void endcommenting(cp)
  2496. char *cp;
  2497. {
  2498.     commenting_flag--;
  2499.     if (!commenting_flag) {
  2500.     saveinputcomment(cp);
  2501.     }
  2502. }
  2503.  
  2504.  
  2505.  
  2506.  
  2507. int peeknextchar()
  2508. {
  2509.     char *cp;
  2510.  
  2511.     cp = inbufptr;
  2512.     while (isspace(*cp))
  2513.     cp++;
  2514.     return *cp;
  2515. }
  2516.  
  2517.  
  2518.  
  2519.  
  2520. #ifdef LEXDEBUG
  2521. Static void zgettok();
  2522. void gettok()
  2523. {
  2524.     zgettok();
  2525.     if (tokentrace) {
  2526.         printf("gettok() found %s", tok_name(curtok));
  2527.         switch (curtok) {
  2528.             case TOK_HEXLIT:
  2529.             case TOK_OCTLIT:
  2530.             case TOK_INTLIT:
  2531.             case TOK_MININT:
  2532.                 printf(", curtokint = %d", curtokint);
  2533.                 break;
  2534.             case TOK_REALLIT:
  2535.             case TOK_STRLIT:
  2536.                 printf(", curtokbuf = %s", makeCstring(curtokbuf, curtokint));
  2537.                 break;
  2538.         default:
  2539.         break;
  2540.         }
  2541.         putchar('\n');
  2542.     }
  2543. }
  2544. Static void zgettok()
  2545. #else
  2546. void gettok()
  2547. #endif
  2548. {
  2549.     register char ch;
  2550.     register char *cp;
  2551.     char ch2;
  2552.     char *startcp;
  2553.     int i;
  2554.  
  2555.     debughook();
  2556.     for (;;) {
  2557.         switch ((ch = *inbufptr++)) {
  2558.  
  2559.             case 0:
  2560.             if (commenting_flag)
  2561.             saveinputcomment(inbufptr-1);
  2562.                 getline();
  2563.         cp = curtokbuf;
  2564.         for (;;) {
  2565.             inbufindent = 0;
  2566.             for (;;) {
  2567.             if (*inbufptr == '\t') {
  2568.                 inbufindent++;
  2569.                 if (intabsize)
  2570.                 inbufindent = (inbufindent / intabsize + 1) * intabsize;
  2571.             } else if (*inbufptr == ' ')
  2572.                 inbufindent++;
  2573.             else if (*inbufptr != 26)
  2574.                 break;
  2575.             inbufptr++;
  2576.             }
  2577.             if (!*inbufptr && !commenting_flag) {   /* blank line */
  2578.             *cp++ = '\001';
  2579.             getline();
  2580.             } else
  2581.             break;
  2582.         }
  2583.         if (cp > curtokbuf) {
  2584.             *cp = 0;
  2585.             commentline(CMT_POST);
  2586.         }
  2587.                 break;
  2588.  
  2589.             case '\t':
  2590.             case ' ':
  2591.             case 26:    /* ignore ^Z's in Turbo files */
  2592.                 while (*inbufptr++ == ch) ;
  2593.                 inbufptr--;
  2594.                 break;
  2595.  
  2596.             case '$':
  2597.         if (dollar_idents)
  2598.             goto ident;
  2599.                 if (dollar_flag) {
  2600.                     dollar_flag = 0;
  2601.                     curtok = TOK_DOLLAR;
  2602.                     return;
  2603.         }
  2604.         startcp = inbufptr-1;
  2605.         while (isspace(*inbufptr))
  2606.             inbufptr++;
  2607.         cp = inbufptr;
  2608.         while (isxdigit(*cp))
  2609.             cp++;
  2610.         if (cp > inbufptr && cp <= inbufptr+8 && !isalnum(*cp)) {
  2611.             while (isspace(*cp))
  2612.             cp++;
  2613.             if (!isdigit(*cp) && *cp != '\'') {
  2614.             cp = curtokbuf;    /* Turbo hex constant */
  2615.             while (isxdigit(*inbufptr))
  2616.                 *cp++ = *inbufptr++;
  2617.             *cp = 0;
  2618.             curtok = TOK_HEXLIT;
  2619.             curtokint = my_strtol(curtokbuf, NULL, 16);
  2620.             return;
  2621.             }
  2622.                 }
  2623.         dollar_flag++;     /* HP Pascal compiler directive */
  2624.         do {
  2625.             gettok();
  2626.             if (curtok == TOK_IF) {             /* $IF expr$ */
  2627.             Expr *ex;
  2628.             Value val;
  2629.             if (!skipping_module) {
  2630.                 if (!setup_complete)
  2631.                 error("$IF$ not allowed at top of program");
  2632.  
  2633.                 /* Even though HP Pascal doesn't let these nest,
  2634.                    there's no harm in supporting it. */
  2635.                 if (if_flag) {
  2636.                 skiptotoken(TOK_DOLLAR);
  2637.                 if_flag++;
  2638.                 break;
  2639.                 }
  2640.                 gettok();
  2641.                 ex = p_expr(tp_boolean);
  2642.                 val = eval_expr_consts(ex);
  2643.                 freeexpr(ex);
  2644.                 i = (val.type == tp_boolean && val.i);
  2645.                 free_value(&val);
  2646.                 if (!i) {
  2647.                 if (curtok != TOK_DOLLAR) {
  2648.                     warning("Syntax error in $IF$ expression [240]");
  2649.                     skiptotoken(TOK_DOLLAR);
  2650.                 }
  2651.                 begincommenting(startcp);
  2652.                 if_flag++;
  2653.                 while (if_flag > 0)
  2654.                     gettok();
  2655.                 endcommenting(inbufptr);
  2656.                 }
  2657.             } else {
  2658.                 skiptotoken(TOK_DOLLAR);
  2659.             }
  2660.             } else if (curtok == TOK_END) {     /* $END$ */
  2661.             if (if_flag) {
  2662.                 gettok();
  2663.                 if (!wexpecttok(TOK_DOLLAR))
  2664.                 skiptotoken(TOK_DOLLAR);
  2665.                 curtok = TOK_ENDIF;
  2666.                 if_flag--;
  2667.                 return;
  2668.             } else {
  2669.                 gettok();
  2670.                 if (!wexpecttok(TOK_DOLLAR))
  2671.                 skiptotoken(TOK_DOLLAR);
  2672.             }
  2673.             } else if (curtok == TOK_IDENT) {
  2674.             if (!strcmp(curtokbuf, "INCLUDE") &&
  2675.                  !if_flag && !skipping_module) {
  2676.                 char *fn;
  2677.                 gettok();
  2678.                 if (curtok == TOK_IDENT) {
  2679.                 fn = stralloc(curtokcase);
  2680.                 gettok();
  2681.                 } else if (wexpecttok(TOK_STRLIT)) {
  2682.                 fn = stralloc(curtokbuf);
  2683.                 gettok();
  2684.                 } else
  2685.                 fn = "";
  2686.                 if (!wexpecttok(TOK_DOLLAR)) {
  2687.                 skiptotoken(TOK_DOLLAR);
  2688.                 } else {
  2689.                 if (handle_include(fn))
  2690.                     return;
  2691.                 }
  2692.             } else if (ignore_directives ||
  2693.                    if_flag ||
  2694.                    !strcmp(curtokbuf, "SEARCH") ||
  2695.                    !strcmp(curtokbuf, "REF") ||
  2696.                    !strcmp(curtokbuf, "DEF")) {
  2697.                 skiptotoken(TOK_DOLLAR);
  2698.             } else if (!strcmp(curtokbuf, "SWITCH_STRPOS")) {
  2699.                 switch_strpos = getflag();
  2700.             } else if (!strcmp(curtokbuf, "SYSPROG")) {
  2701.                 if (getflag())
  2702.                 sysprog_flag |= 1;
  2703.                 else
  2704.                 sysprog_flag &= ~1;
  2705.             } else if (!strcmp(curtokbuf, "MODCAL")) {
  2706.                 if (getflag())
  2707.                 sysprog_flag |= 2;
  2708.                 else
  2709.                 sysprog_flag &= ~2;
  2710.             } else if (!strcmp(curtokbuf, "PARTIAL_EVAL")) {
  2711.                 if (shortcircuit < 0)
  2712.                 partial_eval_flag = getflag();
  2713.             } else if (!strcmp(curtokbuf, "IOCHECK")) {
  2714.                 iocheck_flag = getflag();
  2715.             } else if (!strcmp(curtokbuf, "RANGE")) {
  2716.                 if (getflag()) {
  2717.                 if (!range_flag)
  2718.                     note("Range checking is ON [216]");
  2719.                 range_flag = 1;
  2720.                 } else {
  2721.                 if (range_flag)
  2722.                     note("Range checking is OFF [216]");
  2723.                 range_flag = 0;
  2724.                 }
  2725.             } else if (!strcmp(curtokbuf, "OVFLCHECK")) {
  2726.                 if (getflag()) {
  2727.                 if (!ovflcheck_flag)
  2728.                     note("Overflow checking is ON [219]");
  2729.                 ovflcheck_flag = 1;
  2730.                 } else {
  2731.                 if (ovflcheck_flag)
  2732.                     note("Overflow checking is OFF [219]");
  2733.                 ovflcheck_flag = 0;
  2734.                 }
  2735.             } else if (!strcmp(curtokbuf, "STACKCHECK")) {
  2736.                 if (getflag()) {
  2737.                 if (!stackcheck_flag)
  2738.                     note("Stack checking is ON [217]");
  2739.                 stackcheck_flag = 1;
  2740.                 } else {
  2741.                 if (stackcheck_flag)
  2742.                     note("Stack checking is OFF [217]");
  2743.                 stackcheck_flag = 0;
  2744.                 }
  2745.             }
  2746.             skiptotoken2(TOK_DOLLAR, TOK_COMMA);
  2747.             } else {
  2748.             warning("Mismatched '$' signs [241]");
  2749.             dollar_flag = 0;    /* got out of sync */
  2750.             return;
  2751.             }
  2752.         } while (curtok == TOK_COMMA);
  2753.                 break;
  2754.  
  2755.             case '"':
  2756.         if (C_lex) {
  2757.             get_C_string(ch);
  2758.             curtok = TOK_STRLIT;
  2759.             return;
  2760.         }
  2761.         goto stringLiteral;
  2762.  
  2763.             case '#':
  2764.         if (modula2) {
  2765.             curtok = TOK_NE;
  2766.             return;
  2767.         }
  2768.         cp = inbufptr;
  2769.         while (isspace(*cp)) cp++;
  2770.         if (!strcincmp(cp, "INCLUDE", 7)) {
  2771.             char *cp2, *cp3;
  2772.             cp += 7;
  2773.             while (isspace(*cp)) cp++;
  2774.             cp2 = cp + strlen(cp) - 1;
  2775.             while (isspace(*cp2)) cp2--;
  2776.             if ((*cp == '"' && *cp2 == '"' && cp2 > cp) ||
  2777.             (*cp == '<' && *cp2 == '>')) {
  2778.             inbufptr = cp2 + 1;
  2779.             cp3 = stralloc(cp + 1);
  2780.             cp3[cp2 - cp - 1] = 0;
  2781.             if (handle_include(cp3))
  2782.                 return;
  2783.             else
  2784.                 break;
  2785.             }
  2786.         }
  2787.         /* fall through */
  2788.  
  2789.             case '\'':
  2790.                 if (C_lex && ch == '\'') {
  2791.                     get_C_string(ch);
  2792.                     if (curtokint != 1)
  2793.                         warning("Character constant has length != 1 [242]");
  2794.                     curtokint = *curtokbuf;
  2795.                     curtok = TOK_CHARLIT;
  2796.                     return;
  2797.                 }
  2798.           stringLiteral:
  2799.                 cp = curtokbuf;
  2800.         ch2 = (ch == '"') ? '"' : '\'';
  2801.                 do {
  2802.                     if (ch == ch2) {
  2803.                         while ((ch = *inbufptr++) != '\n' &&
  2804.                                ch != EOF) {
  2805.                             if (ch == ch2) {
  2806.                                 if (*inbufptr != ch2 || modula2)
  2807.                                     break;
  2808.                                 else
  2809.                                     inbufptr++;
  2810.                             }
  2811.                             *cp++ = ch;
  2812.                         }
  2813.                         if (ch != ch2)
  2814.                             warning("Error in string literal [243]");
  2815.                     } else {
  2816.                         ch = *inbufptr++;
  2817.                         if (isdigit(ch)) {
  2818.                             i = 0;
  2819.                             while (isdigit(ch)) {
  2820.                                 i = i*10 + ch - '0';
  2821.                                 ch = *inbufptr++;
  2822.                             }
  2823.                             inbufptr--;
  2824.                             *cp++ = i;
  2825.                         } else {
  2826.                             *cp++ = ch & 0x1f;
  2827.                         }
  2828.                     }
  2829.                     while (*inbufptr == ' ' || *inbufptr == '\t')
  2830.                         inbufptr++;
  2831.                 } while ((ch = *inbufptr++) == ch2 || ch == '#');
  2832.                 inbufptr--;
  2833.                 *cp = 0;
  2834.                 curtokint = cp - curtokbuf;
  2835.                 curtok = TOK_STRLIT;
  2836.                 return;
  2837.  
  2838.             case '(':
  2839.                 if (*inbufptr == '*' && !C_lex) {
  2840.                     inbufptr++;
  2841.             switch (commenting_flag ? 0 : parsecomment(0, 1)) {
  2842.                 case 0:
  2843.                             comment(1);
  2844.                 break;
  2845.                 case 2:
  2846.                 return;
  2847.             }
  2848.                     break;
  2849.                 } else if (*inbufptr == '.') {
  2850.                     curtok = TOK_LBR;
  2851.                     inbufptr++;
  2852.                 } else {
  2853.                     curtok = TOK_LPAR;
  2854.                 }
  2855.                 return;
  2856.  
  2857.             case '{':
  2858.                 if (C_lex || modula2) {
  2859.                     curtok = TOK_LBRACE;
  2860.                     return;
  2861.                 }
  2862.                 switch (commenting_flag ? 0 : parsecomment(0, 0)) {
  2863.                     case 0:
  2864.                         comment(0);
  2865.                         break;
  2866.                     case 2:
  2867.                         return;
  2868.                 }
  2869.                 break;
  2870.  
  2871.             case '}':
  2872.                 if (C_lex || modula2) {
  2873.                     curtok = TOK_RBRACE;
  2874.                     return;
  2875.                 }
  2876.         if (skipflag > 0) {
  2877.             skipflag = 0;
  2878.         } else
  2879.             warning("Unmatched '}' in input file [244]");
  2880.                 break;
  2881.  
  2882.             case ')':
  2883.                 curtok = TOK_RPAR;
  2884.                 return;
  2885.  
  2886.             case '*':
  2887.         if (*inbufptr == (C_lex ? '/' : ')')) {
  2888.             inbufptr++;
  2889.             if (skipflag > 0) {
  2890.             skipflag = 0;
  2891.             } else
  2892.             warning("Unmatched '*)' in input file [245]");
  2893.             break;
  2894.         } else if (*inbufptr == '*' && !C_lex) {
  2895.             curtok = TOK_STARSTAR;
  2896.             inbufptr++;
  2897.         } else
  2898.             curtok = TOK_STAR;
  2899.                 return;
  2900.  
  2901.             case '+':
  2902.                 if (C_lex && *inbufptr == '+') {
  2903.                     curtok = TOK_PLPL;
  2904.                     inbufptr++;
  2905.                 } else
  2906.                     curtok = TOK_PLUS;
  2907.                 return;
  2908.  
  2909.             case ',':
  2910.                 curtok = TOK_COMMA;
  2911.                 return;
  2912.  
  2913.             case '-':
  2914.                 if (C_lex && *inbufptr == '-') {
  2915.                     curtok = TOK_MIMI;
  2916.                     inbufptr++;
  2917.                 } else if (*inbufptr == '>') {
  2918.                     curtok = TOK_ARROW;
  2919.                     inbufptr++;
  2920.                 } else
  2921.                     curtok = TOK_MINUS;
  2922.                 return;
  2923.  
  2924.             case '.':
  2925.                 if (*inbufptr == '.') {
  2926.                     curtok = TOK_DOTS;
  2927.                     inbufptr++;
  2928.                 } else if (*inbufptr == ')') {
  2929.                     curtok = TOK_RBR;
  2930.                     inbufptr++;
  2931.                 } else
  2932.                     curtok = TOK_DOT;
  2933.                 return;
  2934.  
  2935.             case '/':
  2936.         if (C_lex && *inbufptr == '*') {
  2937.             inbufptr++;
  2938.             comment(2);
  2939.             break;
  2940.         }
  2941.                 curtok = TOK_SLASH;
  2942.                 return;
  2943.  
  2944.             case ':':
  2945.                 if (*inbufptr == '=') {
  2946.                     curtok = TOK_ASSIGN;
  2947.                     inbufptr++;
  2948.         } else if (*inbufptr == ':') {
  2949.                     curtok = TOK_COLONCOLON;
  2950.                     inbufptr++;
  2951.                 } else
  2952.                     curtok = TOK_COLON;
  2953.                 return;
  2954.  
  2955.             case ';':
  2956.                 curtok = TOK_SEMI;
  2957.                 return;
  2958.  
  2959.             case '<':
  2960.                 if (*inbufptr == '=') {
  2961.                     curtok = TOK_LE;
  2962.                     inbufptr++;
  2963.                 } else if (*inbufptr == '>') {
  2964.                     curtok = TOK_NE;
  2965.                     inbufptr++;
  2966.                 } else if (*inbufptr == '<') {
  2967.                     curtok = TOK_LTLT;
  2968.                     inbufptr++;
  2969.                 } else
  2970.                     curtok = TOK_LT;
  2971.                 return;
  2972.  
  2973.             case '>':
  2974.                 if (*inbufptr == '=') {
  2975.                     curtok = TOK_GE;
  2976.                     inbufptr++;
  2977.                 } else if (*inbufptr == '>') {
  2978.                     curtok = TOK_GTGT;
  2979.                     inbufptr++;
  2980.                 } else
  2981.                     curtok = TOK_GT;
  2982.                 return;
  2983.  
  2984.             case '=':
  2985.         if (*inbufptr == '=') {
  2986.             curtok = TOK_EQEQ;
  2987.             inbufptr++;
  2988.         } else
  2989.             curtok = TOK_EQ;
  2990.                 return;
  2991.  
  2992.             case '[':
  2993.                 curtok = TOK_LBR;
  2994.                 return;
  2995.  
  2996.             case ']':
  2997.                 curtok = TOK_RBR;
  2998.                 return;
  2999.  
  3000.             case '^':
  3001.                 curtok = TOK_HAT;
  3002.                 return;
  3003.  
  3004.             case '&':
  3005.                 if (*inbufptr == '&') {
  3006.                     curtok = TOK_ANDAND;
  3007.                     inbufptr++;
  3008.                 } else
  3009.                     curtok = TOK_AMP;
  3010.                 return;
  3011.  
  3012.             case '|':
  3013.                 if (*inbufptr == '|') {
  3014.                     curtok = TOK_OROR;
  3015.                     inbufptr++;
  3016.                 } else
  3017.                     curtok = TOK_VBAR;
  3018.                 return;
  3019.  
  3020.             case '~':
  3021.                 curtok = TOK_TWIDDLE;
  3022.                 return;
  3023.  
  3024.             case '!':
  3025.                 if (*inbufptr == '=') {
  3026.                     curtok = TOK_BANGEQ;
  3027.                     inbufptr++;
  3028.                 } else
  3029.                     curtok = TOK_BANG;
  3030.                 return;
  3031.  
  3032.             case '%':
  3033.         if (C_lex) {
  3034.             curtok = TOK_PERC;
  3035.             return;
  3036.         }
  3037.         goto ident;
  3038.  
  3039.             case '?':
  3040.                 curtok = TOK_QM;
  3041.                 return;
  3042.  
  3043.             case '@':
  3044.         curtok = TOK_ADDR;
  3045.                 return;
  3046.  
  3047.             case EOFMARK:
  3048.                 if (curtok == TOK_EOF) {
  3049.                     if (inputkind == INP_STRLIST)
  3050.                         error("Unexpected end of macro");
  3051.                     else
  3052.                         error("Unexpected end of file");
  3053.                 }
  3054.                 curtok = TOK_EOF;
  3055.                 return;
  3056.  
  3057.             default:
  3058.                 if (isdigit(ch)) {
  3059.             cp = inbufptr;
  3060.             while (isxdigit(*cp))
  3061.             cp++;
  3062.             if (*cp == '#' && isxdigit(cp[1])) {
  3063.             i = atoi(inbufptr-1);
  3064.             inbufptr = cp+1;
  3065.             } else if (toupper(cp[-1]) == 'B' ||
  3066.                    toupper(cp[-1]) == 'C') {
  3067.                         inbufptr--;
  3068.             i = 8;
  3069.             } else if (toupper(*cp) == 'H') {
  3070.                         inbufptr--;
  3071.             i = 16;
  3072.             } else if ((ch == '0' && toupper(*inbufptr) == 'X' &&
  3073.                 isxdigit(inbufptr[1]))) {
  3074.             inbufptr++;
  3075.             i = 16;
  3076.             } else {
  3077.             i = 10;
  3078.             }
  3079.             if (i != 10) {
  3080.                         curtokint = 0;
  3081.                         while (isdigit(*inbufptr) ||
  3082.                    (i > 10 && isxdigit(*inbufptr))) {
  3083.                             ch = toupper(*inbufptr++);
  3084.                             curtokint *= i;
  3085.                             if (ch <= '9')
  3086.                                 curtokint += ch - '0';
  3087.                             else
  3088.                                 curtokint += ch - 'A' + 10;
  3089.                         }
  3090.                         sprintf(curtokbuf, "%ld", curtokint);
  3091.             if ((toupper(*inbufptr) == 'B' && i == 8) ||
  3092.                 (toupper(*inbufptr) == 'H' && i == 16))
  3093.                 inbufptr++;
  3094.             if (toupper(*inbufptr) == 'C' && i == 8) {
  3095.                 inbufptr++;
  3096.                 curtok = TOK_STRLIT;
  3097.                 curtokbuf[0] = curtokint;
  3098.                 curtokbuf[1] = 0;
  3099.                 curtokint = 1;
  3100.                 return;
  3101.             }
  3102.                         if (toupper(*inbufptr) == 'L') {
  3103.                             strcat(curtokbuf, "L");
  3104.                             inbufptr++;
  3105.                         }
  3106.                         curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
  3107.                         return;
  3108.                     }
  3109.                     cp = curtokbuf;
  3110.                     i = 0;
  3111.                     while (ch == '0')
  3112.                         ch = *inbufptr++;
  3113.                     if (isdigit(ch)) {
  3114.                         while (isdigit(ch)) {
  3115.                             *cp++ = ch;
  3116.                             ch = *inbufptr++;
  3117.                         }
  3118.                     } else
  3119.                         *cp++ = '0';
  3120.                     if (ch == '.') {
  3121.                         if (isdigit(*inbufptr)) {
  3122.                             *cp++ = ch;
  3123.                             ch = *inbufptr++;
  3124.                             i = 1;
  3125.                             while (isdigit(ch)) {
  3126.                                 *cp++ = ch;
  3127.                                 ch = *inbufptr++;
  3128.                             }
  3129.                         }
  3130.                     }
  3131.                     if (ch == 'e' || ch == 'E' ||
  3132.             ch == 'd' || ch == 'D' ||
  3133.             ch == 'q' || ch == 'Q') {
  3134.                         ch = *inbufptr;
  3135.                         if (isdigit(ch) || ch == '+' || ch == '-') {
  3136.                             *cp++ = 'e';
  3137.                             inbufptr++;
  3138.                             i = 1;
  3139.                             do {
  3140.                                 *cp++ = ch;
  3141.                                 ch = *inbufptr++;
  3142.                             } while (isdigit(ch));
  3143.                         }
  3144.                     }
  3145.                     inbufptr--;
  3146.                     *cp = 0;
  3147.                     if (i) {
  3148.                         curtok = TOK_REALLIT;
  3149.                         curtokint = cp - curtokbuf;
  3150.                     } else {
  3151.                         if (cp >= curtokbuf+10) {
  3152.                             i = strcmp(curtokbuf, "2147483648");
  3153.                             if (cp > curtokbuf+10 || i > 0) {
  3154.                 curtok = TOK_REALLIT;
  3155.                 curtokint = cp - curtokbuf + 2;
  3156.                 strcat(curtokbuf, ".0");
  3157.                 return;
  3158.                 }
  3159.                             if (i == 0) {
  3160.                                 curtok = TOK_MININT;
  3161.                                 curtokint = -2147483648;
  3162.                                 return;
  3163.                             }
  3164.                         }
  3165.                         curtok = TOK_INTLIT;
  3166.                         curtokint = atol(curtokbuf);
  3167.                         if (toupper(*inbufptr) == 'L') {
  3168.                             strcat(curtokbuf, "L");
  3169.                             inbufptr++;
  3170.                         }
  3171.                     }
  3172.                     return;
  3173.                 } else if (isalpha(ch) || ch == '_') {
  3174. ident:
  3175.                     {
  3176.                         register char *cp2;
  3177.                         curtoksym = NULL;
  3178.                         cp = curtokbuf;
  3179.                         cp2 = curtokcase;
  3180.             *cp2++ = symcase ? ch : tolower(ch);
  3181.             *cp++ = pascalcasesens ? ch : toupper(ch);
  3182.             while (isalnum((ch = *inbufptr++)) ||
  3183.                    ch == '_' ||
  3184.                    (ch == '%' && !C_lex) ||
  3185.                    (ch == '$' && dollar_idents)) {
  3186.                 *cp2++ = symcase ? ch : tolower(ch);
  3187.                 if (!ignorenonalpha || isalnum(ch))
  3188.                 *cp++ = pascalcasesens ? ch : toupper(ch);
  3189.             }
  3190.                         inbufptr--;
  3191.                         *cp2 = 0;
  3192.                         *cp = 0;
  3193.             if (pascalsignif > 0)
  3194.                 curtokbuf[pascalsignif] = 0;
  3195.                     }
  3196.             if (*curtokbuf == '%') {
  3197.             if (!strcicmp(curtokbuf, "%INCLUDE")) {
  3198.                 char *cp2 = inbufptr;
  3199.                 while (isspace(*cp2)) cp2++;
  3200.                 if (*cp2 == '\'')
  3201.                 cp2++;
  3202.                 cp = curtokbuf;
  3203.                 while (*cp2 && *cp2 != '\'' &&
  3204.                    *cp2 != ';' && !isspace(*cp2)) {
  3205.                 *cp++ = *cp2++;
  3206.                 }
  3207.                 *cp = 0;
  3208.                 cp = my_strrchr(curtokbuf, '/');
  3209.                 if (cp && (!strcicmp(cp, "/LIST") ||
  3210.                        !strcicmp(cp, "/NOLIST")))
  3211.                 *cp = 0;
  3212.                 if (*cp2 == '\'')
  3213.                 cp2++;
  3214.                 while (isspace(*cp2)) cp2++;
  3215.                 if (*cp2 == ';')
  3216.                 cp2++;
  3217.                 while (isspace(*cp2)) cp2++;
  3218.                 if (!*cp2) {
  3219.                 inbufptr = cp2;
  3220.                 (void) handle_include(stralloc(curtokbuf));
  3221.                 return;
  3222.                 }
  3223.             } else if (!strcicmp(curtokbuf, "%TITLE") ||
  3224.                    !strcicmp(curtokbuf, "%SUBTITLE")) {
  3225.                 gettok();   /* string literal */
  3226.                 break;
  3227.             } else if (!strcicmp(curtokbuf, "%PAGE")) {
  3228.                 /* should store a special page-break comment? */
  3229.                 break;   /* ignore token */
  3230.             } else if ((i = 2, !strcicmp(curtokbuf, "%B")) ||
  3231.                    (i = 8, !strcicmp(curtokbuf, "%O")) ||
  3232.                    (i = 16, !strcicmp(curtokbuf, "%X"))) {
  3233.                 while (isspace(*inbufptr)) inbufptr++;
  3234.                 if (*inbufptr == '\'') {
  3235.                 inbufptr++;
  3236.                 curtokint = 0;
  3237.                 while (*inbufptr && *inbufptr != '\'') {
  3238.                     ch = toupper(*inbufptr++);
  3239.                     if (isxdigit(ch)) {
  3240.                     curtokint *= i;
  3241.                     if (ch <= '9')
  3242.                         curtokint += ch - '0';
  3243.                     else
  3244.                         curtokint += ch - 'A' + 10;
  3245.                     } else if (!isspace(ch))
  3246.                     warning("Bad digit in literal [246]");
  3247.                 }
  3248.                 if (*inbufptr)
  3249.                     inbufptr++;
  3250.                 sprintf(curtokbuf, "%ld", curtokint);
  3251.                 curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
  3252.                 return;
  3253.                 }
  3254.                         }
  3255.             }
  3256.                     {
  3257.                         register unsigned int hash;
  3258.                         register Symbol *sp;
  3259.  
  3260.                         hash = 0;
  3261.                         for (cp = curtokbuf; *cp; cp++)
  3262.                             hash = hash*3 + *cp;
  3263.                         sp = symtab[hash % SYMHASHSIZE];
  3264.                         while (sp && (i = strcmp(sp->name, curtokbuf)) != 0) {
  3265.                             if (i < 0)
  3266.                                 sp = sp->left;
  3267.                             else
  3268.                                 sp = sp->right;
  3269.                         }
  3270.                         if (!sp)
  3271.                             sp = findsymbol(curtokbuf);
  3272.             if (sp->flags & SSYNONYM) {
  3273.                 i = 100;
  3274.                 while (--i > 0 && sp && (sp->flags & SSYNONYM)) {
  3275.                 Strlist *sl;
  3276.                 sl = strlist_find(sp->symbolnames, "===");
  3277.                 if (sl)
  3278.                     sp = (Symbol *)sl->value;
  3279.                 else
  3280.                     sp = NULL;
  3281.                 }
  3282.                 if (!sp)
  3283.                 break;    /* ignore token */
  3284.             }
  3285.             if (sp->kwtok && !(sp->flags & KWPOSS) &&
  3286.                 (pascalcasesens != 2 || !islower(*curtokbuf)) &&
  3287.                 (pascalcasesens != 3 || !isupper(*curtokbuf))) {
  3288.                 curtok = sp->kwtok;
  3289.                 return;
  3290.             }
  3291.             curtok = TOK_IDENT;
  3292.                         curtoksym = sp;
  3293.                         if ((i = withlevel) != 0 && sp->fbase) {
  3294.                             while (--i >= 0) {
  3295.                                 curtokmeaning = sp->fbase;
  3296.                                 while (curtokmeaning) {
  3297.                                     if (curtokmeaning->rectype == withlist[i]) {
  3298.                                         curtokint = i;
  3299.                                         return;
  3300.                                     }
  3301.                                     curtokmeaning = curtokmeaning->snext;
  3302.                                 }
  3303.                             }
  3304.                         }
  3305.                         curtokmeaning = sp->mbase;
  3306.                         while (curtokmeaning && !curtokmeaning->isactive)
  3307.                             curtokmeaning = curtokmeaning->snext;
  3308.             if (!curtokmeaning)
  3309.                 return;
  3310.             while (curtokmeaning->kind == MK_SYNONYM)
  3311.                 curtokmeaning = curtokmeaning->xnext;
  3312.             /* look for unit.ident notation */
  3313.                         if (curtokmeaning->kind == MK_MODULE ||
  3314.                 curtokmeaning->kind == MK_FUNCTION) {
  3315.                             for (cp = inbufptr; isspace(*cp); cp++) ;
  3316.                             if (*cp == '.') {
  3317.                                 for (cp++; isspace(*cp); cp++) ;
  3318.                                 if (isalpha(*cp)) {
  3319.                                     Meaning *mp = curtokmeaning;
  3320.                                     Symbol *sym = curtoksym;
  3321.                                     char *saveinbufptr = inbufptr;
  3322.                                     gettok();
  3323.                                     if (curtok == TOK_DOT)
  3324.                     gettok();
  3325.                     else
  3326.                     curtok = TOK_END;
  3327.                                     if (curtok == TOK_IDENT) {
  3328.                     curtokmeaning = curtoksym->mbase;
  3329.                     while (curtokmeaning &&
  3330.                            curtokmeaning->ctx != mp)
  3331.                         curtokmeaning = curtokmeaning->snext;
  3332.                     if (!curtokmeaning &&
  3333.                         !strcmp(sym->name, "SYSTEM")) {
  3334.                         curtokmeaning = curtoksym->mbase;
  3335.                         while (curtokmeaning &&
  3336.                            curtokmeaning->ctx != nullctx)
  3337.                         curtokmeaning = curtokmeaning->snext;
  3338.                     }
  3339.                     } else
  3340.                     curtokmeaning = NULL;
  3341.                                     if (!curtokmeaning) {
  3342.                                         /* oops, was probably funcname.field */
  3343.                                         inbufptr = saveinbufptr;
  3344.                                         curtokmeaning = mp;
  3345.                                         curtoksym = sym;
  3346.                                     }
  3347.                                 }
  3348.                             }
  3349.                         }
  3350.                         return;
  3351.                     }
  3352.                 } else {
  3353.                     warning(format_d("Unrecognized character 0%o in file [247]",
  3354.                      ch));
  3355.                 }
  3356.         }
  3357.     }
  3358. }
  3359.  
  3360.  
  3361.  
  3362. void checkkeyword(tok)
  3363. Token tok;
  3364. {
  3365.     if (curtok == TOK_IDENT &&
  3366.     curtoksym->kwtok == tok) {
  3367.     curtoksym->flags &= ~KWPOSS;
  3368.     curtok = tok;
  3369.     }
  3370. }
  3371.  
  3372.  
  3373. void checkmodulewords()
  3374. {
  3375.     if (modula2) {
  3376.     checkkeyword(TOK_FROM);
  3377.     checkkeyword(TOK_DEFINITION);
  3378.     checkkeyword(TOK_IMPLEMENT);
  3379.     checkkeyword(TOK_MODULE);
  3380.     checkkeyword(TOK_IMPORT);
  3381.     checkkeyword(TOK_EXPORT);
  3382.     } else if (curtok == TOK_IDENT &&
  3383.            (curtoksym->kwtok == TOK_MODULE ||
  3384.         curtoksym->kwtok == TOK_IMPORT ||
  3385.         curtoksym->kwtok == TOK_EXPORT ||
  3386.         curtoksym->kwtok == TOK_IMPLEMENT)) {
  3387.     if (!strcmp(curtokbuf, "UNIT") ||
  3388.         !strcmp(curtokbuf, "USES") ||
  3389.         !strcmp(curtokbuf, "INTERFACE") ||
  3390.         !strcmp(curtokbuf, "IMPLEMENTATION")) {
  3391.         modulenotation = 0;
  3392.         findsymbol("UNIT")->flags &= ~KWPOSS;
  3393.         findsymbol("USES")->flags &= ~KWPOSS;
  3394.         findsymbol("INTERFACE")->flags &= ~KWPOSS;
  3395.         findsymbol("IMPLEMENTATION")->flags &= ~KWPOSS;
  3396.     } else {
  3397.         modulenotation = 1;
  3398.         findsymbol("MODULE")->flags &= ~KWPOSS;
  3399.         findsymbol("EXPORT")->flags &= ~KWPOSS;
  3400.         findsymbol("IMPORT")->flags &= ~KWPOSS;
  3401.         findsymbol("IMPLEMENT")->flags &= ~KWPOSS;
  3402.     }
  3403.     curtok = curtoksym->kwtok;
  3404.     }
  3405. }
  3406.  
  3407.  
  3408.  
  3409.  
  3410.  
  3411.  
  3412.  
  3413.  
  3414.  
  3415.  
  3416.  
  3417.  
  3418. /* End. */
  3419.  
  3420.  
  3421.  
  3422.