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 if (ptr->kind == PROCESS) /* new process creation */
59 thisp->template.addr = ah; /* save template address */
60 thisp->template.mark = M[ ah+1 ];
61 msg.control.type = CREATE;
62 msg.control.par = M[ am+PROTNUM ];
63 moveparams(thispix, am, &msg, PARIN, LOADPAR);
64 msg.control.receiver.pix = 0; /* pix will create receiver */
65 msg.control.receiver.mark= 0; /* mark will create receiver */
66 msg.control.receiver.node = getnode(am); /* node we decided */
67 sendmsg1( &msg); /* send create request */
70 stderr, "send new process from %d to node %d\n",
72 msg.control.receiver.node
75 passivate(WAITFORNEW); /* and wait for return from process */
78 if (isprocess((virtaddr*)(M+apt+SL))) /* remote procedure call */
80 thisp->backobj.addr = ah; /* save template address */
81 thisp->backobj.mark = M[ ah+1 ];
82 thisp->M[ temporary ] = am; /* physical address also */
85 loadvirt( v, apt+SL );
86 obj2mess( M, &v, &msg.control.receiver );
89 stderr, "send rpc from process %d to (%d,%d,%d)\n",
91 msg.control.receiver.node,
92 msg.control.receiver.pix,
93 msg.control.receiver.mark
97 msg.control.type = RPCALL;
98 msg.control.par = M[ am+PROTNUM ];
99 moveparams(thispix, am, &msg, PARIN, LOADPAR);
100 sendmsg1( &msg); /* send RPC request */
101 passivate(WAITFORRPC); /* and wait for RP return */
105 M[ c1+M[ c1 ]+LSC ] = ic; /* save local control */
106 loosen(); /* release DISPLAY */
107 update(am, ah); /* update DISPLAY */
108 c1 = am; /* new current */
110 pnum = ptr->preflist;
111 plen = ptr->lthpreflist;
112 while (TRUE) /* search for executable prefix */
120 ptr = prototype[ M[ pnum ] ];
123 if (ptr->kind != RECORD) plen = 0;
130 * Transfer control to a local unprefixed procedure, function, block,
131 * class or coroutine.
133 void goloc(word ah, word am)
138 M[ c1+M[ c1 ]+LSC ] = ic; /* save local control */
139 c1 = am; /* new current */
140 t1 = M[ am+PROTNUM ];
141 ptr = prototype[ t1 ];
144 M[ display+t1 ] = am; /* simulate update display */
145 M[ display2+t1 ] = ah;
146 M[ am+M[ am ]+STATSL ]++;
149 /* Return from block. */
150 void backbl(virtaddr *virt, word *am)
154 t1 = M[ c1+PROTNUM ];
155 virt->addr = M[ display2+t1 ];
156 virt->mark = M[ virt->addr+1 ]; /* prepare old address */
157 *am = c1; /* am of old */
158 M[ display+t1 ] = 0; /* simulate loosen */
160 M[ t1+STATSL ]--; /* remove from SL chain */
161 c1 = M[ t1+SL ]; /* return up along SL */
162 if (c1 == DUMMY) endprocess(0); /* return from main */
163 c1 = M[ c1 ]; /* am of new current */
164 c2 = c1+prototype[ M[ c1+PROTNUM ] ]->span;
165 ic = M[ c1+M[ c1 ]+LSC ];
166 storevirt(*virt, *am+M[ *am ]+DL); /* force DL consistency */
170 /* Common code for some backs below. */
171 static void back1(word at1, word at2, virtaddr *virt, word *am)
176 if (at1 == 0) endprocess(0);
177 t1 = M[ c1+PROTNUM ];
178 virt->addr = M[ display2+t1 ]; /* ah of old */
179 virt->mark = M[ virt->addr+1 ];
180 *am = c1; /* am of old */
181 storevirt(*virt, at2); /* loop up DL */
182 at2 = M[ at1 ]; /* am of DL */
185 c2 = c1 + prototype[ M[ c1+PROTNUM ] ]->span;
186 ic = M[ c1+M[ c1 ]+LSC ];
191 * Return from classes, coroutines and by end from procedures.
193 void back(virtaddr *virt, word *am, word length)
201 t1 = M[ t2+DL ]; /* ah of DL */
202 ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */
203 if (ptr->kind == PROCESS) /* RETURN in process */
206 fprintf( stderr, "return from process %d\n", thispix );
208 if (M[ c1+PROTNUM ] == MAINBLOCK) endprocess(0);
211 loadvirt( v, t2+DL );
212 obj2mess( M, &v, &msg.control.receiver ); /* father process */
214 msg.control.type = CREACK;
215 moveparams(thispix, c1, &msg, PAROUT, LOADPAR);
216 sendmsg1(&msg); /* send create acknowledge */
217 M[ t2+DL ] = 0; /* cut DL of new process head */
218 passivate(STOPPED); /* and suspend new process */
221 if (ptr->kind == COROUTINE)
223 if (t1 != 0) /* nothing if detached */
226 back1(t1, t2+DL, virt, am);
231 plist = ic; /* save begining of prototype list */
232 if (ptr->lthpreflist==1 && t1==M[t2+SL] && M[t2+DL+1]==M[t2+SL+1])
235 back1(t1, t2+DL, virt, am);
240 stderr, "back (thisp=%d) from %s to %s\n",
243 (ptr->kind==PROCEDURE) ?
245 (ptr->kind==FUNCTION) ?
249 isprocess((virtaddr*)(M+t2+RPCDL)) ? "PROCESS" : "OBJECT"
253 if ((ptr->kind == PROCEDURE || ptr->kind == FUNCTION) &&
254 isprocess((virtaddr*)(M+t2+RPCDL)))
258 loadvirt( v, t2+RPCDL );
259 obj2mess( M, &v, &msg.control.receiver ); /* remote DL */
263 stderr, "send rpc ack from process %d to (%d,%d,%d)\n",
265 msg.control.receiver.node,
266 msg.control.receiver.pix,
267 msg.control.receiver.mark
270 msg.control.type = RPCACK;
271 moveparams(thispix, *am, &msg, PAROUT, LOADPAR);
272 sendmsg1(&msg); /* send RP return - acknowledge */
273 gkill(virt); /* kill procedure object manualy */
274 popmask(thispix); /* restore RPC mask from stack */
275 for (i = 0; i < length; i++) /* and modify it */
277 t1 = virtprot(M[ plist++ ]); /* prototype number */
278 if (t1 > 0) enable(thispix, t1);
279 else disable(thispix, -t1);
281 evaluaterpc(thispix); /* check for enabled RPCs */
288 * Return, end in procedures and functions without prefix.
290 void backpr(virtaddr *virt, word *am)
294 t2 = c1+M[ c1 ]+DL; /* DL pointer of current */
295 t1 = M[ t2 ]; /* ah of DL */
296 t3 = c1+M[ c1 ]+SL; /* SL pointer */
297 if (t1 == M[ t3 ] && M[ t2+1 ] == M[ t3+1 ]) backbl(virt, am); /* SL=DL */
298 else back1(t1, t2, virt, am);
301 /* End in classes and coroutines. */
302 void fin(word backic, virtaddr *virt, word *am)
306 knd = prototype[ M[ c1+PROTNUM ] ]->kind;
307 if (knd != COROUTINE && knd != PROCESS)
308 back(virt, am, (word) 0); /* a class - exit as above */
311 ic = backic; /* backspace ic */
313 t1 = M[ t2+DL ]; /* ah of DL */
316 if (M[ t2+SL ] == DUMMY) endprocess(0);
317 ic = 0; /* coroutine terminated */
324 back1(t1, t2+DL, virt, am);
329 /* Helper for attach/detach */
330 static void att2(virtaddr *virt, word ax, word at1)
334 t1 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
335 t2 = at1+M[ at1 ]+DL; /* DL of coroutine head */
336 M[ t2 ] = t1; /* loop up DL */
337 M[ t2+1 ] = M[ t1+1 ];
338 M[ c1+M[ c1 ]+LSC ] = ic; /* preserve local control */
340 phead = thisp->prochead;
341 storevirt(*virt, phead+M[ phead ]+CHD);
343 if (t2 == 0) errsignal(RTECORAC); /* coroutine active */
344 M[ ax+DL ] = 0; /* cut DL of new coroutine head */
347 c2 = c1+prototype[ M[ c1+PROTNUM ] ]->span;
348 ic = M[ c1+M[ c1 ]+LSC ];
349 if (ic == 0) errsignal(RTECORTM); /* coroutine terminated */
353 void attach(virtaddr *virt)
355 word t1, ax, phead, chead;
358 if (M[ virt->addr+1 ] != virt->mark) errsignal(RTEILLAT);
359 else ax = M[ virt->addr ]; /* am */
360 t1 = M[ ax+PROTNUM ];
361 if (t1 == AINT || t1 == AREAL || t1 == AVIRT || t1 == FILEOBJECT)
363 knd = prototype[ t1 ]->kind;
364 if (knd != COROUTINE && knd != PROCESS) errsignal(RTEILLAT);
366 phead = thisp->prochead;
367 chead = phead+M[ phead ]+CHD;
368 if (virt->addr != M[ chead ] || virt->mark != M[ chead+1 ])
370 M[ ax+CL ] = M[ chead ];
371 M[ ax+CL+1 ] = M[ chead+1 ];
372 att2(virt, ax, M[ M[ chead ] ]);
382 phead = thisp->prochead;
383 t1 = M[ M[ phead+M[ phead ]+CHD ] ]; /* am of coroutine head */
384 loadvirt(virt, t1+M[ t1 ]+CL); /* coroutine link */
385 if (M[ virt.addr+1 ] != virt.mark) errsignal(RTEILLDT);
386 att2(&virt, M[ virt.addr ]+M[ M[ virt.addr ] ], t1);
389 /* Simulate execution of inner */
390 void inner(word level)
395 ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */
396 t1 = ptr->lthpreflist;
398 if (level == t1-1) ic = ptr->codeaddr;
399 else ic = prototype[ M[ ptr->preflist+level ] ]->codeaddr;