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

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

编译器/解释器

开发平台：

C/C++

pexpr.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_PEXPR_C
  21. #include "trans.h"
  26. Expr *dots_n_hats(ex, target)
  27. Expr *ex;
  28. Type *target;
  29. {
  30.     Expr *ex2, *ex3;
  31.     Type *tp, *tp2, *ot;
  32.     Meaning *mp, *tvar;
  33.     int bits, hassl;
  35.     for (;;) {
  36. if ((ex->val.type->kind == TK_PROCPTR ||
  37.      ex->val.type->kind == TK_CPROCPTR) &&
  38.     curtok != TOK_ASSIGN &&
  39.     ((mp = (tp2 = ex->val.type)->basetype->fbase) == NULL ||
  40.      (mp->isreturn && mp->xnext == NULL) ||
  41.      curtok == TOK_LPAR) &&
  42.     (tp2->basetype->basetype != tp_void || target == tp_void) &&
  43.     (!target || (target->kind != TK_PROCPTR &&
  44.  target->kind != TK_CPROCPTR))) {
  45.     hassl = tp2->escale;
  46.     ex2 = ex;
  47.     ex3 = copyexpr(ex2);
  48.     if (hassl != 0)
  49. ex3 = makeexpr_cast(makeexpr_dotq(ex3, "proc", tp_anyptr),
  50.     makepointertype(tp2->basetype));
  51.     ex = makeexpr_un(EK_SPCALL, tp2->basetype->basetype, ex3);
  52.     if (mp && mp->isreturn) {  /* pointer to buffer for return value */
  53. tvar = makestmttempvar(ex->val.type->basetype,
  54.        (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
  55. insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
  56. mp = mp->xnext;
  57.     }
  58.     if (mp) {
  59. if (wneedtok(TOK_LPAR)) {
  60.     ex = p_funcarglist(ex, mp, 0, 0);
  61.     skipcloseparen();
  62. }
  63.     } else if (curtok == TOK_LPAR) {
  64. gettok();
  65. if (!wneedtok(TOK_RPAR))
  66.     skippasttoken(TOK_RPAR);
  67.     }
  68.     if (hassl != 1 || hasstaticlinks == 2) {
  69. freeexpr(ex2);
  70.     } else {
  71. ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
  72. ex3 = copyexpr(ex);
  73. insertarg(&ex3, ex3->nargs, copyexpr(ex2));
  74. tp = maketype(TK_FUNCTION);
  75. tp->basetype = tp2->basetype->basetype;
  76. tp->fbase = tp2->basetype->fbase;
  77. tp->issigned = 1;
  78. ex3->args[0]->val.type = makepointertype(tp);
  79. ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
  80.    ex3, ex);
  81.     }
  82.     if (tp2->basetype->fbase &&
  83. tp2->basetype->fbase->isreturn &&
  84. tp2->basetype->fbase->kind == MK_VARPARAM)
  85. ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
  86.     continue;
  87. }
  88.         switch (curtok) {
  90.             case TOK_HAT:
  91.     case TOK_ADDR:
  92.                 gettok();
  93.                 ex = makeexpr_hat(ex, 1);
  94.                 break;
  96.             case TOK_LBR:
  97.                 do {
  98.                     gettok();
  99.                     tp = ex->val.type;
  100.                     if (tp->kind == TK_STRING) {
  101.                         ex2 = p_expr(tp_integer);
  102.                         if (checkconst(ex2, 0))   /* is it "s[0]"? */
  103.                             ex = makeexpr_bicall_1("strlen", tp_char, ex);
  104.                         else
  105.                             ex = makeexpr_index(ex, ex2, makeexpr_long(1));
  106.                     } else if (tp->kind == TK_ARRAY ||
  107.                                tp->kind == TK_SMALLARRAY) {
  108.                         if (tp->smax) {
  109.                             ord_range_expr(tp->indextype, &ex2, NULL);
  110.                             ex2 = makeexpr_minus(p_ord_expr(),
  111.  copyexpr(ex2));
  112.                             if (!nodependencies(ex2, 0) &&
  113.                                 *getbitsname == '*') {
  114.                                 mp = makestmttempvar(tp_integer, name_TEMP);
  115.                                 ex3 = makeexpr_assign(makeexpr_var(mp), ex2);
  116.                                 ex2 = makeexpr_var(mp);
  117.                             } else
  118.                                 ex3 = NULL;
  119.                             ex = makeexpr_bicall_3(getbitsname, tp_int,
  120.                                                    ex, ex2,
  121.                                                    makeexpr_long(tp->escale));
  122.                             if (tp->kind == TK_ARRAY) {
  123.                                 if (tp->basetype == tp_sshort)
  124.                                     bits = 4;
  125.                                 else
  126.                                     bits = 3;
  127.                                 insertarg(&ex, 3, makeexpr_long(bits));
  128.                             }
  129.                             ex = makeexpr_comma(ex3, ex);
  130.                             ot = ord_type(tp->smax->val.type);
  131.                             if (ot->kind == TK_ENUM && ot->meaning && useenum)
  132.                                 ex = makeexpr_cast(ex, tp->smax->val.type);
  133.                             ex->val.type = tp->smax->val.type;
  134.                         } else {
  135.                             ord_range_expr(ex->val.type->indextype, &ex2, NULL);
  136.                             if (debug>2) { fprintf(outf, "ord_range_expr returns "); dumpexpr(ex2); fprintf(outf, "n"); }
  137.                             ex = makeexpr_index(ex, p_ord_expr(),
  138. copyexpr(ex2));
  139.                         }
  140.                     } else {
  141.                         warning("Index on a non-array variable [287]");
  142. ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
  143.     }
  144.                 } while (curtok == TOK_COMMA);
  145.                 if (!wneedtok(TOK_RBR))
  146.     skippasttotoken(TOK_RBR, TOK_SEMI);
  147.                 break;
  149.             case TOK_DOT:
  150.                 gettok();
  151.                 if (!wexpecttok(TOK_IDENT))
  152.     break;
  153. if (ex->val.type->kind == TK_STRING) {
  154.     if (!strcicmp(curtokbuf, "LENGTH")) {
  155. ex = makeexpr_bicall_1("strlen", tp_int, ex);
  156.     } else if (!strcicmp(curtokbuf, "BODY")) {
  157. /* nothing to do */
  158.     }
  159.     gettok();
  160.     break;
  161. }
  162.                 mp = curtoksym->fbase;
  163.                 while (mp && mp->rectype != ex->val.type)
  164.                     mp = mp->snext;
  165.                 if (mp)
  166.                     ex = makeexpr_dot(ex, mp);
  167.                 else {
  168.                     warning(format_s("No field called %s in that record [288]", curtokbuf));
  169.     ex = makeexpr_dotq(ex, curtokcase, tp_integer);
  170. }
  171.                 gettok();
  172.                 break;
  174.     case TOK_COLONCOLON:
  175. gettok();
  176. if (wexpecttok(TOK_IDENT)) {
  177.     ex = pascaltypecast(curtokmeaning->type, ex);
  178.     gettok();
  179. }
  180. break;
  182.             default:
  183.                 return ex;
  184.         }
  185.     }
  186. }
  190. Expr *fake_dots_n_hats(ex)
  191. Expr *ex;
  192. {
  193.     for (;;) {
  194.         switch (curtok) {
  196.             case TOK_HAT:
  197.     case TOK_ADDR:
  198.         if (ex->val.type->kind == TK_POINTER)
  199.     ex = makeexpr_hat(ex, 0);
  200. else {
  201.     ex->val.type = makepointertype(ex->val.type);
  202.     ex = makeexpr_un(EK_HAT, ex->val.type->basetype, ex);
  203. }
  204.                 gettok();
  205.                 break;
  207.             case TOK_LBR:
  208.                 do {
  209.                     gettok();
  210.                     ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
  211.                 } while (curtok == TOK_COMMA);
  212.                 if (!wneedtok(TOK_RBR))
  213.     skippasttotoken(TOK_RBR, TOK_SEMI);
  214.                 break;
  216.             case TOK_DOT:
  217.                 gettok();
  218.                 if (!wexpecttok(TOK_IDENT))
  219.     break;
  220.                 ex = makeexpr_dotq(ex, curtokcase, tp_integer);
  221.                 gettok();
  222.                 break;
  224.     case TOK_COLONCOLON:
  225. gettok();
  226. if (wexpecttok(TOK_IDENT)) {
  227.     ex = pascaltypecast(curtokmeaning->type, ex);
  228.     gettok();
  229. }
  230. break;
  232.             default:
  233.                 return ex;
  234.         }
  235.     }
  236. }
  240. Static void bindnames(ex)
  241. Expr *ex;
  242. {
  243.     int i;
  244.     Symbol *sp;
  245.     Meaning *mp;
  247.     if (ex->kind == EK_NAME) {
  248. sp = findsymbol_opt(fixpascalname(ex->val.s));
  249. if (sp) {
  250.     mp = sp->mbase;
  251.     while (mp && !mp->isactive)
  252. mp = mp->snext;
  253.     if (mp && !strcmp(mp->name, ex->val.s)) {
  254. ex->kind = EK_VAR;
  255. ex->val.i = (long)mp;
  256. ex->val.type = mp->type;
  257.     }
  258. }
  259.     }
  260.     i = ex->nargs;
  261.     while (--i >= 0)
  262. bindnames(ex->args[i]);
  263. }
  267. void var_reference(mp)
  268. Meaning *mp;
  269. {
  270.     Meaning *mp2;
  272.     mp->refcount++;
  273.     if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
  274. mp->ctx->needvarstruct &&
  275. (mp->kind == MK_VAR ||
  276.  mp->kind == MK_VARREF ||
  277.  mp->kind == MK_VARMAC ||
  278.  mp->kind == MK_PARAM ||
  279.  mp->kind == MK_VARPARAM ||
  280.  (mp->kind == MK_CONST &&
  281.   (mp->type->kind == TK_ARRAY ||
  282.    mp->type->kind == TK_RECORD)))) {
  283.         if (debug>1) { fprintf(outf, "varstruct'ing %sn", mp->name); }
  284.         if (!mp->varstructflag) {
  285.             mp->varstructflag = 1;
  286.             if (mp->constdefn &&      /* move init code into function body */
  287. mp->kind != MK_VARMAC) {
  288.                 mp2 = addmeaningafter(mp, curtoksym, MK_VAR);
  289.                 curtoksym->mbase = mp2->snext;  /* hide this fake variable */
  290.                 mp2->snext = mp;      /* remember true variable */
  291.                 mp2->type = mp->type;
  292.                 mp2->constdefn = mp->constdefn;
  293.                 mp2->isforward = 1;   /* declare it "static" */
  294.                 mp2->refcount++;      /* so it won't be purged! */
  295.                 mp->constdefn = NULL;
  296.                 mp->isforward = 0;
  297.             }
  298.         }
  299.         for (mp2 = curctx->ctx; mp2 != mp->ctx; mp2 = mp2->ctx)
  300.             mp2->varstructflag = 1;
  301.         mp2->varstructflag = 1;
  302.     }
  303. }
  307. Static Expr *p_variable(target)
  308. Type *target;
  309. {
  310.     Expr *ex, *ex2;
  311.     Meaning *mp;
  312.     Symbol *sym;
  314.     if (curtok != TOK_IDENT) {
  315.         warning("Expected a variable [289]");
  316. return makeexpr_long(0);
  317.     }
  318.     if (!curtokmeaning) {
  319. sym = curtoksym;
  320.         ex = makeexpr_name(curtokcase, tp_integer);
  321.         gettok();
  322.         if (curtok == TOK_LPAR) {
  323.             ex = makeexpr_bicall_0(ex->val.s, tp_integer);
  324.             do {
  325.                 gettok();
  326.                 insertarg(&ex, ex->nargs, p_expr(NULL));
  327.             } while (curtok == TOK_COMMA || curtok == TOK_ASSIGN);
  328.             if (!wneedtok(TOK_RPAR))
  329. skippasttotoken(TOK_RPAR, TOK_SEMI);
  330.         }
  331. if (!tryfuncmacro(&ex, NULL))
  332.     undefsym(sym);
  333.         return fake_dots_n_hats(ex);
  334.     }
  335.     var_reference(curtokmeaning);
  336.     mp = curtokmeaning;
  337.     if (mp->kind == MK_FIELD) {
  338.         ex = makeexpr_dot(copyexpr(withexprs[curtokint]), mp);
  339.     } else if (mp->kind == MK_CONST &&
  340.        mp->type->kind == TK_SET &&
  341.        mp->constdefn) {
  342. ex = copyexpr(mp->constdefn);
  343. mp = makestmttempvar(ex->val.type, name_SET);
  344.         ex2 = makeexpr(EK_MACARG, 0);
  345.         ex2->val.type = ex->val.type;
  346. ex = replaceexprexpr(ex, ex2, makeexpr_var(mp));
  347.         freeexpr(ex2);
  348.     } else if (mp->kind == MK_CONST &&
  349.                (mp == mp_false ||
  350.                 mp == mp_true ||
  351.                 mp->anyvarflag ||
  352.                 (foldconsts > 0 &&
  353.                  (mp->type->kind == TK_INTEGER ||
  354.                   mp->type->kind == TK_BOOLEAN ||
  355.                   mp->type->kind == TK_CHAR ||
  356.                   mp->type->kind == TK_ENUM ||
  357.                   mp->type->kind == TK_SUBR ||
  358.                   mp->type->kind == TK_REAL)) ||
  359.                 (foldstrconsts > 0 &&
  360.                  (mp->type->kind == TK_STRING)))) {
  361.         if (mp->constdefn) {
  362.             ex = copyexpr(mp->constdefn);
  363.             if (ex->val.type == tp_int)   /* kludge! */
  364.                 ex->val.type = tp_integer;
  365.         } else
  366.             ex = makeexpr_val(copyvalue(mp->val));
  367.     } else if (mp->kind == MK_VARPARAM ||
  368.                mp->kind == MK_VARREF) {
  369.         ex = makeexpr_hat(makeexpr_var(mp), 0);
  370.     } else if (mp->kind == MK_VARMAC) {
  371.         ex = copyexpr(mp->constdefn);
  372. bindnames(ex);
  373.         ex = gentle_cast(ex, mp->type);
  374.         ex->val.type = mp->type;
  375.     } else if (mp->kind == MK_SPVAR && mp->handler) {
  376.         gettok();
  377.         ex = (*mp->handler)(mp);
  378.         return dots_n_hats(ex, target);
  379.     } else if (mp->kind == MK_VAR ||
  380.                mp->kind == MK_CONST ||
  381.                mp->kind == MK_PARAM) {
  382.         ex = makeexpr_var(mp);
  383.     } else {
  384.         symclass(mp->sym);
  385.         ex = makeexpr_name(mp->name, tp_integer);
  386.     }
  387.     gettok();
  388.     return dots_n_hats(ex, target);
  389. }
  394. Expr *p_ord_expr()
  395. {
  396.     return makeexpr_charcast(p_expr(tp_integer));
  397. }
  401. Static Expr *makesmallsetconst(bits, type)
  402. long bits;
  403. Type *type;
  404. {
  405.     Expr *ex;
  407.     ex = makeexpr_long(bits);
  408.     ex->val.type = type;
  409.     if (smallsetconst != 2)
  410.         insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  411.     return ex;
  412. }
  416. Expr *packset(ex, type)
  417. Expr *ex;
  418. Type *type;
  419. {
  420.     Meaning *mp;
  421.     Expr *ex2;
  422.     long max2;
  424.     if (ex->kind == EK_BICALL) {
  425.         if (!strcmp(ex->val.s, setexpandname) &&
  426.             (mp = istempvar(ex->args[0])) != NULL) {
  427.             canceltempvar(mp);
  428.             return grabarg(ex, 1);
  429.         }
  430.         if (!strcmp(ex->val.s, setunionname) &&
  431.             (mp = istempvar(ex->args[0])) != NULL &&
  432.             !exproccurs(ex->args[1], ex->args[0]) &&
  433.             !exproccurs(ex->args[2], ex->args[0])) {
  434.             canceltempvar(mp);
  435.             return makeexpr_bin(EK_BOR, type, packset(ex->args[1], type),
  436.                                               packset(ex->args[2], type));
  437.         }
  438.         if (!strcmp(ex->val.s, setaddname)) {
  439.             ex2 = makeexpr_bin(EK_LSH, type,
  440.                                makeexpr_longcast(makeexpr_long(1), 1),
  441.                                ex->args[1]);
  442.             ex = packset(ex->args[0], type);
  443.             if (checkconst(ex, 0))
  444.                 return ex2;
  445.             else
  446.                 return makeexpr_bin(EK_BOR, type, ex, ex2);
  447.         }
  448.         if (!strcmp(ex->val.s, setaddrangename)) {
  449.             if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
  450.                 note("Range construction was implemented by a subtraction which may overflow [278]");
  451.             ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
  452.                                               makeexpr_longcast(makeexpr_long(1), 1),
  453.                                               makeexpr_plus(ex->args[2],
  454.                                                             makeexpr_long(1))),
  455.                                  makeexpr_bin(EK_LSH, type,
  456.                                               makeexpr_longcast(makeexpr_long(1), 1),
  457.                                               ex->args[1]));
  458.             ex = packset(ex->args[0], type);
  459.             if (checkconst(ex, 0))
  460.                 return ex2;
  461.             else
  462.                 return makeexpr_bin(EK_BOR, type, ex, ex2);
  463.         }
  464.     }
  465.     return makeexpr_bicall_1(setpackname, type, ex);
  466. }
  470. #define MAXSETLIT 400
  472. Expr *p_setfactor(type)
  473. Type *type;
  474. {
  475.     Expr *ex, *exmax = NULL, *ex2;
  476.     Expr *first[MAXSETLIT], *last[MAXSETLIT];
  477.     char doneflag[MAXSETLIT];
  478.     int i, j, num, donecount;
  479.     int isconst, guesstype = 0;
  480.     long maxv, max2;
  481.     Value val;
  482.     Type *tp;
  483.     Meaning *tvar;
  485.     if (curtok == TOK_LBRACE)
  486. gettok();
  487.     else if (!wneedtok(TOK_LBR))
  488. return makeexpr_long(0);
  489.     if (curtok == TOK_RBR || curtok == TOK_RBRACE) {        /* empty set */
  490.         gettok();
  491.         val.type = tp_smallset;
  492.         val.i = 0;
  493.         val.s = NULL;
  494.         return makeexpr_val(val);
  495.     }
  496.     if (!type)
  497.         guesstype = 1;
  498.     maxv = -1;
  499.     isconst = 1;
  500.     num = 0;
  501.     for (;;) {
  502.         if (num >= MAXSETLIT) {
  503.             warning(format_d("Too many elements in set literal; max=%d [290]", MAXSETLIT));
  504.             ex = p_expr(type);
  505.             while (curtok != TOK_RBR && curtok != TOK_RBRACE) {
  506.                 gettok();
  507.                 ex = p_expr(type);
  508.             }
  509.             break;
  510.         }
  511.         if (guesstype && num == 0) {
  512.             ex = p_ord_expr();
  513.             type = ord_type(ex->val.type);
  514.         } else {
  515.             ex = p_expr(type);
  516.         }
  517.         first[num] = ex = gentle_cast(ex, type);
  518.         doneflag[num] = 0;
  519.         if (curtok == TOK_DOTS) {
  520.             val = eval_expr(ex);
  521.             if (val.type) {
  522. if (val.i > maxv) {     /* In case of [127..0] */
  523.     maxv = val.i;
  524.     exmax = ex;
  525. }
  526.     } else
  527.                 isconst = 0;
  528.             gettok();
  529.             last[num] = ex = gentle_cast(p_expr(type), type);
  530.         } else {
  531.             last[num] = NULL;
  532.         }
  533.         val = eval_expr(ex);
  534.         if (val.type) {
  535.             if (val.i > maxv) {
  536.                 maxv = val.i;
  537.                 exmax = ex;
  538.             }
  539.         } else {
  540.             isconst = 0;
  541.             maxv = LONG_MAX;
  542.         }
  543.         num++;
  544.         if (curtok == TOK_COMMA)
  545.             gettok();
  546.         else
  547.             break;
  548.     }
  549.     if (curtok == TOK_RBRACE)
  550. gettok();
  551.     else if (!wneedtok(TOK_RBR))
  552. skippasttotoken(TOK_RBR, TOK_SEMI);
  553.     tp = ord_type(first[0]->val.type);
  554.     if (guesstype) {      /* must determine type */
  555.         if (!exmax || maxv == LONG_MAX) {
  556.             maxv = defaultsetsize-1;
  557.             if (ord_range(tp, NULL, &max2) && maxv > max2)
  558.                 maxv = max2;
  559.             exmax = makeexpr_long(maxv);
  560.         } else
  561.             exmax = copyexpr(exmax);
  562.         if (!ord_range(tp, NULL, &max2) || maxv != max2)
  563.             tp = makesubrangetype(tp, makeexpr_long(0), exmax);
  564.         type = makesettype(tp);
  565.     } else
  566. type = makesettype(type);
  567.     donecount = 0;
  568.     if (smallsetconst > 0) {
  569.         val.i = 0;
  570.         for (i = 0; i < num; i++) {
  571.             if (first[i]->kind == EK_CONST && first[i]->val.i < setbits &&
  572.                 (!last[i] || (last[i]->kind == EK_CONST &&
  573.                               last[i]->val.i >= 0 &&
  574.                               last[i]->val.i < setbits))) {
  575.                 if (last[i]) {
  576.                     for (j = first[i]->val.i; j <= last[i]->val.i; j++)
  577.                         val.i |= 1<<j;
  578.                 } else
  579.     val.i |= 1 << first[i]->val.i;
  580.                 doneflag[i] = 1;
  581.                 donecount++;
  582.             }
  583.         }
  584.     }
  585.     if (donecount) {
  586.         ex = makesmallsetconst(val.i, tp_smallset);
  587.     } else
  588.         ex = NULL;
  589.     if (type->kind == TK_SMALLSET) {
  590.         for (i = 0; i < num; i++) {
  591.             if (!doneflag[i]) {
  592.                 ex2 = makeexpr_bin(EK_LSH, type,
  593.    makeexpr_longcast(makeexpr_long(1), 1),
  594.    enum_to_int(first[i]));
  595.                 if (last[i]) {
  596.                     if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
  597.                         note("Range construction was implemented by a subtraction which may overflow [278]");
  598.                     ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
  599.                                                       makeexpr_longcast(makeexpr_long(1), 1),
  600.                                                       makeexpr_plus(enum_to_int(last[i]),
  601.                                                                     makeexpr_long(1))),
  602.                                          ex2);
  603.                 }
  604.                 if (ex)
  605.                     ex = makeexpr_bin(EK_BOR, type, makeexpr_longcast(ex, 1), ex2);
  606.                 else
  607.                     ex = ex2;
  608.             }
  609.         }
  610.     } else {
  611.         tvar = makestmttempvar(type, name_SET);
  612.         if (!ex) {
  613.             val.type = tp_smallset;
  614.     val.i = 0;
  615.     val.s = NULL;
  616.     ex = makeexpr_val(val);
  617. }
  618.         ex = makeexpr_bicall_2(setexpandname, type,
  619.                                makeexpr_var(tvar), makeexpr_arglong(ex, 1));
  620.         for (i = 0; i < num; i++) {
  621.             if (!doneflag[i]) {
  622.                 if (last[i])
  623.                     ex = makeexpr_bicall_3(setaddrangename, type,
  624.                                            ex, makeexpr_arglong(enum_to_int(first[i]), 0),
  625.                                                makeexpr_arglong(enum_to_int(last[i]), 0));
  626.                 else
  627.                     ex = makeexpr_bicall_2(setaddname, type,
  628.                                            ex, makeexpr_arglong(enum_to_int(first[i]), 0));
  629.             }
  630.         }
  631.     }
  632.     return ex;
  633. }
  638. Expr *p_funcarglist(ex, args, firstarg, ismacro)
  639. Expr *ex;
  640. Meaning *args;
  641. int firstarg, ismacro;
  642. {
  643.     Meaning *mp, *mp2, *arglist = args, *prevarg = NULL;
  644.     Expr *ex2;
  645.     int i, fi, fakenum = -1, castit, isconf, isnonpos = 0;
  646.     Type *tp, *tp2;
  647.     char *name;
  649.     castit = castargs;
  650.     if (castit < 0)
  651. castit = (prototypes == 0);
  652.     while (args) {
  653. if (isnonpos) {
  654.     while (curtok == TOK_COMMA)
  655. gettok();
  656.     if (curtok == TOK_RPAR) {
  657. args = arglist;
  658. i = firstarg;
  659. while (args) {
  660.     if (ex->nargs <= i)
  661. insertarg(&ex, ex->nargs, NULL);
  662.     if (!ex->args[i]) {
  663. if (args->constdefn)
  664.     ex->args[i] = copyexpr(args->constdefn);
  665. else {
  666.     warning(format_s("Missing value for parameter %s [291]",
  667.      args->name));
  668.     ex->args[i] = makeexpr_long(0);
  669. }
  670.     }
  671.     args = args->xnext;
  672.     i++;
  673. }
  674. break;
  675.     }
  676. }
  677. if (args->isreturn || args->fakeparam) {
  678.     if (args->fakeparam) {
  679. if (fakenum < 0)
  680.     fakenum = ex->nargs;
  681. if (args->constdefn)
  682.     insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  683. else
  684.     insertarg(&ex, ex->nargs, makeexpr_long(0));
  685.     }
  686.     args = args->xnext;     /* return value parameter */
  687.     continue;
  688. }
  689. if (curtok == TOK_RPAR) {
  690.     if (args->constdefn) {
  691. insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  692. args = args->xnext;
  693. continue;
  694.     } else {
  695. if (ex->kind == EK_FUNCTION) {
  696.     name = ((Meaning *)ex->val.i)->name;
  697.     ex->kind = EK_BICALL;
  698.     ex->val.s = stralloc(name);
  699. } else
  700.     name = "function";
  701. warning(format_s("Too few arguments for %s [292]", name));
  702. return ex;
  703.     }
  704. }
  705. if (curtok == TOK_COMMA) {
  706.     if (args->constdefn)
  707. insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  708.     else {
  709. warning(format_s("Missing parameter %s [293]", args->name));
  710. insertarg(&ex, ex->nargs, makeexpr_long(0));
  711.     }
  712.     gettok();
  713.     args = args->xnext;
  714.     continue;
  715. }
  716. p_mech_spec(0);
  717. if (curtok == TOK_IDENT) {
  718.     mp = arglist;
  719.     mp2 = NULL;
  720.     i = firstarg;
  721.     fi = -1;
  722.     while (mp && strcmp(curtokbuf, mp->sym->name)) {
  723. if (mp->fakeparam) {
  724.     if (fi < 0)
  725. fi = i;
  726. } else
  727.     fi = -1;
  728. i++;
  729. mp2 = mp;
  730. mp = mp->xnext;
  731.     }
  732.     if (mp &&
  733. (peeknextchar() == ':' || !curtokmeaning || isnonpos)) {
  734. gettok();
  735. wneedtok(TOK_ASSIGN);
  736. prevarg = mp2;
  737. args = mp;
  738. fakenum = fi;
  739. isnonpos = 1;
  740.     } else
  741. i = ex->nargs;
  742. } else
  743.     i = ex->nargs;
  744. while (ex->nargs <= i)
  745.     insertarg(&ex, ex->nargs, NULL);
  746. if (ex->args[i])
  747.     warning(format_s("Multiple values for parameter %s [294]",
  748.      args->name));
  749. tp = args->type;
  750. ex2 = p_expr(tp);
  751. if (args->kind == MK_VARPARAM)
  752.     tp = tp->basetype;
  753. tp2 = ex2->val.type;
  754. isconf = ((tp->kind == TK_ARRAY ||
  755.    tp->kind == TK_STRING) && tp->structdefd);
  756.         switch (args->kind) {
  758.             case MK_PARAM:
  759.         if (castit && tp->kind == TK_REAL &&
  760.     ex2->val.type->kind != TK_REAL)
  761.                     ex2 = makeexpr_cast(ex2, tp);
  762.                 else if (ord_type(tp)->kind == TK_INTEGER && !ismacro)
  763.                     ex2 = makeexpr_arglong(ex2, long_type(tp));
  764.                 else if (args->othername && args->rectype != tp &&
  765.                          tp->kind != TK_STRING && args->type == tp2)
  766.                     ex2 = makeexpr_addr(ex2);
  767.                 else
  768.                     ex2 = gentle_cast(ex2, tp);
  769. ex->args[i] = ex2;
  770.                 break;
  772.             case MK_VARPARAM:
  773.                 if (args->type == tp_strptr && args->anyvarflag) {
  774.     ex->args[i] = strmax_func(ex2);
  775.                     insertarg(&ex, ex->nargs-1, makeexpr_addr(ex2));
  776.     if (isnonpos)
  777. note("Non-positional conformant parameters may not work [279]");
  778.                 } else {                        /* regular VAR parameter */
  779.                     ex2 = makeexpr_addrf(ex2);
  780.                     if (args->anyvarflag ||
  781.                         (tp->kind == TK_POINTER && tp2->kind == TK_POINTER &&
  782.                          (tp == tp_anyptr || tp2 == tp_anyptr))) {
  783. if (!ismacro)
  784.     ex2 = makeexpr_cast(ex2, args->type);
  785.                     } else {
  786.                         if (tp2 != tp && !isconf &&
  787.     (tp2->kind != TK_STRING ||
  788.      tp->kind != TK_STRING))
  789.                             warning(format_s("Type mismatch in VAR parameter %s [295]",
  790.                                              args->name));
  791.                     }
  792.     ex->args[i] = ex2;
  793.                 }
  794.                 break;
  796.     default:
  797. intwarning("p_funcarglist",
  798.    format_s("Parameter type is %s [296]",
  799.     meaningkindname(args->kind)));
  800. break;
  801.         }
  802. if (isconf &&   /* conformant array or string */
  803.     (!prevarg || prevarg->type != args->type)) {
  804.     while (tp->kind == TK_ARRAY && tp->structdefd) {
  805. if (tp2->kind == TK_SMALLARRAY) {
  806.     warning("Trying to pass a small-array for a conformant array [297]");
  807.     /* this has a chance of working... */
  808.     ex->args[ex->nargs-1] =
  809. makeexpr_addr(ex->args[ex->nargs-1]);
  810. } else if (tp2->kind == TK_STRING) {
  811.     ex->args[fakenum++] =
  812. makeexpr_arglong(makeexpr_long(1), integer16 == 0);
  813.     ex->args[fakenum++] =
  814. makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
  815.  integer16 == 0);
  816.     break;
  817.         } else if (tp2->kind != TK_ARRAY) {
  818.     warning("Type mismatch for conformant array [298]");
  819.     break;
  820. }
  821. ex->args[fakenum++] =
  822.     makeexpr_arglong(copyexpr(tp2->indextype->smin),
  823.      integer16 == 0);
  824. ex->args[fakenum++] =
  825.     makeexpr_arglong(copyexpr(tp2->indextype->smax),
  826.      integer16 == 0);
  827. tp = tp->basetype;
  828. tp2 = tp2->basetype;
  829.     }
  830.     if (tp->kind == TK_STRING && tp->structdefd) {
  831. ex->args[fakenum] =
  832.     makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
  833.      integer16 == 0);
  834.     }
  835. }
  836. fakenum = -1;
  837. if (!isnonpos) {
  838.     prevarg = args;
  839.     args = args->xnext;
  840.     if (args) {
  841. if (curtok != TOK_RPAR && !wneedtok(TOK_COMMA))
  842.     skiptotoken2(TOK_RPAR, TOK_SEMI);
  843.     }
  844. }
  845.     }
  846.     if (curtok == TOK_COMMA) {
  847. if (ex->kind == EK_FUNCTION) {
  848.     name = ((Meaning *)ex->val.i)->name;
  849.     ex->kind = EK_BICALL;
  850.     ex->val.s = stralloc(name);
  851. } else
  852.     name = "function";
  853. warning(format_s("Too many arguments for %s [299]", name));
  854. while (curtok == TOK_COMMA) {
  855.     gettok();
  856.     insertarg(&ex, ex->nargs, p_expr(tp_integer));
  857. }
  858.     }
  859.     return ex;
  860. }
  864. Expr *replacemacargs(ex, fex)
  865. Expr *ex, *fex;
  866. {
  867.     int i;
  868.     Expr *ex2;
  870.     for (i = 0; i < ex->nargs; i++)
  871.         ex->args[i] = replacemacargs(ex->args[i], fex);
  872.     if (ex->kind == EK_MACARG) {
  873. if (ex->val.i <= fex->nargs) {
  874.     ex2 = copyexpr(fex->args[ex->val.i - 1]);
  875. } else {
  876.     ex2 = makeexpr_name("<meef>", tp_integer);
  877.     note("FuncMacro specified more arguments than call [280]");
  878. }
  879. freeexpr(ex);
  880. return ex2;
  881.     }
  882.     return resimplify(ex);
  883. }
  886. Expr *p_noarglist(ex, mp, args)
  887. Expr *ex;
  888. Meaning *mp, *args;
  889. {
  890.     while (args && args->constdefn) {
  891. insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  892. args = args->xnext;
  893.     }
  894.     if (args) {
  895. warning(format_s("Expected an argument list for %s [300]", mp->name));
  896. ex->kind = EK_BICALL;
  897. ex->val.s = stralloc(mp->name);
  898.     }
  899.     return ex;
  900. }
  903. void func_reference(func)
  904. Meaning *func;
  905. {
  906.     Meaning *mp;
  908.     if (func->ctx && func->ctx != curctx &&func->ctx->kind == MK_FUNCTION &&
  909. func->ctx->varstructflag && !curctx->ctx->varstructflag) {
  910. for (mp = curctx->ctx; mp != func->ctx; mp = mp->ctx)
  911.     mp->varstructflag = 1;
  912.     }
  913. }
  916. Expr *p_funccall(mp)
  917. Meaning *mp;
  918. {
  919.     Meaning *mp2, *tvar;
  920.     Expr *ex, *ex2;
  921.     int firstarg = 0;
  923.     func_reference(mp);
  924.     ex = makeexpr(EK_FUNCTION, 0);
  925.     ex->val.i = (long)mp;
  926.     ex->val.type = mp->type->basetype;
  927.     mp2 = mp->type->fbase;
  928.     if (mp2 && mp2->isreturn) {    /* pointer to buffer for return value */
  929.         tvar = makestmttempvar(ex->val.type->basetype,
  930.             (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
  931.         insertarg(&ex, 0, makeexpr_addr(makeexpr_var(tvar)));
  932.         mp2 = mp2->xnext;
  933. firstarg++;
  934.     }
  935.     if (mp2 && curtok != TOK_LPAR) {
  936. ex = p_noarglist(ex, mp, mp2);
  937.     } else if (curtok == TOK_LPAR) {
  938. gettok();
  939.         ex = p_funcarglist(ex, mp2, firstarg, (mp->constdefn != NULL));
  940.         skipcloseparen();
  941.     }
  942.     if (mp->constdefn) {
  943.         ex2 = replacemacargs(copyexpr(mp->constdefn), ex);
  944. ex2 = gentle_cast(ex2, ex->val.type);
  945. ex2->val.type = ex->val.type;
  946.         freeexpr(ex);
  947.         return ex2;
  948.     }
  949.     return ex;
  950. }
  957. Expr *accumulate_strlit()
  958. {
  959.     char buf[256], ch, *cp, *cp2;
  960.     int len, i, danger = 0;
  962.     len = 0;
  963.     cp = buf;
  964.     for (;;) {
  965.         if (curtok == TOK_STRLIT) {
  966.             cp2 = curtokbuf;
  967.             i = curtokint;
  968.             while (--i >= 0) {
  969.                 if (++len <= 255) {
  970.                     ch = *cp++ = *cp2++;
  971.                     if (ch & 128)
  972.                         danger++;
  973.                 }
  974.             }
  975.         } else if (curtok == TOK_HAT) {    /* Turbo */
  976.             i = getchartok() & 0x1f;
  977.             if (++len <= 255)
  978.                 *cp++ = i;
  979. } else if (curtok == TOK_LPAR) {   /* VAX */
  980.     Value val;
  981.     do {
  982. gettok();
  983. val = p_constant(tp_integer);
  984. if (++len <= 255)
  985.     *cp++ = val.i;
  986.     } while (curtok == TOK_COMMA);
  987.     skipcloseparen();
  988.     continue;
  989.         } else
  990.             break;
  991.         gettok();
  992.     }
  993.     if (len > 255) {
  994.         warning("String literal too long [301]");
  995.         len = 255;
  996.     }
  997.     if (danger &&
  998.         !(unsignedchar == 1 ||
  999.           (unsignedchar != 0 && signedchars == 0)))
  1000.         note(format_s("Character%s >= 128 encountered [281]", (danger > 1) ? "s" : ""));
  1001.     return makeexpr_lstring(buf, len);
  1002. }
  1006. Expr *pascaltypecast(type, ex2)
  1007. Type *type;
  1008. Expr *ex2;
  1009. {
  1010.     if ((ex2->val.type->kind == TK_INTEGER ||
  1011.  ex2->val.type->kind == TK_CHAR ||
  1012.  ex2->val.type->kind == TK_BOOLEAN ||
  1013.  ex2->val.type->kind == TK_ENUM ||
  1014.  ex2->val.type->kind == TK_SUBR ||
  1015.  ex2->val.type->kind == TK_REAL ||
  1016.  ex2->val.type->kind == TK_POINTER ||
  1017.  ex2->val.type->kind == TK_STRING) &&
  1018. (type->kind == TK_INTEGER ||
  1019.  type->kind == TK_CHAR ||
  1020.  type->kind == TK_BOOLEAN ||
  1021.  type->kind == TK_ENUM ||
  1022.  type->kind == TK_SUBR ||
  1023.  type->kind == TK_REAL ||
  1024.  type->kind == TK_POINTER)) {
  1025. if (type->kind == TK_POINTER || ex2->val.type->kind == TK_POINTER)
  1026.     return makeexpr_un(EK_CAST, type, ex2);
  1027. else
  1028.     return makeexpr_un(EK_ACTCAST, type, ex2);
  1029.     } else {
  1030. return makeexpr_hat(makeexpr_cast(makeexpr_addr(ex2),
  1031.   makepointertype(type)), 0);
  1032.     }
  1033. }
  1038. Static Expr *p_factor(target)
  1039. Type *target;
  1040. {
  1041.     Expr *ex, *ex2;
  1042.     Type *type;
  1043.     Meaning *mp, *mp2;
  1045.     switch (curtok) {
  1047.         case TOK_INTLIT:
  1048.             ex = makeexpr_long(curtokint);
  1049.             gettok();
  1050.             return ex;
  1052.         case TOK_HEXLIT:
  1053.             ex = makeexpr_long(curtokint);
  1054.             insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  1055.             gettok();
  1056.             return ex;
  1058.         case TOK_OCTLIT:
  1059.             ex = makeexpr_long(curtokint);
  1060.             insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
  1061.             gettok();
  1062.             return ex;
  1064.         case TOK_MININT:
  1065.     strcat(curtokbuf, ".0");
  1067. /* fall through */
  1068.         case TOK_REALLIT:
  1069.             ex = makeexpr_real(curtokbuf);
  1070.             gettok();
  1071.             return ex;
  1073.         case TOK_HAT:
  1074.         case TOK_STRLIT:
  1075.             ex = accumulate_strlit();
  1076.             return ex;
  1078.         case TOK_LPAR:
  1079.             gettok();
  1080.             ex = p_expr(target);
  1081.             skipcloseparen();
  1082.             return dots_n_hats(ex, target);
  1084.         case TOK_NOT:
  1085. case TOK_TWIDDLE:
  1086.             gettok();
  1087.             ex = p_factor(tp_integer);
  1088.             if (ord_type(ex->val.type)->kind == TK_INTEGER)
  1089.                 return makeexpr_un(EK_BNOT, tp_integer, ex);
  1090.             else
  1091.                 return makeexpr_not(ex);
  1093.         case TOK_ADDR:
  1094.             gettok();
  1095.     if (curtok == TOK_ADDR) {
  1096. gettok();
  1097. ex = p_factor(tp_proc);
  1098. if (ex->val.type->kind == TK_PROCPTR && ex->kind == EK_COMMA)
  1099.     return grabarg(grabarg(grabarg(ex, 0), 1), 0);
  1100. if (ex->val.type->kind != TK_CPROCPTR)
  1101.     warning("@@ allowed only for procedure pointers [302]");
  1102. return makeexpr_addrf(ex);
  1103.     }
  1104.             if (curtok == TOK_IDENT && 0 &&  /***/
  1105.                 curtokmeaning && (curtokmeaning->kind == MK_FUNCTION ||
  1106.                                   curtokmeaning->kind == MK_SPECIAL)) {
  1107.                 if (curtokmeaning->ctx == nullctx)
  1108.                     warning(format_s("Can't take address of predefined object %s [303]",
  1109.                                      curtokmeaning->name));
  1110.                 ex = makeexpr_name(curtokmeaning->name, tp_anyptr);
  1111.                 gettok();
  1112.             } else {
  1113. ex = p_factor(tp_proc);
  1114. if (ex->val.type->kind == TK_PROCPTR) {
  1115.   /*  ex = makeexpr_dotq(ex, "proc", tp_anyptr);  */
  1116. } else if (ex->val.type->kind == TK_CPROCPTR) {
  1117.     ex = makeexpr_cast(ex, tp_anyptr);
  1118. } else
  1119.     ex = makeexpr_addrf(ex);
  1120.             }
  1121.             return ex;
  1123.         case TOK_LBR:
  1124. case TOK_LBRACE:
  1125.             return p_setfactor(NULL);
  1127.         case TOK_NIL:
  1128.             gettok();
  1129.             return makeexpr_nil();
  1131. case TOK_IF:    /* nifty Pascal extension */
  1132.     gettok();
  1133.     ex = p_expr(tp_boolean);
  1134.     wneedtok(TOK_THEN);
  1135.     ex2 = p_expr(tp_integer);
  1136.     if (wneedtok(TOK_ELSE))
  1137. return makeexpr_cond(ex, ex2, p_factor(ex2->val.type));
  1138.     else
  1139. return makeexpr_cond(ex, ex2, makeexpr_long(0));
  1141.         case TOK_IDENT:
  1142.             mp = curtokmeaning;
  1143.             switch ((mp) ? mp->kind : MK_VAR) {
  1145.                 case MK_TYPE:
  1146.                     gettok();
  1147.                     type = mp->type;
  1148.                     switch (curtok) {
  1150.                         case TOK_LPAR:    /* Turbo type cast */
  1151.                             gettok();
  1152.                             ex2 = p_expr(type);
  1153.     ex = pascaltypecast(type, ex2);
  1154.                             skipcloseparen();
  1155.                             return dots_n_hats(ex, target);
  1157.                         case TOK_LBR:
  1158. case TOK_LBRACE:
  1159.                             switch (type->kind) {
  1161.                                 case TK_SET:
  1162.                                 case TK_SMALLSET:
  1163.                                     return p_setfactor(type->indextype);
  1165.                                 case TK_RECORD:
  1166.                                     return p_constrecord(type, 0);
  1168.                                 case TK_ARRAY:
  1169.                                 case TK_SMALLARRAY:
  1170.                                     return p_constarray(type, 0);
  1172.                                 case TK_STRING:
  1173.                                     return p_conststring(type, 0);
  1175.                                 default:
  1176.                                     warning("Bad type for constructor [304]");
  1177.     skipparens();
  1178.     return makeexpr_name(mp->name, mp->type);
  1179.                             }
  1181. default:
  1182.     wexpected("an expression");
  1183.     return makeexpr_name(mp->name, mp->type);
  1184.                     }
  1186.                 case MK_SPECIAL:
  1187.                     if (mp->handler && mp->isfunction &&
  1188. (curtok == TOK_LPAR || !target ||
  1189.  (target->kind != TK_PROCPTR &&
  1190.   target->kind != TK_CPROCPTR))) {
  1191.                         gettok();
  1192.                         if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
  1193.                             ex = makeexpr_bicall_0(mp->name, tp_integer);
  1194.                             if (curtok == TOK_LPAR) {
  1195.                                 do {
  1196.                                     gettok();
  1197.                                     insertarg(&ex, ex->nargs, p_expr(NULL));
  1198.                                 } while (curtok == TOK_COMMA);
  1199.                                 skipcloseparen();
  1200.                             }
  1201.                             tryfuncmacro(&ex, mp);
  1202.     return ex;
  1203.                         }
  1204.                         ex = (*mp->handler)(mp);
  1205. if (!ex)
  1206.     ex = makeexpr_long(0);
  1207. return ex;
  1208.                     } else {
  1209. if (target->kind == TK_PROCPTR ||
  1210.     target->kind == TK_CPROCPTR)
  1211.     note("Using a built-in procedure as a procedure pointer [316]");
  1212.                         else
  1213.     symclass(curtoksym);
  1214.                         gettok();
  1215.                         return makeexpr_name(mp->name, tp_integer);
  1216.                     }
  1218.                 case MK_FUNCTION:
  1219.                     mp->refcount++;
  1220.                     need_forward_decl(mp);
  1221.     gettok();
  1222.                     if (mp->isfunction &&
  1223. (curtok == TOK_LPAR || !target ||
  1224.  (target->kind != TK_PROCPTR &&
  1225.   target->kind != TK_CPROCPTR))) {
  1226.                         ex = p_funccall(mp);
  1227.                         if (!mp->constdefn) {
  1228.                             if (mp->handler && !(mp->sym->flags & LEAVEALONE))
  1229.                                 ex = (*mp->handler)(ex);
  1230. }
  1231. if (mp->cbase->kind == MK_VARPARAM) {
  1232.     ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
  1233.                         }
  1234.                         return dots_n_hats(ex, target);
  1235.                     } else {
  1236. if (mp->handler && !(mp->sym->flags & LEAVEALONE))
  1237.     note("Using a built-in procedure as a procedure pointer [316]");
  1238. if (target && target->kind == TK_CPROCPTR) {
  1239.     type = maketype(TK_CPROCPTR);
  1240.     type->basetype = mp->type;
  1241.     type->escale = 0;
  1242.     mp2 = makestmttempvar(type, name_TEMP);
  1243.     ex = makeexpr_comma(
  1244.                                     makeexpr_assign(
  1245.                                        makeexpr_var(mp2),
  1246.        makeexpr_name(mp->name, tp_text)),
  1247.     makeexpr_var(mp2));
  1248.     if (mp->ctx->kind == MK_FUNCTION)
  1249. warning("Procedure pointer to nested procedure [305]");
  1250. } else {
  1251.     type = maketype(TK_PROCPTR);
  1252.     type->basetype = mp->type;
  1253.     type->escale = 1;
  1254.     mp2 = makestmttempvar(type, name_TEMP);
  1255.     ex = makeexpr_comma(
  1256.                                     makeexpr_comma(
  1257.                                        makeexpr_assign(
  1258.                                           makeexpr_dotq(makeexpr_var(mp2),
  1259. "proc",
  1260. tp_anyptr),
  1261.   makeexpr_name(mp->name, tp_text)),
  1262.                                           /* handy pointer type */
  1263.        makeexpr_assign(
  1264.                                           makeexpr_dotq(makeexpr_var(mp2),
  1265. "link",
  1266. tp_anyptr),
  1267.           makeexpr_ctx(mp->ctx))),
  1268.     makeexpr_var(mp2));
  1269. }
  1270.                         return ex;
  1271.                     }
  1273.                 default:
  1274.                     return p_variable(target);
  1275.             }
  1277. default:
  1278.     wexpected("an expression");
  1279.     return makeexpr_long(0);
  1280.     
  1281.     }
  1282. }
  1287. Static Expr *p_powterm(target)
  1288. Type *target;
  1289. {
  1290.     Expr *ex = p_factor(target);
  1291.     Expr *ex2;
  1292.     int i, castit;
  1293.     long v;
  1295.     if (curtok == TOK_STARSTAR) {
  1296. gettok();
  1297. ex2 = p_powterm(target);
  1298. if (ex->val.type->kind == TK_REAL ||
  1299.     ex2->val.type->kind == TK_REAL) {
  1300.     if (checkconst(ex2, 2)) {
  1301. ex = makeexpr_sqr(ex, 0);
  1302.     } else if (checkconst(ex2, 3)) {
  1303. ex = makeexpr_sqr(ex, 1);
  1304.     } else {
  1305. castit = castargs >= 0 ? castargs : (prototypes == 0);
  1306. if (ex->val.type->kind != TK_REAL && castit)
  1307.     ex = makeexpr_cast(ex, tp_longreal);
  1308. if (ex2->val.type->kind != TK_REAL && castit)
  1309.     ex2 = makeexpr_cast(ex2, tp_longreal);
  1310. ex = makeexpr_bicall_2("pow", tp_longreal, ex, ex2);
  1311.     }
  1312. } else if (checkconst(ex, 2)) {
  1313.     freeexpr(ex);
  1314.     ex = makeexpr_bin(EK_LSH, tp_integer,
  1315.       makeexpr_longcast(makeexpr_long(1), 1), ex2);
  1316. } else if (checkconst(ex, 0) ||
  1317.    checkconst(ex, 1) ||
  1318.    checkconst(ex2, 1)) {
  1319.     freeexpr(ex2);
  1320. } else if (checkconst(ex2, 0)) {
  1321.     freeexpr(ex);
  1322.     freeexpr(ex2);
  1323.     ex = makeexpr_long(1);
  1324. } else if (isliteralconst(ex, NULL) == 2 &&
  1325.    isliteralconst(ex2, NULL) == 2 &&
  1326.    ex2->val.i > 0) {
  1327.     v = ex->val.i;
  1328.     i = ex2->val.i;
  1329.     while (--i > 0)
  1330. v *= ex->val.i;
  1331.     freeexpr(ex);
  1332.     freeexpr(ex2);
  1333.     ex = makeexpr_long(v);
  1334. } else if (checkconst(ex2, 2)) {
  1335.     ex = makeexpr_sqr(ex, 0);
  1336. } else if (checkconst(ex2, 3)) {
  1337.     ex = makeexpr_sqr(ex, 1);
  1338. } else {
  1339.     ex = makeexpr_bicall_2("ipow", tp_integer,
  1340.    makeexpr_arglong(ex, 1),
  1341.    makeexpr_arglong(ex2, 1));
  1342. }
  1343.     }
  1344.     return ex;
  1345. }
  1348. Static Expr *p_term(target)
  1349. Type *target;
  1350. {
  1351.     Expr *ex = p_powterm(target);
  1352.     Expr *ex2;
  1353.     Type *type;
  1354.     Meaning *tvar;
  1355.     int useshort;
  1357.     for (;;) {
  1358. checkkeyword(TOK_SHL);
  1359. checkkeyword(TOK_SHR);
  1360. checkkeyword(TOK_REM);
  1361.         switch (curtok) {
  1363.             case TOK_STAR:
  1364.                 gettok();
  1365.                 if (ex->val.type->kind == TK_SET ||
  1366.                     ex->val.type->kind == TK_SMALLSET) {
  1367.                     ex2 = p_powterm(ex->val.type);
  1368.                     type = mixsets(&ex, &ex2);
  1369.                     if (type->kind == TK_SMALLSET) {
  1370.                         ex = makeexpr_bin(EK_BAND, type, ex, ex2);
  1371.                     } else {
  1372.                         tvar = makestmttempvar(type, name_SET);
  1373.                         ex = makeexpr_bicall_3(setintname, type,
  1374.                                                makeexpr_var(tvar),
  1375.                                                ex, ex2);
  1376.                     }
  1377.                 } else
  1378.                     ex = makeexpr_times(ex, p_powterm(tp_integer));
  1379.                 break;
  1381.             case TOK_SLASH:
  1382.                 gettok();
  1383.                 if (ex->val.type->kind == TK_SET ||
  1384.                     ex->val.type->kind == TK_SMALLSET) {
  1385.                     ex2 = p_powterm(ex->val.type);
  1386.                     type = mixsets(&ex, &ex2);
  1387.                     if (type->kind == TK_SMALLSET) {
  1388.                         ex = makeexpr_bin(EK_BXOR, type, ex, ex2);
  1389.                     } else {
  1390.                         tvar = makestmttempvar(type, name_SET);
  1391.                         ex = makeexpr_bicall_3(setxorname, type,
  1392.                                                makeexpr_var(tvar),
  1393.                                                ex, ex2);
  1394.                     }
  1395. } else
  1396.     ex = makeexpr_divide(ex, p_powterm(tp_integer));
  1397.                 break;
  1399.             case TOK_DIV:
  1400.                 gettok();
  1401.                 ex = makeexpr_div(ex, p_powterm(tp_integer));
  1402.                 break;
  1404.             case TOK_REM:
  1405.                 gettok();
  1406.                 ex = makeexpr_rem(ex, p_powterm(tp_integer));
  1407.                 break;
  1409.             case TOK_MOD:
  1410.                 gettok();
  1411.                 ex = makeexpr_mod(ex, p_powterm(tp_integer));
  1412.                 break;
  1414.             case TOK_AND:
  1415.     case TOK_AMP:
  1416. useshort = (curtok == TOK_AMP);
  1417.                 gettok();
  1418.                 ex2 = p_powterm(tp_integer);
  1419.                 if (ord_type(ex->val.type)->kind == TK_INTEGER)
  1420.                     ex = makeexpr_bin(EK_BAND, ex->val.type, ex, ex2);
  1421.                 else if (partial_eval_flag || useshort ||
  1422.                          (shortopt && nosideeffects(ex2, 1)))
  1423.                     ex = makeexpr_and(ex, ex2);
  1424.                 else
  1425.                     ex = makeexpr_bin(EK_BAND, tp_boolean, ex, ex2);
  1426.                 break;
  1428.             case TOK_SHL:
  1429.                 gettok();
  1430.                 ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_powterm(tp_integer));
  1431.                 break;
  1433.             case TOK_SHR:
  1434.                 gettok();
  1435.                 ex = force_unsigned(ex);
  1436.                 ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_powterm(tp_integer));
  1437.                 break;
  1439.             default:
  1440.                 return ex;
  1441.         }
  1442.     }
  1443. }
  1447. Static Expr *p_sexpr(target)
  1448. Type *target;
  1449. {
  1450.     Expr *ex, *ex2;
  1451.     Type *type;
  1452.     Meaning *tvar;
  1453.     int useshort;
  1455.     switch (curtok) {
  1456.         case TOK_MINUS:
  1457.             gettok();
  1458.             if (curtok == TOK_MININT) {
  1459.                 gettok();
  1460.                 ex = makeexpr_long(MININT);
  1461. break;
  1462.             }
  1463.             ex = makeexpr_neg(p_term(target));
  1464.             break;
  1465.         case TOK_PLUS:
  1466.             gettok();
  1467.         /* fall through */
  1468.         default:
  1469.             ex = p_term(target);
  1470.             break;
  1471.     }
  1472.     if (curtok == TOK_PLUS &&
  1473.         (ex->val.type->kind == TK_STRING ||
  1474.          ord_type(ex->val.type)->kind == TK_CHAR ||
  1475.          ex->val.type->kind == TK_ARRAY)) {
  1476.         while (curtok == TOK_PLUS) {
  1477.             gettok();
  1478.             ex = makeexpr_concat(ex, p_term(NULL), 0);
  1479.         }
  1480.         return ex;
  1481.     } else {
  1482.         for (;;) {
  1483.     checkkeyword(TOK_XOR);
  1484.             switch (curtok) {
  1486.                 case TOK_PLUS:
  1487.                     gettok();
  1488.                     if (ex->val.type->kind == TK_SET ||
  1489.                         ex->val.type->kind == TK_SMALLSET) {
  1490.                         ex2 = p_term(ex->val.type);
  1491.                         type = mixsets(&ex, &ex2);
  1492.                         if (type->kind == TK_SMALLSET) {
  1493.                             ex = makeexpr_bin(EK_BOR, type, ex, ex2);
  1494.                         } else {
  1495.                             tvar = makestmttempvar(type, name_SET);
  1496.                             ex = makeexpr_bicall_3(setunionname, type,
  1497.                                                    makeexpr_var(tvar),
  1498.                                                    ex, ex2);
  1499.                         }
  1500.                     } else
  1501.                         ex = makeexpr_plus(ex, p_term(tp_integer));
  1502.                     break;
  1504.                 case TOK_MINUS:
  1505.                     gettok();
  1506.                     if (ex->val.type->kind == TK_SET ||
  1507.                         ex->val.type->kind == TK_SMALLSET) {
  1508.                         ex2 = p_term(tp_integer);
  1509.                         type = mixsets(&ex, &ex2);
  1510.                         if (type->kind == TK_SMALLSET) {
  1511.                             ex = makeexpr_bin(EK_BAND, type, ex,
  1512.                                               makeexpr_un(EK_BNOT, type, ex2));
  1513.                         } else {
  1514.                             tvar = makestmttempvar(type, name_SET);
  1515.                             ex = makeexpr_bicall_3(setdiffname, type,
  1516.                                                    makeexpr_var(tvar), ex, ex2);
  1517.                         }
  1518.                     } else
  1519.                         ex = makeexpr_minus(ex, p_term(tp_integer));
  1520.                     break;
  1522. case TOK_VBAR:
  1523.     if (modula2)
  1524. return ex;
  1525.     /* fall through */
  1527.                 case TOK_OR:
  1528.     useshort = (curtok == TOK_VBAR);
  1529.                     gettok();
  1530.                     ex2 = p_term(tp_integer);
  1531.                     if (ord_type(ex->val.type)->kind == TK_INTEGER)
  1532.                         ex = makeexpr_bin(EK_BOR, ex->val.type, ex, ex2);
  1533.                     else if (partial_eval_flag || useshort ||
  1534.                              (shortopt && nosideeffects(ex2, 1)))
  1535.                         ex = makeexpr_or(ex, ex2);
  1536.                     else
  1537.                         ex = makeexpr_bin(EK_BOR, tp_boolean, ex, ex2);
  1538.                     break;
  1540.                 case TOK_XOR:
  1541.                     gettok();
  1542.                     ex2 = p_term(tp_integer);
  1543.                     ex = makeexpr_bin(EK_BXOR, ex->val.type, ex, ex2);
  1544.                     break;
  1546.                 default:
  1547.                     return ex;
  1548.             }
  1549.         }
  1550.     }
  1551. }
  1555. Expr *p_expr(target)
  1556. Type *target;
  1557. {
  1558.     Expr *ex = p_sexpr(target);
  1559.     Expr *ex2, *ex3, *ex4;
  1560.     Type *type;
  1561.     Meaning *tvar;
  1562.     long mask, smin, smax;
  1563.     int i, j;
  1565.     switch (curtok) {
  1567.         case TOK_EQ:
  1568.             gettok();
  1569.             return makeexpr_rel(EK_EQ, ex, p_sexpr(ex->val.type));
  1571.         case TOK_NE:
  1572.             gettok();
  1573.             return makeexpr_rel(EK_NE, ex, p_sexpr(ex->val.type));
  1575.         case TOK_LT:
  1576.             gettok();
  1577.             return makeexpr_rel(EK_LT, ex, p_sexpr(ex->val.type));
  1579.         case TOK_GT:
  1580.             gettok();
  1581.             return makeexpr_rel(EK_GT, ex, p_sexpr(ex->val.type));
  1583.         case TOK_LE:
  1584.             gettok();
  1585.             return makeexpr_rel(EK_LE, ex, p_sexpr(ex->val.type));
  1587.         case TOK_GE:
  1588.             gettok();
  1589.             return makeexpr_rel(EK_GE, ex, p_sexpr(ex->val.type));
  1591.         case TOK_IN:
  1592.             gettok();
  1593.             ex2 = p_sexpr(tp_smallset);
  1594.             ex = gentle_cast(ex, ex2->val.type->indextype);
  1595.             if (ex2->val.type->kind == TK_SMALLSET) {
  1596.                 if (!ord_range(ex->val.type, &smin, &smax)) {
  1597.                     smin = -1;
  1598.                     smax = setbits;
  1599.                 }
  1600.                 if (!nosideeffects(ex, 0)) {
  1601.                     tvar = makestmttempvar(ex->val.type, name_TEMP);
  1602.                     ex3 = makeexpr_assign(makeexpr_var(tvar), ex);