MultiSource/Benchmarks/MallocBench/p2c/funcs.c

/* "p2c", a Pascal to C translator.
   Copyright (C) 1989, 1990, 1991 Free Software Foundation.
   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.

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




Static Strlist *enumnames;
Static int enumnamecount;



void setup_funcs()
{
    enumnames = NULL;
    enumnamecount = 0;
}





int isvar(ex, mp)
Expr *ex;
Meaning *mp;
{
    return (ex->kind == EK_VAR && (Meaning *)ex->val.i == mp);
}




char *getstring(ex)
Expr *ex;
{
    ex = makeexpr_stringify(ex);
    if (ex->kind != EK_CONST || ex->val.type->kind != TK_STRING) {
        intwarning("getstring", "Not a string literal [206]");
	return "";
    }
    return ex->val.s;
}




Expr *p_parexpr(target)
Type *target;
{
    Expr *ex;

    if (wneedtok(TOK_LPAR)) {
	ex = p_expr(target);
	if (!wneedtok(TOK_RPAR))
	    skippasttotoken(TOK_RPAR, TOK_SEMI);
    } else
	ex = p_expr(target);
    return ex;
}



Type *argbasetype(ex)
Expr *ex;
{
    if (ex->kind == EK_CAST)
        ex = ex->args[0];
    if (ex->val.type->kind == TK_POINTER)
        return ex->val.type->basetype;
    else
        return ex->val.type;
}



Type *choosetype(t1, t2)
Type *t1, *t2;
{
    if (t1 == tp_void ||
        (type_sizeof(t2, 1) && !type_sizeof(t1, 1)))
        return t2;
    else
        return t1;
}



Expr *convert_offset(type, ex2)
Type *type;
Expr *ex2;
{
    long size;
    int i;
    Value val;
    Expr *ex3;

    if (type->kind == TK_POINTER ||
        type->kind == TK_ARRAY ||
        type->kind == TK_SET ||
        type->kind == TK_STRING)
        type = type->basetype;
    size = type_sizeof(type, 1);
    if (size == 1)
        return ex2;
    val = eval_expr_pasc(ex2);
    if (val.type) {
        if (val.i == 0)
            return ex2;
        if (size && val.i % size == 0) {
            freeexpr(ex2);
            return makeexpr_long(val.i / size);
        }
    } else {     /* look for terms like "n*sizeof(foo)" */
	while (ex2->kind == EK_CAST || ex2->kind == EK_ACTCAST)
	    ex2 = ex2->args[0];
        if (ex2->kind == EK_TIMES) {
	    for (i = 0; i < ex2->nargs; i++) {
		ex3 = convert_offset(type, ex2->args[i]);
		if (ex3) {
		    ex2->args[i] = ex3;
		    return resimplify(ex2);
		}
	    }
            for (i = 0;
                 i < ex2->nargs && ex2->args[i]->kind != EK_SIZEOF;
                 i++) ;
            if (i < ex2->nargs) {
                if (ex2->args[i]->args[0]->val.type == type) {
                    delfreearg(&ex2, i);
                    if (ex2->nargs == 1)
                        return ex2->args[0];
                    else
                        return ex2;
                }
            }
        } else if (ex2->kind == EK_PLUS) {
	    ex3 = copyexpr(ex2);
	    for (i = 0; i < ex2->nargs; i++) {
		ex3->args[i] = convert_offset(type, ex3->args[i]);
		if (!ex3->args[i]) {
		    freeexpr(ex3);
		    return NULL;
		}
	    }
	    freeexpr(ex2);
	    return resimplify(ex3);
        } else if (ex2->kind == EK_SIZEOF) {
            if (ex2->args[0]->val.type == type) {
                freeexpr(ex2);
                return makeexpr_long(1);
            }
        } else if (ex2->kind == EK_NEG) {
	    ex3 = convert_offset(type, ex2->args[0]);
	    if (ex3)
                return makeexpr_neg(ex3);
        }
    }
    return NULL;
}



Expr *convert_size(type, ex, name)
Type *type;
Expr *ex;
char *name;
{
    long size;
    Expr *ex2;
    int i, okay;
    Value val;

    if (debug>2) { fprintf(outf,"convert_size("); dumpexpr(ex); fprintf(outf,")\n"); }
    while (type->kind == TK_ARRAY || type->kind == TK_STRING)
        type = type->basetype;
    if (type == tp_void)
        return ex;
    size = type_sizeof(type, 1);
    if (size == 1)
        return ex;
    while (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
	ex = ex->args[0];
    switch (ex->kind) {

        case EK_TIMES:
            for (i = 0; i < ex->nargs; i++) {
                ex2 = convert_size(type, ex->args[i], NULL);
                if (ex2) {
                    ex->args[i] = ex2;
                    return resimplify(ex);
                }
            }
            break;

        case EK_PLUS:
            okay = 1;
            for (i = 0; i < ex->nargs; i++) {
                ex2 = convert_size(type, ex->args[i], NULL);
                if (ex2)
                    ex->args[i] = ex2;
                else
                    okay = 0;
            }
            ex = distribute_plus(ex);
            if ((ex->kind != EK_TIMES || !okay) && name)
                note(format_s("Suspicious mixture of sizes in %s [173]", name));
            return ex;

        case EK_SIZEOF:
            return ex;

	default:
	    break;
    }
    val = eval_expr_pasc(ex);
    if (val.type) {
        if (val.i == 0)
            return ex;
        if (size && val.i % size == 0) {
            freeexpr(ex);
            return makeexpr_times(makeexpr_long(val.i / size),
                                  makeexpr_sizeof(makeexpr_type(type), 0));
        }
    }
    if (name) {
        note(format_s("Can't interpret size in %s [174]", name));
        return ex;
    } else
        return NULL;
}












Static Expr *func_abs()
{
    Expr *ex;
    Meaning *tvar;
    int lness;

    ex = p_parexpr(tp_integer);
    if (ex->val.type->kind == TK_REAL)
        return makeexpr_bicall_1("fabs", tp_longreal, ex);
    else {
        lness = exprlongness(ex);
        if (lness < 0)
            return makeexpr_bicall_1("abs", tp_int, ex);
        else if (lness > 0 && *absname) {
            if (ansiC > 0) {
                return makeexpr_bicall_1("labs", tp_integer, ex);
            } else if (*absname == '*' && (exprspeed(ex) >= 5 || !nosideeffects(ex, 0))) {
                tvar = makestmttempvar(tp_integer, name_TEMP);
                return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar),
                                                      ex),
                                      makeexpr_bicall_1(absname, tp_integer,
                                                        makeexpr_var(tvar)));
            } else {
                return makeexpr_bicall_1(absname, tp_integer, ex);
            }
        } else if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
            return makeexpr_cond(makeexpr_rel(EK_LT, copyexpr(ex),
                                                     makeexpr_long(0)),
                                 makeexpr_neg(copyexpr(ex)),
                                 ex);
        } else {
            tvar = makestmttempvar(tp_integer, name_TEMP);
            return makeexpr_cond(makeexpr_rel(EK_LT, makeexpr_assign(makeexpr_var(tvar),
                                                                     ex),
                                                     makeexpr_long(0)),
                                 makeexpr_neg(makeexpr_var(tvar)),
                                 makeexpr_var(tvar));
        }
    }
}



Static Expr *func_addr()
{
    Expr *ex, *ex2, *ex3;
    Type *type, *tp2;
    int haspar;

    haspar = wneedtok(TOK_LPAR);
    ex = p_expr(tp_proc);
    if (curtok == TOK_COMMA) {
        gettok();
        ex2 = p_expr(tp_integer);
        ex3 = convert_offset(ex->val.type, ex2);
        if (checkconst(ex3, 0)) {
            ex = makeexpr_addrf(ex);
        } else {
            ex = makeexpr_addrf(ex);
            if (ex3) {
                ex = makeexpr_plus(ex, ex3);
            } else {
                note("Don't know how to reduce offset for ADDR [175]");
                type = makepointertype(tp_abyte);
		tp2 = ex->val.type;
                ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
            }
        }
    } else {
	if ((ex->val.type->kind != TK_PROCPTR &&
	     ex->val.type->kind != TK_CPROCPTR) ||
	    (ex->kind == EK_VAR &&
	     ex->val.type == ((Meaning *)ex->val.i)->type))
	    ex = makeexpr_addrf(ex);
    }
    if (haspar) {
	if (!wneedtok(TOK_RPAR))
	    skippasttotoken(TOK_RPAR, TOK_SEMI);
    }
    return ex;
}


Static Expr *func_iaddress()
{
    return makeexpr_cast(func_addr(), tp_integer);
}



Static Expr *func_addtopointer()
{
    Expr *ex, *ex2, *ex3;
    Type *type, *tp2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_anyptr);
    if (skipcomma()) {
	ex2 = p_expr(tp_integer);
    } else
	ex2 = makeexpr_long(0);
    skipcloseparen();
    ex3 = convert_offset(ex->val.type, ex2);
    if (!checkconst(ex3, 0)) {
	if (ex3) {
	    ex = makeexpr_plus(ex, ex3);
	} else {
	    note("Don't know how to reduce offset for ADDTOPOINTER [175]");
	    type = makepointertype(tp_abyte);
	    tp2 = ex->val.type;
	    ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
	}
    }
    return ex;
}



Stmt *proc_assert()
{
    Expr *ex;

    ex = p_parexpr(tp_boolean);
    return makestmt_call(makeexpr_bicall_1("assert", tp_void, ex));
}



Stmt *wrapopencheck(sp, fex)
Stmt *sp;
Expr *fex;
{
    Stmt *sp2;

    if (FCheck(checkfileisopen) && !is_std_file(fex)) {
        sp2 = makestmt(SK_IF);
        sp2->exp1 = makeexpr_rel(EK_NE, filebasename(fex), makeexpr_nil());
        sp2->stm1 = sp;
        if (iocheck_flag) {
            sp2->stm2 = makestmt_call(makeexpr_bicall_1(name_ESCIO, tp_integer,
							makeexpr_name(filenotopenname, tp_int)));
        } else {
            sp2->stm2 = makestmt_assign(makeexpr_var(mp_ioresult),
					makeexpr_name(filenotopenname, tp_int));
        }
        return sp2;
    } else {
        freeexpr(fex);
        return sp;
    }
}



Static Expr *checkfilename(nex)
Expr *nex;
{
    Expr *ex;

    nex = makeexpr_stringcast(nex);
    if (nex->kind == EK_CONST && nex->val.type->kind == TK_STRING) {
        switch (which_lang) {

            case LANG_HP:
                if (!strncmp(nex->val.s, "#1:", 3) ||
                    !strncmp(nex->val.s, "console:", 8) ||
                    !strncmp(nex->val.s, "CONSOLE:", 8)) {
                    freeexpr(nex);
                    nex = makeexpr_string("/dev/tty");
                } else if (!strncmp(nex->val.s, "#2:", 3) ||
                           !strncmp(nex->val.s, "systerm:", 8) ||
                           !strncmp(nex->val.s, "SYSTERM:", 8)) {
                    freeexpr(nex);
                    nex = makeexpr_string("/dev/tty");     /* should do more? */
                } else if (!strncmp(nex->val.s, "#6:", 3) ||
                           !strncmp(nex->val.s, "printer:", 8) ||
                           !strncmp(nex->val.s, "PRINTER:", 8)) {
                    note("Opening a file named PRINTER: [176]");
                } else if (my_strchr(nex->val.s, ':')) {
                    note("Opening a file whose name contains a ':' [177]");
                }
                break;

            case LANG_TURBO:
                if (checkstring(nex, "con") ||
                    checkstring(nex, "CON") ||
                    checkstring(nex, "")) {
                    freeexpr(nex);
                    nex = makeexpr_string("/dev/tty");
                } else if (checkstring(nex, "nul") ||
                           checkstring(nex, "NUL")) {
                    freeexpr(nex);
                    nex = makeexpr_string("/dev/null");
                } else if (checkstring(nex, "lpt1") ||
                           checkstring(nex, "LPT1") ||
                           checkstring(nex, "lpt2") ||
                           checkstring(nex, "LPT2") ||
                           checkstring(nex, "lpt3") ||
                           checkstring(nex, "LPT3") ||
                           checkstring(nex, "com1") ||
                           checkstring(nex, "COM1") ||
                           checkstring(nex, "com2") ||
                           checkstring(nex, "COM2")) {
                    note("Opening a DOS device file name [178]");
                }
                break;

	    default:
		break;
        }
    } else {
	if (*filenamefilter && strcmp(filenamefilter, "0")) {
	    ex = makeexpr_sizeof(copyexpr(nex), 0);
	    nex = makeexpr_bicall_2(filenamefilter, tp_str255, nex, ex);
	} else
	    nex = makeexpr_stringify(nex);
    }
    return nex;
}



Static Stmt *assignfilename(fex, nex)
Expr *fex, *nex;
{
    Meaning *mp;
    Expr *nvex;

    nvex = filenamepart(fex);
    if (nvex) {
        freeexpr(fex);
        return makestmt_call(makeexpr_assign(nvex, nex));
    } else {
	mp = isfilevar(fex);
        if (mp)
            warning("Don't know how to ASSIGN to a non-explicit file variable [207]");
        else
            note("Encountered an ASSIGN statement [179]");
        return makestmt_call(makeexpr_bicall_2("assign", tp_void, fex, nex));
    }
}



Static Stmt *proc_assign()
{
    Expr *fex, *nex;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    nex = checkfilename(p_expr(tp_str255));
    skipcloseparen();
    return assignfilename(fex, nex);
}



Static Stmt *handleopen(code)
int code;
{
    Stmt *sp, *sp1, *sp2, *spassign;
    Expr *fex, *nex, *ex, *truenex, *nvex;
    Meaning *fmp;
    int needcheckopen = 1;
    char modebuf[5], *cp;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    fmp = isfilevar(fex);
    nvex = filenamepart(fex);
    truenex = NULL;
    spassign = NULL;
    if (curtok == TOK_COMMA) {
        gettok();
        ex = p_expr(tp_str255);
    } else
        ex = NULL;
    if (ex && (ex->val.type->kind == TK_STRING ||
	       ex->val.type->kind == TK_ARRAY)) {
        nex = checkfilename(ex);
        if (nvex) {
            spassign = assignfilename(copyexpr(fex), nex);
            nex = nvex;
        }
	truenex = nex;
        if (curtok == TOK_COMMA) {
            gettok();
            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 ||
	(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 {
	    sp2 = makestmt_assign(filebasename(copyexpr(fex)),
				 makeexpr_bicall_3((*freopenname) ? freopenname : "freopen",
						   tp_text,
						   copyexpr(nex),
						   makeexpr_string(modebuf),
						   filebasename(copyexpr(fex))));
	    if (!*freopenname) {
		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 (nex)
	freeexpr(nex);
    if (FCheck(checkfileopen) && needcheckopen) {
        sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
                                                              makeexpr_rel(EK_NE, filebasename(copyexpr(fex)), makeexpr_nil()),
							      makeexpr_name(filenotfoundname, tp_int))));
    }
    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_bicall_2(name_SETIO, tp_void,
                                   makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
				   makeexpr_name(endoffilename, tp_int));
        }
    }
    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_bicall_2(name_SETIO, tp_void,
                                   makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
				   makeexpr_name(filewriteerrorname, tp_int));
        }
    }
    return wrapopencheck(makestmt_call(ex), fex);
}



