decl.c

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

    mp_string = makestandardmeaning(MK_TYPE, "STRING");
    tp = makestandardtype(TK_STRING, mp_string);
    tp->basetype = tp_char;
    tp->indextype = tp_str255->indextype;

    tp_smallset = maketype(TK_SMALLSET);
    tp_smallset->basetype = tp_integer;
    tp_smallset->indextype = tp_boolean;

    tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
    tp_text->basetype = makestandardtype(TK_FILE, NULL);       /* "FILE *" */
    tp_text->basetype->basetype = tp_char;
    tp_text->basetype->pointertype = tp_text;

    tp_bigtext = makestandardtype(TK_BIGFILE, makestandardmeaning(MK_TYPE, "BIGTEXT"));
    tp_bigtext->basetype = tp_char;
    tp_bigtext->meaning->name = stralloc("_TEXT");
    tp_bigtext->meaning->wasdeclared = 1;

    tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);

    mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
    mp->type = tp_text;

    mp = makestandardmeaning(MK_TYPE, "BITSET");
    mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
					    makeexpr_long(setbits-1)));
    mp->type->meaning = mp;

    mp = makestandardmeaning(MK_TYPE, "INTSET");
    mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
					    makeexpr_long(defaultsetsize-1)));
    mp->type->meaning = mp;

    mp_input = makestandardmeaning(MK_VAR, "INPUT");
    mp_input->type = tp_text;
    mp_input->name = stralloc("stdin");
    ex_input = makeexpr_var(mp_input);

    mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
    mp_output->type = tp_text;
    mp_output->name = stralloc("stdout");
    ex_output = makeexpr_var(mp_output);

    mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
    mp_stderr->type = tp_text;
    mp_stderr->name = stralloc("stderr");

    mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
    mp_escapecode->type = tp_sshort;
    mp_escapecode->name = stralloc(name_ESCAPECODE);

    mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
    mp_ioresult->type = tp_integer;
    mp_ioresult->name = stralloc(name_IORESULT);

    mp_false = makestandardmeaning(MK_CONST, "FALSE");
    mp_false->type = mp_false->val.type = tp_boolean;
    mp_false->val.i = 0;

    mp_true = makestandardmeaning(MK_CONST, "TRUE");
    mp_true->type = mp_true->val.type = tp_boolean;
    mp_true->val.i = 1;

    mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
    mp_maxint->type = mp_maxint->val.type = tp_integer;
    mp_maxint->val.i = MAXINT;
    mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
                               (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");

    mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
    mp->type = mp->val.type = tp_integer;
    mp->val.i = MAXINT;
    mp->name = stralloc("LONG_MAX");

    mp_minint = makestandardmeaning(MK_CONST, "MININT");
    mp_minint->type = mp_minint->val.type = tp_integer;
    mp_minint->val.i = MININT;
    mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
                               (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");

    mp = makestandardmeaning(MK_CONST, "MAXCHAR");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 127;
    mp->name = stralloc("CHAR_MAX");

    mp = makestandardmeaning(MK_CONST, "MINCHAR");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 0;
    mp->anyvarflag = 1;

    mp = makestandardmeaning(MK_CONST, "BELL");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 7;
    mp->anyvarflag = 1;

    mp = makestandardmeaning(MK_CONST, "TAB");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 9;
    mp->anyvarflag = 1;

    mp_str_hp = mp_str_turbo = NULL;
    mp_val_modula = mp_val_turbo = NULL;
    mp_blockread_ucsd = mp_blockread_turbo = NULL;
    mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
    mp_dec_dec = mp_dec_turbo = NULL;
}



/* This makes sure that if A imports B and then C, C's interface is not
   parsed in the environment of B */
int push_imports()
{
    int mark = firstimport;
    Meaning *mp;

    while (firstimport < numimports) {
	if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
	    for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
		mp->isactive = 0;
	}
        firstimport++;
    }
    return mark;
}



void pop_imports(mark)
int mark;
{
    Meaning *mp;

    while (firstimport > mark) {
        firstimport--;
        for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
            mp->isactive = 1;
    }
}



void import_ctx(ctx)
Meaning *ctx;
{
    Meaning *mp;
    int i;

    for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
    if (i >= numimports) {
        if (numimports == MAXIMPORTS)
            error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
        importlist[numimports++] = ctx;
    }
    for (mp = ctx->cbase; mp; mp = mp->cnext) {
        if (mp->exported)
            mp->isactive = 1;
    }
}



