trans.c

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

        return format_d("<type %d>", (int) kind);
}

char *exprkindname(kind)
enum exprkind kind;
{
#ifdef HASDUMPS
    if ((unsigned int)kind < (unsigned int)EK_LAST)
        return exprkindnames[(int) kind];
    else
#endif /*HASDUMPS*/
        return format_d("<expr %d>", (int) kind);
}

char *stmtkindname(kind)
enum stmtkind kind;
{
#ifdef HASDUMPS
    if ((unsigned int)kind < (unsigned int)SK_LAST)
        return stmtkindnames[(int) kind];
    else
#endif /*HASDUMPS*/
        return format_d("<stmt %d>", (int) kind);
}



void dumptype(tp)
Type *tp;
{
    if (!tp) {
        fprintf(outf, "<NULL>\n");
        return;
    }
    if (ISBOGUS(tp)) {
	fprintf(outf, "0x%lX\n", (long)tp);
	return;
    }
    fprintf(outf, "      Type %lx, kind=%s", (long)tp, typekindname(tp->kind));
#ifdef HASDUMPS
    fprintf(outf, ", meaning=%lx, basetype=%lx, indextype=%lx\n",
            (long)tp->meaning, (long)tp->basetype, (long)tp->indextype);
    tp->dumped = 1;
    if (tp->basetype)
	dumptype(tp->basetype);
    if (tp->indextype)
	dumptype(tp->indextype);
#else
    fprintf(outf, "\n");
#endif /*HASDUMPS*/
}


void dumpmeaning(mp)
Meaning *mp;
{
    if (!mp) {
        fprintf(outf, "<NULL>\n");
        return;
    }
    if (ISBOGUS(mp)) {
	fprintf(outf, "0x%lX\n", (long)mp);
	return;
    }
    fprintf(outf, "   Meaning %lx, name=%s, kind=%s",
	    (long)mp, ((mp->name) ? mp->name : "<null>"),
	    meaningkindname(mp->kind));
#ifdef HASDUMPS
    fprintf(outf, ", ctx=%lx, cbase=%lx, cnext=%lx, type=%lx\n",
            (long)mp->ctx, (long)mp->cbase, (long)mp->cnext, (long)mp->type);
    if (mp->type && !mp->type->dumped)
	dumptype(mp->type);
    mp->dumped = 1;
#else
    fprintf(outf, "\n");
#endif /*HASDUMPS*/
}


void dumpsymtable(sym)
Symbol *sym;
{
    Meaning *mp;

    if (sym) {
	dumpsymtable(sym->left);
#ifdef HASDUMPS
	if ((sym->mbase && !sym->mbase->dumped) ||
	    (sym->fbase && !sym->fbase->dumped))
#endif
	    {
		fprintf(outf, "Symbol %s:\n", sym->name);
		for (mp = sym->mbase; mp; mp = mp->snext)
		    dumpmeaning(mp);
		for (mp = sym->fbase; mp; mp = mp->snext)
		    dumpmeaning(mp);
		fprintf(outf, "\n");
	    }
	dumpsymtable(sym->right);
    }
}


