1 /* Loglan82 Compiler&Interpreter
2 Copyright (C) 1993 Institute of Informatics, University of Warsaw
3 Copyright (C) 1993, 1994 LITA, Pau
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.
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.
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.
19 contacts: Andrzej.Salwicki@univ-pau.fr
22 LITA Departement d'Informatique
24 Avenue de l'Universite
26 tel. ++33 59923154 fax. ++33 59841696
28 =======================================================================
40 /* Execute one L-code instruction */
48 virtaddr virt1, virt2, virt3;
52 openrc(a3, &virt2, &t2);
58 storevirt(thisp->backobj, a1);
63 /* skip the address */
65 raise_signal(a3, M[ic - 1], &t1, &t2);
71 openobj(M[a3], &t1, &t2);
78 slopen(M[a3 + APREF], &virt3, &t1, &t2);
84 virt1.addr = M[display2 + a2];
85 virt1.mark = M[virt1.addr + 1];
92 M[a1] = M[prototype[t1]->virtlist + a3];
101 M[a1] = param[a3].xword;
105 MR(a1) = param[a3].xreal;
109 storevirt(param[a3].xvirt, a1);
124 if (member(&virt2, &t1)) {
125 switch ((int) M[t1 + PROTNUM]) {
136 M[a1] = (M[t1 + 2 ] + 3) / t2;
145 if (member(&virt2, &t1)) {
146 switch ((int) M[t1 + PROTNUM]) {
157 M[a1] = (M[t1 + 2] + M[t1]) / t2 - 1;
164 typep(M[a2], a3, &virt1.addr, &virt1.mark);
165 storevirt(virt1, a1);
170 copy(&virt2, &virt1);
171 storevirt(virt1, a1);
177 /* LRCVAVIRT */ /* recover virtual address from ah */
180 virt1.mark = M[virt1.addr + 1];
181 storevirt(virt1, a1);
186 M[a1] = M[prototype[M[temporary]]->virtlist + a2];
192 /* fprintf(stderr, "co ja tu robie?"); */
194 if (!member(&virt2, &M[a1]))
200 M[a1] = absolute(t2);
220 M[a1] = t2 + M[prototype[M[t2 + PROTNUM]]->parlist + a3];
227 t2 = t1 + loadt(M[M[a2]], a3);
229 storevirt(virt1, a1);
234 M[a1] = lbool(is(&virt2, a3));
239 M[a1] = lbool(inl(&virt2, a3));
244 if (member(&virt2, &M[a1]))
251 M[a1] = (word)(MR(a2));
255 MR(a1) = (real)(M[a2]);
264 storevirt(virt1, a1);
267 WARNING: these areas may overlap! */
273 WARNING: these areas may overlap!*/
275 /* MACHINE DEPENDENT */
278 storevirt(virt1, a1);
283 M[a1] = lbool(M[a2 + 1] != M[M[a2] + 1]);
287 M[a1] = lbool(M[a2+1] == M[M[a2] + 1]);
290 /* modify the formal type */
293 /* number of "arrayof" */
295 storevirt(virt1, a1);
299 M[a1] = M[a2] | M[a3];
303 M[a1] = M[a2] & M[a3];
310 if (member(&virt2, &t2)) {
312 t1 = M[a3] - M[t2 + 2];
313 if (t1 < 3 || t1 >= M[t2])
325 /* physical address */
327 M[a1] = t1 + M[a3] - M[t1 + 2];
331 M[a1] = lbool(M[a2] == M[a3]);
335 M[a1] = lbool(M[a2] != M[a3]);
339 M[a1] = lbool(M[a2] < M[a3]);
343 M[a1] = lbool(M[a2] <= M[a3]);
347 M[a1] = lbool(M[a2] > M[a3]);
351 M[a1] = lbool(M[a2] >= M[a3]);
357 storevirt(virt2, a1);
362 M[a1] = M[a2] + M[a3];
370 M[a1] = M[a2] * M[a3];
374 M[a1] = shift(M[a2], M[a3]);
377 case 117:/* LIDIVE */
381 M[a1] = M[a2] / M[a3];
388 M[a1] = M[a2] % M[a3];
392 MR(a1) = MR(a2) + MR(a3);
396 MR(a1) = MR(a2) - MR(a3);
400 MR(a1) = MR(a2) * MR(a3);
404 if (MR(a3) == (real)0.0)
407 MR(a1) = MR(a2) / MR(a3);
413 if (member(&virt2, &t1))
414 M[a1] = lbool(member(&virt3, &t2) && t1 == t2);
416 M[a1] = lbool(!member(&virt3, &t2));
422 if (member(&virt2, &t1))
423 M[a1] = lbool(!member(&virt3, &t2) || t1 != t2);
425 M[a1] = lbool(member(&virt3, &t2));
429 M[a1] = lbool(MR(a2) == MR(a3));
433 M[a1] = lbool(MR(a2) != MR(a3));
437 M[a1] = lbool(MR(a2) < MR(a3));
441 M[a1] = lbool(MR(a2) <= MR(a3));
445 M[a1] = lbool(MR(a2) > MR(a3));
449 M[a1] = lbool(MR(a2) >= MR(a3));
453 M[a1] = M[a2] ^ M[a3];
458 /* reschedule forced so alarm may be switched off */
476 param[a3].xword = M[a1];
485 loadvirt(param[a3].xvirt, a1);
489 param[a3].xreal = MR(a1);
524 /* right side type */
526 typed(virt1.addr, virt1.mark, virt3.addr, virt3.mark, &virt2);
538 goloc(thisp->blck1, thisp->blck2);
542 disp(&thisp->backobj);
554 backhd(&thisp->backobj, &M[temporary]);
562 openobj(a1, &thisp->blck1, &thisp->blck2);
575 backbl(&thisp->backobj, &M[temporary]);
579 /* backpr(&thisp->backobj, &M[temporary]); */
580 back(&thisp->backobj, &M[temporary], (word) 0);
584 back(&thisp->backobj, &M[temporary], (word) 0);
588 fin(ic - APOPCODE, &thisp->backobj, &M[temporary]);
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 */
597 if (t1 < 0 || t1 >= M[a2 + 1])
599 ic = a2 + 2 + M[a2 + 1];
615 disp(&thisp->template);
619 for (i = 0; i < a1; i++)
620 enable(thispix, virtprot(M[ic++]));
621 evaluaterpc(thispix);
625 for (i = 0; i < a1; i++)
626 disable(thispix, virtprot(M[ic++]));
639 back(&thisp->backobj, &M[temporary], a1);