home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 379a.lha / p2c1_13a / src / src.zoo / pexpr1.c < prev    next >
C/C++ Source or Header  |  1990-03-11  |  30KB  |  990 lines
  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.
  4.  
  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).
  8.  
  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.
  13.  
  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. */
  17.  
  18. #define PROTO_PEXPR1_C
  19. #include "trans.h"
  20.  
  21. Expr *dots_n_hats(ex, target)
  22. Expr *ex;
  23. Type *target;
  24. {
  25.     Expr *ex2, *ex3;
  26.     Type *tp, *tp2, *ot;
  27.     Meaning *mp, *tvar;
  28.     int bits, hassl;
  29.  
  30.     for (;;) {
  31.     if ((ex->val.type->kind == TK_PROCPTR ||
  32.          ex->val.type->kind == TK_CPROCPTR) &&
  33.         curtok != TOK_ASSIGN &&
  34.         ((mp = (tp2 = ex->val.type)->basetype->fbase) == NULL ||
  35.          (mp->isreturn && mp->xnext == NULL) ||
  36.          curtok == TOK_LPAR) &&
  37.         (tp2->basetype->basetype != tp_void || target == tp_void) &&
  38.         (!target || (target->kind != TK_PROCPTR &&
  39.              target->kind != TK_CPROCPTR))) {
  40.         hassl = tp2->escale;
  41.         ex2 = ex;
  42.         ex3 = copyexpr(ex2);
  43.         if (hassl != 0)
  44.         ex3 = makeexpr_cast(makeexpr_dotq(ex3, "proc", tp_anyptr),
  45.                     makepointertype(tp2->basetype));
  46.         ex = makeexpr_un(EK_SPCALL, tp2->basetype->basetype, ex3);
  47.         if (mp && mp->isreturn) {  /* pointer to buffer for return value */
  48.         tvar = makestmttempvar(ex->val.type->basetype,
  49.                        (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
  50.         insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
  51.         mp = mp->xnext;
  52.         }
  53.         if (mp) {
  54.         if (wneedtok(TOK_LPAR)) {
  55.             ex = p_funcarglist(ex, mp, 0, 0);
  56.             skipcloseparen();
  57.         }
  58.         } else if (curtok == TOK_LPAR) {
  59.         gettok();
  60.         if (!wneedtok(TOK_RPAR))
  61.             skippasttoken(TOK_RPAR);
  62.         }
  63.         if (hassl != 1 || hasstaticlinks == 2) {
  64.         freeexpr(ex2);
  65.         } else {
  66.         ex2 = makeexpr_dotq(ex2, "link", tp_anyptr),
  67.         ex3 = copyexpr(ex);
  68.         insertarg(&ex3, ex3->nargs, copyexpr(ex2));
  69.         tp = maketype(TK_FUNCTION);
  70.         tp->basetype = tp2->basetype->basetype;
  71.         tp->fbase = tp2->basetype->fbase;
  72.         tp->issigned = 1;
  73.         ex3->args[0]->val.type = makepointertype(tp);
  74.         ex = makeexpr_cond(makeexpr_rel(EK_NE, ex2, makeexpr_nil()),
  75.                    ex3, ex);
  76.         }
  77.         if (tp2->basetype->fbase &&
  78.         tp2->basetype->fbase->isreturn &&
  79.         tp2->basetype->fbase->kind == MK_VARPARAM)
  80.         ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
  81.         continue;
  82.     }
  83.         switch (curtok) {
  84.  
  85.             case TOK_HAT:
  86.         case TOK_ADDR:
  87.                 gettok();
  88.                 ex = makeexpr_hat(ex, 1);
  89.                 break;
  90.  
  91.             case TOK_LBR:
  92.                 do {
  93.                     gettok();
  94.                     tp = ex->val.type;
  95.                     if (tp->kind == TK_STRING) {
  96.                         ex2 = p_expr(tp_integer);
  97.                         if (checkconst(ex2, 0))   /* is it "s[0]"? */
  98.                             ex = makeexpr_bicall_1("strlen", tp_char, ex);
  99.                         else
  100.                             ex = makeexpr_index(ex, ex2, makeexpr_long(1));
  101.                     } else if (tp->kind == TK_ARRAY ||
  102.                                tp->kind == TK_SMALLARRAY) {
  103.                         if (tp->smax) {
  104.                             ord_range_expr(tp->indextype, &ex2, NULL);
  105.                             ex2 = makeexpr_minus(p_ord_expr(),
  106.                          copyexpr(ex2));
  107.                             if (!nodependencies(ex2, 0) &&
  108.                                 *getbitsname == '*') {
  109.                                 mp = makestmttempvar(tp_integer, name_TEMP);
  110.                                 ex3 = makeexpr_assign(makeexpr_var(mp), ex2);
  111.                                 ex2 = makeexpr_var(mp);
  112.                             } else
  113.                                 ex3 = NULL;
  114.                             ex = makeexpr_bicall_3(getbitsname, tp_int,
  115.                                                    ex, ex2,
  116.                                                    makeexpr_long(tp->escale));
  117.                             if (tp->kind == TK_ARRAY) {
  118.                                 if (tp->basetype == tp_sshort)
  119.                                     bits = 4;
  120.                                 else
  121.                                     bits = 3;
  122.                                 insertarg(&ex, 3, makeexpr_long(bits));
  123.                             }
  124.                             ex = makeexpr_comma(ex3, ex);
  125.                             ot = ord_type(tp->smax->val.type);
  126.                             if (ot->kind == TK_ENUM && ot->meaning && useenum)
  127.                                 ex = makeexpr_cast(ex, tp->smax->val.type);
  128.                             ex->val.type = tp->smax->val.type;
  129.                         } else {
  130.                             ord_range_expr(ex->val.type->indextype, &ex2, NULL);
  131.                             if (debug>2) { fprintf(outf, "ord_range_expr returns "); dumpexpr(ex2); fprintf(outf, "\n"); }
  132.                             ex = makeexpr_index(ex, p_ord_expr(),
  133.                         copyexpr(ex2));
  134.                         }
  135.                     } else {
  136.                         warning("Index on a non-array variable [287]");
  137.             ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
  138.             }
  139.                 } while (curtok == TOK_COMMA);
  140.                 if (!wneedtok(TOK_RBR))
  141.             skippasttotoken(TOK_RBR, TOK_SEMI);
  142.                 break;
  143.  
  144.             case TOK_DOT:
  145.                 gettok();
  146.                 if (!wexpecttok(TOK_IDENT))
  147.             break;
  148.         if (ex->val.type->kind == TK_STRING) {
  149.             if (!strcicmp(curtokbuf, "LENGTH")) {
  150.             ex = makeexpr_bicall_1("strlen", tp_int, ex);
  151.             } else if (!strcicmp(curtokbuf, "BODY")) {
  152.             /* nothing to do */
  153.             }
  154.             gettok();
  155.             break;
  156.         }
  157.                 mp = curtoksym->fbase;
  158.                 while (mp && mp->rectype != ex->val.type)
  159.                     mp = mp->snext;
  160.                 if (mp)
  161.                     ex = makeexpr_dot(ex, mp);
  162.                 else {
  163.                     warning(format_s("No field called %s in that record [288]", curtokbuf));
  164.             ex = makeexpr_dotq(ex, curtokcase, tp_integer);
  165.         }
  166.                 gettok();
  167.                 break;
  168.  
  169.         case TOK_COLONCOLON:
  170.         gettok();
  171.         if (wexpecttok(TOK_IDENT)) {
  172.             ex = pascaltypecast(curtokmeaning->type, ex);
  173.             gettok();
  174.         }
  175.         break;
  176.  
  177.             default:
  178.                 return ex;
  179.         }
  180.     }
  181. }
  182.  
  183.  
  184.  
  185. Expr *fake_dots_n_hats(ex)
  186. Expr *ex;
  187. {
  188.     for (;;) {
  189.         switch (curtok) {
  190.  
  191.             case TOK_HAT:
  192.         case TOK_ADDR:
  193.             if (ex->val.type->kind == TK_POINTER)
  194.             ex = makeexpr_hat(ex, 0);
  195.         else {
  196.             ex->val.type = makepointertype(ex->val.type);
  197.             ex = makeexpr_un(EK_HAT, ex->val.type->basetype, ex);
  198.         }
  199.                 gettok();
  200.                 break;
  201.  
  202.             case TOK_LBR:
  203.                 do {
  204.                     gettok();
  205.                     ex = makeexpr_bin(EK_INDEX, tp_integer, ex, p_expr(tp_integer));
  206.                 } while (curtok == TOK_COMMA);
  207.                 if (!wneedtok(TOK_RBR))
  208.             skippasttotoken(TOK_RBR, TOK_SEMI);
  209.                 break;
  210.  
  211.             case TOK_DOT:
  212.                 gettok();
  213.                 if (!wexpecttok(TOK_IDENT))
  214.             break;
  215.                 ex = makeexpr_dotq(ex, curtokcase, tp_integer);
  216.                 gettok();
  217.                 break;
  218.  
  219.         case TOK_COLONCOLON:
  220.         gettok();
  221.         if (wexpecttok(TOK_IDENT)) {
  222.             ex = pascaltypecast(curtokmeaning->type, ex);
  223.             gettok();
  224.         }
  225.         break;
  226.  
  227.             default:
  228.                 return ex;
  229.         }
  230.     }
  231. }
  232.  
  233.  
  234.  
  235. Static void bindnames(ex)
  236. Expr *ex;
  237. {
  238.     int i;
  239.     Symbol *sp;
  240.     Meaning *mp;
  241.  
  242.     if (ex->kind == EK_NAME) {
  243.     sp = findsymbol_opt(fixpascalname(ex->val.s));
  244.     if (sp) {
  245.         mp = sp->mbase;
  246.         while (mp && !mp->isactive)
  247.         mp = mp->snext;
  248.         if (mp && !strcmp(mp->name, ex->val.s)) {
  249.         ex->kind = EK_VAR;
  250.         ex->val.i = (long)mp;
  251.         ex->val.type = mp->type;
  252.         }
  253.     }
  254.     }
  255.     i = ex->nargs;
  256.     while (--i >= 0)
  257.     bindnames(ex->args[i]);
  258. }
  259.  
  260.  
  261.  
  262. void var_reference(mp)
  263. Meaning *mp;
  264. {
  265.     Meaning *mp2;
  266.  
  267.     mp->refcount++;
  268.     if (mp->ctx && mp->ctx->kind == MK_FUNCTION &&
  269.     mp->ctx->needvarstruct &&
  270.     (mp->kind == MK_VAR ||
  271.      mp->kind == MK_VARREF ||
  272.      mp->kind == MK_VARMAC ||
  273.      mp->kind == MK_PARAM ||
  274.      mp->kind == MK_VARPARAM ||
  275.      (mp->kind == MK_CONST &&
  276.       (mp->type->kind == TK_ARRAY ||
  277.        mp->type->kind == TK_RECORD)))) {
  278.         if (debug>1) { fprintf(outf, "varstruct'ing %s\n", mp->name); }
  279.         if (!mp->varstructflag) {
  280.             mp->varstructflag = 1;
  281.             if (mp->constdefn &&      /* move init code into function body */
  282.         mp->kind != MK_VARMAC) {
  283.                 mp2 = addmeaningafter(mp, curtoksym, MK_VAR);
  284.                 curtoksym->mbase = mp2->snext;  /* hide this fake variable */
  285.                 mp2->snext = mp;      /* remember true variable */
  286.                 mp2->type = mp->type;
  287.                 mp2->constdefn = mp->constdefn;
  288.                 mp2->isforward = 1;   /* declare it "static" */
  289.                 mp2->refcount++;      /* so it won't be purged! */
  290.                 mp->constdefn = NULL;
  291.                 mp->isforward = 0;
  292.             }
  293.         }
  294.         for (mp2 = curctx->ctx; mp2 != mp->ctx; mp2 = mp2->ctx)
  295.             mp2->varstructflag = 1;
  296.         mp2->varstructflag = 1;
  297.     }
  298. }
  299.  
  300. Expr *p_variable(target)
  301. Type *target;
  302. {
  303.     Expr *ex, *ex2;
  304.     Meaning *mp;
  305.     Symbol *sym;
  306.  
  307.     if (curtok != TOK_IDENT) {
  308.         warning("Expected a variable [289]");
  309.     return makeexpr_long(0);
  310.     }
  311.     if (!curtokmeaning) {
  312.     sym = curtoksym;
  313.         ex = makeexpr_name(curtokcase, tp_integer);
  314.         gettok();
  315.         if (curtok == TOK_LPAR) {
  316.             ex = makeexpr_bicall_0(ex->val.s, tp_integer);
  317.             do {
  318.                 gettok();
  319.                 insertarg(&ex, ex->nargs, p_expr(NULL));
  320.             } while (curtok == TOK_COMMA || curtok == TOK_ASSIGN);
  321.             if (!wneedtok(TOK_RPAR))
  322.         skippasttotoken(TOK_RPAR, TOK_SEMI);
  323.         }
  324.     if (!tryfuncmacro(&ex, NULL))
  325.         undefsym(sym);
  326.         return fake_dots_n_hats(ex);
  327.     }
  328.     var_reference(curtokmeaning);
  329.     mp = curtokmeaning;
  330.     if (mp->kind == MK_FIELD) {
  331.         ex = makeexpr_dot(copyexpr(withexprs[curtokint]), mp);
  332.     } else if (mp->kind == MK_CONST &&
  333.            mp->type->kind == TK_SET &&
  334.            mp->constdefn) {
  335.     ex = copyexpr(mp->constdefn);
  336.     mp = makestmttempvar(ex->val.type, name_SET);
  337.         ex2 = makeexpr(EK_MACARG, 0);
  338.         ex2->val.type = ex->val.type;
  339.     ex = replaceexprexpr(ex, ex2, makeexpr_var(mp));
  340.         freeexpr(ex2);
  341.     } else if (mp->kind == MK_CONST &&
  342.                (mp == mp_false ||
  343.                 mp == mp_true ||
  344.                 mp->anyvarflag ||
  345.                 (foldconsts > 0 &&
  346.                  (mp->type->kind == TK_INTEGER ||
  347.                   mp->type->kind == TK_BOOLEAN ||
  348.                   mp->type->kind == TK_CHAR ||
  349.                   mp->type->kind == TK_ENUM ||
  350.                   mp->type->kind == TK_SUBR ||
  351.                   mp->type->kind == TK_REAL)) ||
  352.                 (foldstrconsts > 0 &&
  353.                  (mp->type->kind == TK_STRING)))) {
  354.         if (mp->constdefn) {
  355.             ex = copyexpr(mp->constdefn);
  356.             if (ex->val.type == tp_int)   /* kludge! */
  357.                 ex->val.type = tp_integer;
  358.         } else
  359.             ex = makeexpr_val(copyvalue(mp->val));
  360.     } else if (mp->kind == MK_VARPARAM ||
  361.                mp->kind == MK_VARREF) {
  362.         ex = makeexpr_hat(makeexpr_var(mp), 0);
  363.     } else if (mp->kind == MK_VARMAC) {
  364.         ex = copyexpr(mp->constdefn);
  365.     bindnames(ex);
  366.         ex = gentle_cast(ex, mp->type);
  367.         ex->val.type = mp->type;
  368.     } else if (mp->kind == MK_SPVAR && mp->handler) {
  369.         gettok();
  370.         ex = (*mp->handler)(mp);
  371.         return dots_n_hats(ex, target);
  372.     } else if (mp->kind == MK_VAR ||
  373.                mp->kind == MK_CONST ||
  374.                mp->kind == MK_PARAM) {
  375.         ex = makeexpr_var(mp);
  376.     } else {
  377.         symclass(mp->sym);
  378.         ex = makeexpr_name(mp->name, tp_integer);
  379.     }
  380.     gettok();
  381.     return dots_n_hats(ex, target);
  382. }
  383.  
  384. Expr *p_ord_expr()
  385. {
  386.     return makeexpr_charcast(p_expr(tp_integer));
  387. }
  388.  
  389. Expr *makesmallsetconst(bits, type)
  390. long bits;
  391. Type *type;
  392. {
  393.     Expr *ex;
  394.  
  395.     ex = makeexpr_long(bits);
  396.     ex->val.type = type;
  397.     if (smallsetconst != 2)
  398.         insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
  399.     return ex;
  400. }
  401.  
  402. Expr *packset(ex, type)
  403. Expr *ex;
  404. Type *type;
  405. {
  406.     Meaning *mp;
  407.     Expr *ex2;
  408.     long max2;
  409.  
  410.     if (ex->kind == EK_BICALL) {
  411.         if (!strcmp(ex->val.s, setexpandname) &&
  412.             (mp = istempvar(ex->args[0])) != NULL) {
  413.             canceltempvar(mp);
  414.             return grabarg(ex, 1);
  415.         }
  416.         if (!strcmp(ex->val.s, setunionname) &&
  417.             (mp = istempvar(ex->args[0])) != NULL &&
  418.             !exproccurs(ex->args[1], ex->args[0]) &&
  419.             !exproccurs(ex->args[2], ex->args[0])) {
  420.             canceltempvar(mp);
  421.             return makeexpr_bin(EK_BOR, type, packset(ex->args[1], type),
  422.                                               packset(ex->args[2], type));
  423.         }
  424.         if (!strcmp(ex->val.s, setaddname)) {
  425.             ex2 = makeexpr_bin(EK_LSH, type,
  426.                                makeexpr_longcast(makeexpr_long(1), 1),
  427.                                ex->args[1]);
  428.             ex = packset(ex->args[0], type);
  429.             if (checkconst(ex, 0))
  430.                 return ex2;
  431.             else
  432.                 return makeexpr_bin(EK_BOR, type, ex, ex2);
  433.         }
  434.         if (!strcmp(ex->val.s, setaddrangename)) {
  435.             if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
  436.                 note("Range construction was implemented by a subtraction which may overflow [278]");
  437.             ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
  438.                                               makeexpr_longcast(makeexpr_long(1), 1),
  439.                                               makeexpr_plus(ex->args[2],
  440.                                                             makeexpr_long(1))),
  441.                                  makeexpr_bin(EK_LSH, type,
  442.                                               makeexpr_longcast(makeexpr_long(1), 1),
  443.                                               ex->args[1]));
  444.             ex = packset(ex->args[0], type);
  445.             if (checkconst(ex, 0))
  446.                 return ex2;
  447.             else
  448.                 return makeexpr_bin(EK_BOR, type, ex, ex2);
  449.         }
  450.     }
  451.     return makeexpr_bicall_1(setpackname, type, ex);
  452. }
  453.  
  454.  
  455.  
  456. #define MAXSETLIT 400
  457.  
  458. Expr *p_setfactor(type)
  459. Type *type;
  460. {
  461.     Expr *ex, *exmax = NULL, *ex2;
  462.     Expr *first[MAXSETLIT], *last[MAXSETLIT];
  463.     char doneflag[MAXSETLIT];
  464.     int i, j, num, donecount;
  465.     int isconst, guesstype = 0;
  466.     long maxv, max2;
  467.     Value val;
  468.     Type *tp;
  469.     Meaning *tvar;
  470.  
  471.     if (curtok == TOK_LBRACE)
  472.     gettok();
  473.     else if (!wneedtok(TOK_LBR))
  474.     return makeexpr_long(0);
  475.     if (curtok == TOK_RBR || curtok == TOK_RBRACE) {        /* empty set */
  476.         gettok();
  477.         val.type = tp_smallset;
  478.         val.i = 0;
  479.         val.s = NULL;
  480.         return makeexpr_val(val);
  481.     }
  482.     if (!type)
  483.         guesstype = 1;
  484.     maxv = -1;
  485.     isconst = 1;
  486.     num = 0;
  487.     for (;;) {
  488.         if (num >= MAXSETLIT) {
  489.             warning(format_d("Too many elements in set literal; max=%d [290]", MAXSETLIT));
  490.             ex = p_expr(type);
  491.             while (curtok != TOK_RBR && curtok != TOK_RBRACE) {
  492.                 gettok();
  493.                 ex = p_expr(type);
  494.             }
  495.             break;
  496.         }
  497.         if (guesstype && num == 0) {
  498.             ex = p_ord_expr();
  499.             type = ord_type(ex->val.type);
  500.         } else {
  501.             ex = p_expr(type);
  502.         }
  503.         first[num] = ex = gentle_cast(ex, type);
  504.         doneflag[num] = 0;
  505.         if (curtok == TOK_DOTS) {
  506.             val = eval_expr(ex);
  507.             if (val.type) {
  508.         if (val.i > maxv) {     /* In case of [127..0] */
  509.             maxv = val.i;
  510.             exmax = ex;
  511.         }
  512.         } else
  513.                 isconst = 0;
  514.             gettok();
  515.             last[num] = ex = gentle_cast(p_expr(type), type);
  516.         } else {
  517.             last[num] = NULL;
  518.         }
  519.         val = eval_expr(ex);
  520.         if (val.type) {
  521.             if (val.i > maxv) {
  522.                 maxv = val.i;
  523.                 exmax = ex;
  524.             }
  525.         } else {
  526.             isconst = 0;
  527.             maxv = LONG_MAX;
  528.         }
  529.         num++;
  530.         if (curtok == TOK_COMMA)
  531.             gettok();
  532.         else
  533.             break;
  534.     }
  535.     if (curtok == TOK_RBRACE)
  536.     gettok();
  537.     else if (!wneedtok(TOK_RBR))
  538.     skippasttotoken(TOK_RBR, TOK_SEMI);
  539.     tp = ord_type(first[0]->val.type);
  540.     if (guesstype) {      /* must determine type */
  541.         if (!exmax || maxv == LONG_MAX) {
  542.             maxv = defaultsetsize-1;
  543.             if (ord_range(tp, NULL, &max2) && maxv > max2)
  544.                 maxv = max2;
  545.             exmax = makeexpr_long(maxv);
  546.         } else
  547.             exmax = copyexpr(exmax);
  548.         if (!ord_range(tp, NULL, &max2) || maxv != max2)
  549.             tp = makesubrangetype(tp, makeexpr_long(0), exmax);
  550.         type = makesettype(tp);
  551.     } else
  552.     type = makesettype(type);
  553.     donecount = 0;
  554.     if (smallsetconst > 0) {
  555.         val.i = 0;
  556.         for (i = 0; i < num; i++) {
  557.             if (first[i]->kind == EK_CONST && first[i]->val.i < setbits &&
  558.                 (!last[i] || (last[i]->kind == EK_CONST &&
  559.                               last[i]->val.i >= 0 &&
  560.                               last[i]->val.i < setbits))) {
  561.                 if (last[i]) {
  562.                     for (j = first[i]->val.i; j <= last[i]->val.i; j++)
  563.                         val.i |= 1<<j;
  564.                 } else
  565.             val.i |= 1 << first[i]->val.i;
  566.                 doneflag[i] = 1;
  567.                 donecount++;
  568.             }
  569.         }
  570.     }
  571.     if (donecount) {
  572.         ex = makesmallsetconst(val.i, tp_smallset);
  573.     } else
  574.         ex = NULL;
  575.     if (type->kind == TK_SMALLSET) {
  576.         for (i = 0; i < num; i++) {
  577.             if (!doneflag[i]) {
  578.                 ex2 = makeexpr_bin(EK_LSH, type,
  579.                    makeexpr_longcast(makeexpr_long(1), 1),
  580.                    enum_to_int(first[i]));
  581.                 if (last[i]) {
  582.                     if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
  583.                         note("Range construction was implemented by a subtraction which may overflow [278]");
  584.                     ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
  585.                                                       makeexpr_longcast(makeexpr_long(1), 1),
  586.                                                       makeexpr_plus(enum_to_int(last[i]),
  587.                                                                     makeexpr_long(1))),
  588.                                          ex2);
  589.                 }
  590.                 if (ex)
  591.                     ex = makeexpr_bin(EK_BOR, type, makeexpr_longcast(ex, 1), ex2);
  592.                 else
  593.                     ex = ex2;
  594.             }
  595.         }
  596.     } else {
  597.         tvar = makestmttempvar(type, name_SET);
  598.         if (!ex) {
  599.             val.type = tp_smallset;
  600.         val.i = 0;
  601.         val.s = NULL;
  602.         ex = makeexpr_val(val);
  603.     }
  604.         ex = makeexpr_bicall_2(setexpandname, type,
  605.                                makeexpr_var(tvar), makeexpr_arglong(ex, 1));
  606.         for (i = 0; i < num; i++) {
  607.             if (!doneflag[i]) {
  608.                 if (last[i])
  609.                     ex = makeexpr_bicall_3(setaddrangename, type,
  610.                                            ex, makeexpr_arglong(enum_to_int(first[i]), 0),
  611.                                                makeexpr_arglong(enum_to_int(last[i]), 0));
  612.                 else
  613.                     ex = makeexpr_bicall_2(setaddname, type,
  614.                                            ex, makeexpr_arglong(enum_to_int(first[i]), 0));
  615.             }
  616.         }
  617.     }
  618.     return ex;
  619. }
  620.  
  621.  
  622.  
  623.  
  624. Expr *p_funcarglist(ex, args, firstarg, ismacro)
  625. Expr *ex;
  626. Meaning *args;
  627. int firstarg, ismacro;
  628. {
  629.     Meaning *mp, *mp2, *arglist = args, *prevarg = NULL;
  630.     Expr *ex2;
  631.     int i, fi, fakenum = -1, castit, isconf, isnonpos = 0;
  632.     Type *tp, *tp2;
  633.     char *name;
  634.  
  635.     castit = castargs;
  636.     if (castit < 0)
  637.     castit = (prototypes == 0);
  638.     while (args) {
  639.     if (isnonpos) {
  640.         while (curtok == TOK_COMMA)
  641.         gettok();
  642.         if (curtok == TOK_RPAR) {
  643.         args = arglist;
  644.         i = firstarg;
  645.         while (args) {
  646.             if (ex->nargs <= i)
  647.             insertarg(&ex, ex->nargs, NULL);
  648.             if (!ex->args[i]) {
  649.             if (args->constdefn)
  650.                 ex->args[i] = copyexpr(args->constdefn);
  651.             else {
  652.                 warning(format_s("Missing value for parameter %s [291]",
  653.                          args->name));
  654.                 ex->args[i] = makeexpr_long(0);
  655.             }
  656.             }
  657.             args = args->xnext;
  658.             i++;
  659.         }
  660.         break;
  661.         }
  662.     }
  663.     if (args->isreturn || args->fakeparam) {
  664.         if (args->fakeparam) {
  665.         if (fakenum < 0)
  666.             fakenum = ex->nargs;
  667.         if (args->constdefn)
  668.             insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  669.         else
  670.             insertarg(&ex, ex->nargs, makeexpr_long(0));
  671.         }
  672.         args = args->xnext;     /* return value parameter */
  673.         continue;
  674.     }
  675.     if (curtok == TOK_RPAR) {
  676.         if (args->constdefn) {
  677.         insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  678.         args = args->xnext;
  679.         continue;
  680.         } else {
  681.         if (ex->kind == EK_FUNCTION) {
  682.             name = ((Meaning *)ex->val.i)->name;
  683.             ex->kind = EK_BICALL;
  684.             ex->val.s = stralloc(name);
  685.         } else
  686.             name = "function";
  687.         warning(format_s("Too few arguments for %s [292]", name));
  688.         return ex;
  689.         }
  690.     }
  691.     if (curtok == TOK_COMMA) {
  692.         if (args->constdefn)
  693.         insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  694.         else {
  695.         warning(format_s("Missing parameter %s [293]", args->name));
  696.         insertarg(&ex, ex->nargs, makeexpr_long(0));
  697.         }
  698.         gettok();
  699.         args = args->xnext;
  700.         continue;
  701.     }
  702.     p_mech_spec(0);
  703.     if (curtok == TOK_IDENT) {
  704.         mp = arglist;
  705.         mp2 = NULL;
  706.         i = firstarg;
  707.         fi = -1;
  708.         while (mp && strcmp(curtokbuf, mp->sym->name)) {
  709.         if (mp->fakeparam) {
  710.             if (fi < 0)
  711.             fi = i;
  712.         } else
  713.             fi = -1;
  714.         i++;
  715.         mp2 = mp;
  716.         mp = mp->xnext;
  717.         }
  718.         if (mp &&
  719.         (peeknextchar() == ':' || !curtokmeaning || isnonpos)) {
  720.         gettok();
  721.         wneedtok(TOK_ASSIGN);
  722.         prevarg = mp2;
  723.         args = mp;
  724.         fakenum = fi;
  725.         isnonpos = 1;
  726.         } else
  727.         i = ex->nargs;
  728.     } else
  729.         i = ex->nargs;
  730.     while (ex->nargs <= i)
  731.         insertarg(&ex, ex->nargs, NULL);
  732.     if (ex->args[i])
  733.         warning(format_s("Multiple values for parameter %s [294]",
  734.                  args->name));
  735.     tp = args->type;
  736.     ex2 = p_expr(tp);
  737.     if (args->kind == MK_VARPARAM)
  738.         tp = tp->basetype;
  739.     tp2 = ex2->val.type;
  740.     isconf = ((tp->kind == TK_ARRAY ||
  741.            tp->kind == TK_STRING) && tp->structdefd);
  742.         switch (args->kind) {
  743.  
  744.             case MK_PARAM:
  745.             if (castit && tp->kind == TK_REAL &&
  746.             ex2->val.type->kind != TK_REAL)
  747.                     ex2 = makeexpr_cast(ex2, tp);
  748.                 else if (ord_type(tp)->kind == TK_INTEGER && !ismacro)
  749.                     ex2 = makeexpr_arglong(ex2, long_type(tp));
  750.                 else if (args->othername && args->rectype != tp &&
  751.                          tp->kind != TK_STRING && args->type == tp2)
  752.                     ex2 = makeexpr_addr(ex2);
  753.                 else
  754.                     ex2 = gentle_cast(ex2, tp);
  755.         ex->args[i] = ex2;
  756.                 break;
  757.  
  758.             case MK_VARPARAM:
  759.                 if (args->type == tp_strptr && args->anyvarflag) {
  760.             ex->args[i] = strmax_func(ex2);
  761.                     insertarg(&ex, ex->nargs-1, makeexpr_addr(ex2));
  762.             if (isnonpos)
  763.             note("Non-positional conformant parameters may not work [279]");
  764.                 } else {                        /* regular VAR parameter */
  765.                     ex2 = makeexpr_addrf(ex2);
  766.                     if (args->anyvarflag ||
  767.                         (tp->kind == TK_POINTER && tp2->kind == TK_POINTER &&
  768.                          (tp == tp_anyptr || tp2 == tp_anyptr))) {
  769.             if (!ismacro)
  770.                 ex2 = makeexpr_cast(ex2, args->type);
  771.                     } else {
  772.                         if (tp2 != tp && !isconf &&
  773.                 (tp2->kind != TK_STRING ||
  774.                  tp->kind != TK_STRING))
  775.                             warning(format_s("Type mismatch in VAR parameter %s [295]",
  776.                                              args->name));
  777.                     }
  778.             ex->args[i] = ex2;
  779.                 }
  780.                 break;
  781.  
  782.         default:
  783.         intwarning("p_funcarglist",
  784.                format_s("Parameter type is %s [296]",
  785.                     meaningkindname(args->kind)));
  786.         break;
  787.         }
  788.     if (isconf &&   /* conformant array or string */
  789.         (!prevarg || prevarg->type != args->type)) {
  790.         while (tp->kind == TK_ARRAY && tp->structdefd) {
  791.         if (tp2->kind == TK_SMALLARRAY) {
  792.             warning("Trying to pass a small-array for a conformant array [297]");
  793.             /* this has a chance of working... */
  794.             ex->args[ex->nargs-1] =
  795.             makeexpr_addr(ex->args[ex->nargs-1]);
  796.         } else if (tp2->kind == TK_STRING) {
  797.             ex->args[fakenum++] =
  798.             makeexpr_arglong(makeexpr_long(1), integer16 == 0);
  799.             ex->args[fakenum++] =
  800.             makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
  801.                      integer16 == 0);
  802.             break;
  803.             } else if (tp2->kind != TK_ARRAY) {
  804.             warning("Type mismatch for conformant array [298]");
  805.             break;
  806.         }
  807.         ex->args[fakenum++] =
  808.             makeexpr_arglong(copyexpr(tp2->indextype->smin),
  809.                      integer16 == 0);
  810.         ex->args[fakenum++] =
  811.             makeexpr_arglong(copyexpr(tp2->indextype->smax),
  812.                      integer16 == 0);
  813.         tp = tp->basetype;
  814.         tp2 = tp2->basetype;
  815.         }
  816.         if (tp->kind == TK_STRING && tp->structdefd) {
  817.         ex->args[fakenum] =
  818.             makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
  819.                      integer16 == 0);
  820.         }
  821.     }
  822.     fakenum = -1;
  823.     if (!isnonpos) {
  824.         prevarg = args;
  825.         args = args->xnext;
  826.         if (args) {
  827.         if (curtok != TOK_RPAR && !wneedtok(TOK_COMMA))
  828.             skiptotoken2(TOK_RPAR, TOK_SEMI);
  829.         }
  830.     }
  831.     }
  832.     if (curtok == TOK_COMMA) {
  833.     if (ex->kind == EK_FUNCTION) {
  834.         name = ((Meaning *)ex->val.i)->name;
  835.         ex->kind = EK_BICALL;
  836.         ex->val.s = stralloc(name);
  837.     } else
  838.         name = "function";
  839.     warning(format_s("Too many arguments for %s [299]", name));
  840.     while (curtok == TOK_COMMA) {
  841.         gettok();
  842.         insertarg(&ex, ex->nargs, p_expr(tp_integer));
  843.     }
  844.     }
  845.     return ex;
  846. }
  847.  
  848.  
  849.  
  850. Expr *replacemacargs(ex, fex)
  851. Expr *ex, *fex;
  852. {
  853.     int i;
  854.     Expr *ex2;
  855.  
  856.     for (i = 0; i < ex->nargs; i++)
  857.         ex->args[i] = replacemacargs(ex->args[i], fex);
  858.     if (ex->kind == EK_MACARG) {
  859.     if (ex->val.i <= fex->nargs) {
  860.         ex2 = copyexpr(fex->args[ex->val.i - 1]);
  861.     } else {
  862.         ex2 = makeexpr_name("<meef>", tp_integer);
  863.         note("FuncMacro specified more arguments than call [280]");
  864.     }
  865.     freeexpr(ex);
  866.     return ex2;
  867.     }
  868.     return resimplify(ex);
  869. }
  870.  
  871.  
  872. Expr *p_noarglist(ex, mp, args)
  873. Expr *ex;
  874. Meaning *mp, *args;
  875. {
  876.     while (args && args->constdefn) {
  877.     insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
  878.     args = args->xnext;
  879.     }
  880.     if (args) {
  881.     warning(format_s("Expected an argument list for %s [300]", mp->name));
  882.     ex->kind = EK_BICALL;
  883.     ex->val.s = stralloc(mp->name);
  884.     }
  885.     return ex;
  886. }
  887.  
  888.  
  889. void func_reference(func)
  890. Meaning *func;
  891. {
  892.     Meaning *mp;
  893.  
  894.     if (func->ctx && func->ctx != curctx &&func->ctx->kind == MK_FUNCTION &&
  895.     func->ctx->varstructflag && !curctx->ctx->varstructflag) {
  896.     for (mp = curctx->ctx; mp != func->ctx; mp = mp->ctx)
  897.         mp->varstructflag = 1;
  898.     }
  899. }
  900.  
  901.  
  902. Expr *p_funccall(mp)
  903. Meaning *mp;
  904. {
  905.     Meaning *mp2, *tvar;
  906.     Expr *ex, *ex2;
  907.     int firstarg = 0;
  908.  
  909.     func_reference(mp);
  910.     ex = makeexpr(EK_FUNCTION, 0);
  911.     ex->val.i = (long)mp;
  912.     ex->val.type = mp->type->basetype;
  913.     mp2 = mp->type->fbase;
  914.     if (mp2 && mp2->isreturn) {    /* pointer to buffer for return value */
  915.         tvar = makestmttempvar(ex->val.type->basetype,
  916.             (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
  917.         insertarg(&ex, 0, makeexpr_addr(makeexpr_var(tvar)));
  918.         mp2 = mp2->xnext;
  919.     firstarg++;
  920.     }
  921.     if (mp2 && curtok != TOK_LPAR) {
  922.     ex = p_noarglist(ex, mp, mp2);
  923.     } else if (curtok == TOK_LPAR) {
  924.     gettok();
  925.         ex = p_funcarglist(ex, mp2, firstarg, (mp->constdefn != NULL));
  926.         skipcloseparen();
  927.     }
  928.     if (mp->constdefn) {
  929.         ex2 = replacemacargs(copyexpr(mp->constdefn), ex);
  930.     ex2 = gentle_cast(ex2, ex->val.type);
  931.     ex2->val.type = ex->val.type;
  932.         freeexpr(ex);
  933.         return ex2;
  934.     }
  935.     return ex;
  936. }
  937.  
  938.  
  939.  
  940.  
  941.  
  942.  
  943. Expr *accumulate_strlit()
  944. {
  945.     char buf[256], ch, *cp, *cp2;
  946.     int len, i, danger = 0;
  947.  
  948.     len = 0;
  949.     cp = buf;
  950.     for (;;) {
  951.         if (curtok == TOK_STRLIT) {
  952.             cp2 = curtokbuf;
  953.             i = curtokint;
  954.             while (--i >= 0) {
  955.                 if (++len <= 255) {
  956.                     ch = *cp++ = *cp2++;
  957.                     if (ch & 128)
  958.                         danger++;
  959.                 }
  960.             }
  961.         } else if (curtok == TOK_HAT) {    /* Turbo */
  962.             i = getchartok() & 0x1f;
  963.             if (++len <= 255)
  964.                 *cp++ = i;
  965.     } else if (curtok == TOK_LPAR) {   /* VAX */
  966.         Value val;
  967.         do {
  968.         gettok();
  969.         val = p_constant(tp_integer);
  970.         if (++len <= 255)
  971.             *cp++ = val.i;
  972.         } while (curtok == TOK_COMMA);
  973.         skipcloseparen();
  974.         continue;
  975.         } else
  976.             break;
  977.         gettok();
  978.     }
  979.     if (len > 255) {
  980.         warning("String literal too long [301]");
  981.         len = 255;
  982.     }
  983.     if (danger &&
  984.         !(unsignedchar == 1 ||
  985.           (unsignedchar != 0 && signedchars == 0)))
  986.         note(format_s("Character%s >= 128 encountered [281]", (danger > 1) ? "s" : ""));
  987.     return makeexpr_lstring(buf, len);
  988. }
  989.  
  990.