Logo Search packages:      
Sourcecode: p2c version File versions  Download package

lex.c

/* "p2c", a Pascal to C translator.
   Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation.
   Author's address: daveg@synaptics.com.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation (any version).

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */



#define PROTO_LEX_C
#include "trans.h"


/* Define LEXDEBUG for a token trace */
#define LEXDEBUG




#define EOFMARK 1


Static char dollar_flag, lex_initialized;
Static int if_flag, if_skip;
Static int commenting_flag;
Static char *commenting_ptr;
Static int skipflag;
Static char modulenotation;
Static short inputkind;
Static Strlist *instrlist;
Static char inbuf[300];
Static char *oldinfname, *oldctxname;
Static Strlist *endnotelist;



#define INP_FILE     0
#define INP_INCFILE  1
#define INP_STRLIST  2

Static struct inprec {
    struct inprec *next;
    short kind;
    char *fname, *inbufptr;
    int lnum;
    FILE *filep;
    Strlist *strlistp, *tempopts;
    Token curtok, saveblockkind;
    Symbol *curtoksym;
    Meaning *curtokmeaning;
    char *curtokbuf, *curtokcase;
} *topinput;






char *fixpascalname(name)
char *name;
{
    char *cp, *cp2;

    if (pascalsignif > 0) {
        name = format_ds("%.*s", pascalsignif, name);
        if (!pascalcasesens)
            upc(name);
      else if (pascalcasesens == 3)
          lwc(name);
    } else if (!pascalcasesens)
        name = strupper(name);
    else if (pascalcasesens == 3)
      name = strlower(name);
    if (ignorenonalpha) {
      for (cp = cp2 = name; *cp; cp++)
          if (isalnum(*cp))
            *cp2++ = *cp;
    }
    return name;
}



Static void makekeyword(name)
char *name;
{
    Symbol *sym;

    if (*name) {
        sym = findsymbol(name);
        sym->flags |= AVOIDNAME;
    }
}


Static void makeglobword(name)
char *name;
{
    Symbol *sym;

    if (*name) {
        sym = findsymbol(name);
        sym->flags |= AVOIDGLOB;
    }
}



Static void makekeywords()
{
    makekeyword("auto");
    makekeyword("break");
    makekeyword("char");
    makekeyword("continue");
    makekeyword("default");
    makekeyword("defined");   /* is this one really necessary? */
    makekeyword("double");
    makekeyword("enum");
    makekeyword("extern");
    makekeyword("float");
    makekeyword("int");
    makekeyword("long");
    makekeyword("noalias");
    makekeyword("register");
    makekeyword("return");
    makekeyword("short");
    makekeyword("signed");
    makekeyword("sizeof");
    makekeyword("static");
    makekeyword("struct");
    makekeyword("switch");
    makekeyword("typedef");
    makekeyword("union");
    makekeyword("unsigned");
    makekeyword("void");
    makekeyword("volatile");
    makekeyword("asm");
    makekeyword("fortran");
    makekeyword("entry");
    makekeyword("pascal");
    if (cplus != 0) {
      makekeyword("catch");
        makekeyword("class");
        makekeyword("delete");
        makekeyword("friend");
        makekeyword("inline");
        makekeyword("new");
        makekeyword("operator");
        makekeyword("overload");
        makekeyword("private");
        makekeyword("protected");
        makekeyword("public");
        makekeyword("template");
        makekeyword("this");
        makekeyword("throw");
        makekeyword("try");
        makekeyword("virtual");
    }
    makekeyword(name_UCHAR);
    makekeyword(name_SCHAR);    /* any others? */
    makekeyword(name_BOOLEAN);
    makekeyword(name_PROCEDURE);
    makekeyword(name_ESCAPE);
    makekeyword(name_ESCIO);
    makekeyword(name_CHKIO);
    makekeyword(name_SETIO);
    makeglobword("main");
    makeglobword("vextern");     /* used in generated .h files */
    makeglobword("argc");
    makeglobword("argv");
    makekeyword("TRY");
    makekeyword("RECOVER");
    makekeyword("RECOVER2");
    makekeyword("ENDTRY");
}



Static Symbol *Pkeyword(name, tok)
char *name;
Token tok;
{
    Symbol *sp = NULL;

    if (pascalcasesens != 2) {
      sp = findsymbol(strlower(name));
      sp->kwtok = tok;
    }
    if (pascalcasesens != 3) {
      sp = findsymbol(strupper(name));
      sp->kwtok = tok;
    }
    return sp;
}


Static Symbol *Pkeywordposs(name, tok)
char *name;
Token tok;
{
    Symbol *sp = NULL;

    if (pascalcasesens != 2) {
      sp = findsymbol(strlower(name));
      sp->kwtok = tok;
      sp->flags |= KWPOSS;
    }
    if (pascalcasesens != 3) {
      sp = findsymbol(strupper(name));
      sp->kwtok = tok;
      sp->flags |= KWPOSS;
    }
    return sp;
}


Static void makePascalwords()
{
    if (which_lang == LANG_TIP)
      Pkeyword("ACCESS", TOK_ACCESS);
    Pkeyword("AND", TOK_AND);
    Pkeyword("ARRAY", TOK_ARRAY);
    Pkeywordposs("ANYVAR", TOK_ANYVAR);
    Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
    Pkeyword("BEGIN", TOK_BEGIN);
    Pkeywordposs("BY", TOK_BY);
    Pkeyword("CASE", TOK_CASE);
    if (which_lang == LANG_TIP)
      Pkeyword("COMMON", TOK_COMMON);
    Pkeyword("CONST", TOK_CONST);
    Pkeywordposs("CONSTRUCTOR", TOK_CONSTRUCTOR);
    Pkeywordposs("DESTRUCTOR", TOK_DESTRUCTOR);
    Pkeyword("DIV", TOK_DIV);
    Pkeywordposs("DEFINITION", TOK_DEFINITION);
    Pkeyword("DO", TOK_DO);
    Pkeyword("DOWNTO", TOK_DOWNTO);
    Pkeyword("ELSE", TOK_ELSE);
    Pkeywordposs("ELSIF", TOK_ELSIF);
    Pkeyword("END", TOK_END);
    Pkeywordposs("EXPORT", TOK_EXPORT);
    Pkeyword("FILE", TOK_FILE);
    Pkeyword("FOR", TOK_FOR);
    Pkeywordposs("FROM", TOK_FROM);
    Pkeyword("FUNCTION", TOK_FUNCTION);
    Pkeyword("GOTO", TOK_GOTO);
    Pkeyword("IF", TOK_IF);
    Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
    Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
    Pkeywordposs("IMPORT", TOK_IMPORT);
    Pkeyword("IN", TOK_IN);
    Pkeywordposs("INHERITED", TOK_INHERITED);
    Pkeywordposs("INLINE", TOK_INLINE);
    Pkeywordposs("INTERFACE", TOK_EXPORT);
    Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
    Pkeyword("LABEL", TOK_LABEL);
    Pkeywordposs("LOOP", TOK_LOOP);
    Pkeyword("MOD", TOK_MOD);
    Pkeywordposs("MODULE", TOK_MODULE);
    Pkeyword("NIL", TOK_NIL);
    Pkeyword("NOT", TOK_NOT);
    Pkeywordposs("OBJECT", TOK_OBJECT);
    Pkeyword("OF", TOK_OF);
    Pkeyword("OR", TOK_OR);
    Pkeywordposs("ORIGIN", TOK_ORIGIN);
    Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
    Pkeywordposs("OVERLAY", TOK_SEGMENT);
    Pkeywordposs("OVERRIDE", TOK_OVERRIDE);
    Pkeyword("PACKED", TOK_PACKED);
    Pkeywordposs("POINTER", TOK_POINTER);
    Pkeywordposs("PRIVATE", TOK_PRIVATE);
    Pkeyword("PROCEDURE", TOK_PROCEDURE);
    Pkeyword("PROGRAM", TOK_PROGRAM);
    Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
    Pkeywordposs("RANDOM", TOK_RANDOM);
    Pkeyword("RECORD", TOK_RECORD);
    Pkeywordposs("RECOVER", TOK_RECOVER);
    Pkeywordposs("REM", TOK_REM);
    Pkeyword("REPEAT", TOK_REPEAT);
    Pkeywordposs("RETURN", TOK_RETURN);
    if (which_lang == LANG_UCSD)
      Pkeyword("SEGMENT", TOK_SEGMENT);
    else
      Pkeywordposs("SEGMENT", TOK_SEGMENT);
    Pkeyword("SET", TOK_SET);
    Pkeywordposs("SHL", TOK_SHL);
    Pkeywordposs("SHR", TOK_SHR);
    Pkeyword("THEN", TOK_THEN);
    Pkeyword("TO", TOK_TO);
    Pkeywordposs("TRY", TOK_TRY);
    Pkeyword("TYPE", TOK_TYPE);
    Pkeyword("UNTIL", TOK_UNTIL);
    Pkeywordposs("USES", TOK_IMPORT);
    Pkeywordposs("UNIT", TOK_MODULE);
    if (which_lang == LANG_VAX)
      Pkeyword("VALUE", TOK_VALUE);
    else
      Pkeywordposs("VALUE", TOK_VALUE);
    Pkeyword("VAR", TOK_VAR);
    Pkeywordposs("VARYING", TOK_VARYING);
    Pkeywordposs("VIRTUAL", TOK_VIRTUAL);
    Pkeyword("WHILE", TOK_WHILE);
    Pkeyword("WITH", TOK_WITH);
    Pkeywordposs("XOR", TOK_XOR);
    Pkeyword("__MODULE", TOK_MODULE);
    Pkeyword("__IMPORT", TOK_IMPORT);
    Pkeyword("__EXPORT", TOK_EXPORT);
    Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
}



Static void deterministic(name)
char *name;
{
    Symbol *sym;

    if (*name) {
        sym = findsymbol(name);
        sym->flags |= DETERMF;
    }
}


Static void nosideeff(name)
char *name;
{
    Symbol *sym;

    if (*name) {
        sym = findsymbol(name);
        sym->flags |= NOSIDEEFF;
    }
}



Static void recordsideeffects()
{
    deterministic("abs");
    deterministic("acos");
    deterministic("asin");
    deterministic("atan");
    deterministic("atan2");
    deterministic("atof");
    deterministic("atoi");
    deterministic("atol");
    deterministic("ceil");
    deterministic("cos");
    deterministic("cosh");
    deterministic("exp");
    deterministic("fabs");
    deterministic("feof");
    deterministic("feoln");
    deterministic("ferror");
    deterministic("floor");
    deterministic("fmod");
    deterministic("ftell");
    deterministic("isalnum");
    deterministic("isalpha");
    deterministic("isdigit");
    deterministic("islower");
    deterministic("isspace");
    deterministic("isupper");
    deterministic("labs");
    deterministic("ldexp");
    deterministic("log");
    deterministic("log10");
    deterministic("memcmp");
    deterministic("memchr");
    deterministic("pow");
    deterministic("sin");
    deterministic("sinh");
    deterministic("sqrt");
    deterministic("strchr");
    deterministic("strcmp");
    deterministic("strcspn");
    deterministic("strlen");
    deterministic("strncmp");
    deterministic("strpbrk");
    deterministic("strrchr");
    deterministic("strspn");
    deterministic("strstr");
    deterministic("tan");
    deterministic("tanh");
    deterministic("tolower");
    deterministic("toupper");
    deterministic(setequalname);
    deterministic(subsetname);
    deterministic(signextname);
}





void init_lex()
{
    int i;

    inputkind = INP_FILE;
    inf_lnum = 0;
    inf_ltotal = 0;
    *inbuf = 0;
    inbufptr = inbuf;
    keepingstrlist = NULL;
    tempoptionlist = NULL;
    switch_strpos = 0;
    dollar_flag = 0;
    if_flag = 0;
    if_skip = 0;
    commenting_flag = 0;
    skipflag = 0;
    inbufindent = 0;
    modulenotation = 1;
    notephase = 0;
    endnotelist = NULL;
    for (i = 0; i < SYMHASHSIZE; i++)
        symtab[i] = 0;
    C_lex = 0;
    lex_initialized = 0;
}


