1 /* Loglan82 Compiler&Interpreter
\r
2 Copyright (C) 1993 Institute of Informatics, University of Warsaw
\r
3 Copyright (C) 1993, 1994 LITA, Pau
\r
5 This program is free software; you can redistribute it and/or modify
\r
6 it under the terms of the GNU General Public License as published by
\r
7 the Free Software Foundation; either version 2 of the License, or
\r
8 (at your option) any later version.
\r
10 This program is distributed in the hope that it will be useful,
\r
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
\r
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\r
13 GNU General Public License for more details.
\r
15 You should have received a copy of the GNU General Public License
\r
16 along with this program; if not, write to the Free Software
\r
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
\r
19 contacts: Andrzej.Salwicki@univ-pau.fr
\r
22 LITA Departement d'Informatique
\r
24 Avenue de l'Universite
\r
26 tel. ++33 59923154 fax. ++33 59841696
\r
28 =======================================================================
\r
34 #include "process.h"
\r
35 #include "intproto.h"
\r
37 /* Transfer of control routines */
\r
39 #ifndef NO_PROTOTYPES
\r
40 static void att2(virtaddr *, word, word);
\r
41 static void back1(word, word, virtaddr *, word *);
\r
44 static void back1();
\r
47 /* Transfer control to the newly created object.
\r
54 word pnum, plen, node, apt;
\r
57 ptr = prototype[ M[ am+PROTNUM ] ];
\r
59 if (ptr->kind == PROCESS) /* new process creation */
\r
61 thisp->template.addr = ah; /* save template address */
\r
62 thisp->template.mark = M[ ah+1 ];
\r
63 msg.control.type = CREATE;
\r
64 msg.control.par = M[ am+PROTNUM ];
\r
65 moveparams(thispix, am, &msg, PARIN, LOADPAR);
\r
66 msg.control.receiver.pix = 0; /* pix will create receiver */
\r
67 msg.control.receiver.mark= 0; /* mark will create receiver */
\r
68 msg.control.receiver.node = getnode(am); /* node we decided */
\r
69 sendmsg( &msg); /* send create request */
\r
72 stderr, "send new process from %d to node %d\n",
\r
74 msg.control.receiver.node
\r
77 passivate(WAITFORNEW); /* and wait for return from process */
\r
80 if (isprocess((virtaddr*)(M+apt+SL))) /* remote procedure call */
\r
82 thisp->backobj.addr = ah; /* save template address */
\r
83 thisp->backobj.mark = M[ ah+1 ];
\r
84 thisp->M[ temporary ] = am; /* physical address also */
\r
87 loadvirt( v, apt+SL );
\r
88 obj2mess( M, &v, &msg.control.receiver );
\r
91 stderr, "send rpc from process %d to (%d,%d,%d)\n",
\r
93 msg.control.receiver.node,
\r
94 msg.control.receiver.pix,
\r
95 msg.control.receiver.mark
\r
99 msg.control.type = RPCALL;
\r
100 msg.control.par = M[ am+PROTNUM ];
\r
101 moveparams(thispix, am, &msg, PARIN, LOADPAR);
\r
102 sendmsg( &msg); /* send RPC request */
\r
103 passivate(WAITFORRPC); /* and wait for RP return */
\r
107 M[ c1+M[ c1 ]+LSC ] = ic; /* save local control */
\r
108 loosen(); /* release DISPLAY */
\r
109 update(am, ah); /* update DISPLAY */
\r
110 c1 = am; /* new current */
\r
112 pnum = ptr->preflist;
\r
113 plen = ptr->lthpreflist;
\r
114 while (TRUE) /* search for executable prefix */
\r
117 ic = ptr->codeaddr;
\r
122 ptr = prototype[ M[ pnum ] ];
\r
125 if (ptr->kind != RECORD) plen = 0;
\r
131 /* Transfer control to a local unprefixed procedure, function, block,
\r
132 * class or coroutine.
\r
141 M[ c1+M[ c1 ]+LSC ] = ic; /* save local control */
\r
142 c1 = am; /* new current */
\r
143 t1 = M[ am+PROTNUM ];
\r
144 ptr = prototype[ t1 ];
\r
146 ic = ptr->codeaddr;
\r
147 M[ display+t1 ] = am; /* simulate update display */
\r
148 M[ display2+t1 ] = ah;
\r
149 M[ am+M[ am ]+STATSL ]++;
\r
153 void backbl(virt, am) /* Return from block. */
\r
159 t1 = M[ c1+PROTNUM ];
\r
160 virt->addr = M[ display2+t1 ];
\r
161 virt->mark = M[ virt->addr+1 ]; /* prepare old address */
\r
162 *am = c1; /* am of old */
\r
163 M[ display+t1 ] = 0; /* simulate loosen */
\r
165 M[ t1+STATSL ]--; /* remove from SL chain */
\r
166 c1 = M[ t1+SL ]; /* return up along SL */
\r
167 if (c1 == DUMMY) endprocess(0); /* return from main */
\r
168 c1 = M[ c1 ]; /* am of new current */
\r
169 c2 = c1+prototype[ M[ c1+PROTNUM ] ]->span;
\r
170 ic = M[ c1+M[ c1 ]+LSC ];
\r
171 storevirt(*virt, *am+M[ *am ]+DL); /* force DL consistency */
\r
175 static void back1(at1, at2, virt, am) /* Common code for some backs below. */
\r
183 if (at1 == 0) endprocess(0);
\r
184 t1 = M[ c1+PROTNUM ];
\r
185 virt->addr = M[ display2+t1 ]; /* ah of old */
\r
186 virt->mark = M[ virt->addr+1 ];
\r
187 *am = c1; /* am of old */
\r
188 storevirt(*virt, at2); /* loop up DL */
\r
189 at2 = M[ at1 ]; /* am of DL */
\r
192 c2 = c1 + prototype[ M[ c1+PROTNUM ] ]->span;
\r
193 ic = M[ c1+M[ c1 ]+LSC ];
\r
197 /* Return from classes, coroutines and by end from procedures.
\r
200 void back(virt, am, length)
\r
205 word t1, t2, plist;
\r
211 t1 = M[ t2+DL ]; /* ah of DL */
\r
212 ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */
\r
213 if (ptr->kind == PROCESS) /* RETURN in process */
\r
216 fprintf( stderr, "return from process %d\n", thispix );
\r
218 if (M[ c1+PROTNUM ] == MAINBLOCK) endprocess(0);
\r
221 loadvirt( v, t2+DL );
\r
222 obj2mess( M, &v, &msg.control.receiver ); /* father process */
\r
224 msg.control.type = CREACK;
\r
225 moveparams(thispix, c1, &msg, PAROUT, LOADPAR);
\r
226 sendmsg(&msg); /* send create acknowledge */
\r
227 M[ t2+DL ] = 0; /* cut DL of new process head */
\r
228 passivate(STOPPED); /* and suspend new process */
\r
231 if (ptr->kind == COROUTINE)
\r
233 if (t1 != 0) /* nothing if detached */
\r
236 back1(t1, t2+DL, virt, am);
\r
241 plist = ic; /* save begining of prototype list */
\r
242 if (ptr->lthpreflist==1 && t1==M[t2+SL] && M[t2+DL+1]==M[t2+SL+1])
\r
245 back1(t1, t2+DL, virt, am);
\r
250 stderr, "back (thisp=%d) from %s to %s\n",
\r
253 (ptr->kind==PROCEDURE) ?
\r
255 (ptr->kind==FUNCTION) ?
\r
259 isprocess((virtaddr*)(M+t2+RPCDL)) ? "PROCESS" : "OBJECT"
\r
263 if ((ptr->kind == PROCEDURE || ptr->kind == FUNCTION) &&
\r
264 isprocess((virtaddr*)(M+t2+RPCDL)))
\r
268 loadvirt( v, t2+RPCDL );
\r
269 obj2mess( M, &v, &msg.control.receiver ); /* remote DL */
\r
273 stderr, "send rpc ack from process %d to (%d,%d,%d)\n",
\r
275 msg.control.receiver.node,
\r
276 msg.control.receiver.pix,
\r
277 msg.control.receiver.mark
\r
280 msg.control.type = RPCACK;
\r
281 moveparams(thispix, *am, &msg, PAROUT, LOADPAR);
\r
282 sendmsg(&msg); /* send RP return - acknowledge */
\r
283 gkill(virt); /* kill procedure object manualy */
\r
284 popmask(thispix); /* restore RPC mask from stack */
\r
285 for (i = 0; i < length; i++) /* and modify it */
\r
287 t1 = virtprot(M[ plist++ ]); /* prototype number */
\r
288 if (t1 > 0) enable(thispix, t1);
\r
289 else disable(thispix, -t1);
\r
291 evaluaterpc(thispix); /* check for enabled RPCs */
\r
297 /* Return, end in procedures and functions without prefix.
\r
300 void backpr(virt, am)
\r
306 t2 = c1+M[ c1 ]+DL; /* DL pointer of current */
\r
307 t1 = M[ t2 ]; /* ah of DL */
\r
308 t3 = c1+M[ c1 ]+SL; /* SL pointer */
\r
309 if (t1 == M[ t3 ] && M[ t2+1 ] == M[ t3+1 ]) backbl(virt, am); /* SL=DL */
\r
310 else back1(t1, t2, virt, am);
\r
314 void fin(backic, virt, am) /* End in classes and coroutines. */
\r
321 knd = prototype[ M[ c1+PROTNUM ] ]->kind;
\r
322 if (knd != COROUTINE && knd != PROCESS)
\r
323 back(virt, am, (word) 0); /* a class - exit as above */
\r
326 ic = backic; /* backspace ic */
\r
328 t1 = M[ t2+DL ]; /* ah of DL */
\r
331 if (M[ t2+SL ] == DUMMY) endprocess(0);
\r
332 ic = 0; /* coroutine terminated */
\r
339 back1(t1, t2+DL, virt, am);
\r
345 static void att2(virt, ax, at1) /* Helper for attach/detach */
\r
349 word t1, t2, phead;
\r
351 t1 = M[ display2+M[ c1+PROTNUM ] ]; /* ah of current */
\r
352 t2 = at1+M[ at1 ]+DL; /* DL of coroutine head */
\r
353 M[ t2 ] = t1; /* loop up DL */
\r
354 M[ t2+1 ] = M[ t1+1 ];
\r
355 M[ c1+M[ c1 ]+LSC ] = ic; /* preserve local control */
\r
357 phead = thisp->prochead;
\r
358 storevirt(*virt, phead+M[ phead ]+CHD);
\r
360 if (t2 == 0) errsignal(RTECORAC); /* coroutine active */
\r
361 M[ ax+DL ] = 0; /* cut DL of new coroutine head */
\r
364 c2 = c1+prototype[ M[ c1+PROTNUM ] ]->span;
\r
365 ic = M[ c1+M[ c1 ]+LSC ];
\r
366 if (ic == 0) errsignal(RTECORTM); /* coroutine terminated */
\r
373 word t1, ax, phead, chead;
\r
376 if (M[ virt->addr+1 ] != virt->mark) errsignal(RTEILLAT);
\r
377 else ax = M[ virt->addr ]; /* am */
\r
378 t1 = M[ ax+PROTNUM ];
\r
379 if (t1 == AINT || t1 == AREAL || t1 == AVIRT || t1 == FILEOBJECT)
\r
380 errsignal(RTEILLAT);
\r
381 knd = prototype[ t1 ]->kind;
\r
382 if (knd != COROUTINE && knd != PROCESS) errsignal(RTEILLAT);
\r
384 phead = thisp->prochead;
\r
385 chead = phead+M[ phead ]+CHD;
\r
386 if (virt->addr != M[ chead ] || virt->mark != M[ chead+1 ])
\r
388 M[ ax+CL ] = M[ chead ];
\r
389 M[ ax+CL+1 ] = M[ chead+1 ];
\r
390 att2(virt, ax, M[ M[ chead ] ]);
\r
400 phead = thisp->prochead;
\r
401 t1 = M[ M[ phead+M[ phead ]+CHD ] ]; /* am of coroutine head */
\r
402 loadvirt(virt, t1+M[ t1 ]+CL); /* coroutine link */
\r
403 if (M[ virt.addr+1 ] != virt.mark) errsignal(RTEILLDT);
\r
404 att2(&virt, M[ virt.addr ]+M[ M[ virt.addr ] ], t1);
\r
408 void inner(level) /* Simulate execution of inner */
\r
414 ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */
\r
415 t1 = ptr->lthpreflist;
\r
417 if (level == t1-1) ic = ptr->codeaddr;
\r
418 else ic = prototype[ M[ ptr->preflist+level ] ]->codeaddr;
\r