1 /* Loglan82 Compiler&Interpreter
\r
2 Copyright (C) 1981-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
38 /* Initialize memory structures for objects, main object and a few goodies
\r
47 for (i = 0; i < MAXPROCESS; i++ ) /* initialize process descriptors */
\r
49 process[ i ].used = FALSE; /* not used */
\r
50 process[ i ].mark = -1; /* initial mark for processes */
\r
51 process[ i ].M = NULL; /* memory not allocated */
\r
52 process[ i ].hash = NULL;
\r
54 process[ 0 ].M = M; /* always contains code */
\r
55 dispoff = VIRTSC-(lastprot+1); /* DISPLAY offset in process object */
\r
56 disp2off = dispoff-(lastprot+1); /* indirect DISPLAY offset */
\r
57 ready = qinit(); /* initialize Round-Robin queue */
\r
58 ranset(); /* init pseudo-random no. generator */
\r
63 DosGetInfoSeg(&gsel, &lsel);
\r
64 ginf = MAKEPGINFOSEG(gsel);
\r
68 if (!remote) /* create main process */
\r
70 father.node = 0; /* dummy DL for generated process */
\r
73 thispix = 0; /* current process index */
\r
74 thisp = &process[ thispix ]; /* current process descr pointer */
\r
75 initprocess((word) 0, (word) MAINBLOCK, &father);
\r
76 mainprog = thisp->prochead; /* am of main */
\r
77 c1 = thisp->c1; /* pointers to current object */
\r
79 ic = thisp->ic; /* instruction counter */
\r
80 param = thisp->param; /* parameter vector */
\r
81 apt = mainprog+M[ mainprog ]; /* LWA+1 of main */
\r
82 display = apt+dispoff; /* DISPLAY in main */
\r
83 display2 = apt+disp2off; /* indirect DISPLAY in main */
\r
84 mnoff = 2; /* offset of variable mainprog */
\r
85 storevirt(thisp->procref, mainprog+mnoff); /* init variable main */
\r
86 M[ apt+STATSL ]++; /* flag main included in SL chain */
\r
87 thisp->status = STOPPED;
\r
88 activate(thispix); /* activate main process */
\r
92 thispix = 1; /* a dirty trick: set junk current */
\r
93 thisp = &process[ thispix ]; /* process for first transfer() */
\r
94 } /* (must save 'context' somewhere) */
\r
101 void initprocess(pix, prot, father) /* Initialize process descriptor */
\r
107 word i, j, ah, am, apt;
\r
110 fprintf(stderr,"new process(n,p,m) (%d,%d,%d)",0,pix,process[pix].mark);
\r
111 fprintf(stderr," from (%d,%d,%d)\n",father->node,father->pix,father->mark);
\r
114 p = &process[ pix ];
\r
116 hash_create(p,119);
\r
118 p->used = TRUE; /* process descriptor is used */
\r
119 p->prot = prot; /* prototype number */
\r
120 p->freeitem = 0; /* null list of free dictionary items */
\r
121 p->upper = memorysize-1; /* highest memory address */
\r
122 p->lower = freem; /* lowest address for data */
\r
123 p->headk = p->lower; /* head of killed objects list */
\r
124 p->M[ p->headk ] = MAXAPPT; /* maximum appetite sentinel */
\r
126 ah = p->upper-1; /* dict. item for process itself */
\r
127 p->lastitem = ah; /* first word used by dictionary */
\r
128 ptr = prototype[ prot ];
\r
129 if (p->upper - p->lower - ptr->appetite < 512)
\r
130 if (prot == MAINBLOCK)
\r
131 abend("Memory size too small (use /m option)\n");
\r
132 else errsignal(RTEMEMOV);
\r
134 /* generate process object */
\r
135 p->lastused = p->lower+ptr->appetite;
\r
137 p->M[ am ] = ptr->appetite;
\r
138 p->M[ am+PROTNUM ] = prot;
\r
139 for (i = PROTNUM+1; i < ptr->appetite; i++)
\r
144 p->procref.addr = ah;
\r
145 p->procref.mark = 0;
\r
146 p->c1 = am; /* initialize current object ptrs */
\r
147 p->c2 = am+ptr->span;
\r
148 apt = am+ptr->appetite;
\r
149 p->M[ apt+CHD ] = ah; /* initialize coroutine head ptr */
\r
150 p->M[ apt+CHD+1 ] = 0;
\r
151 p->M[ apt+SL ] = DUMMY; /* dummy SL for process */
\r
152 p->M[ 1 ] = 1; /* absolute none */
\r
153 for (i = MAINBLOCK; i <= lastprot; i++) /* initialize DISPLAY */
\r
154 p->M[ apt+dispoff+i ] = 0;
\r
155 p->M[ apt+disp2off+MAINBLOCK ] = DUMMY; /* dummmy entry for MAIN */
\r
156 j = ptr->preflist; /* set DISPLAY entries for process */
\r
158 for (i = j+ptr->lthpreflist-1; i >= j; i--)
\r
160 p->M[ apt+dispoff+M[ i ] ] = am; /* physical address */
\r
161 p->M[ apt+disp2off+M[ i ] ] = ah; /* indirect address */
\r
166 mess2obj( p, father, &v );
\r
167 p->M[ apt+DL ] = v.addr;
\r
168 p->M[ apt+DL+1 ] = v.mark;
\r
171 p->msgqueue = qinit();
\r
172 p->rpcwait = qinit();
\r
173 p->rpcmask = sinit();
\r
174 pushmask(pix); /* initialy all RPCs are disabled */
\r
175 p->trlnumber = 0; /* trace line number */
\r
176 i = ptr->preflist; /* search for executable prefix */
\r
177 while (prototype[ p->M[ i ] ]->kind == RECORD) i++;
\r
178 p->ic = prototype[ M[ i ] ]->codeaddr; /* first instruction address */
\r
180 fprintf(stderr,"first instruction address %d of new process %d\n", p->ic, pix );
\r
182 p->force_compactification=FALSE;
\r
186 bool member(virt, am)
\r
190 *am = M[ virt->addr ];
\r
191 return (virt->mark == M[ virt->addr+1 ]);
\r
195 void update(am, ah) /* Update DISPLAY */
\r
198 word t1, t2, t3, t4, t5, t6;
\r
204 M[ t1+STATSL ]++; /* flag object included in SL */
\r
205 ptr = prototype[ M[ am+PROTNUM ] ];
\r
206 t2 = ptr->preflist;
\r
207 t3 = t2+ptr->lthpreflist-1;
\r
208 for (t4 = t3; t4 >= t2; t4-- )
\r
212 if (M[ t5 ] == 0) /* entry to be updated */
\r
215 M[ display2+t6 ] = ah;
\r
219 if (ah == DUMMY) break;
\r
220 if (M[ ah+1 ] != M[ t1+SL+1 ]) errsignal(RTESLCOF);
\r
226 void loosen() /* Loosen DISPLAY */
\r
234 ptr = prototype[ M[ t1+PROTNUM ] ];
\r
235 t2 = ptr->preflist;
\r
236 for (t3 = t2+ptr->lthpreflist-1; t3 >= t2; t3-- )
\r
237 M[ display+M[ t3 ] ] = 0;
\r
239 M[ t3+STATSL ]--; /* flag object removed from SL */
\r
240 t1 = M[ t3+SL ]; /* ah of SL */
\r
241 if (t1 == DUMMY) break; /* still not main */
\r
242 t1 = M[ t1 ]; /* am of SL */
\r
247 static int tracecnt = 0; /* To count trace messages in line */
\r
249 void trace(lineno) /* Trace the program if debug mode */
\r
252 thisp->trlnumber = lineno;
\r
253 if (debug && lineno > 0)
\r
256 if (tracecnt == MAXTRACNT) /* change line */
\r
259 fprintf(tracefile, "\n");
\r
261 fprintf(tracefile, "%6ld", (long) lineno);
\r
263 trapmsg(); /* check for waiting message */
\r
264 rpc2(); /* check for RPC message */
\r
268 void endrun(status)
\r
273 fprintf(stderr, "\n\nEnd of LOGLAN-82 program execution\n");fflush(stderr);
\r
277 if (debug) fclose(tracefile);
\r