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