Static Stmt *proc_bclr()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    skipcloseparen();
    return makestmt_assign(ex,
			   makeexpr_bin(EK_BAND, ex->val.type,
					copyexpr(ex),
					makeexpr_un(EK_BNOT, ex->val.type,
					makeexpr_bin(EK_LSH, tp_integer,
						     makeexpr_arglong(
						         makeexpr_long(1), 1),
						     ex2))));
}



Static Stmt *proc_bset()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    skipcloseparen();
    return makestmt_assign(ex,
			   makeexpr_bin(EK_BOR, ex->val.type,
					copyexpr(ex),
					makeexpr_bin(EK_LSH, tp_integer,
						     makeexpr_arglong(
						         makeexpr_long(1), 1),
						     ex2)));
}



Static Expr *func_bsl()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    skipcloseparen();
    return makeexpr_bin(EK_LSH, tp_integer, ex, ex2);
}



Static Expr *func_bsr()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    skipcloseparen();
    return makeexpr_bin(EK_RSH, tp_integer, force_unsigned(ex), ex2);
}



Static Expr *func_btst()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    skipcloseparen();
    return makeexpr_rel(EK_NE,
			makeexpr_bin(EK_BAND, tp_integer,
				     ex,
				     makeexpr_bin(EK_LSH, tp_integer,
						  makeexpr_arglong(
						      makeexpr_long(1), 1),
						  ex2)),
			makeexpr_long(0));
}



Static Expr *func_byteread()
{
    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), sex)->exp1;
    } else
        sex = NULL;
    skipcloseparen();
    type = vex->val.type;
    ex = makeexpr_bicall_4("fread", tp_integer,
			   makeexpr_addr(vex),
			   makeexpr_long(1),
			   convert_size(type, ex2, "BYTEREAD"),
			   filebasename(copyexpr(fex)));
    return makeexpr_comma(sex, ex);
}



Static Expr *func_bytewrite()
{
    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), sex)->exp1;
    } else
        sex = NULL;
    skipcloseparen();
    type = vex->val.type;
    ex = makeexpr_bicall_4("fwrite", tp_integer,
			   makeexpr_addr(vex),
			   makeexpr_long(1),
			   convert_size(type, ex2, "BYTEWRITE"),
			   filebasename(copyexpr(fex)));
    return makeexpr_comma(sex, ex);
}



Static Expr *func_byte_offset()
{
    Type *tp;
    Meaning *mp;
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    tp = p_type(NULL);
    if (!skipcomma())
	return NULL;
    if (!wexpecttok(TOK_IDENT))
	return NULL;
    mp = curtoksym->fbase;
    while (mp && mp->rectype != tp)
	mp = mp->snext;
    if (!mp)
	ex = makeexpr_name(curtokcase, tp_integer);
    else
	ex = makeexpr_name(mp->name, tp_integer);
    gettok();
    skipcloseparen();
    return makeexpr_bicall_2("OFFSETOF", (size_t_long) ? tp_integer : tp_int,
			     makeexpr_type(tp), ex);
}



Static Stmt *proc_call()
{
    Expr *ex, *ex2, *ex3;
    Type *type, *tp;
    Meaning *mp;

    if (!skipopenparen())
	return NULL;
    ex2 = p_expr(tp_proc);
    type = ex2->val.type;
    if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
        warning("CALL requires a procedure variable [208]");
	type = tp_proc;
    }
    ex = makeexpr(EK_SPCALL, 1);
    ex->val.type = tp_void;
    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) {
        if (wneedtok(TOK_COMMA))
	    ex = p_funcarglist(ex, mp, 0, 0);
    }
    skipcloseparen();
    if (type->escale != 1 || hasstaticlinks == 2) {
	freeexpr(ex2);
	return makestmt_call(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 makestmt_if(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
                       makestmt_call(ex3),
                       makestmt_call(ex));
}



Static Expr *func_chr()
{
    Expr *ex;

    ex = p_expr(tp_integer);
    if ((exprlongness(ex) < 0 || ex->kind == EK_CAST) && ex->kind != EK_ACTCAST)
        ex->val.type = tp_char;
    else
        ex = makeexpr_cast(ex, tp_char);
    return ex;
}



Static Stmt *proc_close()
{
    Stmt *sp;
    Expr *fex, *ex;
    char *opt;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    sp = makestmt_if(makeexpr_rel(EK_NE, filebasename(copyexpr(fex)),
				  makeexpr_nil()),
                     makestmt_call(makeexpr_bicall_1("fclose", tp_void,
                                                     filebasename(copyexpr(fex)))),
                     (FCheck(checkfileisopen))
		         ? makestmt_call(
			     makeexpr_bicall_1(name_ESCIO,
					       tp_integer,
					       makeexpr_name(filenotopenname,
							     tp_int)))
                         : NULL);
    if (curtok == TOK_COMMA) {
        gettok();
	opt = "";
	if (curtok == TOK_IDENT &&
	    (!strcicmp(curtokbuf, "LOCK") ||
	     !strcicmp(curtokbuf, "PURGE") ||
	     !strcicmp(curtokbuf, "NORMAL") ||
	     !strcicmp(curtokbuf, "CRUNCH"))) {
	    opt = stralloc(curtokbuf);
	    gettok();
	} else {
	    ex = p_expr(tp_str255);
	    if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING)
		opt = ex->val.s;
	}
	if (!strcicmp(opt, "PURGE")) {
	    note("File is being closed with PURGE option [186]");
        }
    }
    sp = makestmt_seq(sp, makestmt_assign(filebasename(fex), makeexpr_nil()));
    skipcloseparen();
    return sp;
}



Static Expr *func_concat()
{
    Expr *ex;

    if (!skipopenparen())
	return makeexpr_string("oops");
    ex = p_expr(tp_str255);
    while (curtok == TOK_COMMA) {
        gettok();
        ex = makeexpr_concat(ex, p_expr(tp_str255), 0);
    }
    skipcloseparen();
    return ex;
}



Static Expr *func_copy(ex)
Expr *ex;
{
    if (isliteralconst(ex->args[3], NULL) == 2 &&
        ex->args[3]->val.i >= stringceiling) {
        return makeexpr_bicall_3("sprintf", ex->val.type,
                                 ex->args[0],
                                 makeexpr_string("%s"),
                                 bumpstring(ex->args[1], 
                                            makeexpr_unlongcast(ex->args[2]), 1));
    }
    if (checkconst(ex->args[2], 1)) {
        return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
                                                ex->args[2], ex->args[3]));
    }
    return makeexpr_bicall_4(strsubname, ex->val.type,
                             ex->args[0],
                             ex->args[1],
                             makeexpr_arglong(ex->args[2], 0),
                             makeexpr_arglong(ex->args[3], 0));
}



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


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



Static Stmt *proc_cycle()
{
    return makestmt(SK_CONTINUE);
}



Static Stmt *proc_date()
{
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_str255);
    skipcloseparen();
    return makestmt_call(makeexpr_bicall_1("VAXdate", tp_integer, ex));
}


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

    if (!skipopenparen())
	return NULL;
    vex = p_expr(NULL);
    if (curtok == TOK_COMMA) {
        gettok();
        ex = p_expr(tp_integer);
    } else
        ex = makeexpr_long(1);
    skipcloseparen();
    return makestmt_assign(vex, makeexpr_minus(copyexpr(vex), ex));
}



Static Expr *func_dec()
{
    return handle_vax_hex(NULL, "d", 0);
}



Static Stmt *proc_delete(ex)
Expr *ex;
{
    if (ex->nargs == 1)   /* Kludge for Oregon Software Pascal's delete(f) */
	return makestmt_call(makeexpr_bicall_1(strdeletename, tp_void, ex->args[0]));
    return makestmt_call(makeexpr_bicall_3(strdeletename, tp_void,
                                           ex->args[0], 
                                           makeexpr_arglong(ex->args[1], 0),
                                           makeexpr_arglong(ex->args[2], 0)));
}



void parse_special_variant(tp, buf)
Type *tp;
char *buf;
{
    char *cp;
    Expr *ex;

    if (!tp)
	intwarning("parse_special_variant", "tp == NULL");
    if (!tp || tp->meaning == NULL) {
	*buf = 0;
	if (curtok == TOK_COMMA) {
	    skiptotoken(TOK_RPAR);
	}
	return;
    }
    strcpy(buf, tp->meaning->name);
    while (curtok == TOK_COMMA) {
	gettok();
	cp = buf + strlen(buf);
	*cp++ = '.';
	if (curtok == TOK_MINUS) {
	    *cp++ = '-';
	    gettok();
	}
	if (curtok == TOK_INTLIT ||
	    curtok == TOK_HEXLIT ||
	    curtok == TOK_OCTLIT) {
	    sprintf(cp, "%ld", curtokint);
	    gettok();
	} else if (curtok == TOK_HAT || curtok == TOK_STRLIT) {
	    ex = makeexpr_charcast(accumulate_strlit());
	    if (ex->kind == EK_CONST) {
		if (ex->val.i <= 32 || ex->val.i > 126 ||
		    ex->val.i == '\'' || ex->val.i == '\\' ||
		    ex->val.i == '=' || ex->val.i == '}')
		    sprintf(cp, "%ld", ex->val.i);
		else
		    strcpy(cp, makeCchar(ex->val.i));
	    } else {
		*buf = 0;
		*cp = 0;
	    }
	    freeexpr(ex);
	} else {
	    if (!wexpecttok(TOK_IDENT)) {
		skiptotoken(TOK_RPAR);
		return;
	    }
	    if (curtokmeaning)
		strcpy(cp, curtokmeaning->name);
	    else
		strcpy(cp, curtokbuf);
	    gettok();
	}
    }
}


char *find_special_variant(buf, spname, splist, need)
char *buf, *spname;
Strlist *splist;
int need;
{
    Strlist *best = NULL;
    int len, bestlen = -1;
    char *cp, *cp2;

    if (!*buf)
	return NULL;
    while (splist) {
	cp = splist->s;
	cp2 = buf;
	while (*cp && toupper(*cp) == toupper(*cp2))
	    cp++, cp2++;
	len = cp2 - buf;
	if (!*cp && (!*cp2 || *cp2 == '.') && len > bestlen) {
	    best = splist;
	    bestlen = len;
	}
	splist = splist->next;
    }
    if (bestlen != strlen(buf) && my_strchr(buf, '.')) {
	if ((need & 1) || bestlen >= 0) {
	    if (need & 2)
		return NULL;
	    if (spname)
		note(format_ss("No %s form known for %s [187]",
			       spname, strupper(buf)));
	}
    }
    if (bestlen >= 0)
	return (char *)best->value;
    else
	return NULL;
}



Static char *choose_free_func(ex)
Expr *ex;
{
    if (!*freename) {
	if (!*freervaluename)
	    return "free";
	else
	    return freervaluename;
    }
    if (!*freervaluename)
	return freervaluename;
    if (expr_is_lvalue(ex))
	return freename;
    else
	return freervaluename;
}


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

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_anyptr);
    type = ex->val.type->basetype;
    parse_special_variant(type, vbuf);
    skipcloseparen();
    name = find_special_variant(vbuf, "SpecialFree", specialfrees, 0);
    if (!name)
	name = choose_free_func(ex);
    return makestmt_call(makeexpr_bicall_1(name, tp_void, ex));
}



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("~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()
{
    Expr *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 (modula2) {
	return makestmt(SK_BREAK);
    }
    if (curtok == TOK_LPAR) {
        gettok();
	if (curtok == TOK_PROGRAM ||
	    (curtok == TOK_IDENT && 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, 1L);
}



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);
    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;
{
    Expr *vex, *ex2, *sz = NULL;
    Stmt *sp;

    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);
    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 Expr *handle_vax_hex(ex, fmt, scale)
Expr *ex;
char *fmt;
int scale;
{
    Expr *lex, *dex, *vex;
    Meaning *tvar;
    Type *tp;
    long smin, smax;
    int bits;

    if (!ex) {
	if (!skipopenparen())
	    return NULL;
	ex = p_expr(tp_integer);
    }
    tp = true_type(ex);
    if (ord_range(tp, &smin, &smax))
	bits = typebits(smin, smax);
    else
	bits = 32;
    if (curtok == TOK_COMMA) {
	gettok();
	if (curtok != TOK_COMMA)
	    lex = makeexpr_arglong(p_expr(tp_integer), 0);
	else
	    lex = NULL;
    } else
	lex = NULL;
    if (!lex) {
	if (!scale)
	    lex = makeexpr_long(11);
	else
	    lex = makeexpr_long((bits+scale-1) / scale + 1);
    }
    if (curtok == TOK_COMMA) {
	gettok();
	dex = makeexpr_arglong(p_expr(tp_integer), 0);
    } else {
	if (!scale)
	    dex = makeexpr_long(10);
	else
	    dex = makeexpr_long((bits+scale-1) / scale);
    }
    if (lex->kind == EK_CONST && dex->kind == EK_CONST &&
	lex->val.i < dex->val.i)
	lex = NULL;
    skipcloseparen();
    tvar = makestmttempvar(tp_str255, name_STRING);
    vex = makeexpr_var(tvar);
    ex = makeexpr_forcelongness(ex);
    if (exprlongness(ex) > 0)
	fmt = format_s("l%s", fmt);
    if (checkconst(lex, 0) || checkconst(lex, 1))
	lex = NULL;
    if (checkconst(dex, 0) || checkconst(dex, 1))
	dex = NULL;
    if (lex) {
	if (dex)
	    ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
				   makeexpr_string(format_s("%%*.*%s", fmt)),
				   lex, dex, ex);
	else
	    ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
				   makeexpr_string(format_s("%%*%s", fmt)),
				   lex, ex);
    } else {
	if (dex)
	    ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
				   makeexpr_string(format_s("%%.*%s", fmt)),
				   dex, ex);
	else
	    ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
				   makeexpr_string(format_s("%%%s", fmt)),
				   ex);
    }
    return ex;
}




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

    if (!skipopenparen())
	return NULL;
    ex = makeexpr_stringcast(p_expr(tp_integer));
    if ((ex->val.type->kind == TK_STRING ||
	 ex->val.type == tp_strptr) &&
	curtok != TOK_COMMA) {
	skipcloseparen();
	if (ex->kind == EK_CONST) {    /* HP Pascal */
	    cp = getstring(ex);
	    ex = makeexpr_long(my_strtol(cp, NULL, 16));
	    insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
	    return ex;
	} else {
	    return makeexpr_bicall_3("strtol", tp_integer, 
				     ex, makeexpr_nil(), makeexpr_long(16));
	}
    } else {    /* VAX Pascal */
	return handle_vax_hex(ex, "x", 4);
    }
}



Static Expr *func_hi()
{
    Expr *ex;

    ex = force_unsigned(p_parexpr(tp_integer));
    return makeexpr_bin(EK_RSH, tp_ubyte,
                        ex, makeexpr_long(8));
}