void perm_import(ctx)
Meaning *ctx;
{
    Meaning *mp;

    /* Import permanently, as in Turbo's "system" unit */
    for (mp = ctx->cbase; mp; mp = mp->cnext) {
        if (mp->exported)
            mp->isactive = 1;
    }
}



void unimport(mark)
int mark;
{
    Meaning *mp;

    while (numimports > mark) {
        numimports--;
	if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
	    for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
		mp->isactive = 0;
	}
    }
}




void activatemeaning(mp)
Meaning *mp;
{
    Meaning *mp2;

    if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
    mp->isactive = 1;
    if (mp->sym->mbase != mp) {     /* move to front of symbol list */
        mp2 = mp->sym->mbase;
        for (;;) {
            if (!mp2) {
		/* Not on symbol list: must be a special kludge meaning */
                return;
            }
            if (mp2->snext == mp)
                break;
            mp2 = mp2->snext;
        }
        mp2->snext = mp->snext;
        mp->snext = mp->sym->mbase;
        mp->sym->mbase = mp;
    }
}



void pushctx(ctx)
Meaning *ctx;
{
    struct ctxstack *top;

    top = ALLOC(1, struct ctxstack, ctxstacks);
    top->ctx = curctx;
    top->ctxlast = curctxlast;
    top->tempvars = tempvars;
    top->tempvarcount = tempvarcount;
    top->importmark = numimports;
    top->next = ctxtop;
    ctxtop = top;
    curctx = ctx;
    curctxlast = ctx->cbase;
    if (curctxlast) {
        activatemeaning(curctxlast);
        while (curctxlast->cnext) {
            curctxlast = curctxlast->cnext;
            activatemeaning(curctxlast);
        }
    }
    tempvars = NULL;
    tempvarcount = 0;
    if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
	progress();
}



void popctx()
{
    struct ctxstack *top;
    struct tempvarlist *tv;
    Meaning *mp;

    if (!strlist_cifind(permimports, curctx->sym->name)) {
	for (mp = curctx->cbase; mp; mp = mp->cnext) {
	    if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
	    mp->isactive = 0;
	}
    }
    top = ctxtop;
    ctxtop = top->next;
    curctx = top->ctx;
    curctxlast = top->ctxlast;
    while (tempvars) {
        tv = tempvars->next;
        FREE(tempvars);
        tempvars = tv;
    }
    tempvars = top->tempvars;
    tempvarcount = top->tempvarcount;
    unimport(top->importmark);
    FREE(top);
    if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
	progress();
}



void forget_ctx(ctx, all)
Meaning *ctx;
int all;
{
    register Meaning *mp, **mpprev, *mp2, **mpp2;

    if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase && !all)
	mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
    else
	mpprev = &ctx->cbase;
    while ((mp = *mpprev) != NULL) {
	if (all ||
	    (mp->kind != MK_PARAM &&
	     mp->kind != MK_VARPARAM)) {
	    *mpprev = mp->cnext;
	    mpp2 = &mp->sym->mbase;
	    while ((mp2 = *mpp2) != NULL && mp2 != mp)
		mpp2 = &mp2->snext;
	    if (mp2)
		*mpp2 = mp2->snext;
	    if (mp->kind == MK_CONST)
		free_value(&mp->val);
	    freeexpr(mp->constdefn);
	    if (mp->cbase)
		forget_ctx(mp, 1);
	    if (mp->kind == MK_FUNCTION && mp->val.i)
		free_stmt((Stmt *)mp->val.i);
	    strlist_empty(&mp->comments);
	    if (mp->name)
		FREE(mp->name);
	    if (mp->othername)
		FREE(mp->othername);
	    FREE(mp);
	} else
	    mpprev = &mp->cnext;
    }
}




void handle_nameof()
{
    Strlist *sl, *sl2;
    Symbol *sp;
    char *cp;

    for (sl = nameoflist; sl; sl = sl->next) {
        cp = my_strchr(sl->s, '.');
        if (cp) {
            sp = findsymbol(fixpascalname(cp + 1));
            sl2 = strlist_add(&sp->symbolnames, 
                              format_ds("%.*s", (int)(cp - sl->s), sl->s));
        } else {
            sp = findsymbol(fixpascalname(sl->s));
            sl2 = strlist_add(&sp->symbolnames, "");
        }
        sl2->value = sl->value;
        if (debug > 0)
            fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
                          sp->name, sl2->s, (char *)sl2->value);
    }
    strlist_empty(&nameoflist);
}



