decl.c

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

/* "p2c", a Pascal to C translator.
   Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation.
   Author's address: [e-mail].

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



#define MAXIMPORTS 100



Static struct ptrdesc {
    struct ptrdesc *next;
    Symbol *sym;
    Type *tp;
} *ptrbase;

Static struct ctxstack {
    struct ctxstack *next;
    Meaning *ctx, *ctxlast;
    struct tempvarlist *tempvars;
    int tempvarcount, importmark;
} *ctxtop;

Static struct tempvarlist {
    struct tempvarlist *next;
    Meaning *tvar;
    int active;
} *tempvars, *stmttempvars;

Static int tempvarcount;

Static int stringtypecachesize;
Static Type **stringtypecache;

Static Meaning *importlist[MAXIMPORTS];
Static int firstimport;

Static Type *tp_special_anyptr;

Static int wasaliased;
Static int deferallptrs;
Static int anydeferredptrs;
Static int silentalreadydef;
Static int nonloclabelcount;
Static int useextern;

Static Strlist *varstructdecllist;




Static Meaning *findstandardmeaning(kind, name)
enum meaningkind kind;
char *name;
{
    Meaning *mp;
    Symbol *sym;

    sym = findsymbol(fixpascalname(name));
    for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
    if (mp) {
	if (mp->kind == kind)
	    mp->refcount = 1;
	else
	    mp = NULL;
    }
    return mp;
}


Static Meaning *makestandardmeaning(kind, name)
enum meaningkind kind;
char *name;
{
    Meaning *mp;
    Symbol *sym;

    sym = findsymbol(fixpascalname(name));
    for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
    if (!mp) {
        mp = addmeaning(sym, kind);
        strchange(&mp->name, name);
        if (debug < 4)
            mp->dumped = partialdump;     /* prevent irrelevant dumping */
    } else {
        mp->kind = kind;
    }
    mp->refcount = 1;
    return mp;
}


Static Type *makestandardtype(kind, mp)
enum typekind kind;
Meaning *mp;
{
    Type *tp;

    tp = maketype(kind);
    tp->meaning = mp;
    if (mp)
        mp->type = tp;
    return tp;
}




Static Stmt *nullspecialproc(mp)
Meaning *mp;
{
    warning(format_s("Procedure %s not yet supported [118]", mp->name));
    if (curtok == TOK_LPAR)
        skipparens();
    return NULL;
}

Meaning *makespecialproc(name, handler)
char *name;
Stmt *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullspecialproc;
    mp = makestandardmeaning(MK_SPECIAL, name);
    mp->handler = (Expr *(*)())handler;
    return mp;
}



Static Stmt *nullstandardproc(ex)
Expr *ex;
{
    warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
    return makestmt_call(ex);
}

Meaning *makestandardproc(name, handler)
char *name;
Stmt *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullstandardproc;
    mp = findstandardmeaning(MK_FUNCTION, name);
    if (mp) {
	mp->handler = (Expr *(*)())handler;
	if (mp->isfunction) {
	    warning(format_s("Procedure %s was declared as a function [119]", name));
	    mp->isfunction = 0;
	}
    } else if (debug > 0)
	warning(format_s("Procedure %s was never declared [120]", name));
    return mp;
}



Static Expr *nullspecialfunc(mp)
Meaning *mp;
{
    warning(format_s("Function %s not yet supported [121]", mp->name));
    if (curtok == TOK_LPAR)
        skipparens();
    return makeexpr_long(0);
}

Meaning *makespecialfunc(name, handler)
char *name;
Expr *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullspecialfunc;
    mp = makestandardmeaning(MK_SPECIAL, name);
    mp->isfunction = 1;
    mp->handler = handler;
    return mp;
}



Static Expr *nullstandardfunc(ex)
Expr *ex;
{
    warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
    return ex;
}

Meaning *makestandardfunc(name, handler)
char *name;
Expr *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullstandardfunc;
    mp = findstandardmeaning(MK_FUNCTION, name);
    if (mp) {
	mp->handler = handler;
	if (!mp->isfunction) {
	    warning(format_s("Function %s was declared as a procedure [122]", name));
	    mp->isfunction = 1;
	}
    } else if (debug > 0)
	warning(format_s("Function %s was never declared [123]", name));
    return mp;
}




