funcs.c

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

            ex = p_expr(tp_str255);
        } else
            ex = NULL;
    } else if (nvex) {
        nex = nvex;
    } else {
	switch (code) {
	    case 0:
	        if (ex)
		    note("Can't interpret name argument in RESET [180]");
		break;
  	    case 1:
	        note("REWRITE does not specify a name [181]");
		break;
	    case 2:
		note("OPEN does not specify a name [181]");
		break;
	    case 3:
		note("APPEND does not specify a name [181]");
		break;
	}
	nex = NULL;
    }
    if (ex) {
        if (ord_type(ex->val.type)->kind == TK_INTEGER) {
	    if (!checkconst(ex, 1))
		note("Ignoring block size in binary file [182]");
            freeexpr(ex);
        } else {
	    if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
		cp = getstring(ex);
		if (strcicmp(cp, "SHARED"))
		    note(format_s("Ignoring option string \"%s\" in open [183]", cp));
	    } else
		note("Ignoring option string in open [183]");
        }
    }
    switch (code) {

        case 0:  /* reset */
            strcpy(modebuf, "r");
            break;

        case 1:  /* rewrite */
            strcpy(modebuf, "w");
            break;

        case 2:  /* open */
            strcpy(modebuf, openmode);
            break;

        case 3:  /* append */
            strcpy(modebuf, "a");
            break;

    }
    if (!*modebuf) {
        strcpy(modebuf, "r+");
    }
    if (readwriteopen == 2 ||
	(israndomfile(fex->val.type) && code != 0) ||
	(readwriteopen &&
	 fex->val.type != tp_text &&
	 fex->val.type != tp_bigtext)) {
	if (!my_strchr(modebuf, '+'))
	    strcat(modebuf, "+");
    }
    if (fex->val.type != tp_text &&
	fex->val.type != tp_bigtext &&
	binarymode != 0) {
        if (binarymode == 1)
            strcat(modebuf, "b");
        else
            note("Opening a binary file [184]");
    }
    if (!nex && fmp &&
	!is_std_file(fex) &&
	literalfilesflag > 0 &&
	(literalfilesflag == 1 ||
	 strlist_cifind(literalfiles, fmp->name))) {
	nex = makeexpr_string(fmp->name);
    }
    sp1 = NULL;
    sp2 = NULL;
    if (!nex || (isfiletype(fex->val.type, 1) && !truenex)) {
	if (isvar(fex, mp_output)) {
	    note("RESET/REWRITE ignored for file OUTPUT [319]");
	} else {
	    sp1 = makestmt_call(makeexpr_bicall_1("rewind", tp_void,
						  filebasename(copyexpr(fex))));
	    if (code == 0 || is_std_file(fex)) {
		sp1 = wrapopencheck(sp1, copyexpr(fex));
		needcheckopen = 0;
	    } else
		sp1 = makestmt_if(makeexpr_rel(EK_NE,
					       filebasename(copyexpr(fex)),
					       makeexpr_nil()),
				 sp1,
				 makestmt_assign(filebasename(copyexpr(fex)),
						 makeexpr_bicall_0("tmpfile",
								   tp_text)));
	}
    }
    if (nex || isfiletype(fex->val.type, 1)) {
	needcheckopen = 1;
	if (!strcmp(freopenname, "fclose") ||
	    !strcmp(freopenname, "fopen")) {
	    sp2 = makestmt_assign(filebasename(copyexpr(fex)),
				  makeexpr_bicall_2("fopen", tp_text,
						    copyexpr(nex),
						    makeexpr_string(modebuf)));
	    if (!strcmp(freopenname, "fclose")) {
		sp2 = makestmt_seq(makestmt_if(makeexpr_rel(EK_NE,
							    filebasename(copyexpr(fex)),
							    makeexpr_nil()),
					       makestmt_call(makeexpr_bicall_1("fclose", tp_void,
									       filebasename(copyexpr(fex)))),
					       NULL),
				   sp2);
	    }
	} else {
	    char *frname = freopenname;
	    if (fex->kind == EK_VAR && fex->val.type == tp_text &&
		((Meaning *)fex->val.i == mp_input ||
		 (Meaning *)fex->val.i == mp_output)) {
		tfex = makeexpr_var(makestmttempvar(tp_text, name_TEMP));
		frname = "freopen";
	    }
	    sp2 = makestmt_assign(filebasename(copyexpr(tfex)),
				 makeexpr_bicall_3((*frname) ? frname : "freopen",
						   tp_text,
						   copyexpr(nex),
						   makeexpr_string(modebuf),
						   filebasename(copyexpr(fex))));
	    if (!*frname) {
		sp2 = makestmt_if(makeexpr_rel(EK_NE, filebasename(copyexpr(fex)),
					       makeexpr_nil()),
				  sp2,
				  makestmt_assign(filebasename(copyexpr(fex)),
						  makeexpr_bicall_2("fopen", tp_text,
								    copyexpr(nex),
								    makeexpr_string(modebuf))));
	    }
	}
    }
    if (!sp1)
	sp = sp2;
    else if (!sp2)
	sp = sp1;
    else {
	sp = makestmt_if(makeexpr_rel(EK_NE, copyexpr(nex),
				      makeexpr_string("")),
			 sp2, sp1);
    }
    if (code == 2 && !*openmode && nex) {
        sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
						       filebasename(copyexpr(fex)),
						       makeexpr_nil()),
                                          makestmt_assign(filebasename(copyexpr(fex)),
                                                          makeexpr_bicall_2("fopen", tp_text,
                                                                            copyexpr(nex),
                                                                            makeexpr_string("w+"))),
                                          NULL));
    }
    if (FCheck(checkfileopen) && needcheckopen) {
        sp = makestmt_seq(sp, makestmt_call(
				  makeexpr_SETIO(
				      makeexpr_rel(EK_NE,
						   filebasename(copyexpr(tfex)),
						   makeexpr_nil()),
				      filenotfoundname,
				      filenamepart(tfex)
				      ? tfex : nex)));
    }
    sp = makestmt_seq(spassign, sp);
    cp = (code == 0) ? resetbufname : setupbufname;
    if (*cp &&   /* (may be eaten later, if buffering isn't needed) */
	fileisbuffered(fex, 1))
	sp = makestmt_seq(sp,
	         makestmt_call(
                     makeexpr_bicall_2(cp, tp_void, filebasename(fex),
			 makeexpr_type(filebasetype(fex->val.type)))));
    else
	freeexpr(fex);
    skipcloseparen();
    return sp;
}