Static Expr *func_high()
{
    Expr *ex;
    Type *type;

    ex = p_parexpr(tp_integer);
    type = ex->val.type;
    if (type->kind == TK_POINTER)
	type = type->basetype;
    if (type->kind == TK_ARRAY ||
	type->kind == TK_SMALLARRAY) {
	ex = makeexpr_minus(copyexpr(type->indextype->smax),
			    copyexpr(type->indextype->smin));
    } else {
	warning("HIGH requires an array name parameter [210]");
	ex = makeexpr_bicall_1("HIGH", tp_int, ex);
    }
    return ex;
}



Static Expr *func_hiword()
{
    Expr *ex;

    ex = force_unsigned(p_parexpr(tp_unsigned));
    return makeexpr_bin(EK_RSH, tp_unsigned,
                        ex, makeexpr_long(16));
}



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

    if (!skipopenparen())
	return NULL;
    vex = p_expr(NULL);
    if (curtok == TOK_COMMA) {
        gettok();
        ex = p_expr(tp_integer);
    } else
        ex = makeexpr_long(1);
    skipcloseparen();
    return makestmt_assign(vex, makeexpr_plus(copyexpr(vex), ex));
}



Static Stmt *proc_incl()
{
    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_BOR, vex->val.type,
						 copyexpr(vex),
						 makeexpr_bin(EK_LSH, vex->val.type,
							      makeexpr_longcast(makeexpr_long(1), 1),
							      ex)));
    else
	return makestmt_call(makeexpr_bicall_2(setaddname, tp_void, vex,
					       makeexpr_arglong(enum_to_int(ex), 0)));
}



Static Stmt *proc_insert(ex)
Expr *ex;
{
    return makestmt_call(makeexpr_bicall_3(strinsertname, tp_void,
                                           ex->args[0], 
                                           ex->args[1],
                                           makeexpr_arglong(ex->args[2], 0)));
}



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

    ex = p_parexpr(tp_integer);
    if (ex->val.type->kind == TK_REAL) {    /* Turbo Pascal INT */
	tvar = makestmttempvar(tp_longreal, name_TEMP);
	return makeexpr_comma(makeexpr_bicall_2("modf", tp_longreal,
						grabarg(ex, 0),
						makeexpr_addr(makeexpr_var(tvar))),
			      makeexpr_var(tvar));
    } else {     /* VAX Pascal INT */
	return makeexpr_ord(ex);
    }
}


Static Expr *func_uint()
{
    Expr *ex;

    ex = p_parexpr(tp_integer);
    return makeexpr_cast(ex, tp_unsigned);
}



Static Stmt *proc_leave()
{
    return makestmt(SK_BREAK);
}



Static Expr *func_lo()
{
    Expr *ex;

    ex = gentle_cast(p_parexpr(tp_integer), tp_ushort);
    return makeexpr_bin(EK_BAND, tp_ubyte,
                        ex, makeexpr_long(255));
}


Static Expr *func_loophole()
{
    Type *type;
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    type = p_type(NULL);
    if (!skipcomma())
	return NULL;
    ex = p_expr(tp_integer);
    skipcloseparen();
    return pascaltypecast(type, ex);
}



Static Expr *func_lower()
{
    Expr *ex;
    Value val;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
	gettok();
	val = p_constant(tp_integer);
	if (!val.type || val.i != 1)
	    note("LOWER(v,n) not supported for n>1 [190]");
    }
    skipcloseparen();
    return copyexpr(ex->val.type->indextype->smin);
}



Static Expr *func_loword()
{
    Expr *ex;

    ex = p_parexpr(tp_integer);
    return makeexpr_bin(EK_BAND, tp_ushort,
                        ex, makeexpr_long(65535));
}



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



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



Static Expr *func_max()
{
    Type *tp;
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    if (curtok == TOK_IDENT && curtokmeaning &&
	curtokmeaning->kind == MK_TYPE) {
	tp = curtokmeaning->type;
	gettok();
	skipcloseparen();
	return copyexpr(tp->smax);
    }
    ex = p_expr(tp_integer);
    while (curtok == TOK_COMMA) {
	gettok();
	ex2 = p_expr(ex->val.type);
	if (ex->val.type->kind == TK_REAL) {
	    tp = ex->val.type;
	    if (ex2->val.type->kind != TK_REAL)
		ex2 = makeexpr_cast(ex2, tp);
	} else {
	    tp = ex2->val.type;
	    if (ex->val.type->kind != TK_REAL)
		ex = makeexpr_cast(ex, tp);
	}
	ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmax" : "P_imax",
			       tp, ex, ex2);
    }				
    skipcloseparen();
    return ex;
}



Static Expr *func_maxavail(ex)
Expr *ex;
{
    freeexpr(ex);
    return makeexpr_bicall_0("maxavail", tp_integer);
}



Static Expr *func_maxpos()
{
    return file_iofunc(3, seek_base);
}



Static Expr *func_memavail(ex)
Expr *ex;
{
    freeexpr(ex);
    return makeexpr_bicall_0("memavail", tp_integer);
}



Static Expr *var_mem()
{
    Expr *ex, *ex2;

    if (!wneedtok(TOK_LBR))
	return makeexpr_name("MEM", tp_integer);
    ex = p_expr(tp_integer);
    if (curtok == TOK_COLON) {
	gettok();
	ex2 = p_expr(tp_integer);
	ex = makeexpr_bicall_2("MEM", tp_ubyte, ex, ex2);
    } else {
	ex = makeexpr_bicall_1("MEM", tp_ubyte, ex);
    }
    if (!wneedtok(TOK_RBR))
	skippasttotoken(TOK_RBR, TOK_SEMI);
    note("Reference to MEM [191]");
    return ex;
}



Static Expr *var_memw()
{
    Expr *ex, *ex2;

    if (!wneedtok(TOK_LBR))
	return makeexpr_name("MEMW", tp_integer);
    ex = p_expr(tp_integer);
    if (curtok == TOK_COLON) {
	gettok();
	ex2 = p_expr(tp_integer);
	ex = makeexpr_bicall_2("MEMW", tp_ushort, ex, ex2);
    } else {
	ex = makeexpr_bicall_1("MEMW", tp_ushort, ex);
    }
    if (!wneedtok(TOK_RBR))
	skippasttotoken(TOK_RBR, TOK_SEMI);
    note("Reference to MEMW [191]");
    return ex;
}



Static Expr *var_meml()
{
    Expr *ex, *ex2;

    if (!wneedtok(TOK_LBR))
	return makeexpr_name("MEML", tp_integer);
    ex = p_expr(tp_integer);
    if (curtok == TOK_COLON) {
	gettok();
	ex2 = p_expr(tp_integer);
	ex = makeexpr_bicall_2("MEML", tp_integer, ex, ex2);
    } else {
	ex = makeexpr_bicall_1("MEML", tp_integer, ex);
    }
    if (!wneedtok(TOK_RBR))
	skippasttotoken(TOK_RBR, TOK_SEMI);
    note("Reference to MEML [191]");
    return ex;
}



Static Expr *func_min()
{
    Type *tp;
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    if (curtok == TOK_IDENT && curtokmeaning &&
	curtokmeaning->kind == MK_TYPE) {
	tp = curtokmeaning->type;
	gettok();
	skipcloseparen();
	return copyexpr(tp->smin);
    }
    ex = p_expr(tp_integer);
    while (curtok == TOK_COMMA) {
	gettok();
	ex2 = p_expr(ex->val.type);
	if (ex->val.type->kind == TK_REAL) {
	    tp = ex->val.type;
	    if (ex2->val.type->kind != TK_REAL)
		ex2 = makeexpr_cast(ex2, tp);
	} else {
	    tp = ex2->val.type;
	    if (ex->val.type->kind != TK_REAL)
		ex = makeexpr_cast(ex, tp);
	}
	ex = makeexpr_bicall_2((tp->kind == TK_REAL) ? "P_rmin" : "P_imin",
			       tp, ex, ex2);
    }				
    skipcloseparen();
    return ex;
}



Static Stmt *proc_move(ex)
Expr *ex;
{
    ex->args[0] = gentle_cast(ex->args[0], tp_anyptr);    /* source */
    ex->args[1] = gentle_cast(ex->args[1], tp_anyptr);    /* dest */
    ex->args[2] = convert_size(choosetype(argbasetype(ex->args[0]),
                                          argbasetype(ex->args[1])), ex->args[2], "MOVE");
    return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
                                           ex->args[1],
                                           ex->args[0],
                                           makeexpr_arglong(ex->args[2], (size_t_long != 0))));
}



Static Stmt *proc_move_fast()
{
    Expr *ex, *ex2, *ex3, *ex4;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ord_range_expr(ex2->val.type->indextype, &ex4, NULL);
    ex2 = makeexpr_index(ex2, p_expr(tp_integer), copyexpr(ex4));
    if (!skipcomma())
	return NULL;
    ex3 = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    ord_range_expr(ex3->val.type->indextype, &ex4, NULL);
    ex3 = makeexpr_index(ex3, p_expr(tp_integer), copyexpr(ex4));
    skipcloseparen();
    ex = convert_size(choosetype(argbasetype(ex2),
				 argbasetype(ex3)), ex, "MOVE_FAST");
    return makestmt_call(makeexpr_bicall_3("memmove", tp_void,
					   makeexpr_addr(ex3),
					   makeexpr_addr(ex2),
					   makeexpr_arglong(ex, (size_t_long != 0))));
}



Static Stmt *proc_new()
{
    Expr *ex, *ex2;
    Stmt *sp, **spp;
    Type *type;
    char *name, *name2 = NULL, vbuf[1000];

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_anyptr);
    type = ex->val.type;
    if (type->kind == TK_POINTER)
	type = type->basetype;
    parse_special_variant(type, vbuf);
    skipcloseparen();
    name = find_special_variant(vbuf, NULL, specialmallocs, 3);
    if (!name) {
        name2 = find_special_variant(vbuf, NULL, specialsizeofs, 3);
	if (!name2) {
	    name = find_special_variant(vbuf, NULL, specialmallocs, 1);
	    name2 = find_special_variant(vbuf, NULL, specialsizeofs, 1);
	    if (name || !name2)
		name = find_special_variant(vbuf, "SpecialMalloc", specialmallocs, 1);
	    else
		name2 = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
	}
    }
    if (name) {
	ex2 = makeexpr_bicall_0(name, ex->val.type);
    } else if (name2) {
	ex2 = makeexpr_bicall_1(mallocname, tp_anyptr, pc_expr_str(name2));
    } else {
	ex2 = makeexpr_bicall_1(mallocname, tp_anyptr,
				makeexpr_sizeof(makeexpr_type(type), 1));
    }
    sp = makestmt_assign(copyexpr(ex), ex2);
    if (malloccheck) {
        sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ,
						       copyexpr(ex),
						       makeexpr_nil()),
                                          makestmt_call(makeexpr_bicall_0(name_OUTMEM, tp_int)),
                                          NULL));
    }
    spp = &sp->next;
    while (*spp)
	spp = &(*spp)->next;
    if (type->kind == TK_RECORD)
	initfilevars(type->fbase, &spp, makeexpr_hat(ex, 0));
    else if (isfiletype(type, -1))
	sp = makestmt_seq(sp, makestmt_call(initfilevar(makeexpr_hat(ex, 0))));
    else
	freeexpr(ex);
    return sp;
}



Static Expr *func_oct()
{
    return handle_vax_hex(NULL, "o", 3);
}



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

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



Static Expr *func_odd(ex)
Expr *ex;
{
    ex = makeexpr_unlongcast(grabarg(ex, 0));
    if (*oddname)
        return makeexpr_bicall_1(oddname, tp_boolean, ex);
    else
        return makeexpr_bin(EK_BAND, tp_boolean, ex, makeexpr_long(1));
}



Static Stmt *proc_open()
{
    return handleopen(2);
}



Static Expr *func_ord()
{
    Expr *ex;

    if (wneedtok(TOK_LPAR)) {
	ex = p_ord_expr();
	skipcloseparen();
    } else
	ex = p_ord_expr();
    return makeexpr_ord(ex);
}



Static Expr *func_ord4()
{
    Expr *ex;

    if (wneedtok(TOK_LPAR)) {
	ex = p_ord_expr();
	skipcloseparen();
    } else
	ex = p_ord_expr();
    return makeexpr_longcast(makeexpr_ord(ex), 1);
}



Static Stmt *proc_pack()
{
    Expr *exs, *exd, *exi, *mind;
    Meaning *tvar;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    exs = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    exi = p_ord_expr();
    if (!skipcomma())
	return NULL;
    exd = p_expr(NULL);
    skipcloseparen();
    if (exs->val.type->kind != TK_ARRAY ||
	(exd->val.type->kind != TK_ARRAY &&
	 exd->val.type->kind != TK_SMALLARRAY)) {
	warning("Bad argument types for PACK/UNPACK [325]");
	return makestmt_call(makeexpr_bicall_3("pack", tp_void,
					       exs, exi, exd));
    }
    if (exs->val.type->smax || exd->val.type->smax) {
	tvar = makestmttempvar(exd->val.type->indextype, name_TEMP);
	sp = makestmt(SK_FOR);
	if (exd->val.type->smin)
	    mind = exd->val.type->smin;
	else
	    mind = exd->val.type->indextype->smin;
	sp->exp1 = makeexpr_assign(makeexpr_var(tvar),
				   copyexpr(mind));
	sp->exp2 = makeexpr_rel(EK_LE, makeexpr_var(tvar),
				copyexpr(exd->val.type->indextype->smax));
	sp->exp3 = makeexpr_assign(makeexpr_var(tvar),
				   makeexpr_plus(makeexpr_var(tvar),
						 makeexpr_long(1)));
	exi = makeexpr_minus(exi, copyexpr(mind));
	sp->stm1 = makestmt_assign(p_index(exd, makeexpr_var(tvar)),
				   p_index(exs,
					   makeexpr_plus(makeexpr_var(tvar),
							 exi)));
	return sp;
    } else {
	exi = gentle_cast(exi, exs->val.type->indextype);
	return makestmt_call(makeexpr_bicall_3("memcpy", exd->val.type,
					       exd,
					       makeexpr_addr(p_index(exs, exi)),
					       makeexpr_sizeof(copyexpr(exd), 0)));
    }
}



Static Expr *func_pad(ex)
Expr *ex;
{
    if (checkconst(ex->args[1], 0) ||    /* "s" is null string */
	checkconst(ex->args[2], ' ')) {
        return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
                                 makeexpr_string("%*s"),
                                 makeexpr_longcast(ex->args[3], 0),
                                 makeexpr_string(""));
    }
    return makeexpr_bicall_4(strpadname, tp_strptr,
			     ex->args[0], ex->args[1], ex->args[2],
			     makeexpr_arglong(ex->args[3], 0));
}



