lang/pc/comp/cstoper.c

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