funcs.c

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

Static int usenewdelete(tp)
Type *tp;
{
    if (newdelete)
	return 1;
    if (tp->kind == TK_POINTER && tp->basetype->kind == TK_RECORD &&
	tp->basetype->issigned)
	return 1;   /* Always use new/delete for object types */
    return 0;
}


Static Stmt *proc_dispose()
{
    Expr *ex, *destr = NULL;
    Type *type;
    Stmt *sp;
    char *name, vbuf[1000];

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_anyptr);
    type = ex->val.type->basetype;
    if (type->kind == TK_RECORD && type->issigned)
	destr = parse_constructor(type, ex);
    else
	parse_special_variant(type, vbuf);
    skipcloseparen();
    name = find_special_variant(vbuf, "SpecialFree", specialfrees, 0);
    if (!name && usenewdelete(ex->val.type)) {
	if (type->kind == TK_ARRAY || type->kind == TK_SET ||
	    type->kind == TK_STRING)
	    sp = makestmt_call(makeexpr_bin(EK_DELETE, tp_void, ex,
					    makeexpr_name("", tp_integer)));
	else
	    sp = makestmt_call(makeexpr_un(EK_DELETE, tp_void, ex));
    } else {
	if (!name)
	    name = choose_free_func(ex);
	sp = makestmt_call(makeexpr_bicall_1(name, tp_void, ex));
    }
    if (destr)
	sp = makestmt_seq(makestmt_call(destr), sp);
    return sp;
}



Static Expr *func_exp(ex)
Expr *ex;
{
    return makeexpr_bicall_1("exp", tp_longreal, grabarg(ex, 0));
}



Static Expr *func_expo(ex)
Expr *ex;
{
    Meaning *tvar;

    tvar = makestmttempvar(tp_int, name_TEMP);
    return makeexpr_comma(makeexpr_bicall_2("frexp", tp_longreal,
					    grabarg(ex, 0),
					    makeexpr_addr(makeexpr_var(tvar))),
			  makeexpr_var(tvar));
}



int is_std_file(ex)
Expr *ex;
{
    return isvar(ex, mp_input) || isvar(ex, mp_output) ||
           isvar(ex, mp_stderr);
}



Static Expr *iofunc(ex, code)
Expr *ex;
int code;
{
    Expr *ex2 = NULL, *ex3 = NULL;
    Meaning *tvar = NULL;

    if (FCheck(checkfileisopen) && !is_std_file(ex)) {
        if (isfiletype(ex->val.type, 1) ||
	    (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
            ex2 = filebasename(copyexpr(ex));
	} else {
            ex3 = ex;
            tvar = makestmttempvar(ex->val.type, name_TEMP);
            ex2 = makeexpr_var(tvar);
            ex = makeexpr_var(tvar);
        }
    }
    ex = filebasename(ex);
    switch (code) {

        case 0:  /* eof */
            if (fileisbuffered(ex, 0) && *eofbufname)
		ex = makeexpr_bicall_1(eofbufname, tp_boolean, ex);
	    else if (*eofname)
		ex = makeexpr_bicall_1(eofname, tp_boolean, ex);
	    else
		ex = makeexpr_rel(EK_NE, makeexpr_bicall_1("feof", tp_int, ex),
				         makeexpr_long(0));
            break;

        case 1:  /* eoln */
            ex = makeexpr_bicall_1(eolnname, tp_boolean, ex);
            break;

        case 2:  /* position or filepos */
            if (fileisbuffered(ex, 0) && *fileposbufname)
		ex = makeexpr_bicall_1(fileposbufname, tp_integer, ex);
	    else
		ex = makeexpr_bicall_1(fileposname, tp_integer, ex);
            break;

        case 3:  /* maxpos or filesize */
            ex = makeexpr_bicall_1(maxposname, tp_integer, ex);
            break;

    }
    if (ex2) {
        ex = makeexpr_bicall_4((iocheck_flag) ? "~~CHKIO" : name_CHKIO,
                               (code == 0 || code == 1) ? tp_boolean : tp_integer,
                               makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
			       makeexpr_name("FileNotOpen", tp_int),
                               ex, makeexpr_long(0));
    }
    if (ex3)
        ex = makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex3), ex);
    return ex;
}