void setup_lex()
{
    lex_initialized = 1;
    if (!strcmp(language, "MODCAL"))
        sysprog_flag = 2;
    else
        sysprog_flag = 0;
    if (shortcircuit < 0)
        partial_eval_flag = (which_lang == LANG_TURBO ||
                       which_lang == LANG_VAX ||
                       which_lang == LANG_OREGON ||
                       which_lang == LANG_TIP ||
                       modula2 ||
                       hpux_lang);
    else
        partial_eval_flag = shortcircuit;
    iocheck_flag = 1;
    range_flag = 1;
    ovflcheck_flag = 1;
    stackcheck_flag = 1;
    fixedflag = 0;
    taggedflag = 0;
    withlevel = 0;
    makekeywords();
    makePascalwords();
    recordsideeffects();
    topinput = 0;
    ignore_directives = 0;
    skipping_module = 0;
    blockkind = TOK_END;
    gettok();
}




int checkeatnote(msg)
char *msg;
{
    Strlist *lp;
    char *cp;
    int len;

    for (lp = eatnotes; lp; lp = lp->next) {
      if (!strcmp(lp->s, "1")) {
          echoword("[*]", 0);
          return 1;
      }
      if (!strcmp(lp->s, "0"))
          return 0;
      len = strlen(lp->s);
      cp = msg;
      while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
          cp++;
      if (*cp) {
          cp = lp->s;
          if (*cp != '[')
            cp = format_s("[%s", cp);
          if (cp[strlen(cp)-1] != ']')
            cp = format_s("%s]", cp);
          echoword(cp, 0);
          return 1;
      }
    }
    return 0;
}



void beginerror()
{
    end_source();
    if (showprogress) {
        fprintf(stderr, "\r%60s\r", "");
        clearprogress();
    } else
      echobreak();
}


void counterror()
{
    if (maxerrors > 0) {
      if (--maxerrors == 0) {
          fprintf(outf, "\n/* Translation aborted: Too many errors. */\n");
          fprintf(outf,   "-------------------------------------------\n");
          if (outf != stdout)
            printf("Translation aborted: Too many errors.\n");
          if (verbose)
            fprintf(logf, "Translation aborted: Too many errors.\n");
          closelogfile();
          exit_failure();
      }
    }
}


void error(msg)     /* does not return */
char *msg;
{
    flushcomments(NULL, -1, -1);
    beginerror();
    fprintf(outf, "/* %s, line %d: %s */\n", infname, inf_lnum, msg);
    fprintf(outf, "/* Translation aborted. */\n");
    fprintf(outf, "--------------------------\n");
    if (outf != stdout) {
        printf("\"%s\", line %d,%d: %s\n", infname, inf_lnum, outf_lnum, msg);
        printf("Translation aborted.\n");
    }
    if (verbose) {
      fprintf(logf, "%s:%d:%d: %s\n",
            infname, inf_lnum, outf_lnum, msg);
      fprintf(logf, "Translation aborted.\n");
    }
    closelogfile();
    exit_failure();
}


void interror(proc, msg)      /* does not return */
char *proc, *msg;
{
    error(format_ss("Internal error in %s: %s", proc, msg));
}


void warning(msg)
char *msg;
{
    if (checkeatnote(msg)) {
      if (verbose)
          fprintf(logf, "%s:%d:%d: Omitted warning: %s\n",
                infname, inf_lnum, outf_lnum, msg);
      return;
    }
    beginerror();
    addnote(format_s("Warning: %s", msg), curserial);
    counterror();
}


void intwarning(proc, msg)
char *proc, *msg;
{
    if (checkeatnote(msg)) {
      if (verbose)
          fprintf(logf, "%s:%d:%d: Omitted internal error in %s: %s\n",
                infname, inf_lnum, outf_lnum, proc, msg);
      return;
    }
    beginerror();
    addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
    if (error_crash)
        exit_failure();
    counterror();
}




void note(msg)
char *msg;
{
    if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
      if (verbose)
          fprintf(logf, "%s:%d:%d: Omitted note: %s\n",
                infname, inf_lnum, outf_lnum, msg);
      return;
    }
    beginerror();
    addnote(format_s("Note: %s", msg), curserial);
    counterror();
}



void endnote(msg)
char *msg;
{
    if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
      if (verbose)
          fprintf(logf, "%s:%d:%d: Omitted end-note: %s\n",
                infname, inf_lnum, outf_lnum, msg);
      return;
    }
    if (verbose)
      fprintf(logf, "%s:%d:%d: Recorded end-note: %s\n",
            infname, inf_lnum, outf_lnum, msg);
    (void) strlist_add(&endnotelist, msg);
}


void showendnotes()
{
    while (initialcalls) {
      if (initialcalls->value)
          endnote(format_s("Remember to call %s in main program [215]",
                       initialcalls->s));
      strlist_eat(&initialcalls);
    }
    if (endnotelist) {
      end_source();
      while (endnotelist) {
          if (!quietmode) {
            if (outf != stdout) {
                beginerror();
                printf("Note: %s\n", endnotelist->s);
            } else
                fprintf(stderr, "Note: %s\n", endnotelist->s);
          }
          if (slashslash)
            fprintf(outf, "// p2c: Note: %s\n", endnotelist->s);
          else
            fprintf(outf, "/* p2c: Note: %s */\n", endnotelist->s);
          outf_lnum++;
          strlist_eat(&endnotelist);
      }
    }
}







char *tok_name(tok)
Token tok;
{
    if (tok == TOK_END && inputkind == INP_STRLIST)
      return "end of macro";
    if (tok == curtok && tok == TOK_IDENT)
        return format_s("'%s'", curtokcase);
    if (!modulenotation) {
        switch (tok) {
            case TOK_MODULE:    return "UNIT";
            case TOK_IMPORT:    return "USES";
            case TOK_EXPORT:    return "INTERFACE";
            case TOK_IMPLEMENT: return "IMPLEMENTATION";
          default:            break;
        }
    }
    return toknames[(int) tok];
}



void expected(msg)
char *msg;
{
    error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
}


void expecttok(tok)
Token tok;
{
    if (curtok != tok)
        expected(tok_name(tok));
}


void needtok(tok)
Token tok;
{
    if (curtok != tok)
        expected(tok_name(tok));
    gettok();
}


int wexpected(msg)
char *msg;
{
    warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
    return 0;
}


int wexpecttok(tok)
Token tok;
{
    if (curtok != tok)
        return wexpected(tok_name(tok));
    else
      return 1;
}


int wneedtok(tok)
Token tok;
{
    if (wexpecttok(tok)) {
      gettok();
      return 1;
    } else
      return 0;
}


void alreadydef(sym)
Symbol *sym;
{
    warning(format_s("Symbol '%s' was already defined [220]", sym->name));
}


void undefsym(sym)
Symbol *sym;
{
    warning(format_s("Symbol '%s' is not defined [221]", sym->name));
}


void symclass(sym)
Symbol *sym;
{
    warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
}


void badtypes()
{
    warning("Type mismatch [223]");
}


void valrange()
{
    warning("Value range error [224]");
}



void skipparens()
{
    Token begintok;

    if (curtok == TOK_LPAR) {
        gettok();
        while (curtok != TOK_RPAR)
            skipparens();
    } else if (curtok == TOK_LBR) {
        gettok();
        while (curtok != TOK_RBR)
            skipparens();
    } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
             curtok == TOK_CASE) {
      begintok = curtok;
        gettok();
        while (curtok != TOK_END)
          if (curtok == TOK_CASE && begintok == TOK_RECORD)
            gettok();
          else
            skipparens();
    }
    gettok();
}


void skiptotoken2(tok1, tok2)
Token tok1, tok2;
{
    while (curtok != tok1 && curtok != tok2 &&
         curtok != TOK_END && curtok != TOK_RPAR &&
         curtok != TOK_RBR && curtok != TOK_EOF)
      skipparens();
}


void skippasttoken2(tok1, tok2)
Token tok1, tok2;
{
    skiptotoken2(tok1, tok2);
    if (curtok == tok1 || curtok == tok2)
      gettok();
}


void skippasttotoken(tok1, tok2)
Token tok1, tok2;
{
    skiptotoken2(tok1, tok2);
    if (curtok == tok1)
      gettok();
}


void skiptotoken(tok)
Token tok;
{
    skiptotoken2(tok, tok);
}


void skippasttoken(tok)
Token tok;
{
    skippasttoken2(tok, tok);
}



int skipopenparen()
{
    if (wneedtok(TOK_LPAR))
      return 1;
    skiptotoken(TOK_SEMI);
    return 0;
}


int skipcloseparen()
{
    if (curtok == TOK_COMMA)
      warning("Too many arguments for built-in routine [225]");
    else
      if (wneedtok(TOK_RPAR))
          return 1;
    skippasttotoken(TOK_RPAR, TOK_SEMI);
    return 0;
}


int skipcomma()
{
    if (curtok == TOK_RPAR)
      warning("Too few arguments for built-in routine [226]");
    else
      if (wneedtok(TOK_COMMA))
          return 1;
    skippasttotoken(TOK_RPAR, TOK_SEMI);
    return 0;
}





char *findaltname(name, num)
char *name;
int num;
{
    char *cp;

    if (num <= 0)
        return name;
    if (num == 1 && *alternatename1)
        return format_s(alternatename1, name);
    if (num == 2 && *alternatename2)
        return format_s(alternatename2, name);
    if (*alternatename)
        return format_sd(alternatename, name, num);
    cp = name;
    if (*alternatename1) {
        while (--num >= 0)
          cp = format_s(alternatename1, cp);
    } else {
      while (--num >= 0)
          cp = format_s("%s_", cp);
    }
    return cp;
}



Symbol *findsymbol_opt(name)
char *name;
{
    register int i;
    register unsigned int hash;
    register char *cp;
    register Symbol *sp;

    hash = 0;
    for (cp = name; *cp; cp++)
        hash = hash*3 + *cp;
    sp = symtab[hash % SYMHASHSIZE];
    while (sp && (i = strcmp(sp->name, name)) != 0) {
        if (i < 0)
            sp = sp->left;
        else
            sp = sp->right;
    }
    return sp;
}



Symbol *findsymbol(name)
char *name;
{
    register int i;
    register unsigned int hash;
    register char *cp;
    register Symbol **prev, *sp;

    hash = 0;
    for (cp = name; *cp; cp++)
        hash = hash*3 + *cp;
    prev = symtab + (hash % SYMHASHSIZE);
    while ((sp = *prev) != 0 &&
           (i = strcmp(sp->name, name)) != 0) {
        if (i < 0)
            prev = &(sp->left);
        else
            prev = &(sp->right);
    }
    if (!sp) {
        sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
        sp->mbase = sp->fbase = NULL;
        sp->left = sp->right = NULL;
        strcpy(sp->name, name);
        sp->flags = 0;
      sp->kwtok = TOK_NONE;
        sp->symbolnames = NULL;
        *prev = sp;
    }
    return sp;
}




void clearprogress()
{
    oldinfname = NULL;
}


void progress()
{
    char *ctxname;
    int needrefr;
    static int prevlen;

    if (showprogress) {
        if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
            !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
            ctxname = "";
        else
            ctxname = curctx->name;
        needrefr = (inf_lnum & 15) == 0;
        if (oldinfname != infname || oldctxname != ctxname) {
          if (oldinfname != infname)
            prevlen = 60;
            fprintf(stderr, "\r%*s", prevlen + 2, "");
            oldinfname = infname;
            oldctxname = ctxname;
            needrefr = 1;
        }
        if (needrefr) {
            fprintf(stderr, "\r%5d %s  %s", inf_lnum, infname, ctxname);
          prevlen = 8 + strlen(infname) + strlen(ctxname);
        } else {
            fprintf(stderr, "\r%5d", inf_lnum);
          prevlen = 5;
      }
    }
}



