util/grind/expr.c

   1 /* $Id: expr.c,v 1.18 1994/06/24 10:59:46 ceriel Exp $ */
   2
   3 /* This file contains the expression evaluator. It exports the following
   4    routines:
   5    - int eval_cond(p_tree p)
   6         This routine evaluates the conditional expression indicated by p
   7         and returns 1 if it evaluates to TRUE, or 0 if it could not be
   8         evaluated for some reason or if it evalutes to FALSE.
   9         If the expression cannot be evaluated, an error message is given.
  10    - int eval_desig(p_tree p, t_addr *paddr, long **psize, p_type *ptp)
  11         This routine evaluates the expression indicated by p, which should
  12         result in a designator. The result of the expression is an address
  13         which is to be found in *paddr. *psize will contain the size of the
  14         designated object, and *ptp its type.
  15         If the expression cannot be evaluated or does not result in a
  16         designator, 0 is returned and an error message is given.
  17         Otherwise, 1 is returned.
  18    - int eval_expr(p_tree p, char **pbuf, long **psize, p_type *ptp)
  19         This routine evaluates the expression indicated by p.
  20         The result of the expression is left in *pbuf.
  21         *psize will contain the size of the value, and *ptp its type.
  22         If the expression cannot be evaluated, 0 is returned and an error
  23         message is given.  Otherwise, 1 is returned.
  24    - int convert(char **pbuf, long *psize, p_type *ptp, p_type tp, long size)
  25         This routine tries to convert the value in pbuf of size psize
  26         and type ptp to type tp with size size. It returns 0 if this fails,
  27         while producing an error message. Otherwise, it returns 1 and
  28         the resulting value, type and size are left in pbuf, ptp, and
  29         psize, respectively.
  30    - long get_int(char *buf, long size, int class)
  31         Returns the value of size 'size', residing in 'buf', of 'class'
  32         T_INTEGER, T_UNSIGNED, or T_ENUM.
  33    - int put_int(char *buf, long size, long value)
  34         Stores the value 'value' of size 'size' in 'buf'.
  35    - double get_real(char *buf, long size)
  36         Returns the real value of size 'size', residing in 'buf'.
  37         T_INTEGER, T_UNSIGNED, or T_ENUM.
  38    - int put_real(char *buf, long size, double value)
  39         Stores the value 'value' of size 'size' in 'buf'.
  40 */
  41
  42 #include <stdio.h>
  43 #include <alloc.h>
  44 #include <assert.h>
  45
  46 #include "position.h"
  47 #include "operator.h"
  48 #include "tree.h"
  49 #include "expr.h"
  50 #include "symbol.h"
  51 #include "type.h"
  52 #include "langdep.h"
  53 #include "scope.h"
  54 #include "idf.h"
  55 #include "misc.h"
  56
  57 extern FILE     *db_out;
  58 extern int      stack_offset;
  59 extern char     *strcpy();
  60 extern t_addr   *get_EM_regs();
  61 extern char     *memcpy();
  62 extern char     *malloc(), *realloc();
  63
  64 #define malloc_succeeded(p)     if (! (p)) {\
  65                                         error("could not allocate enough memory");\
  66                                         return 0;\
  67                                 }
  68
  69 /* static t_addr        get_addr(p_symbol sym; long *psize);
  70    Get the address of the object indicated by sym. Returns 0 on failure,
  71    address on success. *psize will contain size of object.
  72    For local variables or parameters, the 'stack_offset' variable is
  73    used to determine from which stack frame the search must start.
  74 */
  75 static t_addr
  76 get_addr(sym, psize)
  77   register p_symbol     sym;
  78   long                  *psize;
  79 {
  80   p_type        tp = sym->sy_type;
  81   long          size = tp->ty_size;
  82   t_addr        *EM_regs;
  83   int           i;
  84   p_scope       sc, symsc;
  85
  86   *psize = size;
  87   switch(sym->sy_class) {
  88   case VAR:
  89         /* exists if child exists; nm_value contains addres */
  90         return (t_addr) sym->sy_name.nm_value;
  91   case VARPAR:
  92   case LOCVAR:
  93         /* first find the stack frame in which it resides */
  94         symsc = base_scope(sym->sy_scope);
  95
  96         /* now symsc contains the scope where the storage for sym is
  97            allocated. Now find it on the stack of child.
  98         */
  99         i = stack_offset;
 100         for (;;) {
 101                 sc = 0;
 102                 if (! (EM_regs = get_EM_regs(i++))) {
 103                         return 0;
 104                 }
 105                 if (! EM_regs[1]) {
 106                         error("%s not available", sym->sy_idf->id_text);
 107                         return 0;
 108                 }
 109                 sc = base_scope(get_scope_from_addr(EM_regs[2]));
 110                 if (! sc || sc->sc_start > EM_regs[2]) {
 111                         error("%s not available", sym->sy_idf->id_text);
 112                         sc = 0;
 113                         return 0;
 114                 }
 115                 if (sc == symsc) break;         /* found it */
 116         }
 117
 118         if (sym->sy_class == LOCVAR) {
 119                 /* Either local variable or value parameter */
 120                 return EM_regs[sym->sy_name.nm_value < 0 ? 0 : 1] +
 121                                   (t_addr) sym->sy_name.nm_value;
 122         }
 123
 124         /* If we get here, we have a var parameter. Get the parameters
 125            of the current procedure invocation.
 126         */
 127         {
 128                 p_type proctype = sc->sc_definedby->sy_type;
 129                 t_addr a;
 130                 char *AB;
 131
 132                 size = proctype->ty_nbparams;
 133                 if (has_static_link(sc)) size += pointer_size;
 134                 AB = malloc((unsigned) size);
 135                 if (! AB) {
 136                         error("could not allocate enough memory");
 137                         break;
 138                 }
 139                 if (! get_bytes(size, EM_regs[1], AB)) {
 140                         break;
 141                 }
 142                 if ((size = tp->ty_size) == 0) {
 143                         size = compute_size(tp, AB);
 144                         *psize = size;
 145                 }
 146                 a = (t_addr) get_int(AB+sym->sy_name.nm_value, pointer_size, T_UNSIGNED);
 147                 free(AB);
 148                 return a;
 149         }
 150   default:
 151         error("%s is not a variable", sym->sy_idf->id_text);
 152         break;
 153   }
 154   return 0;
 155 }
 156
 157 static int
 158 get_v(a, pbuf, size)
 159   t_addr        a;
 160   char          **pbuf;
 161   long          size;
 162 {
 163   if (a) {
 164         *pbuf = malloc((unsigned) size);
 165         if (! *pbuf) {
 166                 error("could not allocate enough memory");
 167                 return 0;
 168         }
 169         if (! get_bytes(size, a, *pbuf)) return 0;
 170         return 1;
 171   }
 172   return 0;
 173 }
 174
 175 /* static int   get_value(p_symbol sym; char **pbuf; long *psize);
 176    Get the value of the symbol indicated by sym.  Return 0 on failure,
 177    1 on success. On success, 'pbuf' contains the value, and 'psize' contains
 178    the size. For 'pbuf', storage is allocated by malloc; this storage must
 179    be freed by caller (I don't like this any more than you do, but caller
 180    does not know sizes).
 181    For local variables or parameters, the 'stack_offset' variable is
 182    used to determine from which stack frame the search must start.
 183 */
 184 static int
 185 get_value(sym, pbuf, psize)
 186   register p_symbol     sym;
 187   char  **pbuf;
 188   long  *psize;
 189 {
 190   p_type        tp = sym->sy_type;
 191   int           retval = 0;
 192   t_addr        a;
 193   long          size = tp->ty_size;
 194
 195   *pbuf = 0;
 196   switch(sym->sy_class) {
 197   case CONST:
 198         *pbuf = malloc((unsigned) size);
 199         if (! *pbuf) {
 200                 error("could not allocate enough memory");
 201                 break;
 202         }
 203         switch(tp->ty_class) {
 204         case T_REAL:
 205                 put_real(*pbuf, size, sym->sy_const.co_rval);
 206                 break;
 207         case T_INTEGER:
 208         case T_SUBRANGE:
 209         case T_UNSIGNED:
 210         case T_ENUM:
 211                 put_int(*pbuf, size, sym->sy_const.co_ival);
 212                 break;
 213         case T_SET:
 214                 memcpy(*pbuf, sym->sy_const.co_setval, (int) size);
 215                 break;
 216         case T_STRING:
 217                 memcpy(*pbuf, sym->sy_const.co_sval, (int) size);
 218                 break;
 219         default:
 220                 fatal("strange constant");
 221         }
 222         retval = 1;
 223         break;
 224   case VAR:
 225   case VARPAR:
 226   case LOCVAR:
 227         a = get_addr(sym, psize);
 228         retval = get_v(a, pbuf, *psize);
 229         size = *psize;
 230         break;
 231   case UBOUND:
 232         a = get_addr(sym->sy_descr, psize);
 233         retval = get_v(a, pbuf, *psize);
 234         if (! retval) break;
 235         size = get_int(*pbuf, *psize, T_INTEGER);
 236         retval = get_v(a+*psize, pbuf, *psize);
 237         if (! retval) break;
 238         size += get_int(*pbuf, *psize, T_INTEGER);
 239         put_int(*pbuf, *psize, size);
 240         size = *psize;
 241         break;
 242   case LBOUND:
 243         a = get_addr(sym->sy_descr, psize);
 244         retval = get_v(a, pbuf, *psize);
 245         break;
 246   }
 247
 248   if (retval == 0) {
 249         if (*pbuf) free(*pbuf);
 250         *pbuf = 0;
 251         *psize = 0;
 252   }
 253   else *psize = size;
 254
 255   return retval;
 256 }
 257
 258 /* buffer to integer and vice versa routines */
 259
 260 long
 261 get_int(buf, size, class)
 262   char  *buf;
 263   long  size;
 264   int   class;
 265 {
 266   register long l;
 267
 268   switch((int)size) {
 269   case sizeof(char):
 270         l = *buf;
 271         if (class == T_INTEGER && l >= 0x7F) l -= 256;
 272         else if (class != T_INTEGER && l < 0) l += 256;
 273         break;
 274   case sizeof(short):
 275         l = *((short *) buf);
 276         if (class == T_INTEGER && l >= 0x7FFF) l -= 65536;
 277         else if (class != T_INTEGER && l < 0) l += 65536;
 278         break;
 279   default:
 280         l = *((long *) buf);
 281   }
 282   return l;
 283 }
 284
 285 put_int(buf, size, value)
 286   char  *buf;
 287   long  size;
 288   long  value;
 289 {
 290   switch((int)size) {
 291   case sizeof(char):
 292         *buf = value;
 293         break;
 294   case sizeof(short):
 295         *((short *) buf) = value;
 296         break;
 297   default:
 298         *((long *) buf) = value;
 299         break;
 300   }
 301   /*NOTREACHED*/
 302 }
 303
 304 /* buffer to real and vice versa routines */
 305
 306 double
 307 get_real(buf, size)
 308   char  *buf;
 309   long  size;
 310 {
 311   switch((int) size) {
 312   case sizeof(float):
 313         return *((float *) buf);
 314   default:
 315         return *((double *) buf);
 316   }
 317   /*NOTREACHED*/
 318 }
 319
 320 put_real(buf, size, value)
 321   char  *buf;
 322   long  size;
 323   double value;
 324 {
 325   switch((int)size) {
 326   case sizeof(float):
 327         *((float *) buf) = value;
 328         break;
 329   default:
 330         *((double *) buf) = value;
 331         break;
 332   }
 333   /* NOTREACHED */
 334 }
 335
 336 int
 337 convert(pbuf, psize, ptp, tp, size)
 338   char  **pbuf;
 339   long  *psize;
 340   register p_type *ptp;
 341   register p_type tp;
 342   long size;
 343 {
 344   /* Convert the value in pbuf, of size psize and type ptp, to type
 345      tp and leave the resulting value in pbuf, the resulting size
 346      in psize, and the resulting type in ptp.
 347   */
 348   long  l;
 349   double d;
 350
 351   if (*ptp == tp) return 1;
 352   if (size > *psize) {
 353         *pbuf = realloc(*pbuf, (unsigned int) size);
 354         malloc_succeeded(*pbuf);
 355   }
 356   if ((*ptp)->ty_class == T_SUBRANGE) *ptp = (*ptp)->ty_base;
 357   if (tp && *ptp) switch((*ptp)->ty_class) {
 358   case T_INTEGER:
 359   case T_UNSIGNED:
 360   case T_POINTER:
 361   case T_ENUM:
 362         l = get_int(*pbuf, *psize, (*ptp)->ty_class);
 363         if (tp == bool_type) l = l != 0;
 364         switch(tp->ty_class) {
 365         case T_SUBRANGE:
 366         case T_INTEGER:
 367         case T_UNSIGNED:
 368         case T_POINTER:
 369         case T_ENUM:
 370                 put_int(*pbuf, size, l);
 371                 *psize = size;
 372                 *ptp = tp;
 373                 return 1;
 374         case T_REAL:
 375                 put_real(*pbuf,
 376                          size,
 377                          (*ptp)->ty_class == T_INTEGER
 378                                 ? (double) l
 379                                 : (double) (unsigned long) l);
 380                 *psize = size;
 381                 *ptp = tp;
 382                 return 1;
 383         default:
 384                 break;
 385         }
 386         break;
 387   case T_REAL:
 388         d = get_real(*pbuf, *psize);
 389         switch(tp->ty_class) {
 390         case T_ENUM:
 391         case T_SUBRANGE:
 392         case T_INTEGER:
 393         case T_UNSIGNED:
 394         case T_POINTER:
 395                 if (tp == bool_type) put_int(*pbuf, size, (long) (d != 0));
 396                 else put_int(*pbuf, size, (long) d);
 397                 *psize = size;
 398                 *ptp = tp;
 399                 return 1;
 400         case T_REAL:
 401                 put_real(*pbuf, size, d);
 402                 *psize = size;
 403                 *ptp = tp;
 404                 return 1;
 405         default:
 406                 break;
 407         }
 408         break;
 409   default:
 410         break;
 411   }
 412   error("illegal conversion");
 413   return 0;
 414 }
 415
 416 int
 417 eval_cond(p)
 418   p_tree        p;
 419 {
 420   char  *buf;
 421   long  size;
 422   p_type tp;
 423   long val;
 424   p_type target_tp = currlang->has_bool_type ? bool_type : int_type;
 425
 426   if (eval_expr(p, &buf, &size, &tp)) {
 427         if (convert(&buf, &size, &tp, target_tp, target_tp->ty_size)) {
 428                 val = get_int(buf, size, T_UNSIGNED);
 429                 free(buf);
 430                 return (int) (val != 0);
 431         }
 432         free(buf);
 433   }
 434   return 0;
 435 }
 436
 437 /* one routine for each unary operator */
 438
 439 static int
 440 not_op(p, pbuf, psize, ptp)
 441   p_tree        p;
 442   char          **pbuf;
 443   long          *psize;
 444   p_type        *ptp;
 445 {
 446   p_type target_tp = currlang->has_bool_type ? bool_type : int_type;
 447
 448   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
 449       convert(pbuf, psize, ptp, target_tp, target_tp->ty_size)) {
 450         put_int(*pbuf, *psize, (long) !get_int(*pbuf, *psize, T_UNSIGNED));
 451         return 1;
 452   }
 453   return 0;
 454 }
 455
 456 static int
 457 bnot_op(p, pbuf, psize, ptp)
 458   p_tree        p;
 459   char          **pbuf;
 460   long          *psize;
 461   p_type        *ptp;
 462 {
 463   if (eval_expr(p->t_args[0], pbuf, psize, ptp)) {
 464         switch((*ptp)->ty_class) {
 465         case T_INTEGER:
 466         case T_ENUM:
 467         case T_UNSIGNED:
 468         case T_SUBRANGE:
 469                 put_int(*pbuf, *psize, ~get_int(*pbuf, *psize, T_UNSIGNED));
 470                 return 1;
 471         default:
 472                 error("illegal operand type(s)");
 473                 break;
 474         }
 475   }
 476   return 0;
 477 }
 478
 479 static int
 480 ptr_addr(p, paddr, psize, ptp)
 481   p_tree        p;
 482   t_addr        *paddr;
 483   long          *psize;
 484   p_type        *ptp;
 485 {
 486   char  *buf;
 487
 488   if (eval_expr(p->t_args[0], &buf, psize, ptp)) {
 489         switch((*ptp)->ty_class) {
 490         case T_POINTER:
 491                 *ptp = (*ptp)->ty_ptrto;
 492                 *psize = (*ptp)->ty_size;
 493                 *paddr = get_int(buf, pointer_size, T_UNSIGNED);
 494                 free(buf);
 495                 return 1;
 496         default:
 497                 error("illegal operand of DEREF");
 498                 free(buf);
 499                 break;
 500         }
 501   }
 502   return 0;
 503 }
 504
 505 static int
 506 deref_op(p, pbuf, psize, ptp)
 507   p_tree        p;
 508   char          **pbuf;
 509   long          *psize;
 510   p_type        *ptp;
 511 {
 512   t_addr addr;
 513
 514   if (ptr_addr(p, &addr, psize, ptp)) {
 515         *pbuf = malloc((unsigned) *psize);
 516         malloc_succeeded(*pbuf);
 517         if (! get_bytes(*psize, addr, *pbuf)) {
 518                 free(*pbuf);
 519                 *pbuf = 0;
 520                 return 0;
 521         }
 522         return 1;
 523   }
 524   return 0;
 525 }
 526
 527 static int
 528 addr_op(p, pbuf, psize, ptp)
 529   p_tree        p;
 530   char          **pbuf;
 531   long          *psize;
 532   p_type        *ptp;
 533 {
 534   t_addr addr;
 535
 536   if (eval_desig(p->t_args[0], &addr, psize, ptp)) {
 537         *pbuf = malloc((unsigned) pointer_size);
 538         malloc_succeeded(*pbuf);
 539         put_int(*pbuf, pointer_size, (long) addr);
 540         address_type->ty_ptrto = *ptp;
 541         *ptp = address_type;
 542         return 1;
 543   }
 544   return 0;
 545 }
 546
 547 static int
 548 unmin_op(p, pbuf, psize, ptp)
 549   p_tree        p;
 550   char          **pbuf;
 551   long          *psize;
 552   p_type        *ptp;
 553 {
 554   if (eval_expr(p->t_args[0], pbuf, psize, ptp)) {
 555         switch((*ptp)->ty_class) {
 556         case T_SUBRANGE:
 557         case T_INTEGER:
 558         case T_ENUM:
 559         case T_UNSIGNED:
 560                 put_int(*pbuf, *psize, -get_int(*pbuf, *psize, (*ptp)->ty_class));
 561                 return 1;
 562         case T_REAL:
 563                 put_real(*pbuf, *psize, -get_real(*pbuf, *psize));
 564                 return 1;
 565         default:
 566                 error("illegal operand of unary -");
 567                 break;
 568         }
 569   }
 570   return 0;
 571 }
 572
 573 static int
 574 unplus_op(p, pbuf, psize, ptp)
 575   p_tree        p;
 576   char          **pbuf;
 577   long          *psize;
 578   p_type        *ptp;
 579 {
 580   if (eval_expr(p->t_args[0], pbuf, psize, ptp)) {
 581         switch((*ptp)->ty_class) {
 582         case T_SUBRANGE:
 583         case T_INTEGER:
 584         case T_ENUM:
 585         case T_UNSIGNED:
 586         case T_REAL:
 587                 return 1;
 588         default:
 589                 error("illegal operand of unary +");
 590                 break;
 591         }
 592   }
 593   return 0;
 594 }
 595
 596 static int (*un_op[])() = {
 597   0,
 598   not_op,
 599   deref_op,
 600   0,
 601   0,
 602   0,
 603   0,
 604   0,
 605   0,
 606   0,
 607   0,
 608   unplus_op,
 609   unmin_op,
 610   0,
 611   0,
 612   0,
 613   0,
 614   0,
 615   0,
 616   0,
 617   0,
 618   0,
 619   0,
 620   0,
 621   bnot_op,
 622   0,
 623   0,
 624   0,
 625   addr_op
 626 };
 627
 628 static p_type
 629 balance(tp1, tp2)
 630   p_type        tp1, tp2;
 631 {
 632
 633   if (tp1->ty_class == T_SUBRANGE) tp1 = tp1->ty_base;
 634   if (tp2->ty_class == T_SUBRANGE) tp2 = tp2->ty_base;
 635   if (tp1 == tp2) return tp2;
 636   if (tp2->ty_class == T_REAL) {
 637         p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
 638   }
 639   if (tp1->ty_class == T_REAL) {
 640         switch(tp2->ty_class) {
 641         case T_INTEGER:
 642         case T_UNSIGNED:
 643         case T_ENUM:
 644                 return tp1;
 645         case T_REAL:
 646                 return tp1->ty_size > tp2->ty_size ? tp1 : tp2;
 647         default:
 648                 error("illegal type combination");
 649                 return 0;
 650         }
 651   }
 652   if (tp2->ty_class == T_POINTER) {
 653         p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
 654   }
 655   if (tp1->ty_class == T_POINTER) {
 656         switch(tp2->ty_class) {
 657         case T_INTEGER:
 658         case T_UNSIGNED:
 659         case T_POINTER:
 660         case T_ENUM:
 661                 return tp1;
 662         default:
 663                 error("illegal type combination");
 664                 return 0;
 665         }
 666   }
 667   if (tp2->ty_class == T_UNSIGNED) {
 668         p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
 669   }
 670   if (tp1->ty_class == T_UNSIGNED) {
 671         switch(tp2->ty_class) {
 672         case T_INTEGER:
 673         case T_UNSIGNED:
 674                 if (tp1->ty_size >= tp2->ty_size) return tp1;
 675                 return tp2;
 676         case T_ENUM:
 677                 return tp1;
 678         default:
 679                 error("illegal type combination");
 680                 return 0;
 681         }
 682   }
 683   if (tp2->ty_class == T_INTEGER) {
 684         p_type tmp = tp1; tp1 = tp2; tp2 = tmp;
 685   }
 686   if (tp1->ty_class == T_INTEGER) {
 687         switch(tp2->ty_class) {
 688         case T_INTEGER:
 689                 if (tp1->ty_size >= tp2->ty_size) return tp1;
 690                 return tp2;
 691         case T_ENUM:
 692                 return tp1;
 693         default:
 694                 error("illegal type combination");
 695                 return 0;
 696         }
 697   }
 698   error("illegal type combination");
 699   return 0;
 700 }
 701
 702 static int
 703 andor_op(p, pbuf, psize, ptp)
 704   p_tree        p;
 705   char          **pbuf;
 706   long          *psize;
 707   p_type        *ptp;
 708 {
 709   long          l1, l2;
 710   char          *buf = 0;
 711   long          size;
 712   p_type        tp;
 713   p_type        target_tp = currlang->has_bool_type ? bool_type : int_type;
 714
 715   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
 716       convert(pbuf, psize, ptp, target_tp, target_tp->ty_size) &&
 717       eval_expr(p->t_args[1], &buf, &size, &tp) &&
 718       convert(&buf, &size, &tp, target_tp, target_tp->ty_size)) {
 719         l1 = get_int(*pbuf, *psize, T_UNSIGNED);
 720         l2 = get_int(buf, size, T_UNSIGNED);
 721         put_int(*pbuf,
 722                 *psize,
 723                 p->t_whichoper == E_AND
 724                         ? (long)(l1 && l2)
 725                         : (long)(l1 || l2));
 726         free(buf);
 727         return 1;
 728   }
 729   if (buf) free(buf);
 730   return 0;
 731 }
 732
 733 static int
 734 arith_op(p, pbuf, psize, ptp)
 735   p_tree        p;
 736   char          **pbuf;
 737   long          *psize;
 738   p_type        *ptp;
 739 {
 740   long          l1, l2;
 741   double        d1, d2;
 742   char          *buf = 0;
 743   long          size;
 744   p_type        tp, balance_tp;
 745
 746   if (!(eval_expr(p->t_args[0], pbuf, psize, ptp) &&
 747         eval_expr(p->t_args[1], &buf, &size, &tp))) {
 748         return 0;
 749   }
 750   if ((*ptp)->ty_class == T_POINTER) {
 751         if (currlang != c_dep ||
 752             (p->t_whichoper != E_PLUS && p->t_whichoper != E_MIN)) {
 753                 error("illegal operand type(s)");
 754                 free(buf);
 755                 return 0;
 756         }
 757         l1 = get_int(*pbuf, *psize, T_UNSIGNED);
 758         if (tp->ty_class == T_POINTER) {
 759                 if (p->t_whichoper != E_MIN) {
 760                         error("illegal operand type(s)");
 761                         free(buf);
 762                         return 0;
 763                 }
 764                 l2 = get_int(buf, size, T_UNSIGNED);
 765                 free(buf);
 766                 *pbuf = Realloc(*pbuf, (unsigned) long_size);
 767                 put_int(*pbuf, long_size, (l1 - l2)/(*ptp)->ty_ptrto->ty_size);
 768                 *ptp = long_type;
 769                 return 1;
 770         }
 771         if (! convert(&buf, &size, &tp, long_type, long_size)) {
 772                 free(buf);
 773                 return 0;
 774         }
 775         l2 = get_int(buf, size, T_INTEGER) * (*ptp)->ty_ptrto->ty_size;
 776         free(buf);
 777         buf = 0;
 778         if (p->t_whichoper == E_PLUS) l1 += l2;
 779         else l1 -= l2;
 780         put_int(*pbuf, *psize, l1);
 781         return 1;
 782   }
 783   if ((balance_tp = balance(*ptp, tp)) &&
 784       convert(pbuf, psize, ptp, balance_tp, balance_tp->ty_size) &&
 785       convert(&buf, &size, &tp, balance_tp, balance_tp->ty_size)) {
 786         switch(balance_tp->ty_class) {
 787         case T_INTEGER:
 788         case T_ENUM:
 789         case T_UNSIGNED:
 790                 l1 = get_int(*pbuf, *psize, balance_tp->ty_class);
 791                 l2 = get_int(buf, size, balance_tp->ty_class);
 792                 free(buf);
 793                 buf = 0;
 794                 switch(p->t_whichoper) {
 795                 case E_BAND:
 796                         l1 &= l2;
 797                         break;
 798                 case E_BOR:
 799                         l1 |= l2;
 800                         break;
 801                 case E_BXOR:
 802                         l1 ^= l2;
 803                         break;
 804                 case E_PLUS:
 805                         l1 += l2;
 806                         break;
 807                 case E_MIN:
 808                         l1 -= l2;
 809                         break;
 810                 case E_MUL:
 811                         l1 *= l2;
 812                         break;
 813                 case E_DIV:
 814                 case E_ZDIV:
 815                         if (! l2) {
 816                                 error("division by 0");
 817                                 return 0;
 818                         }
 819                         if (balance_tp->ty_class == T_INTEGER) {
 820                                 if ((l1 < 0) != (l2 < 0)) {
 821                                         if (l1 < 0) l1 = - l1;
 822                                         else l2 = -l2;
 823                                         if (p->t_whichoper == E_DIV) {
 824                                             l1 = -((l1+l2-1)/l2);
 825                                         }
 826                                         else {
 827                                             l1 = -(l1/l2);
 828                                         }
 829                                 }
 830                                 else l1 /= l2;
 831                         }
 832                         else l1 = (unsigned long) l1 /
 833                                   (unsigned long) l2;
 834                         break;
 835                 case E_MOD:
 836                 case E_ZMOD:
 837                         if (! l2) {
 838                                 error("modulo by 0");
 839                                 return 0;
 840                         }
 841                         if (balance_tp->ty_class == T_INTEGER) {
 842                                 if ((l1 < 0) != (l2 < 0)) {
 843                                         if (l1 < 0) l1 = - l1;
 844                                         else l2 = -l2;
 845                                         if (p->t_whichoper == E_MOD) {
 846                                             l1 = ((l1+l2-1)/l2)*l2 - l1;
 847                                         }
 848                                         else {
 849                                             l1 = (l1/l2)*l2 - l1;
 850                                         }
 851                                 }
 852                                 else l1 %= l2;
 853                         }
 854                         else l1 = (unsigned long) l1 %
 855                                   (unsigned long) l2;
 856                         break;
 857                 }
 858                 put_int(*pbuf, *psize, l1);
 859                 break;
 860         case T_REAL:
 861                 d1 = get_real(*pbuf, *psize);
 862                 d2 = get_real(buf, size);
 863                 free(buf);
 864                 buf = 0;
 865                 switch(p->t_whichoper) {
 866                 case E_DIV:
 867                 case E_ZDIV:
 868                         if (d2 == 0.0) {
 869                                 error("division by 0.0");
 870                                 return 0;
 871                         }
 872                         d1 /= d2;
 873                         break;
 874                 case E_PLUS:
 875                         d1 += d2;
 876                         break;
 877                 case E_MIN:
 878                         d1 -= d2;
 879                         break;
 880                 case E_MUL:
 881                         d1 *= d2;
 882                         break;
 883                 }
 884                 put_real(*pbuf, *psize, d1);
 885                 break;
 886         default:
 887                 error("illegal operand type(s)");
 888                 free(buf);
 889                 return 0;
 890         }
 891         return 1;
 892   }
 893   if (buf) free(buf);
 894   return 0;
 895 }
 896
 897 static int
 898 sft_op(p, pbuf, psize, ptp)
 899   p_tree        p;
 900   char          **pbuf;
 901   long          *psize;
 902   p_type        *ptp;
 903 {
 904   long          l1, l2;
 905   char          *buf = 0;
 906   long          size;
 907   p_type        tp;
 908
 909   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
 910       eval_expr(p->t_args[1], &buf, &size, &tp) &&
 911       convert(&buf, &size, &tp, int_type, int_size)) {
 912         tp = *ptp;
 913         if (tp->ty_class == T_SUBRANGE) {
 914                 tp = tp->ty_base;
 915         }
 916         switch(tp->ty_class) {
 917         case T_INTEGER:
 918         case T_ENUM:
 919         case T_UNSIGNED:
 920                 l1 = get_int(*pbuf, *psize, tp->ty_class);
 921                 l2 = get_int(buf, size, T_INTEGER);
 922                 free(buf);
 923                 buf = 0;
 924                 switch(p->t_whichoper) {
 925                 case E_LSFT:
 926                         l1 <<= (int) l2;
 927                         break;
 928                 case E_RSFT:
 929                         if (tp->ty_class == T_INTEGER) l1 >>= (int) l2;
 930                         else l1 = (unsigned long) l1 >> (int) l2;
 931                         break;
 932                 }
 933                 break;
 934         default:
 935                 error("illegal operand type(s)");
 936                 free(buf);
 937                 return 0;
 938         }
 939         return 1;
 940   }
 941   if (buf) free(buf);
 942   return 0;
 943 }
 944
 945 static int
 946 cmp_op(p, pbuf, psize, ptp)
 947   p_tree        p;
 948   char          **pbuf;
 949   long          *psize;
 950   p_type        *ptp;
 951 {
 952   long          l1, l2;
 953   double        d1, d2;
 954   char          *buf = 0;
 955   long          size;
 956   p_type        tp, balance_tp;
 957
 958   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
 959       eval_expr(p->t_args[1], &buf, &size, &tp) &&
 960       (balance_tp = balance(*ptp, tp)) &&
 961       convert(pbuf, psize, ptp, balance_tp, balance_tp->ty_size) &&
 962       convert(&buf, &size, &tp, balance_tp, balance_tp->ty_size)) {
 963         switch(balance_tp->ty_class) {
 964         case T_INTEGER:
 965         case T_ENUM:
 966         case T_UNSIGNED:
 967         case T_POINTER:
 968                 l1 = get_int(*pbuf, *psize, balance_tp->ty_class);
 969                 l2 = get_int(buf, size, balance_tp->ty_class);
 970                 free(buf);
 971                 buf = 0;
 972                 switch(p->t_whichoper) {
 973                 case E_EQUAL:
 974                         l1 = l1 == l2;
 975                         break;
 976                 case E_NOTEQUAL:
 977                         l1 = l1 != l2;
 978                         break;
 979                 case E_LTEQUAL:
 980                         if (balance_tp->ty_class == T_INTEGER) {
 981                                 l1 = l1 <= l2;
 982                         }
 983                         else    l1 = (unsigned long) l1 <=
 984                                      (unsigned long) l2;
 985                         break;
 986                 case E_LT:
 987                         if (balance_tp->ty_class == T_INTEGER) {
 988                                 l1 = l1 < l2;
 989                         }
 990                         else    l1 = (unsigned long) l1 <
 991                                      (unsigned long) l2;
 992                         break;
 993                 case E_GTEQUAL:
 994                         if (balance_tp->ty_class == T_INTEGER) {
 995                                 l1 = l1 >= l2;
 996                         }
 997                         else    l1 = (unsigned long) l1 >=
 998                                      (unsigned long) l2;
 999                         break;
1000                 case E_GT:
1001                         if (balance_tp->ty_class == T_INTEGER) {
1002                                 l1 = l1 > l2;
1003                         }
1004                         else    l1 = (unsigned long) l1 >
1005                                      (unsigned long) l2;
1006                         break;
1007                 default:
1008                         l1 = 0;
1009                         assert(0);
1010                         break;
1011                 }
1012                 break;
1013         case T_REAL:
1014                 d1 = get_real(*pbuf, *psize);
1015                 d2 = get_real(buf, size);
1016                 free(buf);
1017                 buf = 0;
1018                 switch(p->t_whichoper) {
1019                 case E_EQUAL:
1020                         l1 = d1 == d2;
1021                         break;
1022                 case E_NOTEQUAL:
1023                         l1 = d1 != d2;
1024                         break;
1025                 case E_LTEQUAL:
1026                         l1 = d1 <= d2;
1027                         break;
1028                 case E_LT:
1029                         l1 = d1 < d2;
1030                         break;
1031                 case E_GTEQUAL:
1032                         l1 = d1 >= d2;
1033                         break;
1034                 case E_GT:
1035                         l1 = d1 > d2;
1036                         break;
1037                 default:
1038                         l1 = 0;
1039                         assert(0);
1040                         break;
1041                 }
1042                 break;
1043         default:
1044                 error("illegal operand type(s)");
1045                 free(buf);
1046                 return 0;
1047         }
1048         if (*psize < int_size) {
1049                 *psize = int_size;
1050                 *pbuf = realloc(*pbuf, (unsigned int) int_size);
1051                 malloc_succeeded(*pbuf);
1052         }
1053         else    *psize = int_size;
1054         if (currlang->has_bool_type) {
1055                 *ptp = bool_type;
1056         }
1057         else    *ptp = int_type;
1058         put_int(*pbuf, *psize, l1);
1059         return 1;
1060   }
1061   if (buf) free(buf);
1062   return 0;
1063 }
1064
1065 static int
1066 in_op(p, pbuf, psize, ptp)
1067   p_tree        p;
1068   char          **pbuf;
1069   long          *psize;
1070   p_type        *ptp;
1071 {
1072   long          l;
1073   char          *buf = 0;
1074   long          size;
1075   p_type        tp;
1076   int           sft = int_size == 2 ? 4 : 5;
1077
1078   if (eval_expr(p->t_args[0], pbuf, psize, ptp) &&
1079       eval_expr(p->t_args[1], &buf, &size, &tp)) {
1080         if (tp->ty_class != T_SET) {
1081                 error("right-hand side of IN not a set");
1082                 free(buf);
1083                 return 0;
1084         }
1085         if (! convert(pbuf, psize, ptp, tp->ty_setbase, int_size)) {
1086                 free(buf);
1087                 return 0;
1088         }
1089         l = get_int(*pbuf, *psize, (*ptp)->ty_class) - tp->ty_setlow;
1090         l = l >= 0
1091             && l <= (size << 3)
1092             && (((int *) buf)[(int)(l>>sft)] & (1 << (l & ((1 << sft)-1))));
1093         free(buf);
1094         *pbuf = realloc(*pbuf, (unsigned) int_size);
1095         malloc_succeeded(*pbuf);
1096         *psize = int_size;
1097         *ptp = currlang->has_bool_type ? bool_type : int_type;
1098         put_int(*pbuf, *psize, l);
1099         return 1;
1100   }
1101   return 0;
1102 }
1103
1104 static int
1105 array_addr(p, paddr, psize, ptp)
1106   p_tree        p;
1107   t_addr        *paddr;
1108   long          *psize;
1109   p_type        *ptp;
1110 {
1111   long          l;
1112   char          *buf = 0;
1113   long          size;
1114   p_type        tp;
1115
1116   if (eval_desig(p->t_args[0], paddr, psize, ptp) &&
1117       eval_expr(p->t_args[1], &buf, &size, &tp)) {
1118         if ((*ptp)->ty_class != T_ARRAY && (*ptp)->ty_class != T_POINTER) {
1119                 error("illegal left-hand side of [");
1120                 free(buf);
1121                 return 0;
1122         }
1123         if ((*ptp)->ty_class == T_POINTER) {
1124                 if (! get_bytes(pointer_size, *paddr, (char *) paddr)) {
1125                         free(buf);
1126                         return 0;
1127                 }
1128                 *paddr = get_int((char *) paddr, pointer_size, T_UNSIGNED);
1129         }
1130         if (! convert(&buf, &size, &tp, int_type, int_size)) {
1131                 free(buf);
1132                 return 0;
1133         }
1134         l = get_int(buf, size, T_INTEGER);
1135         free(buf);
1136         buf = 0;
1137         if ((*ptp)->ty_class == T_ARRAY) {
1138                 if (l < (*ptp)->ty_lb || l > (*ptp)->ty_hb) {
1139                         error("array bound error");
1140                         return 0;
1141                 }
1142                 l -= (*ptp)->ty_lb;
1143                 *ptp = (*ptp)->ty_elements;
1144                 l *= (*currlang->arrayelsize)((*ptp)->ty_size);
1145         }
1146         else {
1147                 *ptp = (*ptp)->ty_ptrto;
1148                 l *= (*ptp)->ty_size;
1149         }
1150         *psize = (*ptp)->ty_size;
1151         *paddr += l;
1152         return 1;
1153   }
1154   return 0;
1155 }
1156
1157 static int
1158 array_op(p, pbuf, psize, ptp)
1159   p_tree        p;
1160   char          **pbuf;
1161   long          *psize;
1162   p_type        *ptp;
1163 {
1164   t_addr        a;
1165
1166   if (array_addr(p, &a, psize, ptp)) {
1167         *pbuf = malloc((unsigned int) *psize);
1168         malloc_succeeded(*pbuf);
1169         if (! get_bytes(*psize, a, *pbuf)) {
1170                 return 0;
1171         }
1172         return 1;
1173   }
1174   return 0;
1175 }
1176
1177 static int
1178 select_addr(p, paddr, psize, ptp)
1179   p_tree        p;
1180   t_addr        *paddr;
1181   long          *psize;
1182   p_type        *ptp;
1183 {
1184   register p_type       tp;
1185   register struct fields *f;
1186   register int          nf;
1187
1188   if (eval_desig(p->t_args[0], paddr, psize, ptp)) {
1189         tp = *ptp;
1190         if (tp->ty_class != T_STRUCT && tp->ty_class != T_UNION) {
1191                 error("SELECT on non-struct");
1192                 return 0;
1193         }
1194         if (p->t_args[1]->t_oper != OP_NAME) {
1195                 error("right-hand side of SELECT not a name");
1196                 return 0;
1197         }
1198         for (nf = tp->ty_nfields, f = tp->ty_fields; nf; nf--, f++) {
1199                 if (! strcmp(f->fld_name, p->t_args[1]->t_str)) break;
1200         }
1201         if (! nf) {
1202                 error("'%s' not found", p->t_args[1]->t_str);
1203                 return 0;
1204         }
1205
1206         /* ??? this needs some work for bitfields ??? */
1207         *paddr += f->fld_pos>>3;
1208         *psize = f->fld_bitsize >> 3;
1209         *ptp = f->fld_type;
1210         return 1;
1211   }
1212   return 0;
1213 }
1214
1215 static int
1216 select_op(p, pbuf, psize, ptp)
1217   p_tree        p;
1218   char          **pbuf;
1219   long          *psize;
1220   p_type        *ptp;
1221 {
1222   t_addr        a;
1223   if (select_addr(p, &a, psize, ptp)) {
1224         *pbuf = malloc((unsigned int) *psize);
1225         malloc_succeeded(*pbuf);
1226         if (! get_bytes(*psize, a, *pbuf)) {
1227                 free(*pbuf);
1228                 *pbuf = 0;
1229                 return 0;
1230         }
1231         return 1;
1232   }
1233   return 0;
1234 }
1235
1236 static int
1237 derselect_op(p, pbuf, psize, ptp)
1238   p_tree        p;
1239   char          **pbuf;
1240   long          *psize;
1241   p_type        *ptp;
1242 {
1243   int   retval;
1244   t_tree        t;
1245
1246   t.t_oper = OP_UNOP;
1247   t.t_whichoper = E_DEREF;
1248   t.t_args[0] = p->t_args[0];
1249   p->t_args[0] = &t;
1250   p->t_whichoper = E_SELECT;
1251   retval = eval_expr(p, pbuf, psize, ptp);
1252   p->t_args[0] = t.t_args[0];
1253   p->t_whichoper = E_DERSELECT;
1254   return retval;
1255 }
1256
1257 static int (*bin_op[])() = {
1258   0,
1259   0,
1260   0,
1261   andor_op,
1262   andor_op,
1263   arith_op,
1264   arith_op,
1265   arith_op,
1266   arith_op,
1267   in_op,
1268   array_op,
1269   arith_op,
1270   arith_op,
1271   arith_op,
1272   cmp_op,
1273   cmp_op,
1274   cmp_op,
1275   cmp_op,
1276   cmp_op,
1277   cmp_op,
1278   select_op,
1279   arith_op,
1280   arith_op,
1281   arith_op,
1282   0,
1283   derselect_op,
1284   sft_op,
1285   sft_op,
1286   0
1287 };
1288
1289 int
1290 eval_expr(p, pbuf, psize, ptp)
1291   p_tree        p;
1292   char          **pbuf;
1293   long          *psize;
1294   p_type        *ptp;
1295 {
1296   register p_symbol     sym;
1297   int           retval = 0;
1298
1299   *pbuf = 0;
1300
1301   switch(p->t_oper) {
1302   case OP_FORMAT:
1303         if (eval_expr(p->t_args[0], pbuf, psize, ptp)) retval = 1;
1304         break;
1305   case OP_NAME:
1306   case OP_SELECT:
1307         sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR|CONST|LBOUND|UBOUND);
1308         if (! sym) return 0;
1309         if (! get_value(sym, pbuf, psize)) {
1310                 break;
1311         }
1312         *ptp = sym->sy_type;
1313         retval = 1;
1314         break;
1315
1316   case OP_INTEGER:
1317         *pbuf = malloc((unsigned int) long_size);
1318         malloc_succeeded(*pbuf);
1319         *psize = long_size;
1320         *ptp = long_type;
1321         put_int(*pbuf, long_size, p->t_ival);
1322         retval = 1;
1323         break;
1324
1325   case OP_REAL:
1326         *pbuf = malloc((unsigned int) double_size);
1327         malloc_succeeded(*pbuf);
1328         *psize = double_size;
1329         *ptp = double_type;
1330         put_real(*pbuf, double_size, p->t_fval);
1331         retval = 1;
1332         break;
1333
1334   case OP_STRING:
1335         *psize = strlen(p->t_sval)+1;
1336         *pbuf = malloc((unsigned int)*psize);
1337         malloc_succeeded(*pbuf);
1338         *ptp = string_type;
1339         strcpy(*pbuf, p->t_sval);
1340         retval = 1;
1341         break;
1342
1343   case OP_UNOP:
1344         retval = (*un_op[p->t_whichoper])(p, pbuf, psize, ptp);
1345         break;
1346
1347   case OP_BINOP:
1348         retval = (*bin_op[p->t_whichoper])(p, pbuf, psize, ptp);
1349         break;
1350   default:
1351         assert(0);
1352         break;
1353   }
1354   if (! retval) {
1355         if (*pbuf) {
1356                 free(*pbuf);
1357                 *pbuf = 0;
1358         }
1359         *psize = 0;
1360   }
1361   else {
1362         if ((*ptp)->ty_class == T_CROSS) {
1363                 *ptp = (*ptp)->ty_cross;
1364                 if (! *ptp) *ptp = void_type;
1365         }
1366   }
1367   return retval;
1368 }
1369
1370 int
1371 eval_desig(p, paddr, psize, ptp)
1372   p_tree        p;
1373   t_addr        *paddr;
1374   long          *psize;
1375   p_type        *ptp;
1376 {
1377   register p_symbol     sym;
1378   int   retval = 0;
1379   t_addr a;
1380
1381   switch(p->t_oper) {
1382   case OP_NAME:
1383   case OP_SELECT:
1384         sym = identify(p, VAR|REGVAR|LOCVAR|VARPAR);
1385         if (! sym) return 0;
1386         if (! (a = get_addr(sym, psize))) {
1387                 break;
1388         }
1389         *paddr = a;
1390         *ptp = sym->sy_type;
1391         retval = 1;
1392         break;
1393
1394   case OP_UNOP:
1395         switch(p->t_whichoper) {
1396         case E_DEREF:
1397                 if (ptr_addr(p, paddr, psize, ptp)) {
1398                         retval = 1;
1399                 }
1400                 break;
1401         default:
1402                 print_node(db_out, p, 0);
1403                 fputs(" not a designator\n", db_out);
1404                 break;
1405         }
1406         break;
1407
1408   case OP_BINOP:
1409         switch(p->t_whichoper) {
1410         case E_ARRAY:
1411                 if (array_addr(p, paddr, psize, ptp)) {
1412                         retval = 1;
1413                 }
1414                 break;
1415         case E_SELECT:
1416                 if (select_addr(p, paddr, psize, ptp)) {
1417                         retval = 1;
1418                 }
1419                 break;
1420         default:
1421                 print_node(db_out, p, 0);
1422                 fputs(" not a designator\n", db_out);
1423                 break;
1424         }
1425         break;
1426   default:
1427         error("illegal designator");
1428         break;
1429   }
1430   if (! retval) {
1431         *psize = 0;
1432   }
1433   else {
1434         if ((*ptp)->ty_class == T_CROSS) {
1435                 *ptp = (*ptp)->ty_cross;
1436                 if (! *ptp) {
1437                         *ptp = void_type;
1438                         print_node(db_out, p, 0);
1439                         fputs(" designator has unknown type\n", db_out);
1440                         retval = 0;
1441                         *psize = 0;
1442                 }
1443         }
1444   }
1445   return retval;
1446 }