Static Expr *func_eof()
{
    Expr *ex;

    if (curtok == TOK_LPAR)
        ex = p_parexpr(tp_text);
    else
        ex = makeexpr_var(mp_input);
    return iofunc(ex, 0);
}



Static Expr *func_eoln()
{
    Expr *ex;

    if (curtok == TOK_LPAR)
        ex = p_parexpr(tp_text);
    else
        ex = makeexpr_var(mp_input);
    return iofunc(ex, 1);
}



Static Stmt *proc_escape()
{
    Stmt *sp;
    Expr *ex;

    if (which_lang == LANG_TIP) {
	if (!wexpecttok(TOK_IDENT))
	    return NULL;
	if (curtokmeaning && curtokmeaning->kind == MK_LABEL) {
	    sp = makestmt(SK_GOTO);
	    sp->exp1 = makeexpr_name(format_s(name_LABEL,
					      curtokmeaning->name),
				     tp_integer);
	    gettok();
	    return sp;
	} else if (curtokmeaning && curtokmeaning == curctx &&
		   curctx->kind == MK_FUNCTION) {
	    sp = makestmt(SK_RETURN);
	    if (curctx->kind == MK_FUNCTION && curctx->isfunction) {
		sp->exp1 = makeexpr_var(curctx->cbase);
		curctx->cbase->refcount++;
	    }
	    gettok();
	    return sp;
	} else if (curtokmeaning && curtokmeaning->kind == MK_MODULE) {
	    gettok();
	    return makestmt_call(makeexpr_bicall_1("exit", tp_void,
						   makeexpr_name("EXIT_SUCCESS",
								 tp_integer)));
	} else {
	    note("Attempting to ESCAPE beyond this function [188]");
	    ex = makeexpr_name(curtokbuf, tp_integer);
	    gettok();
	    return makestmt_call(makeexpr_bicall_1("ESCAPE", tp_void, ex));
	}
    }
    if (curtok == TOK_LPAR)
        ex = p_parexpr(tp_integer);
    else
        ex = makeexpr_long(0);
    return makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int, 
                                           makeexpr_arglong(ex, 0)));
}



Static Stmt *proc_excl()
{
    Expr *vex, *ex;

    if (!skipopenparen())
	return NULL;
    vex = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    ex = p_expr(vex->val.type->indextype);
    skipcloseparen();
    if (vex->val.type->kind == TK_SMALLSET)
	return makestmt_assign(vex, makeexpr_bin(EK_BAND, vex->val.type,
						 copyexpr(vex),
						 makeexpr_un(EK_BNOT, vex->val.type,
							     makeexpr_bin(EK_LSH, vex->val.type,
									  makeexpr_longcast(makeexpr_long(1), 1),
									  ex))));
    else
	return makestmt_call(makeexpr_bicall_2(setremname, tp_void, vex,
					       makeexpr_arglong(enum_to_int(ex), 0)));
}



Stmt *proc_exit()
{
    Stmt *sp;

    if (curtok == TOK_IF) {
	gettok();
	return makestmt_if(p_expr(tp_boolean), makestmt(SK_BREAK), NULL);
    }
    if (modula2) {
	return makestmt(SK_BREAK);
    }
    if (curtok == TOK_LPAR) {
        gettok();
	if (curtok == TOK_PROGRAM ||
	    (curtok == TOK_IDENT && curtokmeaning &&
	     curtokmeaning->kind == MK_MODULE)) {
	    gettok();
	    skipcloseparen();
	    return makestmt_call(makeexpr_bicall_1("exit", tp_void,
						   makeexpr_name("EXIT_SUCCESS",
								 tp_integer)));
	}
        if (curtok != TOK_IDENT || !curtokmeaning || curtokmeaning != curctx)
            note("Attempting to EXIT beyond this function [188]");
        gettok();
	skipcloseparen();
    }
    sp = makestmt(SK_RETURN);
    if (curctx->kind == MK_FUNCTION && curctx->isfunction) {
        sp->exp1 = makeexpr_var(curctx->cbase);
        curctx->cbase->refcount++;
    }
    return sp;
}