Static void initmeaning(mp)
Meaning *mp;
{
/*    mp->serial = curserial = ++serialcount;    */
    mp->cbase = NULL;
    mp->xnext = NULL;
    mp->othername = NULL;
    mp->type = NULL;
    mp->dtype = NULL;
    mp->needvarstruct = 0;
    mp->varstructflag = 0;
    mp->wasdeclared = 0;
    mp->isforward = 0;
    mp->isfunction = 0;
    mp->istemporary = 0;
    mp->volatilequal = 0;
    mp->constqual = 0;
    mp->warnifused = (warnnames > 0);
    mp->constdefn = NULL;
    mp->val.i = 0;
    mp->val.s = NULL;
    mp->val.type = NULL;
    mp->refcount = 1;
    mp->anyvarflag = 0;
    mp->isactive = 1;
    mp->exported = 0;
    mp->handler = NULL;
    mp->dumped = 0;
    mp->isreturn = 0;
    mp->fakeparam = 0;
    mp->namedfile = 0;
    mp->bufferedfile = 0;
    mp->isref = 0;
    mp->comments = NULL;
    mp->rectype = NULL;
}



int issafename(sp, isglobal, isdefine, isfield)
Symbol *sp;
int isglobal, isdefine, isfield;
{
    Meaning *mp;

    if ((!*alternatename1 || !strcmp(alternatename1, "%s")) &&
	(!*alternatename2 || !strcmp(alternatename2, "%s")) &&
	(!*alternatename || !strcmp(alternatename, "%s")))
	return 1;
    if (isfield && (sp->flags & AVOIDFIELD) && !reusefieldnames)
	return 0;
    if (isdefine && curctx->kind != MK_FUNCTION) {
	if (sp->flags & FWDPARAM)
	    return 0;
    }
    if (distinctdef) {
	mp = curctx->cbase;
	while (mp) {
	    if (mp->name && !strcmp(mp->name, sp->name))
		return 0;
	    mp = mp->cnext;
	}
    }
    if ((sp->flags & AVOIDNAME) ||
	(isdefine && (sp->flags & AVOIDFIELD)) ||
        (isglobal && (sp->flags & AVOIDGLOB)))
        return 0;
    else
        return 1;
}



Static Meaning *enum_tname;

void setupmeaning(mp, sym, kind, namekind)
Meaning *mp;
Symbol *sym;
enum meaningkind kind, namekind;
{
    char *name, *symfmt, *editfmt, *cp, *cp2;
    int altnum, isglobal, isdefine;
    Symbol *sym2;
    Strlist *sl;

    if (!sym)
	sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
    if (sym->mbase && sym->mbase->ctx == curctx &&
	curctx != NULL && !silentalreadydef && !distinctdef)
        alreadydef(sym);
    mp->sym = sym;
    mp->snext = sym->mbase;
    sym->mbase = mp;
    if (sym == curtoksym) {
	sym->kwtok = TOK_NONE;
	sym->flags &= ~KWPOSS;
    }
    mp->ctx = curctx;
    mp->kind = kind;
    if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
	strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
	Meaning *mp2;
	if (islower(sym->name[0]))
	    sym2 = findsymbol(strupper(sym->name));
	else
	    sym2 = findsymbol(strlower(sym->name));
	mp2 = addmeaning(sym2, MK_SYNONYM);
	mp2->xnext = mp;
    }
    if (kind == MK_VAR) {
        sl = strlist_find(varmacros, sym->name);
        if (sl) {
	    mp->kind = kind = namekind = MK_VARMAC;
            mp->constdefn = (Expr *)sl->value;
            strlist_delete(&varmacros, sl);
        }
    }
    if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
        sl = strlist_find(funcmacros, sym->name);
        if (sl) {
            mp->constdefn = (Expr *)sl->value;
            strlist_delete(&funcmacros, sl);
        }
    }
    if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
	kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
        mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
	if (blockkind == TOK_IMPORT)
	    mp->wasdeclared = 1;   /* suppress future declaration */
    } else
        mp->exported = 0;
    if (sym == curtoksym)
        name = curtokcase;
    else
        name = sym->name;
    isdefine = (namekind == MK_CONST || (namekind == MK_VARIANT && !useenum));
    isglobal = (!curctx ||
		curctx->kind != MK_FUNCTION ||
                namekind == MK_FUNCTION ||
		namekind == MK_TYPE ||
		namekind == MK_VARIANT ||
                isdefine) &&