Logo Search packages:      
Sourcecode: heaplayers version File versions

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. */




Generated by  Doxygen 1.6.0   Back to index