void replacestrings(buf, sl)
char *buf;
Strlist *sl;
{
    Strlist *p = sl;
    while (p) {
      char *cp = buf;
      char first = tolower(p->s[0]);
      char ufirst = toupper(p->s[0]);
      while (*cp) {
          if (*cp == first || *cp == ufirst) {
            char *cp1 = cp;
            char *cp2 = p->s;
            while (*cp2 && toupper(*cp1) == toupper(*cp2))
                cp1++, cp2++;
            if (!*cp2) {
                int diff = strlen((char *)p->value) - strlen(p->s);
                if (diff > 0) {
                  cp1 = cp + strlen(cp);
                  while (cp1 >= cp) {
                      cp1[diff] = *cp1;
                      cp1--;
                  }
                } else if (diff < 0) {
                  while (*cp1) {
                      cp1[diff] = *cp1;
                      cp1++;
                  }
                  cp1[diff] = 0;
                }
                cp2 = (char *)p->value;
                while (*cp2)
                  *cp++ = *cp2++;
            } else
                cp++;
          } else if (*cp == '\'') {
            while (*++cp && *cp != '\'') ;
            if (*cp) cp++;
          } else if (*cp == '"') {
            while (*++cp && *cp != '"') ;
            if (*cp) cp++;
          } else
            cp++;
      }
      p = p->next;
    }
}



void getline()
{
    char *cp, *cp2;

    switch (inputkind) {

        case INP_FILE:
        case INP_INCFILE:
            inf_lnum++;
          inf_ltotal++;
            if (fgets(inbuf, 300, inf)) {
                cp = inbuf + strlen(inbuf);
                if (*inbuf && cp[-1] == '\n')
                    cp[-1] = 0;
            replacestrings(inbuf, replacebefore);
            if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
                cp = inbuf + 2;    /* in case input text came */
                inf_lnum = 0;      /*  from the C preprocessor */
                while (isdigit(*cp))
                  inf_lnum = inf_lnum*10 + (*cp++) - '0';
                inf_lnum--;
                while (isspace(*cp)) cp++;
                if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
                  cp++;
                  infname = stralloc(cp);
                  infname[cp2 - cp] = 0;
                }
                getline();
                return;
            }
            if (copysource && *inbuf) {
                start_source();
                fprintf(outf, "%s\n", inbuf);
            }
                if (keepingstrlist) {
                    strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
                }
                if (showprogress && inf_lnum % showprogress == 0)
                    progress();
            } else {
                if (showprogress)
                    fprintf(stderr, "\n");
                if (inputkind == INP_INCFILE) {
                    pop_input();
                    getline();
                } else
                    strcpy(inbuf, "\001");
            }
            break;

        case INP_STRLIST:
            if (instrlist) {
                strcpy(inbuf, instrlist->s);
                if (instrlist->value)
                    inf_lnum = instrlist->value;
                else
                    inf_lnum++;
                instrlist = instrlist->next;
            } else
                strcpy(inbuf, "\001");
            break;
    }
    inbufptr = inbuf;
    inbufindent = 0;
}




Static void push_input()
{
    struct inprec *inp;

    inp = ALLOC(1, struct inprec, inprecs);
    inp->kind = inputkind;
    inp->fname = infname;
    inp->lnum = inf_lnum;
    inp->filep = inf;
    inp->strlistp = instrlist;
    inp->inbufptr = stralloc(inbufptr);
    inp->curtok = curtok;
    inp->curtoksym = curtoksym;
    inp->curtokmeaning = curtokmeaning;
    inp->curtokbuf = stralloc(curtokbuf);
    inp->curtokcase = stralloc(curtokcase);
    inp->saveblockkind = TOK_NIL;
    inp->next = topinput;
    topinput = inp;
    inbufptr = inbuf + strlen(inbuf);
}



void push_input_file(fp, fname, isinclude)
FILE *fp;
char *fname;
int isinclude;
{
    push_input();
    inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
    inf = fp;
    inf_lnum = 0;
    infname = fname;
    *inbuf = 0;
    inbufptr = inbuf;
    topinput->tempopts = tempoptionlist;
    tempoptionlist = NULL;
    if (isinclude != 2)
        gettok();
}


void include_as_import()
{
    if (inputkind == INP_INCFILE) {
      if (topinput->saveblockkind == TOK_NIL)
          topinput->saveblockkind = blockkind;
      blockkind = TOK_IMPORT;
    } else
      warning(format_s("%s ignored except in include files [228]",
                   interfacecomment));
}


void push_input_strlist(sp, fname)
Strlist *sp;
char *fname;
{
    push_input();
    inputkind = INP_STRLIST;
    instrlist = sp;
    if (fname) {
        infname = fname;
        inf_lnum = 0;
    } else
        inf_lnum--;     /* adjust for extra getline() */
    *inbuf = 0;
    inbufptr = inbuf;
    gettok();
}



void pop_input()
{
    struct inprec *inp;

    if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
      while (tempoptionlist) {
          undooption(tempoptionlist->value, tempoptionlist->s);
          strlist_eat(&tempoptionlist);
      }
      tempoptionlist = topinput->tempopts;
      if (inf)
          fclose(inf);
    }
    inp = topinput;
    topinput = inp->next;
    if (inp->saveblockkind != TOK_NIL)
      blockkind = inp->saveblockkind;
    inputkind = inp->kind;
    infname = inp->fname;
    inf_lnum = inp->lnum;
    inf = inp->filep;
    curtok = inp->curtok;
    curtoksym = inp->curtoksym;
    curtokmeaning = inp->curtokmeaning;
    strcpy(curtokbuf, inp->curtokbuf);
    FREE(inp->curtokbuf);
    strcpy(curtokcase, inp->curtokcase);
    FREE(inp->curtokcase);
    strcpy(inbuf, inp->inbufptr);
    FREE(inp->inbufptr);
    inbufptr = inbuf;
    instrlist = inp->strlistp;
    FREE(inp);
}




int undooption(i, name)
int i;
char *name;
{
    char kind = rctable[i].kind;

    switch (kind) {

        case 'S':
      case 'B':
          if (rcprevvalues[i]) {
                *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
                strlist_eat(&rcprevvalues[i]);
                return 1;
            }
            break;

        case 'I':
        case 'D':
            if (rcprevvalues[i]) {
                *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
                strlist_eat(&rcprevvalues[i]);
                return 1;
            }
            break;

        case 'L':
            if (rcprevvalues[i]) {
                *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
                strlist_eat(&rcprevvalues[i]);
                return 1;
            }
            break;

      case 'R':
          if (rcprevvalues[i]) {
            *((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
            strlist_eat(&rcprevvalues[i]);
            return 1;
          }
          break;

        case 'C':
        case 'U':
            if (rcprevvalues[i]) {
                strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
                strlist_eat(&rcprevvalues[i]);
                return 1;
            }
            break;

        case 'A':
            strlist_remove((Strlist **)rctable[i].ptr, name);
            return 1;

        case 'X':
            if (rctable[i].def == 1 || rctable[i].def == 4) {
                strlist_remove((Strlist **)rctable[i].ptr, name);
                return 1;
            }
            break;

    }
    return 0;
}




void badinclude()
{
    warning("Can't handle an \"include\" directive here [229]");
    inputkind = INP_INCFILE;     /* expand it in-line */
    gettok();
}



int handle_include(fn)
char *fn;
{
    FILE *fp = NULL;
    Strlist *sl;

    for (sl = includedirs; sl; sl = sl->next) {
      fp = fopen(format_s(sl->s, fn), "r");
      if (fp) {
          fn = stralloc(format_s(sl->s, fn));
          break;
      }
    }
    if (!fp) {
        perror(fn);
        warning(format_s("Could not open include file %s [230]", fn));
        return 0;
    } else {
        if (!quietmode && !showprogress)
          if (outf == stdout)
            fprintf(stderr, "Reading include file \"%s\"\n", fn);
          else
            printf("Reading include file \"%s\"\n", fn);
      if (verbose)
          fprintf(logf, "Reading include file \"%s\"\n", fn);
        if (expandincludes == 0) {
            push_input_file(fp, fn, 2);
            curtok = TOK_INCLUDE;
            strcpy(curtokbuf, fn);
        } else {
            push_input_file(fp, fn, 1);
        }
        return 1;
    }
}



int turbo_directive(closing, after)
char *closing, *after;
{
    char *cp, *cp2;
    int i, result;

    if (!strcincmp(inbufptr, "$double", 7)) {
      cp = inbufptr + 7;
      while (isspace(*cp)) cp++;
      if (cp == closing) {
          inbufptr = after;
          doublereals = 1;
          return 1;
      }
    } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
      cp = inbufptr + 9;
      while (isspace(*cp)) cp++;
      if (cp == closing) {
          inbufptr = after;
          doublereals = 0;
          return 1;
      }
    } else if (!strcincmp(inbufptr, "$no object", 10)) {
      cp = inbufptr + 10;
      while (isspace(*cp)) cp++;
      if (cp == closing) {
          inbufptr = after;
          nullbody = 1;
          return 1;
      }
    } else if (!strcincmp(inbufptr, "$nullbody", 9)) {
      cp = inbufptr + 9;
      while (isspace(*cp)) cp++;
      if (cp == closing) {
          inbufptr = after;
          nullbody = 1;
          return 1;
      }
    }
    switch (inbufptr[2]) {

        case '+':
        case '-':
            result = 1;
            cp = inbufptr + 1;
            for (;;) {
                if (!isalpha(*cp++))
                    return 0;
                if (*cp != '+' && *cp != '-')
                    return 0;
                if (++cp == closing)
                    break;
                if (*cp++ != ',')
                    return 0;
            }
            cp = inbufptr + 1;
            do {
                switch (*cp++) {

                    case 'b':
                    case 'B':
                        if (shortcircuit < 0 && which_lang != LANG_MPW)
                            partial_eval_flag = (*cp == '-');
                        break;

                    case 'i':
                    case 'I':
                        iocheck_flag = (*cp == '+');
                        break;

                    case 'r':
                    case 'R':
                        if (*cp == '+') {
                            if (!range_flag)
                                note("Range checking is ON [216]");
                            range_flag = 1;
                        } else {
                            if (range_flag)
                                note("Range checking is OFF [216]");
                            range_flag = 0;
                        }
                        break;

                    case 's':
                    case 'S':
                        if (*cp == '+') {
                            if (!stackcheck_flag)
                                note("Stack checking is ON [217]");
                            stackcheck_flag = 1;
                        } else {
                            if (stackcheck_flag)
                                note("Stack checking is OFF [217]");
                            stackcheck_flag = 0;
                        }
                        break;

                    default:
                        result = 0;
                        break;
                }
                cp++;
            } while (*cp++ == ',');
            if (result)
                inbufptr = after;
            return result;

      case 'c':
      case 'C':
          if (toupper(inbufptr[1]) == 'S' &&
            (inbufptr[3] == '+' || inbufptr[3] == '-') &&
            inbufptr + 4 == closing) {
            if (shortcircuit < 0)
                partial_eval_flag = (inbufptr[3] == '+');
            inbufptr = after;
            return 1;
          }
          return 0;

        case '=':
          switch (inbufptr[1]) {

              case 'f':
              case 'F':
                goto do_include;

          }
          return 0;

        case ' ':
            switch (inbufptr[1]) {

                case 'i':
                case 'I':
            do_include:
                    if (skipping_module)
                        break;
                    cp = inbufptr + 3;
                    while (isspace(*cp)) cp++;
                    cp2 = cp;
                    i = 0;
                    while (*cp2 && cp2 != closing)
                        i++, cp2++;
                    if (cp2 != closing)
                        return 0;
                    while (isspace(cp[i-1]))
                        if (--i <= 0)
                            return 0;
                    inbufptr = after;
                    cp2 = ALLOC(i + 1, char, strings);
                    strncpy(cp2, cp, i);
                    cp2[i] = 0;
                    if (handle_include(cp2))
                  return 2;
                break;

            case 's':
            case 'S':
                cp = inbufptr + 3;
                outsection(minorspace);
                if (cp == closing) {
                  output("#undef __SEG__\n");
                } else {
                  output("#define __SEG__ ");
                  while (*cp && cp != closing)
                      cp++;
                  if (*cp) {
                      i = *cp;
                      *cp = 0;
                      output(inbufptr + 3);
                      *cp = i;
                  }
                  output("\n");
                }
                outsection(minorspace);
                inbufptr = after;
                return 1;

            }
            return 0;

      case '}':
      case '*':
          if (inbufptr + 2 == closing) {
            switch (inbufptr[1]) {
                
              case 's':
              case 'S':
                outsection(minorspace);
                output("#undef __SEG__\n");
                outsection(minorspace);
                inbufptr = after;
                return 1;

            }
          }
          return 0;

        case 'f':   /* $ifdef etc. */
        case 'F':
            if (toupper(inbufptr[1]) == 'I' &&
                ((toupper(inbufptr[3]) == 'O' &&
                  toupper(inbufptr[4]) == 'P' &&
                  toupper(inbufptr[5]) == 'T') ||
                 (toupper(inbufptr[3]) == 'D' &&
                  toupper(inbufptr[4]) == 'E' &&
                  toupper(inbufptr[5]) == 'F') ||
                 (toupper(inbufptr[3]) == 'N' &&
                  toupper(inbufptr[4]) == 'D' &&
                  toupper(inbufptr[5]) == 'E' &&
                  toupper(inbufptr[6]) == 'F'))) {
                note("Turbo Pascal conditional compilation directive was ignored [218]");
            }
            return 0;

    }
    return 0;
}




extern Strlist *addmacros;

void defmacro(name, kind, fname, lnum)
char *name, *fname;
long kind;
int lnum;
{
    Strlist *defsl, *sl, *sl2;
    Symbol *sym, *sym2;
    Meaning *mp;
    Expr *ex;

    defsl = NULL;
    sl = strlist_append(&defsl, name);
    C_lex++;
    if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
        fname = curtoksym->name;
    push_input_strlist(defsl, fname);
    if (fname)
        inf_lnum = lnum;
    switch (kind) {

        case MAC_VAR:
            if (!wexpecttok(TOK_IDENT))
            break;
          for (mp = curtoksym->mbase; mp; mp = mp->snext) {
            if (mp->kind == MK_VAR)
                warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
          }
            sl = strlist_append(&varmacros, curtoksym->name);
            gettok();
            if (!wneedtok(TOK_EQ))
            break;
            sl->value = (long)pc_expr();
            break;

        case MAC_CONST:
            if (!wexpecttok(TOK_IDENT))
            break;
          for (mp = curtoksym->mbase; mp; mp = mp->snext) {
            if (mp->kind == MK_CONST)
                warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
          }
            sl = strlist_append(&constmacros, curtoksym->name);
            gettok();
            if (!wneedtok(TOK_EQ))
            break;
            sl->value = (long)pc_expr();
            break;

        case MAC_FIELD:
            if (!wexpecttok(TOK_IDENT))
            break;
            sym = curtoksym;
            gettok();
            if (!wneedtok(TOK_DOT))
            break;
            if (!wexpecttok(TOK_IDENT))
            break;
          sym2 = curtoksym;
            gettok();
          if (!wneedtok(TOK_EQ))
            break;
            funcmacroargs = NULL;
            sym->flags |= FMACREC;
            ex = pc_expr();
            sym->flags &= ~FMACREC;
          for (mp = sym2->fbase; mp; mp = mp->snext) {
            if (mp->rectype && mp->rectype->meaning &&
                mp->rectype->meaning->sym == sym)
                break;
          }
          if (mp) {
            mp->constdefn = ex;
          } else {
            sl = strlist_append(&fieldmacros, 
                            format_ss("%s.%s", sym->name, sym2->name));
            sl->value = (long)ex;
          }
            break;

        case MAC_FUNC:
            if (!wexpecttok(TOK_IDENT))
            break;
            sym = curtoksym;
            gettok();
            funcmacroargs = NULL;
            if (curtok == TOK_LPAR) {
                do {
                    gettok();
                if (curtok == TOK_RPAR && !funcmacroargs)
                  break;
                    if (!wexpecttok(TOK_IDENT)) {
                  skiptotoken2(TOK_COMMA, TOK_RPAR);
                  continue;
                }
                    sl2 = strlist_append(&funcmacroargs, curtoksym->name);
                    sl2->value = (long)curtoksym;
                    curtoksym->flags |= FMACREC;
                    gettok();
                } while (curtok == TOK_COMMA);
                if (!wneedtok(TOK_RPAR))
                skippasttotoken(TOK_RPAR, TOK_EQ);
            }
            if (!wneedtok(TOK_EQ))
            break;
          ex = pc_expr();
          for (;;) {
            if (sym->mbase &&
                (sym->mbase->kind == MK_FUNCTION ||
                 sym->mbase->kind == MK_SPECIAL)) {
                sym->mbase->constdefn = ex;
            } else {
                sl = strlist_append(&funcmacros, sym->name);
                sl->value = (long)ex;
            }
            if (!strcmp(sym->name, "NEW") || !strcmp(sym->name, "DEC") ||
                !strcmp(sym->name, "STR") || !strcmp(sym->name, "VAL") ||
                !strcmp(sym->name, "BLOCKREAD") ||
                !strcmp(sym->name, "BLOCKWRITE"))
                sym = findsymbol(format_s("%s_TURBO", sym->name));
            else
                break;
          }
            for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
                sym2 = (Symbol *)sl2->value;
                sym2->flags &= ~FMACREC;
            }
            strlist_empty(&funcmacroargs);
            break;

    }
    if (curtok != TOK_EOF)
        warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
    pop_input();
    C_lex--;
    strlist_empty(&defsl);
}