Static Stmt *proc_page()
{
    Expr *fex, *ex;

    if (curtok == TOK_LPAR) {
        fex = p_parexpr(tp_text);
        ex = makeexpr_bicall_2("fprintf", tp_int,
                               filebasename(copyexpr(fex)),
                               makeexpr_string("\f"));
    } else {
        fex = makeexpr_var(mp_output);
        ex = makeexpr_bicall_1("printf", tp_int,
                               makeexpr_string("\f"));
    }
    if (FCheck(checkfilewrite)) {
        ex = makeexpr_bicall_2("~SETIO", tp_void,
                               makeexpr_rel(EK_GE, ex, makeexpr_long(0)),
			       makeexpr_name(filewriteerrorname, tp_int));
    }
    return wrapopencheck(makestmt_call(ex), fex);
}



Static Expr *func_paramcount(ex)
Expr *ex;
{
    freeexpr(ex);
    return makeexpr_minus(makeexpr_name(name_ARGC, tp_int),
                          makeexpr_long(1));
}



Static Expr *func_paramstr(ex)
Expr *ex;
{
    Expr *ex2;

    ex2 = makeexpr_index(makeexpr_name(name_ARGV,
				       makepointertype(tp_strptr)),
			 makeexpr_unlongcast(ex->args[1]),
			 makeexpr_long(0));
    ex2->val.type = tp_str255;
    return makeexpr_bicall_3("sprintf", tp_strptr,
			     ex->args[0],
			     makeexpr_string("%s"),
			     ex2);
}



Static Expr *func_pi()
{
    return makeexpr_name("M_PI", tp_longreal);
}



Static Expr *var_port()
{
    Expr *ex;

    if (!wneedtok(TOK_LBR))
	return makeexpr_name("PORT", tp_integer);
    ex = p_expr(tp_integer);
    if (!wneedtok(TOK_RBR))
	skippasttotoken(TOK_RBR, TOK_SEMI);
    note("Reference to PORT [191]");
    return makeexpr_bicall_1("PORT", tp_ubyte, ex);
}



Static Expr *var_portw()
{
    Expr *ex;

    if (!wneedtok(TOK_LBR))
	return makeexpr_name("PORTW", tp_integer);
    ex = p_expr(tp_integer);
    if (!wneedtok(TOK_RBR))
	skippasttotoken(TOK_RBR, TOK_SEMI);
    note("Reference to PORTW [191]");
    return makeexpr_bicall_1("PORTW", tp_ushort, ex);
}



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

    cp = strposname;
    if (!*cp) {
        note("POS function used [192]");
        cp = "POS";
    } 
    return makeexpr_bicall_3(cp, tp_int,
                             ex->args[1], 
                             ex->args[0],
                             makeexpr_long(1));
}



Static Expr *func_ptr(ex)
Expr *ex;
{
    note("PTR function was used [193]");
    return ex;
}



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



Static Expr *func_pred()
{
    Expr *ex;

    if (wneedtok(TOK_LPAR)) {
	ex = p_ord_expr();
	skipcloseparen();
    } else
	ex = p_ord_expr();
#if 1
    ex = makeexpr_inc(ex, makeexpr_long(-1));
#else
    ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(-1)), ex->val.type);
#endif
    return ex;
}



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

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



Static Expr *func_pwroften(ex)
Expr *ex;
{
    return makeexpr_bicall_2("pow", tp_longreal,
			     makeexpr_real("10.0"), grabarg(ex, 0));
}



Static Stmt *proc_reset()
{
    return handleopen(0);
}



Static Stmt *proc_rewrite()
{
    return handleopen(1);
}




Stmt *doseek(fex, ex)
Expr *fex, *ex;
{
    Expr *ex2;
    Type *basetype = filebasetype(fex->val.type);

    if (ansiC == 1)
        ex2 = makeexpr_name("SEEK_SET", tp_int);
    else
        ex2 = makeexpr_long(0);
    ex = makeexpr_bicall_3("fseek", tp_int,
                           filebasename(copyexpr(fex)),
                           makeexpr_arglong(
                               makeexpr_times(makeexpr_minus(ex,
                                                             makeexpr_long(seek_base)),
                                              makeexpr_sizeof(makeexpr_type(basetype), 0)),
                               1),
                           ex2);
    if (FCheck(checkfileseek)) {
        ex = makeexpr_bicall_2("~SETIO", tp_void,
                               makeexpr_rel(EK_EQ, ex, makeexpr_long(0)),
			       makeexpr_name(endoffilename, tp_int));
    }
    return makestmt_call(ex);
}




Static Expr *makegetchar(fex)
Expr *fex;
{
    if (isvar(fex, mp_input))
        return makeexpr_bicall_0("getchar", tp_char);
    else
        return makeexpr_bicall_1("getc", tp_char, filebasename(copyexpr(fex)));
}



Static Stmt *fixscanf(sp, fex)
Stmt *sp;
Expr *fex;
{
    int nargs, i, isstrread;
    char *cp;
    Expr *ex;
    Stmt *sp2;

    isstrread = (fex->val.type->kind == TK_STRING);
    if (sp->kind == SK_ASSIGN && sp->exp1->kind == EK_BICALL &&
        !strcmp(sp->exp1->val.s, "scanf")) {
        if (sp->exp1->args[0]->kind == EK_CONST &&
            !(sp->exp1->args[0]->val.i&1) && !isstrread) {
            cp = sp->exp1->args[0]->val.s;    /* scanf("%c%c") -> getchar;getchar */
            for (i = 0; cp[i] == '%' && cp[i+1] == 'c'; ) {
                i += 2;
                if (i == sp->exp1->args[0]->val.i) {
                    sp2 = NULL;
                    for (i = 1; i < sp->exp1->nargs; i++) {
                        ex = makeexpr_hat(sp->exp1->args[i], 0);
                        sp2 = makestmt_seq(sp2,
                                           makestmt_assign(copyexpr(ex),
                                                           makegetchar(fex)));
                        if (checkeof(fex)) {
                            sp2 = makestmt_seq(sp2,
                                makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
                                                                makeexpr_rel(EK_NE,
                                                                             ex,
                                                                             makeexpr_name("EOF", tp_char)),
								makeexpr_name(endoffilename, tp_int))));
                        } else
                            freeexpr(ex);
                    }
                    return sp2;
                }
            }
        }
        nargs = sp->exp1->nargs - 1;
        if (isstrread) {
            strchange(&sp->exp1->val.s, "sscanf");
            insertarg(&sp->exp1, 0, copyexpr(fex));
        } else if (!isvar(fex, mp_input)) {
            strchange(&sp->exp1->val.s, "fscanf");
            insertarg(&sp->exp1, 0, filebasename(copyexpr(fex)));
        }
        if (FCheck(checkreadformat)) {
            if (checkeof(fex) && !isstrread)
                ex = makeexpr_cond(makeexpr_rel(EK_NE,
                                                makeexpr_bicall_1("feof",
								  tp_int,
								  filebasename(copyexpr(fex))),
                                                makeexpr_long(0)),
				   makeexpr_name(endoffilename, tp_int),
				   makeexpr_name(badinputformatname, tp_int));
            else
		ex = makeexpr_name(badinputformatname, tp_int);
            sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
                                         makeexpr_rel(EK_EQ,
                                                      sp->exp1,
                                                      makeexpr_long(nargs)),
                                         ex);
        } else if (checkeof(fex) && !isstrread) {
            sp->exp1 = makeexpr_bicall_2("~SETIO", tp_void,
                                         makeexpr_rel(EK_NE,
                                                      sp->exp1,
                                                      makeexpr_name("EOF", tp_int)),
					 makeexpr_name(endoffilename, tp_int));
        }
    }
    return sp;
}



Static Expr *makefgets(vex, lex, fex)
Expr *vex, *lex, *fex;
{
    Expr *ex;

    ex = makeexpr_bicall_3("fgets", tp_strptr,
                           vex,
                           lex,
                           filebasename(copyexpr(fex)));
    if (checkeof(fex)) {
        ex = makeexpr_bicall_2("~SETIO", tp_void,
                               makeexpr_rel(EK_NE, ex, makeexpr_nil()),
			       makeexpr_name(endoffilename, tp_int));
    }
    return ex;
}



Static Stmt *skipeoln(fex)
Expr *fex;
{
    Meaning *tvar;
    Expr *ex;

    if (!strcmp(readlnname, "fgets")) {
        tvar = makestmttempvar(tp_str255, name_STRING);
        return makestmt_call(makefgets(makeexpr_var(tvar),
                                       makeexpr_long(stringceiling+1),
                                       filebasename(fex)));
    } else if (!strcmp(readlnname, "scanf") || !*readlnname) {
        if (checkeof(fex))
            ex = makeexpr_bicall_2("~SETIO", tp_void,
                                   makeexpr_rel(EK_NE,
                                                makegetchar(fex),
                                                makeexpr_name("EOF", tp_char)),
				   makeexpr_name(endoffilename, tp_int));
        else
            ex = makegetchar(fex);
        return makestmt_seq(fixscanf(
                    makestmt_call(makeexpr_bicall_1("scanf", tp_int,
                                                    makeexpr_string("%*[^\n]"))), fex),
                    makestmt_call(ex));
    } else {
        return makestmt_call(makeexpr_bicall_1(readlnname, tp_void,
                                               filebasename(copyexpr(fex))));
    }
}



Static Stmt *handleread_text(fex, var, isreadln)
Expr *fex, *var;
int isreadln;
{
    Stmt *spbase, *spafter, *sp;
    Expr *ex = NULL, *exj = NULL;
    Type *type;
    Meaning *tvar, *tempcp, *mp;
    int i, isstrread, scanfmode, readlnflag, varstring, maxstring;
    int longstrsize = (longstringsize > 0) ? longstringsize : stringceiling;
    long rmin, rmax;
    char *fmt;

    spbase = NULL;
    spafter = NULL;
    sp = NULL;
    tempcp = NULL;
    if (fex->val.type->kind == TK_ARRAY)
	fex = makeexpr_sprintfify(fex);
    isstrread = (fex->val.type->kind == TK_STRING);
    if (isstrread) {
        exj = var;
        var = p_expr(NULL);
    }
    scanfmode = !strcmp(readlnname, "scanf") || !*readlnname || isstrread;
    for (;;) {
        readlnflag = isreadln && curtok == TOK_RPAR;
        if (var->val.type->kind == TK_STRING && !isstrread) {
            if (sp)
                spbase = makestmt_seq(spbase, fixscanf(sp, fex));
            spbase = makestmt_seq(spbase, spafter);
            varstring = (varstrings && var->kind == EK_VAR &&
                         (mp = (Meaning *)var->val.i)->kind == MK_VARPARAM &&
                         mp->type == tp_strptr);
            maxstring = (strmax(var) >= longstrsize && !varstring);
            if (isvar(fex, mp_input) && maxstring && usegets && readlnflag) {
                spbase = makestmt_seq(spbase,
                                      makestmt_call(makeexpr_bicall_1("gets", tp_str255,
                                                                      makeexpr_addr(var))));
                isreadln = 0;
            } else if (scanfmode && !varstring &&
                       (*readlnname || !isreadln)) {
                spbase = makestmt_seq(spbase, makestmt_assign(makeexpr_hat(copyexpr(var), 0),
                                                              makeexpr_char(0)));
                if (maxstring && usegets)
                    ex = makeexpr_string("%[^\n]");
                else
                    ex = makeexpr_string(format_d("%%%d[^\n]", strmax(var)));
                ex = makeexpr_bicall_2("scanf", tp_int, ex, makeexpr_addr(var));
                spbase = makestmt_seq(spbase, fixscanf(makestmt_call(ex), fex));
                if (readlnflag && maxstring && usegets) {
                    spbase = makestmt_seq(spbase, makestmt_call(makegetchar(fex)));
                    isreadln = 0;
                }
            } else {
                ex = makeexpr_plus(strmax_func(var), makeexpr_long(1));
                spbase = makestmt_seq(spbase,
                                      makestmt_call(makefgets(makeexpr_addr(copyexpr(var)),
                                                              ex,
                                                              fex)));
                if (!tempcp)
                    tempcp = makestmttempvar(tp_charptr, name_TEMP);
                spbase = makestmt_seq(spbase,
                                      makestmt_assign(makeexpr_var(tempcp),
                                                      makeexpr_bicall_2("strchr", tp_charptr,
                                                                        makeexpr_addr(copyexpr(var)),
                                                                        makeexpr_char('\n'))));
                sp = makestmt_assign(makeexpr_hat(makeexpr_var(tempcp), 0),
                                     makeexpr_long(0));
                if (readlnflag)
                    isreadln = 0;
                else
                    sp = makestmt_seq(sp,
                                      makestmt_call(makeexpr_bicall_2("ungetc", tp_void,
                                                                      makeexpr_char('\n'),
                                                                      filebasename(copyexpr(fex)))));
                spbase = makestmt_seq(spbase, makestmt_if(makeexpr_rel(EK_NE,
                                                                       makeexpr_var(tempcp),
                                                                       makeexpr_nil()),
                                                          sp,
                                                          NULL));
            }
            sp = NULL;
            spafter = NULL;
        } else if (var->val.type->kind == TK_ARRAY && !isstrread) {
            if (sp)
                spbase = makestmt_seq(spbase, fixscanf(sp, fex));
            spbase = makestmt_seq(spbase, spafter);
	    ex = makeexpr_sizeof(copyexpr(var), 0);
	    if (readlnflag) {
		spbase = makestmt_seq(spbase,
		     makestmt_call(
			 makeexpr_bicall_3("P_readlnpaoc", tp_void,
					   filebasename(copyexpr(fex)),
					   makeexpr_addr(var),
					   makeexpr_arglong(ex, 0))));
		isreadln = 0;
	    } else {
		spbase = makestmt_seq(spbase,
		     makestmt_call(
			 makeexpr_bicall_3("P_readpaoc", tp_void,
					   filebasename(copyexpr(fex)),
					   makeexpr_addr(var),
					   makeexpr_arglong(ex, 0))));
	    }
            sp = NULL;
            spafter = NULL;
        } else {
            switch (ord_type(var->val.type)->kind) {

                case TK_INTEGER:
		    fmt = "d";
		    if (curtok == TOK_COLON) {
			gettok();
			if (curtok == TOK_IDENT &&
			    !strcicmp(curtokbuf, "HEX")) {
			    fmt = "x";
			} else if (curtok == TOK_IDENT &&
			    !strcicmp(curtokbuf, "OCT")) {
			    fmt = "o";
			} else if (curtok == TOK_IDENT &&
			    !strcicmp(curtokbuf, "BIN")) {
			    fmt = "b";
			    note("Using %b for binary format in scanf [194]");
			} else
			    warning("Unrecognized format specified in READ [212]");
			gettok();
		    }
                    type = findbasetype(var->val.type, ODECL_NOPRES);
                    if (exprlongness(var) > 0)
                        ex = makeexpr_string(format_s("%%l%s", fmt));
                    else if (type == tp_integer || type == tp_int ||
                             type == tp_uint || type == tp_sint)
                        ex = makeexpr_string(format_s("%%%s", fmt));
                    else if (type == tp_sshort || type == tp_ushort)
                        ex = makeexpr_string(format_s("%%h%s", fmt));
                    else {
                        tvar = makestmttempvar(tp_int, name_TEMP);
                        spafter = makestmt_seq(spafter,
                                               makestmt_assign(var,
                                                               makeexpr_var(tvar)));
                        var = makeexpr_var(tvar);
                        ex = makeexpr_string(format_s("%%%s", fmt));
                    }
                    break;

                case TK_CHAR:
                    ex = makeexpr_string("%c");
                    if (newlinespace && !isstrread) {
                        spafter = makestmt_seq(spafter,
                                               makestmt_if(makeexpr_rel(EK_EQ,
                                                                        copyexpr(var),
                                                                        makeexpr_char('\n')),
                                                           makestmt_assign(copyexpr(var),
                                                                           makeexpr_char(' ')),
                                                           NULL));
                    }
                    break;

                case TK_BOOLEAN:
                    tvar = makestmttempvar(tp_str255, name_STRING);
                    spafter = makestmt_seq(spafter,
                        makestmt_assign(var,
                                        makeexpr_or(makeexpr_rel(EK_EQ,
                                                                 makeexpr_hat(makeexpr_var(tvar), 0),
                                                                 makeexpr_char('T')),
                                                    makeexpr_rel(EK_EQ,
                                                                 makeexpr_hat(makeexpr_var(tvar), 0),
                                                                 makeexpr_char('t')))));
                    var = makeexpr_var(tvar);
                    ex = makeexpr_string(" %[a-zA-Z]");
                    break;

                case TK_ENUM:
                    warning("READ on enumerated types not yet supported [213]");
                    if (useenum)
                        ex = makeexpr_string("%d");
                    else
                        ex = makeexpr_string("%hd");
                    break;

                case TK_REAL:
		    if (var->val.type == tp_longreal)
			ex = makeexpr_string("%lg");
		    else
			ex = makeexpr_string("%g");
                    break;

                case TK_STRING:     /* strread only */
                    ex = makeexpr_string(format_d("%%%lds", strmax(fex)));
                    break;

                case TK_ARRAY:      /* strread only */
                    if (!ord_range(ex->val.type->indextype, &rmin, &rmax)) {
                        rmin = 1;
                        rmax = 1;
                        note("Can't determine length of packed array of chars [195]");
                    }
                    ex = makeexpr_string(format_d("%%%ldc", rmax-rmin+1));
                    break;

                default:
                    note("Element has wrong type for WRITE statement [196]");
                    ex = NULL;
                    break;

            }
            if (ex) {
                var = makeexpr_addr(var);
                if (sp) {
                    sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0], ex, 0);
                    insertarg(&sp->exp1, sp->exp1->nargs, var);
                } else {
                    sp = makestmt_call(makeexpr_bicall_2("scanf", tp_int, ex, var));
                }
            }
        }
        if (curtok == TOK_COMMA) {
            gettok();
            var = p_expr(NULL);
        } else
            break;
    }
    if (sp) {
        if (isstrread && !FCheck(checkreadformat) &&
            ((i=0, checkstring(sp->exp1->args[0], "%d")) ||
             (i++, checkstring(sp->exp1->args[0], "%ld")) ||
             (i++, checkstring(sp->exp1->args[0], "%hd")) ||
             (i++, checkstring(sp->exp1->args[0], "%lg")))) {
            if (fullstrread != 0 && exj) {
                tvar = makestmttempvar(tp_strptr, name_STRING);
                sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
                                           (i == 3) ? makeexpr_bicall_2("strtod", tp_longreal,
                                                                        copyexpr(fex),
                                                                        makeexpr_addr(makeexpr_var(tvar)))
                                                    : makeexpr_bicall_3("strtol", tp_integer,
                                                                        copyexpr(fex),
                                                                        makeexpr_addr(makeexpr_var(tvar)),
                                                                        makeexpr_long(10)));
		spafter = makestmt_seq(spafter,
				       makestmt_assign(copyexpr(exj),
						       makeexpr_minus(makeexpr_var(tvar),
								      makeexpr_addr(copyexpr(fex)))));
            } else {
                sp->exp1 = makeexpr_assign(makeexpr_hat(sp->exp1->args[1], 0),
                                           makeexpr_bicall_1((i == 1) ? "atol" : (i == 3) ? "atof" : "atoi",
                                                             (i == 1) ? tp_integer : (i == 3) ? tp_longreal : tp_int,
                                                             copyexpr(fex)));
            }
        } else if (isstrread && fullstrread != 0 && exj) {
            sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
                                                makeexpr_string(sizeof_int >= 32 ? "%n" : "%ln"), 0);
            insertarg(&sp->exp1, sp->exp1->nargs, makeexpr_addr(copyexpr(exj)));
        } else if (isreadln && scanfmode && !FCheck(checkreadformat)) {
            isreadln = 0;
            sp->exp1->args[0] = makeexpr_concat(sp->exp1->args[0],
                                                makeexpr_string("%*[^\n]"), 0);
            spafter = makestmt_seq(makestmt_call(makegetchar(fex)), spafter);
        }
        spbase = makestmt_seq(spbase, fixscanf(sp, fex));
    }
    spbase = makestmt_seq(spbase, spafter);
    if (isreadln)
        spbase = makestmt_seq(spbase, skipeoln(fex));
    return spbase;
}



