lang/basic/src/eval.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  */
   5
   6 #include "bem.h"
   7
   8 #ifndef NORSCID
   9 static char rcs_id[] = "$Id: eval.c,v 1.2 1994/06/24 11:30:39 ceriel Exp $" ;
  10 #endif
  11
  12
  13 /* Here you find all routines to evaluate expressions and
  14    generate code for assignment statements
  15 */
  16
  17 exprtype(ltype,rtype)
  18 int     ltype,rtype;
  19 {
  20         /* determine the result type of an expression */
  21         if ( ltype==STRINGTYPE || rtype==STRINGTYPE)
  22         {
  23                 if ( ltype!=rtype)
  24                         error("type conflict, string expected");
  25                 return( STRINGTYPE);
  26         }
  27         /* take maximum */
  28         if ( ltype<rtype) return(rtype);
  29         return(ltype);
  30 }
  31
  32
  33
  34 conversion(oldtype,newtype)
  35 int oldtype,newtype;
  36 {
  37         /* the value on top of the stack should be converted */
  38         if ( oldtype==newtype) return;
  39
  40         switch( oldtype)
  41         {
  42         case INTTYPE:
  43                 if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
  44                 {
  45                         C_loc((arith)BEMINTSIZE);
  46                         C_loc((arith)BEMFLTSIZE);
  47                         C_cif ();
  48                 } else {
  49                         if (debug)
  50                                 print("type n=%d o=%d\n",newtype,oldtype);
  51                         error("conversion error");
  52                 }
  53                 break;
  54         case FLOATTYPE:
  55         case DOUBLETYPE:
  56                 if ( newtype==INTTYPE)
  57                 {
  58                         /* rounded ! */
  59                         C_cal("_cint");
  60                         C_asp((arith)BEMFLTSIZE);
  61                         C_lfr((arith)BEMINTSIZE);
  62                         break;
  63                 } else if ( newtype==FLOATTYPE || newtype==DOUBLETYPE)
  64                         break;
  65         default:
  66                 if (debug)
  67                         print("type n=%d o=%d\n",newtype,oldtype);
  68                 error("conversion error");
  69         }
  70 }
  71
  72
  73
  74 extraconvert(oldtype,newtype,topstack)
  75 int oldtype,newtype,topstack;
  76 {
  77         /* the value below the top of the stack should be converted */
  78         if ( oldtype==newtype ) return;
  79         if ( debug) print("extra convert %d %d %d\n",oldtype,newtype,topstack);
  80         /* save top in dummy */
  81
  82         switch( topstack)
  83         {
  84         case INTTYPE:
  85                 C_ste_dnam("dummy1",(arith)0);
  86                 break;
  87         case FLOATTYPE:
  88         case DOUBLETYPE:
  89                 /* rounded ! */
  90                 C_lae_dnam("dummy1",(arith)0);
  91                 C_sti((arith)BEMFLTSIZE);
  92                 break;
  93         default:
  94                 error("conversion error");
  95                 return;
  96         }
  97         /* now its on top of the stack */
  98
  99         conversion(oldtype,newtype);
 100         /* restore top */
 101
 102         switch( topstack)
 103         {
 104         case INTTYPE:
 105                 C_loe_dnam("dummy1",(arith)0);
 106                 break;
 107         case FLOATTYPE:
 108         case DOUBLETYPE:
 109                 /* rounded ! */
 110                 C_lae_dnam("dummy1",(arith)0);
 111                 C_loi((arith)BEMFLTSIZE);
 112         }
 113 }
 114
 115
 116
 117 boolop(ltype,rtype,operator)
 118 int     ltype,rtype,operator;
 119 {
 120         if ( operator != NOTSYM)
 121         {
 122                 extraconvert(ltype,INTTYPE,rtype);
 123                 conversion(rtype,INTTYPE);
 124         } else conversion(ltype,INTTYPE);
 125
 126         switch( operator)
 127         {
 128         case NOTSYM:
 129                 C_com((arith)BEMINTSIZE);
 130                 break;
 131         case ANDSYM:
 132                 C_and((arith)BEMINTSIZE);
 133                 break;
 134         case ORSYM:
 135                 C_ior((arith)BEMINTSIZE);
 136                 break;
 137         case XORSYM:
 138                 C_xor((arith)BEMINTSIZE);
 139                 break;
 140         case EQVSYM:
 141                 C_xor((arith)BEMINTSIZE);
 142                 C_com((arith)BEMINTSIZE);
 143                 break;
 144         case IMPSYM:
 145                 /* implies */
 146                 C_com((arith)BEMINTSIZE);
 147                 C_and((arith)BEMINTSIZE);
 148                 C_com((arith)BEMINTSIZE);
 149                 break;
 150         default:
 151                 error("boolop:unexpected");
 152         }
 153
 154         return(INTTYPE);
 155 }
 156
 157
 158
 159 genbool(operator)
 160 int operator;
 161 {
 162         int l1,l2;
 163
 164         l1= genlabel();
 165         l2= genlabel();
 166
 167         switch(operator)
 168         {
 169                 case '<':       C_zlt((label)l1); break;
 170                 case '>':       C_zgt((label)l1); break;
 171                 case '=':       C_zeq((label)l1); break;
 172                 case NESYM:     C_zne((label)l1); break;
 173                 case LESYM:     C_zle((label)l1); break;
 174                 case GESYM:     C_zge((label)l1); break;
 175                 default:        error("relop:unexpected operator");
 176         }
 177
 178         C_loc((arith)0);
 179         C_bra((label)l2);
 180         C_df_ilb((label)l1);
 181         C_loc((arith)-1);
 182         C_df_ilb((label)l2);
 183 }
 184
 185
 186
 187 relop( ltype,rtype,operator)
 188 int     ltype,rtype,operator;
 189 {
 190         int     result;
 191
 192         if (debug) print("relop %d %d op=%d\n",ltype,rtype,operator);
 193         result= exprtype(ltype,rtype);
 194         extraconvert(ltype,result,rtype);
 195         conversion(rtype,result);
 196         /* compare the objects */
 197         if ( result==INTTYPE)
 198                 C_cmi((arith)BEMINTSIZE);
 199         else if ( result==FLOATTYPE || result==DOUBLETYPE)
 200                   C_cmf((arith)BEMFLTSIZE);
 201              else if ( result==STRINGTYPE)
 202                   {
 203                           C_cal("_strcomp");
 204                           C_asp((arith)(2*BEMPTRSIZE));
 205                           C_lfr((arith)BEMINTSIZE);
 206                   } else error("relop:unexpected");
 207         /* handle the relational operators */
 208         genbool(operator);
 209         return(INTTYPE);
 210 }
 211
 212
 213
 214 plusmin(ltype,rtype,operator)
 215 int     ltype,rtype,operator;
 216 {
 217         int result;
 218
 219         result= exprtype(ltype,rtype);
 220         if ( result== STRINGTYPE)
 221         {
 222                 if ( operator== '+')
 223                 {
 224                         C_cal("_concat");
 225                         C_asp((arith)(2*BEMPTRSIZE));
 226                         C_lfr((arith)BEMPTRSIZE);
 227                 } else error("illegal operator");
 228         } else {
 229                 extraconvert(ltype,result,rtype);
 230                 conversion(rtype,result);
 231                 if ( result== INTTYPE)
 232                 {
 233                         if ( operator=='+')
 234                                 C_adi((arith)BEMINTSIZE);
 235                         else C_sbi((arith)BEMINTSIZE);
 236                 } else {
 237                         if ( operator=='+')
 238                                 C_adf((arith)BEMFLTSIZE);
 239                         else C_sbf((arith)BEMFLTSIZE);
 240                 }
 241         }
 242         return(result);
 243 }
 244
 245
 246
 247 muldiv(ltype,rtype,operator)
 248 int     ltype,rtype,operator;
 249 {
 250         int result;
 251
 252         result=exprtype(ltype,rtype);
 253         if (operator==MODSYM || operator== '\\') result=INTTYPE;
 254         extraconvert(ltype,result,rtype);
 255         conversion(rtype,result);
 256         if ( result== INTTYPE)
 257         {
 258                 if ( operator=='/')
 259                 {
 260                         result=DOUBLETYPE;
 261                         extraconvert(ltype,result,rtype);
 262                         conversion(rtype,result);
 263                         C_dvf((arith)BEMFLTSIZE);
 264                 } else
 265                 if ( operator=='\\')
 266                         C_dvi((arith)BEMINTSIZE);
 267                 else
 268                 if ( operator=='*')
 269                         C_mli((arith)BEMINTSIZE);
 270                 else
 271                 if ( operator==MODSYM)
 272                         C_rmi((arith)BEMINTSIZE);
 273                 else    error("illegal operator");
 274         } else {
 275                 if ( operator=='/')
 276                         C_dvf((arith)BEMFLTSIZE);
 277                 else
 278                 if ( operator=='*')
 279                         C_mlf((arith)BEMFLTSIZE);
 280                 else    error("illegal operator");
 281         }
 282         return(result);
 283 }
 284
 285
 286
 287 negate(type)
 288 int type;
 289 {
 290         switch(type)
 291         {
 292                 case INTTYPE:
 293                         C_ngi((arith)BEMINTSIZE);
 294                         break;
 295                 case DOUBLETYPE:
 296                 case FLOATTYPE:
 297                         C_ngf((arith)BEMFLTSIZE);
 298                         break;
 299                 default:
 300                         error("Illegal operator");
 301         }
 302         return(type);
 303 }
 304
 305
 306
 307 #ifdef ___
 308 power(ltype,rtype)
 309 int     ltype,rtype;
 310 {
 311         int resulttype = exprtype(ltype, rtype);
 312
 313         extraconvert(ltype,resulttype,rtype);
 314         conversion(rtype,resulttype);
 315         switch(resulttype) {
 316         case INTTYPE:
 317                 C_cal("_ipower");
 318                 break;
 319         case DOUBLETYPE:
 320         case FLOATTYPE:
 321                 C_cal("_power");
 322                 break;
 323         default:
 324                 error("Illegal operator");
 325         }
 326         C_asp((arith)(2*typestring(resulttype)));
 327         C_lfr((arith)typestring(resulttype));
 328         return(resulttype);
 329 }
 330 #else
 331 power(ltype,rtype)
 332 int     ltype,rtype;
 333 {
 334         extraconvert(ltype,DOUBLETYPE,rtype);
 335         conversion(rtype,DOUBLETYPE);
 336         C_cal("_power");
 337         C_asp((arith)(2*BEMFLTSIZE));
 338         C_lfr((arith)BEMFLTSIZE);
 339         return(DOUBLETYPE);
 340 }
 341 #endif
 342
 343
 344 int typesize(ltype)
 345 int ltype;
 346 {
 347         switch( ltype)
 348         {
 349         case INTTYPE:
 350                 return(BEMINTSIZE);
 351         case FLOATTYPE:
 352         case DOUBLETYPE:
 353                 return(BEMFLTSIZE);
 354         case STRINGTYPE:
 355                 return(BEMPTRSIZE);
 356         default:
 357                 error("typesize:unexpected");
 358                 if (debug) print("type received %d\n",ltype);
 359         }
 360         return(BEMINTSIZE);
 361 }
 362
 363
 364
 365 int typestring(type)
 366 int type;
 367 {
 368         switch(type)
 369         {
 370                 case INTTYPE:
 371                         return(BEMINTSIZE);
 372                 case FLOATTYPE:
 373                 case DOUBLETYPE:
 374                         return(BEMFLTSIZE);
 375                 case STRINGTYPE:
 376                         return(BEMPTRSIZE);
 377                 default:
 378                         error("typestring: unexpected type");
 379         }
 380         return(0);
 381 }
 382
 383
 384
 385 loadvar(type)
 386 int type;
 387 {
 388         /* load a simple variable  its address is on the stack*/
 389         C_loi((arith)typestring(type));
 390 }
 391
 392
 393
 394 loadint(value)
 395 int value;
 396 {
 397         C_loc((arith)value);
 398         return(INTTYPE);
 399 }
 400
 401
 402
 403 loaddbl(value)
 404 char *value;
 405 {
 406         int index;
 407
 408         index=genlabel();
 409         C_df_dlb((label)index);
 410         C_bss_fcon((arith)BEMFLTSIZE,value,(arith)BEMFLTSIZE,1);
 411         C_lae_dlb((label)index,(arith)0);
 412         C_loi((arith)BEMFLTSIZE);
 413         return(DOUBLETYPE);
 414 }
 415
 416
 417
 418 loadstr(value)
 419 int value;
 420 {
 421         C_lae_dlb((label)value,(arith)0);
 422 }
 423
 424
 425
 426 loadaddr(s)
 427 Symbol *s;
 428 {
 429         extern Symbol *fcn;
 430         int i,j;
 431         arith sum;
 432
 433         if (debug) print("load %s %d\n",s->symname,s->symtype);
 434         if ( s->symalias>0)
 435                 C_lae_dlb((label)s->symalias,(arith)0);
 436         else {
 437                 j= -s->symalias;
 438                 if (debug) print("load parm %d\n",j);
 439                 /* first count the sizes. */
 440                 sum = 0;
 441                 for(i=fcn->dimensions;i>j;i--)
 442                         sum += typesize(fcn->dimlimit[i-1]);
 443                 C_lal(sum);
 444         }
 445         return(s->symtype);
 446 }
 447
 448
 449
 450 /* This is a new routine */
 451 save_address()
 452 {
 453         C_lae_dnam("dummy3",(arith)0);
 454         C_sti((arith)BEMPTRSIZE);
 455 }
 456
 457
 458
 459 assign(type,lt)
 460 int type,lt;
 461 {
 462         extern int e1,e2;
 463
 464         conversion(lt,type);
 465         C_lae_dnam("dummy3",(arith)0); /* Statement added by us */
 466         C_loi((arith)BEMPTRSIZE);
 467         /* address is on stack already */
 468         C_sti((arith)typestring(type));
 469 }
 470
 471
 472
 473 storevar(lab,type)
 474 int lab,type;
 475 {
 476         /*store value back */
 477         C_lae_dlb((label)lab,(arith)0);
 478         C_sti((arith)typestring(type));
 479 }
 480
 481
 482
 483 /* maintain a stack of array references */
 484 int     dimstk[MAXDIMENSIONS], dimtop= -1;
 485 Symbol  *arraystk[MAXDIMENSIONS];
 486
 487
 488
 489 newarrayload(s)
 490 Symbol *s;
 491 {
 492         if ( dimtop<MAXDIMENSIONS) dimtop++;
 493         if ( s->dimensions==0)
 494         {
 495                 s->dimensions=1;
 496                 defarray(s);
 497         }
 498         dimstk[dimtop]= 0;
 499         arraystk[dimtop]= s;
 500         C_lae_dlb((label)s->symalias,(arith)0);
 501 }
 502
 503
 504
 505 endarrayload()
 506 {
 507         return(arraystk[dimtop--]->symtype);
 508 }
 509
 510
 511
 512 loadarray(type)
 513 int     type;
 514 {
 515         int     dim;
 516         Symbol  *s;
 517
 518         if ( dimtop<0 || dimtop>=MAXDIMENSIONS)
 519                 fatal("too many nested array references");
 520         /* index expression is on top of stack */
 521         s=arraystk[dimtop];
 522         dim= dimstk[dimtop];
 523         if ( dim>=s->dimensions)
 524         {
 525                 error("too many indices");
 526                 dimstk[dimtop]=0;
 527                 return;
 528         }
 529         conversion(type,INTTYPE);
 530         C_lae_dlb((label)s->dimalias[dim],(arith)0);
 531         C_aar((arith)BEMINTSIZE);
 532         dimstk[dimtop]++;
 533 }
 534
 535
 536