/* "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_FUNCS4_C
#include "trans.h"

extern Strlist *enumnames;
extern int enumnamecount;

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

    ex = makeexpr_bicall_3("fgets", tp_strptr,
                           vex,
                           lex,
                           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),
                                       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,
                                               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;
    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'),
                                                                      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,
					   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,
					   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, 0);
                    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:
                    ex = makeexpr_string("%lg");
                    break;

                case TK_STRING:     /* strread only */
                    ex = makeexpr_string(format_d("%%%dc", 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 = fex->val.type->basetype->basetype;
    for (;;) {
        ex = makeexpr_bicall_4("fread", tp_integer, makeexpr_addr(var),
                                                    makeexpr_sizeof(makeexpr_type(basetype), 0),
                                                    makeexpr_long(1),
                                                    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;
}



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

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



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



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



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



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




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



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



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



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



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



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


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



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 && isfilevar(fex))
	sp = makestmt_seq(sp,
		 makestmt_call(
		     makeexpr_bicall_2(setupbufname, tp_void, fex,
			 makeexpr_type(fex->val.type->basetype->basetype))));
    else
	freeexpr(fex);
    return sp;
}



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, ex);
    else
        note("SEEKEOF was used [198]");
    return iofunc(ex, 0);
}



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, ex);
    else
        note("SEEKEOLN was used [199]");
    return iofunc(ex, 1);
}

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



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,
                                           fex,
                                           makeexpr_addr(bex),
                                           makeexpr_name("_IOFBF", tp_integer),
                                           sex));
}



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


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



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



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



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



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



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



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

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



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



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



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



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



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



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

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