cstoper.c 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697
  1. /*
  2. * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
  3. * See the copyright notice in the ACK home directory, in the file "Copyright".
  4. *
  5. * Author: Ceriel J.H. Jacobs
  6. */
  7. /* C O N S T A N T E X P R E S S I O N H A N D L I N G */
  8. /* $Id$ */
  9. #include "debug.h"
  10. #include "target_sizes.h"
  11. #include "uns_arith.h"
  12. #include <em_arith.h>
  13. #include <em_label.h>
  14. #include <assert.h>
  15. #include <alloc.h>
  16. #include "idf.h"
  17. #include "type.h"
  18. #include "LLlex.h"
  19. #include "node.h"
  20. #include "Lpars.h"
  21. #include "standards.h"
  22. #include "warning.h"
  23. extern char *symbol2str();
  24. #define arith_sign ((arith) (1L << (sizeof(arith) * 8 - 1)))
  25. #ifndef NOCROSS
  26. arith full_mask[MAXSIZE+1];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
  27. arith max_int[MAXSIZE+1]; /* max_int[1] == 0x7F, max_int[2] == 0x7FFF, .. */
  28. arith min_int[MAXSIZE+1]; /* min_int[1] == 0xFFFFFF80, min_int[2] = 0xFFFF8000,
  29. ...
  30. */
  31. unsigned int wrd_bits; /* number of bits in a word */
  32. #else
  33. arith full_mask[] = { 0L, 0xFFL, 0xFFFFL, 0L, 0xFFFFFFFFL };
  34. arith max_int[] = { 0L, 0x7FL, 0x7FFFL, 0L, 0x7FFFFFFFL };
  35. arith min_int[] = { 0L, -128L, -32768L, 0L, -2147483647L-1 };
  36. #endif
  37. extern char options[];
  38. overflow(expp)
  39. t_node *expp;
  40. {
  41. if (expp->nd_type != address_type) {
  42. node_warning(expp, W_ORDINARY, "overflow in constant expression");
  43. }
  44. }
  45. STATIC
  46. commonbin(expp)
  47. t_node **expp;
  48. {
  49. register t_node *exp = *expp;
  50. t_type *tp = exp->nd_type;
  51. register t_node *right = exp->nd_RIGHT;
  52. exp->nd_RIGHT = 0;
  53. FreeNode(exp);
  54. *expp = right;
  55. right->nd_type = tp;
  56. }
  57. cstunary(expp)
  58. t_node **expp;
  59. {
  60. /* The unary operation in "expp" is performed on the constant
  61. expression below it, and the result restored in expp.
  62. */
  63. register t_node *exp = *expp;
  64. register t_node *right = exp->nd_RIGHT;
  65. register arith o1 = right->nd_INT;
  66. switch(exp->nd_symb) {
  67. /* Should not get here
  68. case '+':
  69. break;
  70. */
  71. case '-':
  72. if (! options['s'] &&
  73. o1 == min_int[(int)(right->nd_type->tp_size)]) {
  74. overflow(exp);
  75. }
  76. o1 = -o1;
  77. break;
  78. case NOT:
  79. case '~':
  80. o1 = !o1;
  81. break;
  82. default:
  83. crash("(cstunary)");
  84. }
  85. commonbin(expp);
  86. (*expp)->nd_INT = o1;
  87. CutSize(*expp);
  88. }
  89. STATIC
  90. divide(pdiv, prem)
  91. arith *pdiv, *prem;
  92. {
  93. /* Unsigned divide *pdiv by *prem, and store result in *pdiv,
  94. remainder in *prem
  95. */
  96. register arith o1 = *pdiv;
  97. register arith o2 = *prem;
  98. #ifndef UNSIGNED_ARITH
  99. /* this is more of a problem than you might
  100. think on C compilers which do not have
  101. unsigned long.
  102. */
  103. if (o2 & arith_sign) {/* o2 > max_arith */
  104. if (! (o1 >= 0 || o1 < o2)) {
  105. /* this is the unsigned test
  106. o1 < o2 for o2 > max_arith
  107. */
  108. *prem = o2 - o1;
  109. *pdiv = 1;
  110. }
  111. else {
  112. *pdiv = 0;
  113. }
  114. }
  115. else { /* o2 <= max_arith */
  116. arith half, bit, hdiv, hrem, rem;
  117. half = (o1 >> 1) & ~arith_sign;
  118. bit = o1 & 01;
  119. /* now o1 == 2 * half + bit
  120. and half <= max_arith
  121. and bit <= max_arith
  122. */
  123. hdiv = half / o2;
  124. hrem = half % o2;
  125. rem = 2 * hrem + bit;
  126. *pdiv = 2*hdiv;
  127. *prem = rem;
  128. if (rem < 0 || rem >= o2) {
  129. /* that is the unsigned compare
  130. rem >= o2 for o2 <= max_arith
  131. */
  132. *pdiv += 1;
  133. *prem -= o2;
  134. }
  135. }
  136. #else
  137. *pdiv = (UNSIGNED_ARITH) o1 / (UNSIGNED_ARITH) o2;
  138. *prem = (UNSIGNED_ARITH) o1 % (UNSIGNED_ARITH) o2;
  139. #endif
  140. }
  141. cstibin(expp)
  142. t_node **expp;
  143. {
  144. /* The binary operation in "expp" is performed on the constant
  145. expressions below it, and the result restored in expp.
  146. This version is for INTEGER expressions.
  147. */
  148. register t_node *exp = *expp;
  149. register arith o1 = exp->nd_LEFT->nd_INT;
  150. register arith o2 = exp->nd_RIGHT->nd_INT;
  151. register int sz = exp->nd_type->tp_size;
  152. assert(exp->nd_class == Oper);
  153. assert(exp->nd_LEFT->nd_class == Value);
  154. assert(exp->nd_RIGHT->nd_class == Value);
  155. switch (exp->nd_symb) {
  156. case '*':
  157. if (o1 > 0) {
  158. if (o2 > 0) {
  159. if (max_int[sz] / o1 < o2) overflow(exp);
  160. }
  161. else if (min_int[sz] / o1 > o2) overflow(exp);
  162. }
  163. else if (o1 < 0) {
  164. if (o2 < 0) {
  165. if (o1 == min_int[sz] || o2 == min_int[sz] ||
  166. max_int[sz] / (-o1) < (-o2)) overflow(exp);
  167. }
  168. else if (o2 > 0) {
  169. if (min_int[sz] / o2 > o1) overflow(exp);
  170. }
  171. }
  172. o1 *= o2;
  173. break;
  174. case DIV:
  175. case MOD:
  176. if (o2 == 0) {
  177. node_error(exp, exp->nd_symb == DIV ?
  178. "division by 0" :
  179. "modulo by 0");
  180. return;
  181. }
  182. if ((o1 < 0) != (o2 < 0)) {
  183. if (o1 < 0) o1 = -o1;
  184. else o2 = -o2;
  185. if (exp->nd_symb == DIV) o1 = -((o1+o2-1)/o2);
  186. else o1 = ((o1+o2-1)/o2) * o2 - o1;
  187. }
  188. else {
  189. if (exp->nd_symb == DIV) o1 /= o2;
  190. else o1 %= o2;
  191. }
  192. break;
  193. case '+':
  194. if ( (o1 > 0 && o2 > 0 && max_int[sz] - o1 < o2)
  195. || (o1 < 0 && o2 < 0 && min_int[sz] - o1 > o2)
  196. ) overflow(exp);
  197. o1 += o2;
  198. break;
  199. case '-':
  200. if ( (o1 >= 0 && o2 < 0 && max_int[sz] + o2 < o1)
  201. || (o1 < 0 && o2 >= 0 && min_int[sz] + o2 > o1)
  202. ) overflow(exp);
  203. o1 -= o2;
  204. break;
  205. case '<':
  206. o1 = (o1 < o2);
  207. break;
  208. case '>':
  209. o1 = (o1 > o2);
  210. break;
  211. case LESSEQUAL:
  212. o1 = (o1 <= o2);
  213. break;
  214. case GREATEREQUAL:
  215. o1 = (o1 >= o2);
  216. break;
  217. case '=':
  218. o1 = (o1 == o2);
  219. break;
  220. case '#':
  221. o1 = (o1 != o2);
  222. break;
  223. default:
  224. crash("(cstibin)");
  225. }
  226. commonbin(expp);
  227. (*expp)->nd_INT = o1;
  228. CutSize(*expp);
  229. }
  230. cstfbin(expp)
  231. t_node **expp;
  232. {
  233. /* The binary operation in "expp" is performed on the constant
  234. expressions below it, and the result restored in expp.
  235. This version is for REAL expressions.
  236. */
  237. register t_node *exp = *expp;
  238. register struct real *p = exp->nd_LEFT->nd_REAL;
  239. register flt_arith *o1 = &p->r_val;
  240. register flt_arith *o2 = &exp->nd_RIGHT->nd_RVAL;
  241. int compar = 0;
  242. int cmpval = 0;
  243. assert(exp->nd_class == Oper);
  244. assert(exp->nd_LEFT->nd_class == Value);
  245. assert(exp->nd_RIGHT->nd_class == Value);
  246. switch (exp->nd_symb) {
  247. case '*':
  248. flt_mul(o1, o2, o1);
  249. break;
  250. case '/':
  251. flt_div(o1, o2, o1);
  252. break;
  253. case '+':
  254. flt_add(o1, o2, o1);
  255. break;
  256. case '-':
  257. flt_sub(o1, o2, o1);
  258. break;
  259. case '<':
  260. case '>':
  261. case LESSEQUAL:
  262. case GREATEREQUAL:
  263. case '=':
  264. case '#':
  265. compar++;
  266. cmpval = flt_cmp(o1, o2);
  267. switch(exp->nd_symb) {
  268. case '<': cmpval = (cmpval < 0); break;
  269. case '>': cmpval = (cmpval > 0); break;
  270. case LESSEQUAL: cmpval = (cmpval <= 0); break;
  271. case GREATEREQUAL: cmpval = (cmpval >= 0); break;
  272. case '=': cmpval = (cmpval == 0); break;
  273. case '#': cmpval = (cmpval != 0); break;
  274. }
  275. if (exp->nd_RIGHT->nd_RSTR) free(exp->nd_RIGHT->nd_RSTR);
  276. free_real(exp->nd_RIGHT->nd_REAL);
  277. break;
  278. default:
  279. crash("(cstfbin)");
  280. }
  281. switch(flt_status) {
  282. case FLT_OVFL:
  283. node_warning(exp, "floating point overflow on %s",
  284. symbol2str(exp->nd_symb));
  285. break;
  286. case FLT_DIV0:
  287. node_error(exp, "division by 0.0");
  288. break;
  289. }
  290. if (p->r_real) {
  291. free(p->r_real);
  292. p->r_real = 0;
  293. }
  294. if (compar) {
  295. free_real(p);
  296. }
  297. commonbin(expp);
  298. exp = *expp;
  299. if (compar) {
  300. exp->nd_symb = INTEGER;
  301. exp->nd_INT = cmpval;
  302. }
  303. else {
  304. exp->nd_REAL = p;
  305. }
  306. CutSize(exp);
  307. }
  308. cstubin(expp)
  309. t_node **expp;
  310. {
  311. /* The binary operation in "expp" is performed on the constant
  312. expressions below it, and the result restored in
  313. expp.
  314. */
  315. register t_node *exp = *expp;
  316. arith o1 = exp->nd_LEFT->nd_INT;
  317. arith o2 = exp->nd_RIGHT->nd_INT;
  318. register int sz = exp->nd_type->tp_size;
  319. arith tmp1, tmp2;
  320. assert(exp->nd_class == Oper);
  321. assert(exp->nd_LEFT->nd_class == Value);
  322. assert(exp->nd_RIGHT->nd_class == Value);
  323. switch (exp->nd_symb) {
  324. case '*':
  325. if (o1 == 0 || o2 == 0) {
  326. o1 = 0;
  327. break;
  328. }
  329. tmp1 = full_mask[sz];
  330. tmp2 = o2;
  331. divide(&tmp1, &tmp2);
  332. if (! chk_bounds(o1, tmp1, T_CARDINAL)) overflow(exp);
  333. o1 *= o2;
  334. break;
  335. case DIV:
  336. case MOD:
  337. if (o2 == 0) {
  338. node_error(exp, exp->nd_symb == DIV ?
  339. "division by 0" :
  340. "modulo by 0");
  341. return;
  342. }
  343. divide(&o1, &o2);
  344. if (exp->nd_symb == MOD) o1 = o2;
  345. break;
  346. case '+':
  347. if (! chk_bounds(o2, full_mask[sz] - o1, T_CARDINAL)) {
  348. overflow(exp);
  349. }
  350. o1 += o2;
  351. break;
  352. case '-':
  353. if ( exp->nd_type != address_type
  354. && !chk_bounds(o2, o1, T_CARDINAL)
  355. && ( exp->nd_type->tp_fund != T_INTORCARD
  356. || ( exp->nd_type = int_type
  357. , !chk_bounds(min_int[sz], o1 - o2, T_CARDINAL) ) )
  358. ) {
  359. node_warning(exp, W_ORDINARY,
  360. "underflow in constant expression");
  361. }
  362. o1 -= o2;
  363. break;
  364. case '<':
  365. o1 = ! chk_bounds(o2, o1, T_CARDINAL);
  366. break;
  367. case '>':
  368. o1 = ! chk_bounds(o1, o2, T_CARDINAL);
  369. break;
  370. case LESSEQUAL:
  371. o1 = chk_bounds(o1, o2, T_CARDINAL);
  372. break;
  373. case GREATEREQUAL:
  374. o1 = chk_bounds(o2, o1, T_CARDINAL);
  375. break;
  376. case '=':
  377. o1 = (o1 == o2);
  378. break;
  379. case '#':
  380. o1 = (o1 != o2);
  381. break;
  382. case AND:
  383. case '&':
  384. o1 = (o1 && o2);
  385. break;
  386. case OR:
  387. o1 = (o1 || o2);
  388. break;
  389. default:
  390. crash("(cstubin)");
  391. }
  392. commonbin(expp);
  393. exp = *expp;
  394. exp->nd_INT = o1;
  395. if (exp->nd_type == bool_type) exp->nd_symb = INTEGER;
  396. CutSize(exp);
  397. }
  398. cstset(expp)
  399. t_node **expp;
  400. {
  401. extern arith *MkSet();
  402. register t_node *exp = *expp;
  403. register arith *set1, *set2, *set3;
  404. register unsigned int setsize;
  405. register int j;
  406. assert(exp->nd_RIGHT->nd_class == Set);
  407. assert(exp->nd_symb == IN || exp->nd_LEFT->nd_class == Set);
  408. set2 = exp->nd_RIGHT->nd_set;
  409. setsize = (unsigned) (exp->nd_RIGHT->nd_type->tp_size) / (unsigned) word_size;
  410. if (exp->nd_symb == IN) {
  411. /* The setsize must fit in an unsigned, as it is
  412. allocated with Malloc, so we can do the arithmetic
  413. in an unsigned too.
  414. */
  415. unsigned i;
  416. assert(exp->nd_LEFT->nd_class == Value);
  417. exp->nd_LEFT->nd_INT -= exp->nd_RIGHT->nd_type->set_low;
  418. exp = exp->nd_LEFT;
  419. i = exp->nd_INT;
  420. /* Careful here; use exp->nd_LEFT->nd_INT to see if
  421. it falls in the range of the set. Do not use i
  422. for this, as i may be truncated.
  423. */
  424. i = (exp->nd_INT >= 0 &&
  425. exp->nd_INT < setsize * wrd_bits &&
  426. (set2[i / wrd_bits] & (1 << (i % wrd_bits))));
  427. FreeSet(set2);
  428. exp = getnode(Value);
  429. exp->nd_symb = INTEGER;
  430. exp->nd_lineno = (*expp)->nd_lineno;
  431. exp->nd_INT = i;
  432. exp->nd_type = bool_type;
  433. FreeNode(*expp);
  434. *expp = exp;
  435. return;
  436. }
  437. set1 = exp->nd_LEFT->nd_set;
  438. *expp = getnode(Set);
  439. (*expp)->nd_type = exp->nd_type;
  440. (*expp)->nd_lineno = exp->nd_lineno;
  441. switch(exp->nd_symb) {
  442. case '+': /* Set union */
  443. case '-': /* Set difference */
  444. case '*': /* Set intersection */
  445. case '/': /* Symmetric set difference */
  446. (*expp)->nd_set = set3 = MkSet(exp->nd_type->set_sz);
  447. for (j = 0; j < setsize; j++) {
  448. switch(exp->nd_symb) {
  449. case '+':
  450. *set3++ = *set1++ | *set2++;
  451. break;
  452. case '-':
  453. *set3++ = *set1++ & ~*set2++;
  454. break;
  455. case '*':
  456. *set3++ = *set1++ & *set2++;
  457. break;
  458. case '/':
  459. *set3++ = *set1++ ^ *set2++;
  460. break;
  461. }
  462. }
  463. break;
  464. case GREATEREQUAL:
  465. case LESSEQUAL:
  466. case '=':
  467. case '#':
  468. /* Constant set comparisons
  469. */
  470. for (j = 0; j < setsize; j++) {
  471. switch(exp->nd_symb) {
  472. case GREATEREQUAL:
  473. if ((*set1 | *set2++) != *set1) break;
  474. set1++;
  475. continue;
  476. case LESSEQUAL:
  477. if ((*set2 | *set1++) != *set2) break;
  478. set2++;
  479. continue;
  480. case '=':
  481. case '#':
  482. if (*set1++ != *set2++) break;
  483. continue;
  484. }
  485. break;
  486. }
  487. if (j < setsize) {
  488. j = exp->nd_symb == '#';
  489. }
  490. else {
  491. j = exp->nd_symb != '#';
  492. }
  493. *expp = getnode(Value);
  494. (*expp)->nd_symb = INTEGER;
  495. (*expp)->nd_INT = j;
  496. (*expp)->nd_type = bool_type;
  497. (*expp)->nd_lineno = (*expp)->nd_lineno;
  498. break;
  499. default:
  500. crash("(cstset)");
  501. }
  502. FreeSet(exp->nd_LEFT->nd_set);
  503. FreeSet(exp->nd_RIGHT->nd_set);
  504. FreeNode(exp);
  505. }
  506. cstcall(expp, call)
  507. t_node **expp;
  508. {
  509. /* a standard procedure call is found that can be evaluated
  510. compile time, so do so.
  511. */
  512. register t_node *expr;
  513. register t_type *tp;
  514. assert((*expp)->nd_class == Call);
  515. expr = (*expp)->nd_RIGHT->nd_LEFT;
  516. tp = expr->nd_type;
  517. expr->nd_type = (*expp)->nd_type;
  518. (*expp)->nd_RIGHT->nd_LEFT = 0;
  519. FreeNode(*expp);
  520. *expp = expr;
  521. expr->nd_symb = INTEGER;
  522. expr->nd_class = Value;
  523. switch(call) {
  524. case S_ABS:
  525. if (expr->nd_INT < 0) {
  526. if (! options['s'] &&
  527. expr->nd_INT <= min_int[(int)(tp->tp_size)]) {
  528. overflow(expr);
  529. }
  530. expr->nd_INT = - expr->nd_INT;
  531. }
  532. CutSize(expr);
  533. break;
  534. case S_CAP:
  535. if (expr->nd_INT >= 'a' && expr->nd_INT <= 'z') {
  536. expr->nd_INT += ('A' - 'a');
  537. }
  538. break;
  539. case S_HIGH:
  540. case S_MAX:
  541. if (tp->tp_fund == T_INTEGER) {
  542. expr->nd_INT = max_int[(int)(tp->tp_size)];
  543. }
  544. else if (tp->tp_fund == T_CARDINAL) {
  545. expr->nd_INT = full_mask[(int)(tp->tp_size)];
  546. }
  547. else if (tp->tp_fund == T_SUBRANGE) {
  548. expr->nd_INT = tp->sub_ub;
  549. }
  550. else expr->nd_INT = tp->enm_ncst - 1;
  551. break;
  552. case S_MIN:
  553. if (tp->tp_fund == T_INTEGER) {
  554. expr->nd_INT = min_int[(int)(tp->tp_size)];
  555. }
  556. else if (tp->tp_fund == T_SUBRANGE) {
  557. expr->nd_INT = tp->sub_lb;
  558. }
  559. else expr->nd_INT = 0;
  560. break;
  561. case S_ODD:
  562. expr->nd_INT &= 1;
  563. break;
  564. case S_TSIZE:
  565. case S_SIZE:
  566. expr->nd_INT = tp->tp_size;
  567. break;
  568. default:
  569. crash("(cstcall)");
  570. }
  571. }
  572. CutSize(expr)
  573. register t_node *expr;
  574. {
  575. /* The constant value of the expression expr is made to
  576. conform to the size of the type of the expression.
  577. */
  578. register t_type *tp = BaseType(expr->nd_type);
  579. assert(expr->nd_class == Value);
  580. if (tp->tp_fund == T_REAL) return;
  581. if (tp->tp_fund != T_INTEGER) {
  582. expr->nd_INT &= full_mask[(int)(tp->tp_size)];
  583. }
  584. else {
  585. int nbits = (int) (sizeof(arith) - tp->tp_size) * 8;
  586. expr->nd_INT = (expr->nd_INT << nbits) >> nbits;
  587. }
  588. }
  589. InitCst()
  590. {
  591. register int i = 0;
  592. #ifndef NOCROSS
  593. register arith bt = (arith)0;
  594. while (!(bt < 0)) {
  595. i++;
  596. bt = (bt << 8) + 0377;
  597. if (i == MAXSIZE+1)
  598. fatal("array full_mask too small for this machine");
  599. full_mask[i] = bt;
  600. max_int[i] = bt & ~(1L << ((8 * i) - 1));
  601. min_int[i] = - max_int[i];
  602. if (! options['s']) min_int[i]--;
  603. }
  604. if ((int)long_size > sizeof(arith)) {
  605. fatal("sizeof (arith) insufficient on this machine");
  606. }
  607. wrd_bits = 8 * (int) word_size;
  608. #else
  609. if (options['s']) {
  610. for (i = 0; i < sizeof(long); i++) min_int[i] = - max_int[i];
  611. }
  612. #endif
  613. }