开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 编译器/解释器 > 查看源码
funcs.c.1
资源名称：pascal2c.tar.Z　[点击查看]
上传用户：upcnvip
上传日期：2007-01-06
资源大小：474k
文件大小：47k
源码类别：

编译器/解释器

开发平台：

C/C++

funcs.c.1：源码内容
  1. /* "p2c", a Pascal to C translator.
  2.    Copyright (C) 1989 David Gillespie.
  3.    Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation (any version).
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; see the file COPYING.  If not, write to
  16. the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
  20. #define PROTO_FUNCS_C
  21. #include "trans.h"
  26. Static Strlist *enumnames;
  27. Static int enumnamecount;
  31. void setup_funcs()
  32. {
  33.     enumnames = NULL;
  34.     enumnamecount = 0;
  35. }
  41. int isvar(ex, mp)
  42. Expr *ex;
  43. Meaning *mp;
  44. {
  45.     return (ex->kind == EK_VAR && (Meaning *)ex->val.i == mp);
  46. }
  51. char *getstring(ex)
  52. Expr *ex;
  53. {
  54.     ex = makeexpr_stringify(ex);
  55.     if (ex->kind != EK_CONST || ex->val.type->kind != TK_STRING) {
  56.         intwarning("getstring", "Not a string literal [206]");
  57. return "";
  58.     }
  59.     return ex->val.s;
  60. }
  65. Expr *p_parexpr(target)
  66. Type *target;
  67. {
  68.     Expr *ex;
  70.     if (wneedtok(TOK_LPAR)) {
  71. ex = p_expr(target);
  72. if (!wneedtok(TOK_RPAR))
  73.     skippasttotoken(TOK_RPAR, TOK_SEMI);
  74.     } else
  75. ex = p_expr(target);
  76.     return ex;
  77. }
  81. Type *argbasetype(ex)
  82. Expr *ex;
  83. {
  84.     if (ex->kind == EK_CAST)
  85.         ex = ex->args[0];
  86.     if (ex->val.type->kind == TK_POINTER)
  87.         return ex->val.type->basetype;
  88.     else
  89.         return ex->val.type;
  90. }
  94. Type *choosetype(t1, t2)
  95. Type *t1, *t2;
  96. {
  97.     if (t1 == tp_void ||
  98.         (type_sizeof(t2, 1) && !type_sizeof(t1, 1)))
  99.         return t2;
  100.     else
  101.         return t1;
  102. }
  106. Expr *convert_offset(type, ex2)
  107. Type *type;
  108. Expr *ex2;
  109. {
  110.     long size;
  111.     int i;
  112.     Value val;
  113.     Expr *ex3;
  115.     if (type->kind == TK_POINTER ||
  116.         type->kind == TK_ARRAY ||
  117.         type->kind == TK_SET ||
  118.         type->kind == TK_STRING)
  119.         type = type->basetype;
  120.     size = type_sizeof(type, 1);
  121.     if (size == 1)
  122.         return ex2;
  123.     val = eval_expr_pasc(ex2);
  124.     if (val.type) {
  125.         if (val.i == 0)
  126.             return ex2;
  127.         if (size && val.i % size == 0) {
  128.             freeexpr(ex2);
  129.             return makeexpr_long(val.i / size);
  130.         }
  131.     } else {     /* look for terms like "n*sizeof(foo)" */
  132. while (ex2->kind == EK_CAST || ex2->kind == EK_ACTCAST)
  133.     ex2 = ex2->args[0];
  134.         if (ex2->kind == EK_TIMES) {
  135.     for (i = 0; i < ex2->nargs; i++) {
  136. ex3 = convert_offset(type, ex2->args[i]);
  137. if (ex3) {
  138.     ex2->args[i] = ex3;
  139.     return resimplify(ex2);
  140. }
  141.     }
  142.             for (i = 0;
  143.                  i < ex2->nargs && ex2->args[i]->kind != EK_SIZEOF;
  144.                  i++) ;
  145.             if (i < ex2->nargs) {
  146.                 if (ex2->args[i]->args[0]->val.type == type) {
  147.                     delfreearg(&ex2, i);
  148.                     if (ex2->nargs == 1)
  149.                         return ex2->args[0];
  150.                     else
  151.                         return ex2;
  152.                 }
  153.             }
  154.         } else if (ex2->kind == EK_PLUS) {
  155.     ex3 = copyexpr(ex2);
  156.     for (i = 0; i < ex2->nargs; i++) {
  157. ex3->args[i] = convert_offset(type, ex3->args[i]);
  158. if (!ex3->args[i]) {
  159.     freeexpr(ex3);
  160.     return NULL;
  161. }
  162.     }
  163.     freeexpr(ex2);
  164.     return resimplify(ex3);
  165.         } else if (ex2->kind == EK_SIZEOF) {
  166.             if (ex2->args[0]->val.type == type) {
  167.                 freeexpr(ex2);
  168.                 return makeexpr_long(1);
  169.             }
  170.         } else if (ex2->kind == EK_NEG) {
  171.     ex3 = convert_offset(type, ex2->args[0]);
  172.     if (ex3)
  173.                 return makeexpr_neg(ex3);
  174.         }
  175.     }
  176.     return NULL;
  177. }
  181. Expr *convert_size(type, ex, name)
  182. Type *type;
  183. Expr *ex;
  184. char *name;
  185. {
  186.     long size;
  187.     Expr *ex2;
  188.     int i, okay;
  189.     Value val;
  191.     if (debug>2) { fprintf(outf,"convert_size("); dumpexpr(ex); fprintf(outf,")n"); }
  192.     while (type->kind == TK_ARRAY || type->kind == TK_STRING)
  193.         type = type->basetype;
  194.     if (type == tp_void)
  195.         return ex;
  196.     size = type_sizeof(type, 1);
  197.     if (size == 1)
  198.         return ex;
  199.     while (ex->kind == EK_CAST || ex->kind == EK_ACTCAST)
  200. ex = ex->args[0];
  201.     switch (ex->kind) {
  203.         case EK_TIMES:
  204.             for (i = 0; i < ex->nargs; i++) {
  205.                 ex2 = convert_size(type, ex->args[i], NULL);
  206.                 if (ex2) {
  207.                     ex->args[i] = ex2;
  208.                     return resimplify(ex);
  209.                 }
  210.             }
  211.             break;
  213.         case EK_PLUS:
  214.             okay = 1;
  215.             for (i = 0; i < ex->nargs; i++) {
  216.                 ex2 = convert_size(type, ex->args[i], NULL);
  217.                 if (ex2)
  218.                     ex->args[i] = ex2;
  219.                 else
  220.                     okay = 0;
  221.             }
  222.             ex = distribute_plus(ex);
  223.             if ((ex->kind != EK_TIMES || !okay) && name)
  224.                 note(format_s("Suspicious mixture of sizes in %s [173]", name));
  225.             return ex;
  227.         case EK_SIZEOF:
  228.             return ex;
  230. default:
  231.     break;
  232.     }
  233.     val = eval_expr_pasc(ex);
  234.     if (val.type) {
  235.         if (val.i == 0)
  236.             return ex;
  237.         if (size && val.i % size == 0) {
  238.             freeexpr(ex);
  239.             return makeexpr_times(makeexpr_long(val.i / size),
  240.                                   makeexpr_sizeof(makeexpr_type(type), 0));
  241.         }
  242.     }
  243.     if (name) {
  244.         note(format_s("Can't interpret size in %s [174]", name));
  245.         return ex;
  246.     } else
  247.         return NULL;
  248. }
  261. Static Expr *func_abs()
  262. {
  263.     Expr *ex;
  264.     Meaning *tvar;
  265.     int lness;
  267.     ex = p_parexpr(tp_integer);
  268.     if (ex->val.type->kind == TK_REAL)
  269.         return makeexpr_bicall_1("fabs", tp_longreal, ex);
  270.     else {
  271.         lness = exprlongness(ex);
  272.         if (lness < 0)
  273.             return makeexpr_bicall_1("abs", tp_int, ex);
  274.         else if (lness > 0 && *absname) {
  275.             if (ansiC > 0) {
  276.                 return makeexpr_bicall_1("labs", tp_integer, ex);
  277.             } else if (*absname == '*' && (exprspeed(ex) >= 5 || !nosideeffects(ex, 0))) {
  278.                 tvar = makestmttempvar(tp_integer, name_TEMP);
  279.                 return makeexpr_comma(makeexpr_assign(makeexpr_var(tvar),
  280.                                                       ex),
  281.                                       makeexpr_bicall_1(absname, tp_integer,
  282.                                                         makeexpr_var(tvar)));
  283.             } else {
  284.                 return makeexpr_bicall_1(absname, tp_integer, ex);
  285.             }
  286.         } else if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
  287.             return makeexpr_cond(makeexpr_rel(EK_LT, copyexpr(ex),
  288.                                                      makeexpr_long(0)),
  289.                                  makeexpr_neg(copyexpr(ex)),
  290.                                  ex);
  291.         } else {
  292.             tvar = makestmttempvar(tp_integer, name_TEMP);
  293.             return makeexpr_cond(makeexpr_rel(EK_LT, makeexpr_assign(makeexpr_var(tvar),
  294.                                                                      ex),
  295.                                                      makeexpr_long(0)),
  296.                                  makeexpr_neg(makeexpr_var(tvar)),
  297.                                  makeexpr_var(tvar));
  298.         }
  299.     }
  300. }
  304. Static Expr *func_addr()
  305. {
  306.     Expr *ex, *ex2, *ex3;
  307.     Type *type, *tp2;
  308.     int haspar;
  310.     haspar = wneedtok(TOK_LPAR);
  311.     ex = p_expr(tp_proc);
  312.     if (curtok == TOK_COMMA) {
  313.         gettok();
  314.         ex2 = p_expr(tp_integer);
  315.         ex3 = convert_offset(ex->val.type, ex2);
  316.         if (checkconst(ex3, 0)) {
  317.             ex = makeexpr_addrf(ex);
  318.         } else {
  319.             ex = makeexpr_addrf(ex);
  320.             if (ex3) {
  321.                 ex = makeexpr_plus(ex, ex3);
  322.             } else {
  323.                 note("Don't know how to reduce offset for ADDR [175]");
  324.                 type = makepointertype(tp_abyte);
  325. tp2 = ex->val.type;
  326.                 ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
  327.             }
  328.         }
  329.     } else {
  330. if ((ex->val.type->kind != TK_PROCPTR &&
  331.      ex->val.type->kind != TK_CPROCPTR) ||
  332.     (ex->kind == EK_VAR &&
  333.      ex->val.type == ((Meaning *)ex->val.i)->type))
  334.     ex = makeexpr_addrf(ex);
  335.     }
  336.     if (haspar) {
  337. if (!wneedtok(TOK_RPAR))
  338.     skippasttotoken(TOK_RPAR, TOK_SEMI);
  339.     }
  340.     return ex;
  341. }
  344. Static Expr *func_iaddress()
  345. {
  346.     return makeexpr_cast(func_addr(), tp_integer);
  347. }
  351. Static Expr *func_addtopointer()
  352. {
  353.     Expr *ex, *ex2, *ex3;
  354.     Type *type, *tp2;
  356.     if (!skipopenparen())
  357. return NULL;
  358.     ex = p_expr(tp_anyptr);
  359.     if (skipcomma()) {
  360. ex2 = p_expr(tp_integer);
  361.     } else
  362. ex2 = makeexpr_long(0);
  363.     skipcloseparen();
  364.     ex3 = convert_offset(ex->val.type, ex2);
  365.     if (!checkconst(ex3, 0)) {
  366. if (ex3) {
  367.     ex = makeexpr_plus(ex, ex3);
  368. } else {
  369.     note("Don't know how to reduce offset for ADDTOPOINTER [175]");
  370.     type = makepointertype(tp_abyte);
  371.     tp2 = ex->val.type;
  372.     ex = makeexpr_cast(makeexpr_plus(makeexpr_cast(ex, type), ex2), tp2);
  373. }
  374.     }
  375.     return ex;
  376. }
  380. Stmt *proc_assert()
  381. {
  382.     Expr *ex;
  384.     ex = p_parexpr(tp_boolean);
  385.     return makestmt_call(makeexpr_bicall_1("assert", tp_void, ex));
  386. }
  390. Stmt *wrapopencheck(sp, fex)
  391. Stmt *sp;
  392. Expr *fex;
  393. {
  394.     Stmt *sp2;
  396.     if (FCheck(checkfileisopen) && !is_std_file(fex)) {
  397.         sp2 = makestmt(SK_IF);
  398.         sp2->exp1 = makeexpr_rel(EK_NE, fex, makeexpr_nil());
  399.         sp2->stm1 = sp;
  400.         if (iocheck_flag) {
  401.             sp2->stm2 = makestmt_call(makeexpr_bicall_1(name_ESCIO, tp_integer,
  402. makeexpr_name(filenotopenname, tp_int)));
  403.         } else {
  404.             sp2->stm2 = makestmt_assign(makeexpr_var(mp_ioresult),
  405. makeexpr_name(filenotopenname, tp_int));
  406.         }
  407.         return sp2;
  408.     } else {
  409.         freeexpr(fex);
  410.         return sp;
  411.     }
  412. }
  416. Static Expr *checkfilename(nex)
  417. Expr *nex;
  418. {
  419.     Expr *ex;
  421.     nex = makeexpr_stringcast(nex);
  422.     if (nex->kind == EK_CONST && nex->val.type->kind == TK_STRING) {
  423.         switch (which_lang) {
  425.             case LANG_HP:
  426.                 if (!strncmp(nex->val.s, "#1:", 3) ||
  427.                     !strncmp(nex->val.s, "console:", 8) ||
  428.                     !strncmp(nex->val.s, "CONSOLE:", 8)) {
  429.                     freeexpr(nex);
  430.                     nex = makeexpr_string("/dev/tty");
  431.                 } else if (!strncmp(nex->val.s, "#2:", 3) ||
  432.                            !strncmp(nex->val.s, "systerm:", 8) ||
  433.                            !strncmp(nex->val.s, "SYSTERM:", 8)) {
  434.                     freeexpr(nex);
  435.                     nex = makeexpr_string("/dev/tty");     /* should do more? */
  436.                 } else if (!strncmp(nex->val.s, "#6:", 3) ||
  437.                            !strncmp(nex->val.s, "printer:", 8) ||
  438.                            !strncmp(nex->val.s, "PRINTER:", 8)) {
  439.                     note("Opening a file named PRINTER: [176]");
  440.                 } else if (my_strchr(nex->val.s, ':')) {
  441.                     note("Opening a file whose name contains a ':' [177]");
  442.                 }
  443.                 break;
  445.             case LANG_TURBO:
  446.                 if (checkstring(nex, "con") ||
  447.                     checkstring(nex, "CON") ||
  448.                     checkstring(nex, "")) {
  449.                     freeexpr(nex);
  450.                     nex = makeexpr_string("/dev/tty");
  451.                 } else if (checkstring(nex, "nul") ||
  452.                            checkstring(nex, "NUL")) {
  453.                     freeexpr(nex);
  454.                     nex = makeexpr_string("/dev/null");
  455.                 } else if (checkstring(nex, "lpt1") ||
  456.                            checkstring(nex, "LPT1") ||
  457.                            checkstring(nex, "lpt2") ||
  458.                            checkstring(nex, "LPT2") ||
  459.                            checkstring(nex, "lpt3") ||
  460.                            checkstring(nex, "LPT3") ||
  461.                            checkstring(nex, "com1") ||
  462.                            checkstring(nex, "COM1") ||
  463.                            checkstring(nex, "com2") ||
  464.                            checkstring(nex, "COM2")) {
  465.                     note("Opening a DOS device file name [178]");
  466.                 }
  467.                 break;
  469.     default:
  470. break;
  471.         }
  472.     } else {
  473. if (*filenamefilter && strcmp(filenamefilter, "0")) {
  474.     ex = makeexpr_sizeof(copyexpr(nex), 0);
  475.     nex = makeexpr_bicall_2(filenamefilter, tp_str255, nex, ex);
  476. } else
  477.     nex = makeexpr_stringify(nex);
  478.     }
  479.     return nex;
  480. }
  484. Static Stmt *assignfilename(fex, nex)
  485. Expr *fex, *nex;
  486. {
  487.     Meaning *mp;
  489.     mp = isfilevar(fex);
  490.     if (mp && mp->namedfile) {
  491.         freeexpr(fex);
  492.         return makestmt_call(makeexpr_assign(makeexpr_name(format_s(name_FNVAR, mp->name),
  493.                                                            tp_str255),
  494.                                              nex));
  495.     } else {
  496.         if (mp)
  497.             warning("Don't know how to ASSIGN to a non-explicit file variable [207]");
  498.         else
  499.             note("Encountered an ASSIGN statement [179]");
  500.         return makestmt_call(makeexpr_bicall_2("assign", tp_void, fex, nex));
  501.     }
  502. }
  506. Static Stmt *proc_assign()
  507. {
  508.     Expr *fex, *nex;
  510.     if (!skipopenparen())
  511. return NULL;
  512.     fex = p_expr(tp_text);
  513.     if (!skipcomma())
  514. return NULL;
  515.     nex = checkfilename(p_expr(tp_str255));
  516.     skipcloseparen();
  517.     return assignfilename(fex, nex);
  518. }
  522. Static Stmt *handleopen(code)
  523. int code;
  524. {
  525.     Stmt *sp, *spassign;
  526.     Expr *fex, *nex, *ex;
  527.     Meaning *fmp;
  528.     int storefilename, needcheckopen = 1;
  529.     char modebuf[5], *cp;
  531.     if (!skipopenparen())
  532. return NULL;
  533.     fex = p_expr(tp_text);
  534.     fmp = isfilevar(fex);
  535.     storefilename = (fmp && fmp->namedfile);
  536.     spassign = NULL;
  537.     if (curtok == TOK_COMMA) {
  538.         gettok();
  539.         ex = p_expr(tp_str255);
  540.     } else
  541.         ex = NULL;
  542.     if (ex && (ex->val.type->kind == TK_STRING ||
  543.        ex->val.type->kind == TK_ARRAY)) {
  544.         nex = checkfilename(ex);
  545.         if (storefilename) {
  546.             spassign = assignfilename(copyexpr(fex), nex);
  547.             nex = makeexpr_name(format_s(name_FNVAR, fmp->name), tp_str255);
  548.         }
  549.         if (curtok == TOK_COMMA) {
  550.             gettok();
  551.             ex = p_expr(tp_str255);
  552.         } else
  553.             ex = NULL;
  554.     } else if (storefilename) {
  555.         nex = makeexpr_name(format_s(name_FNVAR, fmp->name), tp_str255);
  556.     } else {
  557. switch (code) {
  558.     case 0:
  559.         if (ex)
  560.     note("Can't interpret name argument in RESET [180]");
  561. break;
  562.        case 1:
  563.         note("REWRITE does not specify a name [181]");
  564. break;
  565.     case 2:
  566. note("OPEN does not specify a name [181]");
  567. break;
  568.     case 3:
  569. note("APPEND does not specify a name [181]");
  570. break;
  571. }
  572. nex = NULL;
  573.     }
  574.     if (ex) {
  575.         if (ord_type(ex->val.type)->kind == TK_INTEGER) {
  576.     if (!checkconst(ex, 1))
  577. note("Ignoring block size in binary file [182]");
  578.             freeexpr(ex);
  579.         } else {
  580.     if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
  581. cp = getstring(ex);
  582. if (strcicmp(cp, "SHARED"))
  583.     note(format_s("Ignoring option string "%s" in open [183]", cp));
  584.     } else
  585. note("Ignoring option string in open [183]");
  586.         }
  587.     }
  588.     switch (code) {
  590.         case 0:  /* reset */
  591.             strcpy(modebuf, "r");
  592.             break;
  594.         case 1:  /* rewrite */
  595.             strcpy(modebuf, "w");
  596.             break;
  598.         case 2:  /* open */
  599.             strcpy(modebuf, openmode);
  600.             break;
  602.         case 3:  /* append */
  603.             strcpy(modebuf, "a");
  604.             break;
  606.     }
  607.     if (!*modebuf) {
  608.         strcpy(modebuf, "r+");
  609.     }
  610.     if (readwriteopen == 2 ||
  611. (readwriteopen && fex->val.type != tp_text)) {
  612. if (!my_strchr(modebuf, '+'))
  613.     strcat(modebuf, "+");
  614.     }
  615.     if (fex->val.type != tp_text && binarymode != 0) {
  616.         if (binarymode == 1)
  617.             strcat(modebuf, "b");
  618.         else
  619.             note("Opening a binary file [184]");
  620.     }
  621.     if (!nex && fmp &&
  622. !is_std_file(fex) &&
  623. (literalfilesflag == 1 ||
  624.  strlist_cifind(literalfiles, fmp->name))) {
  625. nex = makeexpr_string(fmp->name);
  626.     }
  627.     if (!nex) {
  628. if (isvar(fex, mp_output)) {
  629.     note("RESET/REWRITE ignored for file OUTPUT [319]");
  630.     sp = NULL;
  631. } else {
  632.     sp = makestmt_call(makeexpr_bicall_1("rewind", tp_void,
  633.  copyexpr(fex)));
  634.     if (code == 0 || is_std_file(fex)) {
  635. sp = wrapopencheck(sp, copyexpr(fex));
  636. needcheckopen = 0;
  637.     } else
  638. sp = makestmt_if(makeexpr_rel(EK_NE, copyexpr(fex),
  639.       makeexpr_nil()),
  640.  sp,
  641.  makestmt_assign(copyexpr(fex),
  642.  makeexpr_bicall_0("tmpfile",
  643.    tp_text)));
  644. }
  645.     } else if (!strcmp(freopenname, "fclose") ||
  646.        !strcmp(freopenname, "fopen")) {
  647.         sp = makestmt_assign(copyexpr(fex),
  648.                              makeexpr_bicall_2("fopen", tp_text,
  649.                                                copyexpr(nex),
  650.                                                makeexpr_string(modebuf)));
  651.         if (!strcmp(freopenname, "fclose")) {
  652.             sp = makestmt_seq(makestmt_if(makeexpr_rel(EK_NE, copyexpr(fex), makeexpr_nil()),
  653.                                           makestmt_call(makeexpr_bicall_1("fclose", tp_void,
  654.                                                                           copyexpr(fex))),
  655.                                           NULL),
  656.                               sp);
  657.         }
  658.     } else {
  659.         sp = makestmt_assign(copyexpr(fex),
  660.                              makeexpr_bicall_3((*freopenname) ? freopenname : "freopen",
  661.                                                tp_text,
  662.                                                copyexpr(nex),
  663.                                                makeexpr_string(modebuf),
  664.                                                copyexpr(fex)));
  665.         if (!*freopenname) {
  666.             sp = makestmt_if(makeexpr_rel(EK_NE, copyexpr(fex), makeexpr_nil()),
  667.                              sp,
  668.                              makestmt_assign(copyexpr(fex),
  669.                                              makeexpr_bicall_2("fopen", tp_text,
  670.                                                                copyexpr(nex),
  671.                                                                makeexpr_string(modebuf))));
  672.         }
  673.     }
  674.     if (code == 2 && !*openmode && nex) {
  675.         sp = makestmt_seq(sp, makestmt_if(makeexpr_rel(EK_EQ, copyexpr(fex), makeexpr_nil()),
  676.                                           makestmt_assign(copyexpr(fex),
  677.                                                           makeexpr_bicall_2("fopen", tp_text,
  678.                                                                             copyexpr(nex),
  679.                                                                             makeexpr_string("w+"))),
  680.                                           NULL));
  681.     }
  682.     if (nex)
  683. freeexpr(nex);
  684.     if (FCheck(checkfileopen) && needcheckopen) {
  685.         sp = makestmt_seq(sp, makestmt_call(makeexpr_bicall_2("~SETIO", tp_void,
  686.                                                               makeexpr_rel(EK_NE, copyexpr(fex), makeexpr_nil()),
  687.       makeexpr_name(filenotfoundname, tp_int))));
  688.     }
  689.     sp = makestmt_seq(spassign, sp);
  690.     cp = (code == 0) ? resetbufname : setupbufname;
  691.     if (*cp && fmp)   /* (may be eaten later, if buffering isn't needed) */
  692. sp = makestmt_seq(sp,
  693.          makestmt_call(
  694.                      makeexpr_bicall_2(cp, tp_void, fex,
  695.  makeexpr_type(fex->val.type->basetype->basetype))));
  696.     else
  697. freeexpr(fex);
  698.     skipcloseparen();
  699.     return sp;
  700. }
  704. Static Stmt *proc_append()
  705. {
  706.     return handleopen(3);
  707. }
  711. Static Expr *func_arccos(ex)
  712. Expr *ex;
  713. {
  714.     return makeexpr_bicall_1("acos", tp_longreal, grabarg(ex, 0));
  715. }
  718. Static Expr *func_arcsin(ex)
  719. Expr *ex;
  720. {
  721.     return makeexpr_bicall_1("asin", tp_longreal, grabarg(ex, 0));
  722. }
  725. Static Expr *func_arctan(ex)
  726. Expr *ex;
  727. {
  728.     ex = grabarg(ex, 0);
  729.     if (atan2flag && ex->kind == EK_DIVIDE)
  730.         return makeexpr_bicall_2("atan2", tp_longreal, 
  731.                                  ex->args[0], ex->args[1]);
  732.     return makeexpr_bicall_1("atan", tp_longreal, ex);
  733. }
  736. Static Expr *func_arctanh(ex)
  737. Expr *ex;
  738. {
  739.     return makeexpr_bicall_1("atanh", tp_longreal, grabarg(ex, 0));
  740. }
  744. Static Stmt *proc_argv()
  745. {
  746.     Expr *ex, *aex, *lex;
  748.     if (!skipopenparen())
  749. return NULL;
  750.     ex = p_expr(tp_integer);
  751.     if (skipcomma()) {
  752. aex = p_expr(tp_str255);
  753.     } else
  754. return NULL;
  755.     skipcloseparen();
  756.     lex = makeexpr_sizeof(copyexpr(aex), 0);
  757.     aex = makeexpr_addrstr(aex);
  758.     return makestmt_call(makeexpr_bicall_3("P_sun_argv", tp_void,
  759.    aex, lex, makeexpr_arglong(ex, 0)));
  760. }
  763. Static Expr *func_asr()
  764. {
  765.     Expr *ex;
  767.     if (!skipopenparen())
  768. return NULL;
  769.     ex = p_expr(tp_integer);
  770.     if (skipcomma()) {
  771.         if (signedshift == 0 || signedshift == 2) {
  772.             ex = makeexpr_bicall_2("P_asr", ex->val.type, ex,
  773.    p_expr(tp_unsigned));
  774. } else {
  775.     ex = force_signed(ex);
  776.     ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
  777.     if (signedshift != 1)
  778. note("Assuming >> is an arithmetic shift [320]");
  779. }
  780. skipcloseparen();
  781.     }
  782.     return ex;
  783. }
  786. Static Expr *func_lsl()
  787. {
  788.     Expr *ex;
  790.     if (!skipopenparen())
  791. return NULL;
  792.     ex = p_expr(tp_integer);
  793.     if (skipcomma()) {
  794. ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_expr(tp_unsigned));
  795. skipcloseparen();
  796.     }
  797.     return ex;
  798. }
  801. Static Expr *func_lsr()
  802. {
  803.     Expr *ex;
  805.     if (!skipopenparen())
  806. return NULL;
  807.     ex = p_expr(tp_integer);
  808.     if (skipcomma()) {
  809. ex = force_unsigned(ex);
  810. ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_expr(tp_unsigned));
  811. skipcloseparen();
  812.     }
  813.     return ex;
  814. }
  818. Static Expr *func_bin()
  819. {
  820.     note("Using %b for binary printf format [185]");
  821.     return handle_vax_hex(NULL, "b", 1);
  822. }
  826. Static Expr *func_binary(ex)
  827. Expr *ex;
  828. {
  829.     char *cp;
  831.     ex = grabarg(ex, 0);
  832.     if (ex->kind == EK_CONST) {
  833.         cp = getstring(ex);
  834.         ex = makeexpr_long(my_strtol(cp, NULL, 2));
  835.         insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  836.         return ex;
  837.     } else {
  838.         return makeexpr_bicall_3("strtol", tp_integer, 
  839.                                  ex, makeexpr_nil(), makeexpr_long(2));
  840.     }
  841. }
  845. Static Expr *handle_bitsize(next)
  846. int next;
  847. {
  848.     Expr *ex;
  849.     Type *type;
  850.     int lpar;
  851.     long psize;
  853.     lpar = (curtok == TOK_LPAR);
  854.     if (lpar)
  855. gettok();
  856.     if (curtok == TOK_IDENT && curtokmeaning &&
  857. curtokmeaning->kind == MK_TYPE) {
  858.         ex = makeexpr_type(curtokmeaning->type);
  859.         gettok();
  860.     } else
  861.         ex = p_expr(NULL);
  862.     type = ex->val.type;
  863.     if (lpar)
  864. skipcloseparen();
  865.     psize = 0;
  866.     packedsize(NULL, &type, &psize, 0);
  867.     if (psize > 0 && psize < 32 && next) {
  868. if (psize > 16)
  869.     psize = 32;
  870. else if (psize > 8)
  871.     psize = 16;
  872. else if (psize > 4)
  873.     psize = 8;
  874. else if (psize > 2)
  875.     psize = 4;
  876. else if (psize > 1)
  877.     psize = 2;
  878. else
  879.     psize = 1;
  880.     }
  881.     if (psize)
  882. return makeexpr_long(psize);
  883.     else
  884. return makeexpr_times(makeexpr_sizeof(ex, 0),
  885.       makeexpr_long(sizeof_char ? sizeof_char : 8));
  886. }
  889. Static Expr *func_bitsize()
  890. {
  891.     return handle_bitsize(0);
  892. }
  895. Static Expr *func_bitnext()
  896. {
  897.     return handle_bitsize(1);
  898. }
  902. Static Expr *func_blockread()
  903. {
  904.     Expr *ex, *ex2, *vex, *sex, *fex;
  905.     Type *type;
  907.     if (!skipopenparen())
  908. return NULL;
  909.     fex = p_expr(tp_text);
  910.     if (!skipcomma())
  911. return NULL;
  912.     vex = p_expr(NULL);
  913.     if (!skipcomma())
  914. return NULL;
  915.     ex2 = p_expr(tp_integer);
  916.     if (curtok == TOK_COMMA) {
  917.         gettok();
  918.         sex = p_expr(tp_integer);
  919. sex = doseek(copyexpr(fex),
  920.      makeexpr_times(sex, makeexpr_long(512)))->exp1;
  921.     } else
  922.         sex = NULL;
  923.     skipcloseparen();
  924.     type = vex->val.type;
  925.     ex = makeexpr_bicall_4("fread", tp_integer,
  926.    makeexpr_addr(vex),
  927.    makeexpr_long(512),
  928.    convert_size(type, ex2, "BLOCKREAD"),
  929.    copyexpr(fex));
  930.     return makeexpr_comma(sex, ex);
  931. }
  935. Static Expr *func_blockwrite()
  936. {
  937.     Expr *ex, *ex2, *vex, *sex, *fex;
  938.     Type *type;
  940.     if (!skipopenparen())
  941. return NULL;
  942.     fex = p_expr(tp_text);
  943.     if (!skipcomma())
  944. return NULL;
  945.     vex = p_expr(NULL);
  946.     if (!skipcomma())
  947. return NULL;
  948.     ex2 = p_expr(tp_integer);
  949.     if (curtok == TOK_COMMA) {
  950.         gettok();
  951.         sex = p_expr(tp_integer);
  952. sex = doseek(copyexpr(fex),
  953.      makeexpr_times(sex, makeexpr_long(512)))->exp1;
  954.     } else
  955.         sex = NULL;
  956.     skipcloseparen();
  957.     type = vex->val.type;
  958.     ex = makeexpr_bicall_4("fwrite", tp_integer,
  959.    makeexpr_addr(vex),
  960.    makeexpr_long(512),
  961.    convert_size(type, ex2, "BLOCKWRITE"),
  962.    copyexpr(fex));
  963.     return makeexpr_comma(sex, ex);
  964. }
  969. Static Stmt *proc_blockread()
  970. {
  971.     Expr *ex, *ex2, *vex, *rex, *fex;
  972.     Type *type;
  974.     if (!skipopenparen())
  975. return NULL;
  976.     fex = p_expr(tp_text);
  977.     if (!skipcomma())
  978. return NULL;
  979.     vex = p_expr(NULL);
  980.     if (!skipcomma())
  981. return NULL;
  982.     ex2 = p_expr(tp_integer);
  983.     if (curtok == TOK_COMMA) {
  984.         gettok();
  985.         rex = p_expr(tp_integer);
  986.     } else
  987.         rex = NULL;
  988.     skipcloseparen();
  989.     type = vex->val.type;
  990.     if (rex) {
  991.         ex = makeexpr_bicall_4("fread", tp_integer,
  992.                                makeexpr_addr(vex),
  993.                                makeexpr_long(1),
  994.                                convert_size(type, ex2, "BLOCKREAD"),
  995.                                copyexpr(fex));
  996.         ex = makeexpr_assign(rex, ex);
  997.         if (!iocheck_flag)
  998.             ex = makeexpr_comma(ex,
  999.                                 makeexpr_assign(makeexpr_var(mp_ioresult),
  1000.                                                 makeexpr_long(0)));
  1001.     } else {
  1002.         ex = makeexpr_bicall_4("fread", tp_integer,
  1003.                                makeexpr_addr(vex),
  1004.                                convert_size(type, ex2, "BLOCKREAD"),
  1005.                                makeexpr_long(1),
  1006.                                copyexpr(fex));
  1007.         if (checkeof(fex)) {
  1008.             ex = makeexpr_bicall_2(name_SETIO, tp_void,
  1009.                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
  1010.    makeexpr_name(endoffilename, tp_int));
  1011.         }
  1012.     }
  1013.     return wrapopencheck(makestmt_call(ex), fex);
  1014. }
  1019. Static Stmt *proc_blockwrite()
  1020. {
  1021.     Expr *ex, *ex2, *vex, *rex, *fex;
  1022.     Type *type;
  1024.     if (!skipopenparen())
  1025. return NULL;
  1026.     fex = p_expr(tp_text);
  1027.     if (!skipcomma())
  1028. return NULL;
  1029.     vex = p_expr(NULL);
  1030.     if (!skipcomma())
  1031. return NULL;
  1032.     ex2 = p_expr(tp_integer);
  1033.     if (curtok == TOK_COMMA) {
  1034.         gettok();
  1035.         rex = p_expr(tp_integer);
  1036.     } else
  1037.         rex = NULL;
  1038.     skipcloseparen();
  1039.     type = vex->val.type;
  1040.     if (rex) {
  1041.         ex = makeexpr_bicall_4("fwrite", tp_integer,
  1042.                                makeexpr_addr(vex),
  1043.                                makeexpr_long(1),
  1044.                                convert_size(type, ex2, "BLOCKWRITE"),
  1045.                                copyexpr(fex));
  1046.         ex = makeexpr_assign(rex, ex);
  1047.         if (!iocheck_flag)
  1048.             ex = makeexpr_comma(ex,
  1049.                                 makeexpr_assign(makeexpr_var(mp_ioresult),
  1050.                                                 makeexpr_long(0)));
  1051.     } else {
  1052.         ex = makeexpr_bicall_4("fwrite", tp_integer,
  1053.                                makeexpr_addr(vex),
  1054.                                convert_size(type, ex2, "BLOCKWRITE"),
  1055.                                makeexpr_long(1),
  1056.                                copyexpr(fex));
  1057.         if (FCheck(checkfilewrite)) {
  1058.             ex = makeexpr_bicall_2(name_SETIO, tp_void,
  1059.                                    makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
  1060.    makeexpr_name(filewriteerrorname, tp_int));
  1061.         }
  1062.     }
  1063.     return wrapopencheck(makestmt_call(ex), fex);
  1064. }
  1068. Static Stmt *proc_bclr()
  1069. {
  1070.     Expr *ex, *ex2;
  1072.     if (!skipopenparen())
  1073. return NULL;
  1074.     ex = p_expr(tp_integer);
  1075.     if (!skipcomma())
  1076. return NULL;
  1077.     ex2 = p_expr(tp_integer);
  1078.     skipcloseparen();
  1079.     return makestmt_assign(ex,
  1080.    makeexpr_bin(EK_BAND, ex->val.type,
  1081. copyexpr(ex),
  1082. makeexpr_un(EK_BNOT, ex->val.type,
  1083. makeexpr_bin(EK_LSH, tp_integer,
  1084.      makeexpr_arglong(
  1085.          makeexpr_long(1), 1),
  1086.      ex2))));
  1087. }
  1091. Static Stmt *proc_bset()
  1092. {
  1093.     Expr *ex, *ex2;
  1095.     if (!skipopenparen())
  1096. return NULL;
  1097.     ex = p_expr(tp_integer);
  1098.     if (!skipcomma())
  1099. return NULL;
  1100.     ex2 = p_expr(tp_integer);
  1101.     skipcloseparen();
  1102.     return makestmt_assign(ex,
  1103.    makeexpr_bin(EK_BOR, ex->val.type,
  1104. copyexpr(ex),
  1105. makeexpr_bin(EK_LSH, tp_integer,
  1106.      makeexpr_arglong(
  1107.          makeexpr_long(1), 1),
  1108.      ex2)));
  1109. }
  1113. Static Expr *func_bsl()
  1114. {
  1115.     Expr *ex, *ex2;
  1117.     if (!skipopenparen())
  1118. return NULL;
  1119.     ex = p_expr(tp_integer);
  1120.     if (!skipcomma())
  1121. return NULL;
  1122.     ex2 = p_expr(tp_integer);
  1123.     skipcloseparen();
  1124.     return makeexpr_bin(EK_LSH, tp_integer, ex, ex2);
  1125. }
  1129. Static Expr *func_bsr()
  1130. {
  1131.     Expr *ex, *ex2;
  1133.     if (!skipopenparen())
  1134. return NULL;
  1135.     ex = p_expr(tp_integer);
  1136.     if (!skipcomma())
  1137. return NULL;
  1138.     ex2 = p_expr(tp_integer);
  1139.     skipcloseparen();
  1140.     return makeexpr_bin(EK_RSH, tp_integer, force_unsigned(ex), ex2);
  1141. }
  1145. Static Expr *func_btst()
  1146. {
  1147.     Expr *ex, *ex2;
  1149.     if (!skipopenparen())
  1150. return NULL;
  1151.     ex = p_expr(tp_integer);
  1152.     if (!skipcomma())
  1153. return NULL;
  1154.     ex2 = p_expr(tp_integer);
  1155.     skipcloseparen();
  1156.     return makeexpr_rel(EK_NE,
  1157. makeexpr_bin(EK_BAND, tp_integer,
  1158.      ex,
  1159.      makeexpr_bin(EK_LSH, tp_integer,
  1160.   makeexpr_arglong(
  1161.       makeexpr_long(1), 1),
  1162.   ex2)),
  1163. makeexpr_long(0));
  1164. }
  1168. Static Expr *func_byteread()
  1169. {
  1170.     Expr *ex, *ex2, *vex, *sex, *fex;
  1171.     Type *type;
  1173.     if (!skipopenparen())
  1174. return NULL;
  1175.     fex = p_expr(tp_text);
  1176.     if (!skipcomma())
  1177. return NULL;
  1178.     vex = p_expr(NULL);
  1179.     if (!skipcomma())
  1180. return NULL;
  1181.     ex2 = p_expr(tp_integer);
  1182.     if (curtok == TOK_COMMA) {
  1183.         gettok();
  1184.         sex = p_expr(tp_integer);
  1185. sex = doseek(copyexpr(fex), sex)->exp1;
  1186.     } else
  1187.         sex = NULL;
  1188.     skipcloseparen();
  1189.     type = vex->val.type;
  1190.     ex = makeexpr_bicall_4("fread", tp_integer,
  1191.    makeexpr_addr(vex),
  1192.    makeexpr_long(1),
  1193.    convert_size(type, ex2, "BYTEREAD"),
  1194.    copyexpr(fex));
  1195.     return makeexpr_comma(sex, ex);
  1196. }
  1200. Static Expr *func_bytewrite()
  1201. {
  1202.     Expr *ex, *ex2, *vex, *sex, *fex;
  1203.     Type *type;
  1205.     if (!skipopenparen())
  1206. return NULL;
  1207.     fex = p_expr(tp_text);
  1208.     if (!skipcomma())
  1209. return NULL;
  1210.     vex = p_expr(NULL);
  1211.     if (!skipcomma())
  1212. return NULL;
  1213.     ex2 = p_expr(tp_integer);
  1214.     if (curtok == TOK_COMMA) {
  1215.         gettok();
  1216.         sex = p_expr(tp_integer);
  1217. sex = doseek(copyexpr(fex), sex)->exp1;
  1218.     } else
  1219.         sex = NULL;
  1220.     skipcloseparen();
  1221.     type = vex->val.type;
  1222.     ex = makeexpr_bicall_4("fwrite", tp_integer,
  1223.    makeexpr_addr(vex),
  1224.    makeexpr_long(1),
  1225.    convert_size(type, ex2, "BYTEWRITE"),
  1226.    copyexpr(fex));
  1227.     return makeexpr_comma(sex, ex);
  1228. }
  1232. Static Expr *func_byte_offset()
  1233. {
  1234.     Type *tp;
  1235.     Meaning *mp;
  1236.     Expr *ex;
  1238.     if (!skipopenparen())
  1239. return NULL;
  1240.     tp = p_type(NULL);
  1241.     if (!skipcomma())
  1242. return NULL;
  1243.     if (!wexpecttok(TOK_IDENT))
  1244. return NULL;
  1245.     mp = curtoksym->fbase;
  1246.     while (mp && mp->rectype != tp)
  1247. mp = mp->snext;
  1248.     if (!mp)
  1249. ex = makeexpr_name(curtokcase, tp_integer);
  1250.     else
  1251. ex = makeexpr_name(mp->name, tp_integer);
  1252.     gettok();
  1253.     skipcloseparen();
  1254.     return makeexpr_bicall_2("OFFSETOF", (size_t_long) ? tp_integer : tp_int,
  1255.      makeexpr_type(tp), ex);
  1256. }
  1260. Static Stmt *proc_call()
  1261. {
  1262.     Expr *ex, *ex2, *ex3;
  1263.     Type *type, *tp;
  1264.     Meaning *mp;
  1266.     if (!skipopenparen())
  1267. return NULL;
  1268.     ex2 = p_expr(tp_proc);
  1269.     type = ex2->val.type;
  1270.     if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
  1271.         warning("CALL requires a procedure variable [208]");
  1272. type = tp_proc;
  1273.     }
  1274.     ex = makeexpr(EK_SPCALL, 1);
  1275.     ex->val.type = tp_void;
  1276.     ex->args[0] = copyexpr(ex2);
  1277.     if (type->escale != 0)
  1278. ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
  1279.     makepointertype(type->basetype));
  1280.     mp = type->basetype->fbase;
  1281.     if (mp) {
  1282.         if (wneedtok(TOK_COMMA))
  1283.     ex = p_funcarglist(ex, mp, 0, 0);
  1284.     }
  1285.     skipcloseparen();
  1286.     if (type->escale != 1 || hasstaticlinks == 2) {
  1287. freeexpr(ex2);
  1288. return makestmt_call(ex);
  1289.     }
  1290.     ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
  1291.     ex3 = copyexpr(ex);
  1292.     insertarg(&ex3, ex3->nargs, copyexpr(ex2));
  1293.     tp = maketype(TK_FUNCTION);
  1294.     tp->basetype = type->basetype->basetype;
  1295.     tp->fbase = type->basetype->fbase;
  1296.     tp->issigned = 1;
  1297.     ex3->args[0]->val.type = makepointertype(tp);
  1298.     return makestmt_if(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
  1299.                        makestmt_call(ex3),
  1300.                        makestmt_call(ex));
  1301. }
  1305. Static Expr *func_chr()
  1306. {
  1307.     Expr *ex;
  1309.     ex = p_expr(tp_integer);
  1310.     if ((exprlongness(ex) < 0 || ex->kind == EK_CAST) && ex->kind != EK_ACTCAST)
  1311.         ex->val.type = tp_char;
  1312.     else
  1313.         ex = makeexpr_cast(ex, tp_char);
  1314.     return ex;
  1315. }
  1319. Static Stmt *proc_close()
  1320. {
  1321.     Stmt *sp;
  1322.     Expr *fex, *ex;
  1323.     char *opt;
  1325.     if (!skipopenparen())
  1326. return NULL;
  1327.     fex = p_expr(tp_text);
  1328.     sp = makestmt_if(makeexpr_rel(EK_NE, copyexpr(fex), makeexpr_nil()),
  1329.                      makestmt_call(makeexpr_bicall_1("fclose", tp_void,
  1330.                                                      copyexpr(fex))),
  1331.                      (FCheck(checkfileisopen))
  1332.          ? makestmt_call(
  1333.      makeexpr_bicall_1(name_ESCIO,
  1334.        tp_integer,
  1335.        makeexpr_name(filenotopenname,
  1336.      tp_int)))
  1337.                          : NULL);
  1338.     if (curtok == TOK_COMMA) {
  1339.         gettok();
  1340. opt = "";
  1341. if (curtok == TOK_IDENT &&
  1342.     (!strcicmp(curtokbuf, "LOCK") ||
  1343.      !strcicmp(curtokbuf, "PURGE") ||
  1344.      !strcicmp(curtokbuf, "NORMAL") ||
  1345.      !strcicmp(curtokbuf, "CRUNCH"))) {
  1346.     opt = stralloc(curtokbuf);
  1347.     gettok();
  1348. } else {
  1349.     ex = p_expr(tp_str255);
  1350.     if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING)
  1351. opt = ex->val.s;
  1352. }
  1353. if (!strcicmp(opt, "PURGE")) {
  1354.     note("File is being closed with PURGE option [186]");
  1355.         }
  1356.     }
  1357.     sp = makestmt_seq(sp, makestmt_assign(fex, makeexpr_nil()));
  1358.     skipcloseparen();
  1359.     return sp;
  1360. }
  1364. Static Expr *func_concat()
  1365. {
  1366.     Expr *ex;
  1368.     if (!skipopenparen())
  1369. return makeexpr_string("oops");
  1370.     ex = p_expr(tp_str255);
  1371.     while (curtok == TOK_COMMA) {
  1372.         gettok();
  1373.         ex = makeexpr_concat(ex, p_expr(tp_str255), 0);
  1374.     }
  1375.     skipcloseparen();
  1376.     return ex;
  1377. }
  1381. Static Expr *func_copy(ex)
  1382. Expr *ex;
  1383. {
  1384.     if (isliteralconst(ex->args[3], NULL) == 2 &&
  1385.         ex->args[3]->val.i >= stringceiling) {
  1386.         return makeexpr_bicall_3("sprintf", ex->val.type,
  1387.                                  ex->args[0],
  1388.                                  makeexpr_string("%s"),
  1389.                                  bumpstring(ex->args[1], 
  1390.                                             makeexpr_unlongcast(ex->args[2]), 1));
  1391.     }
  1392.     if (checkconst(ex->args[2], 1)) {
  1393.         return makeexpr_addr(makeexpr_substring(ex->args[0], ex->args[1], 
  1394.                                                 ex->args[2], ex->args[3]));
  1395.     }
  1396.     return makeexpr_bicall_4(strsubname, ex->val.type,
  1397.                              ex->args[0],
  1398.                              ex->args[1],
  1399.                              makeexpr_arglong(ex->args[2], 0),
  1400.                              makeexpr_arglong(ex->args[3], 0));
  1401. }
  1405. Static Expr *func_cos(ex)
  1406. Expr *ex;
  1407. {
  1408.     return makeexpr_bicall_1("cos", tp_longreal, grabarg(ex, 0));
  1409. }
  1412. Static Expr *func_cosh(ex)
  1413. Expr *ex;
  1414. {
  1415.     return makeexpr_bicall_1("cosh", tp_longreal, grabarg(ex, 0));
  1416. }
  1420. Static Stmt *proc_cycle()
  1421. {
  1422.     return makestmt(SK_CONTINUE);
  1423. }
  1427. Static Stmt *proc_dec()
  1428. {
  1429.     Expr *vex, *ex;
  1431.     if (!skipopenparen())
  1432. return NULL;
  1433.     vex = p_expr(NULL);
  1434.     if (curtok == TOK_COMMA) {
  1435.         gettok();
  1436.         ex = p_expr(tp_integer);
  1437.     } else
  1438.         ex = makeexpr_long(1);
  1439.     skipcloseparen();
  1440.     return makestmt_assign(vex, makeexpr_minus(copyexpr(vex), ex));
  1441. }
  1445. Static Expr *func_dec()
  1446. {
  1447.     return handle_vax_hex(NULL, "d", 0);
  1448. }
  1452. Static Stmt *proc_delete(ex)
  1453. Expr *ex;
  1454. {
  1455.     if (ex->nargs == 1)   /* Kludge for Oregon Software Pascal's delete(f) */
  1456. return makestmt_call(makeexpr_bicall_1(strdeletename, tp_void, ex->args[0]));
  1457.     return makestmt_call(makeexpr_bicall_3(strdeletename, tp_void,
  1458.                                            ex->args[0], 
  1459.                                            makeexpr_arglong(ex->args[1], 0),
  1460.                                            makeexpr_arglong(ex->args[2], 0)));
  1461. }
  1465. void parse_special_variant(tp, buf)
  1466. Type *tp;
  1467. char *buf;
  1468. {
  1469.     char *cp;
  1470.     Expr *ex;
  1472.     if (!tp)
  1473. intwarning("parse_special_variant", "tp == NULL");
  1474.     if (!tp || tp->meaning == NULL) {
  1475. *buf = 0;
  1476. if (curtok == TOK_COMMA) {
  1477.     skiptotoken(TOK_RPAR);
  1478. }
  1479. return;
  1480.     }
  1481.     strcpy(buf, tp->meaning->name);
  1482.     while (curtok == TOK_COMMA) {
  1483. gettok();
  1484. cp = buf + strlen(buf);
  1485. *cp++ = '.';
  1486. if (curtok == TOK_MINUS) {
  1487.     *cp++ = '-';
  1488.     gettok();
  1489. }
  1490. if (curtok == TOK_INTLIT ||
  1491.     curtok == TOK_HEXLIT ||
  1492.     curtok == TOK_OCTLIT) {
  1493.     sprintf(cp, "%ld", curtokint);
  1494.     gettok();
  1495. } else if (curtok == TOK_HAT || curtok == TOK_STRLIT) {
  1496.     ex = makeexpr_charcast(accumulate_strlit());
  1497.     if (ex->kind == EK_CONST) {
  1498. if (ex->val.i <= 32 || ex->val.i > 126 ||
  1499.     ex->val.i == ''' || ex->val.i == '\' ||
  1500.     ex->val.i == '=' || ex->val.i == '}')
  1501.     sprintf(cp, "%ld", ex->val.i);
  1502. else
  1503.     strcpy(cp, makeCchar(ex->val.i));
  1504.     } else {
  1505. *buf = 0;
  1506. *cp = 0;
  1507.     }
  1508.     freeexpr(ex);
  1509. } else {
  1510.     if (!wexpecttok(TOK_IDENT)) {
  1511. skiptotoken(TOK_RPAR);
  1512. return;
  1513.     }
  1514.     if (curtokmeaning)
  1515. strcpy(cp, curtokmeaning->name);
  1516.     else
  1517. strcpy(cp, curtokbuf);
  1518.     gettok();
  1519. }
  1520.     }
  1521. }
  1524. char *find_special_variant(buf, spname, splist, need)
  1525. char *buf, *spname;
  1526. Strlist *splist;
  1527. int need;
  1528. {
  1529.     Strlist *best = NULL;
  1530.     int len, bestlen = -1;
  1531.     char *cp, *cp2;
  1533.     if (!*buf)
  1534. return NULL;
  1535.     while (splist) {
  1536. cp = splist->s;
  1537. cp2 = buf;
  1538. while (*cp && toupper(*cp) == toupper(*cp2))
  1539.     cp++, cp2++;
  1540. len = cp2 - buf;
  1541. if (!*cp && (!*cp2 || *cp2 == '.') && len > bestlen) {
  1542.     best = splist;
  1543.     bestlen = len;
  1544. }
  1545. splist = splist->next;
  1546.     }
  1547.     if (bestlen != strlen(buf) && my_strchr(buf, '.')) {
  1548. if ((need & 1) || bestlen >= 0) {
  1549.     if (need & 2)
  1550. return NULL;
  1551.     if (spname)
  1552. note(format_ss("No %s form known for %s [187]",
  1553.        spname, strupper(buf)));
  1554. }
  1555.     }
  1556.     if (bestlen >= 0)
  1557. return (char *)best->value;
  1558.     else
  1559. return NULL;
  1560. }
  1564. Static char *choose_free_func(ex)
  1565. Expr *ex;
  1566. {
  1567.     if (!*freename) {
  1568. if (!*freervaluename)
  1569.     return "free";
  1570. else
  1571.     return freervaluename;
  1572.     }
  1573.     if (!*freervaluename)
  1574. return freervaluename;
  1575.     if (expr_is_lvalue(ex))
  1576. return freename;
  1577.     else
  1578. return freervaluename;
  1579. }
  1582. Static Stmt *proc_dispose()
  1583. {
  1584.     Expr *ex;
  1585.     Type *type;
  1586.     char *name, vbuf[1000];
  1588.     if (!skipopenparen())
  1589. return NULL;
  1590.     ex = p_expr(tp_anyptr);
  1591.     type = ex->val.type->basetype;
  1592.     parse_special_variant(type, vbuf);
  1593.     skipcloseparen();
  1594.     name = find_special_variant(vbuf, "SpecialFree", specialfrees, 0);
  1595.     if (!name)
  1596. name = choose_free_func(ex);
  1597.     return makestmt_call(makeexpr_bicall_1(name, tp_void, ex));
  1598. }
  1602. Static Expr *func_exp(ex)
  1603. Expr *ex;
  1604. {
  1605.     return makeexpr_bicall_1("exp", tp_longreal, grabarg(ex, 0));
  1606. }
  1610. Static Expr *func_expo(ex)
  1611. Expr *ex;
  1612. {
  1613.     Meaning *tvar;
  1615.     tvar = makestmttempvar(tp_int, name_TEMP);
  1616.     return makeexpr_comma(makeexpr_bicall_2("frexp", tp_longreal,
  1617.     grabarg(ex, 0),
  1618.     makeexpr_addr(makeexpr_var(tvar))),
  1619.   makeexpr_var(tvar));
  1620. }
  1624. int is_std_file(ex)
  1625. Expr *ex;
  1626. {
  1627.     return isvar(ex, mp_input) || isvar(ex, mp_output) ||
  1628.            isvar(ex, mp_stderr);
  1629. }
  1633. Static Expr *iofunc(ex, code)
  1634. Expr *ex;
  1635. int code;
  1636. {
  1637.     Expr *ex2 = NULL, *ex3 = NULL;
  1638.     Meaning *tvar = NULL;
  1640.     if (FCheck(checkfileisopen) && !is_std_file(ex)) {
  1641.         if (exprspeed(ex) < 5 && nosideeffects(ex, 0)) {
  1642.             ex2 = copyexpr(ex);
  1643.         } else {
  1644.             ex3 = ex;
  1645.             tvar = makestmttempvar(ex->val.type, name_TEMP);
  1646.             ex2 = makeexpr_var(tvar);
  1647.             ex = makeexpr_var(tvar);
  1648.         }
  1649.     }
  1650.     switch (code) {
  1652.         case 0:  /* eof */
  1653.     if (*eofname)
  1654. ex = makeexpr_bicall_1(eofname, tp_boolean, ex);
  1655.     else
  1656. ex = makeexpr_rel(EK_NE, makeexpr_bicall_1("feof", tp_int, ex),
  1657.          makeexpr_long(0));
  1658.             break;
  1660.         case 1:  /* eoln */
  1661.             ex = makeexpr_bicall_1(eolnname, tp_boolean, ex);
  1662.             break;
  1664.         case 2:  /* position or filepos */
  1665.             ex = makeexpr_bicall_1(fileposname, tp_integer, ex);
  1666.             break;
  1668.         case 3:  /* maxpos or filesize */
  1669.             ex = makeexpr_bicall_1(maxposname, tp_integer, ex);
  1670.             break;
  1672.     }
  1673.     if (ex2) {
  1674.         ex = makeexpr_bicall_4("~CHKIO",
  1675.                                (code == 0 || code == 1) ? tp_boolean : tp_integer,
  1676.                                makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
  1677.        makeexpr_name("FileNotOpen", tp_int),
  1678.                                ex, makeexpr_long(0));
  1679.     }
  1680.     if (ex3)
  1681.         ex = makeexpr_comma(makeexpr_assign(makeexpr_var(tvar), ex3), ex);
  1682.     return ex;
  1683. }
  1687. Static Expr *func_eof()
  1688. {
  1689.     Expr *ex;
  1691.     if (curtok == TOK_LPAR)
  1692.         ex = p_parexpr(tp_text);
  1693.     else
  1694.         ex = makeexpr_var(mp_input);
  1695.     return iofunc(ex, 0);
  1696. }
  1700. Static Expr *func_eoln()
  1701. {
  1702.     Expr *ex;
  1704.     if (curtok == TOK_LPAR)
  1705.         ex = p_parexpr(tp_text);
  1706.     else
  1707.         ex = makeexpr_var(mp_input);
  1708.     return iofunc(ex, 1);
  1709. }
  1713. Static Stmt *proc_escape()
  1714. {
  1715.     Expr *ex;
  1717.     if (curtok == TOK_LPAR)
  1718.         ex = p_parexpr(tp_integer);
  1719.     else
  1720.         ex = makeexpr_long(0);
  1721.     return makestmt_call(makeexpr_bicall_1(name_ESCAPE, tp_int, 
  1722.                                            makeexpr_arglong(ex, 0)));
  1723. }
  1727. Static Stmt *proc_excl()
  1728. {
  1729.     Expr *vex, *ex;
  1731.     if (!skipopenparen())
  1732. return NULL;
  1733.     vex = p_expr(NULL);
  1734.     if (!skipcomma())
  1735. return NULL;
  1736.     ex = p_expr(vex->val.type->indextype);
  1737.     skipcloseparen();
  1738.     if (vex->val.type->kind == TK_SMALLSET)
  1739. return makestmt_assign(vex, makeexpr_bin(EK_BAND, vex->val.type,
  1740.  copyexpr(vex),
  1741.  makeexpr_un(EK_BNOT, vex->val.type,
  1742.      makeexpr_bin(EK_LSH, vex->val.type,
  1743.   makeexpr_longcast(makeexpr_long(1), 1),
  1744.   ex))));
  1745.     else
  1746. return makestmt_call(makeexpr_bicall_2(setremname, tp_void, vex,
  1747.        makeexpr_arglong(enum_to_int(ex), 0)));
  1748. }
  1752. Stmt *proc_exit()
  1753. {
  1754.     Stmt *sp;
  1756.     if (modula2) {
  1757. return makestmt(SK_BREAK);
  1758.     }
  1759.     if (curtok == TOK_LPAR) {
  1760.         gettok();
  1761. if (curtok == TOK_PROGRAM ||
  1762.     (curtok == TOK_IDENT && curtokmeaning->kind == MK_MODULE)) {
  1763.     gettok();
  1764.     skipcloseparen();
  1765.     return makestmt_call(makeexpr_bicall_1("exit", tp_void,
  1766.    makeexpr_long(0)));
  1767. }
  1768.         if (curtok != TOK_IDENT || !curtokmeaning || curtokmeaning != curctx)
  1769.             note("Attempting to EXIT beyond this function [188]");
  1770.         gettok();
  1771. skipcloseparen();
  1772.     }
  1773.     sp = makestmt(SK_RETURN);
  1774.     if (curctx->kind == MK_FUNCTION && curctx->isfunction) {
  1775.         sp->exp1 = makeexpr_var(curctx->cbase);
  1776.         curctx->cbase->refcount++;
  1777.     }
  1778.     return sp;
  1779. }
  1783. Static Expr *file_iofunc(code, base)
  1784. int code;
  1785. long base;
  1786. {
  1787.     Expr *ex;
  1788.     Type *basetype;
  1790.     if (curtok == TOK_LPAR)
  1791. ex = p_parexpr(tp_text);
  1792.     else
  1793. ex = makeexpr_var(mp_input);
  1794.     if (!ex->val.type || !ex->val.type->basetype ||
  1795. !ex->val.type->basetype->basetype)
  1796. basetype = tp_char;
  1797.     else
  1798. basetype = ex->val.type->basetype->basetype;
  1799.     return makeexpr_plus(makeexpr_div(iofunc(ex, code),
  1800.                                       makeexpr_sizeof(makeexpr_type(basetype), 0)),
  1801.                          makeexpr_long(base));
  1802. }
  1806. Static Expr *func_fcall()
  1807. {
  1808.     Expr *ex, *ex2, *ex3;
  1809.     Type *type, *tp;
  1810.     Meaning *mp, *tvar = NULL;
  1811.     int firstarg = 0;
  1813.     if (!skipopenparen())
  1814. return NULL;
  1815.     ex2 = p_expr(tp_proc);
  1816.     type = ex2->val.type;
  1817.     if (type->kind != TK_PROCPTR && type->kind != TK_CPROCPTR) {
  1818.         warning("FCALL requires a function variable [209]");
  1819. type = tp_proc;
  1820.     }
  1821.     ex = makeexpr(EK_SPCALL, 1);
  1822.     ex->val.type = type->basetype->basetype;
  1823.     ex->args[0] = copyexpr(ex2);
  1824.     if (type->escale != 0)
  1825. ex->args[0] = makeexpr_cast(makeexpr_dotq(ex2, "proc", tp_anyptr),
  1826.     makepointertype(type->basetype));
  1827.     mp = type->basetype->fbase;
  1828.     if (mp && mp->isreturn) {    /* pointer to buffer for return value */
  1829.         tvar = makestmttempvar(ex->val.type->basetype,
  1830.             (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
  1831.         insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
  1832.         mp = mp->xnext;
  1833. firstarg++;
  1834.     }
  1835.     if (mp) {
  1836.         if (wneedtok(TOK_COMMA))
  1837.     ex = p_funcarglist(ex, mp, 0, 0);
  1838.     }
  1839.     if (tvar)
  1840. ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
  1841.     skipcloseparen();
  1842.     if (type->escale != 1 || hasstaticlinks == 2) {
  1843. freeexpr(ex2);
  1844. return ex;
  1845.     }
  1846.     ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
  1847.     ex3 = copyexpr(ex);
  1848.     insertarg(&ex3, ex3->nargs, copyexpr(ex2));
  1849.     tp = maketype(TK_FUNCTION);
  1850.     tp->basetype = type->basetype->basetype;
  1851.     tp->fbase = type->basetype->fbase;
  1852.     tp->issigned = 1;
  1853.     ex3->args[0]->val.type = makepointertype(tp);
  1854.     return makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
  1855.  ex3, ex);
  1856. }
  1860. Static Expr *func_filepos()
  1861. {
  1862.     return file_iofunc(2, seek_base);
  1863. }
  1867. Static Expr *func_filesize()
  1868. {
  1869.     return file_iofunc(3, 1L);
  1870. }
  1874. Static Stmt *proc_fillchar()
  1875. {
  1876.     Expr *vex, *ex, *cex;
  1878.     if (!skipopenparen())
  1879. return NULL;
  1880.     vex = gentle_cast(makeexpr_addr(p_expr(NULL)), tp_anyptr);
  1881.     if (!skipcomma())
  1882. return NULL;
  1883.     ex = convert_size(argbasetype(vex), p_expr(tp_integer), "FILLCHAR");
  1884.     if (!skipcomma())
  1885. return NULL;
  1886.     cex = makeexpr_charcast(p_expr(tp_integer));
  1887.     skipcloseparen();
  1888.     return makestmt_call(makeexpr_bicall_3("memset", tp_void,
  1889.                                            vex,
  1890.                                            makeexpr_arglong(cex, 0),
  1891.                                            makeexpr_arglong(ex, (size_t_long != 0))));
  1892. }
  1896. Static Expr *func_sngl()
  1897. {
  1898.     Expr *ex;
  1900.     ex = p_parexpr(tp_real);
  1901.     return makeexpr_cast(ex, tp_real);
  1902. }
  1906. Static Expr *func_float()
  1907. {
  1908.     Expr *ex;
  1910.     ex = p_parexpr(tp_longreal);
  1911.     return makeexpr_cast(ex, tp_longreal);
  1912. }
  1916. Static Stmt *proc_flush()
  1917. {
  1918.     Expr *ex;
  1919.     Stmt *sp;
  1921.     ex = p_parexpr(tp_text);
  1922.     sp = makestmt_call(makeexpr_bicall_1("fflush", tp_void, ex));
  1923.     if (iocheck_flag)
  1924.         sp = makestmt_seq(sp, makestmt_assign(makeexpr_var(mp_ioresult), 
  1925.                                               makeexpr_long(0)));
  1926.     return sp;
  1927. }
  1931. Static Expr *func_frac(ex)
  1932. Expr *ex;
  1933. {
  1934.     Meaning *tvar;
  1936.     tvar = makestmttempvar(tp_longreal, name_DUMMY);
  1937.     return makeexpr_bicall_2("modf", tp_longreal, 
  1938.                              grabarg(ex, 0),
  1939.                              makeexpr_addr(makeexpr_var(tvar)));
  1940. }
  1944. Static Stmt *proc_freemem(ex)
  1945. Expr *ex;
  1946. {
  1947.     Stmt *sp;
  1948.     Expr *vex;
  1950.     vex = makeexpr_hat(eatcasts(ex->args[0]), 0);
  1951.     sp = makestmt_call(makeexpr_bicall_1(choose_free_func(vex),
  1952.  tp_void, copyexpr(vex)));
  1953.     if (alloczeronil) {
  1954.         sp = makestmt_if(makeexpr_rel(EK_NE, vex, makeexpr_nil()),
  1955.                          sp, NULL);
  1956.     } else
  1957.         freeexpr(vex);
  1958.     return sp;
  1959. }
  1963. Static Stmt *proc_get()
  1964. {
  1965.     Expr *ex;
  1966.     Type *type;
  1968.     if (curtok == TOK_LPAR)
  1969. ex = p_parexpr(tp_text);
  1970.     else
  1971. ex = makeexpr_var(mp_input);
  1972.     requirefilebuffer(ex);
  1973.     type = ex->val.type;
  1974.     if (isfiletype(type) && *chargetname &&
  1975. type->basetype->basetype->kind == TK_CHAR)
  1976. return makestmt_call(makeexpr_bicall_1(chargetname, tp_void, ex));
  1977.     else if (isfiletype(type) && *arraygetname &&
  1978.      type->basetype->basetype->kind == TK_ARRAY)
  1979. return makestmt_call(makeexpr_bicall_2(arraygetname, tp_void, ex,
  1980.        makeexpr_type(type->basetype->basetype)));
  1981.     else