Static Stmt *handleread_bin(fex, var)
Expr *fex, *var;
{
    Type *basetype;
    Stmt *sp;
    Expr *ex, *tvardef = NULL;

    sp = NULL;
    basetype = filebasetype(fex->val.type);
    for (;;) {
        ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var),
                                                    makeexpr_sizeof(makeexpr_type(basetype), 0),
                                                    makeexpr_long(1),
                                                    filebasename(copyexpr(fex)));
        if (checkeof(fex)) {
            ex = makeexpr_bicall_2("~SETIO", tp_void,
                                   makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
				   makeexpr_name(endoffilename, tp_int));
        }
        sp = makestmt_seq(sp, makestmt_call(ex));
        if (curtok == TOK_COMMA) {
            gettok();
            var = p_expr(NULL);
        } else
            break;
    }
    freeexpr(tvardef);
    return sp;
}



Static Stmt *proc_read()
{
    Expr *fex, *ex;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(NULL);
    if (isfiletype(ex->val.type, -1) && wneedtok(TOK_COMMA)) {
        fex = ex;
        ex = p_expr(NULL);
    } else {
        fex = makeexpr_var(mp_input);
    }
    if (fex->val.type == tp_text || fex->val.type == tp_bigtext)
        sp = handleread_text(fex, ex, 0);
    else
        sp = handleread_bin(fex, ex);
    skipcloseparen();
    return wrapopencheck(sp, fex);
}



Static Stmt *proc_readdir()
{
    Expr *fex, *ex;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    ex = p_expr(tp_integer);
    sp = doseek(fex, ex);
    if (!skipopenparen())
	return sp;
    sp = makestmt_seq(sp, handleread_bin(fex, p_expr(NULL)));
    skipcloseparen();
    return wrapopencheck(sp, fex);
}



Static Stmt *proc_readln()
{
    Expr *fex, *ex;
    Stmt *sp;

    if (curtok != TOK_LPAR) {
        fex = makeexpr_var(mp_input);
        return wrapopencheck(skipeoln(copyexpr(fex)), fex);
    } else {
        gettok();
        ex = p_expr(NULL);
        if (isfiletype(ex->val.type, -1)) {
            fex = ex;
            if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
                skippasttotoken(TOK_RPAR, TOK_SEMI);
                return wrapopencheck(skipeoln(copyexpr(fex)), fex);
            } else {
                ex = p_expr(NULL);
            }
        } else {
            fex = makeexpr_var(mp_input);
        }
        sp = handleread_text(fex, ex, 1);
        skipcloseparen();
    }
    return wrapopencheck(sp, fex);
}



Static Stmt *proc_readv()
{
    Expr *vex;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    vex = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    sp = handleread_text(vex, NULL, 0);
    skipcloseparen();
    return sp;
}



Static Stmt *proc_strread()
{
    Expr *vex, *exi, *exj, *exjj, *ex;
    Stmt *sp, *sp2;
    Meaning *tvar, *jvar;

    if (!skipopenparen())
	return NULL;
    vex = p_expr(tp_str255);
    if (vex->kind != EK_VAR) {
        tvar = makestmttempvar(tp_str255, name_STRING);
        sp = makestmt_assign(makeexpr_var(tvar), vex);
        vex = makeexpr_var(tvar);
    } else
        sp = NULL;
    if (!skipcomma())
	return NULL;
    exi = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    exj = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    if (exprspeed(exi) >= 5 || !nosideeffects(exi, 0)) {
        sp = makestmt_seq(sp, makestmt_assign(copyexpr(exj), exi));
        exi = copyexpr(exj);
    }
    if (fullstrread != 0 &&
        ((ex = singlevar(exj)) == NULL || exproccurs(exi, ex))) {
        jvar = makestmttempvar(exj->val.type, name_TEMP);
        exjj = makeexpr_var(jvar);
    } else {
        exjj = copyexpr(exj);
        jvar = (exj->kind == EK_VAR) ? (Meaning *)exj->val.i : NULL;
    }
    sp2 = handleread_text(bumpstring(copyexpr(vex),
                                     copyexpr(exi), 1),
                          exjj, 0);
    sp = makestmt_seq(sp, sp2);
    skipcloseparen();
    if (fullstrread == 0) {
        sp = makestmt_seq(sp, makestmt_assign(exj,
                                              makeexpr_plus(makeexpr_bicall_1("strlen", tp_int,
                                                                              vex),
                                                            makeexpr_long(1))));
        freeexpr(exjj);
        freeexpr(exi);
    } else {
        sp = makestmt_seq(sp, makestmt_assign(exj,
                                              makeexpr_plus(exjj, exi)));
        if (fullstrread == 2)
            note("STRREAD was used [197]");
        freeexpr(vex);
    }
    return mixassignments(sp, jvar);
}




Static Expr *func_random()
{
    Expr *ex;

    if (curtok == TOK_LPAR) {
        gettok();
        ex = p_expr(tp_integer);
        skipcloseparen();
        return makeexpr_bicall_1(randintname, tp_integer, makeexpr_arglong(ex, 1));
    } else {
        return makeexpr_bicall_0(randrealname, tp_longreal);
    }
}



Static Stmt *proc_randomize()
{
    if (*randomizename)
        return makestmt_call(makeexpr_bicall_0(randomizename, tp_void));
    else
        return NULL;
}



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

    ex = grabarg(ex, 0);
    if (ex->val.type->kind != TK_REAL)
	return ex;
    if (*roundname) {
        if (*roundname != '*' || (exprspeed(ex) < 5 && nosideeffects(ex, 0))) {
            return makeexpr_bicall_1(roundname, tp_integer, ex);
        } else {
            tvar = makestmttempvar(tp_longreal, name_TEMP);
            return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex),
                                  makeexpr_bicall_1(roundname, tp_integer, makeexpr_var(tvar)));
        }
    } else {
        return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
						  makeexpr_plus(ex, makeexpr_real("0.5"))),
                                tp_integer);
    }
}



Static Stmt *proc_unpack()
{
    Expr *exs, *exd, *exi, *mins;
    Meaning *tvar;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    exs = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    exd = p_expr(NULL);
    if (!skipcomma())
	return NULL;
    exi = p_ord_expr();
    skipcloseparen();
    if (exd->val.type->kind != TK_ARRAY ||
	(exs->val.type->kind != TK_ARRAY &&
	 exs->val.type->kind != TK_SMALLARRAY)) {
	warning("Bad argument types for PACK/UNPACK [325]");
	return makestmt_call(makeexpr_bicall_3("unpack", tp_void,
					       exs, exd, exi));
    }
    if (exs->val.type->smax || exd->val.type->smax) {
	tvar = makestmttempvar(exs->val.type->indextype, name_TEMP);
	sp = makestmt(SK_FOR);
	if (exs->val.type->smin)
	    mins = exs->val.type->smin;
	else
	    mins = exs->val.type->indextype->smin;
	sp->exp1 = makeexpr_assign(makeexpr_var(tvar),
				   copyexpr(mins));
	sp->exp2 = makeexpr_rel(EK_LE, makeexpr_var(tvar),
				copyexpr(exs->val.type->indextype->smax));
	sp->exp3 = makeexpr_assign(makeexpr_var(tvar),
				   makeexpr_plus(makeexpr_var(tvar),
						 makeexpr_long(1)));
	exi = makeexpr_minus(exi, copyexpr(mins));
	sp->stm1 = makestmt_assign(p_index(exd,
					   makeexpr_plus(makeexpr_var(tvar),
							 exi)),
				   p_index(exs, makeexpr_var(tvar)));
	return sp;
    } else {
	exi = gentle_cast(exi, exs->val.type->indextype);
	return makestmt_call(makeexpr_bicall_3("memcpy", exd->val.type,
					       exd,
					       makeexpr_addr(p_index(exs, exi)),
					       makeexpr_sizeof(copyexpr(exd), 0)));
    }
}



Static Expr *func_uround(ex)
Expr *ex;
{
    ex = grabarg(ex, 0);
    if (ex->val.type->kind != TK_REAL)
	return ex;
    return makeexpr_actcast(makeexpr_bicall_1("floor", tp_longreal,
					      makeexpr_plus(ex, makeexpr_real("0.5"))),
			    tp_unsigned);
}



Static Expr *func_scan()
{
    Expr *ex, *ex2, *ex3;
    char *name;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    if (curtok == TOK_EQ)
	name = "P_scaneq";
    else 
	name = "P_scanne";
    gettok();
    ex2 = p_expr(tp_char);
    if (!skipcomma())
	return NULL;
    ex3 = p_expr(tp_str255);
    skipcloseparen();
    return makeexpr_bicall_3(name, tp_int,
			     makeexpr_arglong(ex, 0),
			     makeexpr_charcast(ex2), ex3);
}



Static Expr *func_scaneq(ex)
Expr *ex;
{
    return makeexpr_bicall_3("P_scaneq", tp_int,
			     makeexpr_arglong(ex->args[0], 0),
			     makeexpr_charcast(ex->args[1]),
			     ex->args[2]);
}


Static Expr *func_scanne(ex)
Expr *ex;
{
    return makeexpr_bicall_3("P_scanne", tp_int,
			     makeexpr_arglong(ex->args[0], 0),
			     makeexpr_charcast(ex->args[1]),
			     ex->args[2]);
}



Static Stmt *proc_seek()
{
    Expr *fex, *ex;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    ex = p_expr(tp_integer);
    skipcloseparen();
    sp = wrapopencheck(doseek(fex, ex), copyexpr(fex));
    if (*setupbufname && fileisbuffered(fex, 1))
	sp = makestmt_seq(sp,
		 makestmt_call(
		     makeexpr_bicall_2(setupbufname, tp_void,
				       filebasename(fex),
				       makeexpr_type(filebasetype(fex->val.type)))));
    else
	freeexpr(fex);
    return sp;
}



Static Expr *func_seekeof()
{
    Expr *ex;

    if (curtok == TOK_LPAR)
        ex = p_parexpr(tp_text);
    else
        ex = makeexpr_var(mp_input);
    if (*skipspacename)
        ex = makeexpr_bicall_1(skipspacename, tp_text, filebasename(ex));
    else
        note("SEEKEOF was used [198]");
    return iofunc(ex, 0);
}



