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