Path: wuarchive!brutus.cs.uiuc.edu!apple!bbn!papaya.bbn.com!rsalz
From: rsalz@uunet.uu.net (Rich Salz)
Newsgroups: comp.sources.unix
Subject: v21i076:  Pascal to C translator, Part31/32
Message-ID: <2416@litchi.bbn.com>
Date: 30 Mar 90 19:17:45 GMT
Lines: 2078
Approved: rsalz@uunet.UU.NET
X-Checksum-Snefru: e0f19771 289416a8 a180c7d2 77bbbdc5

Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
Posting-number: Volume 21, Issue 76
Archive-name: p2c/part31

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 31 (of 32)."
# Contents:  src/lex.c.1
# Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:54 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'src/lex.c.1' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'src/lex.c.1'\"
else
echo shar: Extracting \"'src/lex.c.1'\" \(49580 characters\)
sed "s/^X//" >'src/lex.c.1' <<'END_OF_FILE'
X/* "p2c", a Pascal to C translator.
X   Copyright (C) 1989 David Gillespie.
X   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
X
XThis program is free software; you can redistribute it and/or modify
Xit under the terms of the GNU General Public License as published by
Xthe Free Software Foundation (any version).
X
XThis program is distributed in the hope that it will be useful,
Xbut WITHOUT ANY WARRANTY; without even the implied warranty of
XMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
XGNU General Public License for more details.
X
XYou should have received a copy of the GNU General Public License
Xalong with this program; see the file COPYING.  If not, write to
Xthe Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
X
X
X
X#define PROTO_LEX_C
X#include "trans.h"
X
X
X/* Define LEXDEBUG for a token trace */
X#define LEXDEBUG
X
X
X
X
X#define EOFMARK 1
X
X
XStatic char dollar_flag, lex_initialized;
XStatic int if_flag, if_skip;
XStatic int commenting_flag;
XStatic char *commenting_ptr;
XStatic int skipflag;
XStatic char modulenotation;
XStatic short inputkind;
XStatic Strlist *instrlist;
XStatic char inbuf[300];
XStatic char *oldinfname, *oldctxname;
XStatic Strlist *endnotelist;
X
X
X
X#define INP_FILE     0
X#define INP_INCFILE  1
X#define INP_STRLIST  2
X
XStatic struct inprec {
X    struct inprec *next;
X    short kind;
X    char *fname, *inbufptr;
X    int lnum;
X    FILE *filep;
X    Strlist *strlistp, *tempopts;
X    Token curtok, saveblockkind;
X    Symbol *curtoksym;
X    Meaning *curtokmeaning;
X} *topinput;
X
X
X
X
X
X
Xchar *fixpascalname(name)
Xchar *name;
X{
X    char *cp, *cp2;
X
X    if (pascalsignif > 0) {
X        name = format_ds("%.*s", pascalsignif, name);
X        if (!pascalcasesens)
X            upc(name);
X	else if (pascalcasesens == 3)
X	    lwc(name);
X    } else if (!pascalcasesens)
X        name = strupper(name);
X    else if (pascalcasesens == 3)
X	name = strlower(name);
X    if (ignorenonalpha) {
X	for (cp = cp2 = name; *cp; cp++)
X	    if (isalnum(*cp))
X		*cp2++ = *cp;
X    }
X    return name;
X}
X
X
X
XStatic void makekeyword(name)
Xchar *name;
X{
X    Symbol *sym;
X
X    if (*name) {
X        sym = findsymbol(name);
X        sym->flags |= AVOIDNAME;
X    }
X}
X
X
XStatic void makeglobword(name)
Xchar *name;
X{
X    Symbol *sym;
X
X    if (*name) {
X        sym = findsymbol(name);
X        sym->flags |= AVOIDGLOB;
X    }
X}
X
X
X
XStatic void makekeywords()
X{
X    makekeyword("auto");
X    makekeyword("break");
X    makekeyword("char");
X    makekeyword("continue");
X    makekeyword("default");
X    makekeyword("defined");   /* is this one really necessary? */
X    makekeyword("double");
X    makekeyword("enum");
X    makekeyword("extern");
X    makekeyword("float");
X    makekeyword("int");
X    makekeyword("long");
X    makekeyword("noalias");
X    makekeyword("register");
X    makekeyword("return");
X    makekeyword("short");
X    makekeyword("signed");
X    makekeyword("sizeof");
X    makekeyword("static");
X    makekeyword("struct");
X    makekeyword("switch");
X    makekeyword("typedef");
X    makekeyword("union");
X    makekeyword("unsigned");
X    makekeyword("void");
X    makekeyword("volatile");
X    makekeyword("asm");
X    makekeyword("fortran");
X    makekeyword("entry");
X    makekeyword("pascal");
X    if (cplus != 0) {
X        makekeyword("class");
X        makekeyword("delete");
X        makekeyword("friend");
X        makekeyword("inline");
X        makekeyword("new");
X        makekeyword("operator");
X        makekeyword("overload");
X        makekeyword("public");
X        makekeyword("this");
X        makekeyword("virtual");
X    }
X    makekeyword(name_UCHAR);
X    makekeyword(name_SCHAR);    /* any others? */
X    makekeyword(name_BOOLEAN);
X    makekeyword(name_PROCEDURE);
X    makekeyword(name_ESCAPE);
X    makekeyword(name_ESCIO);
X    makekeyword(name_CHKIO);
X    makekeyword(name_SETIO);
X    makeglobword("main");
X    makeglobword("vextern");     /* used in generated .h files */
X    makeglobword("argc");
X    makeglobword("argv");
X    makekeyword("TRY");
X    makekeyword("RECOVER");
X    makekeyword("RECOVER2");
X    makekeyword("ENDTRY");
X}
X
X
X
XStatic Symbol *Pkeyword(name, tok)
Xchar *name;
XToken tok;
X{
X    Symbol *sp = NULL;
X
X    if (pascalcasesens != 2) {
X	sp = findsymbol(strlower(name));
X	sp->kwtok = tok;
X    }
X    if (pascalcasesens != 3) {
X	sp = findsymbol(strupper(name));
X	sp->kwtok = tok;
X    }
X    return sp;
X}
X
X
XStatic Symbol *Pkeywordposs(name, tok)
Xchar *name;
XToken tok;
X{
X    Symbol *sp = NULL;
X
X    if (pascalcasesens != 2) {
X	sp = findsymbol(strlower(name));
X	sp->kwtok = tok;
X	sp->flags |= KWPOSS;
X    }
X    if (pascalcasesens != 3) {
X	sp = findsymbol(strupper(name));
X	sp->kwtok = tok;
X	sp->flags |= KWPOSS;
X    }
X    return sp;
X}
X
X
XStatic void makePascalwords()
X{
X    Pkeyword("AND", TOK_AND);
X    Pkeyword("ARRAY", TOK_ARRAY);
X    Pkeywordposs("ANYVAR", TOK_ANYVAR);
X    Pkeywordposs("ABSOLUTE", TOK_ABSOLUTE);
X    Pkeyword("BEGIN", TOK_BEGIN);
X    Pkeywordposs("BY", TOK_BY);
X    Pkeyword("CASE", TOK_CASE);
X    Pkeyword("CONST", TOK_CONST);
X    Pkeyword("DIV", TOK_DIV);
X    Pkeywordposs("DEFINITION", TOK_DEFINITION);
X    Pkeyword("DO", TOK_DO);
X    Pkeyword("DOWNTO", TOK_DOWNTO);
X    Pkeyword("ELSE", TOK_ELSE);
X    Pkeywordposs("ELSIF", TOK_ELSIF);
X    Pkeyword("END", TOK_END);
X    Pkeywordposs("EXPORT", TOK_EXPORT);
X    Pkeyword("FILE", TOK_FILE);
X    Pkeyword("FOR", TOK_FOR);
X    Pkeywordposs("FROM", TOK_FROM);
X    Pkeyword("FUNCTION", TOK_FUNCTION);
X    Pkeyword("GOTO", TOK_GOTO);
X    Pkeyword("IF", TOK_IF);
X    Pkeywordposs("IMPLEMENT", TOK_IMPLEMENT);
X    Pkeywordposs("IMPLEMENTATION", TOK_IMPLEMENT);
X    Pkeywordposs("IMPORT", TOK_IMPORT);
X    Pkeyword("IN", TOK_IN);
X    Pkeywordposs("INLINE", TOK_INLINE);
X    Pkeywordposs("INTERFACE", TOK_EXPORT);
X    Pkeywordposs("INTERRUPT", TOK_INTERRUPT);
X    Pkeyword("LABEL", TOK_LABEL);
X    Pkeywordposs("LOOP", TOK_LOOP);
X    Pkeyword("MOD", TOK_MOD);
X    Pkeywordposs("MODULE", TOK_MODULE);
X    Pkeyword("NIL", TOK_NIL);
X    Pkeyword("NOT", TOK_NOT);
X    Pkeyword("OF", TOK_OF);
X    Pkeyword("OR", TOK_OR);
X    Pkeywordposs("ORIGIN", TOK_ORIGIN);
X    Pkeywordposs("OTHERWISE", TOK_OTHERWISE);
X    Pkeywordposs("OVERLAY", TOK_SEGMENT);
X    Pkeyword("PACKED", TOK_PACKED);
X    Pkeywordposs("POINTER", TOK_POINTER);
X    Pkeyword("PROCEDURE", TOK_PROCEDURE);
X    Pkeyword("PROGRAM", TOK_PROGRAM);
X    Pkeywordposs("QUALIFIED", TOK_QUALIFIED);
X    Pkeyword("RECORD", TOK_RECORD);
X    Pkeywordposs("RECOVER", TOK_RECOVER);
X    Pkeywordposs("REM", TOK_REM);
X    Pkeyword("REPEAT", TOK_REPEAT);
X    Pkeywordposs("RETURN", TOK_RETURN);
X    if (which_lang == LANG_UCSD)
X	Pkeyword("SEGMENT", TOK_SEGMENT);
X    else
X	Pkeywordposs("SEGMENT", TOK_SEGMENT);
X    Pkeyword("SET", TOK_SET);
X    Pkeywordposs("SHL", TOK_SHL);
X    Pkeywordposs("SHR", TOK_SHR);
X    Pkeyword("THEN", TOK_THEN);
X    Pkeyword("TO", TOK_TO);
X    Pkeywordposs("TRY", TOK_TRY);
X    Pkeyword("TYPE", TOK_TYPE);
X    Pkeyword("UNTIL", TOK_UNTIL);
X    Pkeywordposs("USES", TOK_IMPORT);
X    Pkeywordposs("UNIT", TOK_MODULE);
X    if (which_lang == LANG_VAX)
X	Pkeyword("VALUE", TOK_VALUE);
X    else
X	Pkeywordposs("VALUE", TOK_VALUE);
X    Pkeyword("VAR", TOK_VAR);
X    Pkeywordposs("VARYING", TOK_VARYING);
X    Pkeyword("WHILE", TOK_WHILE);
X    Pkeyword("WITH", TOK_WITH);
X    Pkeywordposs("XOR", TOK_XOR);
X    Pkeyword("__MODULE", TOK_MODULE);
X    Pkeyword("__IMPORT", TOK_IMPORT);
X    Pkeyword("__EXPORT", TOK_EXPORT);
X    Pkeyword("__IMPLEMENT", TOK_IMPLEMENT);
X}
X
X
X
XStatic void deterministic(name)
Xchar *name;
X{
X    Symbol *sym;
X
X    if (*name) {
X        sym = findsymbol(name);
X        sym->flags |= DETERMF;
X    }
X}
X
X
XStatic void nosideeff(name)
Xchar *name;
X{
X    Symbol *sym;
X
X    if (*name) {
X        sym = findsymbol(name);
X        sym->flags |= NOSIDEEFF;
X    }
X}
X
X
X
XStatic void recordsideeffects()
X{
X    deterministic("abs");
X    deterministic("acos");
X    deterministic("asin");
X    deterministic("atan");
X    deterministic("atan2");
X    deterministic("atof");
X    deterministic("atoi");
X    deterministic("atol");
X    deterministic("ceil");
X    deterministic("cos");
X    deterministic("cosh");
X    deterministic("exp");
X    deterministic("fabs");
X    deterministic("feof");
X    deterministic("feoln");
X    deterministic("ferror");
X    deterministic("floor");
X    deterministic("fmod");
X    deterministic("ftell");
X    deterministic("isalnum");
X    deterministic("isalpha");
X    deterministic("isdigit");
X    deterministic("islower");
X    deterministic("isspace");
X    deterministic("isupper");
X    deterministic("labs");
X    deterministic("ldexp");
X    deterministic("log");
X    deterministic("log10");
X    deterministic("memcmp");
X    deterministic("memchr");
X    deterministic("pow");
X    deterministic("sin");
X    deterministic("sinh");
X    deterministic("sqrt");
X    deterministic("strchr");
X    deterministic("strcmp");
X    deterministic("strcspn");
X    deterministic("strlen");
X    deterministic("strncmp");
X    deterministic("strpbrk");
X    deterministic("strrchr");
X    deterministic("strspn");
X    deterministic("strstr");
X    deterministic("tan");
X    deterministic("tanh");
X    deterministic("tolower");
X    deterministic("toupper");
X    deterministic(setequalname);
X    deterministic(subsetname);
X    deterministic(signextname);
X}
X
X
X
X
X
Xvoid init_lex()
X{
X    int i;
X
X    inputkind = INP_FILE;
X    inf_lnum = 0;
X    inf_ltotal = 0;
X    *inbuf = 0;
X    inbufptr = inbuf;
X    keepingstrlist = NULL;
X    tempoptionlist = NULL;
X    switch_strpos = 0;
X    dollar_flag = 0;
X    if_flag = 0;
X    if_skip = 0;
X    commenting_flag = 0;
X    skipflag = 0;
X    inbufindent = 0;
X    modulenotation = 1;
X    notephase = 0;
X    endnotelist = NULL;
X    for (i = 0; i < SYMHASHSIZE; i++)
X        symtab[i] = 0;
X    C_lex = 0;
X    lex_initialized = 0;
X}
X
X
Xvoid setup_lex()
X{
X    lex_initialized = 1;
X    if (!strcmp(language, "MODCAL"))
X        sysprog_flag = 2;
X    else
X        sysprog_flag = 0;
X    if (shortcircuit < 0)
X        partial_eval_flag = (which_lang == LANG_TURBO ||
X			     which_lang == LANG_VAX ||
X			     which_lang == LANG_OREGON ||
X			     modula2 ||
X			     hpux_lang);
X    else
X        partial_eval_flag = shortcircuit;
X    iocheck_flag = 1;
X    range_flag = 1;
X    ovflcheck_flag = 1;
X    stackcheck_flag = 1;
X    fixedflag = 0;
X    withlevel = 0;
X    makekeywords();
X    makePascalwords();
X    recordsideeffects();
X    topinput = 0;
X    ignore_directives = 0;
X    skipping_module = 0;
X    blockkind = TOK_END;
X    gettok();
X}
X
X
X
X
Xint checkeatnote(msg)
Xchar *msg;
X{
X    Strlist *lp;
X    char *cp;
X    int len;
X
X    for (lp = eatnotes; lp; lp = lp->next) {
X	if (!strcmp(lp->s, "1")) {
X	    echoword("[*]", 0);
X	    return 1;
X	}
X	if (!strcmp(lp->s, "0"))
X	    return 0;
X	len = strlen(lp->s);
X	cp = msg;
X	while (*cp && (*cp != lp->s[0] || strncmp(cp, lp->s, len)))
X	    cp++;
X	if (*cp) {
X	    cp = lp->s;
X	    if (*cp != '[')
X		cp = format_s("[%s", cp);
X	    if (cp[strlen(cp)-1] != ']')
X		cp = format_s("%s]", cp);
X	    echoword(cp, 0);
X	    return 1;
X	}
X    }
X    return 0;
X}
X
X
X
Xvoid beginerror()
X{
X    end_source();
X    if (showprogress) {
X        fprintf(stderr, "\r%60s\r", "");
X        clearprogress();
X    } else
X	echobreak();
X}
X
X
Xvoid counterror()
X{
X    if (maxerrors > 0) {
X	if (--maxerrors == 0) {
X	    fprintf(outf, "\n/* Translation aborted: Too many errors. */\n");
X	    fprintf(outf,   "-------------------------------------------\n");
X	    if (outf != stdout)
X		printf("Translation aborted: Too many errors.\n");
X	    if (verbose)
X		fprintf(logf, "Translation aborted: Too many errors.\n");
X	    closelogfile();
X	    exit(EXIT_FAILURE);
X	}
X    }
X}
X
X
Xvoid error(msg)     /* does not return */
Xchar *msg;
X{
X    flushcomments(NULL, -1, -1);
X    beginerror();
X    fprintf(outf, "/* %s, line %d: %s */\n", infname, inf_lnum, msg);
X    fprintf(outf, "/* Translation aborted. */\n");
X    fprintf(outf, "--------------------------\n");
X    if (outf != stdout) {
X        printf("%s, line %d/%d: %s\n", infname, inf_lnum, outf_lnum, msg);
X        printf("Translation aborted.\n");
X    }
X    if (verbose) {
X	fprintf(logf, "%s, line %d/%d: %s\n",
X		infname, inf_lnum, outf_lnum, msg);
X	fprintf(logf, "Translation aborted.\n");
X    }
X    closelogfile();
X    exit(EXIT_FAILURE);
X}
X
X
Xvoid interror(proc, msg)      /* does not return */
Xchar *proc, *msg;
X{
X    error(format_ss("Internal error in %s: %s", proc, msg));
X}
X
X
Xvoid warning(msg)
Xchar *msg;
X{
X    if (checkeatnote(msg)) {
X	if (verbose)
X	    fprintf(logf, "%s, %d/%d: Omitted warning: %s\n",
X		    infname, inf_lnum, outf_lnum, msg);
X	return;
X    }
X    beginerror();
X    addnote(format_s("Warning: %s", msg), curserial);
X    counterror();
X}
X
X
Xvoid intwarning(proc, msg)
Xchar *proc, *msg;
X{
X    if (checkeatnote(msg)) {
X	if (verbose)
X	    fprintf(logf, "%s, %d/%d: Omitted internal error in %s: %s\n",
X		    infname, inf_lnum, outf_lnum, proc, msg);
X	return;
X    }
X    beginerror();
X    addnote(format_ss("Internal error in %s: %s", proc, msg), curserial);
X    if (error_crash)
X        exit(EXIT_FAILURE);
X    counterror();
X}
X
X
X
X
Xvoid note(msg)
Xchar *msg;
X{
X    if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
X	if (verbose)
X	    fprintf(logf, "%s, %d/%d: Omitted note: %s\n",
X		    infname, inf_lnum, outf_lnum, msg);
X	return;
X    }
X    beginerror();
X    addnote(format_s("Note: %s", msg), curserial);
X    counterror();
X}
X
X
X
Xvoid endnote(msg)
Xchar *msg;
X{
X    if (blockkind == TOK_IMPORT || checkeatnote(msg)) {
X	if (verbose)
X	    fprintf(logf, "%s, %d/%d: Omitted end-note: %s\n",
X		    infname, inf_lnum, outf_lnum, msg);
X	return;
X    }
X    if (verbose)
X	fprintf(logf, "%s, %d/%d: Recorded end-note: %s\n",
X		infname, inf_lnum, outf_lnum, msg);
X    (void) strlist_add(&endnotelist, msg);
X}
X
X
Xvoid showendnotes()
X{
X    while (initialcalls) {
X	if (initialcalls->value)
X	    endnote(format_s("Remember to call %s in main program [215]",
X			     initialcalls->s));
X	strlist_eat(&initialcalls);
X    }
X    if (endnotelist) {
X	end_source();
X	while (endnotelist) {
X	    if (outf != stdout) {
X		beginerror();
X		printf("Note: %s\n", endnotelist->s);
X	    }
X	    fprintf(outf, "/* p2c: Note: %s */\n", endnotelist->s);
X	    outf_lnum++;
X	    strlist_eat(&endnotelist);
X	}
X    }
X}
X
X
X
X
X
X
X
Xchar *tok_name(tok)
XToken tok;
X{
X    if (tok == TOK_END && inputkind == INP_STRLIST)
X	return "end of macro";
X    if (tok == curtok && tok == TOK_IDENT)
X        return format_s("'%s'", curtokcase);
X    if (!modulenotation) {
X        switch (tok) {
X            case TOK_MODULE:    return "UNIT";
X            case TOK_IMPORT:    return "USES";
X            case TOK_EXPORT:    return "INTERFACE";
X            case TOK_IMPLEMENT: return "IMPLEMENTATION";
X	    default:		break;
X        }
X    }
X    return toknames[(int) tok];
X}
X
X
X
Xvoid expected(msg)
Xchar *msg;
X{
X    error(format_ss("Expected %s, found %s", msg, tok_name(curtok)));
X}
X
X
Xvoid expecttok(tok)
XToken tok;
X{
X    if (curtok != tok)
X        expected(tok_name(tok));
X}
X
X
Xvoid needtok(tok)
XToken tok;
X{
X    if (curtok != tok)
X        expected(tok_name(tok));
X    gettok();
X}
X
X
Xint wexpected(msg)
Xchar *msg;
X{
X    warning(format_ss("Expected %s, found %s [227]", msg, tok_name(curtok)));
X    return 0;
X}
X
X
Xint wexpecttok(tok)
XToken tok;
X{
X    if (curtok != tok)
X        return wexpected(tok_name(tok));
X    else
X	return 1;
X}
X
X
Xint wneedtok(tok)
XToken tok;
X{
X    if (wexpecttok(tok)) {
X	gettok();
X	return 1;
X    } else
X	return 0;
X}
X
X
Xvoid alreadydef(sym)
XSymbol *sym;
X{
X    warning(format_s("Symbol '%s' was already defined [220]", sym->name));
X}
X
X
Xvoid undefsym(sym)
XSymbol *sym;
X{
X    warning(format_s("Symbol '%s' is not defined [221]", sym->name));
X}
X
X
Xvoid symclass(sym)
XSymbol *sym;
X{
X    warning(format_s("Symbol '%s' is not of the appropriate class [222]", sym->name));
X}
X
X
Xvoid badtypes()
X{
X    warning("Type mismatch [223]");
X}
X
X
Xvoid valrange()
X{
X    warning("Value range error [224]");
X}
X
X
X
Xvoid skipparens()
X{
X    Token begintok;
X
X    if (curtok == TOK_LPAR) {
X        gettok();
X        while (curtok != TOK_RPAR)
X            skipparens();
X    } else if (curtok == TOK_LBR) {
X        gettok();
X        while (curtok != TOK_RBR)
X            skipparens();
X    } else if (curtok == TOK_BEGIN || curtok == TOK_RECORD ||
X	       curtok == TOK_CASE) {
X	begintok = curtok;
X        gettok();
X        while (curtok != TOK_END)
X	    if (curtok == TOK_CASE && begintok == TOK_RECORD)
X		gettok();
X	    else
X		skipparens();
X    }
X    gettok();
X}
X
X
Xvoid skiptotoken2(tok1, tok2)
XToken tok1, tok2;
X{
X    while (curtok != tok1 && curtok != tok2 &&
X	   curtok != TOK_END && curtok != TOK_RPAR &&
X	   curtok != TOK_RBR && curtok != TOK_EOF)
X	skipparens();
X}
X
X
Xvoid skippasttoken2(tok1, tok2)
XToken tok1, tok2;
X{
X    skiptotoken2(tok1, tok2);
X    if (curtok == tok1 || curtok == tok2)
X	gettok();
X}
X
X
Xvoid skippasttotoken(tok1, tok2)
XToken tok1, tok2;
X{
X    skiptotoken2(tok1, tok2);
X    if (curtok == tok1)
X	gettok();
X}
X
X
Xvoid skiptotoken(tok)
XToken tok;
X{
X    skiptotoken2(tok, tok);
X}
X
X
Xvoid skippasttoken(tok)
XToken tok;
X{
X    skippasttoken2(tok, tok);
X}
X
X
X
Xint skipopenparen()
X{
X    if (wneedtok(TOK_LPAR))
X	return 1;
X    skiptotoken(TOK_SEMI);
X    return 0;
X}
X
X
Xint skipcloseparen()
X{
X    if (curtok == TOK_COMMA)
X	warning("Too many arguments for built-in routine [225]");
X    else
X	if (wneedtok(TOK_RPAR))
X	    return 1;
X    skippasttotoken(TOK_RPAR, TOK_SEMI);
X    return 0;
X}
X
X
Xint skipcomma()
X{
X    if (curtok == TOK_RPAR)
X	warning("Too few arguments for built-in routine [226]");
X    else
X	if (wneedtok(TOK_COMMA))
X	    return 1;
X    skippasttotoken(TOK_RPAR, TOK_SEMI);
X    return 0;
X}
X
X
X
X
X
Xchar *findaltname(name, num)
Xchar *name;
Xint num;
X{
X    char *cp;
X
X    if (num <= 0)
X        return name;
X    if (num == 1 && *alternatename1)
X        return format_s(alternatename1, name);
X    if (num == 2 && *alternatename2)
X        return format_s(alternatename2, name);
X    if (*alternatename)
X        return format_sd(alternatename, name, num);
X    cp = name;
X    if (*alternatename1) {
X        while (--num >= 0)
X	    cp = format_s(alternatename1, cp);
X    } else {
X	while (--num >= 0)
X	    cp = format_s("%s_", cp);
X    }
X    return cp;
X}
X
X
X
X
XSymbol *findsymbol_opt(name)
Xchar *name;
X{
X    register int i;
X    register unsigned int hash;
X    register char *cp;
X    register Symbol *sp;
X
X    hash = 0;
X    for (cp = name; *cp; cp++)
X        hash = hash*3 + *cp;
X    sp = symtab[hash % SYMHASHSIZE];
X    while (sp && (i = strcmp(sp->name, name)) != 0) {
X        if (i < 0)
X            sp = sp->left;
X        else
X            sp = sp->right;
X    }
X    return sp;
X}
X
X
X
XSymbol *findsymbol(name)
Xchar *name;
X{
X    register int i;
X    register unsigned int hash;
X    register char *cp;
X    register Symbol **prev, *sp;
X
X    hash = 0;
X    for (cp = name; *cp; cp++)
X        hash = hash*3 + *cp;
X    prev = symtab + (hash % SYMHASHSIZE);
X    while ((sp = *prev) != 0 &&
X           (i = strcmp(sp->name, name)) != 0) {
X        if (i < 0)
X            prev = &(sp->left);
X        else
X            prev = &(sp->right);
X    }
X    if (!sp) {
X        sp = ALLOCV(sizeof(Symbol) + strlen(name), Symbol, symbols);
X        sp->mbase = sp->fbase = NULL;
X        sp->left = sp->right = NULL;
X        strcpy(sp->name, name);
X        sp->flags = 0;
X	sp->kwtok = TOK_NONE;
X        sp->symbolnames = NULL;
X        *prev = sp;
X    }
X    return sp;
X}
X
X
X
X
Xvoid clearprogress()
X{
X    oldinfname = NULL;
X}
X
X
Xvoid progress()
X{
X    char *ctxname;
X    int needrefr;
X    static int prevlen;
X
X    if (showprogress) {
X        if (!curctx || curctx == nullctx || curctx->kind == MK_MODULE ||
X            !strncmp(curctx->name, "__PROCPTR", 9) || blockkind == TOK_IMPORT)
X            ctxname = "";
X        else
X            ctxname = curctx->name;
X        needrefr = (inf_lnum & 15) == 0;
X        if (oldinfname != infname || oldctxname != ctxname) {
X	    if (oldinfname != infname)
X		prevlen = 60;
X            fprintf(stderr, "\r%*s", prevlen + 2, "");
X            oldinfname = infname;
X            oldctxname = ctxname;
X            needrefr = 1;
X        }
X        if (needrefr) {
X            fprintf(stderr, "\r%5d %s  %s", inf_lnum, infname, ctxname);
X	    prevlen = 8 + strlen(infname) + strlen(ctxname);
X        } else {
X            fprintf(stderr, "\r%5d", inf_lnum);
X	    prevlen = 5;
X	}
X    }
X}
X
X
X
Xvoid getline()
X{
X    char *cp, *cp2;
X
X    switch (inputkind) {
X
X        case INP_FILE:
X        case INP_INCFILE:
X            inf_lnum++;
X	    inf_ltotal++;
X            if (fgets(inbuf, 300, inf)) {
X                cp = inbuf + strlen(inbuf);
X                if (*inbuf && cp[-1] == '\n')
X                    cp[-1] = 0;
X		if (inbuf[0] == '#' && inbuf[1] == ' ' && isdigit(inbuf[2])) {
X		    cp = inbuf + 2;    /* in case input text came */
X		    inf_lnum = 0;      /*  from the C preprocessor */
X		    while (isdigit(*cp))
X			inf_lnum = inf_lnum*10 + (*cp++) - '0';
X		    inf_lnum--;
X		    while (isspace(*cp)) cp++;
X		    if (*cp == '"' && (cp2 = my_strchr(cp+1, '"')) != NULL) {
X			cp++;
X			infname = stralloc(cp);
X			infname[cp2 - cp] = 0;
X		    }
X		    getline();
X		    return;
X		}
X		if (copysource && *inbuf) {
X		    start_source();
X		    fprintf(outf, "%s\n", inbuf);
X		}
X                if (keepingstrlist) {
X                    strlist_append(keepingstrlist, inbuf)->value = inf_lnum;
X                }
X                if (showprogress && inf_lnum % showprogress == 0)
X                    progress();
X            } else {
X                if (showprogress)
X                    fprintf(stderr, "\n");
X                if (inputkind == INP_INCFILE) {
X                    pop_input();
X                    getline();
X                } else
X                    strcpy(inbuf, "\001");
X            }
X            break;
X
X        case INP_STRLIST:
X            if (instrlist) {
X                strcpy(inbuf, instrlist->s);
X                if (instrlist->value)
X                    inf_lnum = instrlist->value;
X                else
X                    inf_lnum++;
X                instrlist = instrlist->next;
X            } else
X                strcpy(inbuf, "\001");
X            break;
X    }
X    inbufptr = inbuf;
X    inbufindent = 0;
X}
X
X
X
X
XStatic void push_input()
X{
X    struct inprec *inp;
X
X    inp = ALLOC(1, struct inprec, inprecs);
X    inp->kind = inputkind;
X    inp->fname = infname;
X    inp->lnum = inf_lnum;
X    inp->filep = inf;
X    inp->strlistp = instrlist;
X    inp->inbufptr = stralloc(inbufptr);
X    inp->curtok = curtok;
X    inp->curtoksym = curtoksym;
X    inp->curtokmeaning = curtokmeaning;
X    inp->saveblockkind = TOK_NIL;
X    inp->next = topinput;
X    topinput = inp;
X    inbufptr = inbuf + strlen(inbuf);
X}
X
X
X
Xvoid push_input_file(fp, fname, isinclude)
XFILE *fp;
Xchar *fname;
Xint isinclude;
X{
X    push_input();
X    inputkind = (isinclude == 1) ? INP_INCFILE : INP_FILE;
X    inf = fp;
X    inf_lnum = 0;
X    infname = fname;
X    *inbuf = 0;
X    inbufptr = inbuf;
X    topinput->tempopts = tempoptionlist;
X    tempoptionlist = NULL;
X    if (isinclude != 2)
X        gettok();
X}
X
X
Xvoid include_as_import()
X{
X    if (inputkind == INP_INCFILE) {
X	if (topinput->saveblockkind == TOK_NIL)
X	    topinput->saveblockkind = blockkind;
X	blockkind = TOK_IMPORT;
X    } else
X	warning(format_s("%s ignored except in include files [228]",
X			 interfacecomment));
X}
X
X
Xvoid push_input_strlist(sp, fname)
XStrlist *sp;
Xchar *fname;
X{
X    push_input();
X    inputkind = INP_STRLIST;
X    instrlist = sp;
X    if (fname) {
X        infname = fname;
X        inf_lnum = 0;
X    } else
X        inf_lnum--;     /* adjust for extra getline() */
X    *inbuf = 0;
X    inbufptr = inbuf;
X    gettok();
X}
X
X
X
Xvoid pop_input()
X{
X    struct inprec *inp;
X
X    if (inputkind == INP_FILE || inputkind == INP_INCFILE) {
X	while (tempoptionlist) {
X	    undooption(tempoptionlist->value, tempoptionlist->s);
X	    strlist_eat(&tempoptionlist);
X	}
X	tempoptionlist = topinput->tempopts;
X	if (inf)
X	    fclose(inf);
X    }
X    inp = topinput;
X    topinput = inp->next;
X    if (inp->saveblockkind != TOK_NIL)
X	blockkind = inp->saveblockkind;
X    inputkind = inp->kind;
X    infname = inp->fname;
X    inf_lnum = inp->lnum;
X    inf = inp->filep;
X    curtok = inp->curtok;
X    curtoksym = inp->curtoksym;
X    curtokmeaning = inp->curtokmeaning;
X    strcpy(inbuf, inp->inbufptr);
X    FREE(inp->inbufptr);
X    inbufptr = inbuf;
X    instrlist = inp->strlistp;
X    FREE(inp);
X}
X
X
X
X
Xint undooption(i, name)
Xint i;
Xchar *name;
X{
X    char kind = rctable[i].kind;
X
X    switch (kind) {
X
X        case 'S':
X	case 'B':
X	    if (rcprevvalues[i]) {
X                *((short *)rctable[i].ptr) = rcprevvalues[i]->value;
X                strlist_eat(&rcprevvalues[i]);
X                return 1;
X            }
X            break;
X
X        case 'I':
X        case 'D':
X            if (rcprevvalues[i]) {
X                *((int *)rctable[i].ptr) = rcprevvalues[i]->value;
X                strlist_eat(&rcprevvalues[i]);
X                return 1;
X            }
X            break;
X
X        case 'L':
X            if (rcprevvalues[i]) {
X                *((long *)rctable[i].ptr) = rcprevvalues[i]->value;
X                strlist_eat(&rcprevvalues[i]);
X                return 1;
X            }
X            break;
X
X	case 'R':
X	    if (rcprevvalues[i]) {
X		*((double *)rctable[i].ptr) = atof(rcprevvalues[i]->s);
X		strlist_eat(&rcprevvalues[i]);
X		return 1;
X	    }
X	    break;
X
X        case 'C':
X        case 'U':
X            if (rcprevvalues[i]) {
X                strcpy((char *)rctable[i].ptr, rcprevvalues[i]->s);
X                strlist_eat(&rcprevvalues[i]);
X                return 1;
X            }
X            break;
X
X        case 'A':
X            strlist_remove((Strlist **)rctable[i].ptr, name);
X            return 1;
X
X        case 'X':
X            if (rctable[i].def == 1) {
X                strlist_remove((Strlist **)rctable[i].ptr, name);
X                return 1;
X            }
X            break;
X
X    }
X    return 0;
X}
X
X
X
X
Xvoid badinclude()
X{
X    warning("Can't handle an \"include\" directive here [229]");
X    inputkind = INP_INCFILE;     /* expand it in-line */
X    gettok();
X}
X
X
X
Xint handle_include(fn)
Xchar *fn;
X{
X    FILE *fp = NULL;
X    Strlist *sl;
X
X    for (sl = includedirs; sl; sl = sl->next) {
X	fp = fopen(format_s(sl->s, fn), "r");
X	if (fp) {
X	    fn = stralloc(format_s(sl->s, fn));
X	    break;
X	}
X    }
X    if (!fp) {
X        perror(fn);
X        warning(format_s("Could not open include file %s [230]", fn));
X        return 0;
X    } else {
X        if (!quietmode && !showprogress)
X	    if (outf == stdout)
X		fprintf(stderr, "Reading include file \"%s\"\n", fn);
X	    else
X		printf("Reading include file \"%s\"\n", fn);
X	if (verbose)
X	    fprintf(logf, "Reading include file \"%s\"\n", fn);
X        if (expandincludes == 0) {
X            push_input_file(fp, fn, 2);
X            curtok = TOK_INCLUDE;
X            strcpy(curtokbuf, fn);
X        } else {
X            push_input_file(fp, fn, 1);
X        }
X        return 1;
X    }
X}
X
X
X
Xint turbo_directive(closing, after)
Xchar *closing, *after;
X{
X    char *cp, *cp2;
X    int i, result;
X
X    if (!strcincmp(inbufptr, "$double", 7)) {
X	cp = inbufptr + 7;
X	while (isspace(*cp)) cp++;
X	if (cp == closing) {
X	    inbufptr = after;
X	    doublereals = 1;
X	    return 1;
X	}
X    } else if (!strcincmp(inbufptr, "$nodouble", 9)) {
X	cp = inbufptr + 9;
X	while (isspace(*cp)) cp++;
X	if (cp == closing) {
X	    inbufptr = after;
X	    doublereals = 0;
X	    return 1;
X	}
X    }
X    switch (inbufptr[2]) {
X
X        case '+':
X        case '-':
X            result = 1;
X            cp = inbufptr + 1;
X            for (;;) {
X                if (!isalpha(*cp++))
X                    return 0;
X                if (*cp != '+' && *cp != '-')
X                    return 0;
X                if (++cp == closing)
X                    break;
X                if (*cp++ != ',')
X                    return 0;
X            }
X            cp = inbufptr + 1;
X            do {
X                switch (*cp++) {
X
X                    case 'b':
X                    case 'B':
X                        if (shortcircuit < 0 && which_lang != LANG_MPW)
X                            partial_eval_flag = (*cp == '-');
X                        break;
X
X                    case 'i':
X                    case 'I':
X                        iocheck_flag = (*cp == '+');
X                        break;
X
X                    case 'r':
X                    case 'R':
X                        if (*cp == '+') {
X                            if (!range_flag)
X                                note("Range checking is ON [216]");
X                            range_flag = 1;
X                        } else {
X                            if (range_flag)
X                                note("Range checking is OFF [216]");
X                            range_flag = 0;
X                        }
X                        break;
X
X                    case 's':
X                    case 'S':
X                        if (*cp == '+') {
X                            if (!stackcheck_flag)
X                                note("Stack checking is ON [217]");
X                            stackcheck_flag = 1;
X                        } else {
X                            if (stackcheck_flag)
X                                note("Stack checking is OFF [217]");
X                            stackcheck_flag = 0;
X                        }
X                        break;
X
X                    default:
X                        result = 0;
X                        break;
X                }
X                cp++;
X            } while (*cp++ == ',');
X            if (result)
X                inbufptr = after;
X            return result;
X
X	case 'c':
X	case 'C':
X	    if (toupper(inbufptr[1]) == 'S' &&
X		(inbufptr[3] == '+' || inbufptr[3] == '-') &&
X		inbufptr + 4 == closing) {
X		if (shortcircuit < 0)
X		    partial_eval_flag = (inbufptr[3] == '+');
X		inbufptr = after;
X		return 1;
X	    }
X	    return 0;
X
X        case ' ':
X            switch (inbufptr[1]) {
X
X                case 'i':
X                case 'I':
X                    if (skipping_module)
X                        break;
X                    cp = inbufptr + 3;
X                    while (isspace(*cp)) cp++;
X                    cp2 = cp;
X                    i = 0;
X                    while (*cp2 && cp2 != closing)
X                        i++, cp2++;
X                    if (cp2 != closing)
X                        return 0;
X                    while (isspace(cp[i-1]))
X                        if (--i <= 0)
X                            return 0;
X                    inbufptr = after;
X                    cp2 = ALLOC(i + 1, char, strings);
X                    strncpy(cp2, cp, i);
X                    cp2[i] = 0;
X                    if (handle_include(cp2))
X			return 2;
X		    break;
X
X		case 's':
X		case 'S':
X		    cp = inbufptr + 3;
X		    outsection(minorspace);
X		    if (cp == closing) {
X			output("#undef __SEG__\n");
X		    } else {
X			output("#define __SEG__ ");
X			while (*cp && cp != closing)
X			    cp++;
X			if (*cp) {
X			    i = *cp;
X			    *cp = 0;
X			    output(inbufptr + 3);
X			    *cp = i;
X			}
X			output("\n");
X		    }
X		    outsection(minorspace);
X		    inbufptr = after;
X		    return 1;
X
X            }
X            return 0;
X
X	case '}':
X	case '*':
X	    if (inbufptr + 2 == closing) {
X		switch (inbufptr[1]) {
X		    
X		  case 's':
X		  case 'S':
X		    outsection(minorspace);
X		    output("#undef __SEG__\n");
X		    outsection(minorspace);
X		    inbufptr = after;
X		    return 1;
X
X		}
X	    }
X	    return 0;
X
X        case 'f':   /* $ifdef etc. */
X        case 'F':
X            if (toupper(inbufptr[1]) == 'I' &&
X                ((toupper(inbufptr[3]) == 'O' &&
X                  toupper(inbufptr[4]) == 'P' &&
X                  toupper(inbufptr[5]) == 'T') ||
X                 (toupper(inbufptr[3]) == 'D' &&
X                  toupper(inbufptr[4]) == 'E' &&
X                  toupper(inbufptr[5]) == 'F') ||
X                 (toupper(inbufptr[3]) == 'N' &&
X                  toupper(inbufptr[4]) == 'D' &&
X                  toupper(inbufptr[5]) == 'E' &&
X                  toupper(inbufptr[6]) == 'F'))) {
X                note("Turbo Pascal conditional compilation directive was ignored [218]");
X            }
X            return 0;
X
X    }
X    return 0;
X}
X
X
X
X
Xextern Strlist *addmacros;
X
Xvoid defmacro(name, kind, fname, lnum)
Xchar *name, *fname;
Xlong kind;
Xint lnum;
X{
X    Strlist *defsl, *sl, *sl2;
X    Symbol *sym, *sym2;
X    Meaning *mp;
X    Expr *ex;
X
X    defsl = NULL;
X    sl = strlist_append(&defsl, name);
X    C_lex++;
X    if (fname && !strcmp(fname, "<macro>") && curtok == TOK_IDENT)
X        fname = curtoksym->name;
X    push_input_strlist(defsl, fname);
X    if (fname)
X        inf_lnum = lnum;
X    switch (kind) {
X
X        case MAC_VAR:
X            if (!wexpecttok(TOK_IDENT))
X		break;
X	    for (mp = curtoksym->mbase; mp; mp = mp->snext) {
X		if (mp->kind == MK_VAR)
X		    warning(format_s("VarMacro must be defined before declaration of variable %s [231]", curtokcase));
X	    }
X            sl = strlist_append(&varmacros, curtoksym->name);
X            gettok();
X            if (!wneedtok(TOK_EQ))
X		break;
X            sl->value = (long)pc_expr();
X            break;
X
X        case MAC_CONST:
X            if (!wexpecttok(TOK_IDENT))
X		break;
X	    for (mp = curtoksym->mbase; mp; mp = mp->snext) {
X		if (mp->kind == MK_CONST)
X		    warning(format_s("ConstMacro must be defined before declaration of variable %s [232]", curtokcase));
X	    }
X            sl = strlist_append(&constmacros, curtoksym->name);
X            gettok();
X            if (!wneedtok(TOK_EQ))
X		break;
X            sl->value = (long)pc_expr();
X            break;
X
X        case MAC_FIELD:
X            if (!wexpecttok(TOK_IDENT))
X		break;
X            sym = curtoksym;
X            gettok();
X            if (!wneedtok(TOK_DOT))
X		break;
X            if (!wexpecttok(TOK_IDENT))
X		break;
X	    sym2 = curtoksym;
X            gettok();
X	    if (!wneedtok(TOK_EQ))
X		break;
X            funcmacroargs = NULL;
X            sym->flags |= FMACREC;
X            ex = pc_expr();
X            sym->flags &= ~FMACREC;
X	    for (mp = sym2->fbase; mp; mp = mp->snext) {
X		if (mp->rectype && mp->rectype->meaning &&
X		    mp->rectype->meaning->sym == sym)
X		    break;
X	    }
X	    if (mp) {
X		mp->constdefn = ex;
X	    } else {
X		sl = strlist_append(&fieldmacros, 
X				    format_ss("%s.%s", sym->name, sym2->name));
X		sl->value = (long)ex;
X	    }
X            break;
X
X        case MAC_FUNC:
X            if (!wexpecttok(TOK_IDENT))
X		break;
X            sym = curtoksym;
X            if (sym->mbase &&
X		(sym->mbase->kind == MK_FUNCTION ||
X		 sym->mbase->kind == MK_SPECIAL))
X                sl = NULL;
X            else
X                sl = strlist_append(&funcmacros, sym->name);
X            gettok();
X            funcmacroargs = NULL;
X            if (curtok == TOK_LPAR) {
X                do {
X                    gettok();
X		    if (curtok == TOK_RPAR && !funcmacroargs)
X			break;
X                    if (!wexpecttok(TOK_IDENT)) {
X			skiptotoken2(TOK_COMMA, TOK_RPAR);
X			continue;
X		    }
X                    sl2 = strlist_append(&funcmacroargs, curtoksym->name);
X                    sl2->value = (long)curtoksym;
X                    curtoksym->flags |= FMACREC;
X                    gettok();
X                } while (curtok == TOK_COMMA);
X                if (!wneedtok(TOK_RPAR))
X		    skippasttotoken(TOK_RPAR, TOK_EQ);
X            }
X            if (!wneedtok(TOK_EQ))
X		break;
X            if (sl)
X                sl->value = (long)pc_expr();
X            else
X                sym->mbase->constdefn = pc_expr();
X            for (sl2 = funcmacroargs; sl2; sl2 = sl2->next) {
X                sym2 = (Symbol *)sl2->value;
X                sym2->flags &= ~FMACREC;
X            }
X            strlist_empty(&funcmacroargs);
X            break;
X
X    }
X    if (curtok != TOK_EOF)
X        warning(format_s("Junk (%s) at end of macro definition [233]", tok_name(curtok)));
X    pop_input();
X    C_lex--;
X    strlist_empty(&defsl);
X}
X
X
X
Xvoid check_unused_macros()
X{
X    Strlist *sl;
X
X    if (warnmacros) {
X        for (sl = varmacros; sl; sl = sl->next)
X            warning(format_s("VarMacro %s was never used [234]", sl->s));
X        for (sl = constmacros; sl; sl = sl->next)
X            warning(format_s("ConstMacro %s was never used [234]", sl->s));
X        for (sl = fieldmacros; sl; sl = sl->next)
X            warning(format_s("FieldMacro %s was never used [234]", sl->s));
X        for (sl = funcmacros; sl; sl = sl->next)
X            warning(format_s("FuncMacro %s was never used [234]", sl->s));
X    }
X}
X
X
X
X
X
X#define skipspc(cp)   while (isspace(*cp)) cp++
X
XStatic int parsecomment(p2c_only, starparen)
Xint p2c_only, starparen;
X{
X    char namebuf[302];
X    char *cp, *cp2 = namebuf, *closing, *after;
X    char kind, chgmode, upcflag;
X    long val, oldval, sign;
X    double dval;
X    int i, tempopt, hassign;
X    Strlist *sp;
X    Symbol *sym;
X
X    if (if_flag)
X        return 0;
X    if (!p2c_only) {
X        if (!strncmp(inbufptr, noskipcomment, strlen(noskipcomment)) &&
X	     *noskipcomment) {
X            inbufptr += strlen(noskipcomment);
X	    if (skipflag < 0) {
X		curtok = TOK_ENDIF;
X		skipflag = 1;
X		return 2;
X	    }
X	    skipflag = 1;
X            return 1;
X        }
X    }
X    closing = inbufptr;
X    while (*closing && (starparen
X			? (closing[0] != '*' || closing[1] != ')')
X			: (closing[0] != '}')))
X	closing++;
X    if (!*closing)
X	return 0;
X    after = closing + (starparen ? 2 : 1);
X    cp = inbufptr;
X    while (cp < closing && (*cp != '#' || cp[1] != '#'))
X	cp++;    /* Ignore comments */
X    if (cp < closing) {
X	while (isspace(cp[-1]))
X	    cp--;
X	*cp = '#';   /* avoid skipping spaces past closing! */
X	closing = cp;
X    }
X    if (!p2c_only) {
X        if (!strncmp(inbufptr, "DUMP-SYMBOLS", 12) &&
X	     closing == inbufptr + 12) {
X            wrapup();
X            inbufptr = after;
X            return 1;
X        }
X        if (!strncmp(inbufptr, fixedcomment, strlen(fixedcomment)) &&
X	     *fixedcomment &&
X	     inbufptr + strlen(fixedcomment) == closing) {
X            fixedflag++;
X            inbufptr = after;
X            return 1;
X        }
X        if (!strncmp(inbufptr, permanentcomment, strlen(permanentcomment)) &&
X	     *permanentcomment &&
X	     inbufptr + strlen(permanentcomment) == closing) {
X            permflag = 1;
X            inbufptr = after;
X            return 1;
X        }
X        if (!strncmp(inbufptr, interfacecomment, strlen(interfacecomment)) &&
X	     *interfacecomment &&
X	     inbufptr + strlen(interfacecomment) == closing) {
X            inbufptr = after;
X	    curtok = TOK_INTFONLY;
X            return 2;
X        }
X        if (!strncmp(inbufptr, skipcomment, strlen(skipcomment)) &&
X	     *skipcomment &&
X	     inbufptr + strlen(skipcomment) == closing) {
X            inbufptr = after;
X	    skipflag = -1;
X	    skipping_module++;    /* eat comments in skipped portion */
X	    do {
X		gettok();
X	    } while (curtok != TOK_ENDIF);
X	    skipping_module--;
X            return 1;
X        }
X	if (!strncmp(inbufptr, signedcomment, strlen(signedcomment)) &&
X	     *signedcomment && !p2c_only &&
X	     inbufptr + strlen(signedcomment) == closing) {
X	    inbufptr = after;
X	    gettok();
X	    if (curtok == TOK_IDENT && curtokmeaning &&
X		curtokmeaning->kind == MK_TYPE &&
X		curtokmeaning->type == tp_char) {
X		curtokmeaning = mp_schar;
X	    } else
X		warning("{SIGNED} applied to type other than CHAR [314]");
X	    return 2;
X	}
X	if (!strncmp(inbufptr, unsignedcomment, strlen(unsignedcomment)) &&
X	     *unsignedcomment && !p2c_only &&
X	     inbufptr + strlen(unsignedcomment) == closing) {
X	    inbufptr = after;
X	    gettok();
X	    if (curtok == TOK_IDENT && curtokmeaning &&
X		curtokmeaning->kind == MK_TYPE &&
X		curtokmeaning->type == tp_char) {
X		curtokmeaning = mp_uchar;
X	    } else if (curtok == TOK_IDENT && curtokmeaning &&
X		       curtokmeaning->kind == MK_TYPE &&
X		       curtokmeaning->type == tp_integer) {
X		curtokmeaning = mp_unsigned;
X	    } else if (curtok == TOK_IDENT && curtokmeaning &&
X		       curtokmeaning->kind == MK_TYPE &&
X		       curtokmeaning->type == tp_int) {
X		curtokmeaning = mp_uint;
X	    } else
X		warning("{UNSIGNED} applied to type other than CHAR or INTEGER [313]");
X	    return 2;
X	}
X        if (*inbufptr == '$') {
X            i = turbo_directive(closing, after);
X            if (i)
X                return i;
X        }
X    }
X    tempopt = 0;
X    cp = inbufptr;
X    if (*cp == '*') {
X        cp++;
X        tempopt = 1;
X    }
X    if (!isalpha(*cp))
X        return 0;
X    while ((isalnum(*cp) || *cp == '_') && cp2 < namebuf+300)
X        *cp2++ = toupper(*cp++);
X    *cp2 = 0;
X    i = numparams;
X    while (--i >= 0 && strcmp(rctable[i].name, namebuf)) ;
X    if (i < 0)
X        return 0;
X    kind = rctable[i].kind;
X    chgmode = rctable[i].chgmode;
X    if (chgmode == ' ')    /* allowed in p2crc only */
X        return 0;
X    if (chgmode == 'T' && lex_initialized) {
X        if (cp == closing || *cp == '=' || *cp == '+' || *cp == '-')
X            warning(format_s("%s works only at top of program [235]",
X                             rctable[i].name));
X    }
X    if (cp == closing) {
X        if (kind == 'S' || kind == 'I' || kind == 'D' || kind == 'L' ||
X	    kind == 'R' || kind == 'B' || kind == 'C' || kind == 'U') {
X            undooption(i, "");
X            inbufptr = after;
X            return 1;
X        }
X    }
X    switch (kind) {
X
X        case 'S':
X        case 'I':
X        case 'L':
X            val = oldval = (kind == 'L') ? *(( long *)rctable[i].ptr) :
X                           (kind == 'S') ? *((short *)rctable[i].ptr) :
X                                           *((  int *)rctable[i].ptr);
X            switch (*cp) {
X
X                case '=':
X                    skipspc(cp);
X		    hassign = (*++cp == '-' || *cp == '+');
X                    sign = (*cp == '-') ? -1 : 1;
X		    cp += hassign;
X                    if (isdigit(*cp)) {
X                        val = 0;
X                        while (isdigit(*cp))
X                            val = val * 10 + (*cp++) - '0';
X                        val *= sign;
X			if (kind == 'D' && !hassign)
X			    val += 10000;
X                    } else if (toupper(cp[0]) == 'D' &&
X                               toupper(cp[1]) == 'E' &&
X                               toupper(cp[2]) == 'F') {
X                        val = rctable[i].def;
X                        cp += 3;
X                    }
X                    break;
X
X                case '+':
X                case '-':
X                    if (chgmode != 'R')
X                        return 0;
X                    for (;;) {
X                        if (*cp == '+')
X                            val++;
X                        else if (*cp == '-')
X                            val--;
X                        else
X                            break;
X                        cp++;
X                    }
X                    break;
X
X            }
X            skipspc(cp);
X            if (cp != closing)
X                return 0;
X            strlist_insert(&rcprevvalues[i], "")->value = oldval;
X            if (tempopt)
X                strlist_insert(&tempoptionlist, "")->value = i;
X            if (kind == 'L')
X                *((long *)rctable[i].ptr) = val;
X            else if (kind == 'S')
X                *((short *)rctable[i].ptr) = val;
X            else
X                *((int *)rctable[i].ptr) = val;
X            inbufptr = after;
X            return 1;
X
X	case 'D':
X            val = oldval = *((int *)rctable[i].ptr);
X	    if (*cp++ != '=')
X		return 0;
X	    skipspc(cp);
X	    if (toupper(cp[0]) == 'D' &&
X		toupper(cp[1]) == 'E' &&
X		toupper(cp[2]) == 'F') {
X		val = rctable[i].def;
X		cp += 3;
X	    } else {
X                cp2 = namebuf;
X                while (*cp && cp != closing && !isspace(*cp))
X                    *cp2++ = *cp++;
X		*cp2 = 0;
X		val = parsedelta(namebuf, -1);
X		if (!val)
X		    return 0;
X	    }
X	    skipspc(cp);
X            if (cp != closing)
X                return 0;
X            strlist_insert(&rcprevvalues[i], "")->value = oldval;
X            if (tempopt)
X                strlist_insert(&tempoptionlist, "")->value = i;
X            *((int *)rctable[i].ptr) = val;
X            inbufptr = after;
X            return 1;
X
X        case 'R':
X	    if (*cp++ != '=')
X		return 0;
X	    skipspc(cp);
X	    if (toupper(cp[0]) == 'D' &&
X		toupper(cp[1]) == 'E' &&
X		toupper(cp[2]) == 'F') {
X		dval = rctable[i].def / 100.0;
X		cp += 3;
X	    } else {
X		cp2 = cp;
X		while (isdigit(*cp) || *cp == '-' || *cp == '+' ||
X		       *cp == '.' || toupper(*cp) == 'E')
X		    cp++;
X		if (cp == cp2)
X		    return 0;
X		dval = atof(cp2);
X	    }
X	    skipspc(cp);
X	    if (cp != closing)
X		return 0;
X	    sprintf(namebuf, "%g", *((double *)rctable[i].ptr));
X            strlist_insert(&rcprevvalues[i], namebuf);
X            if (tempopt)
X                strlist_insert(&tempoptionlist, namebuf)->value = i;
X	    *((double *)rctable[i].ptr) = dval;
X            inbufptr = after;
X            return 1;
X
X        case 'B':
X	    if (*cp++ != '=')
X		return 0;
X	    skipspc(cp);
X	    if (toupper(cp[0]) == 'D' &&
X		toupper(cp[1]) == 'E' &&
X		toupper(cp[2]) == 'F') {
X		val = rctable[i].def;
X		cp += 3;
X	    } else {
X		val = parse_breakstr(cp);
X		while (*cp && cp != closing && !isspace(*cp))
X		    cp++;
X	    }
X	    skipspc(cp);
X	    if (cp != closing || val == -1)
X		return 0;
X            strlist_insert(&rcprevvalues[i], "")->value =
X		*((short *)rctable[i].ptr);
X            if (tempopt)
X                strlist_insert(&tempoptionlist, "")->value = i;
X	    *((short *)rctable[i].ptr) = val;
X            inbufptr = after;
X            return 1;
X
X        case 'C':
X        case 'U':
X            if (*cp == '=') {
X                cp++;
X                skipspc(cp);
X                for (cp2 = cp; cp2 != closing && !isspace(*cp2); cp2++)
X                    if (!*cp2 || cp2-cp >= rctable[i].def)
X                        return 0;
X                cp2 = (char *)rctable[i].ptr;
X                sp = strlist_insert(&rcprevvalues[i], cp2);
X                if (tempopt)
X                    strlist_insert(&tempoptionlist, "")->value = i;
X                while (cp != closing && !isspace(*cp2))
X                    *cp2++ = *cp++;
X                *cp2 = 0;
X                if (kind == 'U')
X                    upc((char *)rctable[i].ptr);
X                skipspc(cp);
X                if (cp != closing)
X                    return 0;
X                inbufptr = after;
X                if (!strcmp(rctable[i].name, "LANGUAGE") &&
X                    !strcmp((char *)rctable[i].ptr, "MODCAL"))
X                    sysprog_flag |= 2;
X                return 1;
X            }
X            return 0;
X
X        case 'F':
X        case 'G':
X            if (*cp == '=' || *cp == '+' || *cp == '-') {
X                upcflag = (kind == 'F' && !pascalcasesens);
X                chgmode = *cp++;
X                skipspc(cp);
X                cp2 = namebuf;
X                while (isalnum(*cp) || *cp == '_' || *cp == '$' || *cp == '%')
X                    *cp2++ = *cp++;
X                *cp2++ = 0;
X		if (!*namebuf)
X		    return 0;
X                skipspc(cp);
X                if (cp != closing)
X                    return 0;
X                if (upcflag)
X                    upc(namebuf);
X                sym = findsymbol(namebuf);
X		if (rctable[i].def & FUNCBREAK)
X		    sym->flags &= ~FUNCBREAK;
X                if (chgmode == '-')
X                    sym->flags &= ~rctable[i].def;
X                else
X                    sym->flags |= rctable[i].def;
X                inbufptr = after;
X                return 1;
X           }
X           return 0;
X
X        case 'A':
X            if (*cp == '=' || *cp == '+' || *cp == '-') {
X                chgmode = *cp++;
X                skipspc(cp);
X                cp2 = namebuf;
X                while (cp != closing && !isspace(*cp) && *cp)
X                    *cp2++ = *cp++;
X                *cp2++ = 0;
X                skipspc(cp);
X                if (cp != closing)
X                    return 0;
X                if (chgmode != '+')
X                    strlist_remove((Strlist **)rctable[i].ptr, namebuf);
X                if (chgmode != '-')
X                    sp = strlist_insert((Strlist **)rctable[i].ptr, namebuf);
X                if (tempopt)
X                    strlist_insert(&tempoptionlist, namebuf)->value = i;
X                inbufptr = after;
X                return 1;
X            }
X            return 0;
X
X        case 'M':
X            if (!isspace(*cp))
X                return 0;
X            skipspc(cp);
X            if (!isalpha(*cp))
X                return 0;
X            for (cp2 = cp; *cp2 && cp2 != closing; cp2++) ;
X            if (cp2 > cp && cp2 == closing) {
X                inbufptr = after;
X                cp2 = format_ds("%.*s", (int)(cp2-cp), cp);
X                if (tp_integer != NULL) {
X                    defmacro(cp2, rctable[i].def, NULL, 0);
X                } else {
X                    sp = strlist_append(&addmacros, cp2);
X                    sp->value = rctable[i].def;
X                }
X                return 1;
X            }
X            return 0;
X
X        case 'X':
X            switch (rctable[i].def) {
X
X                case 1:     /* strlist with string values */
X                    if (!isspace(*cp) && *cp != '=' && 
X                        *cp != '+' && *cp != '-')
X                        return 0;
X                    chgmode = *cp++;
X                    skipspc(cp);
X                    cp2 = namebuf;
X                    while (isalnum(*cp) || *cp == '_' ||
X			   *cp == '$' || *cp == '%' ||
X			   *cp == '.' || *cp == '-' ||
X			   (*cp == '\'' && cp[1] && cp[2] == '\'' &&
X			    cp+1 != closing && cp[1] != '=')) {
X			if (*cp == '\'') {
X			    *cp2++ = *cp++;
X			    *cp2++ = *cp++;
X			}			    
X                        *cp2++ = *cp++;
X		    }
X                    *cp2++ = 0;
X                    if (chgmode == '-') {
X                        skipspc(cp);
END_OF_FILE
if test 49580 -ne `wc -c <'src/lex.c.1'`; then
    echo shar: \"'src/lex.c.1'\" unpacked with wrong size!
fi
# end of 'src/lex.c.1'
fi
echo shar: End of archive 31 \(of 32\).
cp /dev/null ark31isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 32 archives.
    echo "Now see PACKNOTES and the README"
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
-- 
Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.