void dumptypename(tp, waddr)
Type *tp;
int waddr;
{
#ifdef HASDUMPS
    if (!tp) {
	fprintf(outf, "<NULL>");
	return;
    }
    if (ISBOGUS(tp)) {
	fprintf(outf, "0x%lX", (long)tp);
	return;
    }
    if (tp == tp_int)             fprintf(outf, "I");
    else if (tp == tp_sint)       fprintf(outf, "SI");
    else if (tp == tp_uint)       fprintf(outf, "UI");
    else if (tp == tp_integer)    fprintf(outf, "L");
    else if (tp == tp_unsigned)   fprintf(outf, "UL");
    else if (tp == tp_char)       fprintf(outf, "C");
    else if (tp == tp_schar)      fprintf(outf, "UC");
    else if (tp == tp_uchar)      fprintf(outf, "SC");
    else if (tp == tp_boolean)    fprintf(outf, "B");
    else if (tp == tp_longreal)   fprintf(outf, "R");
    else if (tp == tp_real)       fprintf(outf, "F");
    else if (tp == tp_anyptr)     fprintf(outf, "A");
    else if (tp == tp_void)       fprintf(outf, "V");
    else if (tp == tp_text)       fprintf(outf, "T");
    else if (tp == tp_bigtext)    fprintf(outf, "BT");
    else if (tp == tp_sshort)     fprintf(outf, "SS");
    else if (tp == tp_ushort)     fprintf(outf, "US");
    else if (tp == tp_abyte)      fprintf(outf, "AB");
    else if (tp == tp_sbyte)      fprintf(outf, "SB");
    else if (tp == tp_ubyte)      fprintf(outf, "UB");
    else if (tp == tp_str255)     fprintf(outf, "S");
    else if (tp == tp_strptr)     fprintf(outf, "SP");
    else if (tp == tp_charptr)    fprintf(outf, "CP");
    else if (tp == tp_smallset)   fprintf(outf, "SMS");
    else if (tp == tp_proc)       fprintf(outf, "PR");
    else if (tp == tp_jmp_buf)    fprintf(outf, "JB");
    else {
	if (tp->meaning && !ISBOGUS(tp->meaning) &&
	    tp->meaning->name && !ISBOGUS(tp->meaning->name) &&
	    tp->meaning->name[0]) {
	    fprintf(outf, "%s", tp->meaning->name);
	    if (tp->dumped)
		return;
	    fprintf(outf, "=");
	    waddr = 1;
	}
	if (waddr) {
	    fprintf(outf, "%lX", (long)tp);
	    if (tp->dumped)
		return;
	    fprintf(outf, ":");
	    tp->dumped = 1;
	}
	switch (tp->kind) {
	    
	  case TK_STRING:
	    fprintf(outf, "Str");
	    if (tp->structdefd)
		fprintf(outf, "Conf");
	    break;

	  case TK_SUBR:
	    dumptypename(tp->basetype, 0);
	    break;

	  case TK_POINTER:
	    fprintf(outf, "^");
	    dumptypename(tp->basetype, 0);
	    break;

	  case TK_SMALLARRAY:
	    fprintf(outf, "Sm");
	    /* fall through */

	  case TK_ARRAY:
	    fprintf(outf, "Ar");
	    if (tp->structdefd)
		fprintf(outf, "Conf");
	    fprintf(outf, "{");
	    dumptypename(tp->indextype, 0);
	    fprintf(outf, "}");
	    if (tp->smin) {
		fprintf(outf, "Skip(");
		dumpexpr(tp->smin);
		fprintf(outf, ")");
	    }
	    if (tp->smax) {
		fprintf(outf, "/");
		if (!ISBOGUS(tp->smax))
		    dumptypename(tp->smax->val.type, 0);
		fprintf(outf, "{%d%s}", tp->escale,
			tp->issigned ? "S" : "U");
	    }
	    fprintf(outf, ":");
	    dumptypename(tp->basetype, 0);
	    break;
		    
	  case TK_SMALLSET:
	    fprintf(outf, "Sm");
	    /* fall through */

	  case TK_SET:
	    fprintf(outf, "Set{");
	    dumptypename(tp->indextype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_FILE:
	    fprintf(outf, "File{");
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_BIGFILE:
	    fprintf(outf, "BigFile{");
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_FUNCTION:
	    fprintf(outf, "Func");
	    if (tp->issigned)
		fprintf(outf, "Link");
	    fprintf(outf, "{");
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  case TK_CPROCPTR:
	    fprintf(outf, "C");
	    /* fall through */

	  case TK_PROCPTR:
	    fprintf(outf, "Proc%d{", tp->escale);
	    dumptypename(tp->basetype, 0);
	    fprintf(outf, "}");
	    break;

	  default:
	    fprintf(outf, "%s", typekindname(tp->kind));
	    break;
		    
	}
	if (tp->kind != TK_ARRAY && tp->kind != TK_SMALLARRAY &&
	    (tp->smin || tp->smax)) {
	    fprintf(outf, "{");
	    dumpexpr(tp->smin);
	    fprintf(outf, "..");
	    dumpexpr(tp->smax);
	    fprintf(outf, "}");
	}
    }
#else
    fprintf(outf, "%lX", tp);
#endif
}


void dumptypename_file(f, tp)
FILE *f;
Type *tp;
{
    FILE *save = outf;
    outf = f;
    dumptypename(tp, 1);
    outf = save;
}


void dumpexpr(ex)
Expr *ex;
{
    int i;
    Type *type;
    char *name;

    if (!ex) {
        fprintf(outf, "<NULL>");
        return;
    }
    if (ISBOGUS(ex)) {
	fprintf(outf, "0x%lX", (long)ex);
	return;
    }
    if (ex->kind == EK_CONST && ex->val.type == tp_integer &&
	ex->nargs == 0 && !ex->val.s) {
	fprintf(outf, "%ld", ex->val.i);
	return;
    }
    if (ex->kind == EK_LONGCONST && ex->val.type == tp_integer &&
	ex->nargs == 0 && !ex->val.s) {
	fprintf(outf, "%ldL", ex->val.i);
	return;
    }
    name = exprkindname(ex->kind);
    if (!strncmp(name, "EK_", 3))
	name += 3;
    fprintf(outf, "%s", name);
#ifdef HASDUMPS

    type = ex->val.type;
    fprintf(outf, "/");
    dumptypename(type, 1);
    if (ex->val.i) {
        switch (ex->kind) {

            case EK_VAR:
            case EK_FUNCTION:
            case EK_CTX:
	        if (ISBOGUS(ex->val.i))
		    fprintf(outf, "[0x%lX]", ex->val.i);
		else
		    fprintf(outf, "[\"%s\"]", ((Meaning *)ex->val.i)->name);
                break;

            default:
                fprintf(outf, "[i=%ld]", ex->val.i);
                break;
        }
    }
    if (ISBOGUS(ex->val.s))
	fprintf(outf, "[0x%lX]", (long)ex->val.s);
    else if (ex->val.s) {
        switch (ex->kind) {

            case EK_BICALL:
            case EK_NAME:
            case EK_DOT:
	        fprintf(outf, "[s=\"%s\"]", ex->val.s);
                break;

            default:
                switch (ex->val.type ? ex->val.type->kind : TK_VOID) {
                    case TK_STRING:
                        fprintf(outf, "[s=%s]", makeCstring(ex->val.s, ex->val.i));
                        break;
                    case TK_REAL:
                        fprintf(outf, "[s=%s]", ex->val.s);
                        break;
                    default:
                        fprintf(outf, "[s=%lx]", (long)ex->val.s);
                }
                break;
        }
    }
    if (ex->nargs > 0) {
        fprintf(outf, "(");
        if (ex->nargs < 10) {
            for (i = 0; i < ex->nargs; i++) {
                if (i)
                    fprintf(outf, ", ");
                dumpexpr(ex->args[i]);
            }
        } else
            fprintf(outf, "...");
        fprintf(outf, ")");
    }
#endif
}


void dumpexpr_file(f, ex)
FILE *f;
Expr *ex;
{
    FILE *save = outf;
    outf = f;
    dumpexpr(ex);
    outf = save;
}


void innerdumpstmt(sp, indent)
Stmt *sp;
int indent;
{
#ifdef HASDUMPS
    if (!sp) {
        fprintf(outf, "<NULL>\n");
        return;
    }
    while (sp) {
	if (ISBOGUS(sp)) {
	    fprintf(outf, "0x%lX\n", (long)sp);
	    return;
	}
        fprintf(outf, "%s", stmtkindname(sp->kind));
        if (sp->exp1) {
            fprintf(outf, ", exp1=");
            dumpexpr(sp->exp1);
        }
        if (sp->exp2) {
            fprintf(outf, ", exp2=");
            dumpexpr(sp->exp2);
        }
        if (sp->exp3) {
            fprintf(outf, ", exp3=");
            dumpexpr(sp->exp3);
        }
	if (indent < 0) break;
        fprintf(outf, "\n");
        if (sp->stm1) {
            fprintf(outf, "%*sstm1=", indent, "");
            innerdumpstmt(sp->stm1, indent+5);
        }
        if (sp->stm2) {
            fprintf(outf, "%*sstm2=", indent, "");
            innerdumpstmt(sp->stm2, indent+5);
        }
        sp = sp->next;
        if (sp) {
            if (indent > 5)
                fprintf(outf, "%*s", indent-5, "");
            fprintf(outf, "next=");
        }
    }
#endif
}


void dumpstmt(sp, indent)
Stmt *sp;
int indent;
{
    fprintf(outf, "%*s", indent, "");
    innerdumpstmt(sp, indent);
}


void dumpstmt_file(f, sp)
FILE *f;
Stmt *sp;
{
    FILE *save = outf;
    Stmt *savenext = NULL;
    outf = f;
    if (sp) {
	savenext = sp->next;
	sp->next = NULL;
    }
    dumpstmt(sp, 5);
    if (sp)
	sp->next = savenext;
    outf = save;
}



void wrapup()
{
    int i;

    for (i = 0; i < SYMHASHSIZE; i++)
        dumpsymtable(symtab[i]);
}




void mem_summary()
{
#ifdef TEST_MALLOC
    printf("Summary of memory allocated but not freed:\n");
    printf("Total bytes = %d of %d\n", final_bytes, total_bytes);
    printf("Expressions = %d of %d\n", final_exprs, total_exprs);
    printf("Meanings =    %d of %d (%d of %d)\n",
	   final_meanings, total_meanings,
	   final_meanings / sizeof(Meaning),
	   total_meanings / sizeof(Meaning));
    printf("Strings =     %d of %d\n", final_strings, total_strings);
    printf("Symbols =     %d of %d\n", final_symbols, total_symbols);
    printf("Types =       %d of %d (%d of %d)\n", final_types, total_types,
	   final_types / sizeof(Type), total_types / sizeof(Type));
    printf("Statements =  %d of %d (%d of %d)\n", final_stmts, total_stmts,
	   final_stmts / sizeof(Stmt), total_stmts / sizeof(Stmt));
    printf("Strlists =    %d of %d\n", final_strlists, total_strlists);
    printf("Literals =    %d of %d\n", final_literals, total_literals);
    printf("Ctxstacks =   %d of %d\n", final_ctxstacks, total_ctxstacks);
    printf("Temp vars =   %d of %d\n", final_tempvars, total_tempvars);
    printf("Input recs =  %d of %d\n", final_inprecs, total_inprecs);
    printf("Parens =      %d of %d\n", final_parens, total_parens);
    printf("Ptr Descs =   %d of %d\n", final_ptrdescs, total_ptrdescs);
    printf("Other =       %d of %d\n", final_misc, total_misc);
    printf("\n");
#endif
}


#ifdef TEST_MALLOC

anyptr memlist;

anyptr test_malloc(size, total, final)
int size, *total, *final;
{
    anyptr p;

    p = malloc(size + 3*sizeof(long));
#if 1
    ((anyptr *)p)[0] = memlist;
    memlist = p;
    ((long *)p)[1] = size;
    ((int **)p)[2] = final;
    total_bytes += size;
    final_bytes += size;
    *total += size;
    *final += size;
#endif
    return (anyptr)((long *)p + 3);
}

void test_free(p)
anyptr p;
{
#if 1
    final_bytes -= ((long *)p)[1-3];
    *((int **)p)[2-3] -= ((long *)p)[1-3];
    ((long *)p)[1-3] *= -1;
#endif
}

anyptr test_realloc(p, size)
anyptr p;
int size;
{
    anyptr p2;

    p2 = test_malloc(size, &total_misc, &final_misc);
    memcpy(p2, p, size);
    test_free(p);
    return p2;
}

#endif  /* TEST_MALLOC */




/* End. */