1 /* Loglan82 Compiler&Interpreter
2 Copyright (C) 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 =======================================================================
18 /**********************************************************/
19 /* auxiliary functions for GEN */
20 /* Written according to NEW m & ipmem declarations */
21 /* Last modified : Mar-01-90 */
22 /**********************************************************/
29 /* static void globrelease(address n, app ap); */
30 /* releases temporary variable with appetite ap and */
31 /* address n within global area */
36 static void globrelease(address,app);
37 static int globspace(app);
38 static void result(argnr);
42 static void globrelease();
43 static int globspace();
51 /* M^ [ FIRSTLABEL..MEMLIMIT ] IS USED FOR HANDLING LABELS */
53 /* M^ [ MEMLIMIT-L+1 ] < 0 */
54 /* --> = - VALUE OF ALREADY DEFINED LABEL */
55 /* M^ [ MEMLIMIT-L+1 ] > 0 */
56 /* --> = HEAD OF UNSATISFIED REFERENCES LIST */
59 bool gtmpmap[ TEMPGUARD + 1 ] ;
60 /* MAP OF GLOBAL NON-REFERENCE TEMPORARY VARIABLES */
62 bool rtmpmap[ MAXREFTEMP + 1 ] ;
63 /* MAP OF (LOCAL) REFERENCE TEMPORARY VARIABLES */
66 /* MAP OF (LOCAL) NON-REFERENCE TEMPORARY VARIABLES */
67 /* TRUE STANDS FOR AVAILABLE WORD, FALSE FOR OCCUPIED ONE */
69 int loctmp ; /* MAXIMAL NUMBER OF ALREADY USED WORDS FOR
70 LOCAL (NON-REFERENCE) TEMPORARY VARIABLES */
72 int reftmp ; /* MAXIMAL NUMBER-1 OF ALREADY USED PAIRS OF WORDS
73 FOR REFERENCE TEMPORARY VARIABLES */
75 tmpmapdscr * mapdscr[ MAXPROT + 1 ] ;
76 /* FOR CLASS ONLY : MAP OF TEMPORARIES USED AT 'INNER' */
79 /**********************************************************/
85 /* DEFINES NEW LABEL AND SATISFIES REFERENCES (IF ANY) */
89 n = MEMLIMIT - lab + 1;
96 m [ n ] = -(fre+base);
100 m [ k ] = fre + base ;
106 void uselabel(lab) address lab;{
107 address n ; /* MAINTAINS THE USE OF LABEL LAB AT ADDRESS fre */
109 n = MEMLIMIT - lab + 1 ;
111 if(n < fre) generror(MEMOVF) ;
112 else firstlabel = n ;
113 if (m [ n ] < 0) /* ALREADY DEFINED */
114 m [ fre ] = -m [ n ] ;
115 else /* ADD TO THE LIST OF UNSATISFIED REFERENCES */
117 m [ fre ] = m [ n ] ;
125 /* THE BEGINNING OF UNIT DESCRIBED AT 'IP' */
127 void begunit(ip) int ip;{
129 pointprdsc prot = prototype[ipmem[ ip - 1 ]];
131 unitt = ipmem[ ip-1 ] ;
134 prot = prototype[unitt] ;
135 prot->codeaddr = fre + base;
136 if (prot->lthpreflist > 1){ /* prefixed unit */
139 /* ltmpmap = mapdscr[k]->map ;*/
140 for (i=0; i<= MAXLOCTEMP; i++) ltmpmap[i] = mapdscr[k]->map[i];
142 loctmp = mapdscr[k]->locsize ;
143 reftmp = mapdscr[k]->refsize ;
147 for (k = 1; k<= MAXLOCTEMP; k++) ltmpmap[k] = TRUE; /* index negated */
149 /* fillword(ltmpmap + 1, (char) TRUE, MAXLOCTEMP) ;
157 for (k = 0; k <= MAXREFTEMP; k++) rtmpmap[ k ] = TRUE ;
159 /* memset(rtmpmap, (char) TRUE, MAXREFTEMP + 1) ;*/
161 for (k = 1; k <= TEMPGUARD; k++) gtmpmap[ k ] = TRUE ;
163 /* memset(gtmpmap + 1, (char) TRUE, TEMPGUARD) ; */
166 firstlabel = MEMLIMIT; /* IN FACT, MEMLIMIT+1 */
169 /* for (k = 0; k <= MEMLIMIT; k++) m[k]=0; */
170 /* memset( (char *)m, 0, (MEMLIMIT + 1)*sizeof(m[0]) ); */
179 /* with prototype[ unitt ] ^ do*/
180 { prot = prototype[ unitt ] ;
181 if(unitt != MAINBLOCK)
182 if ((prot->kind == CLASS) || (prot->kind == LRECORD)
183 || (prot->kind == COROUTINE) || (prot->kind == PROCESS))
184 /*with mapdscr[ unitt ]^ do*/
185 { mapd = mapdscr[unitt] ;
186 mapd ->locsize = loctmp ;
187 mapd ->refsize = reftmp ;
191 case LRECORD : systsize = 0 ;
195 case PREFBLOCK : systsize = 2*(APREF+APINT) ;
196 /* sl, dl, lsc, status sl */
199 case LPROCEDURE : systsize = 3*APREF+2*APINT ;
200 /* sl, dl, rpcdl, lsc, status sl */
201 /*cbc add rpcdl field for procedures and functions...*/
203 case COROUTINE : systsize = 3*APREF+2*APINT ;
204 /* sl, dl, cl, lsc, status sl */
206 case PROCESS : systsize = 5*APREF+2*APINT+2*(lastprot+1);
207 /* sl, dl, cl, chd, virtsc, lsc, statsl, display, display2 */
209 case HANDLER : systsize = 2*APREF+3*APINT ;
210 /* sl, dl, lsc, status sl, signal nr */
213 prot->span = prot->appetite + loctmp;
214 prot->appetite = prot->span + (reftmp + 1) * APREF + systsize;
215 if (prot->appetite > MAXAPPT)
217 } /* with prototype */;
219 /* clear dictionary of labels */
220 for(systsize = firstlabel; systsize <= MEMLIMIT; systsize++)
223 /* memset(m+firstlabel, (char)0, (MEMLIMIT-firstlabel+1)*sizeof(address)); */
227 static int globspace(ap) app ap;{
229 /* returns offset of the new temporary variable allocated in global area */
230 /* indexed 1..maxcomtemp */
232 int n ; /* 0..tempguard;*/
237 case 1 : while (!gtmpmap[ ++n ]) ; /*not guarded */
241 gtmpmap[ n ] = FALSE;
248 while (!(gtmpmap[ n ] && gtmpmap[ n+1 ])) ;
249 if (n >= MAXCOMTEMP )
253 gtmpmap[ n ] = FALSE ;
254 gtmpmap[ n + 1 ] = FALSE ;
259 while(!(gtmpmap[ n ] && gtmpmap[ n+1 ] && gtmpmap[ n+2 ])) ;
260 if (n > MAXCOMTEMP - 2)
264 gtmpmap[ n ] = FALSE ;
265 gtmpmap[ n+1 ] = FALSE ;
266 gtmpmap[ n+2 ] = FALSE ;
274 static void globrelease(n,ap) address n; app ap;{
276 /* releases temporary variable with appetite ap and */
277 /* address n within global area */
283 case 2 : gtmpmap[ n+1 ] = TRUE ;
285 case 3 : gtmpmap[ n+1 ] = TRUE ;
286 gtmpmap[ n+2 ] = TRUE ;
293 /* returns offset of the new temporary variable allocated within local area */
294 /* indexed -maxloctemp .. -1 for non-reference or */
295 /* 0 .. maxreftemp for reference values */
297 /* label 77; exit when successed */
301 if (ap == APVIRT) /* REFERENCE */
302 {/* reference variable, indexed 0..maxreftemp */
304 while ( !rtmpmap[ n ] && (n < MAXREFTEMP))
308 rtmpmap[ n ] = FALSE;
317 { /* non-reference, indexed 1..maxloctemp */
319 while (n <= MAXLOCTEMP)
322 { case 1 : ltmpmap[ n ] = FALSE ;
326 case 2 : if (ltmpmap[ n-1 ])
327 { ltmpmap[ n ] = FALSE ;
328 ltmpmap[ n-1 ] = FALSE ;
333 case 3 : if (ltmpmap[ n-1 ] && ltmpmap[ n-2 ])
334 { ltmpmap[ n ] = FALSE ;
335 ltmpmap[ n-1 ] = FALSE ;
336 ltmpmap[ n-2 ] = FALSE ;
346 /* exit on failure */
349 label77 : /* found */
353 } /* non-reference */
356 void locrelease(n, ap)
360 /* releases temporary variable of appetite ap allocated at address n */
361 /* within local area */
364 if (ap == APVIRT) /* reference variable */
365 rtmpmap[ n / APREF ] = TRUE ;
366 else{ /* non-reference */
367 /*cmb indices to ltmpmap negated cmb*/
368 ltmpmap[ -n ] = TRUE ;
371 case 2 : ltmpmap[ -n - 1 ] = TRUE ;
373 case 3 : ltmpmap[ -n - 1 ] = TRUE ;
374 ltmpmap[ -n - 2 ] = TRUE ;
381 void force(n, m, o1, o2)
382 /* FORCES THE N-TH ARGUMENT TO BE OF M-MODE WITH PARAMETERS O1,O2 */
387 { args_struct * curr ; /* gsg for PASCAL WITH translation */
388 curr = args + n ; /* WITH ARGS[ N ] DO BEGIN */
395 /**********************************************************/
399 /* FORCES THE N-TH ARGUMENT TO BE A CONSTANT */
401 { args_struct * curr ; /* gsg for PASCAL WITH translation */
404 /* WITH ARGS[ N ] DO BEGIN */
405 { curr->mode = CONSTANT ;
406 curr->off1 = tuple[ qcurr ].arg[ n ] ;
409 /**********************************************************/
414 /* FORCES THE N-TH ARGUMENT TO BE A PROTOTYPE NUMBER AS A CONSTANT */
416 { args_struct * curr ; /* gsg for PASCAL WITH translation */
419 /* WITH ARGS[ N ] DO BEGIN */
420 { curr->mode = CONSTANT ;
421 curr->off1 = ipmem[ tuple[ qcurr ].arg[ n ] - 1 ] ;
424 /**********************************************************/
427 /* PUTS THE DESCRIPTION OF THE N-TH ARGUMENT INTO ARGS[N] */
428 /* FOR TEMPORARY VARIABLES WITH NO NEXT USE AND NOT LIVE */
429 /* THE CORRESPONDING IS RELEASED */
433 address w1 ; /* ( + 1) WORD OF SYMBOL TABLE ITEM */
434 /* qaddr0 nextuse ; */
435 quadruple * curr1 ; /* gsg for PASCAL WITH translation */
436 args_struct * curr2 ; /* gsg for PASCAL WITH translation */
439 curr1 = tuple + qcurr ;
441 /* WITH TUPLE[ QCURR ] DO BEGIN */
444 notrick = ipmem[ ad ] ;
446 /* WITH ARGS[ N ] DO BEGIN */ /* WITH TRICK.STI DO */
448 switch (smode(notrick)) {
449 /*CBC Replaced global absolute addressing by dot access to MAIN block object */
450 /*CBC VARGLOB : { MODE = GLOBAL ; OFF1 = ipmem[ W1-2 ] + MAIN } */
452 case VARGLOB : curr2->mode = DOTACCESS ;
453 curr2->off1 = ipmem[ w1-2 ] ;
454 curr2->off2 = MAINBLOCK ;
457 case VARLOC : curr2->mode = LOCAL ;
458 curr2->off1 = ipmem[ w1 - 2 ] ;
461 /*CBC Added new addressing mode for remote access through DISPLAY */
462 case VARMID : curr2->mode = DOTACCESS ;
463 curr2->off1 = ipmem[ w1 - 2 ] ;
464 curr2->off2 = /* DISPLAY + */ ipmem[ w1 - 1 ] ;
467 case TEMPVAR : if (slocal(notrick))
469 curr2->mode = TEMPLOCAL ;
471 if ( (curr1->nxtuse[ n ]==0) && (! slive(notrick)) )
472 locrelease(w1, sap(notrick)) ;
476 curr2->mode = GLOBAL ;
477 curr2->off1 = w1 + temporary ;
478 if ((curr1->nxtuse[ n ]==0) && (! slive(notrick)) )
479 globrelease(w1, sap(notrick)) ;
483 case INTCONST : curr2->mode = IMMEDIATE ;
487 case REALCONST : curr2->mode = GLOBAL ;
488 curr2->off1 = realbase + w1 ;
495 /**********************************************************/
498 static void result(n) argnr n;{
500 /* PUTS THE DESRIPTION OF N-TH ARGUMENT ( BEING DEFINED ) INTO ARGS[N]. */
501 /* FOR THE TEMPORARY VALUE THE NEW SPACE IS ASSIGNED */
503 int w1 ; /* ( + 1) WORD OF SYMBOL TABLE ITEM */
504 quadruple * curr1 ; /* gsg for PASCAL WITH translation */
505 args_struct * curr2 ; /* gsg for PASCAL WITH translation */
507 /* int globspace(app) ; */
509 curr1 = tuple + qcurr ;
511 /* WITH TUPLE[ QCURR ] DO BEGIN */
512 { notrick = ipmem[ curr1->arg[ n ] ] ;
513 w1 = ipmem[ curr1->arg[ n ] + 1 ] ;
514 /* WITH ARGS[ N ] DO BEGIN */ /* WITH TRICK.STI DO */
516 switch (smode(notrick)) {
517 /*CBC Replaced global absolute addressing by dot access to MAIN block object */
518 /*CBC VARGLOB : { MODE = GLOBAL ; OFF1 = (ipmem)[ W1-2 ] + MAIN } */
519 case VARGLOB : curr2->mode = DOTACCESS ;
520 curr2->off1 = ipmem[ w1-2 ] ;
521 curr2->off2 = MAINBLOCK ;
524 case VARLOC : curr2->mode = LOCAL ;
525 curr2->off1 = ipmem[ w1-2 ] ;
528 /*CBC Added new addressing mode for remote access through DISPLAY */
529 case VARMID : curr2->mode = DOTACCESS ;
530 curr2->off1 = ipmem[ w1 - 2 ] ;
531 curr2->off2 = /* DISPLAY + */ ipmem[ w1 - 1 ] ;
534 case TEMPVAR : /* ALLOCATE IT */
536 { /* CANNOT USE GLOBAL TEMPORARIES */
537 args[ n ].mode = TEMPLOCAL ;
538 curr2->off1 = locspace(sap(notrick)) ;
539 ipmem[ curr1->arg[ n ] + 1 ] = curr2->off1 ;
542 { /* GLOBAL AREA MAY BE USED */
543 args[ n ].mode = GLOBAL ;
544 curr2->off1 = globspace(sap(notrick)) ;
545 ipmem[ curr1->arg[ n ] + 1 ] = curr2->off1 ;
546 curr2->off1 += temporary ;
551 case REALCONST : /* IMPOSSIBLE */
563 args_struct * curr ; /* gsg for PASCAL WITH translation */
566 printf("on entrance to emit fre == %d\n", fre) ;
568 for (i = 1; i <= 3 ; i++)
569 trick.c2.eop.args[ i ] = (char)(args[ i ].mode) ;
570 trick.c2.eop.args[ 0 ] = (char)(tuple[ qcurr ].opcode) ; /* opcode */
573 m[ fre ] = trick.c0.int1f ;
574 m[ fre + 1 ] = trick.c0.int2f ;
578 m[ fre ] = trick.c1.intf ;
583 printf(" emit %d\n", trick.c2.eop.args[0]);
588 for (i = 1; i <= 3; i++) /* WITH ARGS[ I ] DO */
589 { curr = args + i ; /* gsg PASCAL WITH translation */
591 if (curr->mode != NOARGUMENT)
593 m[ fre ] = curr->off1 ;
595 if ( (curr->mode == REMOTE) || /*cbc*/ (curr->mode == DOTACCESS) )
597 m[ fre ] = curr->off2 ;
602 if (fre >= firstlabel)
605 printf("on exit from emit fre == %d\n", fre) ;
611 /* PREPARES DEFAULT DESCRIPTIONS OF ARGUMENTS */
615 /* void result(argnr) ; */
617 for (d = 1; d <= 3; d++)
618 args[ d ].mode = NOARGUMENT ;
619 d = opdescr[tuple[qcurr].opcode ] ; /*!!*/
625 case 1 : forceconst(1) ;
628 case 2 : argument(1) ;
631 case 3 : argument(1) ;
635 case 4 : argument(1) ;
640 case 5 : argument(1) ;
644 case 6 : argument(1) ;
649 case 7 : argument(1) ;
656 { /* AT LEAST ONE RESULT */
657 if (d < 14) /* 1 RESULT */
661 case 9 : forceconst(2) ;
664 case 10 : forceconst(2) ;
668 case 11 : argument(2) ;
671 case 12 : argument(2) ;
675 case 13 : argument(2) ;
681 else { /* 2 RESULTS */
683 if (tuple[qcurr].opcode >= 4)
686 else forceconst(3) /* openrc , raise */ ;
691 } /* at least one result */
697 /* PRODUCES A DESCRIPTION OF 'CASE' */
700 int lab,labnr,othrlab;
704 /* WITH TUPLE[ QCURR ] DO */
706 labnr = next() ; /* number of labels */
707 othrlab = next() ; /* 'otherwise' label */
708 deflabel(othrlab - 1) ;/* 'switch' description label */
709 m[ fre ] = next() ; /* minimal value of 'switch' expression */
710 tofill = fre + 1 ; /* to be filled with the number of branches */
713 for (n = 1; n <= labnr; n++)
716 valuee = iand(ishft(trick,-8),255) ;
717 lab = iand(trick,255) ;
724 uselabel(othrlab + lab) ;