src/int/execute.c

   1 /*     Loglan82 Compiler&Interpreter
   2      Copyright (C) 1993 Institute of Informatics, University of Warsaw
   3      Copyright (C)  1993, 1994 LITA, Pau
   4
   5      This program is free software; you can redistribute it and/or modify
   6      it under the terms of the GNU General Public License as published by
   7      the Free Software Foundation; either version 2 of the License, or
   8      (at your option) any later version.
   9
  10      This program is distributed in the hope that it will be useful,
  11      but WITHOUT ANY WARRANTY; without even the implied warranty of
  12      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13      GNU General Public License for more details.
  14
  15              You should have received a copy of the GNU General Public License
  16              along with this program; if not, write to the Free Software
  17              Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18
  19  contacts:  Andrzej.Salwicki@univ-pau.fr
  20
  21 or             Andrzej Salwicki
  22                 LITA   Departement d'Informatique
  23                 Universite de Pau
  24                 Avenue de l'Universite
  25                 64000 Pau   FRANCE
  26                  tel.  ++33 59923154    fax. ++33 59841696
  27
  28 =======================================================================
  29 */
  30
  31 #include "depend.h"
  32 #include "genint.h"
  33 #include "int.h"
  34 #include "process.h"
  35 #include "intproto.h"
  36
  37 #include <assert.h>
  38
  39 /**
  40  * @file
  41  */
  42
  43 /** Execute one L-code instruction */
  44 void execute()
  45 {
  46         word t1, t2;
  47         int i;
  48         real r;
  49         virtaddr virt1, virt2, virt3;
  50         switch (opcode) {
  51         /* LOPENRC */
  52         case 1:
  53                 openrc(a3, &virt2, &t2);
  54                 storevirt(virt2, a1);
  55                 M[a2] = t2;
  56                 break;
  57         /* LBACKADDR */
  58         case 2:
  59                 storevirt(thisp->backobj, a1);
  60                 M[a2] = M[temporary];
  61                 break;
  62         /* LRAISE */
  63         case 3:
  64                 /* skip the address */
  65                 ic++;
  66                 raise_signal(a3, M[ic - 1], &t1, &t2);
  67                 M[a1] = t1;
  68                 M[a2] = t2;
  69                 break;
  70         /* LOPEN */
  71         case 4:
  72                 openobj(M[a3], &t1, &t2);
  73                 M[a1] = t1;
  74                 M[a2] = t2;
  75                 break;
  76         /* LSLOPEN */
  77         case 5:
  78                 loadvirt(virt3, a3);
  79                 slopen(M[a3 + APREF], &virt3, &t1, &t2);
  80                 M[a1] = t1;
  81                 M[a2] = t2;
  82                 break;
  83         /* LTHIS */
  84         case 15:
  85                 virt1.addr = M[display2 + a2];
  86                 virt1.mark = M[virt1.addr + 1];
  87                 storevirt(virt1, a1);
  88                 break;
  89         /* LVIRTDISPL */
  90         case 20:
  91                 t2 = M[display + a2];
  92                 t1 = M[t2 + PROTNUM];
  93                 M[a1] = M[prototype[t1]->virtlist + a3];
  94                 break;
  95         /* LSTATTYPE */
  96         case 21:
  97                 M[a1] = a2;
  98                 M[a1 + 1] = a3;
  99                 break;
 100         /* LIPAROUT */
 101         case 23:
 102                 M[a1] = param[a3].xword;
 103                 break;
 104         /* LRPAROUT */
 105         case 24:
 106                 MR(a1) = param[a3].xreal;
 107                 break;
 108         /* LVPAROUT */
 109         case 25:
 110                 storevirt(param[a3].xvirt, a1);
 111                 break;
 112         /* LSIGN */
 113         case 31:
 114                 if (M[a2] == 0)
 115                         M[a1] = 0;
 116                 else if (M[a2] < 0)
 117                         M[a1] = -1;
 118                 else
 119                         M[a1] = 1;
 120                 break;
 121         /* LLOWER */
 122         case 33:
 123         case 34:
 124                 loadvirt(virt2, a2);
 125                 if (member(&virt2, &t1)) {
 126                         switch ((int) M[t1 + PROTNUM]) {
 127                         case AINT:
 128                                 t2 = APINT;
 129                                 break;
 130                         case AREAL:
 131                                 t2 = APREAL;
 132                                 break;
 133                         case AVIRT:
 134                                 t2 = APREF;
 135                                 break;
 136                         }
 137                         M[a1] = (M[t1 + 2 ] + 3) / t2;
 138                 }
 139                 else
 140                         errsignal(RTEREFTN);
 141                 break;
 142         /* LUPPER */
 143         case 35:
 144         case 36:
 145                 loadvirt(virt2, a2);
 146                 if (member(&virt2, &t1)) {
 147                         switch ((int) M[t1 + PROTNUM]) {
 148                         case AINT:
 149                                 t2 = APINT;
 150                                 break;
 151                         case AREAL:
 152                                 t2 = APREAL;
 153                                 break;
 154                         case AVIRT:
 155                                 t2 = APREF;
 156                                 break;
 157                         }
 158                         M[a1] = (M[t1 + 2] + M[t1]) / t2 - 1;
 159                 }
 160                 else
 161                         errsignal(RTEREFTN);
 162                 break;
 163         /* LGETTYPE */
 164         case 40:
 165                 typep(M[a2], a3, &virt1.addr, &virt1.mark);
 166                 storevirt(virt1, a1);
 167                 break;
 168         /* LCOPY */
 169         case 41:
 170                 loadvirt(virt2, a2);
 171                 copy(&virt2, &virt1);
 172                 storevirt(virt1, a1);
 173                 break;
 174         /* LNOT */
 175         case 42:
 176                 M[a1] = ~M[a2];
 177                 break;
 178         /* LRCVAVIRT */ /* recover virtual address from ah */
 179         case 43:
 180                 virt1.addr = M[a2];
 181                 virt1.mark = M[virt1.addr + 1];
 182                 storevirt(virt1, a1);
 183                 break;
 184         /* LVIRTDOT */
 185         case 44:
 186         case 45:
 187                 M[a1] = M[prototype[M[temporary]]->virtlist + a2];
 188                 break;
 189         /* LADDRPH */
 190         case 46:
 191         /* LADDRPH2 */
 192         case 47:
 193                 /* fprintf(stderr, "co ja tu robie?"); */
 194                 loadvirt(virt2, a2);
 195                 if (!member(&virt2, &M[a1]))
 196                         errsignal(RTEREFTN);
 197                 break;
 198         /* LIABS */
 199         case 48:
 200                 t2 = M[a2];
 201                 M[a1] = absolute(t2);
 202                 break;
 203         /* LINEG */
 204         case 49:
 205                 M[a1] = -M[a2];
 206                 break;
 207         /* LRABS */
 208         case 50:
 209                 r = MR(a2);
 210                 if(r < (real)0.0)
 211                         r = (real)0.0 - r;
 212                 MR(a1) = r;
 213                 break;
 214         /* LRNEG */
 215         case 51:
 216                 MR(a1) = -MR(a2);
 217                 break;
 218         /* LPARAMADDR */
 219         case 52:
 220                 t2 = M[a2];
 221                 M[a1] = t2 + M[prototype[M[t2 + PROTNUM]]->parlist + a3];
 222                 break;
 223         /* LLOADT */
 224         case 54:
 225                 /* offset */
 226                 t1 = M[ic++];
 227                 /* object address */
 228                 t2 = t1 + loadt(M[M[a2]], a3);
 229                 loadvirt(virt1, t2);
 230                 storevirt(virt1, a1);
 231                 break;
 232         /* LIS */
 233         case 55:
 234                 loadvirt(virt2, a2);
 235                 M[a1] = lbool(is(&virt2, a3));
 236                 break;
 237         /* LIN */
 238         case 56:
 239                 loadvirt(virt2, a2);
 240                 M[a1] = lbool(inl(&virt2, a3));
 241                 break;
 242         /* LQUA */
 243         case 57:
 244                 loadvirt(virt2, a2);
 245                 if (member(&virt2, &M[a1]))
 246                         qua(&virt2, a3);
 247                 else
 248                         errsignal(RTEREFTN);
 249                 break;
 250         /* LIFIX */
 251         case 58:
 252                 M[a1] = (word)(MR(a2));
 253                 break;
 254         /* LFLOAT */
 255         case 59:
 256                 MR(a1) = (real)(M[a2]);
 257                 break;
 258         /* LIMOVE */
 259         case 60:
 260                 M[a1] = M[a2];
 261                 break;
 262         /* LVMOVE */
 263         case 61:
 264                 loadvirt(virt1, a2);
 265                 storevirt(virt1, a1);
 266                 break;
 267         /* LRMOVE
 268         WARNING: these areas may overlap! */
 269         case 62:
 270                 r = MR(a2);
 271                 MR(a1) = r;
 272                 break;
 273         /* LFPMOVE
 274         WARNING: these areas may overlap!*/
 275         case 63:
 276                 /* MACHINE DEPENDENT */
 277                 loadvirt(virt1, a2);
 278                 t1 = M[a2 + 2];
 279                 storevirt(virt1, a1);
 280                 M[a1 + 2] = t1;
 281                 break;
 282         /* LEQNONE */
 283         case 82:
 284                 M[a1] = lbool(M[a2 + 1] != M[M[a2] + 1]);
 285                 break;
 286         /* LNENONE */
 287         case 83:
 288                 M[a1] = lbool(M[a2+1] == M[M[a2] + 1]);
 289                 break;
 290         /* LMDFTYPE */
 291         /* modify the formal type */
 292         case 87:
 293                 loadvirt(virt1, a2);
 294                 /* number of "arrayof" */
 295                 virt1.addr += a3;
 296                 storevirt(virt1, a1);
 297                 break;
 298         /* LOR */
 299         case 100:
 300                 M[a1] = M[a2] | M[a3];
 301                 break;
 302         /* LAND */
 303         case 101:
 304                 M[a1] = M[a2] & M[a3];
 305                 break;
 306         /* LARRAY */
 307         case 102:
 308         case 103:
 309         case 104:
 310                 loadvirt(virt2, a2);
 311                 if (member(&virt2, &t2)) {
 312                         /* index-lower+3 */
 313                         t1 = M[a3] - M[t2 + 2];
 314                         if (t1 < 3 || t1 >= M[t2])
 315                                 errsignal(RTEINVIN);
 316                         else
 317                                 M[a1] = t2+t1;
 318                 }
 319                 else
 320                         errsignal(RTEREFTN);
 321                 break;
 322
 323         /* LFARRAY
 324         without any tests */
 325         case 105:
 326                 /* physical address */
 327                 t1 = M[M[a2]];
 328                 M[a1] = t1 + M[a3] - M[t1 + 2];
 329                 break;
 330         /* LIEQUAL */
 331         case 106:
 332                 M[a1] = lbool(M[a2] == M[a3]);
 333                 break;
 334         /* LINEQUAL */
 335         case 107:
 336                 M[a1] = lbool(M[a2] != M[a3]);
 337                 break;
 338         /* LILT */
 339         case 108:
 340                 M[a1] = lbool(M[a2] < M[a3]);
 341                 break;
 342         /* LILE */
 343         case 109:
 344                 M[a1] = lbool(M[a2] <= M[a3]);
 345                 break;
 346         /* LIGT */
 347         case 110:
 348                 M[a1] = lbool(M[a2] > M[a3]);
 349                 break;
 350         /* LIGE */
 351         case 111:
 352                 M[a1] = lbool(M[a2] >= M[a3]);
 353                 break;
 354         /* LCOMBINE */
 355         case 112:
 356                 loadvirt(virt2, a2);
 357                 t1 = M[a3];
 358                 storevirt(virt2, a1);
 359                 M[a1 + APREF] = t1;
 360                 break;
 361         /* LIADD */
 362         case 113:
 363                 M[a1] = M[a2] + M[a3];
 364                 break;
 365         /* LISUB */
 366         case 114:
 367                 M[a1] = M[a2]-M[a3];
 368                 break;
 369         /* LIMULT */
 370         case 115:
 371                 M[a1] = M[a2] * M[a3];
 372                 break;
 373         /* LSHIFT */
 374         case 116:
 375                 M[a1] = shift(M[a2], M[a3]);
 376                 break;
 377
 378         case 117:/* LIDIVE */
 379                 if (M[a3] == 0)
 380                         errsignal(RTEDIVBZ);
 381                 else
 382                         M[a1] = M[a2] / M[a3];
 383                 break;
 384         /* LIMODE */
 385         case 118:
 386                 if (M[a3] == 0)
 387                         errsignal(RTEDIVBZ);
 388                 else
 389                         M[a1] = M[a2] % M[a3];
 390                 break;
 391         /* LRADD */
 392         case 119:
 393                 MR(a1) = MR(a2) + MR(a3);
 394                 break;
 395         /* LRSUB */
 396         case 120:
 397                 MR(a1) = MR(a2) - MR(a3);
 398                 break;
 399         /* LRMULT */
 400         case 121:
 401                 MR(a1) = MR(a2) * MR(a3);
 402                 break;
 403         /* LRDIVE */
 404         case 122:
 405                 if (MR(a3) == (real)0.0)
 406                         errsignal(RTEDIVBZ);
 407                 else
 408                         MR(a1) = MR(a2) / MR(a3);
 409                 break;
 410         /* LEQREF */
 411         case 123:
 412                 loadvirt(virt2, a2);
 413                 loadvirt(virt3, a3);
 414                 if (member(&virt2, &t1))
 415                         M[a1] = lbool(member(&virt3, &t2) && t1 == t2);
 416                 else
 417                         M[a1] = lbool(!member(&virt3, &t2));
 418                 break;
 419         /* LNEREF */
 420         case 124:
 421                 loadvirt(virt2, a2);
 422                 loadvirt(virt3, a3);
 423                 if (member(&virt2, &t1))
 424                         M[a1] = lbool(!member(&virt3, &t2) || t1 != t2);
 425                 else
 426                         M[a1] = lbool(member(&virt3, &t2));
 427                 break;
 428         /* LREQ */
 429         case 125:
 430                 M[a1] = lbool(MR(a2) == MR(a3));
 431                 break;
 432         /* LRNE */
 433         case 126:
 434                 M[a1] = lbool(MR(a2) != MR(a3));
 435                 break;
 436         /* LRLT */
 437         case 127:
 438                 M[a1] = lbool(MR(a2) < MR(a3));
 439                 break;
 440         /* LRLE */
 441         case 128:
 442                 M[a1] = lbool(MR(a2) <= MR(a3));
 443                 break;
 444         /* LRGT */
 445         case 129:
 446                 M[a1] = lbool(MR(a2) > MR(a3));
 447                 break;
 448         /* LRGE */
 449         case 130:
 450                 M[a1] = lbool(MR(a2) >= MR(a3));
 451                 break;
 452         /* LXOR */
 453         case 131:
 454                 M[a1] = M[a2] ^ M[a3];
 455                 break;
 456         /* LCALLPROCSTAND */
 457         case 132:
 458 #if USE_ALARM
 459                 /* reschedule forced so alarm may be switched off */
 460                 alarm(0);
 461 #endif
 462                 reschedule = TRUE;
 463                 standard(a1);
 464                 break;
 465         /* LKILL */
 466         case 143:
 467                 loadvirt(virt1, a1);
 468                 disp(&virt1);
 469                 break;
 470         /* LHEADS */
 471         case 144:
 472                 loadvirt(virt1, a1);
 473                 heads(&virt1, a2);
 474                 break;
 475         /* LIPARINP */
 476         case 145:
 477                 param[a3].xword = M[a1];
 478                 break;
 479         /* LGKILL */
 480         case 146:
 481                 loadvirt(virt1, a1);
 482                 gkill(&virt1);
 483                 break;
 484         /* LVPARINP */
 485         case 147:
 486                 loadvirt(param[a3].xvirt, a1);
 487                 break;
 488         /* LRPARINP */
 489         case 148:
 490                 param[a3].xreal = MR(a1);
 491                 break;
 492         /* LQUATEST */
 493         case 149:
 494                 loadvirt(virt1, a1);
 495                 qua(&virt1, a2);
 496                 break;
 497         /* LSTYPE */
 498         case 150:
 499                 loadvirt(virt1, a1);
 500                 typref(&virt1, a2);
 501                 break;
 502         /* LIFFALSE */
 503         case 151:
 504                 if (M[a1] == LFALSE)
 505                         ic = a2;
 506                 break;
 507         /* LIFTRUE */
 508         case 152:
 509                 if (M[a1] == LTRUE)
 510                         ic = a2;
 511                 break;
 512         /* LGO */
 513         case 159:
 514                 go(M[a2], M[a1]);
 515                 break;
 516         /* LGOLOCAL */
 517         case 160:
 518                 goloc(M[a2], M[a1]);
 519                 break;
 520         /* LDTYPE */
 521         case 170:
 522                 /* left side type */
 523                 loadvirt(virt1, a1);
 524                 loadvirt(virt2, a2);
 525                 /* right side type */
 526                 loadvirt(virt3, a3);
 527                 typed(virt1.addr, virt1.mark, virt3.addr, virt3.mark, &virt2);
 528                 break;
 529         /* LTERMINATE */
 530         case 172:
 531                 term();
 532                 break;
 533         /* LWIND */
 534         case 173:
 535                 wind();
 536                 break;
 537         /* LBLOCK2 */
 538         case 174:
 539                 goloc(thisp->blck1, thisp->blck2);
 540                 break;
 541         /* LBLOCK3 */
 542         case 176:
 543                 disp(&thisp->backobj);
 544                 break;
 545         /* LTRACE */
 546         case 177:
 547                 trace(a1);
 548                 break;
 549         /* LINNER */
 550         case 178:
 551                 inner(a1);
 552                 break;
 553         /* LBACKHD */
 554         case 180:
 555                 backhd(&thisp->backobj, &M[temporary]);
 556                 break;
 557         /* LJUMP */
 558         case 182:
 559                 ic = a1;
 560                 break;
 561         /* LBLOCK1 */
 562         case 186:
 563                 openobj(a1, &thisp->blck1, &thisp->blck2);
 564                 break;
 565         /* LDETACH */
 566         case 187:
 567                 detach();
 568                 break;
 569         /* LATTACH */
 570         case 188:
 571                 loadvirt(virt1, a1);
 572                 attach(&virt1);
 573                 break;
 574         /* LBACKBL */
 575         case 191:
 576                 backbl(&thisp->backobj, &M[temporary]);
 577                 break;
 578         /* LBACKPR */
 579         case 192:
 580                 /* backpr(&thisp->backobj, &M[temporary]); */
 581                 back(&thisp->backobj, &M[temporary], (word) 0);
 582                 break;
 583         /* LBACK */
 584         case 193:
 585                 back(&thisp->backobj, &M[temporary], (word) 0);
 586                 break;
 587         /* LFIN */
 588         case 194:
 589                 fin(ic - APOPCODE, &thisp->backobj, &M[temporary]);
 590                 break;
 591         /* LCASE */
 592         case 195:
 593                 /* a2 = address of case description : */
 594                 /* minimal value, number of branches, */
 595                 /* remaining branches followed by "otherwise" code */
 596                 /* in 0..number of branches-1 */
 597                 t1 = M[a1] - M[a2];
 598                 if (t1 < 0 || t1 >= M[a2 + 1])
 599                         /* otherwise */
 600                         ic = a2 + 2 + M[a2 + 1];
 601                 else
 602                         /* indirect jump */
 603                         ic = M[a2 + 2 + t1];
 604                 break;
 605         /* LRESUME */
 606         case 220:
 607                 loadvirt(virt1, a1);
 608                 resume(&virt1);
 609                 break;
 610         /* LSTOP */
 611         case 221:
 612                 passivate(STOPPED);
 613                 break;
 614         /* LKILLTEMP */
 615         case 222:
 616                 disp(&thisp->template);
 617                 break;
 618         /* LENABLE */
 619         case 223:
 620                 for (i = 0; i < a1; i++)
 621                         enable(thispix, virtprot(M[ic++]));
 622                 evaluaterpc(thispix);
 623                 break;
 624         /* LDISABLE */
 625         case 224:
 626                 for (i = 0; i < a1; i++)
 627                         disable(thispix, virtprot(M[ic++]));
 628                 break;
 629         /* LACCEPT1 */
 630         case 225:
 631                 rpc_accept(a1);
 632                 break;
 633         /* LACCEPT2 */
 634         case 226:
 635                 popmask(thispix);
 636                 rpc3();
 637                 break;
 638         /* LBACKRPC */
 639         case 227:
 640                 back(&thisp->backobj, &M[temporary], a1);
 641                 break;
 642         /* LASKPROT */
 643         case 228:
 644                 loadvirt(virt1, a1);
 645                 askprot(&virt1);
 646                 break;
 647         /* LSTEP */
 648         case 240:
 649                 if (M[a1] < 0)
 650                         errsignal(RTENEGST);
 651                 break;
 652
 653         default:
 654                 break;
 655         }
 656 }
 657
 658