开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 编译器/解释器 > 查看源码
lex.c.1
资源名称：pascal2c.tar.Z　[点击查看]
上传用户：upcnvip
上传日期：2007-01-06
资源大小：474k
文件大小：48k
源码类别：

编译器/解释器

开发平台：

C/C++

lex.c.1：源码内容
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  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).
  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.
  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. */
  20. #define PROTO_LEX_C
  21. #include "trans.h"
  24. /* Define LEXDEBUG for a token trace */
  25. #define LEXDEBUG
  30. #define EOFMARK 1
  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;
  47. #define INP_FILE     0
  48. #define INP_INCFILE  1
  49. #define INP_STRLIST  2
  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. } *topinput;
  68. char *fixpascalname(name)
  69. char *name;
  70. {
  71.     char *cp, *cp2;
  73.     if (pascalsignif > 0) {
  74.         name = format_ds("%.*s", pascalsignif, name);
  75.         if (!pascalcasesens)
  76.             upc(name);
  77. else if (pascalcasesens == 3)
  78.     lwc(name);
  79.     } else if (!pascalcasesens)
  80.         name = strupper(name);
  81.     else if (pascalcasesens == 3)
  82. name = strlower(name);
  83.     if (ignorenonalpha) {
  84. for (cp = cp2 = name; *cp; cp++)
  85.     if (isalnum(*cp))
  86. *cp2++ = *cp;
  87.     }
  88.     return name;
  89. }
  93. Static void makekeyword(name)
  94. char *name;
  95. {
  96.     Symbol *sym;
  98.     if (*name) {
  99.         sym = findsymbol(name);
  100.         sym->flags |= AVOIDNAME;
  101.     }
  102. }
  105. Static void makeglobword(name)
  106. char *name;
  107. {
  108.     Symbol *sym;
  110.     if (*name) {
  111.         sym = findsymbol(name);
  112.         sym->flags |= AVOIDGLOB;
  113.     }
  114. }
  118. Static void makekeywords()
  119. {
  120.     makekeyword("auto");
  121.     makekeyword("break");
  122.     makekeyword("char");
  123.     makekeyword("continue");
  124.     makekeyword("default");
  125.     makekeyword("defined");   /* is this one really necessary? */
  126.     makekeyword("double");
  127.     makekeyword("enum");
  128.     makekeyword("extern");
  129.     makekeyword("float");
  130.     makekeyword("int");
  131.     makekeyword("long");
  132.     makekeyword("noalias");
  133.     makekeyword("register");
  134.     makekeyword("return");
  135.     makekeyword("short");
  136.     makekeyword("signed");
  137.     makekeyword("sizeof");
  138.     makekeyword("static");
  139.     makekeyword("struct");
  140.     makekeyword("switch");
  141.     makekeyword("typedef");
  142.     makekeyword("union");
  143.     makekeyword("unsigned");
  144.     makekeyword("void");
  145.     makekeyword("volatile");
  146.     makekeyword("asm");
  147.     makekeyword("fortran");
  148.     makekeyword("entry");
  149.     makekeyword("pascal");
  150.     if (cplus != 0) {
  151.         makekeyword("class");
  152.         makekeyword("delete");
  153.         makekeyword("friend");
  154.         makekeyword("inline");
  155.         makekeyword("new");
  156.         makekeyword("operator");
  157.         makekeyword("overload");
  158.         makekeyword("public");
  159.         makekeyword("this");
  160.         makekeyword("virtual");
  161.     }
  162.     makekeyword(name_UCHAR);
  163.     makekeyword(name_SCHAR);    /* any others? */
  164.     makekeyword(name_BOOLEAN);
  165.     makekeyword(name_PROCEDURE);
  166.     makekeyword(name_ESCAPE);
  167.     makekeyword(name_ESCIO);
  168.     makekeyword(name_CHKIO);
  169.     makekeyword(name_SETIO);
  170.     makeglobword("main");
  171.     makeglobword("vextern");     /* used in generated .h files */
  172.     makeglobword("argc");
  173.     makeglobword("argv");
  174.     makekeyword("TRY");
  175.     makekeyword("RECOVER");
  176.     makekeyword("RECOVER2");
  177.     makekeyword("ENDTRY");
  178. }
  182. Static Symbol *Pkeyword(name, tok)
  183. char *name;
  184. Token tok;
  185. {
  186.     Symbol *sp = NULL;
  188.     if (pascalcasesens != 2) {
  189. sp = findsymbol(strlower(name));
  190. sp->kwtok = tok;
  191.     }
  192.     if (pascalcasesens != 3) {
  193. sp = findsymbol(strupper(name));
  194. sp->kwtok = tok;
  195.     }
  196.     return sp;
  197. }
  200. Static Symbol *Pkeywordposs(name, tok)
  201. char *name;
  202. Token tok;
  203. {
  204.     Symbol *sp = NULL;
  206.     if (pascalcasesens != 2) {
  207. sp = findsymbol(strlower(name));
  208. sp->kwtok = tok;
  209. sp->flags |= KWPOSS;
  210.     }
  211.     if (pascalcasesens != 3) {
  212. sp = findsymbol(strupper(name));
  213. sp->kwtok = tok;
  214. sp->flags |= KWPOSS;
  215.     }
  216.     return sp;
  217. }
  220. Static void makePascalwords()
  221. {
  222.     Pkeyword("AND", TOK_AND);
  223.     Pkeyword("ARRAY", TOK_ARRAY);
  224.     Pkeywordposs("ANYVAR", TOK_ANYVAR);
  225.     Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
  226.     Pkeyword("BEGIN", TOK_BEGIN);
  227.     Pkeywordposs("BY", TOK_BY);
  228.     Pkeyword("CASE", TOK_CASE);
  229.     Pkeyword("CONST", TOK_CONST);
  230.     Pkeyword("DIV", TOK_DIV);
  231.     Pkeywordposs("DEFINITION", TOK_DEFINITION);
  232.     Pkeyword("DO", TOK_DO);
  233.     Pkeyword("DOWNTO", TOK_DOWNTO);
  234.     Pkeyword("ELSE", TOK_ELSE);
  235.     Pkeywordposs("ELSIF", TOK_ELSIF);
  236.     Pkeyword("END", TOK_END);
  237.     Pkeywordposs("EXPORT", TOK_EXPORT);
  238.     Pkeyword("FILE", TOK_FILE);
  239.     Pkeyword("FOR", TOK_FOR);
  240.     Pkeywordposs("FROM", TOK_FROM);
  241.     Pkeyword("FUNCTION", TOK_FUNCTION);
  242.     Pkeyword("GOTO", TOK_GOTO);
  243.     Pkeyword("IF", TOK_IF);
  244.     Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
  245.     Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
  246.     Pkeywordposs("IMPORT", TOK_IMPORT);
  247.     Pkeyword("IN", TOK_IN);
  248.     Pkeywordposs("INLINE", TOK_INLINE);
  249.     Pkeywordposs("INTERFACE", TOK_EXPORT);
  250.     Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
  251.     Pkeyword("LABEL", TOK_LABEL);
  252.     Pkeywordposs("LOOP", TOK_LOOP);
  253.     Pkeyword("MOD", TOK_MOD);
  254.     Pkeywordposs("MODULE", TOK_MODULE);
  255.     Pkeyword("NIL", TOK_NIL);
  256.     Pkeyword("NOT", TOK_NOT);
  257.     Pkeyword("OF", TOK_OF);
  258.     Pkeyword("OR", TOK_OR);
  259.     Pkeywordposs("ORIGIN", TOK_ORIGIN);
  260.     Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
  261.     Pkeywordposs("OVERLAY", TOK_SEGMENT);
  262.     Pkeyword("PACKED", TOK_PACKED);
  263.     Pkeywordposs("POINTER", TOK_POINTER);
  264.     Pkeyword("PROCEDURE", TOK_PROCEDURE);
  265.     Pkeyword("PROGRAM", TOK_PROGRAM);
  266.     Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
  267.     Pkeyword("RECORD", TOK_RECORD);
  268.     Pkeywordposs("RECOVER", TOK_RECOVER);
  269.     Pkeywordposs("REM", TOK_REM);
  270.     Pkeyword("REPEAT", TOK_REPEAT);
  271.     Pkeywordposs("RETURN", TOK_RETURN);
  272.     if (which_lang == LANG_UCSD)
  273. Pkeyword("SEGMENT", TOK_SEGMENT);
  274.     else
  275. Pkeywordposs("SEGMENT", TOK_SEGMENT);
  276.     Pkeyword("SET", TOK_SET);
  277.     Pkeywordposs("SHL", TOK_SHL);
  278.     Pkeywordposs("SHR", TOK_SHR);
  279.     Pkeyword("THEN", TOK_THEN);
  280.     Pkeyword("TO", TOK_TO);
  281.     Pkeywordposs("TRY", TOK_TRY);
  282.     Pkeyword("TYPE", TOK_TYPE);
  283.     Pkeyword("UNTIL", TOK_UNTIL);
  284.     Pkeywordposs("USES", TOK_IMPORT);
  285.     Pkeywordposs("UNIT", TOK_MODULE);
  286.     if (which_lang == LANG_VAX)
  287. Pkeyword("VALUE", TOK_VALUE);
  288.     else
  289. Pkeywordposs("VALUE", TOK_VALUE);
  290.     Pkeyword("VAR", TOK_VAR);
  291.     Pkeywordposs("VARYING", TOK_VARYING);
  292.     Pkeyword("WHILE", TOK_WHILE);
  293.     Pkeyword("WITH", TOK_WITH);
  294.     Pkeywordposs("XOR", TOK_XOR);
  295.     Pkeyword("__MODULE", TOK_MODULE);
  296.     Pkeyword("__IMPORT", TOK_IMPORT);
  297.     Pkeyword("__EXPORT", TOK_EXPORT);
  298.     Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
  299. }
  303. Static void deterministic(name)
  304. char *name;
  305. {
  306.     Symbol *sym;
  308.     if (*name) {
  309.         sym = findsymbol(name);
  310.         sym->flags |= DETERMF;
  311.     }
  312. }
  315. Static void nosideeff(name)
  316. char *name;
  317. {
  318.     Symbol *sym;
  320.     if (*name) {
  321.         sym = findsymbol(name);
  322.         sym->flags |= NOSIDEEFF;
  323.     }
  324. }
  328. Static void recordsideeffects()
  329. {
  330.     deterministic("abs");
  331.     deterministic("acos");
  332.     deterministic("asin");
  333.     deterministic("atan");
  334.     deterministic("atan2");
  335.     deterministic("atof");
  336.     deterministic("atoi");
  337.     deterministic("atol");
  338.     deterministic("ceil");
  339.     deterministic("cos");
  340.     deterministic("cosh");
  341.     deterministic("exp");
  342.     deterministic("fabs");
  343.     deterministic("feof");
  344.     deterministic("feoln");
  345.     deterministic("ferror");
  346.     deterministic("floor");
  347.     deterministic("fmod");
  348.     deterministic("ftell");
  349.     deterministic("isalnum");
  350.     deterministic("isalpha");
  351.     deterministic("isdigit");
  352.     deterministic("islower");
  353.     deterministic("isspace");
  354.     deterministic("isupper");
  355.     deterministic("labs");
  356.     deterministic("ldexp");
  357.     deterministic("log");
  358.     deterministic("log10");
  359.     deterministic("memcmp");
  360.     deterministic("memchr");
  361.     deterministic("pow");
  362.     deterministic("sin");
  363.     deterministic("sinh");
  364.     deterministic("sqrt");
  365.     deterministic("strchr");
  366.     deterministic("strcmp");
  367.     deterministic("strcspn");
  368.     deterministic("strlen");
  369.     deterministic("strncmp");
  370.     deterministic("strpbrk");
  371.     deterministic("strrchr");
  372.     deterministic("strspn");
  373.     deterministic("strstr");
  374.     deterministic("tan");
  375.     deterministic("tanh");
  376.     deterministic("tolower");
  377.     deterministic("toupper");
  378.     deterministic(setequalname);
  379.     deterministic(subsetname);
  380.     deterministic(signextname);
  381. }
  387. void init_lex()
  388. {
  389.     int i;
  391.     inputkind = INP_FILE;
  392.     inf_lnum = 0;
  393.     inf_ltotal = 0;
  394.     *inbuf = 0;
  395.     inbufptr = inbuf;
  396.     keepingstrlist = NULL;
  397.     tempoptionlist = NULL;
  398.     switch_strpos = 0;
  399.     dollar_flag = 0;
  400.     if_flag = 0;
  401.     if_skip = 0;
  402.     commenting_flag = 0;
  403.     skipflag = 0;
  404.     inbufindent = 0;
  405.     modulenotation = 1;
  406.     notephase = 0;
  407.     endnotelist = NULL;
  408.     for (i = 0; i < SYMHASHSIZE; i++)
  409.         symtab[i] = 0;
  410.     C_lex = 0;
  411.     lex_initialized = 0;
  412. }
  415. void setup_lex()
  416. {
  417.     lex_initialized = 1;
  418.     if (!strcmp(language, "MODCAL"))
  419.         sysprog_flag = 2;
  420.     else
  421.         sysprog_flag = 0;
  422.     if (shortcircuit < 0)
  423.         partial_eval_flag = (which_lang == LANG_TURBO ||
  424.      which_lang == LANG_VAX ||
  425.      which_lang == LANG_OREGON ||
  426.      modula2 ||
  427.      hpux_lang);
  428.     else
  429.         partial_eval_flag = shortcircuit;
  430.     iocheck_flag = 1;
  431.     range_flag = 1;
  432.     ovflcheck_flag = 1;
  433.     stackcheck_flag = 1;
  434.     fixedflag = 0;
  435.     withlevel = 0;
  436.     makekeywords();
  437.     makePascalwords();
  438.     recordsideeffects();
  439.     topinput = 0;
  440.     ignore_directives = 0;
  441.     skipping_module = 0;
  442.     blockkind = TOK_END;
  443.     gettok();
  444. }
  449. int checkeatnote(msg)
  450. char *msg;
  451. {
  452.     Strlist *lp;
  453.     char *cp;
  454.     int len;
  456.     for (lp = eatnotes; lp; lp = lp->next) {
  457. if (!strcmp(lp->s, "1")) {
  458.     echoword("[*]", 0);
  459.     return 1;
  460. }
  461. if (!strcmp(lp->s, "0"))
  462.     return 0;
  463. len = strlen(lp->s);
  464. cp = msg;
  465. while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
  466.     cp++;
  467. if (*cp) {
  468.     cp = lp->s;
  469.     if (*cp != '[')
  470. cp = format_s("[%s", cp);
  471.     if (cp[strlen(cp)-1] != ']')
  472. cp = format_s("%s]", cp);
  473.     echoword(cp, 0);
  474.     return 1;
  475. }
  476.     }
  477.     return 0;
  478. }
  482. void beginerror()
  483. {
  484.     end_source();
  485.     if (showprogress) {
  486.         fprintf(stderr, "r%60sr", "");
  487.         clearprogress();
  488.     } else
  489. echobreak();
  490. }
  493. void counterror()
  494. {
  495.     if (maxerrors > 0) {
  496. if (--maxerrors == 0) {
  497.     fprintf(outf, "n/* Translation aborted: Too many errors. */n");
  498.     fprintf(outf,   "-------------------------------------------n");
  499.     if (outf != stdout)
  500. printf("Translation aborted: Too many errors.n");
  501.     if (verbose)
  502. fprintf(logf, "Translation aborted: Too many errors.n");
  503.     closelogfile();
  504.     exit(EXIT_FAILURE);
  505. }
  506.     }
  507. }
  510. void error(msg)     /* does not return */
  511. char *msg;
  512. {
  513.     flushcomments(NULL, -1, -1);
  514.     beginerror();
  515.     fprintf(outf, "/* %s, line %d: %s */n", infname, inf_lnum, msg);
  516.     fprintf(outf, "/* Translation aborted. */n");
  517.     fprintf(outf, "--------------------------n");
  518.     if (outf != stdout) {
  519.         printf("%s, line %d/%d: %sn", infname, inf_lnum, outf_lnum, msg);
  520.         printf("Translation aborted.n");
  521.     }
  522.     if (verbose) {
  523. fprintf(logf, "%s, line %d/%d: %sn",
  524. infname, inf_lnum, outf_lnum, msg);
  525. fprintf(logf, "Translation aborted.n");
  526.     }
  527.     closelogfile();
  528.     exit(EXIT_FAILURE);
  529. }
  532. void interror(proc, msg)      /* does not return */
  533. char *proc, *msg;
  534. {
  535.     error(format_ss("Internal error in %s: %s", proc, msg));
  536. }
  539. void warning(msg)
  540. char *msg;
  541. {
  542.     if (checkeatnote(msg)) {
  543. if (verbose)
  544.     fprintf(logf, "%s, %d/%d: Omitted warning: %sn",
  545.     infname, inf_lnum, outf_lnum, msg);
  546. return;
  547.     }
  548.     beginerror();
  549.     addnote(format_s("Warning: %s", msg), curserial);
  550.     counterror();
  551. }
  554. void intwarning(proc, msg)
  555. char *proc, *msg;
  556. {
  557.     if (checkeatnote(msg)) {
  558. if (verbose)
  559.     fprintf(logf, "%s, %d/%d: Omitted internal error in %s: %sn",
  560.     infname, inf_lnum, outf_lnum, proc, msg);
  561. return;
  562.     }
  563.     beginerror();
  564.     addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
  565.     if (error_crash)
  566.         exit(EXIT_FAILURE);
  567.     counterror();
  568. }
  573. void note(msg)
  574. char *msg;
  575. {
  576.     if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
  577. if (verbose)
  578.     fprintf(logf, "%s, %d/%d: Omitted note: %sn",
  579.     infname, inf_lnum, outf_lnum, msg);
  580. return;
  581.     }
  582.     beginerror();
  583.     addnote(format_s("Note: %s", msg), curserial);
  584.     counterror();
  585. }
  589. void endnote(msg)
  590. char *msg;
  591. {
  592.     if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
  593. if (verbose)
  594.     fprintf(logf, "%s, %d/%d: Omitted end-note: %sn",
  595.     infname, inf_lnum, outf_lnum, msg);
  596. return;
  597.     }
  598.     if (verbose)
  599. fprintf(logf, "%s, %d/%d: Recorded end-note: %sn",
  600. infname, inf_lnum, outf_lnum, msg);
  601.     (void) strlist_add(&endnotelist, msg);
  602. }
  605. void showendnotes()
  606. {
  607.     while (initialcalls) {
  608. if (initialcalls->value)
  609.     endnote(format_s("Remember to call %s in main program [215]",
  610.      initialcalls->s));
  611. strlist_eat(&initialcalls);
  612.     }
  613.     if (endnotelist) {
  614. end_source();
  615. while (endnotelist) {
  616.     if (outf != stdout) {
  617. beginerror();
  618. printf("Note: %sn", endnotelist->s);
  619.     }
  620.     fprintf(outf, "/* p2c: Note: %s */n", endnotelist->s);
  621.     outf_lnum++;
  622.     strlist_eat(&endnotelist);
  623. }
  624.     }
  625. }
  633. char *tok_name(tok)
  634. Token tok;
  635. {
  636.     if (tok == TOK_END && inputkind == INP_STRLIST)
  637. return "end of macro";
  638.     if (tok == curtok && tok == TOK_IDENT)
  639.         return format_s("'%s'", curtokcase);
  640.     if (!modulenotation) {
  641.         switch (tok) {
  642.             case TOK_MODULE:    return "UNIT";
  643.             case TOK_IMPORT:    return "USES";
  644.             case TOK_EXPORT:    return "INTERFACE";
  645.             case TOK_IMPLEMENT: return "IMPLEMENTATION";
  646.     default: break;
  647.         }
  648.     }
  649.     return toknames[(int) tok];
  650. }
  654. void expected(msg)
  655. char *msg;
  656. {
  657.     error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
  658. }
  661. void expecttok(tok)
  662. Token tok;
  663. {
  664.     if (curtok != tok)
  665.         expected(tok_name(tok));
  666. }
  669. void needtok(tok)
  670. Token tok;
  671. {
  672.     if (curtok != tok)
  673.         expected(tok_name(tok));
  674.     gettok();
  675. }
  678. int wexpected(msg)
  679. char *msg;
  680. {
  681.     warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
  682.     return 0;
  683. }
  686. int wexpecttok(tok)
  687. Token tok;
  688. {
  689.     if (curtok != tok)
  690.         return wexpected(tok_name(tok));
  691.     else
  692. return 1;
  693. }
  696. int wneedtok(tok)
  697. Token tok;
  698. {
  699.     if (wexpecttok(tok)) {
  700. gettok();
  701. return 1;
  702.     } else
  703. return 0;
  704. }
  707. void alreadydef(sym)
  708. Symbol *sym;
  709. {
  710.     warning(format_s("Symbol '%s' was already defined [220]", sym->name));
  711. }
  714. void undefsym(sym)
  715. Symbol *sym;
  716. {
  717.     warning(format_s("Symbol '%s' is not defined [221]", sym->name));
  718. }
  721. void symclass(sym)
  722. Symbol *sym;
  723. {
  724.     warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
  725. }
  728. void badtypes()
  729. {
  730.     warning("Type mismatch [223]");
  731. }
  734. void valrange()
  735. {
  736.     warning("Value range error [224]");
  737. }
  741. void skipparens()
  742. {
  743.     Token begintok;
  745.     if (curtok == TOK_LPAR) {
  746.         gettok();
  747.         while (curtok != TOK_RPAR)
  748.             skipparens();
  749.     } else if (curtok == TOK_LBR) {
  750.         gettok();
  751.         while (curtok != TOK_RBR)
  752.             skipparens();
  753.     } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
  754.        curtok == TOK_CASE) {
  755. begintok = curtok;
  756.         gettok();
  757.         while (curtok != TOK_END)
  758.     if (curtok == TOK_CASE && begintok == TOK_RECORD)
  759. gettok();
  760.     else
  761. skipparens();
  762.     }
  763.     gettok();
  764. }
  767. void skiptotoken2(tok1, tok2)
  768. Token tok1, tok2;
  769. {
  770.     while (curtok != tok1 && curtok != tok2 &&
  771.    curtok != TOK_END && curtok != TOK_RPAR &&
  772.    curtok != TOK_RBR && curtok != TOK_EOF)
  773. skipparens();
  774. }
  777. void skippasttoken2(tok1, tok2)
  778. Token tok1, tok2;
  779. {
  780.     skiptotoken2(tok1, tok2);
  781.     if (curtok == tok1 || curtok == tok2)
  782. gettok();
  783. }
  786. void skippasttotoken(tok1, tok2)
  787. Token tok1, tok2;
  788. {
  789.     skiptotoken2(tok1, tok2);
  790.     if (curtok == tok1)
  791. gettok();
  792. }
  795. void skiptotoken(tok)
  796. Token tok;
  797. {
  798.     skiptotoken2(tok, tok);
  799. }
  802. void skippasttoken(tok)
  803. Token tok;
  804. {
  805.     skippasttoken2(tok, tok);
  806. }
  810. int skipopenparen()
  811. {
  812.     if (wneedtok(TOK_LPAR))
  813. return 1;
  814.     skiptotoken(TOK_SEMI);
  815.     return 0;
  816. }
  819. int skipcloseparen()
  820. {
  821.     if (curtok == TOK_COMMA)
  822. warning("Too many arguments for built-in routine [225]");
  823.     else
  824. if (wneedtok(TOK_RPAR))
  825.     return 1;
  826.     skippasttotoken(TOK_RPAR, TOK_SEMI);
  827.     return 0;
  828. }
  831. int skipcomma()
  832. {
  833.     if (curtok == TOK_RPAR)
  834. warning("Too few arguments for built-in routine [226]");
  835.     else
  836. if (wneedtok(TOK_COMMA))
  837.     return 1;
  838.     skippasttotoken(TOK_RPAR, TOK_SEMI);
  839.     return 0;
  840. }
  846. char *findaltname(name, num)
  847. char *name;
  848. int num;
  849. {
  850.     char *cp;
  852.     if (num <= 0)
  853.         return name;
  854.     if (num == 1 && *alternatename1)
  855.         return format_s(alternatename1, name);
  856.     if (num == 2 && *alternatename2)
  857.         return format_s(alternatename2, name);
  858.     if (*alternatename)
  859.         return format_sd(alternatename, name, num);
  860.     cp = name;
  861.     if (*alternatename1) {
  862.         while (--num >= 0)
  863.     cp = format_s(alternatename1, cp);
  864.     } else {
  865. while (--num >= 0)
  866.     cp = format_s("%s_", cp);
  867.     }
  868.     return cp;
  869. }
  874. Symbol *findsymbol_opt(name)
  875. char *name;
  876. {
  877.     register int i;
  878.     register unsigned int hash;
  879.     register char *cp;
  880.     register Symbol *sp;
  882.     hash = 0;
  883.     for (cp = name; *cp; cp++)
  884.         hash = hash*3 + *cp;
  885.     sp = symtab[hash % SYMHASHSIZE];
  886.     while (sp && (i = strcmp(sp->name, name)) != 0) {
  887.         if (i < 0)
  888.             sp = sp->left;
  889.         else
  890.             sp = sp->right;
  891.     }
  892.     return sp;
  893. }
  897. Symbol *findsymbol(name)
  898. char *name;
  899. {
  900.     register int i;
  901.     register unsigned int hash;
  902.     register char *cp;
  903.     register Symbol **prev, *sp;
  905.     hash = 0;
  906.     for (cp = name; *cp; cp++)
  907.         hash = hash*3 + *cp;
  908.     prev = symtab + (hash % SYMHASHSIZE);
  909.     while ((sp = *prev) != 0 &&
  910.            (i = strcmp(sp->name, name)) != 0) {
  911.         if (i < 0)
  912.             prev = &(sp->left);
  913.         else
  914.             prev = &(sp->right);
  915.     }
  916.     if (!sp) {
  917.         sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
  918.         sp->mbase = sp->fbase = NULL;
  919.         sp->left = sp->right = NULL;
  920.         strcpy(sp->name, name);
  921.         sp->flags = 0;
  922. sp->kwtok = TOK_NONE;
  923.         sp->symbolnames = NULL;
  924.         *prev = sp;
  925.     }
  926.     return sp;
  927. }
  932. void clearprogress()
  933. {
  934.     oldinfname = NULL;
  935. }
  938. void progress()
  939. {
  940.     char *ctxname;
  941.     int needrefr;
  942.     static int prevlen;
  944.     if (showprogress) {
  945.         if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
  946.             !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
  947.             ctxname = "";
  948.         else
  949.             ctxname = curctx->name;
  950.         needrefr = (inf_lnum & 15) == 0;
  951.         if (oldinfname != infname || oldctxname != ctxname) {
  952.     if (oldinfname != infname)
  953. prevlen = 60;
  954.             fprintf(stderr, "r%*s", prevlen + 2, "");
  955.             oldinfname = infname;
  956.             oldctxname = ctxname;
  957.             needrefr = 1;
  958.         }
  959.         if (needrefr) {
  960.             fprintf(stderr, "r%5d %s  %s", inf_lnum, infname, ctxname);
  961.     prevlen = 8 + strlen(infname) + strlen(ctxname);
  962.         } else {
  963.             fprintf(stderr, "r%5d", inf_lnum);
  964.     prevlen = 5;
  965. }
  966.     }
  967. }
  971. void getline()
  972. {
  973.     char *cp, *cp2;
  975.     switch (inputkind) {
  977.         case INP_FILE:
  978.         case INP_INCFILE:
  979.             inf_lnum++;
  980.     inf_ltotal++;
  981.             if (fgets(inbuf, 300, inf)) {
  982.                 cp = inbuf + strlen(inbuf);
  983.                 if (*inbuf && cp[-1] == 'n')
  984.                     cp[-1] = 0;
  985. if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
  986.     cp = inbuf + 2;    /* in case input text came */
  987.     inf_lnum = 0;      /*  from the C preprocessor */
  988.     while (isdigit(*cp))
  989. inf_lnum = inf_lnum*10 + (*cp++) - '0';
  990.     inf_lnum--;
  991.     while (isspace(*cp)) cp++;
  992.     if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
  993. cp++;
  994. infname = stralloc(cp);
  995. infname[cp2 - cp] = 0;
  996.     }
  997.     getline();
  998.     return;
  999. }
  1000. if (copysource && *inbuf) {
  1001.     start_source();
  1002.     fprintf(outf, "%sn", inbuf);
  1003. }
  1004.                 if (keepingstrlist) {
  1005.                     strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
  1006.                 }
  1007.                 if (showprogress && inf_lnum % showprogress == 0)
  1008.                     progress();
  1009.             } else {
  1010.                 if (showprogress)
  1011.                     fprintf(stderr, "n");
  1012.                 if (inputkind == INP_INCFILE) {
  1013.                     pop_input();
  1014.                     getline();
  1015.                 } else
  1016.                     strcpy(inbuf, "01");
  1017.             }
  1018.             break;
  1020.         case INP_STRLIST:
  1021.             if (instrlist) {
  1022.                 strcpy(inbuf, instrlist->s);
  1023.                 if (instrlist->value)
  1024.                     inf_lnum = instrlist->value;
  1025.                 else
  1026.                     inf_lnum++;
  1027.                 instrlist = instrlist->next;
  1028.             } else
  1029.                 strcpy(inbuf, "01");
  1030.             break;
  1031.     }
  1032.     inbufptr = inbuf;
  1033.     inbufindent = 0;
  1034. }
  1039. Static void push_input()
  1040. {
  1041.     struct inprec *inp;
  1043.     inp = ALLOC(1, struct inprec, inprecs);
  1044.     inp->kind = inputkind;
  1045.     inp->fname = infname;
  1046.     inp->lnum = inf_lnum;
  1047.     inp->filep = inf;
  1048.     inp->strlistp = instrlist;
  1049.     inp->inbufptr = stralloc(inbufptr);
  1050.     inp->curtok = curtok;
  1051.     inp->curtoksym = curtoksym;
  1052.     inp->curtokmeaning = curtokmeaning;
  1053.     inp->saveblockkind = TOK_NIL;
  1054.     inp->next = topinput;
  1055.     topinput = inp;
  1056.     inbufptr = inbuf + strlen(inbuf);
  1057. }
  1061. void push_input_file(fp, fname, isinclude)
  1062. FILE *fp;
  1063. char *fname;
  1064. int isinclude;
  1065. {
  1066.     push_input();
  1067.     inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
  1068.     inf = fp;
  1069.     inf_lnum = 0;
  1070.     infname = fname;
  1071.     *inbuf = 0;
  1072.     inbufptr = inbuf;
  1073.     topinput->tempopts = tempoptionlist;
  1074.     tempoptionlist = NULL;
  1075.     if (isinclude != 2)
  1076.         gettok();
  1077. }
  1080. void include_as_import()
  1081. {
  1082.     if (inputkind == INP_INCFILE) {
  1083. if (topinput->saveblockkind == TOK_NIL)
  1084.     topinput->saveblockkind = blockkind;
  1085. blockkind = TOK_IMPORT;
  1086.     } else
  1087. warning(format_s("%s ignored except in include files [228]",
  1088.  interfacecomment));
  1089. }
  1092. void push_input_strlist(sp, fname)
  1093. Strlist *sp;
  1094. char *fname;
  1095. {
  1096.     push_input();
  1097.     inputkind = INP_STRLIST;
  1098.     instrlist = sp;
  1099.     if (fname) {
  1100.         infname = fname;
  1101.         inf_lnum = 0;
  1102.     } else
  1103.         inf_lnum--;     /* adjust for extra getline() */
  1104.     *inbuf = 0;
  1105.     inbufptr = inbuf;
  1106.     gettok();
  1107. }
  1111. void pop_input()
  1112. {
  1113.     struct inprec *inp;
  1115.     if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
  1116. while (tempoptionlist) {
  1117.     undooption(tempoptionlist->value, tempoptionlist->s);
  1118.     strlist_eat(&tempoptionlist);
  1119. }
  1120. tempoptionlist = topinput->tempopts;
  1121. if (inf)
  1122.     fclose(inf);
  1123.     }
  1124.     inp = topinput;
  1125.     topinput = inp->next;
  1126.     if (inp->saveblockkind != TOK_NIL)
  1127. blockkind = inp->saveblockkind;
  1128.     inputkind = inp->kind;
  1129.     infname = inp->fname;
  1130.     inf_lnum = inp->lnum;
  1131.     inf = inp->filep;
  1132.     curtok = inp->curtok;
  1133.     curtoksym = inp->curtoksym;
  1134.     curtokmeaning = inp->curtokmeaning;
  1135.     strcpy(inbuf, inp->inbufptr);
  1136.     FREE(inp->inbufptr);
  1137.     inbufptr = inbuf;
  1138.     instrlist = inp->strlistp;
  1139.     FREE(inp);
  1140. }
  1145. int undooption(i, name)
  1146. int i;
  1147. char *name;
  1148. {
  1149.     char kind = rctable[i].kind;
  1151.     switch (kind) {
  1153.         case 'S':
  1154. case 'B':
  1155.     if (rcprevvalues[i]) {
  1156.                 *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
  1157.                 strlist_eat(&rcprevvalues[i]);
  1158.                 return 1;
  1159.             }
  1160.             break;
  1162.         case 'I':
  1163.         case 'D':
  1164.             if (rcprevvalues[i]) {
  1165.                 *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
  1166.                 strlist_eat(&rcprevvalues[i]);
  1167.                 return 1;
  1168.             }
  1169.             break;
  1171.         case 'L':
  1172.             if (rcprevvalues[i]) {
  1173.                 *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
  1174.                 strlist_eat(&rcprevvalues[i]);
  1175.                 return 1;
  1176.             }
  1177.             break;
  1179. case 'R':
  1180.     if (rcprevvalues[i]) {
  1181. *((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
  1182. strlist_eat(&rcprevvalues[i]);
  1183. return 1;
  1184.     }
  1185.     break;
  1187.         case 'C':
  1188.         case 'U':
  1189.             if (rcprevvalues[i]) {
  1190.                 strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
  1191.                 strlist_eat(&rcprevvalues[i]);
  1192.                 return 1;
  1193.             }
  1194.             break;
  1196.         case 'A':
  1197.             strlist_remove((Strlist **)rctable[i].ptr, name);
  1198.             return 1;
  1200.         case 'X':
  1201.             if (rctable[i].def == 1) {
  1202.                 strlist_remove((Strlist **)rctable[i].ptr, name);
  1203.                 return 1;
  1204.             }
  1205.             break;
  1207.     }
  1208.     return 0;
  1209. }
  1214. void badinclude()
  1215. {
  1216.     warning("Can't handle an "include" directive here [229]");
  1217.     inputkind = INP_INCFILE;     /* expand it in-line */
  1218.     gettok();
  1219. }
  1223. int handle_include(fn)
  1224. char *fn;
  1225. {
  1226.     FILE *fp = NULL;
  1227.     Strlist *sl;
  1229.     for (sl = includedirs; sl; sl = sl->next) {
  1230. fp = fopen(format_s(sl->s, fn), "r");
  1231. if (fp) {
  1232.     fn = stralloc(format_s(sl->s, fn));
  1233.     break;
  1234. }
  1235.     }
  1236.     if (!fp) {
  1237.         perror(fn);
  1238.         warning(format_s("Could not open include file %s [230]", fn));
  1239.         return 0;
  1240.     } else {
  1241.         if (!quietmode && !showprogress)
  1242.     if (outf == stdout)
  1243. fprintf(stderr, "Reading include file "%s"n", fn);
  1244.     else
  1245. printf("Reading include file "%s"n", fn);
  1246. if (verbose)
  1247.     fprintf(logf, "Reading include file "%s"n", fn);
  1248.         if (expandincludes == 0) {
  1249.             push_input_file(fp, fn, 2);
  1250.             curtok = TOK_INCLUDE;
  1251.             strcpy(curtokbuf, fn);
  1252.         } else {
  1253.             push_input_file(fp, fn, 1);
  1254.         }
  1255.         return 1;
  1256.     }
  1257. }
  1261. int turbo_directive(closing, after)
  1262. char *closing, *after;
  1263. {
  1264.     char *cp, *cp2;
  1265.     int i, result;
  1267.     if (!strcincmp(inbufptr, "$double", 7)) {
  1268. cp = inbufptr + 7;
  1269. while (isspace(*cp)) cp++;
  1270. if (cp == closing) {
  1271.     inbufptr = after;
  1272.     doublereals = 1;
  1273.     return 1;
  1274. }
  1275.     } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
  1276. cp = inbufptr + 9;
  1277. while (isspace(*cp)) cp++;
  1278. if (cp == closing) {
  1279.     inbufptr = after;
  1280.     doublereals = 0;
  1281.     return 1;
  1282. }
  1283.     }
  1284.     switch (inbufptr[2]) {
  1286.         case '+':
  1287.         case '-':
  1288.             result = 1;
  1289.             cp = inbufptr + 1;
  1290.             for (;;) {
  1291.                 if (!isalpha(*cp++))
  1292.                     return 0;
  1293.                 if (*cp != '+' && *cp != '-')
  1294.                     return 0;
  1295.                 if (++cp == closing)
  1296.                     break;
  1297.                 if (*cp++ != ',')
  1298.                     return 0;
  1299.             }
  1300.             cp = inbufptr + 1;
  1301.             do {
  1302.                 switch (*cp++) {
  1304.                     case 'b':
  1305.                     case 'B':
  1306.                         if (shortcircuit < 0 && which_lang != LANG_MPW)
  1307.                             partial_eval_flag = (*cp == '-');
  1308.                         break;
  1310.                     case 'i':
  1311.                     case 'I':
  1312.                         iocheck_flag = (*cp == '+');
  1313.                         break;
  1315.                     case 'r':
  1316.                     case 'R':
  1317.                         if (*cp == '+') {
  1318.                             if (!range_flag)
  1319.                                 note("Range checking is ON [216]");
  1320.                             range_flag = 1;
  1321.                         } else {
  1322.                             if (range_flag)
  1323.                                 note("Range checking is OFF [216]");
  1324.                             range_flag = 0;
  1325.                         }
  1326.                         break;
  1328.                     case 's':
  1329.                     case 'S':
  1330.                         if (*cp == '+') {
  1331.                             if (!stackcheck_flag)
  1332.                                 note("Stack checking is ON [217]");
  1333.                             stackcheck_flag = 1;
  1334.                         } else {
  1335.                             if (stackcheck_flag)
  1336.                                 note("Stack checking is OFF [217]");
  1337.                             stackcheck_flag = 0;
  1338.                         }
  1339.                         break;
  1341.                     default:
  1342.                         result = 0;
  1343.                         break;
  1344.                 }
  1345.                 cp++;
  1346.             } while (*cp++ == ',');
  1347.             if (result)
  1348.                 inbufptr = after;
  1349.             return result;
  1351. case 'c':
  1352. case 'C':
  1353.     if (toupper(inbufptr[1]) == 'S' &&
  1354. (inbufptr[3] == '+' || inbufptr[3] == '-') &&
  1355. inbufptr + 4 == closing) {
  1356. if (shortcircuit < 0)
  1357.     partial_eval_flag = (inbufptr[3] == '+');
  1358. inbufptr = after;
  1359. return 1;
  1360.     }
  1361.     return 0;
  1363.         case ' ':
  1364.             switch (inbufptr[1]) {
  1366.                 case 'i':
  1367.                 case 'I':
  1368.                     if (skipping_module)
  1369.                         break;
  1370.                     cp = inbufptr + 3;
  1371.                     while (isspace(*cp)) cp++;
  1372.                     cp2 = cp;
  1373.                     i = 0;
  1374.                     while (*cp2 && cp2 != closing)
  1375.                         i++, cp2++;
  1376.                     if (cp2 != closing)
  1377.                         return 0;
  1378.                     while (isspace(cp[i-1]))
  1379.                         if (--i <= 0)
  1380.                             return 0;
  1381.                     inbufptr = after;
  1382.                     cp2 = ALLOC(i + 1, char, strings);
  1383.                     strncpy(cp2, cp, i);
  1384.                     cp2[i] = 0;
  1385.                     if (handle_include(cp2))
  1386. return 2;
  1387.     break;
  1389. case 's':
  1390. case 'S':
  1391.     cp = inbufptr + 3;
  1392.     outsection(minorspace);
  1393.     if (cp == closing) {
  1394. output("#undef __SEG__n");
  1395.     } else {
  1396. output("#define __SEG__ ");
  1397. while (*cp && cp != closing)
  1398.     cp++;
  1399. if (*cp) {
  1400.     i = *cp;
  1401.     *cp = 0;
  1402.     output(inbufptr + 3);
  1403.     *cp = i;
  1404. }
  1405. output("n");
  1406.     }
  1407.     outsection(minorspace);
  1408.     inbufptr = after;
  1409.     return 1;
  1411.             }
  1412.             return 0;
  1414. case '}':
  1415. case '*':
  1416.     if (inbufptr + 2 == closing) {
  1417. switch (inbufptr[1]) {
  1418.     
  1419.   case 's':
  1420.   case 'S':
  1421.     outsection(minorspace);
  1422.     output("#undef __SEG__n");
  1423.     outsection(minorspace);
  1424.     inbufptr = after;
  1425.     return 1;
  1427. }
  1428.     }
  1429.     return 0;
  1431.         case 'f':   /* $ifdef etc. */
  1432.         case 'F':
  1433.             if (toupper(inbufptr[1]) == 'I' &&
  1434.                 ((toupper(inbufptr[3]) == 'O' &&
  1435.                   toupper(inbufptr[4]) == 'P' &&
  1436.                   toupper(inbufptr[5]) == 'T') ||
  1437.                  (toupper(inbufptr[3]) == 'D' &&
  1438.                   toupper(inbufptr[4]) == 'E' &&
  1439.                   toupper(inbufptr[5]) == 'F') ||
  1440.                  (toupper(inbufptr[3]) == 'N' &&
  1441.                   toupper(inbufptr[4]) == 'D' &&
  1442.                   toupper(inbufptr[5]) == 'E' &&
  1443.                   toupper(inbufptr[6]) == 'F'))) {
  1444.                 note("Turbo Pascal conditional compilation directive was ignored [218]");
  1445.             }
  1446.             return 0;
  1448.     }
  1449.     return 0;
  1450. }
  1455. extern Strlist *addmacros;
  1457. void defmacro(name, kind, fname, lnum)
  1458. char *name, *fname;
  1459. long kind;
  1460. int lnum;
  1461. {
  1462.     Strlist *defsl, *sl, *sl2;
  1463.     Symbol *sym, *sym2;
  1464.     Meaning *mp;
  1465.     Expr *ex;
  1467.     defsl = NULL;
  1468.     sl = strlist_append(&defsl, name);
  1469.     C_lex++;
  1470.     if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
  1471.         fname = curtoksym->name;
  1472.     push_input_strlist(defsl, fname);
  1473.     if (fname)
  1474.         inf_lnum = lnum;
  1475.     switch (kind) {
  1477.         case MAC_VAR:
  1478.             if (!wexpecttok(TOK_IDENT))
  1479. break;
  1480.     for (mp = curtoksym->mbase; mp; mp = mp->snext) {
  1481. if (mp->kind == MK_VAR)
  1482.     warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
  1483.     }
  1484.             sl = strlist_append(&varmacros, curtoksym->name);
  1485.             gettok();
  1486.             if (!wneedtok(TOK_EQ))
  1487. break;
  1488.             sl->value = (long)pc_expr();
  1489.             break;
  1491.         case MAC_CONST:
  1492.             if (!wexpecttok(TOK_IDENT))
  1493. break;
  1494.     for (mp = curtoksym->mbase; mp; mp = mp->snext) {
  1495. if (mp->kind == MK_CONST)
  1496.     warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
  1497.     }
  1498.             sl = strlist_append(&constmacros, curtoksym->name);
  1499.             gettok();
  1500.             if (!wneedtok(TOK_EQ))
  1501. break;
  1502.             sl->value = (long)pc_expr();
  1503.             break;
  1505.         case MAC_FIELD:
  1506.             if (!wexpecttok(TOK_IDENT))
  1507. break;
  1508.             sym = curtoksym;
  1509.             gettok();
  1510.             if (!wneedtok(TOK_DOT))
  1511. break;
  1512.             if (!wexpecttok(TOK_IDENT))
  1513. break;
  1514.     sym2 = curtoksym;
  1515.             gettok();
  1516.     if (!wneedtok(TOK_EQ))
  1517. break;
  1518.             funcmacroargs = NULL;
  1519.             sym->flags |= FMACREC;
  1520.             ex = pc_expr();
  1521.             sym->flags &= ~FMACREC;
  1522.     for (mp = sym2->fbase; mp; mp = mp->snext) {
  1523. if (mp->rectype && mp->rectype->meaning &&
  1524.     mp->rectype->meaning->sym == sym)
  1525.     break;
  1526.     }
  1527.     if (mp) {
  1528. mp->constdefn = ex;
  1529.     } else {
  1530. sl = strlist_append(&fieldmacros, 
  1531.     format_ss("%s.%s", sym->name, sym2->name));
  1532. sl->value = (long)ex;
  1533.     }
  1534.             break;
  1536.         case MAC_FUNC:
  1537.             if (!wexpecttok(TOK_IDENT))
  1538. break;
  1539.             sym = curtoksym;
  1540.             if (sym->mbase &&
  1541. (sym->mbase->kind == MK_FUNCTION ||
  1542.  sym->mbase->kind == MK_SPECIAL))
  1543.                 sl = NULL;
  1544.             else
  1545.                 sl = strlist_append(&funcmacros, sym->name);
  1546.             gettok();
  1547.             funcmacroargs = NULL;
  1548.             if (curtok == TOK_LPAR) {
  1549.                 do {
  1550.                     gettok();
  1551.     if (curtok == TOK_RPAR && !funcmacroargs)
  1552. break;
  1553.                     if (!wexpecttok(TOK_IDENT)) {
  1554. skiptotoken2(TOK_COMMA, TOK_RPAR);
  1555. continue;
  1556.     }
  1557.                     sl2 = strlist_append(&funcmacroargs, curtoksym->name);
  1558.                     sl2->value = (long)curtoksym;
  1559.                     curtoksym->flags |= FMACREC;
  1560.                     gettok();
  1561.                 } while (curtok == TOK_COMMA);
  1562.                 if (!wneedtok(TOK_RPAR))
  1563.     skippasttotoken(TOK_RPAR, TOK_EQ);
  1564.             }
  1565.             if (!wneedtok(TOK_EQ))
  1566. break;
  1567.             if (sl)
  1568.                 sl->value = (long)pc_expr();
  1569.             else
  1570.                 sym->mbase->constdefn = pc_expr();
  1571.             for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
  1572.                 sym2 = (Symbol *)sl2->value;
  1573.                 sym2->flags &= ~FMACREC;
  1574.             }
  1575.             strlist_empty(&funcmacroargs);
  1576.             break;
  1578.     }
  1579.     if (curtok != TOK_EOF)
  1580.         warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
  1581.     pop_input();
  1582.     C_lex--;
  1583.     strlist_empty(&defsl);
  1584. }
  1588. void check_unused_macros()
  1589. {
  1590.     Strlist *sl;
  1592.     if (warnmacros) {
  1593.         for (sl = varmacros; sl; sl = sl->next)
  1594.             warning(format_s("VarMacro %s was never used [234]", sl->s));
  1595.         for (sl = constmacros; sl; sl = sl->next)
  1596.             warning(format_s("ConstMacro %s was never used [234]", sl->s));
  1597.         for (sl = fieldmacros; sl; sl = sl->next)
  1598.             warning(format_s("FieldMacro %s was never used [234]", sl->s));
  1599.         for (sl = funcmacros; sl; sl = sl->next)
  1600.             warning(format_s("FuncMacro %s was never used [234]", sl->s));
  1601.     }
  1602. }
  1608. #define skipspc(cp)   while (isspace(*cp)) cp++
  1610. Static int parsecomment(p2c_only, starparen)
  1611. int p2c_only, starparen;
  1612. {
  1613.     char namebuf[302];
  1614.     char *cp, *cp2 = namebuf, *closing, *after;
  1615.     char kind, chgmode, upcflag;
  1616.     long val, oldval, sign;
  1617.     double dval;
  1618.     int i, tempopt, hassign;
  1619.     Strlist *sp;
  1620.     Symbol *sym;
  1622.     if (if_flag)
  1623.         return 0;
  1624.     if (!p2c_only) {
  1625.         if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
  1626.      *noskipcomment) {
  1627.             inbufptr += strlen(noskipcomment);
  1628.     if (skipflag < 0) {
  1629. curtok = TOK_ENDIF;
  1630. skipflag = 1;
  1631. return 2;
  1632.     }
  1633.     skipflag = 1;
  1634.             return 1;
  1635.         }
  1636.     }
  1637.     closing = inbufptr;
  1638.     while (*closing && (starparen
  1639. ? (closing[0] != '*' || closing[1] != ')')
  1640. : (closing[0] != '}')))
  1641. closing++;
  1642.     if (!*closing)
  1643. return 0;
  1644.     after = closing + (starparen ? 2 : 1);
  1645.     cp = inbufptr;
  1646.     while (cp < closing && (*cp != '#' || cp[1] != '#'))
  1647. cp++;    /* Ignore comments */
  1648.     if (cp < closing) {
  1649. while (isspace(cp[-1]))
  1650.     cp--;
  1651. *cp = '#';   /* avoid skipping spaces past closing! */
  1652. closing = cp;
  1653.     }
  1654.     if (!p2c_only) {
  1655.         if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
  1656.      closing == inbufptr + 12) {
  1657.             wrapup();
  1658.             inbufptr = after;
  1659.             return 1;
  1660.         }
  1661.         if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
  1662.      *fixedcomment &&
  1663.      inbufptr + strlen(fixedcomment) == closing) {
  1664.             fixedflag++;
  1665.             inbufptr = after;
  1666.             return 1;
  1667.         }
  1668.         if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
  1669.      *permanentcomment &&
  1670.      inbufptr + strlen(permanentcomment) == closing) {
  1671.             permflag = 1;
  1672.             inbufptr = after;
  1673.             return 1;
  1674.         }
  1675.         if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
  1676.      *interfacecomment &&
  1677.      inbufptr + strlen(interfacecomment) == closing) {
  1678.             inbufptr = after;
  1679.     curtok = TOK_INTFONLY;
  1680.             return 2;
  1681.         }
  1682.         if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
  1683.      *skipcomment &&
  1684.      inbufptr + strlen(skipcomment) == closing) {
  1685.             inbufptr = after;
  1686.     skipflag = -1;
  1687.     skipping_module++;    /* eat comments in skipped portion */
  1688.     do {
  1689. gettok();
  1690.     } while (curtok != TOK_ENDIF);
  1691.     skipping_module--;
  1692.             return 1;
  1693.         }
  1694. if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
  1695.      *signedcomment && !p2c_only &&
  1696.      inbufptr + strlen(signedcomment) == closing) {
  1697.     inbufptr = after;
  1698.     gettok();
  1699.     if (curtok == TOK_IDENT && curtokmeaning &&
  1700. curtokmeaning->kind == MK_TYPE &&
  1701. curtokmeaning->type == tp_char) {
  1702. curtokmeaning = mp_schar;
  1703.     } else
  1704. warning("{SIGNED} applied to type other than CHAR [314]");
  1705.     return 2;
  1706. }
  1707. if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
  1708.      *unsignedcomment && !p2c_only &&
  1709.      inbufptr + strlen(unsignedcomment) == closing) {
  1710.     inbufptr = after;
  1711.     gettok();
  1712.     if (curtok == TOK_IDENT && curtokmeaning &&
  1713. curtokmeaning->kind == MK_TYPE &&
  1714. curtokmeaning->type == tp_char) {
  1715. curtokmeaning = mp_uchar;
  1716.     } else if (curtok == TOK_IDENT && curtokmeaning &&
  1717.        curtokmeaning->kind == MK_TYPE &&
  1718.        curtokmeaning->type == tp_integer) {
  1719. curtokmeaning = mp_unsigned;
  1720.     } else if (curtok == TOK_IDENT && curtokmeaning &&
  1721.        curtokmeaning->kind == MK_TYPE &&
  1722.        curtokmeaning->type == tp_int) {
  1723. curtokmeaning = mp_uint;
  1724.     } else
  1725. warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
  1726.     return 2;
  1727. }
  1728.         if (*inbufptr == '$') {
  1729.             i = turbo_directive(closing, after);
  1730.             if (i)
  1731.                 return i;
  1732.         }
  1733.     }
  1734.     tempopt = 0;
  1735.     cp = inbufptr;
  1736.     if (*cp == '*') {
  1737.         cp++;
  1738.         tempopt = 1;
  1739.     }
  1740.     if (!isalpha(*cp))
  1741.         return 0;
  1742.     while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
  1743.         *cp2++ = toupper(*cp++);
  1744.     *cp2 = 0;
  1745.     i = numparams;
  1746.     while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
  1747.     if (i < 0)
  1748.         return 0;
  1749.     kind = rctable[i].kind;
  1750.     chgmode = rctable[i].chgmode;
  1751.     if (chgmode == ' ')    /* allowed in p2crc only */
  1752.         return 0;
  1753.     if (chgmode == 'T' && lex_initialized) {
  1754.         if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
  1755.             warning(format_s("%s works only at top of program [235]",
  1756.                              rctable[i].name));
  1757.     }
  1758.     if (cp == closing) {
  1759.         if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
  1760.     kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
  1761.             undooption(i, "");
  1762.             inbufptr = after;
  1763.             return 1;
  1764.         }
  1765.     }
  1766.     switch (kind) {
  1768.         case 'S':
  1769.         case 'I':
  1770.         case 'L':
  1771.             val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
  1772.                            (kind == 'S') ? *((short *)rctable[i].ptr) :
  1773.                                            *((  int *)rctable[i].ptr);
  1774.             switch (*cp) {
  1776.                 case '=':
  1777.                     skipspc(cp);
  1778.     hassign = (*++cp == '-' || *cp == '+');
  1779.                     sign = (*cp == '-') ? -1 : 1;
  1780.     cp += hassign;
  1781.                     if (isdigit(*cp)) {
  1782.                         val = 0;
  1783.                         while (isdigit(*cp))
  1784.                             val = val * 10 + (*cp++) - '0';
  1785.                         val *= sign;
  1786. if (kind == 'D' && !hassign)
  1787.     val += 10000;
  1788.                     } else if (toupper(cp[0]) == 'D' &&
  1789.                                toupper(cp[1]) == 'E' &&
  1790.                                toupper(cp[2]) == 'F') {
  1791.                         val = rctable[i].def;
  1792.                         cp += 3;
  1793.                     }
  1794.                     break;
  1796.                 case '+':
  1797.                 case '-':
  1798.                     if (chgmode != 'R')
  1799.                         return 0;
  1800.                     for (;;) {
  1801.                         if (*cp == '+')
  1802.                             val++;
  1803.                         else if (*cp == '-')
  1804.                             val--;
  1805.                         else
  1806.                             break;
  1807.                         cp++;
  1808.                     }
  1809.                     break;
  1811.             }
  1812.             skipspc(cp);
  1813.             if (cp != closing)
  1814.                 return 0;
  1815.             strlist_insert(&rcprevvalues[i], "")->value = oldval;
  1816.             if (tempopt)
  1817.                 strlist_insert(&tempoptionlist, "")->value = i;
  1818.             if (kind == 'L')
  1819.                 *((long *)rctable[i].ptr) = val;
  1820.             else if (kind == 'S')
  1821.                 *((short *)rctable[i].ptr) = val;
  1822.             else
  1823.                 *((int *)rctable[i].ptr) = val;
  1824.             inbufptr = after;
  1825.             return 1;
  1827. case 'D':
  1828.             val = oldval = *((int *)rctable[i].ptr);
  1829.     if (*cp++ != '=')
  1830. return 0;
  1831.     skipspc(cp);
  1832.     if (toupper(cp[0]) == 'D' &&
  1833. toupper(cp[1]) == 'E' &&
  1834. toupper(cp[2]) == 'F') {
  1835. val = rctable[i].def;
  1836. cp += 3;
  1837.     } else {
  1838.                 cp2 = namebuf;
  1839.                 while (*cp && cp != closing && !isspace(*cp))
  1840.                     *cp2++ = *cp++;
  1841. *cp2 = 0;
  1842. val = parsedelta(namebuf, -1);
  1843. if (!val)
  1844.     return 0;
  1845.     }
  1846.     skipspc(cp);
  1847.             if (cp != closing)
  1848.                 return 0;
  1849.             strlist_insert(&rcprevvalues[i], "")->value = oldval;
  1850.             if (tempopt)
  1851.                 strlist_insert(&tempoptionlist, "")->value = i;
  1852.             *((int *)rctable[i].ptr) = val;
  1853.             inbufptr = after;
  1854.             return 1;
  1856.         case 'R':
  1857.     if (*cp++ != '=')
  1858. return 0;
  1859.     skipspc(cp);
  1860.     if (toupper(cp[0]) == 'D' &&
  1861. toupper(cp[1]) == 'E' &&
  1862. toupper(cp[2]) == 'F') {
  1863. dval = rctable[i].def / 100.0;
  1864. cp += 3;
  1865.     } else {
  1866. cp2 = cp;
  1867. while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
  1868.        *cp == '.' || toupper(*cp) == 'E')
  1869.     cp++;
  1870. if (cp == cp2)
  1871.     return 0;
  1872. dval = atof(cp2);
  1873.     }
  1874.     skipspc(cp);
  1875.     if (cp != closing)
  1876. return 0;
  1877.     sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
  1878.             strlist_insert(&rcprevvalues[i], namebuf);
  1879.             if (tempopt)
  1880.                 strlist_insert(&tempoptionlist, namebuf)->value = i;
  1881.     *((double *)rctable[i].ptr) = dval;
  1882.             inbufptr = after;
  1883.             return 1;
  1885.         case 'B':
  1886.     if (*cp++ != '=')
  1887. return 0;
  1888.     skipspc(cp);
  1889.     if (toupper(cp[0]) == 'D' &&
  1890. toupper(cp[1]) == 'E' &&
  1891. toupper(cp[2]) == 'F') {
  1892. val = rctable[i].def;
  1893. cp += 3;
  1894.     } else {
  1895. val = parse_breakstr(cp);
  1896. while (*cp && cp != closing && !isspace(*cp))
  1897.     cp++;
  1898.     }
  1899.     skipspc(cp);
  1900.     if (cp != closing || val == -1)
  1901. return 0;
  1902.             strlist_insert(&rcprevvalues[i], "")->value =
  1903. *((short *)rctable[i].ptr);
  1904.             if (tempopt)
  1905.                 strlist_insert(&tempoptionlist, "")->value = i;
  1906.     *((short *)rctable[i].ptr) = val;
  1907.             inbufptr = after;
  1908.             return 1;
  1910.         case 'C':
  1911.         case 'U':
  1912.             if (*cp == '=') {
  1913.                 cp++;
  1914.                 skipspc(cp);
  1915.                 for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
  1916.                     if (!*cp2 || cp2-cp >= rctable[i].def)
  1917.                         return 0;
  1918.                 cp2 = (char *)rctable[i].ptr;
  1919.                 sp = strlist_insert(&rcprevvalues[i], cp2);
  1920.                 if (tempopt)
  1921.                     strlist_insert(&tempoptionlist, "")->value = i;
  1922.                 while (cp != closing && !isspace(*cp2))
  1923.                     *cp2++ = *cp++;
  1924.                 *cp2 = 0;
  1925.                 if (kind == 'U')
  1926.                     upc((char *)rctable[i].ptr);
  1927.                 skipspc(cp);
  1928.                 if (cp != closing)
  1929.                     return 0;
  1930.                 inbufptr = after;
  1931.                 if (!strcmp(rctable[i].name, "LANGUAGE") &&
  1932.                     !strcmp((char *)rctable[i].ptr, "MODCAL"))
  1933.                     sysprog_flag |= 2;
  1934.                 return 1;
  1935.             }
  1936.             return 0;
  1938.         case 'F':
  1939.         case 'G':
  1940.             if (*cp == '=' || *cp == '+' || *cp == '-') {
  1941.                 upcflag = (kind == 'F' && !pascalcasesens);
  1942.                 chgmode = *cp++;
  1943.                 skipspc(cp);
  1944.                 cp2 = namebuf;
  1945.                 while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
  1946.                     *cp2++ = *cp++;
  1947.                 *cp2++ = 0;
  1948. if (!*namebuf)
  1949.     return 0;
  1950.                 skipspc(cp);
  1951.                 if (cp != closing)
  1952.                     return 0;
  1953.                 if (upcflag)
  1954.                     upc(namebuf);
  1955.                 sym = findsymbol(namebuf);
  1956. if (rctable[i].def & FUNCBREAK)
  1957.     sym->flags &= ~FUNCBREAK;
  1958.                 if (chgmode == '-')
  1959.                     sym->flags &= ~rctable[i].def;
  1960.                 else
  1961.                     sym->flags |= rctable[i].def;
  1962.                 inbufptr = after;
  1963.                 return 1;
  1964.            }
  1965.            return 0;
  1967.         case 'A':
  1968.             if (*cp == '=' || *cp == '+' || *cp == '-') {
  1969.                 chgmode = *cp++;
  1970.                 skipspc(cp);
  1971.                 cp2 = namebuf;
  1972.                 while (cp != closing && !isspace(*cp) && *cp)
  1973.                     *cp2++ = *cp++;
  1974.                 *cp2++ = 0;
  1975.                 skipspc(cp);
  1976.                 if (cp != closing)
  1977.                     return 0;
  1978.                 if (chgmode != '+')
  1979.                     strlist_remove((Strlist **)rctable[i].ptr, namebuf);
  1980.                 if (chgmode != '-')
  1981.                     sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
  1982.                 if (tempopt)
  1983.                     strlist_insert(&tempoptionlist, namebuf)->value = i;
  1984.                 inbufptr = after;
  1985.                 return 1;
  1986.             }
  1987.             return 0;
  1989.         case 'M':
  1990.             if (!isspace(*cp))
  1991.                 return 0;
  1992.             skipspc(cp);
  1993.             if (!isalpha(*cp))
  1994.                 return 0;
  1995.             for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
  1996.             if (cp2 > cp && cp2 == closing) {
  1997.                 inbufptr = after;
  1998.                 cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
  1999.                 if (tp_integer != NULL) {
  2000.                     defmacro(cp2, rctable[i].def, NULL, 0);
  2001.                 } else {
  2002.                     sp = strlist_append(&addmacros, cp2);
  2003.                     sp->value = rctable[i].def;
  2004.                 }
  2005.                 return 1;
  2006.             }
  2007.             return 0;
  2009.         case 'X':
  2010.             switch (rctable[i].def) {
  2012.                 case 1:     /* strlist with string values */
  2013.                     if (!isspace(*cp) && *cp != '=' && 
  2014.                         *cp != '+' && *cp != '-')
  2015.                         return 0;
  2016.                     chgmode = *cp++;
  2017.                     skipspc(cp);
  2018.                     cp2 = namebuf;
  2019.                     while (isalnum(*cp) || *cp == '_' ||
  2020.    *cp == '$' || *cp == '%' ||
  2021.    *cp == '.' || *cp == '-' ||
  2022.    (*cp == ''' && cp[1] && cp[2] == ''' &&
  2023.     cp+1 != closing && cp[1] != '=')) {
  2024. if (*cp == ''') {
  2025.     *cp2++ = *cp++;
  2026.     *cp2++ = *cp++;
  2027. }     
  2028.                         *cp2++ = *cp++;
  2029.     }
  2030.                     *cp2++ = 0;
  2031.                     if (chgmode == '-') {
  2032.                         skipspc(cp);