123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497 |
- /* 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 */
- #include <stdlib.h>
- #include <string.h>
- #include "debug.h"
- #include "target_sizes.h"
- #include <alloc.h>
- #include <assert.h>
- #include <em_arith.h>
- #include <em_label.h>
- #include "LLlex.h"
- #include "Lpars.h"
- #include "const.h"
- #include "node.h"
- #include "required.h"
- #include "type.h"
- long mach_long_sign; /* sign bit of the machine long */
- long full_mask[MAXSIZE+1];/* full_mask[1] == 0xFF, full_mask[2] == 0xFFFF, .. */
- arith max_int; /* maximum integer on the target machine */
- arith min_int; /* mimimum integer on the target machin */
- char *maxint_str; /* string representation of maximum integer */
- arith wrd_bits; /* number of bits in a word */
- arith max_intset; /* largest value of set of integer */
- overflow(expp)
- struct node *expp;
- {
- node_warning(expp, "overflow in constant expression");
- }
- cstunary(expp)
- register struct node *expp;
- {
- /* The unary operation in "expp" is performed on the constant
- expression below it, and the result restored in expp.
- */
- register arith o1 = expp->nd_right->nd_INT;
- switch( expp->nd_symb ) {
- /* Should not get here
- case '+':
- case '(':
- break;
- */
- case '-':
- o1 = -o1;
- break;
- case NOT:
- o1 = !o1;
- break;
- default:
- crash("(cstunary)");
- }
- expp->nd_class = Value;
- expp->nd_token = expp->nd_right->nd_token;
- expp->nd_INT = o1;
- CutSize(expp);
- FreeNode(expp->nd_right);
- expp->nd_right = NULLNODE;
- }
- cstbin(expp)
- register struct node *expp;
- {
- /* The binary operation in "expp" is performed on the constant
- expressions below it, and the result restored in expp.
- */
- register arith o1, o2;
- register char *s1, *s2;
- int str = expp->nd_left->nd_type->tp_fund & T_STRINGCONST;
- if( str ) {
- o1 = o2 = 0; /* so LINT won't complain */
- s1 = expp->nd_left->nd_STR;
- s2 = expp->nd_right->nd_STR;
- }
- else {
- s1 = s2 = (char *) 0; /* so LINT won't complain */
- o1 = expp->nd_left->nd_INT;
- o2 = expp->nd_right->nd_INT;
- }
- assert(expp->nd_class == Boper);
- assert(expp->nd_left->nd_class == Value);
- assert(expp->nd_right->nd_class == Value);
- switch( expp->nd_symb ) {
- case '+':
- if (o1 > 0 && o2 > 0) {
- if (max_int - o1 < o2) overflow(expp);
- }
- else if (o1 < 0 && o2 < 0) {
- if (min_int - o1 > o2) overflow(expp);
- }
- o1 += o2;
- break;
- case '-':
- if ( o1 >= 0 && o2 < 0) {
- if (max_int + o2 < o1) overflow(expp);
- }
- else if (o1 < 0 && o2 >= 0) {
- if (min_int + o2 > o1) overflow(expp);
- }
- o1 -= o2;
- break;
- case '*':
- if (o1 > 0 && o2 > 0) {
- if (max_int / o1 < o2) overflow(expp);
- }
- else if (o1 < 0 && o2 < 0) {
- if (o1 == min_int || o2 == min_int ||
- max_int / (-o1) < (-o2)) overflow(expp);
- }
- else if (o1 > 0) {
- if (min_int / o1 > o2) overflow(expp);
- }
- else if (o2 > 0) {
- if (min_int / o2 > o1) overflow(expp);
- }
- o1 *= o2;
- break;
- case DIV:
- if( o2 == 0 ) {
- node_error(expp, "division by 0");
- return;
- }
- else o1 /= o2;
- break;
- case MOD:
- if( o2 == 0 ) {
- node_error(expp, "modulo by 0");
- return;
- }
- else
- o1 %= o2;
- break;
- case OR:
- o1 = (o1 || o2);
- break;
- case AND:
- o1 = (o1 && o2);
- break;
- case '=':
- o1 = str ? !strcmp(s1, s2) : (o1 == o2);
- break;
- case NOTEQUAL:
- o1 = str ? (strcmp(s1, s2) != 0) : (o1 != o2);
- break;
- case LESSEQUAL:
- o1 = str ? (strcmp(s1, s2) <= 0) : (o1 <= o2);
- break;
- case GREATEREQUAL:
- o1 = str ? (strcmp(s1, s2) >= 0) : (o1 >= o2);
- break;
- case '<':
- o1 = str ? (strcmp(s1, s2) < 0) : (o1 < o2);
- break;
- case '>':
- o1 = str ? (strcmp(s1, s2) > 0) : (o1 > o2);
- break;
- /* case '/': */
- default:
- crash("(cstbin)");
- }
- expp->nd_class = Value;
- expp->nd_token = expp->nd_right->nd_token;
- /* STRING compare has a bool_type as result */
- if( expp->nd_type == bool_type ) expp->nd_symb = INTEGER;
- expp->nd_INT = o1;
- CutSize(expp);
- FreeNode(expp->nd_left);
- FreeNode(expp->nd_right);
- expp->nd_left = expp->nd_right = NULLNODE;
- }
- cstset(expp)
- register struct node *expp;
- {
- register arith *set1, *set2;
- arith *resultset = (arith *) 0;
- int empty_result = 0;
- register int setsize, j;
- assert(expp->nd_right->nd_class == Set);
- assert(expp->nd_symb == IN || expp->nd_left->nd_class == Set);
- set2 = expp->nd_right->nd_set;
- setsize = (unsigned) (expp->nd_right->nd_type->tp_size) / (unsigned) word_size;
- if( expp->nd_symb == IN ) {
- arith i;
- assert(expp->nd_left->nd_class == Value);
- i = expp->nd_left->nd_INT;
- expp->nd_class = Value;
- expp->nd_symb = INTEGER;
- expp->nd_INT = (i >= 0 && set2 && i < (setsize * wrd_bits) &&
- (set2[i/wrd_bits] & (1 << (i%wrd_bits))));
- if( set2 ) free((char *) set2);
- }
- else {
- set1 = expp->nd_left->nd_set;
- resultset = set1;
- expp->nd_left->nd_set = (arith *) 0;
- switch( expp->nd_symb ) {
- case '+':
- /* Set union
- */
- if( !set1 ) {
- resultset = set2;
- expp->nd_right->nd_set = (arith *) 0;
- break;
- }
- if( set2 )
- for( j = 0; j < setsize; j++ )
- *set1++ |= *set2++;
- break;
- case '-':
- /* Set difference
- */
- if( !set1 || !set2 ) {
- /* The set from which something is substracted
- is already empty, or the set that is
- substracted is empty. In either case, the
- result set is set1.
- */
- break;
- }
- empty_result = 1;
- for( j = 0; j < setsize; j++ )
- if( *set1++ &= ~*set2++ ) empty_result = 0;
- break;
- case '*':
- /* Set intersection
- */
- if( !set1 ) {
- /* set1 is empty, and so is the result set
- */
- break;
- }
- if( !set2 ) {
- /* set 2 is empty, so the result set must be
- empty too.
- */
- resultset = set2;
- expp->nd_right->nd_set = (arith *) 0;
- break;
- }
- empty_result = 1;
- for( j = 0; j < setsize; j++ )
- if( *set1++ &= *set2++ ) empty_result = 0;
- break;
- case '=':
- case NOTEQUAL:
- case LESSEQUAL:
- case GREATEREQUAL:
- /* Constant set comparisons
- */
- if( !setsize ) setsize++; /* force comparison */
- expp->nd_left->nd_set = set1; /* may be disposed of */
- for( j = 0; j < setsize; j++ ) {
- switch( expp->nd_symb ) {
- case '=':
- case NOTEQUAL:
- if( !set1 && !set2 ) {
- j = setsize;
- break;
- }
- if( !set1 || !set2 ) break;
- if( *set1++ != *set2++ ) break;
- continue;
- case LESSEQUAL:
- if( !set1 ) {
- j = setsize;
- break;
- }
- if( !set2 ) break;
- if( (*set2 | *set1++) != *set2 ) break;
- set2++;
- continue;
- case GREATEREQUAL:
- if( !set2 ) {
- j = setsize;
- break;
- }
- if( !set1 ) break;
- if( (*set1 | *set2++) != *set1 ) break;
- set1++;
- continue;
- }
- break;
- }
- if( j < setsize )
- expp->nd_INT = expp->nd_symb == NOTEQUAL;
- else
- expp->nd_INT = expp->nd_symb != NOTEQUAL;
- expp->nd_class = Value;
- expp->nd_symb = INTEGER;
- if( expp->nd_left->nd_set )
- free((char *) expp->nd_left->nd_set);
- if( expp->nd_right->nd_set )
- free((char *) expp->nd_right->nd_set);
- FreeNode(expp->nd_left);
- FreeNode(expp->nd_right);
- expp->nd_left = expp->nd_right = NULLNODE;
- return;
- default:
- crash("(cstset)");
- }
- if( expp->nd_right->nd_set )
- free((char *) expp->nd_right->nd_set);
- if( expp->nd_left->nd_set )
- free((char *) expp->nd_left->nd_set);
- if( empty_result ) {
- free((char *) resultset);
- resultset = (arith *) 0;
- }
- expp->nd_class = Set;
- expp->nd_set = resultset;
- }
- FreeNode(expp->nd_left);
- FreeNode(expp->nd_right);
- expp->nd_left = expp->nd_right = NULLNODE;
- }
- cstcall(expp, req)
- register struct node *expp;
- {
- /* a standard procedure call is found that can be evaluated
- compile time, so do so.
- */
- register struct node *expr = NULLNODE;
- assert(expp->nd_class == Call);
- expr = expp->nd_right->nd_left;
- expp->nd_class = Value;
- expp->nd_symb = INTEGER;
- switch( req ) {
- case R_ABS:
- if( expr->nd_INT < 0 ) {
- if (expr->nd_INT <= min_int) {
- overflow(expr);
- }
- expp->nd_INT = - expr->nd_INT;
- }
- else expp->nd_INT = expr->nd_INT;
- CutSize(expp);
- break;
- case R_SQR:
- if (expr->nd_INT < 0) {
- if ( expr->nd_INT == min_int ||
- max_int / expr->nd_INT > expr->nd_INT) {
- overflow(expr);
- }
- }
- else if (max_int / expr->nd_INT < expr->nd_INT) {
- overflow(expr);
- }
- expp->nd_INT = expr->nd_INT * expr->nd_INT;
- CutSize(expp);
- break;
- case R_ORD:
- case R_CHR:
- expp->nd_INT = expr->nd_INT;
- CutSize(expp);
- break;
- case R_ODD:
- expp->nd_INT = (expr->nd_INT & 1);
- break;
- case R_SUCC:
- expp->nd_INT = expr->nd_INT + 1;
- if( /* Check overflow of subranges or enumerations */
- (expp->nd_type->tp_fund & T_SUBRANGE &&
- expp->nd_INT > expp->nd_type->sub_ub
- )
- ||
- ( expp->nd_type->tp_fund & T_ENUMERATION &&
- expp->nd_INT >= expp->nd_type->enm_ncst
- )
- )
- node_warning(expp, "\"succ\": no successor");
- else CutSize(expp);
- break;
- case R_PRED:
- expp->nd_INT = expr->nd_INT - 1;
- if( /* Check with lowerbound of subranges or enumerations */
- (expp->nd_type->tp_fund & T_SUBRANGE &&
- expp->nd_INT < expp->nd_type->sub_lb
- )
- ||
- ( expp->nd_type->tp_fund & T_ENUMERATION &&
- expp->nd_INT < 0
- )
- )
- node_warning(expp, "\"pred\": no predecessor");
- else CutSize(expp);
- break;
- default:
- crash("(cstcall)");
- }
- FreeNode(expp->nd_left);
- FreeNode(expp->nd_right);
- expp->nd_right = expp->nd_left = NULLNODE;
- }
- CutSize(expr)
- register struct node *expr;
- {
- /* The constant value of the expression expr is made to conform
- * to the size of the type of the expression
- */
- register arith o1 = expr->nd_INT;
- register struct type *tp = BaseType(expr->nd_type);
- int size = tp->tp_size;
- long remainder = o1 & ~full_mask[size];
- assert(expr->nd_class == Value);
- if( tp->tp_fund & T_CHAR ) {
- if( o1 & (~full_mask[size] >> 1) ) {
- node_warning(expr, "overflow in character value");
- o1 &= 0177;
- }
- }
- else if( remainder != 0 && remainder != ~full_mask[size] ||
- (o1 & full_mask[size]) == 1 << (size * 8 - 1) ) {
- /* integers in [-maxint .. maxint] */
- int nbits = (int) (sizeof(long) - size) * 8;
- /* overflow(expr); */
- /* sign bit of o1 in sign bit of mach_long */
- o1 <<= nbits;
- /* shift back to get sign extension */
- o1 >>= nbits;
- }
- expr->nd_INT = o1;
- }
- InitCst()
- {
- extern char *long2str(), *Salloc();
- register int i = 0;
- register arith bt = (arith)0;
- while( !(bt < 0) ) {
- bt = (bt << 8) + 0377;
- i++;
- if( i == MAXSIZE + 1 )
- fatal("array full_mask too small for this machine");
- full_mask[i] = bt;
- }
- mach_long_sign = 1L << (sizeof(long) * 8 - 1);
- if( int_size > sizeof(long) )
- fatal("sizeof (long) insufficient on this machine");
- max_int = full_mask[int_size] & ~(1L << (int_size * 8 - 1));
- min_int = - max_int;
- maxint_str = long2str(max_int, 10);
- maxint_str = Salloc(maxint_str, (unsigned int) strlen(maxint_str));
- wrd_bits = 8 * (int) word_size;
- if( !max_intset ) max_intset = wrd_bits - 1;
- }
|