1 /* Loglan82 Compiler&Interpreter
2 Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
3 Copyright (C) 1993, 1994 LITA, Pau
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.
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.
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.
19 contacts: Andrzej.Salwicki@univ-pau.fr
22 LITA Departement d'Informatique
24 Avenue de l'Universite
26 tel. ++33 59923154 fax. ++33 59841696
28 =======================================================================
38 * Initialize memory structures for objects, main object and a few goodies more.
45 /* initialize process descriptors */
46 for (i = 0; i < MAXPROCESS; i++) {
48 process[i].used = FALSE;
49 /* initial mark for processes */
51 /* memory not allocated */
53 process[i].hash = NULL;
55 /* always contains code */
57 /* DISPLAY offset in process object */
58 dispoff = VIRTSC - (lastprot + 1);
59 /* indirect DISPLAY offset */
60 disp2off = dispoff - (lastprot + 1);
61 /* initialize Round-Robin queue */
63 /* init pseudo-random no. generator */
69 DosGetInfoSeg(&gsel, &lsel);
70 ginf = MAKEPGINFOSEG(gsel);
74 /* create main process */
76 /* dummy DL for generated process */
80 /* current process index */
82 /* current process descr pointer */
83 thisp = &process[thispix];
84 initprocess((word) 0, (word) MAINBLOCK, &father);
86 mainprog = thisp->prochead;
87 /* pointers to current object */
90 /* instruction counter */
92 /* parameter vector */
95 apt = mainprog + M[mainprog];
97 display = apt + dispoff;
98 /* indirect DISPLAY in main */
99 display2 = apt + disp2off;
100 /* offset of variable mainprog */
102 /* init variable main */
103 storevirt(thisp->procref, mainprog + mnoff);
104 /* flag main included in SL chain */
106 thisp->status = STOPPED;
107 /* activate main process */
112 /* a dirty trick: set junk current */
114 /* process for first transfer() */
115 thisp = &process[thispix];
116 /* (must save 'context' somewhere) */
124 * Initialize process descriptor
126 void initprocess(word pix, word prot, procaddr *father)
130 word i, j, ah, am, apt;
133 fprintf(stderr, "new process(n,p,m) (%d,%d,%d)", 0, pix,
135 fprintf(stderr, " from (%d,%d,%d)\n", father->node, father->pix,
144 /* process descriptor is used */
146 /* prototype number */
148 /* null list of free dictionary items */
150 /* highest memory address */
151 p->upper = memorysize - 1;
152 /* lowest address for data */
154 /* head of killed objects list */
156 /* maximum appetite sentinel */
157 p->M[ p->headk ] = MAXAPPT;
159 /* dict. item for process itself */
161 /* first word used by dictionary */
163 ptr = prototype[prot];
164 if (p->upper - p->lower - ptr->appetite < 512)
165 if (prot == MAINBLOCK)
166 abend("Memory size too small (use /m option)\n");
167 else errsignal(RTEMEMOV);
169 /* generate process object */
170 p->lastused = p->lower + ptr->appetite;
172 p->M[am] = ptr->appetite;
173 p->M[am + PROTNUM] = prot;
174 for (i = PROTNUM + 1; i < ptr->appetite; i++)
179 p->procref.addr = ah;
181 /* initialize current object ptrs */
183 p->c2 = am + ptr->span;
184 apt = am + ptr->appetite;
185 /* initialize coroutine head ptr */
186 p->M[apt + CHD] = ah;
187 p->M[apt + CHD + 1] = 0;
188 /* dummy SL for process */
189 p->M[apt + SL] = DUMMY;
192 /* initialize DISPLAY */
193 for (i = MAINBLOCK; i <= lastprot; i++) {
194 /* dummmy entry for MAIN */
195 p->M[apt + dispoff + i] = 0;
197 p->M[apt + disp2off + MAINBLOCK] = DUMMY;
198 /* set DISPLAY entries for process */
201 for (i = j + ptr->lthpreflist - 1; i >= j; i--) {
202 /* physical address */
203 p->M[apt + dispoff + M[i]] = am;
204 /* indirect address */
205 p->M[apt + disp2off + M[i]] = ah;
210 mess2obj(p, father, &v);
211 p->M[apt + DL] = v.addr;
212 p->M[apt + DL + 1] = v.mark;
214 p->msgqueue = qinit();
215 p->rpcwait = qinit();
216 p->rpcmask = sinit();
217 /* initialy all RPCs are disabled */
219 /* trace line number */
221 /* search for executable prefix */
223 while (prototype[p->M[i]]->kind == RECORD)
226 /* first instruction address */
227 p->ic = prototype[M[i]]->codeaddr;
228 p->force_compactification = FALSE;
235 bool member(virtaddr *virt, word *am)
239 if (virt->mark == M[virt->addr + 1])
240 fprintf(stderr, "Yes");
242 fprintf(stderr, "No");
245 return (virt->mark == M[virt->addr + 1]);
251 void update(word am, word ah)
253 word t1, t2, t3, t4, t5, t6;
258 /* flag object included in SL */
260 ptr = prototype[M[am + PROTNUM]];
262 t3 = t2 + ptr->lthpreflist - 1;
263 for (t4 = t3; t4 >= t2; t4--) {
266 /* entry to be updated */
269 M[display2 + t6] = ah;
276 if (M[ah + 1] != M[t1 + SL + 1])
293 ptr = prototype[M[t1 + PROTNUM]];
295 for (t3 = t2 + ptr->lthpreflist - 1; t3 >= t2; t3--)
296 M[display + M[t3]] = 0;
298 /* flag object removed from SL */
311 * To count trace messages in line
313 static int tracecnt = 0;
316 * Trace the program if debug mode
318 void trace(word lineno)
320 thisp->trlnumber = lineno;
321 if (debug && lineno > 0) {
324 if (tracecnt == MAXTRACNT) {
326 fprintf(tracefile, "\n");
328 fprintf(tracefile, "%6ld", (long) lineno);
330 /* check for waiting message */
332 /* check for RPC message */
339 void endrun(int status)
348 msg.msg_type = MSG_INT;
349 msg.param.pword[0] = INT_EXITING;
350 strcpy(msg.param.pstr, ProgName);
351 write(internal_sock, &msg, sizeof(MESSAGE));
352 m.msg_type = MSG_GRAPH;
353 m.param.pword[0] = GRAPH_FREE;
354 write(graph_sock, &m, sizeof(G_MESSAGE));
355 close(internal_sock);
361 for(i = 0; i < 255; i++)
362 if (DirConn[i] != -1)