Static Expr *file_iofunc(code, base)
int code;
long base;
{
    Expr *ex;
    Type *basetype;

    if (curtok == TOK_LPAR)
	ex = p_parexpr(tp_text);
    else
	ex = makeexpr_var(mp_input);
    if (!ex->val.type || !ex->val.type->basetype ||
	!filebasetype(ex->val.type))
	basetype = tp_char;
    else
	basetype = filebasetype(ex->val.type);
    return makeexpr_plus(makeexpr_div(iofunc(ex, code),
                                      makeexpr_sizeof(makeexpr_type(basetype), 0)),
                         makeexpr_long(base));
}



Static Expr *func_fcall()
{
    Expr *ex, *ex2, *ex3;
    Type *type, *tp;
    Meaning *mp, *tvar = NULL;
    int firstarg = 0;

    if (!skipopenparen())
	return NULL;
    ex2 = p_expr(tp_proc);
    type = ex2->val.type;
    if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
        warning("FCALL requires a function variable [209]");
	type = tp_proc;
    }
    ex = makeexpr(EK_SPCALL, 1);
    ex->val.type = type->basetype->basetype;
    ex->args[0] = copyexpr(ex2);
    if (type->escale != 0)
	ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
				    makepointertype(type->basetype));
    mp = type->basetype->fbase;
    if (mp && mp->isreturn) {    /* pointer to buffer for return value */
        tvar = makestmttempvar(ex->val.type->basetype,
            (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
        insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
        mp = mp->xnext;
	firstarg++;
    }
    if (mp) {
        if (wneedtok(TOK_COMMA))
	    ex = p_funcarglist(ex, mp, 0, 0);
    }
    if (tvar)
	ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
    skipcloseparen();
    if (type->escale != 1 || hasstaticlinks == 2) {
	freeexpr(ex2);
	return ex;
    }
    ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
    ex3 = copyexpr(ex);
    insertarg(&ex3, ex3->nargs, copyexpr(ex2));
    tp = maketype(TK_FUNCTION);
    tp->basetype = type->basetype->basetype;
    tp->fbase = type->basetype->fbase;
    tp->issigned = 1;
    ex3->args[0]->val.type = makepointertype(tp);
    return makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
			 ex3, ex);
}



Static Expr *func_filepos()
{
    return file_iofunc(2, seek_base);
}



Static Expr *func_filesize()
{
    return file_iofunc(3, 0L);
}



Static Stmt *proc_fillchar()
{
    Expr *vex, *ex, *cex;

    if (!skipopenparen())
	return NULL;
    vex = gentle_cast(makeexpr_addr(p_expr(NULL)), tp_anyptr);
    if (!skipcomma())
	return NULL;
    ex = convert_size(argbasetype(vex), p_expr(tp_integer), "FILLCHAR");
    if (!skipcomma())
	return NULL;
    cex = makeexpr_charcast(p_expr(tp_integer));
    skipcloseparen();
    return makestmt_call(makeexpr_bicall_3("memset", tp_void,
                                           vex,
                                           makeexpr_arglong(cex, 0),
                                           makeexpr_arglong(ex, (size_t_long != 0))));
}



Static Expr *func_sngl()
{
    Expr *ex;

    ex = p_parexpr(tp_real);
    return makeexpr_cast(ex, tp_real);
}



Static Expr *func_float()
{
    Expr *ex;

    ex = p_parexpr(tp_longreal);
    return makeexpr_cast(ex, tp_longreal);
}