Static Expr *func_seekeoln()
{
    Expr *ex;

    if (curtok == TOK_LPAR)
        ex = p_parexpr(tp_text);
    else
        ex = makeexpr_var(mp_input);
    if (*skipspacename)
        ex = makeexpr_bicall_1(skipspacename, tp_text, filebasename(ex));
    else
        note("SEEKEOLN was used [199]");
    return iofunc(ex, 1);
}



Static Stmt *proc_setstrlen()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_integer);
    skipcloseparen();
    return makestmt_assign(makeexpr_bicall_1("strlen", tp_int, ex),
                           ex2);
}



Static Stmt *proc_settextbuf()
{
    Expr *fex, *bex, *sex;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    bex = p_expr(NULL);
    if (curtok == TOK_COMMA) {
        gettok();
        sex = p_expr(tp_integer);
    } else
        sex = makeexpr_sizeof(copyexpr(bex), 0);
    skipcloseparen();
    note("Make sure setvbuf() call occurs when file is open [200]");
    return makestmt_call(makeexpr_bicall_4("setvbuf", tp_void,
                                           filebasename(fex),
                                           makeexpr_addr(bex),
                                           makeexpr_name("_IOFBF", tp_integer),
                                           sex));
}



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


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



Static Expr *func_sizeof()
{
    Expr *ex;
    Type *type;
    char *name, vbuf[1000];
    int lpar;

    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;
    parse_special_variant(type, vbuf);
    if (lpar)
	skipcloseparen();
    name = find_special_variant(vbuf, "SpecialSizeOf", specialsizeofs, 1);
    if (name) {
	freeexpr(ex);
	return pc_expr_str(name);
    } else
	return makeexpr_sizeof(ex, 0);
}



Static Expr *func_statusv()
{
    return makeexpr_name(name_IORESULT, tp_integer);
}



Static Expr *func_str_hp(ex)
Expr *ex;
{
    return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
                                            ex->args[2], ex->args[3]));
}



Static Stmt *proc_strappend()
{
    Expr *ex, *ex2;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    ex2 = p_expr(tp_str255);
    skipcloseparen();
    return makestmt_assign(ex, makeexpr_concat(copyexpr(ex), ex2, 0));
}



Static Stmt *proc_strdelete()
{
    Meaning *tvar = NULL, *tvari;
    Expr *ex, *ex2, *ex3, *ex4, *exi, *exn;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    exi = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
	gettok();
	exn = p_expr(tp_integer);
    } else
	exn = makeexpr_long(1);
    skipcloseparen();
    if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
        sp = NULL;
    else {
        tvari = makestmttempvar(tp_int, name_TEMP);
        sp = makestmt_assign(makeexpr_var(tvari), exi);
        exi = makeexpr_var(tvari);
    }
    ex3 = bumpstring(copyexpr(ex), copyexpr(exi), 1);
    ex4 = bumpstring(copyexpr(ex), makeexpr_plus(exi, exn), 1);
    if (strcpyleft) {
        ex2 = ex3;
    } else {
        tvar = makestmttempvar(tp_str255, name_STRING);
        ex2 = makeexpr_var(tvar);
    }
    sp = makestmt_seq(sp, makestmt_assign(ex2, ex4));
    if (!strcpyleft)
        sp = makestmt_seq(sp, makestmt_assign(ex3, makeexpr_var(tvar)));
    return sp;
}



Static Stmt *proc_strinsert()
{
    Meaning *tvari;
    Expr *exs, *exd, *exi;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    exs = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    exd = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    exi = p_expr(tp_integer);
    skipcloseparen();
#if 0
    if (checkconst(exi, 1)) {
        freeexpr(exi);
        return makestmt_assign(exd,
                               makeexpr_concat(exs, copyexpr(exd)));
    }
#endif
    if (exprspeed(exi) < 5 && nosideeffects(exi, 0))
        sp = NULL;
    else {
        tvari = makestmttempvar(tp_int, name_TEMP);
        sp = makestmt_assign(makeexpr_var(tvari), exi);
        exi = makeexpr_var(tvari);
    }
    exd = bumpstring(exd, exi, 1);
    sp = makestmt_seq(sp, makestmt_assign(exd,
                                          makeexpr_concat(exs, copyexpr(exd), 0)));
    return sp;
}



Static Stmt *proc_strmove()
{
    Expr *exlen, *exs, *exsi, *exd, *exdi;

    if (!skipopenparen())
	return NULL;
    exlen = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    exs = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    exsi = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    exd = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    exdi = p_expr(tp_integer);
    skipcloseparen();
    exsi = makeexpr_arglong(exsi, 0);
    exdi = makeexpr_arglong(exdi, 0);
    return makestmt_call(makeexpr_bicall_5(strmovename, tp_str255,
					   exlen, exs, exsi, exd, exdi));
}



Static Expr *func_strlen(ex)
Expr *ex;
{
    return makeexpr_bicall_1("strlen", tp_int, grabarg(ex, 0));
}



Static Expr *func_strltrim(ex)
Expr *ex;
{
    return makeexpr_assign(makeexpr_hat(ex->args[0], 0),
                           makeexpr_bicall_1(strltrimname, tp_str255, ex->args[1]));
}



Static Expr *func_strmax(ex)
Expr *ex;
{
    return strmax_func(grabarg(ex, 0));
}



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

    if (!switch_strpos)
        swapexprs(ex->args[0], ex->args[1]);
    cp = strposname;
    if (!*cp) {
        note("STRPOS function used [201]");
        cp = "STRPOS";
    } 
    return makeexpr_bicall_3(cp, tp_int,
                             ex->args[0], 
                             ex->args[1],
                             makeexpr_long(1));
}



Static Expr *func_strrpt(ex)
Expr *ex;
{
    if (ex->args[1]->kind == EK_CONST &&
        ex->args[1]->val.i == 1 && ex->args[1]->val.s[0] == ' ') {
        return makeexpr_bicall_4("sprintf", tp_strptr, ex->args[0],
                                 makeexpr_string("%*s"),
                                 makeexpr_longcast(ex->args[2], 0),
                                 makeexpr_string(""));
    } else
        return makeexpr_bicall_3(strrptname, tp_strptr, ex->args[0], ex->args[1],
                                 makeexpr_arglong(ex->args[2], 0));
}



Static Expr *func_strrtrim(ex)
Expr *ex;
{
    return makeexpr_bicall_1(strrtrimname, tp_strptr,
                             makeexpr_assign(makeexpr_hat(ex->args[0], 0),
                                             ex->args[1]));
}



Static Expr *func_succ()
{
    Expr *ex;

    if (wneedtok(TOK_LPAR)) {
	ex = p_ord_expr();
	skipcloseparen();
    } else
	ex = p_ord_expr();
#if 1
    ex = makeexpr_inc(ex, makeexpr_long(1));
#else
    ex = makeexpr_cast(makeexpr_plus(ex, makeexpr_long(1)), ex->val.type);
#endif
    return ex;
}



Static Expr *func_sqr()
{
    return makeexpr_sqr(p_parexpr(tp_integer), 0);
}



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



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

    ex = grabarg(ex, 0);
    cp = swapname;
    if (!*cp) {
        note("SWAP function was used [202]");
        cp = "SWAP";
    }
    return makeexpr_bicall_1(swapname, tp_int, ex);
}



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


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



Static Expr *func_trunc(ex)
Expr *ex;
{
    return makeexpr_actcast(grabarg(ex, 0), tp_integer);
}



Static Expr *func_utrunc(ex)
Expr *ex;
{
    return makeexpr_actcast(grabarg(ex, 0), tp_unsigned);
}



Static Expr *func_uand()
{
    Expr *ex;

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



Static Expr *func_udec()
{
    return handle_vax_hex(NULL, "u", 0);
}



Static Expr *func_unot()
{
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_unsigned);
    ex = makeexpr_un(EK_BNOT, ex->val.type, ex);
    skipcloseparen();
    return ex;
}



Static Expr *func_uor()
{
    Expr *ex;

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



Static Expr *func_upcase(ex)
Expr *ex;
{
    return makeexpr_bicall_1("toupper", tp_char, grabarg(ex, 0));
}



Static Expr *func_upper()
{
    Expr *ex;
    Value val;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_integer);
    if (curtok == TOK_COMMA) {
	gettok();
	val = p_constant(tp_integer);
	if (!val.type || val.i != 1)
	    note("UPPER(v,n) not supported for n>1 [190]");
    }
    skipcloseparen();
    return copyexpr(ex->val.type->indextype->smax);
}



Static Expr *func_uxor()
{
    Expr *ex;

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



Static Expr *func_val_modula()
{
    Expr *ex;
    Type *tp;

    if (!skipopenparen())
	return NULL;
    tp = p_type(NULL);
    if (!skipcomma())
	return NULL;
    ex = p_expr(tp);
    skipcloseparen();
    return pascaltypecast(tp, ex);
}



Static Stmt *proc_val_turbo()
{
    Expr *ex, *vex, *code, *fmt;

    if (!skipopenparen())
	return NULL;
    ex = gentle_cast(p_expr(tp_str255), tp_str255);
    if (!skipcomma())
	return NULL;
    vex = p_expr(NULL);
    if (curtok == TOK_COMMA) {
	gettok();
	code = gentle_cast(p_expr(tp_integer), tp_integer);
    } else
	code = NULL;
    skipcloseparen();
    if (vex->val.type->kind == TK_REAL)
        fmt = makeexpr_string("%lg");
    else if (exprlongness(vex) > 0)
        fmt = makeexpr_string("%ld");
    else
        fmt = makeexpr_string("%d");
    ex = makeexpr_bicall_3("sscanf", tp_int,
                           ex, fmt, makeexpr_addr(vex));
    if (code) {
	ex = makeexpr_rel(EK_EQ, ex, makeexpr_long(0));
	return makestmt_assign(code, makeexpr_ord(ex));
    } else
	return makestmt_call(ex);
}







Static Expr *writestrelement(ex, wid, vex, code, needboth)
Expr *ex, *wid, *vex;
int code, needboth;
{
    if (formatstrings && needboth) {
        return makeexpr_bicall_5("sprintf", tp_str255, vex,
                                 makeexpr_string(format_d("%%*.*%c", code)),
                                 copyexpr(wid),
                                 wid,
                                 ex);
    } else {
        return makeexpr_bicall_4("sprintf", tp_str255, vex,
                                 makeexpr_string(format_d("%%*%c", code)),
                                 wid,
                                 ex);
    }
}



Static char *makeenumnames(tp)
Type *tp;
{
    Strlist *sp;
    char *name;
    Meaning *mp;
    int saveindent;

    for (sp = enumnames; sp && sp->value != (long)tp; sp = sp->next) ;
    if (!sp) {
        if (tp->meaning)
            name = format_s(name_ENUM, tp->meaning->name);
        else
            name = format_s(name_ENUM, format_d("_%d", ++enumnamecount));
        sp = strlist_insert(&enumnames, name);
        sp->value = (long)tp;
        outsection(2);
        output(format_s("static %s *", charname));
        output(sp->s);
        output("[] = {\n");
	saveindent = outindent;
	moreindent(tabsize);
	moreindent(structinitindent);
        for (mp = tp->fbase; mp; mp = mp->xnext) {
            output(makeCstring(mp->sym->name, strlen(mp->sym->name)));
            if (mp->xnext)
                output(",\002 ");
        }
        outindent = saveindent;
        output("\n} ;\n");
        outsection(2);
    }
    return sp->s;
}





/* This function must return a "tempsprintf" */

Expr *writeelement(ex, wid, prec, base)
Expr *ex, *wid, *prec;
int base;
{
    Expr *vex, *ex1, *ex2;
    Meaning *tvar;
    char *fmtcode;
    Type *type;

    ex = makeexpr_charcast(ex);
    if (ex->val.type->kind == TK_POINTER) {
        ex = makeexpr_hat(ex, 0);   /* convert char *'s to strings */
        intwarning("writeelement", "got a char * instead of a string [214]");
    }
    if ((ex->val.type->kind == TK_STRING && !wid) ||
        (ord_type(ex->val.type)->kind == TK_CHAR && (!wid || checkconst(wid, 1)))) {
        return makeexpr_sprintfify(ex);
    }
    tvar = makestmttempvar(tp_str255, name_STRING);
    vex = makeexpr_var(tvar);
    if (wid)
        wid = makeexpr_longcast(wid, 0);
    if (prec)
        prec = makeexpr_longcast(prec, 0);
#if 0
    if (wid && (wid->kind == EK_CONST && wid->val.i < 0 ||
                checkconst(wid, -1))) {
        freeexpr(wid);     /* P-system uses write(x:-1) to mean write(x) */
        wid = NULL;
    }
    if (prec && (prec->kind == EK_CONST && prec->val.i < 0 ||
                 checkconst(prec, -1))) {
        freeexpr(prec);
        prec = NULL;
    }
#endif
    switch (ord_type(ex->val.type)->kind) {

        case TK_INTEGER:
            if (!wid) {
		if (integerwidth < 0)
		    integerwidth = (which_lang == LANG_TURBO) ? 1 : 12;
		wid = makeexpr_long(integerwidth);
	    }
	    type = findbasetype(ex->val.type, ODECL_NOPRES);
	    if (base == 16)
		fmtcode = "x";
	    else if (base == 8)
		fmtcode = "o";
	    else if ((possiblesigns(wid) & (1|4)) == 1) {
		wid = makeexpr_neg(wid);
		fmtcode = "x";
	    } else if (type == tp_unsigned ||
		       type == tp_uint ||
		       (type == tp_ushort && sizeof_int < 32))
		fmtcode = "u";
	    else
		fmtcode = "d";
            ex = makeexpr_forcelongness(ex);
            if (checkconst(wid, 0) || checkconst(wid, 1)) {
                ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
                                       makeexpr_string(format_ss("%%%s%s",
								 (exprlongness(ex) > 0) ? "l" : "",
								 fmtcode)),
                                       ex);
            } else {
                ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
                                       makeexpr_string(format_ss("%%*%s%s",
								 (exprlongness(ex) > 0) ? "l" : "",
								 fmtcode)),
                                       wid,
                                       ex);
            }
            break;

        case TK_CHAR:
            ex = writestrelement(ex, wid, vex, 'c',
                                     (wid->kind != EK_CONST || wid->val.i < 1));
            break;

        case TK_BOOLEAN:
            if (!wid) {
                ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
                                       makeexpr_string("%s"),
                                       makeexpr_cond(ex,
                                                     makeexpr_string(" TRUE"),
                                                     makeexpr_string("FALSE")));
            } else if (checkconst(wid, 1)) {
                ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
                                       makeexpr_string("%c"),
                                       makeexpr_cond(ex,
                                                     makeexpr_char('T'),
                                                     makeexpr_char('F')));
            } else {
                ex = writestrelement(makeexpr_cond(ex,
                                                   makeexpr_string("TRUE"),
                                                   makeexpr_string("FALSE")),
                                     wid, vex, 's',
                                     (wid->kind != EK_CONST || wid->val.i < 5));
            }
            break;

        case TK_ENUM:
            ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
                                   makeexpr_string("%s"),
                                   makeexpr_index(makeexpr_name(makeenumnames(ex->val.type),
                                                                tp_strptr),
                                                  ex, NULL));
            break;

        case TK_REAL:
            if (!wid)
                wid = makeexpr_long(realwidth);
            if (prec && (possiblesigns(prec) & (1|4)) != 1) {
                ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
                                       makeexpr_string("%*.*f"),
                                       wid,
                                       prec,
                                       ex);
            } else {
		if (prec)
		    prec = makeexpr_neg(prec);
		else
		    prec = makeexpr_minus(copyexpr(wid),
					  makeexpr_long(7));
		if (prec->kind == EK_CONST) {
		    if (prec->val.i <= 0)
			prec = makeexpr_long(1);
		} else {
		    prec = makeexpr_bicall_2("P_max", tp_integer, prec,
					     makeexpr_long(1));
		}
                if (wid->kind == EK_CONST && wid->val.i > 21) {
                    ex = makeexpr_bicall_5("sprintf", tp_str255, vex,
                                           makeexpr_string("%*.*E"),
                                           wid,
					   prec,
                                           ex);
#if 0
                } else if (checkconst(wid, 7)) {
                    ex = makeexpr_bicall_3("sprintf", tp_str255, vex,
                                           makeexpr_string("%E"),
                                           ex);
#endif
                } else {
                    ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
                                           makeexpr_string("% .*E"),
					   prec,
                                           ex);
                }
            }
            break;

        case TK_STRING:
            ex = writestrelement(ex, wid, vex, 's', 1);
            break;

        case TK_ARRAY:     /* assume packed array of char */
	    ord_range_expr(ex->val.type->indextype, &ex1, &ex2);
	    ex1 = makeexpr_plus(makeexpr_minus(copyexpr(ex2),
					       copyexpr(ex1)),
				makeexpr_long(1));
	    ex1 = makeexpr_longcast(ex1, 0);
	    fmtcode = "%.*s";
            if (!wid) {
		wid = ex1;
            } else {
		if (isliteralconst(wid, NULL) == 2 &&
		    isliteralconst(ex1, NULL) == 2) {
		    if (wid->val.i > ex1->val.i) {
			fmtcode = format_ds("%*s%%.*s",
					    wid->val.i - ex1->val.i, "");
			wid = ex1;
		    }
		} else
		    note("Format for packed-array-of-char will work only if width < length [321]");
	    }
            ex = makeexpr_bicall_4("sprintf", tp_str255, vex,
                                   makeexpr_string(fmtcode),
                                   wid,
                                   makeexpr_addr(ex));
            break;

        default:
            note("Element has wrong type for WRITE statement [196]");
            ex = makeexpr_bicall_2("sprintf", tp_str255, vex, makeexpr_string("<meef>"));
            break;

    }
    return ex;
}



