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 =======================================================================
37 /* Transfer of control routines */
39 static void att2(virtaddr *, word, word);
40 static void back1(word, word, virtaddr *, word *);
47 *Transfer control to the newly created object.
49 void go(word ah, word am)
52 word pnum, plen, node, apt;
55 ptr = prototype[M[am + PROTNUM]];
57 /* new process creation */
58 if (ptr->kind == PROCESS) {
59 /* save template address */
60 thisp->template.addr = ah;
61 thisp->template.mark = M[ah + 1];
62 msg.control.type = CREATE;
63 msg.control.par = M[am + PROTNUM];
64 moveparams(thispix, am, &msg, PARIN, LOADPAR);
65 /* pix will create receiver */
66 msg.control.receiver.pix = 0;
67 /* mark will create receiver */
68 msg.control.receiver.mark= 0;
70 msg.control.receiver.node = getnode(am);
71 /* send create request */
74 fprintf(stderr, "send new process from %d to node %d\n",
75 thispix, msg.control.receiver.node);
77 /* and wait for return from process */
78 passivate(WAITFORNEW);
79 } else if (isprocess((virtaddr*)(M+apt+SL))) {
80 /* remote procedure call */
81 /* save template address */
82 thisp->backobj.addr = ah;
83 thisp->backobj.mark = M[ah + 1];
84 /* physical address also */
85 thisp->M[temporary] = am;
88 loadvirt(v, apt + SL);
89 obj2mess(M, &v, &msg.control.receiver);
93 stderr, "send rpc from process %d to (%d,%d,%d)\n",
95 msg.control.receiver.node,
96 msg.control.receiver.pix,
97 msg.control.receiver.mark
101 msg.control.type = RPCALL;
102 msg.control.par = M[am + PROTNUM];
103 moveparams(thispix, am, &msg, PARIN, LOADPAR);
104 /* send RPC request */
106 /* and wait for RP return */
107 passivate(WAITFORRPC);
109 /* save local control */
110 M[c1 + M[c1] + LSC] = ic;
111 /* release DISPLAY */
118 pnum = ptr->preflist;
119 plen = ptr->lthpreflist;
120 /* search for executable prefix */
126 ptr = prototype[M[pnum]];
129 if (ptr->kind != RECORD)
137 * Transfer control to a local unprefixed procedure, function, block,
138 * class or coroutine.
140 void goloc(word ah, word am)
145 /* save local control */
146 M[c1 + M[c1] + LSC] = ic;
149 t1 = M[am + PROTNUM];
153 /* simulate update display */
154 M[display + t1] = am;
155 M[display2 + t1] = ah;
156 M[am + M[am]+STATSL ]++;
159 /** Return from block. */
160 void backbl(virtaddr *virt, word *am)
164 t1 = M[c1 + PROTNUM];
165 virt->addr = M[display2 + t1];
166 /* prepare old address */
167 virt->mark = M[virt->addr + 1];
170 /* simulate loosen */
173 /* remove from SL chain */
175 /* return up along SL */
177 /* return from main */
181 /* am of new current */
183 c2 = c1 + prototype[M[c1 + PROTNUM]]->span;
184 ic = M[c1 + M[c1] + LSC];
185 /* force DL consistency */
186 storevirt(*virt, *am + M[*am]+DL);
190 /* Common code for some backs below. */
191 static void back1(word at1, word at2, virtaddr *virt, word *am)
198 t1 = M[c1 + PROTNUM];
200 virt->addr = M[display2 + t1];
201 virt->mark = M[virt->addr + 1];
205 storevirt(*virt, at2);
210 c2 = c1 + prototype[M[c1 + PROTNUM]]->span;
211 ic = M[c1 + M[c1] + LSC];
216 * Return from classes, coroutines and by end from procedures.
218 void back(virtaddr *virt, word *am, word length)
228 /* prototype of current */
229 ptr = prototype[M[c1 + PROTNUM]];
230 /* RETURN in process */
231 if (ptr->kind == PROCESS) {
233 fprintf( stderr, "return from process %d\n", thispix);
235 if (M[c1 + PROTNUM] == MAINBLOCK)
239 loadvirt(v, t2 + DL);
241 obj2mess(M, &v, &msg.control.receiver);
243 msg.control.type = CREACK;
244 moveparams(thispix, c1, &msg, PAROUT, LOADPAR);
245 /* send create acknowledge */
247 /* cut DL of new process head */
249 /* and suspend new process */
251 } else if (ptr->kind == COROUTINE) {
252 /* nothing if detached */
255 back1(t1, t2 + DL, virt, am);
258 /* save begining of prototype list */
260 if (ptr->lthpreflist == 1 && t1 == M[t2 + SL] &&
261 M[t2 + DL + 1] == M[t2 + SL + 1])
264 back1(t1, t2 + DL, virt, am);
269 stderr, "back (thisp=%d) from %s to %s\n",
272 (ptr->kind==PROCEDURE) ?
274 (ptr->kind==FUNCTION) ?
278 isprocess((virtaddr*)(M+t2+RPCDL)) ? "PROCESS" : "OBJECT"
282 if ((ptr->kind == PROCEDURE || ptr->kind == FUNCTION) &&
283 isprocess((virtaddr*)(M+t2+RPCDL))) {
287 loadvirt(v, t2 + RPCDL);
289 obj2mess(M, &v, &msg.control.receiver);
294 "send rpc ack from process %d to (%d,%d,%d)\n",
296 msg.control.receiver.node,
297 msg.control.receiver.pix,
298 msg.control.receiver.mark
301 msg.control.type = RPCACK;
302 moveparams(thispix, *am, &msg, PAROUT, LOADPAR);
303 /* send RP return - acknowledge */
305 /* kill procedure object manualy */
307 /* restore RPC mask from stack */
310 for (i = 0; i < length; i++) {
311 /* prototype number */
312 t1 = virtprot(M[plist++]);
316 disable(thispix, -t1);
318 /* check for enabled RPCs */
319 evaluaterpc(thispix);
326 * Return, end in procedures and functions without prefix.
328 void backpr(virtaddr *virt, word *am)
331 /* DL pointer of current */
332 t2 = c1 + M[c1] + DL;
338 if (t1 == M[t3] && M[t2 + 1] == M[t3 + 1])
341 back1(t1, t2, virt, am);
344 /** End in classes and coroutines. */
345 void fin(word backic, virtaddr *virt, word *am)
349 knd = prototype[M[c1 + PROTNUM]]->kind;
350 if (knd != COROUTINE && knd != PROCESS) {
351 /* a class - exit as above */
352 back(virt, am, (word) 0);
361 if (M[t2 + SL] == DUMMY)
363 /* coroutine terminated */
369 back1(t1, t2 + DL, virt, am);
374 /** Helper for attach/detach */
375 static void att2(virtaddr *virt, word ax, word at1)
380 t1 = M[display2 + M[c1 + PROTNUM]];
381 /* DL of coroutine head */
382 t2 = at1 + M[at1] + DL;
385 M[t2 + 1] = M[t1 + 1];
386 /* preserve local control */
387 M[c1 + M[c1] + LSC] = ic;
389 phead = thisp->prochead;
390 storevirt(*virt, phead + M[phead] + CHD);
392 /* coroutine active */
395 /* cut DL of new coroutine head */
399 c2 = c1 + prototype[M[c1 + PROTNUM]]->span;
400 ic = M[ c1 + M[c1] + LSC];
401 /* coroutine terminated */
407 void attach(virtaddr *virt)
409 word t1, ax, phead, chead;
412 if (M[virt->addr + 1] != virt->mark)
418 t1 = M[ax + PROTNUM];
419 if (t1 == AINT || t1 == AREAL || t1 == AVIRT || t1 == FILEOBJECT)
421 knd = prototype[t1]->kind;
422 if (knd != COROUTINE && knd != PROCESS)
425 phead = thisp->prochead;
426 chead = phead + M[phead] + CHD;
427 if (virt->addr != M[chead] || virt->mark != M[chead + 1]) {
428 M[ax + CL] = M[chead];
429 M[ax + CL + 1] = M[chead + 1];
430 att2(virt, ax, M[M[chead]]);
440 phead = thisp->prochead;
441 /* am of coroutine head */
442 t1 = M[M[phead + M[phead] + CHD]];
444 loadvirt(virt, t1 + M[t1] + CL);
445 if (M[virt.addr + 1] != virt.mark)
447 att2(&virt, M[virt.addr] + M[M[virt.addr]], t1);
450 /* Simulate execution of inner */
451 void inner(word level)
456 /* prototype of current */
457 ptr = prototype[M[c1 + PROTNUM]];
458 t1 = ptr->lthpreflist;
463 ic = prototype[M[ptr->preflist + level]]->codeaddr;