sources/new-s5r4/runsys.c

   1      /* Loglan82 Compiler&Interpreter
   2      Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
   3      Copyright (C)  1993, 1994 LITA, Pau
   4
   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.
   9
  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.
  14
  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.
  18
  19  contacts:  Andrzej.Salwicki@univ-pau.fr
  20
  21 or             Andrzej Salwicki
  22                 LITA   Departement d'Informatique
  23                 Universite de Pau
  24                 Avenue de l'Universite
  25                 64000 Pau   FRANCE
  26                  tel.  ++33 59923154    fax. ++33 59841696
  27
  28 =======================================================================
  29 */
  30
  31 #include        "depend.h"
  32 #include        "genint.h"
  33 #include        "int.h"
  34 #include        "process.h"
  35 #include        "intproto.h"
  36
  37
  38 /* Initialize memory structures for objects, main object and a few goodies
  39  * more.
  40  */
  41
  42 void runsys()
  43 {
  44     word apt, i;
  45     procaddr father;
  46
  47     for (i = 0;  i < MAXPROCESS;  i++ ) /* initialize process descriptors */
  48     {
  49         process[ i ].used = FALSE;     /* not used */
  50         process[ i ].mark = -1;               /* initial mark for processes */
  51         process[ i ].M = NULL;         /* memory not allocated */
  52         process[ i ].hash = NULL;
  53     }
  54     process[ 0 ].M = M;                /* always contains code */
  55     dispoff = VIRTSC-(lastprot+1);      /* DISPLAY offset in process object */
  56     disp2off = dispoff-(lastprot+1);    /* indirect DISPLAY offset */
  57     ready = qinit();         /* initialize Round-Robin queue */
  58     ranset();              /* init pseudo-random no. generator */
  59
  60 #if OS2
  61     {
  62         SEL gsel, lsel;
  63         DosGetInfoSeg(&gsel, &lsel);
  64         ginf = MAKEPGINFOSEG(gsel);
  65     }
  66 #endif
  67
  68     if (!remote)                     /* create main process */
  69     {
  70         father.node = 0;     /* dummy DL for generated process */
  71         father.pix  = 0;
  72         father.mark = 0;
  73         thispix = 0;                       /* current process index */
  74         thisp = &process[ thispix ];       /* current process descr pointer */
  75         initprocess((word) 0, (word) MAINBLOCK, &father);
  76         mainprog = thisp->prochead;        /* am of main */
  77         c1 = thisp->c1;            /* pointers to current object */
  78         c2 = thisp->c2;
  79         ic = thisp->ic;         /* instruction counter */
  80         param = thisp->param;           /* parameter vector */
  81         apt = mainprog+M[ mainprog ];      /* LWA+1 of main */
  82         display = apt+dispoff;         /* DISPLAY in main */
  83         display2 = apt+disp2off;   /* indirect DISPLAY in main */
  84         mnoff = 2;                /* offset of variable mainprog */
  85         storevirt(thisp->procref, mainprog+mnoff);  /* init variable main */
  86         M[ apt+STATSL ]++;         /* flag main included in SL chain */
  87         thisp->status = STOPPED;
  88         activate(thispix);         /* activate main process */
  89     }
  90     else  /* remote */
  91     {
  92         thispix = 1;                  /* a dirty trick: set junk current */
  93         thisp = &process[ thispix ];       /* process for first transfer() */
  94     }                     /* (must save 'context' somewhere) */
  95 #if DLINK
  96     net_attention();
  97 #endif
  98 }
  99
 100
 101 void initprocess(pix, prot, father)     /* Initialize process descriptor */
 102 word pix, prot;
 103 procaddr *father;
 104 {
 105     procdescr *p;
 106     protdescr *ptr;
 107     word i, j, ah, am, apt;
 108
 109 #ifdef RPCDBG
 110 fprintf(stderr,"new process(n,p,m) (%d,%d,%d)",0,pix,process[pix].mark);
 111 fprintf(stderr," from (%d,%d,%d)\n",father->node,father->pix,father->mark);
 112 #endif
 113
 114             p = &process[ pix ];
 115
 116 #ifdef OBJECTADDR
 117     hash_create(p,119);
 118 #endif
 119     p->used = TRUE;            /* process descriptor is used */
 120     p->prot = prot;            /* prototype number */
 121     p->freeitem = 0;         /* null list of free dictionary items */
 122     p->upper = memorysize-1;       /* highest memory address */
 123     p->lower = freem;      /* lowest address for data */
 124     p->headk = p->lower;               /* head of killed objects list */
 125     p->M[ p->headk ] = MAXAPPT;         /* maximum appetite sentinel */
 126     p->headk2 = 0;
 127     ah = p->upper-1;         /* dict. item for process itself */
 128     p->lastitem = ah;      /* first word used by dictionary */
 129     ptr = prototype[ prot ];
 130     if (p->upper - p->lower - ptr->appetite < 512)
 131         if (prot == MAINBLOCK)
 132             abend("Memory size too small (use /m option)\n");
 133         else errsignal(RTEMEMOV);
 134
 135     /* generate process object */
 136     p->lastused = p->lower+ptr->appetite;
 137     am = p->lower+1;
 138     p->M[ am ] = ptr->appetite;
 139     p->M[ am+PROTNUM ] = prot;
 140     for (i = PROTNUM+1;  i < ptr->appetite;  i++)
 141         p->M[ am+i ] = 0;
 142     p->M[ ah   ] = am;
 143     p->M[ ah+1 ] = 0;
 144     p->prochead = am;
 145     p->procref.addr = ah;
 146     p->procref.mark = 0;
 147     p->c1 = am;                      /* initialize current object ptrs */
 148     p->c2 = am+ptr->span;
 149     apt = am+ptr->appetite;
 150     p->M[ apt+CHD ] = ah;             /* initialize coroutine head ptr */
 151     p->M[ apt+CHD+1 ] = 0;
 152     p->M[ apt+SL ] = DUMMY;         /* dummy SL for process */
 153     p->M[ 1 ] = 1;               /* absolute none */
 154     for (i = MAINBLOCK;  i <= lastprot;  i++)  /* initialize DISPLAY */
 155         p->M[ apt+dispoff+i ] = 0;
 156     p->M[ apt+disp2off+MAINBLOCK ] = DUMMY;     /* dummmy entry for MAIN */
 157     j = ptr->preflist;           /* set DISPLAY entries for process */
 158
 159     for (i = j+ptr->lthpreflist-1;  i >= j;  i--)
 160     {
 161         p->M[ apt+dispoff+M[ i ] ] = am;       /* physical address */
 162         p->M[ apt+disp2off+M[ i ] ] = ah;      /* indirect address */
 163     }
 164
 165     {
 166        virtaddr v;
 167        mess2obj( p, father, &v );
 168        p->M[ apt+DL ] = v.addr;
 169        p->M[ apt+DL+1 ] = v.mark;
 170     }
 171     p->msgqueue = qinit();
 172     p->rpcwait = qinit();
 173     p->rpcmask = sinit();
 174     pushmask(pix);               /* initialy all RPCs are disabled */
 175     p->trlnumber = 0;      /* trace line number */
 176     i = ptr->preflist;           /* search for executable prefix */
 177     while (prototype[ p->M[ i ] ]->kind == RECORD) i++;
 178     p->ic = prototype[ M[ i ] ]->codeaddr;  /* first instruction address */
 179 #if RPCDBG
 180 fprintf(stderr,"first instruction address %d of new process %d\n", p->ic, pix );
 181 #endif
 182     p->force_compactification=FALSE;
 183 }
 184
 185
 186 bool member(virt, am)
 187 virtaddr *virt;
 188 word *am;
 189 {
 190     *am = M[ virt->addr ];
 191     return (virt->mark == M[ virt->addr+1 ]);
 192 }
 193
 194
 195 void update(am, ah)                     /* Update DISPLAY */
 196 word am, ah;
 197 {
 198     word t1, t2, t3, t4, t5, t6;
 199     protdescr *ptr;
 200
 201     while (TRUE)
 202     {
 203         t1 = am+M[ am ];
 204         M[ t1+STATSL ]++;               /* flag object included in SL */
 205         ptr = prototype[ M[ am+PROTNUM ] ];
 206         t2 = ptr->preflist;
 207         t3 = t2+ptr->lthpreflist-1;
 208         for (t4 = t3;  t4 >= t2;  t4-- )
 209         {
 210             t6 = M[ t4 ];
 211             t5 = display+t6;
 212             if (M[ t5 ] == 0)           /* entry to be updated */
 213             {
 214                 M[ t5 ] = am;
 215                 M[ display2+t6 ] = ah;
 216             }
 217         }
 218         ah = M[ t1+SL ];
 219         if (ah == DUMMY) break;
 220         if (M[ ah+1 ] != M[ t1+SL+1 ])  errsignal(RTESLCOF);
 221         am = M[ ah ];
 222     }
 223 }
 224
 225
 226 void loosen()                           /* Loosen DISPLAY */
 227 {
 228     word t1, t2, t3;
 229     protdescr *ptr;
 230
 231     t1 = c1;
 232     while (TRUE)
 233     {
 234         ptr = prototype[ M[ t1+PROTNUM ] ];
 235         t2 = ptr->preflist;
 236         for (t3 = t2+ptr->lthpreflist-1;  t3 >= t2;  t3-- )
 237             M[ display+M[ t3 ] ] = 0;
 238         t3 = t1+M[ t1 ];
 239         M[ t3+STATSL ]--;               /* flag object removed from SL */
 240         t1 = M[ t3+SL ];                /* ah of SL */
 241         if (t1 == DUMMY) break;         /* still not main */
 242         t1 = M[ t1 ];                   /* am of SL */
 243     }
 244 }
 245
 246
 247 static int tracecnt = 0;               /* To count trace messages in line */
 248
 249 void trace(lineno)                      /* Trace the program if debug mode */
 250 word lineno;
 251 {
 252     thisp->trlnumber = lineno;
 253     if (debug && lineno > 0)
 254     {
 255         tracecnt++;
 256         if (tracecnt == MAXTRACNT)      /* change line */
 257         {
 258             tracecnt = 0;
 259             fprintf(tracefile, "\n");
 260         }
 261         fprintf(tracefile, "%6ld", (long) lineno);
 262     }
 263     trapmsg();                       /* check for waiting message */
 264     rpc2();              /* check for RPC message */
 265 }
 266
 267
 268 void endrun(status)
 269 int status;
 270 {
 271     fflush(stdout);
 272
 273     fprintf(stderr, "\n\nEnd of LOGLAN-82 program execution\n");fflush(stderr);
 274 #if DLINK
 275     net_logoff();
 276 #endif
 277     if (debug) fclose(tracefile);
 278     exit(status);
 279 }
 280
 281