sources/int/control.c

   1 /*     Loglan82 Compiler&Interpreter\r
   2      Copyright (C) 1993 Institute of Informatics, University of Warsaw\r
   3      Copyright (C)  1993, 1994 LITA, Pau\r
   4      \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
   9      \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
  14      \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
  18 \r
  19  contacts:  Andrzej.Salwicki@univ-pau.fr\r
  20 \r
  21 or             Andrzej Salwicki\r
  22                 LITA   Departement d'Informatique\r
  23                 Universite de Pau\r
  24                 Avenue de l'Universite\r
  25                 64000 Pau   FRANCE\r
  26                  tel.  ++33 59923154    fax. ++33 59841696\r
  27 \r
  28 =======================================================================\r
  29 */\r
  30 \r
  31 #include        "depend.h"\r
  32 #include        "genint.h"\r
  33 #include        "int.h"\r
  34 #include        "process.h"\r
  35 #include        "intproto.h"\r
  36 \r
  37 /* Transfer of control routines */\r
  38 \r
  39 #ifndef NO_PROTOTYPES\r
  40 static void att2(virtaddr *, word, word);\r
  41 static void back1(word, word, virtaddr *, word *);\r
  42 #else\r
  43 static void att2();\r
  44 static void back1();\r
  45 #endif\r
  46 \r
  47 /* Transfer control to the newly created object.\r
  48  */\r
  49 \r
  50 void go(ah, am)\r
  51 word ah, am;\r
  52 {\r
  53     protdescr *ptr;\r
  54     word pnum, plen, node, apt;\r
  55     message msg;\r
  56 \r
  57     ptr = prototype[ M[ am+PROTNUM ] ];\r
  58     apt = am+M[ am ];\r
  59     if (ptr->kind == PROCESS)           /* new process creation */\r
  60     {\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
  70 #       ifdef RPCDBG\r
  71         fprintf(\r
  72                 stderr, "send new process from %d to node %d\n",\r
  73                 thispix,\r
  74                 msg.control.receiver.node\r
  75                );\r
  76 #       endif\r
  77         passivate(WAITFORNEW);          /* and wait for return from process */\r
  78     }\r
  79     else\r
  80         if (isprocess((virtaddr*)(M+apt+SL)))   /* remote procedure call */\r
  81         {\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
  85             {\r
  86                virtaddr v;\r
  87                loadvirt( v, apt+SL );\r
  88                obj2mess( M, &v, &msg.control.receiver );\r
  89 #              ifdef RPCDBG\r
  90                fprintf(\r
  91                         stderr, "send rpc from process %d to (%d,%d,%d)\n",\r
  92                         thispix,\r
  93                         msg.control.receiver.node,\r
  94                         msg.control.receiver.pix,\r
  95                         msg.control.receiver.mark\r
  96                       );\r
  97 #              endif\r
  98             }\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
 104         }\r
 105         else\r
 106         {\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
 111             c2 = c1+ptr->span;\r
 112             pnum = ptr->preflist;\r
 113             plen = ptr->lthpreflist;\r
 114             while (TRUE)                /* search for executable prefix */\r
 115                 if (plen <= 1)\r
 116                 {\r
 117                     ic = ptr->codeaddr;\r
 118                     break;\r
 119                 }\r
 120                 else\r
 121                 {\r
 122                     ptr = prototype[ M[ pnum ] ];\r
 123                     plen--;\r
 124                     pnum++;\r
 125                     if (ptr->kind != RECORD) plen = 0;\r
 126                 }\r
 127         }\r
 128 }\r
 129 \r
 130 \r
 131 /* Transfer control to a local unprefixed procedure, function, block,\r
 132  * class or coroutine.\r
 133  */\r
 134 \r
 135 void goloc(ah, am)\r
 136 word ah, am;\r
 137 {\r
 138     word t1;\r
 139     protdescr *ptr;\r
 140 \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
 145     c2 = am+ptr->span;\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
 150 }\r
 151 \r
 152 \r
 153 void backbl(virt, am)                   /* Return from block. */\r
 154 virtaddr *virt;\r
 155 word *am;\r
 156 {\r
 157     word t1;\r
 158 \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
 164     t1 = c1+M[ c1 ];\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
 172 }\r
 173 \r
 174 \r
 175 static void back1(at1, at2, virt, am)   /* Common code for some backs below. */\r
 176 word at1, at2;\r
 177 virtaddr *virt;\r
 178 word *am;\r
 179 {\r
 180     word t1;\r
 181 \r
 182     loosen();\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
 190     update(at2, at1);\r
 191     c1 = at2;\r
 192     c2 = c1 + prototype[ M[ c1+PROTNUM ] ]->span;\r
 193     ic = M[ c1+M[ c1 ]+LSC ];\r
 194 }\r
 195 \r
 196 \r
 197 /* Return from classes, coroutines and by end from procedures.\r
 198  */\r
 199 \r
 200 void back(virt, am, length)\r
 201 virtaddr *virt;\r
 202 word *am;\r
 203 word length;\r
 204 {\r
 205     word t1, t2, plist;\r
 206     int i;\r
 207     protdescr *ptr;\r
 208     message msg;\r
 209 \r
 210     t2 = c1+M[ c1 ];\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
 214     {\r
 215 #       ifdef RPCDBG\r
 216         fprintf( stderr, "return from process %d\n", thispix );\r
 217 #       endif\r
 218         if (M[ c1+PROTNUM ] == MAINBLOCK) endprocess(0);\r
 219         {\r
 220            virtaddr v;\r
 221            loadvirt( v, t2+DL );\r
 222            obj2mess( M, &v, &msg.control.receiver ); /* father process */\r
 223         }\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
 229     }\r
 230     else\r
 231         if (ptr->kind == COROUTINE)\r
 232         {\r
 233             if (t1 != 0)                /* nothing if detached */\r
 234             {\r
 235                 M[ t2+LSC ] = ic;\r
 236                 back1(t1, t2+DL, virt, am);\r
 237             }\r
 238         }\r
 239         else\r
 240         {\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
 243                 backbl(virt, am);\r
 244             else\r
 245                 back1(t1, t2+DL, virt, am);\r
 246 \r
 247 /*\r
 248 #           ifdef RPCDBG\r
 249             fprintf(\r
 250                      stderr, "back (thisp=%d) from %s to %s\n",\r
 251                      thispix,\r
 252                      (\r
 253                        (ptr->kind==PROCEDURE) ?\r
 254                          "PROCEDURE"          :\r
 255                        (ptr->kind==FUNCTION)  ?\r
 256                          "FUNCTION"           :\r
 257                          "???"\r
 258                      ),\r
 259                      isprocess((virtaddr*)(M+t2+RPCDL)) ? "PROCESS" : "OBJECT"\r
 260                    );\r
 261 #           endif\r
 262 */\r
 263             if ((ptr->kind == PROCEDURE || ptr->kind == FUNCTION) &&\r
 264                 isprocess((virtaddr*)(M+t2+RPCDL)))\r
 265             {\r
 266                 {\r
 267                    virtaddr v;\r
 268                    loadvirt( v, t2+RPCDL );\r
 269                    obj2mess( M, &v, &msg.control.receiver ); /* remote DL */\r
 270                 }\r
 271 #               ifdef RPCDBG\r
 272                 fprintf(\r
 273                          stderr, "send rpc ack from process %d to (%d,%d,%d)\n",\r
 274                          thispix,\r
 275                          msg.control.receiver.node,\r
 276                          msg.control.receiver.pix,\r
 277                          msg.control.receiver.mark\r
 278                        );\r
 279 #               endif\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
 286                 {\r
 287                     t1 = virtprot(M[ plist++ ]);  /* prototype number */\r
 288                     if (t1 > 0) enable(thispix, t1);\r
 289                     else disable(thispix, -t1);\r
 290                 }\r
 291                 evaluaterpc(thispix);   /* check for enabled RPCs */\r
 292             }\r
 293         }\r
 294 }\r
 295 \r
 296 \r
 297 /* Return, end in procedures and functions without prefix.\r
 298  */\r
 299 \r
 300 void backpr(virt, am)\r
 301 virtaddr *virt;\r
 302 word *am;\r
 303 {\r
 304     word t1, t2, t3;\r
 305 \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
 311 }\r
 312 \r
 313 \r
 314 void fin(backic, virt, am)              /* End in classes and coroutines. */\r
 315 word backic;\r
 316 virtaddr *virt;\r
 317 word *am;\r
 318 {\r
 319     word t1, t2, knd;\r
 320 \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
 324     else\r
 325     {\r
 326         ic = backic;                    /* backspace ic */\r
 327         t2 = c1+M[ c1 ];\r
 328         t1 = M[ t2+DL ];                /* ah of DL */\r
 329         if (t1 == 0)\r
 330         {\r
 331             if (M[ t2+SL ] == DUMMY) endprocess(0);\r
 332             ic = 0;                     /* coroutine terminated */\r
 333             *am = 0;\r
 334             detach();\r
 335         }\r
 336         else\r
 337         {\r
 338             M[ t2+LSC ] = ic;\r
 339             back1(t1, t2+DL, virt, am);\r
 340         }\r
 341     }\r
 342 }\r
 343 \r
 344 \r
 345 static void att2(virt, ax, at1)         /* Helper for attach/detach */\r
 346 virtaddr *virt;\r
 347 word ax, at1;\r
 348 {\r
 349     word t1, t2, phead;\r
 350 \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
 356     loosen();\r
 357     phead = thisp->prochead;\r
 358     storevirt(*virt, phead+M[ phead ]+CHD);\r
 359     t2 = M[ ax+DL ];\r
 360     if (t2 == 0) errsignal(RTECORAC);   /* coroutine active */\r
 361     M[ ax+DL ] = 0;                     /* cut DL of new coroutine head */\r
 362     c1 = M[ t2 ];\r
 363     update(c1, t2);\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
 367 }\r
 368 \r
 369 \r
 370 void attach(virt)\r
 371 virtaddr *virt;\r
 372 {\r
 373     word t1, ax, phead, chead;\r
 374     int knd;\r
 375 \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
 383     ax = ax+M[ ax ];\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
 387     {\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
 391     }\r
 392 }\r
 393 \r
 394 \r
 395 void detach()\r
 396 {\r
 397     virtaddr virt;\r
 398     word t1, phead;\r
 399 \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
 405 }\r
 406 \r
 407 \r
 408 void inner(level)                       /* Simulate execution of inner */\r
 409 word level;\r
 410 {\r
 411     word t1;\r
 412     protdescr *ptr;\r
 413 \r
 414     ptr = prototype[ M[ c1+PROTNUM ] ]; /* prototype of current */\r
 415     t1 = ptr->lthpreflist;\r
 416     if (t1 != level)\r
 417         if (level == t1-1) ic = ptr->codeaddr;\r
 418         else ic = prototype[ M[ ptr->preflist+level ] ]->codeaddr;\r
 419 }\r
 420 \r
 421 \r