void check_unused_macros()
{
    Strlist *sl;

    if (warnmacros) {
        for (sl = varmacros; sl; sl = sl->next)
            warning(format_s("VarMacro %s was never used [234]", sl->s));
        for (sl = constmacros; sl; sl = sl->next)
            warning(format_s("ConstMacro %s was never used [234]", sl->s));
        for (sl = fieldmacros; sl; sl = sl->next)
            warning(format_s("FieldMacro %s was never used [234]", sl->s));
        for (sl = funcmacros; sl; sl = sl->next)
            warning(format_s("FuncMacro %s was never used [234]", sl->s));
    }
}





#define skipspc(cp)   while (isspace(*cp)) cp++

Static int parsecomment(p2c_only, starparen)
int p2c_only, starparen;
{
    char namebuf[302];
    char *cp, *cp2 = namebuf, *closing, *after;
    char kind, chgmode, upcflag;
    long val, oldval, sign;
    double dval;
    int i, tempopt, hassign;
    Strlist *sp;
    Symbol *sym;

    if (if_flag)
        return 0;
    if (!p2c_only) {
        if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
           *noskipcomment) {
            inbufptr += strlen(noskipcomment);
          if (skipflag < 0) {
            if (skipflag < -1) {
                skipflag++;
            } else {
                curtok = TOK_ENDIF;
                skipflag = 1;
                return 2;
            }
          } else {
            skipflag = 1;
            return 1;
          }
        }
    }
    closing = inbufptr;
    while (*closing && (starparen
                  ? (closing[0] != '*' || closing[1] != ')')
                  : (closing[0] != '}')))
      closing++;
    if (!*closing)
      return 0;
    after = closing + (starparen ? 2 : 1);
    cp = inbufptr;
    while (cp < closing && (*cp != '#' || cp[1] != '#'))
      cp++;    /* Ignore comments */
    if (cp < closing) {
      while (isspace(cp[-1]))
          cp--;
      *cp = '#';   /* avoid skipping spaces past closing! */
      closing = cp;
    }
    if (!p2c_only) {
        if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
           closing == inbufptr + 12) {
            wrapup();
            inbufptr = after;
            return 1;
        }
        if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
           *fixedcomment &&
           inbufptr + strlen(fixedcomment) == closing) {
            fixedflag++;
            inbufptr = after;
            return 1;
        }
        if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
           *permanentcomment &&
           inbufptr + strlen(permanentcomment) == closing) {
            permflag = 1;
            inbufptr = after;
            return 1;
        }
        if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
           *interfacecomment &&
           inbufptr + strlen(interfacecomment) == closing) {
            inbufptr = after;
          curtok = TOK_INTFONLY;
            return 2;
        }
        if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
           *skipcomment &&
           inbufptr + strlen(skipcomment) == closing) {
            inbufptr = after;
          skipflag--;
          if (skipflag == -1) {
            skipping_module++;    /* eat comments in skipped portion */
            do {
                gettok();
            } while (curtok != TOK_ENDIF);
            skipping_module--;
          }
            return 1;
        }
      if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
           *signedcomment && !p2c_only &&
           inbufptr + strlen(signedcomment) == closing) {
          inbufptr = after;
          gettok();
          if (curtok == TOK_IDENT && curtokmeaning &&
            curtokmeaning->kind == MK_TYPE &&
            curtokmeaning->type == tp_char) {
            curtokmeaning = mp_schar;
          } else
            warning("{SIGNED} applied to type other than CHAR [314]");
          return 2;
      }
      if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
           *unsignedcomment && !p2c_only &&
           inbufptr + strlen(unsignedcomment) == closing) {
          inbufptr = after;
          gettok();
          if (curtok == TOK_IDENT && curtokmeaning &&
            curtokmeaning->kind == MK_TYPE &&
            curtokmeaning->type == tp_char) {
            curtokmeaning = mp_uchar;
          } else if (curtok == TOK_IDENT && curtokmeaning &&
                   curtokmeaning->kind == MK_TYPE &&
                   curtokmeaning->type == tp_integer) {
            curtokmeaning = mp_unsigned;
          } else if (curtok == TOK_IDENT && curtokmeaning &&
                   curtokmeaning->kind == MK_TYPE &&
                   curtokmeaning->type == tp_int) {
            curtokmeaning = mp_uint;
          } else
            warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
          return 2;
      }
      if (!strncmp(inbufptr, tagcomment, strlen(tagcomment)) &&
           *tagcomment &&
           inbufptr + strlen(tagcomment) == closing) {
          taggedflag++;
          inbufptr = after;
          return 1;
      }
        if (*inbufptr == '$') {
            i = turbo_directive(closing, after);
            if (i)
                return i;
        }
    }
    tempopt = 0;
    cp = inbufptr;
    if (*cp == '*') {
        cp++;
        tempopt = 1;
    }
    if (!isalpha(*cp))
        return 0;
    while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
        *cp2++ = toupper(*cp++);
    if (cp[0] == '+' && cp[1] == '+' &&
      cp == inbufptr+1 && toupper(cp[-1]) == 'C')
      *cp2++ = *cp++, *cp2++ = *cp++;
    *cp2 = 0;
    i = numparams;
    while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
    if (i < 0)
        return 0;
    kind = rctable[i].kind;
    chgmode = rctable[i].chgmode;
    if (chgmode == ' ')    /* allowed in p2crc only */
        return 0;
    if (chgmode == 'T' && lex_initialized) {
        if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
            warning(format_s("%s works only at top of program [235]",
                             rctable[i].name));
    }
    if (cp == closing) {
        if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
          kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
            undooption(i, "");
            inbufptr = after;
            return 1;
        }
    }
    switch (kind) {

        case 'S':
        case 'I':
        case 'L':
            val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
                           (kind == 'S') ? *((short *)rctable[i].ptr) :
                                           *((  int *)rctable[i].ptr);
            switch (*cp) {

                case '=':
                    skipspc(cp);
                hassign = (*++cp == '-' || *cp == '+');
                    sign = (*cp == '-') ? -1 : 1;
                cp += hassign;
                    if (isdigit(*cp)) {
                        val = 0;
                        while (isdigit(*cp))
                            val = val * 10 + (*cp++) - '0';
                        val *= sign;
                  if (kind == 'D' && !hassign)
                      val += 10000;
                    } else if (toupper(cp[0]) == 'D' &&
                               toupper(cp[1]) == 'E' &&
                               toupper(cp[2]) == 'F') {
                        val = rctable[i].def;
                        cp += 3;
                    }
                    break;

                case '+':
                case '-':
                    if (chgmode != 'R')
                        return 0;
                    for (;;) {
                        if (*cp == '+')
                            val++;
                        else if (*cp == '-')
                            val--;
                        else
                            break;
                        cp++;
                    }
                    break;

            }
            skipspc(cp);
            if (cp != closing)
                return 0;
            strlist_insert(&rcprevvalues[i], "")->value = oldval;
            if (tempopt)
                strlist_insert(&tempoptionlist, "")->value = i;
            if (kind == 'L')
                *((long *)rctable[i].ptr) = val;
            else if (kind == 'S')
                *((short *)rctable[i].ptr) = val;
            else
                *((int *)rctable[i].ptr) = val;
            inbufptr = after;
            return 1;

      case 'D':
            val = oldval = *((int *)rctable[i].ptr);
          if (*cp++ != '=')
            return 0;
          skipspc(cp);
          if (toupper(cp[0]) == 'D' &&
            toupper(cp[1]) == 'E' &&
            toupper(cp[2]) == 'F') {
            val = rctable[i].def;
            cp += 3;
          } else {
                cp2 = namebuf;
                while (*cp && cp != closing && !isspace(*cp))
                    *cp2++ = *cp++;
            *cp2 = 0;
            val = parsedelta(namebuf, -1);
            if (!val)
                return 0;
          }
          skipspc(cp);
            if (cp != closing)
                return 0;
            strlist_insert(&rcprevvalues[i], "")->value = oldval;
            if (tempopt)
                strlist_insert(&tempoptionlist, "")->value = i;
            *((int *)rctable[i].ptr) = val;
            inbufptr = after;
            return 1;

        case 'R':
          if (*cp++ != '=')
            return 0;
          skipspc(cp);
          if (toupper(cp[0]) == 'D' &&
            toupper(cp[1]) == 'E' &&
            toupper(cp[2]) == 'F') {
            dval = rctable[i].def / 100.0;
            cp += 3;
          } else {
            cp2 = cp;
            while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
                   *cp == '.' || toupper(*cp) == 'E')
                cp++;
            if (cp == cp2)
                return 0;
            dval = atof(cp2);
          }
          skipspc(cp);
          if (cp != closing)
            return 0;
          sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
            strlist_insert(&rcprevvalues[i], namebuf);
            if (tempopt)
                strlist_insert(&tempoptionlist, namebuf)->value = i;
          *((double *)rctable[i].ptr) = dval;
            inbufptr = after;
            return 1;

        case 'B':
          if (*cp++ != '=')
            return 0;
          skipspc(cp);
          if (toupper(cp[0]) == 'D' &&
            toupper(cp[1]) == 'E' &&
            toupper(cp[2]) == 'F') {
            val = rctable[i].def;
            cp += 3;
          } else {
            val = parse_breakstr(cp);
            while (*cp && cp != closing && !isspace(*cp))
                cp++;
          }
          skipspc(cp);
          if (cp != closing || val == -1)
            return 0;
            strlist_insert(&rcprevvalues[i], "")->value =
            *((short *)rctable[i].ptr);
            if (tempopt)
                strlist_insert(&tempoptionlist, "")->value = i;
          *((short *)rctable[i].ptr) = val;
            inbufptr = after;
            return 1;

        case 'C':
        case 'U':
            if (*cp == '=') {
                cp++;
                skipspc(cp);
                for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
                    if (!*cp2 || cp2-cp >= rctable[i].def)
                        return 0;
                cp2 = (char *)rctable[i].ptr;
                sp = strlist_insert(&rcprevvalues[i], cp2);
                if (tempopt)
                    strlist_insert(&tempoptionlist, "")->value = i;
                while (cp != closing && !isspace(*cp2))
                    *cp2++ = *cp++;
                *cp2 = 0;
                if (kind == 'U')
                    upc((char *)rctable[i].ptr);
                skipspc(cp);
                if (cp != closing)
                    return 0;
                inbufptr = after;
                if (!strcmp(rctable[i].name, "LANGUAGE") &&
                    !strcmp((char *)rctable[i].ptr, "MODCAL"))
                    sysprog_flag |= 2;
                return 1;
            }
            return 0;

        case 'F':
        case 'G':
            if (*cp == '=' || *cp == '+' || *cp == '-') {
                upcflag = (kind == 'F' && !pascalcasesens);
                chgmode = *cp++;
                skipspc(cp);
                cp2 = namebuf;
                while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
                    *cp2++ = *cp++;
                *cp2++ = 0;
            if (!*namebuf)
                return 0;
                skipspc(cp);
                if (cp != closing)
                    return 0;
                if (upcflag)
                    upc(namebuf);
                sym = findsymbol(namebuf);
            if (rctable[i].def & FUNCBREAK)
                sym->flags &= ~FUNCBREAK;
                if (chgmode == '-')
                    sym->flags &= ~rctable[i].def;
                else
                    sym->flags |= rctable[i].def;
                inbufptr = after;
                return 1;
           }
           return 0;

        case 'A':
            if (*cp == '=' || *cp == '+' || *cp == '-') {
                chgmode = *cp++;
                skipspc(cp);
                cp2 = namebuf;
                while (cp != closing && !isspace(*cp) && *cp)
                    *cp2++ = *cp++;
                *cp2++ = 0;
                skipspc(cp);
                if (cp != closing)
                    return 0;
                if (chgmode != '+')
                    strlist_remove((Strlist **)rctable[i].ptr, namebuf);
                if (chgmode != '-')
                    sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
                if (tempopt)
                    strlist_insert(&tempoptionlist, namebuf)->value = i;
                inbufptr = after;
                return 1;
            }
            return 0;

        case 'M':
            if (!isspace(*cp))
                return 0;
            skipspc(cp);
            if (!isalpha(*cp))
                return 0;
            for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
            if (cp2 > cp && cp2 == closing) {
                inbufptr = after;
                cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
                if (tp_integer != NULL) {
                    defmacro(cp2, rctable[i].def, NULL, 0);
                } else {
                    sp = strlist_append(&addmacros, cp2);
                    sp->value = rctable[i].def;
                }
                return 1;
            }
            return 0;

        case 'X':
            switch (rctable[i].def) {

                case 1:     /* strlist with string values */
                case 4:     /* strlist with string values */
                    if (!isspace(*cp) && *cp != '=' && 
                        *cp != '+' && *cp != '-')
                        return 0;
                    chgmode = *cp++;
                    skipspc(cp);
                    cp2 = namebuf;
                if (*cp == '"' && rctable[i].def == 4) {
                  cp++;
                  while (*cp != '"') {
                      if (cp == closing)
                        return 0;
                      if (*cp == 92 && cp+1 < closing)
                        cp++;
                      *cp2++ = *cp++;
                  }
                  cp++;
                } else {
                  while (isalnum(*cp) || *cp == '_' ||
                         *cp == '$' || *cp == '%' ||
                         *cp == '.' || *cp == '-' ||
                         (*cp == '\'' && cp[1] && cp[2] == '\'' &&
                        cp+1 != closing && cp[1] != '=')) {
                      if (*cp == '\'') {
                        *cp2++ = *cp++;
                        *cp2++ = *cp++;
                      }                 
                      *cp2++ = *cp++;
                  }
                }
                    *cp2++ = 0;
                    if (chgmode == '-') {
                        skipspc(cp);
                        if (cp != closing)
                            return 0;
                        strlist_remove((Strlist **)rctable[i].ptr, namebuf);
                    } else {
                        if (!isspace(*cp) && *cp != '=')
                            return 0;
                        skipspc(cp);
                        if (*cp == '=') {
                            cp++;
                            skipspc(cp);
                        }
                        if (chgmode == '=' || isspace(chgmode))
                            strlist_remove((Strlist **)rctable[i].ptr, namebuf);
                        sp = strlist_append((Strlist **)rctable[i].ptr, namebuf);
                        if (tempopt)
                            strlist_insert(&tempoptionlist, namebuf)->value = i;
                        cp2 = namebuf;
                  if (*cp == '"' && rctable[i].def == 4) {
                      cp++;
                      while (*cp != '"') {
                        if (cp == closing)
                            return 0;
                        if (*cp == 92 && cp+1 < closing)
                            cp++;
                        *cp2++ = *cp++;
                      }
                      cp++;
                      skipspc(cp);
                  } else {
                      while (*cp && cp != closing && !isspace(*cp))
                        *cp2++ = *cp++;
                  }
                        *cp2++ = 0;
                        skipspc(cp);
                        if (cp != closing)
                            return 0;
                        sp->value = (long)stralloc(namebuf);
                    }
                    inbufptr = after;
                    if (lex_initialized)
                        handle_nameof();        /* as good a place to do this as any! */
                    return 1;

                case 3:     /* Synonym parameter */
                if (isspace(*cp) || *cp == '=' ||
                  *cp == '+' || *cp == '-') {
                  chgmode = *cp++;
                  skipspc(cp);
                  cp2 = namebuf;
                  while (isalnum(*cp) || *cp == '_' ||
                         *cp == '$' || *cp == '%')
                      *cp2++ = *cp++;
                  *cp2++ = 0;
                  if (!*namebuf)
                      return 0;
                  skipspc(cp);
                  if (!pascalcasesens)
                      upc(namebuf);
                  sym = findsymbol(namebuf);
                  if (chgmode == '-') {
                      if (cp != closing)
                        return 0;
                      sym->flags &= ~SSYNONYM;
                      inbufptr = after;
                      return 1;
                  }
                  if (*cp == '=') {
                      cp++;
                      skipspc(cp);
                  }
                  cp2 = namebuf;
                  while (isalnum(*cp) || *cp == '_' ||
                         *cp == '$' || *cp == '%')
                      *cp2++ = *cp++;
                  *cp2++ = 0;
                  skipspc(cp);
                  if (cp != closing)
                      return 0;
                  sym->flags |= SSYNONYM;
                  if (!pascalcasesens)
                      upc(namebuf);
                  if (*namebuf)
                      strlist_append(&sym->symbolnames, "===")->value =
                        (long)findsymbol(namebuf);
                  else
                      strlist_append(&sym->symbolnames, "===")->value=0;
                  inbufptr = after;
                  return 1;
                }
                return 0;

            }
            return 0;

    }
    return 0;
}