Static Stmt *proc_append()
{
    return handleopen(3);
}



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


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


Static Expr *func_arctan(ex)
Expr *ex;
{
    ex = grabarg(ex, 0);
    if (atan2flag && ex->kind == EK_DIVIDE)
        return makeexpr_bicall_2("atan2", tp_longreal, 
                                 ex->args[0], ex->args[1]);
    return makeexpr_bicall_1("atan", tp_longreal, ex);
}


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



Static Stmt *proc_argv()
{
    Expr *ex, *aex, *lex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (skipcomma()) {
	aex = p_expr(tp_str255);
    } else
	return NULL;
    skipcloseparen();
    lex = makeexpr_sizeof(copyexpr(aex), 0);
    aex = makeexpr_addrstr(aex);
    return makestmt_call(makeexpr_bicall_3("P_sun_argv", tp_void,
					   aex, lex, makeexpr_arglong(ex, 0)));
}


Static Expr *func_asr()
{
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (skipcomma()) {
        if (signedshift == 0 || signedshift == 2) {
            ex = makeexpr_bicall_2("P_asr", ex->val.type, ex,
				   p_expr(tp_unsigned));
	} else {
	    ex = force_signed(ex);
	    ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
	    if (signedshift != 1)
		note("Assuming >> is an arithmetic shift [320]");
	}
	skipcloseparen();
    }
    return ex;
}


Static Expr *func_lsl()
{
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (skipcomma()) {
	ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_expr(tp_unsigned));
	skipcloseparen();
    }
    return ex;
}


Static Expr *func_lsr()
{
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (skipcomma()) {
	ex = force_unsigned(ex);
	ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
	skipcloseparen();
    }
    return ex;
}



Static Expr *func_bin()
{
    note("Using %b for binary printf format [185]");
    return handle_vax_hex(NULL, "b", 1);
}



Static Expr *func_binary(ex)
Expr *ex;
{
    char *cp;

    ex = grabarg(ex, 0);
    if (ex->kind == EK_CONST) {
        cp = getstring(ex);
        ex = makeexpr_long(my_strtol(cp, NULL, 2));
        insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
        return ex;
    } else {
        return makeexpr_bicall_3("strtol", tp_integer, 
                                 ex, makeexpr_nil(), makeexpr_long(2));
    }
}



