cstoper.c 9.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448
  1. /* 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 */
  2. #include "debug.h"
  3. #include "target_sizes.h"
  4. #include <alloc.h>
  5. #include <assert.h>
  6. #include <em_arith.h>
  7. #include <em_label.h>
  8. #include "LLlex.h"
  9. #include "Lpars.h"
  10. #include "const.h"
  11. #include "node.h"
  12. #include "required.h"
  13. #include "type.h"
  14. long mach_long_sign; /* sign bit of the machine long */
  15. int mach_long_size; /* size of long on this machine == sizeof(long) */
  16. long full_mask[MAXSIZE+1];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
  17. arith max_int; /* maximum integer on target machine */
  18. char *maxint_str; /* string representation of maximum integer */
  19. arith wrd_bits; /* number of bits in a word */
  20. arith max_intset; /* largest value of set of integer */
  21. cstunary(expp)
  22. register struct node *expp;
  23. {
  24. /* The unary operation in "expp" is performed on the constant
  25. expression below it, and the result restored in expp.
  26. */
  27. register arith o1 = expp->nd_right->nd_INT;
  28. switch( expp->nd_symb ) {
  29. /* Should not get here
  30. case '+':
  31. case '(':
  32. break;
  33. */
  34. case '-':
  35. o1 = -o1;
  36. break;
  37. case NOT:
  38. o1 = !o1;
  39. break;
  40. default:
  41. crash("(cstunary)");
  42. }
  43. expp->nd_class = Value;
  44. expp->nd_token = expp->nd_right->nd_token;
  45. expp->nd_INT = o1;
  46. CutSize(expp);
  47. FreeNode(expp->nd_right);
  48. expp->nd_right = NULLNODE;
  49. }
  50. cstbin(expp)
  51. register struct node *expp;
  52. {
  53. /* The binary operation in "expp" is performed on the constant
  54. expressions below it, and the result restored in expp.
  55. */
  56. register arith o1, o2;
  57. register char *s1, *s2;
  58. int str = expp->nd_left->nd_type->tp_fund & T_STRING;
  59. if( str ) {
  60. s1 = expp->nd_left->nd_STR;
  61. s2 = expp->nd_right->nd_STR;
  62. }
  63. else {
  64. o1 = expp->nd_left->nd_INT;
  65. o2 = expp->nd_right->nd_INT;
  66. }
  67. assert(expp->nd_class == Boper);
  68. assert(expp->nd_left->nd_class == Value);
  69. assert(expp->nd_right->nd_class == Value);
  70. switch( expp->nd_symb ) {
  71. case '+':
  72. o1 += o2;
  73. break;
  74. case '-':
  75. o1 -= o2;
  76. break;
  77. case '*':
  78. o1 *= o2;
  79. break;
  80. case DIV:
  81. if( o2 == 0 ) {
  82. node_error(expp, "division by 0");
  83. return;
  84. }
  85. else o1 /= o2;
  86. break;
  87. case MOD:
  88. if( o2 == 0 ) {
  89. node_error(expp, "modulo by 0");
  90. return;
  91. }
  92. else
  93. o1 %= o2;
  94. break;
  95. case OR:
  96. o1 = (o1 || o2);
  97. break;
  98. case AND:
  99. o1 = (o1 && o2);
  100. break;
  101. case '=':
  102. o1 = str ? !strcmp(s1, s2) : (o1 == o2);
  103. break;
  104. case NOTEQUAL:
  105. o1 = str ? (strcmp(s1, s2) != 0) : (o1 != o2);
  106. break;
  107. case LESSEQUAL:
  108. o1 = str ? (strcmp(s1, s2) <= 0) : (o1 <= o2);
  109. break;
  110. case GREATEREQUAL:
  111. o1 = str ? (strcmp(s1, s2) >= 0) : (o1 >= o2);
  112. break;
  113. case '<':
  114. o1 = str ? (strcmp(s1, s2) < 0) : (o1 < o2);
  115. break;
  116. case '>':
  117. o1 = str ? (strcmp(s1, s2) > 0) : (o1 > o2);
  118. break;
  119. /* case '/': */
  120. default:
  121. crash("(cstbin)");
  122. }
  123. expp->nd_class = Value;
  124. expp->nd_token = expp->nd_right->nd_token;
  125. /* STRING compare has a bool_type as result */
  126. if( expp->nd_type == bool_type ) expp->nd_symb = INTEGER;
  127. expp->nd_INT = o1;
  128. CutSize(expp);
  129. FreeNode(expp->nd_left);
  130. FreeNode(expp->nd_right);
  131. expp->nd_left = expp->nd_right = NULLNODE;
  132. }
  133. cstset(expp)
  134. register struct node *expp;
  135. {
  136. register arith *set1, *set2;
  137. arith *resultset = (arith *) 0;
  138. int empty_result = 0;
  139. register int setsize, j;
  140. assert(expp->nd_right->nd_class == Set);
  141. assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
  142. set2 = expp->nd_right->nd_set;
  143. setsize = expp->nd_right->nd_type->tp_size / word_size;
  144. if( expp->nd_symb == IN ) {
  145. arith i;
  146. assert(expp->nd_left->nd_class == Value);
  147. i = expp->nd_left->nd_INT;
  148. expp->nd_class = Value;
  149. expp->nd_symb = INTEGER;
  150. expp->nd_INT = (i >= 0 && set2 && i < (setsize * wrd_bits) &&
  151. (set2[i/wrd_bits] & (1 << (i%wrd_bits))));
  152. if( set2 ) free((char *) set2);
  153. }
  154. else {
  155. set1 = expp->nd_left->nd_set;
  156. resultset = set1;
  157. expp->nd_left->nd_set = (arith *) 0;
  158. switch( expp->nd_symb ) {
  159. case '+':
  160. /* Set union
  161. */
  162. if( !set1 ) {
  163. resultset = set2;
  164. expp->nd_right->nd_set = (arith *) 0;
  165. break;
  166. }
  167. if( set2 )
  168. for( j = 0; j < setsize; j++ )
  169. *set1++ |= *set2++;
  170. break;
  171. case '-':
  172. /* Set difference
  173. */
  174. if( !set1 || !set2 ) {
  175. /* The set from which something is substracted
  176. is already empty, or the set that is
  177. substracted is empty. In either case, the
  178. result set is set1.
  179. */
  180. break;
  181. }
  182. empty_result = 1;
  183. for( j = 0; j < setsize; j++ )
  184. if( *set1++ &= ~*set2++ ) empty_result = 0;
  185. break;
  186. case '*':
  187. /* Set intersection
  188. */
  189. if( !set1 ) {
  190. /* set1 is empty, and so is the result set
  191. */
  192. break;
  193. }
  194. if( !set2 ) {
  195. /* set 2 is empty, so the result set must be
  196. empty too.
  197. */
  198. resultset = set2;
  199. expp->nd_right->nd_set = (arith *) 0;
  200. break;
  201. }
  202. empty_result = 1;
  203. for( j = 0; j < setsize; j++ )
  204. if( *set1++ &= *set2++ ) empty_result = 0;
  205. break;
  206. case '=':
  207. case NOTEQUAL:
  208. case LESSEQUAL:
  209. case GREATEREQUAL:
  210. /* Constant set comparisons
  211. */
  212. if( !setsize ) setsize++; /* force comparison */
  213. expp->nd_left->nd_set = set1; /* may be disposed of */
  214. for( j = 0; j < setsize; j++ ) {
  215. switch( expp->nd_symb ) {
  216. case '=':
  217. case NOTEQUAL:
  218. if( !set1 && !set2 ) {
  219. j = setsize;
  220. break;
  221. }
  222. if( !set1 || !set2 ) break;
  223. if( *set1++ != *set2++ ) break;
  224. continue;
  225. case LESSEQUAL:
  226. if( !set1 ) {
  227. j = setsize;
  228. break;
  229. }
  230. if( !set2 ) break;
  231. if( (*set2 | *set1++) != *set2 ) break;
  232. set2++;
  233. continue;
  234. case GREATEREQUAL:
  235. if( !set2 ) {
  236. j = setsize;
  237. break;
  238. }
  239. if( !set1 ) break;
  240. if( (*set1 | *set2++) != *set1 ) break;
  241. set1++;
  242. continue;
  243. }
  244. break;
  245. }
  246. if( j < setsize )
  247. expp->nd_INT = expp->nd_symb == NOTEQUAL;
  248. else
  249. expp->nd_INT = expp->nd_symb != NOTEQUAL;
  250. expp->nd_class = Value;
  251. expp->nd_symb = INTEGER;
  252. if( expp->nd_left->nd_set )
  253. free((char *) expp->nd_left->nd_set);
  254. if( expp->nd_right->nd_set )
  255. free((char *) expp->nd_right->nd_set);
  256. FreeNode(expp->nd_left);
  257. FreeNode(expp->nd_right);
  258. expp->nd_left = expp->nd_right = NULLNODE;
  259. return;
  260. default:
  261. crash("(cstset)");
  262. }
  263. if( expp->nd_right->nd_set )
  264. free((char *) expp->nd_right->nd_set);
  265. if( expp->nd_left->nd_set )
  266. free((char *) expp->nd_left->nd_set);
  267. if( empty_result ) {
  268. free((char *) resultset);
  269. resultset = (arith *) 0;
  270. }
  271. expp->nd_class = Set;
  272. expp->nd_set = resultset;
  273. }
  274. FreeNode(expp->nd_left);
  275. FreeNode(expp->nd_right);
  276. expp->nd_left = expp->nd_right = NULLNODE;
  277. }
  278. cstcall(expp, req)
  279. register struct node *expp;
  280. {
  281. /* a standard procedure call is found that can be evaluated
  282. compile time, so do so.
  283. */
  284. register struct node *expr = NULLNODE;
  285. assert(expp->nd_class == Call);
  286. expr = expp->nd_right->nd_left;
  287. expp->nd_class = Value;
  288. expp->nd_symb = INTEGER;
  289. switch( req ) {
  290. case R_ABS:
  291. if( expr->nd_INT < 0 ) expp->nd_INT = - expr->nd_INT;
  292. else expp->nd_INT = expr->nd_INT;
  293. CutSize(expp);
  294. break;
  295. case R_SQR:
  296. expp->nd_INT = expr->nd_INT * expr->nd_INT;
  297. CutSize(expp);
  298. break;
  299. case R_ORD:
  300. case R_CHR:
  301. expp->nd_INT = expr->nd_INT;
  302. CutSize(expp);
  303. break;
  304. case R_ODD:
  305. expp->nd_INT = (expr->nd_INT & 1);
  306. break;
  307. case R_SUCC:
  308. expp->nd_INT = expr->nd_INT + 1;
  309. if( /* Check overflow of subranges or enumerations */
  310. (expp->nd_type->tp_fund & T_SUBRANGE &&
  311. expp->nd_INT > expp->nd_type->sub_ub
  312. )
  313. ||
  314. ( expp->nd_type->tp_fund & T_ENUMERATION &&
  315. expp->nd_INT >= expp->nd_type->enm_ncst
  316. )
  317. )
  318. node_warning(expp, "\"succ\": no successor");
  319. else CutSize(expp);
  320. break;
  321. case R_PRED:
  322. expp->nd_INT = expr->nd_INT - 1;
  323. if( /* Check with lowerbound of subranges or enumerations */
  324. (expp->nd_type->tp_fund & T_SUBRANGE &&
  325. expp->nd_INT < expp->nd_type->sub_lb
  326. )
  327. ||
  328. ( expp->nd_type->tp_fund & T_ENUMERATION &&
  329. expp->nd_INT < 0
  330. )
  331. )
  332. node_warning(expp, "\"pred\": no predecessor");
  333. else CutSize(expp);
  334. break;
  335. default:
  336. crash("(cstcall)");
  337. }
  338. FreeNode(expp->nd_left);
  339. FreeNode(expp->nd_right);
  340. expp->nd_right = expp->nd_left = NULLNODE;
  341. }
  342. CutSize(expr)
  343. register struct node *expr;
  344. {
  345. /* The constant value of the expression expr is made to conform
  346. * to the size of the type of the expression
  347. */
  348. register arith o1 = expr->nd_INT;
  349. register struct type *tp = BaseType(expr->nd_type);
  350. int size = tp->tp_size;
  351. long remainder = o1 & ~full_mask[size];
  352. assert(expr->nd_class == Value);
  353. if( tp->tp_fund & T_CHAR ) {
  354. if( o1 & (~full_mask[size] >> 1) ) {
  355. node_warning(expr, "overflow in character value");
  356. o1 &= 0177;
  357. }
  358. }
  359. else if( remainder != 0 && remainder != ~full_mask[size] ||
  360. (o1 & full_mask[size]) == 1 << (size * 8 - 1) ) {
  361. /* integers in [-maxint .. maxint] */
  362. int nbits = (int) (mach_long_size - size) * 8;
  363. node_warning(expr, "overflow in constant expression");
  364. /* sign bit of o1 in sign bit of mach_long */
  365. o1 <<= nbits;
  366. /* shift back to get sign extension */
  367. o1 >>= nbits;
  368. }
  369. expr->nd_INT = o1;
  370. }
  371. InitCst()
  372. {
  373. extern char *long2str(), *Salloc();
  374. register int i = 0;
  375. register arith bt = (arith)0;
  376. while( !(bt < 0) ) {
  377. bt = (bt << 8) + 0377;
  378. i++;
  379. if( i == MAXSIZE + 1 )
  380. fatal("array full_mask too small for this machine");
  381. full_mask[i] = bt;
  382. }
  383. mach_long_size = i;
  384. mach_long_sign = 1 << (mach_long_size * 8 - 1);
  385. if( int_size > mach_long_size )
  386. fatal("sizeof (long) insufficient on this machine");
  387. max_int = full_mask[int_size] & ~(1 << (int_size * 8 - 1));
  388. maxint_str = long2str(max_int, 10);
  389. maxint_str = Salloc(maxint_str, (unsigned int) strlen(maxint_str));
  390. wrd_bits = 8 * word_size;
  391. if( !max_intset ) max_intset = wrd_bits - 1;
  392. }