Static Stmt *handlewrite_text(fex, ex, iswriteln)
Expr *fex, *ex;
int iswriteln;
{
    Expr *print, *wid, *prec;
    unsigned char *ucp;
    int i, done, base;

    print = NULL;
    for (;;) {
        wid = NULL;
        prec = NULL;
	base = 10;
	if (curtok == TOK_COLON && iswriteln >= 0) {
	    gettok();
	    wid = p_expr(tp_integer);
	    if (curtok == TOK_COLON) {
		gettok();
		prec = p_expr(tp_integer);
	    }
	}
	if (curtok == TOK_IDENT &&
	    !strcicmp(curtokbuf, "OCT")) {
	    base = 8;
	    gettok();
	} else if (curtok == TOK_IDENT &&
		   !strcicmp(curtokbuf, "HEX")) {
	    base = 16;
	    gettok();
	}
        ex = writeelement(ex, wid, prec, base);
        print = makeexpr_concat(print, cleansprintf(ex), 1);
        if (curtok == TOK_COMMA && iswriteln >= 0) {
            gettok();
            ex = p_expr(NULL);
        } else
            break;
    }
    if (fex->val.type->kind != TK_STRING) {      /* not strwrite */
        switch (iswriteln) {
            case 1:
            case -1:
                print = makeexpr_concat(print, makeexpr_string("\n"), 1);
                break;
            case 2:
            case -2:
                print = makeexpr_concat(print, makeexpr_string("\r"), 1);
                break;
        }
        if (isvar(fex, mp_output)) {
            ucp = (unsigned char *)print->args[1]->val.s;
            for (i = 0; i < print->args[1]->val.i; i++) {
                if (ucp[i] >= 128 && ucp[i] < 144) {
                    note("WRITE statement contains color/attribute characters [203]");
		    break;
		}
            }
        }
        if ((i = sprintflength(print, 0)) > 0 && print->nargs == 2 && printfonly != 1) {
            print = makeexpr_unsprintfify(print);
            done = 1;
            if (isvar(fex, mp_output)) {
                if (i == 1) {
                    print = makeexpr_bicall_1("putchar", tp_int,
                                              makeexpr_charcast(print));
                } else {
                    if (printfonly == 0) {
                        if (print->val.s[print->val.i-1] == '\n') {
			    print->val.s[--(print->val.i)] = 0;
                            print = makeexpr_bicall_1("puts", tp_int, print);
                        } else {
                            print = makeexpr_bicall_2("fputs", tp_int,
                                                      print,
                                                      copyexpr(fex));
                        }
                    } else {
                        print = makeexpr_sprintfify(print);
                        done = 0;
                    }
                }
            } else {
                if (i == 1) {
                    print = makeexpr_bicall_2("putc", tp_int,
                                              makeexpr_charcast(print),
                                              filebasename(copyexpr(fex)));
                } else if (printfonly == 0) {
                    print = makeexpr_bicall_2("fputs", tp_int,
                                              print,
                                              filebasename(copyexpr(fex)));
                } else {
                    print = makeexpr_sprintfify(print);
                    done = 0;
                }
            }
        } else
            done = 0;
        if (!done) {
            canceltempvar(istempvar(print->args[0]));
            if (checkstring(print->args[1], "%s") && printfonly != 1) {
                print = makeexpr_bicall_2("fputs", tp_int,
                                          grabarg(print, 2),
                                          filebasename(copyexpr(fex)));
            } else if (checkstring(print->args[1], "%c") && printfonly != 1 &&
                       !nosideeffects(print->args[2], 0)) {
                print = makeexpr_bicall_2("fputc", tp_int,
                                          grabarg(print, 2),
                                          filebasename(copyexpr(fex)));
            } else if (isvar(fex, mp_output)) {
                if (checkstring(print->args[1], "%s\n") && printfonly != 1) {
                    print = makeexpr_bicall_1("puts", tp_int, grabarg(print, 2));
                } else if (checkstring(print->args[1], "%c") && printfonly != 1) {
                    print = makeexpr_bicall_1("putchar", tp_int, grabarg(print, 2));
                } else {
                    strchange(&print->val.s, "printf");
                    delfreearg(&print, 0);
                    print->val.type = tp_int;
                }
            } else {
                if (checkstring(print->args[1], "%c") && printfonly != 1) {
                    print = makeexpr_bicall_2("putc", tp_int,
                                              grabarg(print, 2),
                                              filebasename(copyexpr(fex)));
                } else {
                    strchange(&print->val.s, "fprintf");
                    freeexpr(print->args[0]);
                    print->args[0] = filebasename(copyexpr(fex));
                    print->val.type = tp_int;
                }
            }
        }
        if (FCheck(checkfilewrite)) {
            print = makeexpr_bicall_2("~SETIO", tp_void,
                                      makeexpr_rel(EK_GE, print, makeexpr_long(0)),
				      makeexpr_name(filewriteerrorname, tp_int));
        }
    }
    return makestmt_call(print);
}



Static Stmt *handlewrite_bin(fex, ex)
Expr *fex, *ex;
{
    Type *basetype;
    Stmt *sp;
    Expr *tvardef = NULL;
    Meaning *tvar = NULL;

    sp = NULL;
    basetype = filebasetype(fex->val.type);
    for (;;) {
        if (!expr_has_address(ex) || ex->val.type != basetype) {
            if (!tvar)
                tvar = makestmttempvar(basetype, name_TEMP);
            if (!tvardef || !exprsame(tvardef, ex, 1)) {
                freeexpr(tvardef);
                tvardef = copyexpr(ex);
                sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(tvar),
                                                      ex));
            } else
                freeexpr(ex);
            ex = makeexpr_var(tvar);
        }
        ex = makeexpr_bicall_4("fwrite", tp_integer, makeexpr_addr(ex),
                                                     makeexpr_sizeof(makeexpr_type(basetype), 0),
                                                     makeexpr_long(1),
			                             filebasename(copyexpr(fex)));
        if (FCheck(checkfilewrite)) {
            ex = makeexpr_bicall_2("~SETIO", tp_void,
                                   makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
				   makeexpr_name(filewriteerrorname, tp_int));
        }
        sp = makestmt_seq(sp, makestmt_call(ex));
        if (curtok == TOK_COMMA) {
            gettok();
            ex = p_expr(NULL);
        } else
            break;
    }
    freeexpr(tvardef);
    return sp;
}



Static Stmt *proc_write()
{
    Expr *fex, *ex;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(NULL);
    if (isfiletype(ex->val.type, -1) && wneedtok(TOK_COMMA)) {
        fex = ex;
        ex = p_expr(NULL);
    } else {
        fex = makeexpr_var(mp_output);
    }
    if (fex->val.type == tp_text || fex->val.type == tp_bigtext)
        sp = handlewrite_text(fex, ex, 0);
    else
        sp = handlewrite_bin(fex, ex);
    skipcloseparen();
    return wrapopencheck(sp, fex);
}



Static Stmt *handle_modula_write(fmt)
char *fmt;
{
    Expr *ex, *wid;

    if (!skipopenparen())
	return NULL;
    ex = makeexpr_forcelongness(p_expr(NULL));
    if (skipcomma())
	wid = p_expr(tp_integer);
    else
	wid = makeexpr_long(1);
    if (checkconst(wid, 0) || checkconst(wid, 1))
	ex = makeexpr_bicall_2("printf", tp_str255,
			       makeexpr_string(format_ss("%%%s%s",
							 (exprlongness(ex) > 0) ? "l" : "",
							 fmt)),
			       ex);
    else
	ex = makeexpr_bicall_3("printf", tp_str255,
			       makeexpr_string(format_ss("%%*%s%s",
							 (exprlongness(ex) > 0) ? "l" : "",
							 fmt)),
			       makeexpr_arglong(wid, 0),
			       ex);
    skipcloseparen();
    return makestmt_call(ex);
}


Static Stmt *proc_writecard()
{
    return handle_modula_write("u");
}


Static Stmt *proc_writeint()
{
    return handle_modula_write("d");
}


Static Stmt *proc_writehex()
{
    return handle_modula_write("x");
}


Static Stmt *proc_writeoct()
{
    return handle_modula_write("o");
}


Static Stmt *proc_writereal()
{
    return handle_modula_write("f");
}



Static Stmt *proc_writedir()
{
    Expr *fex, *ex;
    Stmt *sp;

    if (!skipopenparen())
	return NULL;
    fex = p_expr(tp_text);
    if (!skipcomma())
	return NULL;
    ex = p_expr(tp_integer);
    sp = doseek(fex, ex);
    if (!skipcomma())
	return sp;
    sp = makestmt_seq(sp, handlewrite_bin(fex, p_expr(NULL)));
    skipcloseparen();
    return wrapopencheck(sp, fex);
}



Static Stmt *handlewriteln(iswriteln)
int iswriteln;
{
    Expr *fex, *ex;
    Stmt *sp;
    Meaning *deffile = mp_output;

    sp = NULL;
    if (iswriteln == 3) {
	iswriteln = 1;
	if (messagestderr)
	    deffile = mp_stderr;
    }
    if (curtok != TOK_LPAR) {
        fex = makeexpr_var(deffile);
        if (iswriteln)
            sp = handlewrite_text(fex, makeexpr_string(""), -iswriteln);
    } else {
        gettok();
        ex = p_expr(NULL);
        if (isfiletype(ex->val.type, -1)) {
            fex = ex;
            if (curtok == TOK_RPAR || !wneedtok(TOK_COMMA)) {
                if (iswriteln)
                    ex = makeexpr_string("");
                else
                    ex = NULL;
            } else {
                ex = p_expr(NULL);
            }
        } else {
            fex = makeexpr_var(deffile);
        }
        if (ex)
            sp = handlewrite_text(fex, ex, iswriteln);
        skipcloseparen();
    }
    if (iswriteln == 0) {
        sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_1("fflush", tp_void,
                                                              filebasename(copyexpr(fex)))));
    }
    return wrapopencheck(sp, fex);
}



Static Stmt *proc_overprint()
{
    return handlewriteln(2);
}



Static Stmt *proc_prompt()
{
    return handlewriteln(0);
}



Static Stmt *proc_writeln()
{
    return handlewriteln(1);
}


Static Stmt *proc_message()
{
    return handlewriteln(3);
}



Static Stmt *proc_writev()
{
    Expr *vex, *ex;
    Stmt *sp;
    Meaning *mp;

    if (!skipopenparen())
	return NULL;
    vex = p_expr(tp_str255);
    if (curtok == TOK_RPAR) {
	gettok();
	return makestmt_assign(vex, makeexpr_string(""));
    }
    if (!skipcomma())
	return NULL;
    sp = handlewrite_text(vex, p_expr(NULL), 0);
    skipcloseparen();
    ex = sp->exp1;
    if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
        (mp = istempvar(ex->args[0])) != NULL) {
        canceltempvar(mp);
        ex->args[0] = vex;
    } else
        sp->exp1 = makeexpr_assign(vex, ex);
    return sp;
}


Static Stmt *proc_strwrite(mp_x, spbase)
Meaning *mp_x;
Stmt *spbase;
{
    Expr *vex, *exi, *exj, *ex;
    Stmt *sp;
    Meaning *mp;

    if (!skipopenparen())
	return NULL;
    vex = p_expr(tp_str255);
    if (!skipcomma())
	return NULL;
    exi = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    exj = p_expr(tp_integer);
    if (!skipcomma())
	return NULL;
    sp = handlewrite_text(vex, p_expr(NULL), 0);
    skipcloseparen();
    ex = sp->exp1;
    FREE(sp);
    if (checkconst(exi, 1)) {
        sp = spbase;
        while (sp && sp->next)
            sp = sp->next;
        if (sp && sp->kind == SK_ASSIGN && sp->exp1->kind == EK_ASSIGN &&
             (sp->exp1->args[0]->kind == EK_HAT ||
              sp->exp1->args[0]->kind == EK_INDEX) &&
             exprsame(sp->exp1->args[0]->args[0], vex, 1) &&
             checkconst(sp->exp1->args[1], 0)) {
            nukestmt(sp);     /* remove preceding bogus setstrlen */
        }
    }
    if (ex->kind == EK_BICALL && !strcmp(ex->val.s, "sprintf") &&
        (mp = istempvar(ex->args[0])) != NULL) {
        canceltempvar(mp);
        ex->args[0] = bumpstring(copyexpr(vex), exi, 1);
        sp = makestmt_call(ex);
    } else
        sp = makestmt_assign(bumpstring(copyexpr(vex), exi, 1), ex);
    if (fullstrwrite != 0) {
        sp = makestmt_seq(sp, makestmt_assign(exj,
                                              makeexpr_plus(makeexpr_bicall_1("strlen", tp_int, vex),
                                                            makeexpr_long(1))));
        if (fullstrwrite == 1)
            note("FullStrWrite=1 not yet supported [204]");
        if (fullstrwrite == 2)
            note("STRWRITE was used [205]");
    } else {
        freeexpr(vex);
    }
    return mixassignments(sp, NULL);
}