Static Stmt *proc_flush()
{
    Expr *ex;
    Stmt *sp;

    ex = p_parexpr(tp_text);
    sp = makestmt_call(makeexpr_bicall_1("fflush", tp_void, filebasename(ex)));
    if (iocheck_flag)
        sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(mp_ioresult), 
                                              makeexpr_long(0)));
    return sp;
}



Static Expr *func_frac(ex)
Expr *ex;
{
    Meaning *tvar;

    tvar = makestmttempvar(tp_longreal, name_DUMMY);
    return makeexpr_bicall_2("modf", tp_longreal, 
                             grabarg(ex, 0),
                             makeexpr_addr(makeexpr_var(tvar)));
}



Static Stmt *proc_freemem(ex)
Expr *ex;
{
    Stmt *sp;
    Expr *vex;

    vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
    if (newdelete) {
	sp = makestmt_call(makeexpr_bin(EK_DELETE, tp_void, copyexpr(vex),
					makeexpr_name("", tp_integer)));
    } else {
	sp = makestmt_call(makeexpr_bicall_1(choose_free_func(vex),
					     tp_void, copyexpr(vex)));
    }
    if (alloczeronil) {
        sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
                         sp, NULL);
    } else
        freeexpr(vex);
    return sp;
}



Static Stmt *proc_get()
{
    Expr *ex;
    Type *type;

    if (curtok == TOK_LPAR)
	ex = p_parexpr(tp_text);
    else
	ex = makeexpr_var(mp_input);
    requirefilebuffer(ex);
    type = ex->val.type;
    if (isfiletype(type, -1) && *chargetname &&
	filebasetype(type)->kind == TK_CHAR)
	return makestmt_call(makeexpr_bicall_1(chargetname, tp_void,
					       filebasename(ex)));
    else if (isfiletype(type, -1) && *arraygetname &&
	     filebasetype(type)->kind == TK_ARRAY)
	return makestmt_call(makeexpr_bicall_2(arraygetname, tp_void,
					       filebasename(ex),
					       makeexpr_type(filebasetype(type))));
    else
	return makestmt_call(makeexpr_bicall_2(getname, tp_void,
					       filebasename(ex),
					       makeexpr_type(filebasetype(type))));
}



Static Stmt *proc_getmem(ex)
Expr *ex;
{
    Type *type;
    Expr *vex, *ex2, *sz = NULL;
    Stmt *sp;

    type = ex->args[0]->val.type;
    vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
    ex2 = ex->args[1];
    if (vex->val.type->kind == TK_POINTER)
        ex2 = convert_size(vex->val.type->basetype, ex2, "GETMEM");
    if (alloczeronil)
        sz = copyexpr(ex2);
    if (newdelete) {
	ex2 = makeexpr_cast(makeexpr_bin(EK_NEW, tp_anyptr,
					 makeexpr_type(tp_abyte),
					 ex2),
			    type);
    } else
	ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, ex2);
    sp = makestmt_assign(copyexpr(vex), ex2);
    if (malloccheck) {
        sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(vex), makeexpr_nil()),
                                          makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
                                          NULL));
    }
    if (sz && !isconstantexpr(sz)) {
        if (alloczeronil == 2)
            note("Called GETMEM with variable argument [189]");
        sp = makestmt_if(makeexpr_rel(EK_NE, sz, makeexpr_long(0)),
                         sp,
                         makestmt_assign(vex, makeexpr_nil()));
    } else
        freeexpr(vex);
    return sp;
}



Static Stmt *proc_gotoxy(ex)
Expr *ex;
{
    return makestmt_call(makeexpr_bicall_2("gotoxy", tp_void,
                                           makeexpr_arglong(ex->args[0], 0),
                                           makeexpr_arglong(ex->args[1], 0)));
}



Static Stmt *proc_halt()
{
    if (which_lang == LANG_TIP) {
	return makestmt_call(makeexpr_bicall_1("exit", tp_void,
					       makeexpr_name("EXIT_FAILURE",
							     tp_integer)));
    } else
	return proc_escape();
}



Static Expr *handle_vax_hex(ex, fmt, scale)
Expr *ex;
char *fmt;