Static Expr *nullspecialvar(mp)
Meaning *mp;
{
    warning(format_s("Variable %s not yet supported [124]", mp->name));
    if (curtok == TOK_LPAR || curtok == TOK_LBR)
        skipparens();
    return makeexpr_var(mp);
}

Meaning *makespecialvar(name, handler)
char *name;
Expr *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullspecialvar;
    mp = makestandardmeaning(MK_SPVAR, name);
    mp->handler = handler;
    return mp;
}





void setup_decl()
{
    Meaning *mp, *mp2, *mp_turbo_shortint;
    Symbol *sym;
    Type *tp;
    int i;

    numimports = 0;
    firstimport = 0;
    permimports = NULL;
    stringceiling = stringceiling | 1;   /* round up to odd */
    stringtypecachesize = (stringceiling + 1) >> 1;
    stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
    curctxlast = NULL;
    curctx = NULL;   /* the meta-ctx has no parent ctx */
    curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
    strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
    ptrbase = NULL;
    tempvars = NULL;
    stmttempvars = NULL;
    tempvarcount = 0;
    deferallptrs = 0;
    silentalreadydef = 0;
    distinctdef = 0;
    varstructdecllist = NULL;
    nonloclabelcount = -1;
    useextern = -1;
    new_array_size = NULL;
    for (i = 0; i < stringtypecachesize; i++)
        stringtypecache[i] = NULL;

    tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
                     (integer16) ? "LONGINT" : "INTEGER"));
    tp_integer->smin = makeexpr_long(MININT);             /* "long" */
    tp_integer->smax = makeexpr_long(MAXINT);

    if (sizeof_int >= 32) {
        tp_int = tp_integer;                              /* "int" */
    } else {
        tp_int = makestandardtype(TK_INTEGER,
                     (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
				     : NULL);
        tp_int->smin = makeexpr_long(min_sshort);
        tp_int->smax = makeexpr_long(max_sshort);
    }
    mp = makestandardmeaning(MK_TYPE, "C_INT");
    mp->type = tp_int;
    if (!tp_int->meaning)
	tp_int->meaning = mp;

    mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
    tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
    tp_unsigned->smin = makeexpr_long(0);                 /* "unsigned long" */
    tp_unsigned->smax = makeexpr_long(MAXINT);

    if (sizeof_int >= 32) {
        tp_uint = tp_unsigned;                            /* "unsigned int" */
	mp_uint = mp_unsigned;
    } else {
	mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
        tp_uint = makestandardtype(TK_INTEGER, mp_uint);
        tp_uint->smin = makeexpr_long(0);
        tp_uint->smax = makeexpr_long(MAXINT);
    }

    tp_sint = makestandardtype(TK_INTEGER, NULL);
    tp_sint->smin = copyexpr(tp_int->smin);               /* "signed int" */
    tp_sint->smax = copyexpr(tp_int->smax);

    tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
    if (unsignedchar == 0) {
	tp_char->smin = makeexpr_long(-128);              /* "char" */
	tp_char->smax = makeexpr_long(127);
    } else {
	tp_char->smin = makeexpr_long(0);
	tp_char->smax = makeexpr_long(255);
    }

    tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
    tp_charptr->basetype = tp_char;
    tp_char->pointertype = tp_charptr;

    mp_schar = makestandardmeaning(MK_TYPE, "SCHAR");     /* "signed char" */
    tp_schar = makestandardtype(TK_CHAR, mp_schar);
    tp_schar->smin = makeexpr_long(-128);
    tp_schar->smax = makeexpr_long(127);

    mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR");     /* "unsigned char" */
    tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
    tp_uchar->smin = makeexpr_long(0);
    tp_uchar->smax = makeexpr_long(255);

    tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
    tp_boolean->smin = makeexpr_long(0);                  /* "boolean" */
    tp_boolean->smax = makeexpr_long(1);

    sym = findsymbol("Boolean");
    sym->flags |= SSYNONYM;
    strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;

    tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
                                                          /* "float" or "double" */
    mp = makestandardmeaning(MK_TYPE, "LONGREAL");
    if (doublereals)
	mp->type = tp_longreal = tp_real;
    else
	tp_longreal = makestandardtype(TK_REAL, mp);

    tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */

    mp = makestandardmeaning(MK_TYPE, "SINGLE");
    if (doublereals)
	makestandardtype(TK_REAL, mp);
    else
	mp->type = tp_real;
    makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
    mp = makestandardmeaning(MK_TYPE, "DOUBLE");
    mp->type = tp_longreal;
    mp = makestandardmeaning(MK_TYPE, "EXTENDED");
    mp->type = tp_longreal;   /* good enough */
    mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
    mp->type = tp_longreal;   /* good enough */
    mp = makestandardmeaning(MK_TYPE, "FIXED");
    mp->type = tp_longreal;
    mp = makestandardmeaning(MK_TYPE, "DECIMAL");
    mp->type = tp_longreal;

    tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
                  (integer16 == 1) ? "INTEGER" : "SWORD"));
    tp_sshort->basetype = tp_integer;                     /* "short" */
    tp_sshort->smin = makeexpr_long(min_sshort);
    tp_sshort->smax = makeexpr_long(max_sshort);

    if (integer16) {
	if (integer16 != 2) {
	    mp = makestandardmeaning(MK_TYPE, "SWORD");
	    mp->type = tp_sshort;
	}
    } else {
	mp = makestandardmeaning(MK_TYPE, "LONGINT");
	mp->type = tp_integer;
    }

    tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
    tp_ushort->basetype = tp_integer;                     /* "unsigned short" */
    tp_ushort->smin = makeexpr_long(0);
    tp_ushort->smax = makeexpr_long(max_ushort);

    mp = makestandardmeaning(MK_TYPE, "CARDINAL");
    mp->type = (integer16) ? tp_ushort : tp_unsigned;
    mp = makestandardmeaning(MK_TYPE, "LONGCARD");
    mp->type = tp_unsigned;

    if (modula2) {
	mp = makestandardmeaning(MK_TYPE, "WORD");
	mp->type = tp_integer;
    } else {
	makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
    }

    tp_sbyte = makestandardtype(TK_SUBR, NULL);           /* "signed char" */
    tp_sbyte->basetype = tp_integer;
    tp_sbyte->smin = makeexpr_long(min_schar);
    tp_sbyte->smax = makeexpr_long(max_schar);

    mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
    mp = makestandardmeaning(MK_TYPE, "SBYTE");
    if (needsignedbyte || signedchars == 1 || hassignedchar) {
	mp->type = tp_sbyte;
	if (mp_turbo_shortint)
	    mp_turbo_shortint->type = tp_sbyte;
	tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
    } else {
	mp->type = tp_sshort;
	if (mp_turbo_shortint)
	    mp_turbo_shortint->type = tp_sshort;
    }

    tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
    tp_ubyte->basetype = tp_integer;                      /* "unsigned char" */
    tp_ubyte->smin = makeexpr_long(0);
    tp_ubyte->smax = makeexpr_long(max_uchar);

    if (signedchars == 1)
        tp_abyte = tp_sbyte;                              /* "char" */
    else if (signedchars == 0)
        tp_abyte = tp_ubyte;
    else {
        tp_abyte = makestandardtype(TK_SUBR, NULL);
        tp_abyte->basetype = tp_integer;
        tp_abyte->smin = makeexpr_long(0);
        tp_abyte->smax = makeexpr_long(max_schar);
    }

    mp = makestandardmeaning(MK_TYPE, "POINTER");
    mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
    tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
    ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
    tp_anyptr->basetype = tp_void;                        /* "void *" */
    tp_void->pointertype = tp_anyptr;

    if (useAnyptrMacros == 1) {
        tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
        tp_special_anyptr->basetype = tp_integer;
        tp_special_anyptr->smin = makeexpr_long(0);
        tp_special_anyptr->smax = makeexpr_long(max_schar);
    } else
        tp_special_anyptr = NULL;

    tp_proc = maketype(TK_PROCPTR);
    tp_proc->basetype = maketype(TK_FUNCTION);
    tp_proc->basetype->basetype = tp_void;
    tp_proc->escale = 1;   /* saved "hasstaticlinks" */

    tp_cproc = maketype(TK_CPROCPTR);
    tp_cproc->basetype = maketype(TK_FUNCTION);
    tp_cproc->basetype->basetype = tp_void;
    tp_cproc->escale = 0;

    tp_str255 = makestandardtype(TK_STRING, NULL);             /* "Char []" */
    tp_str255->basetype = tp_char;
    tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
    tp_str255->indextype->basetype = tp_integer;
    tp_str255->indextype->smin = makeexpr_long(0);
    tp_str255->indextype->smax = makeexpr_long(stringceiling);

    tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
    tp_str255->pointertype = tp_strptr;
    tp_strptr->basetype = tp_str255;