Static void comment(starparen)
int starparen;    /* 0={ }, 1=(* *), 2=C comments, 3=" " */
{
    register char ch;
    int nestcount = 1, startlnum = inf_lnum, wasrel = 0, trailing;
    int i, cmtindent, cmtindent2, saveeat = eatcomments;
    char *cp;

    if (!strncmp(inbufptr, embedcomment, strlen(embedcomment)) &&
      *embedcomment)
      eatcomments = 0;
    cp = inbuf;
    while (isspace(*cp))
      cp++;
    trailing = (*cp != '{' && ((*cp != '(' && *cp != '/') || cp[1] != '*') &&
            (*cp != '"' || starparen != 3));
    cmtindent = inbufindent;
    cmtindent2 = cmtindent + 1 + (starparen != 0);
    cp = inbufptr;
    while (isspace(*cp))
      cmtindent2++, cp++;
    cp = curtokbuf;
    for (;;) {
        ch = *inbufptr++;
        switch (ch) {

            case '}':
                if ((!starparen || nestedcomments == 0) &&
                starparen < 2 &&
                    --nestcount <= 0) {
                    *cp = 0;
                if (wasrel && !strcmp(curtokbuf, "\003"))
                  *curtokbuf = '\002';
                if (!commenting_flag)
                  commentline(trailing ? CMT_TRAIL : CMT_POST);
                eatcomments = saveeat;
                    return;
                }
                break;

            case '"':
                if (starparen == 3) {
                    *cp = 0;
                if (wasrel && !strcmp(curtokbuf, "\003"))
                  *curtokbuf = '\002';
                if (!commenting_flag)
                  commentline(trailing ? CMT_TRAIL : CMT_POST);
                eatcomments = saveeat;
                    return;
                }
                break;

            case '{':
                if (nestedcomments == 1 && starparen < 2)
                    nestcount++;
                break;

            case '*':
                if (*inbufptr == ((starparen == 2) ? '/' : ')') &&
                starparen < 3 &&
                (starparen || nestedcomments == 0) &&
                    --nestcount <= 0) {
                    inbufptr++;
                    *cp = 0;
                if (wasrel && !strcmp(curtokbuf, "\003"))
                  *curtokbuf = '\002';
                if (!commenting_flag)
                  commentline(trailing ? CMT_TRAIL : CMT_POST);
                eatcomments = saveeat;
                    return;
                }
                break;

            case '(':
                if (*inbufptr == '*' && nestedcomments == 1 &&
                starparen < 2) {
                *cp++ = ch;
                ch = *inbufptr++;
                    nestcount++;
            }
                break;

            case 0:
                *cp = 0;
              if (commenting_flag)
                saveinputcomment(inbufptr-1);
            else
                commentline(CMT_POST);
            trailing = 0;
                getline();
            i = 0;
            for (;;) {
                if (*inbufptr == ' ') {
                  inbufptr++;
                  i++;
                } else if (*inbufptr == '\t') {
                  inbufptr++;
                  i++;
                  if (intabsize)
                      i = (i / intabsize + 1) * intabsize;
                } else
                  break;
            }
            cp = curtokbuf;
            if (*inbufptr) {
                if (i == cmtindent2 && !starparen)
                  cmtindent--;
                cmtindent2 = -1;
                if (i >= cmtindent && i > 0) {
                  *cp++ = '\002';
                  i -= cmtindent;
                  wasrel = 1;
                } else {
                  *cp++ = '\003';
                }
                while (--i >= 0)
                  *cp++ = ' ';
            } else
                *cp++ = (slashslash) ? '\002' : '\003';
                continue;

            case EOFMARK:
                error(format_d("Runaway comment from line %d", startlnum));
            eatcomments = saveeat;
                return;     /* unnecessary */

        }
        *cp++ = ch;
    }
}



