/* Loglan82 Compiler&Interpreter Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw Copyright (C) 1993, 1994 LITA, Pau This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. contacts: Andrzej.Salwicki@univ-pau.fr or Andrzej Salwicki LITA Departement d'Informatique Universite de Pau Avenue de l'Universite 64000 Pau FRANCE tel. ++33 59923154 fax. ++33 59841696 ======================================================================= */ #include "depend.h" #include "genint.h" #include "int.h" #include "process.h" #include "intproto.h" /* Initialize memory structures for objects, main object and a few goodies * more. */ void runsys() { word apt, i; procaddr father; for (i = 0; i < MAXPROCESS; i++ ) /* initialize process descriptors */ { process[ i ].used = FALSE; /* not used */ process[ i ].mark = -1; /* initial mark for processes */ process[ i ].M = NULL; /* memory not allocated */ process[ i ].hash = NULL; } process[ 0 ].M = M; /* always contains code */ dispoff = VIRTSC-(lastprot+1); /* DISPLAY offset in process object */ disp2off = dispoff-(lastprot+1); /* indirect DISPLAY offset */ ready = qinit(); /* initialize Round-Robin queue */ ranset(); /* init pseudo-random no. generator */ #if OS2 { SEL gsel, lsel; DosGetInfoSeg(&gsel, &lsel); ginf = MAKEPGINFOSEG(gsel); } #endif if (!remote) /* create main process */ { father.node = 0; /* dummy DL for generated process */ father.pix = 0; father.mark = 0; thispix = 0; /* current process index */ thisp = &process[ thispix ]; /* current process descr pointer */ initprocess((word) 0, (word) MAINBLOCK, &father); mainprog = thisp->prochead; /* am of main */ c1 = thisp->c1; /* pointers to current object */ c2 = thisp->c2; ic = thisp->ic; /* instruction counter */ param = thisp->param; /* parameter vector */ apt = mainprog+M[ mainprog ]; /* LWA+1 of main */ display = apt+dispoff; /* DISPLAY in main */ display2 = apt+disp2off; /* indirect DISPLAY in main */ mnoff = 2; /* offset of variable mainprog */ storevirt(thisp->procref, mainprog+mnoff); /* init variable main */ M[ apt+STATSL ]++; /* flag main included in SL chain */ thisp->status = STOPPED; activate(thispix); /* activate main process */ } else /* remote */ { thispix = 1; /* a dirty trick: set junk current */ thisp = &process[ thispix ]; /* process for first transfer() */ } /* (must save 'context' somewhere) */ #if DLINK net_attention(); #endif } void initprocess(pix, prot, father) /* Initialize process descriptor */ word pix, prot; procaddr *father; { procdescr *p; protdescr *ptr; word i, j, ah, am, apt; #ifdef RPCDBG fprintf(stderr,"new process(n,p,m) (%d,%d,%d)",0,pix,process[pix].mark); fprintf(stderr," from (%d,%d,%d)\n",father->node,father->pix,father->mark); #endif p = &process[ pix ]; #ifdef OBJECTADDR hash_create(p,119); #endif p->used = TRUE; /* process descriptor is used */ p->prot = prot; /* prototype number */ p->freeitem = 0; /* null list of free dictionary items */ p->upper = memorysize-1; /* highest memory address */ p->lower = freem; /* lowest address for data */ p->headk = p->lower; /* head of killed objects list */ p->M[ p->headk ] = MAXAPPT; /* maximum appetite sentinel */ p->headk2 = 0; ah = p->upper-1; /* dict. item for process itself */ p->lastitem = ah; /* first word used by dictionary */ ptr = prototype[ prot ]; if (p->upper - p->lower - ptr->appetite < 512) if (prot == MAINBLOCK) abend("Memory size too small (use /m option)\n"); else errsignal(RTEMEMOV); /* generate process object */ p->lastused = p->lower+ptr->appetite; am = p->lower+1; p->M[ am ] = ptr->appetite; p->M[ am+PROTNUM ] = prot; for (i = PROTNUM+1; i < ptr->appetite; i++) p->M[ am+i ] = 0; p->M[ ah ] = am; p->M[ ah+1 ] = 0; p->prochead = am; p->procref.addr = ah; p->procref.mark = 0; p->c1 = am; /* initialize current object ptrs */ p->c2 = am+ptr->span; apt = am+ptr->appetite; p->M[ apt+CHD ] = ah; /* initialize coroutine head ptr */ p->M[ apt+CHD+1 ] = 0; p->M[ apt+SL ] = DUMMY; /* dummy SL for process */ p->M[ 1 ] = 1; /* absolute none */ for (i = MAINBLOCK; i <= lastprot; i++) /* initialize DISPLAY */ p->M[ apt+dispoff+i ] = 0; p->M[ apt+disp2off+MAINBLOCK ] = DUMMY; /* dummmy entry for MAIN */ j = ptr->preflist; /* set DISPLAY entries for process */ for (i = j+ptr->lthpreflist-1; i >= j; i--) { p->M[ apt+dispoff+M[ i ] ] = am; /* physical address */ p->M[ apt+disp2off+M[ i ] ] = ah; /* indirect address */ } { virtaddr v; mess2obj( p, father, &v ); p->M[ apt+DL ] = v.addr; p->M[ apt+DL+1 ] = v.mark; } p->msgqueue = qinit(); p->rpcwait = qinit(); p->rpcmask = sinit(); pushmask(pix); /* initialy all RPCs are disabled */ p->trlnumber = 0; /* trace line number */ i = ptr->preflist; /* search for executable prefix */ while (prototype[ p->M[ i ] ]->kind == RECORD) i++; p->ic = prototype[ M[ i ] ]->codeaddr; /* first instruction address */ #if RPCDBG fprintf(stderr,"first instruction address %d of new process %d\n", p->ic, pix ); #endif p->force_compactification=FALSE; } bool member(virt, am) virtaddr *virt; word *am; { *am = M[ virt->addr ]; return (virt->mark == M[ virt->addr+1 ]); } void update(am, ah) /* Update DISPLAY */ word am, ah; { word t1, t2, t3, t4, t5, t6; protdescr *ptr; while (TRUE) { t1 = am+M[ am ]; M[ t1+STATSL ]++; /* flag object included in SL */ ptr = prototype[ M[ am+PROTNUM ] ]; t2 = ptr->preflist; t3 = t2+ptr->lthpreflist-1; for (t4 = t3; t4 >= t2; t4-- ) { t6 = M[ t4 ]; t5 = display+t6; if (M[ t5 ] == 0) /* entry to be updated */ { M[ t5 ] = am; M[ display2+t6 ] = ah; } } ah = M[ t1+SL ]; if (ah == DUMMY) break; if (M[ ah+1 ] != M[ t1+SL+1 ]) errsignal(RTESLCOF); am = M[ ah ]; } } void loosen() /* Loosen DISPLAY */ { word t1, t2, t3; protdescr *ptr; t1 = c1; while (TRUE) { ptr = prototype[ M[ t1+PROTNUM ] ]; t2 = ptr->preflist; for (t3 = t2+ptr->lthpreflist-1; t3 >= t2; t3-- ) M[ display+M[ t3 ] ] = 0; t3 = t1+M[ t1 ]; M[ t3+STATSL ]--; /* flag object removed from SL */ t1 = M[ t3+SL ]; /* ah of SL */ if (t1 == DUMMY) break; /* still not main */ t1 = M[ t1 ]; /* am of SL */ } } static int tracecnt = 0; /* To count trace messages in line */ void trace(lineno) /* Trace the program if debug mode */ word lineno; { thisp->trlnumber = lineno; if (debug && lineno > 0) { tracecnt++; if (tracecnt == MAXTRACNT) /* change line */ { tracecnt = 0; fprintf(tracefile, "\n"); } fprintf(tracefile, "%6ld", (long) lineno); } trapmsg(); /* check for waiting message */ rpc2(); /* check for RPC message */ } void endrun(status) int status; { fflush(stdout); fprintf(stderr, "\n\nEnd of LOGLAN-82 program execution\n");fflush(stderr); #if DLINK net_logoff(); #endif if (debug) fclose(tracefile); exit(status); }