/* "p2c", a Pascal to C translator.
   Copyright (C) 1989 David Gillespie.
   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_FUNCS2_C
#include "trans.h"

extern Strlist *enumnames;
extern int enumnamecount;

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"),
                               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),
                               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);
}



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))));
}



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)));
}

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);
}

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);
}

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));
}

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"),
			   copyexpr(fex));
    return makeexpr_comma(sex, ex);
}

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"),
			   copyexpr(fex));
    return makeexpr_comma(sex, ex);
}

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);
}

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));
}

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;
}

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, copyexpr(fex), makeexpr_nil()),
                     makestmt_call(makeexpr_bicall_1("fclose", tp_void,
                                                     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(fex, makeexpr_nil()));
    skipcloseparen();
    return sp;
}

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;
}

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));
}

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

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

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

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));
}

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



Stmt *proc_delete(ex)
Expr *ex;
{
    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;
}


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));
}

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

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);
}

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

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

        case 0:  /* eof */
	    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 */
            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;
}

Expr *func_eof()
{
    Expr *ex;

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

Expr *func_eoln()
{
    Expr *ex;

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

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)));
}



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_long(0)));
	}
        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;
}

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

    ex = p_parexpr(tp_text);
    basetype = ex->val.type->basetype->basetype;
    return makeexpr_plus(makeexpr_div(iofunc(ex, code),
                                      makeexpr_sizeof(makeexpr_type(basetype), 0)),
                         makeexpr_long(base));
}

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);
}



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



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



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))));
}



Expr *func_sngl()
{
    Expr *ex;

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



Expr *func_float()
{
    Expr *ex;

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



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

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



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)));
}



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;
}



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) && *chargetname &&
	type->basetype->basetype->kind == TK_CHAR)
	return makestmt_call(makeexpr_bicall_1(chargetname, tp_void, ex));
    else if (isfiletype(type) && *arraygetname &&
	     type->basetype->basetype->kind == TK_ARRAY)
	return makestmt_call(makeexpr_bicall_2(arraygetname, tp_void, ex,
					       makeexpr_type(type->basetype->basetype)));
    else
	return makestmt_call(makeexpr_bicall_2(getname, tp_void, ex,
					       makeexpr_type(type->basetype->basetype)));
}



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;
}