char *getinlinepart()
{
    char *cp, *buf;

    for (;;) {
        if (isspace(*inbufptr)) {
            inbufptr++;
        } else if (!*inbufptr) {
            getline();
        } else if (*inbufptr == '{') {
            inbufptr++;
            comment(0);
        } else if (*inbufptr == '(' && inbufptr[1] == '*') {
            inbufptr += 2;
            comment(1);
        } else
            break;
    }
    cp = inbufptr;
    while (isspace(*cp) || isalnum(*cp) ||
           *cp == '_' || *cp == '$' || 
           *cp == '+' || *cp == '-' ||
           *cp == '<' || *cp == '>')
        cp++;
    if (cp == inbufptr)
        return "";
    while (isspace(cp[-1]))
        cp--;
    buf = format_s("%s", inbufptr);
    buf[cp-inbufptr] = 0;     /* truncate the string */
    inbufptr = cp;
    return buf;
}




Static int getflag()
{
    int res = 1;

    gettok();
    if (curtok == TOK_IDENT) {
        res = (strcmp(curtokbuf, "OFF") != 0);
        gettok();
    }
    return res;
}




char getchartok()
{
    if (!*inbufptr) {
        warning("Unexpected end of line [236]");
        return ' ';
    }
    if (isspace(*inbufptr)) {
        warning("Whitespace not allowed here [237]");
        return ' ';
    }
    return *inbufptr++;
}



char *getparenstr(buf)
char *buf;
{
    int count = 0;
    char *cp;

    if (inbufptr < buf)    /* this will get most bad cases */
        error("Can't handle a line break here");
    while (isspace(*buf))
        buf++;
    cp = buf;
    for (;;) {
        if (!*cp)
            error("Can't handle a line break here");
        if (*cp == '(')
            count++;
        if (*cp == ')')
            if (--count < 0)
                break;
        cp++;
    }
    inbufptr = cp + 1;
    while (cp > buf && isspace(cp[-1]))
        cp--;
    return format_ds("%.*s", (int)(cp - buf), buf);
}



void leadingcomments()
{
    for (;;) {
        switch (*inbufptr++) {

            case 0:
                getline();
                break;

            case ' ':
            case '\t':
            case 26:
                /* ignore whitespace */
                break;

            case '{':
                if (!parsecomment(1, 0)) {
                    inbufptr--;
                    return;
                }
                break;

          case '(':
            if (*inbufptr == '*') {
                inbufptr++;
                if (!parsecomment(1, 1)) {
                  inbufptr -= 2;
                  return;
                }
                break;
            }
            /* fall through */

            default:
                inbufptr--;
                return;

        }
    }
}




void get_C_string(term)
int term;
{
    char *cp = curtokbuf;
    char ch;
    int i;

    while ((ch = *inbufptr++)) {
        if (ch == term) {
            *cp = 0;
            curtokint = cp - curtokbuf;
            return;
        } else if (ch == '\\') {
            if (isdigit(*inbufptr)) {
                i = (*inbufptr++) - '0';
                if (isdigit(*inbufptr))
                    i = i*8 + (*inbufptr++) - '0';
                if (isdigit(*inbufptr))
                    i = i*8 + (*inbufptr++) - '0';
                *cp++ = i;
            } else {
                ch = *inbufptr++;
                switch (tolower(ch)) {
                    case 'n':
                        *cp++ = '\n';
                        break;
                    case 't':
                        *cp++ = '\t';
                        break;
                    case 'v':
                        *cp++ = '\v';
                        break;
                    case 'b':
                        *cp++ = '\b';
                        break;
                    case 'r':
                        *cp++ = '\r';
                        break;
                    case 'f':
                        *cp++ = '\f';
                        break;
                    case '\\':
                        *cp++ = '\\';
                        break;
                    case '\'':
                        *cp++ = '\'';
                        break;
                    case '"':
                        *cp++ = '"';
                        break;
                    case 'x':
                        if (isxdigit(*inbufptr)) {
                            if (isdigit(*inbufptr))
                                i = (*inbufptr++) - '0';
                            else
                                i = (toupper(*inbufptr++)) - 'A' + 10;
                            if (isdigit(*inbufptr))
                                i = i*16 + (*inbufptr++) - '0';
                            else if (isxdigit(*inbufptr))
                                i = i*16 + (toupper(*inbufptr++)) - 'A' + 10;
                            *cp++ = i;
                            break;
                        }
                        /* fall through */
                    default:
                        warning("Strange character in C string [238]");
                }
            }
        } else
            *cp++ = ch;
    }
    *cp = 0;
    curtokint = cp - curtokbuf;
    warning("Unterminated C string [239]");
}





void begincommenting(cp)
char *cp;
{
    if (!commenting_flag) {
      commenting_ptr = cp;
    }
    commenting_flag++;
}


void saveinputcomment(cp)
char *cp;
{
    if (commenting_ptr)
      sprintf(curtokbuf, "%.*s", (int)(cp - commenting_ptr), commenting_ptr);
    else
      sprintf(curtokbuf, "\003%.*s", (int)(cp - inbuf), inbuf);
    commentline(CMT_POST);
    commenting_ptr = NULL;
}


void endcommenting(cp)
char *cp;
{
    commenting_flag--;
    if (!commenting_flag) {
      saveinputcomment(cp);
    }
}




char *peeknextptr()
{
    char *cp;

    cp = inbufptr;
    for (;;) {
      if (isspace(*cp)) {
          cp++;
      } else if (*cp == '{') {
          while (*cp && *cp != '}')
            cp++;
          if (*cp)
            cp++;
      } else if (*cp == '(' && cp[1] == '*') {
          cp += 2;
          while (*cp && (*cp != '*' || cp[1] != ')'))
            cp++;
          if (*cp)
            cp += 2;
      } else {
          return cp;
      }
    }
}


int peeknextchar()
{
    char *cp;

    cp = peeknextptr();
    if (*cp == ':')
      if (cp[1] == '=')
          return 1;
      else if (cp[1] == ':')
          return 2;
    return *cp;
}


int peeknextword(word)
char *word;
{
    char *cp;
    int len;

    cp = peeknextptr();
    len = strlen(word);
    if (strcincmp(cp, word, len))
      return 0;
    if (isalnum(cp[len]) || cp[len] == '_')
      return 0;
    return 1;
}




