lex.c

把pascal程序转成C语言程序 把pascal程序转成C语言程序

		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++;
			}