Static Stmt *proc_str_turbo()
{
    Expr *ex, *wid, *prec;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(NULL);
    wid = NULL;
    prec = NULL;
    if (curtok == TOK_COLON) {
        gettok();
        wid = p_expr(tp_integer);
        if (curtok == TOK_COLON) {
            gettok();
            prec = p_expr(tp_integer);
        }
    }
    ex = writeelement(ex, wid, prec, 10);
    if (!skipcomma())
	return NULL;
    wid = p_expr(tp_str255);
    skipcloseparen();
    return makestmt_assign(wid, ex);
}



Static Stmt *proc_time()
{
    Expr *ex;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(tp_str255);
    skipcloseparen();
    return makestmt_call(makeexpr_bicall_1("VAXtime", tp_integer, ex));
}


Static Expr *func_xor()
{
    Expr *ex, *ex2;
    Type *type;
    Meaning *tvar;

    if (!skipopenparen())
	return NULL;
    ex = p_expr(NULL);
    if (!skipcomma())
	return ex;
    ex2 = p_expr(ex->val.type);
    skipcloseparen();
    if (ex->val.type->kind != TK_SET &&
	ex->val.type->kind != TK_SMALLSET) {
	ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
    } else {
	type = mixsets(&ex, &ex2);
	tvar = makestmttempvar(type, name_SET);
	ex = makeexpr_bicall_3(setxorname, type,
			       makeexpr_var(tvar),
			       ex, ex2);
    }
    return ex;
}







void decl_builtins()
{
    makespecialfunc( "ABS",           func_abs);
    makespecialfunc( "ADDR",          func_addr);
    if (!modula2)
	makespecialfunc( "ADDRESS",   func_addr);
    makespecialfunc( "ADDTOPOINTER",  func_addtopointer);
    makespecialfunc( "ADR",           func_addr);
    makespecialfunc( "ASL",	      func_lsl);
    makespecialfunc( "ASR",	      func_asr);
    makespecialfunc( "BADDRESS",      func_iaddress);
    makespecialfunc( "BAND",	      func_uand);
    makespecialfunc( "BIN",           func_bin);
    makespecialfunc( "BITNEXT",	      func_bitnext);
    makespecialfunc( "BITSIZE",	      func_bitsize);
    makespecialfunc( "BITSIZEOF",     func_bitsize);
mp_blockread_ucsd =
    makespecialfunc( "BLOCKREAD",     func_blockread);
mp_blockwrite_ucsd =
    makespecialfunc( "BLOCKWRITE",    func_blockwrite);
    makespecialfunc( "BNOT",	      func_unot);
    makespecialfunc( "BOR",	      func_uor);
    makespecialfunc( "BSL",	      func_bsl);
    makespecialfunc( "BSR",	      func_bsr);
    makespecialfunc( "BTST",	      func_btst);
    makespecialfunc( "BXOR",	      func_uxor);
    makespecialfunc( "BYTEREAD",      func_byteread);
    makespecialfunc( "BYTEWRITE",     func_bytewrite);
    makespecialfunc( "BYTE_OFFSET",   func_byte_offset);
    makespecialfunc( "CHR",           func_chr);         
    makespecialfunc( "CONCAT",        func_concat);
    makespecialfunc( "DBLE",          func_float);
mp_dec_dec =
    makespecialfunc( "DEC",           func_dec);
    makespecialfunc( "EOF",           func_eof);
    makespecialfunc( "EOLN",          func_eoln);
    makespecialfunc( "FCALL",         func_fcall);
    makespecialfunc( "FILEPOS",       func_filepos);
    makespecialfunc( "FILESIZE",      func_filesize);
    makespecialfunc( "FLOAT",	      func_float);
    makespecialfunc( "HEX",           func_hex);         
    makespecialfunc( "HI",            func_hi);
    makespecialfunc( "HIWORD",        func_hiword);
    makespecialfunc( "HIWRD",         func_hiword);
    makespecialfunc( "HIGH",          func_high);
    makespecialfunc( "IADDRESS",      func_iaddress);
    makespecialfunc( "INT",           func_int);         
    makespecialfunc( "LAND",	      func_uand);
    makespecialfunc( "LNOT",	      func_unot);
    makespecialfunc( "LO",            func_lo);
    makespecialfunc( "LOOPHOLE",      func_loophole);
    makespecialfunc( "LOR",	      func_uor);
    makespecialfunc( "LOWER",	      func_lower);
    makespecialfunc( "LOWORD",        func_loword);
    makespecialfunc( "LOWRD",         func_loword);
    makespecialfunc( "LSL",	      func_lsl);
    makespecialfunc( "LSR",	      func_lsr);
    makespecialfunc( "MAX",	      func_max);
    makespecialfunc( "MAXPOS",        func_maxpos);
    makespecialfunc( "MIN",	      func_min);
    makespecialfunc( "NEXT",          func_sizeof);
    makespecialfunc( "OCT",           func_oct);
    makespecialfunc( "ORD",           func_ord);
    makespecialfunc( "ORD4",          func_ord4);
    makespecialfunc( "PI",	      func_pi);
    makespecialfunc( "POSITION",      func_position);
    makespecialfunc( "PRED",          func_pred);
    makespecialfunc( "QUAD",          func_float);
    makespecialfunc( "RANDOM",        func_random);
    makespecialfunc( "REF",	      func_addr);
    makespecialfunc( "SCAN",	      func_scan);
    makespecialfunc( "SEEKEOF",       func_seekeof);
    makespecialfunc( "SEEKEOLN",      func_seekeoln);
    makespecialfunc( "SIZE",          func_sizeof);
    makespecialfunc( "SIZEOF",        func_sizeof);
    makespecialfunc( "SNGL",          func_sngl);
    makespecialfunc( "SQR",           func_sqr);
    makespecialfunc( "STATUSV",	      func_statusv);
    makespecialfunc( "SUCC",          func_succ);
    makespecialfunc( "TSIZE",         func_sizeof);
    makespecialfunc( "UAND",	      func_uand);
    makespecialfunc( "UDEC",          func_udec);
    makespecialfunc( "UINT",          func_uint);         
    makespecialfunc( "UNOT",	      func_unot);
    makespecialfunc( "UOR",	      func_uor);
    makespecialfunc( "UPPER",	      func_upper);
    makespecialfunc( "UXOR",	      func_uxor);
mp_val_modula =
    makespecialfunc( "VAL",	      func_val_modula);
    makespecialfunc( "WADDRESS",      func_iaddress);
    makespecialfunc( "XOR",	      func_xor);

    makestandardfunc("ARCTAN",        func_arctan);
    makestandardfunc("ARCTANH",       func_arctanh);
    makestandardfunc("BINARY",        func_binary);      
    makestandardfunc("CAP",           func_upcase);
    makestandardfunc("COPY",          func_copy);        
    makestandardfunc("COS",           func_cos);         
    makestandardfunc("COSH",          func_cosh);         
    makestandardfunc("EXP",           func_exp);         
    makestandardfunc("EXP10",         func_pwroften);
    makestandardfunc("EXPO",          func_expo);         
    makestandardfunc("FRAC",          func_frac);        
    makestandardfunc("INDEX",         func_strpos);      
    makestandardfunc("LASTPOS",       NULL);             
    makestandardfunc("LINEPOS",       NULL);             
    makestandardfunc("LENGTH",        func_strlen);      
    makestandardfunc("LN",            func_ln);          
    makestandardfunc("LOG",           func_log);
    makestandardfunc("LOG10",         func_log);
    makestandardfunc("MAXAVAIL",      func_maxavail);
    makestandardfunc("MEMAVAIL",      func_memavail);
    makestandardfunc("OCTAL",         func_octal);       
    makestandardfunc("ODD",           func_odd);         
    makestandardfunc("PAD",           func_pad);
    makestandardfunc("PARAMCOUNT",    func_paramcount);
    makestandardfunc("PARAMSTR",      func_paramstr);    
    makestandardfunc("POS",           func_pos);         
    makestandardfunc("PTR",           func_ptr);
    makestandardfunc("PWROFTEN",      func_pwroften);
    makestandardfunc("ROUND",         func_round);       
    makestandardfunc("SCANEQ",        func_scaneq);
    makestandardfunc("SCANNE",        func_scanne);
    makestandardfunc("SIN",           func_sin);         
    makestandardfunc("SINH",          func_sinh);         
    makestandardfunc("SQRT",          func_sqrt);        
mp_str_hp =
    makestandardfunc("STR",           func_str_hp);
    makestandardfunc("STRLEN",        func_strlen);      
    makestandardfunc("STRLTRIM",      func_strltrim);    
    makestandardfunc("STRMAX",        func_strmax);      
    makestandardfunc("STRPOS",        func_strpos);      
    makestandardfunc("STRRPT",        func_strrpt);      
    makestandardfunc("STRRTRIM",      func_strrtrim);    
    makestandardfunc("SUBSTR",        func_str_hp);
    makestandardfunc("SWAP",          func_swap);        
    makestandardfunc("TAN",           func_tan);       
    makestandardfunc("TANH",          func_tanh);       
    makestandardfunc("TRUNC",         func_trunc);       
    makestandardfunc("UPCASE",        func_upcase);      
    makestandardfunc("UROUND",        func_uround);
    makestandardfunc("UTRUNC",        func_utrunc);

    makespecialproc( "APPEND",        proc_append);
    makespecialproc( "ARGV",	      proc_argv);
    makespecialproc( "ASSERT",        proc_assert);
    makespecialproc( "ASSIGN",        proc_assign);
    makespecialproc( "BCLR",	      proc_bclr);
mp_blockread_turbo =
    makespecialproc( "BLOCKREAD_TURBO", proc_blockread);
mp_blockwrite_turbo =
    makespecialproc( "BLOCKWRITE_TURBO", proc_blockwrite);
    makespecialproc( "BREAK",         proc_flush);
    makespecialproc( "BSET",	      proc_bset);
    makespecialproc( "CALL",          proc_call);
    makespecialproc( "CLOSE",         proc_close);
    makespecialproc( "CONNECT",       proc_assign);
    makespecialproc( "CYCLE",	      proc_cycle);
    makespecialproc( "DATE",	      proc_date);
mp_dec_turbo =
    makespecialproc( "DEC_TURBO",     proc_dec);
    makespecialproc( "DISPOSE",       proc_dispose);
    makespecialproc( "ESCAPE",        proc_escape);
    makespecialproc( "EXCL",          proc_excl);
    makespecialproc( "EXIT",          proc_exit);
    makespecialproc( "FILLCHAR",      proc_fillchar);
    makespecialproc( "FLUSH",         proc_flush);
    makespecialproc( "GET",           proc_get);
    makespecialproc( "HALT",          proc_escape);
    makespecialproc( "INC",           proc_inc);
    makespecialproc( "INCL",          proc_incl);
    makespecialproc( "LEAVE",	      proc_leave);
    makespecialproc( "LOCATE",        proc_seek);
    makespecialproc( "MESSAGE",       proc_message);
    makespecialproc( "MOVE_FAST",     proc_move_fast);        
    makespecialproc( "MOVE_L_TO_R",   proc_move_fast);        
    makespecialproc( "MOVE_R_TO_L",   proc_move_fast);        
    makespecialproc( "NEW",           proc_new);
    if (which_lang != LANG_VAX)
	makespecialproc( "OPEN",      proc_open);
    makespecialproc( "OVERPRINT",     proc_overprint);
    makespecialproc( "PACK",          proc_pack);
    makespecialproc( "PAGE",          proc_page);
    makespecialproc( "PUT",           proc_put);
    makespecialproc( "PROMPT",        proc_prompt);
    makespecialproc( "RANDOMIZE",     proc_randomize);
    makespecialproc( "READ",          proc_read);
    makespecialproc( "READDIR",       proc_readdir);
    makespecialproc( "READLN",        proc_readln);
    makespecialproc( "READV",         proc_readv);
    makespecialproc( "RESET",         proc_reset);
    makespecialproc( "REWRITE",       proc_rewrite);
    makespecialproc( "SEEK",          proc_seek);
    makespecialproc( "SETSTRLEN",     proc_setstrlen);
    makespecialproc( "SETTEXTBUF",    proc_settextbuf);
mp_str_turbo =
    makespecialproc( "STR_TURBO",     proc_str_turbo);
    makespecialproc( "STRAPPEND",     proc_strappend);
    makespecialproc( "STRDELETE",     proc_strdelete);
    makespecialproc( "STRINSERT",     proc_strinsert);
    makespecialproc( "STRMOVE",       proc_strmove);
    makespecialproc( "STRREAD",       proc_strread);
    makespecialproc( "STRWRITE",      proc_strwrite);
    makespecialproc( "TIME",	      proc_time);
    makespecialproc( "UNPACK",        proc_unpack);
    makespecialproc( "WRITE",         proc_write);
    makespecialproc( "WRITEDIR",      proc_writedir);
    makespecialproc( "WRITELN",       proc_writeln);
    makespecialproc( "WRITEV",        proc_writev);
mp_val_turbo =
    makespecialproc( "VAL_TURBO",     proc_val_turbo);

    makestandardproc("DELETE",        proc_delete);      
    makestandardproc("FREEMEM",       proc_freemem);     
    makestandardproc("GETMEM",        proc_getmem);
    makestandardproc("GOTOXY",        proc_gotoxy);      
    makestandardproc("INSERT",        proc_insert);      
    makestandardproc("MARK",          NULL);             
    makestandardproc("MOVE",          proc_move);        
    makestandardproc("MOVELEFT",      proc_move);        
    makestandardproc("MOVERIGHT",     proc_move);        
    makestandardproc("RELEASE",       NULL);             

    makespecialvar(  "MEM",           var_mem);
    makespecialvar(  "MEMW",          var_memw);
    makespecialvar(  "MEML",          var_meml);
    makespecialvar(  "PORT",          var_port);
    makespecialvar(  "PORTW",         var_portw);

    /* Modula-2 standard I/O procedures (case-sensitive!) */
    makespecialproc( "Read",          proc_read);
    makespecialproc( "ReadCard",      proc_read);
    makespecialproc( "ReadInt",       proc_read);
    makespecialproc( "ReadReal",      proc_read);
    makespecialproc( "ReadString",    proc_read);
    makespecialproc( "Write",         proc_write);
    makespecialproc( "WriteCard",     proc_writecard);
    makespecialproc( "WriteHex",      proc_writehex);
    makespecialproc( "WriteInt",      proc_writeint);
    makespecialproc( "WriteOct",      proc_writeoct);
    makespecialproc( "WriteLn",       proc_writeln);
    makespecialproc( "WriteReal",     proc_writereal);
    makespecialproc( "WriteString",   proc_write);
}




/* End. */