#ifdef LEXDEBUG
Static void zgettok();
void gettok()
{
    zgettok();
    if (tokentrace) {
        printf("gettok() found %s", tok_name(curtok));
        switch (curtok) {
            case TOK_HEXLIT:
            case TOK_OCTLIT:
            case TOK_INTLIT:
            case TOK_MININT:
                printf(", curtokint = %ld", curtokint);
                break;
            case TOK_REALLIT:
            case TOK_STRLIT:
                printf(", curtokbuf = %s", makeCstring(curtokbuf, curtokint));
                break;
          default:
            break;
        }
        putchar('\n');
    }
}
Static void zgettok()
#else
void gettok()
#endif
{
    register char ch;
    register char *cp;
    char ch2;
    char *startcp;
    int i;

    debughook();
    for (;;) {
        switch ((ch = *inbufptr++)) {

            case 0:
              if (commenting_flag)
                saveinputcomment(inbufptr-1);
                getline();
            cp = curtokbuf;
            for (;;) {
                inbufindent = 0;
                for (;;) {
                  if (*inbufptr == '\t') {
                      inbufindent++;
                      if (intabsize)
                        inbufindent = (inbufindent / intabsize + 1) * intabsize;
                  } else if (*inbufptr == ' ')
                      inbufindent++;
                  else if (*inbufptr != 26)
                      break;
                  inbufptr++;
                }
                if (!*inbufptr && !commenting_flag) {   /* blank line */
                  *cp++ = '\001';
                  getline();
                } else
                  break;
            }
            if (cp > curtokbuf) {
                *cp = 0;
                commentline(CMT_POST);
            }
                break;

          case '\f':
            cp = curtokbuf;
            *cp++ = '\001';
            *cp++ = '\014';
            if (!*inbufptr && !commenting_flag) {
                getline();
                while (!*inbufptr) {
                  *cp++ = '\001';
                  getline();
                }
            }
            *cp = 0;
            commentline(CMT_POST);
            break;

            case '\t':
            case ' ':
            case 26:    /* ignore ^Z's in Turbo files */
                while (*inbufptr++ == ch) ;
                inbufptr--;
                break;

            case '$':
            if (dollar_idents)
                goto ident;
                if (dollar_flag) {
                    dollar_flag = 0;
                    curtok = TOK_DOLLAR;
                    return;
            }
            startcp = inbufptr-1;
            while (isspace(*inbufptr))
                inbufptr++;
            cp = inbufptr;
            while (isxdigit(*cp))
                cp++;
            if (cp > inbufptr && cp <= inbufptr+8 && !isalnum(*cp)) {
                while (isspace(*cp))
                  cp++;
                if (!isdigit(*cp) && *cp != '\'') {
                  cp = curtokbuf;    /* Turbo hex constant */
                  while (isxdigit(*inbufptr))
                      *cp++ = *inbufptr++;
                  *cp = 0;
                  curtok = TOK_HEXLIT;
                  curtokint = my_strtol(curtokbuf, NULL, 16);
                  return;
                }
                }
            dollar_flag++;     /* HP Pascal compiler directive */
            do {
                gettok();
                if (curtok == TOK_IF) {             /* $IF expr$ */
                  Expr *ex;
                  Value val;
                  if (!skipping_module) {
                      if (!setup_complete)
                        error("$IF$ not allowed at top of program");

                      /* Even though HP Pascal doesn't let these nest,
                         there's no harm in supporting it. */
                      if (if_flag) {
                        skiptotoken(TOK_DOLLAR);
                        if_flag++;
                        break;
                      }
                      gettok();
                      ex = p_expr(tp_boolean);
                      val = eval_expr_consts(ex);
                      freeexpr(ex);
                      i = (val.type == tp_boolean && val.i);
                      free_value(&val);
                      if (!i) {
                        if (curtok != TOK_DOLLAR) {
                            warning("Syntax error in $IF$ expression [240]");
                            skiptotoken(TOK_DOLLAR);
                        }
                        begincommenting(startcp);
                        if_flag++;
                        while (if_flag > 0)
                            gettok();
                        endcommenting(inbufptr);
                      }
                  } else {
                      skiptotoken(TOK_DOLLAR);
                  }
                } else if (curtok == TOK_END) {     /* $END$ */
                  if (if_flag) {
                      gettok();
                      if (!wexpecttok(TOK_DOLLAR))
                        skiptotoken(TOK_DOLLAR);
                      curtok = TOK_ENDIF;
                      if_flag--;
                      return;
                  } else {
                      gettok();
                      if (!wexpecttok(TOK_DOLLAR))
                        skiptotoken(TOK_DOLLAR);
                  }
                } else if (curtok == TOK_IDENT) {
                  if (!strcmp(curtokbuf, "INCLUDE") &&
                       !if_flag && !skipping_module) {
                      char *fn;
                      gettok();
                      if (curtok == TOK_IDENT) {
                        fn = stralloc(curtokcase);
                        gettok();
                      } else if (wexpecttok(TOK_STRLIT)) {
                        fn = stralloc(curtokbuf);
                        gettok();
                      } else
                        fn = "";
                      if (!wexpecttok(TOK_DOLLAR)) {
                        skiptotoken(TOK_DOLLAR);
                      } else {
                        if (handle_include(fn))
                            return;
                      }
                  } else if (ignore_directives ||
                           if_flag ||
                           !strcmp(curtokbuf, "SEARCH") ||
                           !strcmp(curtokbuf, "REF") ||
                           !strcmp(curtokbuf, "DEF")) {
                      skiptotoken(TOK_DOLLAR);
                  } else if (!strcmp(curtokbuf, "SWITCH_STRPOS")) {
                      switch_strpos = getflag();
                  } else if (!strcmp(curtokbuf, "SYSPROG")) {
                      if (getflag())
                        sysprog_flag |= 1;
                      else
                        sysprog_flag &= ~1;
                  } else if (!strcmp(curtokbuf, "MODCAL")) {
                      if (getflag())
                        sysprog_flag |= 2;
                      else
                        sysprog_flag &= ~2;
                  } else if (!strcmp(curtokbuf, "PARTIAL_EVAL")) {
                      if (shortcircuit < 0)
                        partial_eval_flag = getflag();
                  } else if (!strcmp(curtokbuf, "IOCHECK")) {
                      iocheck_flag = getflag();
                  } else if (!strcmp(curtokbuf, "RANGE")) {
                      if (getflag()) {
                        if (!range_flag)
                            note("Range checking is ON [216]");
                        range_flag = 1;
                      } else {
                        if (range_flag)
                            note("Range checking is OFF [216]");
                        range_flag = 0;
                      }
                  } else if (!strcmp(curtokbuf, "OVFLCHECK")) {
                      if (getflag()) {
                        if (!ovflcheck_flag)
                            note("Overflow checking is ON [219]");
                        ovflcheck_flag = 1;
                      } else {
                        if (ovflcheck_flag)
                            note("Overflow checking is OFF [219]");
                        ovflcheck_flag = 0;
                      }
                  } else if (!strcmp(curtokbuf, "STACKCHECK")) {
                      if (getflag()) {
                        if (!stackcheck_flag)
                            note("Stack checking is ON [217]");
                        stackcheck_flag = 1;
                      } else {
                        if (stackcheck_flag)
                            note("Stack checking is OFF [217]");
                        stackcheck_flag = 0;
                      }
                  }
                  skiptotoken2(TOK_DOLLAR, TOK_COMMA);
                } else {
                  warning("Mismatched '$' signs [241]");
                  dollar_flag = 0;    /* got out of sync */
                  return;
                }
            } while (curtok == TOK_COMMA);
                break;

            case '"':
            if (C_lex) {
                get_C_string(ch);
                curtok = TOK_STRLIT;
                return;
            }
            if (which_lang == LANG_TIP) {
                strcpy(curtokbuf, inbufptr);
                cp = inbuf;
                while (isspace(*cp))
                  cp++;
                if (!commenting_flag)
                  commentline((*cp != '"') ? CMT_TRAIL : CMT_POST);
                inbufptr += strlen(inbufptr);
                    break;
                }
            if (which_lang == LANG_APOLLO) {
                comment(3);
                break;
            }
            goto stringLiteral;

            case '#':
            if (modula2) {
                curtok = TOK_NE;
                return;
            }
            if (which_lang == LANG_TIP) {
                cp = curtokbuf;    /* Turbo hex constant */
                while (isxdigit(*inbufptr))
                  *cp++ = *inbufptr++;
                if (toupper(*inbufptr) == 'L')
                  *cp++ = *inbufptr++;
                *cp = 0;
                curtok = TOK_HEXLIT;
                curtokint = my_strtol(curtokbuf, NULL, 16);
                return;
            }
            cp = inbufptr;
            while (isspace(*cp)) cp++;
            if (!strcincmp(cp, "INCLUDE", 7)) {
                char *cp2, *cp3;
                cp += 7;
                while (isspace(*cp)) cp++;
                cp2 = cp + strlen(cp) - 1;
                while (isspace(*cp2)) cp2--;
                if ((*cp == '"' && *cp2 == '"' && cp2 > cp) ||
                  (*cp == '<' && *cp2 == '>')) {
                  inbufptr = cp2 + 1;
                  cp3 = stralloc(cp + 1);
                  cp3[cp2 - cp - 1] = 0;
                  if (handle_include(cp3))
                      return;
                  else
                      break;
                }
            }
            /* fall through */

            case '\'':
                if (C_lex && ch == '\'') {
                    get_C_string(ch);
                    if (curtokint != 1)
                        warning("Character constant has length != 1 [242]");
                    curtokint = *curtokbuf;
                    curtok = TOK_CHARLIT;
                    return;
                }
            stringLiteral:
                cp = curtokbuf;
            ch2 = (ch == '"') ? '"' : '\'';
                do {
                    if (ch == ch2) {
                        while ((ch = *inbufptr++) != '\n' &&
                               ch != EOF) {
                            if (ch == ch2) {
                                if (*inbufptr != ch2 || modula2)
                                    break;
                                else
                                    inbufptr++;
                            }
                      if (ch == '#' && which_lang == LANG_TIP) {
                        if (isxdigit(*inbufptr) &&
                            isxdigit(inbufptr[1])) {
                            ch = *inbufptr++;
                            if (isdigit(ch))
                              i = ch - '0';
                            else
                              i = toupper(ch) - 'A' + 10;
                            ch = *inbufptr++;
                            if (isdigit(ch))
                              i = i*16 + ch - '0';
                            else
                              i = i*16 + toupper(ch) - 'A' + 10;
                            ch = i;
                        } else if (*inbufptr == ch)
                            inbufptr++;
                      }
                            *cp++ = ch;
                        }
                        if (ch != ch2)
                            warning("Error in string literal [243]");
                    } else {
                        ch = *inbufptr++;
                  /* Check for Turbo #$FF hex constant */
                  /* (Contributed by Robert Andersson, robert@gar.no) */
                  if (ch == '$' && isxdigit(*inbufptr)) {
                      /* Pick out the hex number */
                      i = 0;
                      ch = *inbufptr++;
                      while (isxdigit(ch)) {
                        if (isdigit(ch))
                            i = i*16 + ch - '0';
                        else if (ch >= 'a')
                            i = i*16 + ch - 'a' + 10;
                        else if (ch >= 'A')
                            i = i*16 + ch - 'A' + 10;
                        ch = *inbufptr++;
                      }
                      while (ch == ' ' || ch == '\t')
                        ch = *inbufptr++;
                      inbufptr--;
#if 0
    /* Not safe---consider "var ch:char; begin ch:=#$ff end". */
                      /* Check if part of a string */
                      if (cp == curtokbuf && ch != '#' && ch != ch2) {
                        curtokint = i;
                        curtok = TOK_HEXLIT;
                        return;
                      }
#endif
                      *cp++ = i;
                  } else if (isdigit(ch)) {
                            i = 0;
                            while (isdigit(ch)) {
                                i = i*10 + ch - '0';
                                ch = *inbufptr++;
                            }
                            inbufptr--;
                            *cp++ = i;
                        } else {
                            *cp++ = ch & 0x1f;
                        }
                    }
                    while (*inbufptr == ' ' || *inbufptr == '\t')
                        inbufptr++;
                } while ((ch = *inbufptr++) == ch2 || ch == '#');
                inbufptr--;
                *cp = 0;
                curtokint = cp - curtokbuf;
                curtok = TOK_STRLIT;
                return;

            case '(':
                if (*inbufptr == '*' && !C_lex) {
                    inbufptr++;
                switch (commenting_flag ? 0 : parsecomment(0, 1)) {
                    case 0:
                            comment(1);
                      break;
                    case 2:
                      return;
                }
                    break;
                } else if (*inbufptr == '.') {
                    curtok = TOK_LBR;
                    inbufptr++;
                } else {
#if 0
                if (!C_lex && peeknextchar() == ')') {
                  gettok();
                  gettok();
                  return;
                }
#endif
                    curtok = TOK_LPAR;
                }
                return;

            case '{':
                if (C_lex || modula2) {
                    curtok = TOK_LBRACE;
                    return;
                }
                switch (commenting_flag ? 0 : parsecomment(0, 0)) {
                    case 0:
                        comment(0);
                        break;
                    case 2:
                        return;
                }
                break;

            case '}':
                if (C_lex || modula2) {
                    curtok = TOK_RBRACE;
                    return;
                }
            if (skipflag > 0) {
                skipflag = 0;
            } else
                warning("Unmatched '}' in input file [244]");
                break;

            case ')':
                curtok = TOK_RPAR;
                return;

            case '*':
            if (*inbufptr == (C_lex ? '/' : ')')) {
                inbufptr++;
                if (skipflag > 0) {
                  skipflag = 0;
                } else
                  warning("Unmatched '*)' in input file [245]");
                break;
            } else if (*inbufptr == '*' && !C_lex) {
                curtok = TOK_STARSTAR;
                inbufptr++;
            } else
                curtok = TOK_STAR;
                return;

            case '+':
                if (C_lex && *inbufptr == '+') {
                    curtok = TOK_PLPL;
                    inbufptr++;
                } else
                    curtok = TOK_PLUS;
                return;

            case ',':
                curtok = TOK_COMMA;
                return;

            case '-':
                if (C_lex && *inbufptr == '-') {
                    curtok = TOK_MIMI;
                    inbufptr++;
                } else if (*inbufptr == '>') {
                    curtok = TOK_ARROW;
                    inbufptr++;
                } else
                    curtok = TOK_MINUS;
                return;

            case '.':
                if (*inbufptr == '.') {
                    curtok = TOK_DOTS;
                    inbufptr++;
                } else if (*inbufptr == ')') {
                    curtok = TOK_RBR;
                    inbufptr++;
                } else
                    curtok = TOK_DOT;
                return;

            case '/':
            if (C_lex && *inbufptr == '*') {
                inbufptr++;
                comment(2);
                break;
            }
                curtok = TOK_SLASH;
                return;

            case ':':
                if (*inbufptr == '=') {
                    curtok = TOK_ASSIGN;
                    inbufptr++;
            } else if (*inbufptr == ':') {
                    curtok = TOK_COLONCOLON;
                    inbufptr++;
                } else
                    curtok = TOK_COLON;
                return;

            case ';':
                curtok = TOK_SEMI;
                return;

            case '<':
                if (*inbufptr == '=') {
                    curtok = TOK_LE;
                    inbufptr++;
                } else if (*inbufptr == '>') {
                    curtok = TOK_NE;
                    inbufptr++;
                } else if (*inbufptr == '<') {
                    curtok = TOK_LTLT;
                    inbufptr++;
                } else
                    curtok = TOK_LT;
                return;

            case '>':
                if (*inbufptr == '=') {
                    curtok = TOK_GE;
                    inbufptr++;
                } else if (*inbufptr == '>') {
                    curtok = TOK_GTGT;
                    inbufptr++;
                } else
                    curtok = TOK_GT;
                return;

            case '=':
            if (*inbufptr == '=') {
                curtok = TOK_EQEQ;
                inbufptr++;
            } else
                curtok = TOK_EQ;
                return;

            case '[':
                curtok = TOK_LBR;
                return;

            case ']':
                curtok = TOK_RBR;
                return;

            case '^':
                curtok = TOK_HAT;
                return;

            case '&':
                if (*inbufptr == '&') {
                    curtok = TOK_ANDAND;
                    inbufptr++;
                } else
                    curtok = TOK_AMP;
                return;

            case '|':
                if (*inbufptr == '|') {
                    curtok = TOK_OROR;
                    inbufptr++;
                } else
                    curtok = TOK_VBAR;
                return;

            case '~':
                curtok = TOK_TWIDDLE;
                return;

            case '!':
                if (*inbufptr == '=') {
                    curtok = TOK_BANGEQ;
                    inbufptr++;
                } else
                    curtok = TOK_BANG;
                return;

            case '%':
            if (C_lex) {
                curtok = TOK_PERC;
                return;
            }
            goto ident;

            case '?':
                curtok = TOK_QM;
                return;

            case '@':
            curtok = TOK_ADDR;
                return;

            case EOFMARK:
                if (curtok == TOK_EOF) {
                    if (inputkind == INP_STRLIST)
                        error("Unexpected end of macro");
                    else
                        error("Unexpected end of file");
                }
                curtok = TOK_EOF;
                return;

            default:
                if (isdigit(ch)) {
                cp = inbufptr;
                while (isxdigit(*cp))
                  cp++;
                if (*cp == '#' && isxdigit(cp[1])) {
                  i = atoi(inbufptr-1);
                  inbufptr = cp+1;
                } else if (toupper(cp[-1]) == 'B' ||
                         toupper(cp[-1]) == 'C') {
                        inbufptr--;
                  i = 8;
                } else if (toupper(*cp) == 'H') {
                        inbufptr--;
                  i = 16;
                } else if ((ch == '0' && toupper(*inbufptr) == 'X' &&
                        isxdigit(inbufptr[1]))) {
                  inbufptr++;
                  i = 16;
                } else {
                  i = 10;
                }
                if (i != 10) {
                        curtokint = 0;
                        while (isdigit(*inbufptr) ||
                         (i > 10 && isxdigit(*inbufptr))) {
                            ch = toupper(*inbufptr++);
                            curtokint *= i;
                            if (ch <= '9')
                                curtokint += ch - '0';
                            else
                                curtokint += ch - 'A' + 10;
                        }
                        sprintf(curtokbuf, "%ld", curtokint);
                  if ((toupper(*inbufptr) == 'B' && i == 8) ||
                      (toupper(*inbufptr) == 'H' && i == 16))
                      inbufptr++;
                  if (toupper(*inbufptr) == 'C' && i == 8) {
                      inbufptr++;
                      curtok = TOK_STRLIT;
                      curtokbuf[0] = curtokint;
                      curtokbuf[1] = 0;
                      curtokint = 1;
                      return;
                  }
                        if (toupper(*inbufptr) == 'L') {
                            strcat(curtokbuf, "L");
                            inbufptr++;
                        }
                        curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
                        return;
                    }
                    cp = curtokbuf;
                    i = 0;
                    while (ch == '0')
                        ch = *inbufptr++;
                    if (isdigit(ch)) {
                        while (isdigit(ch)) {
                            *cp++ = ch;
                            ch = *inbufptr++;
                        }
                    } else
                        *cp++ = '0';
                    if (ch == '.') {
                        if (isdigit(*inbufptr)) {
                            *cp++ = ch;
                            ch = *inbufptr++;
                            i = 1;
                            while (isdigit(ch)) {
                                *cp++ = ch;
                                ch = *inbufptr++;
                            }
                        }
                    }
                    if (ch == 'e' || ch == 'E' ||
                  ch == 'd' || ch == 'D' ||
                  ch == 'l' || ch == 'L' ||
                  ch == 'q' || ch == 'Q') {
                        ch = *inbufptr;
                        if (isdigit(ch) || ch == '+' || ch == '-') {
                            *cp++ = 'e';
                            inbufptr++;
                            i = 1;
                            do {
                                *cp++ = ch;
                                ch = *inbufptr++;
                            } while (isdigit(ch));
                        }
                    }
                    inbufptr--;
                    *cp = 0;
                    if (i) {
                        curtok = TOK_REALLIT;
                        curtokint = cp - curtokbuf;
                    } else {
                        if (cp >= curtokbuf+10) {
                            i = strcmp(curtokbuf, "2147483648");
                            if (cp > curtokbuf+10 || i > 0) {
                        curtok = TOK_REALLIT;
                        curtokint = cp - curtokbuf + 2;
                        strcat(curtokbuf, ".0");
                        return;
                      }
                            if (i == 0) {
                                curtok = TOK_MININT;
                                curtokint = (-2147483647) - 1;
                                return;
                            }
                        }
                        curtok = TOK_INTLIT;
                        curtokint = atol(curtokbuf);
                        if (toupper(*inbufptr) == 'L') {
                            strcat(curtokbuf, "L");
                            inbufptr++;
                        }
                    }
                    return;
                } else if (isalpha(ch) || ch == '_') {
ident:
                    {
                        register char *cp2;
                        curtoksym = NULL;
                        cp = curtokbuf;
                        cp2 = curtokcase;
                  *cp2++ = symcase ? ch : tolower(ch);
                  *cp++ = pascalcasesens ? ch : toupper(ch);
                  while (isalnum((ch = *inbufptr++)) ||
                         ch == '_' ||
                         (ch == '%' && !C_lex) ||
                         (ch == '$' && dollar_idents)) {
                      *cp2++ = symcase ? ch : tolower(ch);
                      if (!ignorenonalpha || isalnum(ch))
                        *cp++ = pascalcasesens ? ch : toupper(ch);
                  }
                        inbufptr--;
                        *cp2 = 0;
                        *cp = 0;
                  if (pascalsignif > 0)
                      curtokbuf[pascalsignif] = 0;
                    }
                if (*curtokbuf == '%') {
                  if (!strcicmp(curtokbuf, "%INCLUDE")) {
                      char *cp2 = inbufptr;
                      while (isspace(*cp2)) cp2++;
                      if (*cp2 == '\'')
                        cp2++;
                      cp = curtokbuf;
                      while (*cp2 && *cp2 != '\'' &&
                           *cp2 != ';' && !isspace(*cp2)) {
                        *cp++ = *cp2++;
                      }
                      *cp = 0;
                      cp = my_strrchr(curtokbuf, '/');
                      if (cp && (!strcicmp(cp, "/LIST") ||
                               !strcicmp(cp, "/NOLIST")))
                        *cp = 0;
                      if (*cp2 == '\'')
                        cp2++;
                      while (isspace(*cp2)) cp2++;
                      if (*cp2 == ';')
                        cp2++;
                      while (isspace(*cp2)) cp2++;
                      if (!*cp2) {
                        inbufptr = cp2;
                        (void) handle_include(stralloc(curtokbuf));
                        return;
                      }
                  } else if (!strcicmp(curtokbuf, "%TITLE") ||
                           !strcicmp(curtokbuf, "%SUBTITLE")) {
                      gettok();   /* string literal */
                      break;
                  } else if (!strcicmp(curtokbuf, "%PAGE")) {
                      /* should store a special page-break comment? */
                      break;   /* ignore token */
                  } else if ((i = 2, !strcicmp(curtokbuf, "%B")) ||
                           (i = 8, !strcicmp(curtokbuf, "%O")) ||
                           (i = 16, !strcicmp(curtokbuf, "%X"))) {
                      while (isspace(*inbufptr)) inbufptr++;
                      if (*inbufptr == '\'') {
                        inbufptr++;
                        curtokint = 0;
                        while (*inbufptr && *inbufptr != '\'') {
                            ch = toupper(*inbufptr++);
                            if (isxdigit(ch)) {
                              curtokint *= i;
                              if (ch <= '9')
                                  curtokint += ch - '0';
                              else
                                  curtokint += ch - 'A' + 10;
                            } else if (!isspace(ch))
                              warning("Bad digit in literal [246]");
                        }
                        if (*inbufptr)
                            inbufptr++;
                        sprintf(curtokbuf, "%ld", curtokint);
                        curtok = (i == 8) ? TOK_OCTLIT : TOK_HEXLIT;
                        return;
                      }
                        }
                }
                    {
                        register unsigned int hash;
                        register Symbol *sp;

                        hash = 0;
                        for (cp = curtokbuf; *cp; cp++)
                            hash = hash*3 + *cp;
                        sp = symtab[hash % SYMHASHSIZE];
                        while (sp && (i = strcmp(sp->name, curtokbuf)) != 0) {
                            if (i < 0)
                                sp = sp->left;
                            else
                                sp = sp->right;
                        }
                        if (!sp)
                            sp = findsymbol(curtokbuf);
                  if (sp->flags & SSYNONYM) {
                      i = 100;
                      while (--i > 0 && sp && (sp->flags & SSYNONYM)) {
                        Strlist *sl;
                        sl = strlist_find(sp->symbolnames, "===");
                        if (sl)
                            sp = (Symbol *)sl->value;
                        else
                            sp = NULL;
                      }
                      if (!sp)
                        break;    /* ignore token */
                  }
                  if (sp->kwtok && !(sp->flags & KWPOSS) &&
                      (pascalcasesens != 2 || !islower(*curtokbuf)) &&
                      (pascalcasesens != 3 || !isupper(*curtokbuf))) {
                      curtok = sp->kwtok;
                      return;
                  }
                  curtok = TOK_IDENT;
                        curtoksym = sp;
                  curtokint = -1;
                        if ((i = withlevel) != 0 && sp->fbase) {
                            while (--i >= 0) {
                                curtokmeaning = sp->fbase;
                                while (curtokmeaning) {
                                    if (curtokmeaning->rectype == withlist[i]) {
                                        curtokint = i;
                                        return;
                                    }
                                    curtokmeaning = curtokmeaning->snext;
                                }
                            }
                        }
                        curtokmeaning = sp->mbase;
                        while (curtokmeaning && !curtokmeaning->isactive)
                            curtokmeaning = curtokmeaning->snext;
                  if (!curtokmeaning)
                      return;
                  while (curtokmeaning->kind == MK_SYNONYM)
                      curtokmeaning = curtokmeaning->xnext;
                  /* look for unit.ident notation */
                        if (curtokmeaning->kind == MK_MODULE ||
                      curtokmeaning->kind == MK_FUNCTION) {
                            for (cp = inbufptr; isspace(*cp); cp++) ;
                            if (*cp == '.') {
                                for (cp++; isspace(*cp); cp++) ;
                                if (isalpha(*cp)) {
                                    Meaning *mp = curtokmeaning;
                                    Symbol *sym = curtoksym;
                                    char *saveinbufptr = inbufptr;
                                    gettok();
                                    if (curtok == TOK_DOT)
                              gettok();
                            else
                              curtok = TOK_END;
                                    if (curtok == TOK_IDENT) {
                              curtokmeaning = curtoksym->mbase;
                              while (curtokmeaning &&
                                     curtokmeaning->ctx != mp)
                                  curtokmeaning = curtokmeaning->snext;
                              if (!curtokmeaning &&
                                  !strcmp(sym->name, "SYSTEM")) {
                                  curtokmeaning = curtoksym->mbase;
                                  while (curtokmeaning &&
                                       curtokmeaning->ctx != nullctx)
                                    curtokmeaning = curtokmeaning->snext;
                              }
                            } else
                              curtokmeaning = NULL;
                                    if (!curtokmeaning) {
                                        /* oops, was probably funcname.field */
                                        inbufptr = saveinbufptr;
                                        curtokmeaning = mp;
                                        curtoksym = sym;
                                    }
                                }
                            }
                        }
                        return;
                    }
                } else {
                    warning(format_d("Unrecognized character 0%o in file [247]",
                             ch));
                }
        }
    }
}



