/* "p2c", a Pascal to C translator.
   Copyright (C) 1989 David Gillespie.
   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.

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_LEX2_C
#include "trans.h"

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

#define EOFMARK 1

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

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

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

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->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(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) {
                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;
	}
    }
    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 'i':
                case 'I':
                    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;
            if (sym->mbase &&
		(sym->mbase->kind == MK_FUNCTION ||
		 sym->mbase->kind == MK_SPECIAL))
                sl = NULL;
            else
                sl = strlist_append(&funcmacros, sym->name);
            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;
            if (sl)
                sl->value = (long)pc_expr();
            else
                sym->mbase->constdefn = pc_expr();
            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) {
		curtok = TOK_ENDIF;
		skipflag = 1;
		return 2;
	    }
	    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 = -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 (*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++);
    *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 */
                    if (!isspace(*cp) && *cp != '=' && 
                        *cp != '+' && *cp != '-')
                        return 0;
                    chgmode = *cp++;
                    skipspc(cp);
                    cp2 = namebuf;
                    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;
                        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;
}