Static Expr *handle_bitsize(next)
int next;
{
    Expr *ex;
    Type *type;
    int lpar;
    long psize;

    lpar = (curtok == TOK_LPAR);
    if (lpar)
	gettok();
    if (curtok == TOK_IDENT && curtokmeaning &&
	curtokmeaning->kind == MK_TYPE) {
        ex = makeexpr_type(curtokmeaning->type);
        gettok();
    } else
        ex = p_expr(NULL);
    type = ex->val.type;
    if (lpar)
	skipcloseparen();
    psize = 0;
    packedsize(NULL, &type, &psize, 0);
    if (psize > 0 && psize < 32 && next) {
	if (psize > 16)
	    psize = 32;
	else if (psize > 8)
	    psize = 16;
	else if (psize > 4)
	    psize = 8;
	else if (psize > 2)
	    psize = 4;
	else if (psize > 1)
	    psize = 2;
	else
	    psize = 1;
    }
    if (psize)
	return makeexpr_long(psize);
    else
	return makeexpr_times(makeexpr_sizeof(ex, 0),
			      makeexpr_long(sizeof_char ? sizeof_char : 8));
}


Static Expr *func_bitsize()
{
    return handle_bitsize(0);
}


Static Expr *func_bitnext()
{
    return handle_bitsize(1);
}



Static Expr *func_blockread()
{
    Expr *ex, *ex2, *vex, *sex, *fex;
    Type *type;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    vex = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
        gettok();
        sex = p_expr(tp_integer);
	sex = doseek(copyexpr(fex),
		     makeexpr_times(sex, makeexpr_long(512)))->exp1;
    } else
        sex = NULL;
    skipcloseparen();
    type = vex->val.type;
    ex = makeexpr_bicall_4("fread", tp_integer,
			   makeexpr_addr(vex),
			   makeexpr_long(512),
			   convert_size(type, ex2, "BLOCKREAD"),
			   filebasename(copyexpr(fex)));
    return makeexpr_comma(sex, ex);
}



Static Expr *func_blockwrite()
{
    Expr *ex, *ex2, *vex, *sex, *fex;
    Type *type;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    vex = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
        gettok();
        sex = p_expr(tp_integer);
	sex = doseek(copyexpr(fex),
		     makeexpr_times(sex, makeexpr_long(512)))->exp1;
    } else
        sex = NULL;
    skipcloseparen();
    type = vex->val.type;
    ex = makeexpr_bicall_4("fwrite", tp_integer,
			   makeexpr_addr(vex),
			   makeexpr_long(512),
			   convert_size(type, ex2, "BLOCKWRITE"),
			   filebasename(copyexpr(fex)));
    return makeexpr_comma(sex, ex);
}




Static Stmt *proc_blockread()
{
    Expr *ex, *ex2, *vex, *rex, *fex;
    Type *type;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    vex = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
        gettok();
        rex = p_expr(tp_integer);
    } else
        rex = NULL;
    skipcloseparen();
    type = vex->val.type;
    if (rex) {
        ex = makeexpr_bicall_4("fread", tp_integer,
                               makeexpr_addr(vex),
                               makeexpr_long(1),
                               convert_size(type, ex2, "BLOCKREAD"),
                               filebasename(copyexpr(fex)));
        ex = makeexpr_assign(rex, ex);
        if (!iocheck_flag)
            ex = makeexpr_comma(ex,
                                makeexpr_assign(makeexpr_var(mp_ioresult),
                                                makeexpr_long(0)));
    } else {
        ex = makeexpr_bicall_4("fread", tp_integer,
                               makeexpr_addr(vex),
                               convert_size(type, ex2, "BLOCKREAD"),
                               makeexpr_long(1),
                               filebasename(copyexpr(fex)));
        if (checkeof(fex)) {
            ex = makeexpr_SETIO(makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
				endoffilename, fex);
        }
    }
    return wrapopencheck(makestmt_call(ex), fex);
}




Static Stmt *proc_blockwrite()
{
    Expr *ex, *ex2, *vex, *rex, *fex;
    Type *type;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    vex = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
        gettok();
        rex = p_expr(tp_integer);
    } else
        rex = NULL;
    skipcloseparen();
    type = vex->val.type;
    if (rex) {
        ex = makeexpr_bicall_4("fwrite", tp_integer,
                               makeexpr_addr(vex),
                               makeexpr_long(1),
                               convert_size(type, ex2, "BLOCKWRITE"),
                               filebasename(copyexpr(fex)));
        ex = makeexpr_assign(rex, ex);
        if (!iocheck_flag)
            ex = makeexpr_comma(ex,
                                makeexpr_assign(makeexpr_var(mp_ioresult),
                                                makeexpr_long(0)));
    } else {
        ex = makeexpr_bicall_4("fwrite", tp_integer,
                               makeexpr_addr(vex),
                               convert_size(type, ex2, "BLOCKWRITE"),
                               makeexpr_long(1),
                               filebasename(copyexpr(fex)));
        if (FCheck(checkfilewrite)) {
            ex = makeexpr_SETIO(makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
				filewriteerrorname, fex);
        }
    }
    return wrapopencheck(makestmt_call(ex), fex);
}



Static Stmt *proc_bclr()