void checkkeyword(tok)
Token tok;
{
    if (curtok == TOK_IDENT &&
      curtoksym->kwtok == tok) {
      curtoksym->flags &= ~KWPOSS;
      curtok = tok;
    }
}


void checkmodulewords()
{
    if (modula2) {
      checkkeyword(TOK_FROM);
      checkkeyword(TOK_DEFINITION);
      checkkeyword(TOK_IMPLEMENT);
      checkkeyword(TOK_MODULE);
      checkkeyword(TOK_IMPORT);
      checkkeyword(TOK_EXPORT);
    } else if (curtok == TOK_IDENT &&
             (curtoksym->kwtok == TOK_MODULE ||
            curtoksym->kwtok == TOK_IMPORT ||
            curtoksym->kwtok == TOK_EXPORT ||
            curtoksym->kwtok == TOK_IMPLEMENT)) {
      if (!strcmp(curtokbuf, "UNIT") ||
          !strcmp(curtokbuf, "USES") ||
          !strcmp(curtokbuf, "INTERFACE") ||
          !strcmp(curtokbuf, "IMPLEMENTATION")) {
          modulenotation = 0;
          findsymbol("UNIT")->flags &= ~KWPOSS;
          findsymbol("USES")->flags &= ~KWPOSS;
          findsymbol("INTERFACE")->flags &= ~KWPOSS;
          findsymbol("IMPLEMENTATION")->flags &= ~KWPOSS;
      } else {
          modulenotation = 1;
          findsymbol("MODULE")->flags &= ~KWPOSS;
          findsymbol("EXPORT")->flags &= ~KWPOSS;
          findsymbol("IMPORT")->flags &= ~KWPOSS;
          findsymbol("IMPLEMENT")->flags &= ~KWPOSS;
      }
      curtok = curtoksym->kwtok;
    }
}












/* End. */




Generated by  Doxygen 1.6.0   Back to index