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.
16 =======================================================================
24 static bool vtype(address,int);
25 static void addressing(void);
26 static void param(int,int);
27 static void p2(int,int,address);
28 static void par2(address,int);
29 static void putaddr(int,int);
30 static void parproc(int);
31 static void parfunc(int);
32 static void partype(int);
33 static void signoffst(int);
34 static void offsets(void);
35 static void rpcmask(void);
40 static void addressing();
44 static void putaddr();
45 static void parproc();
46 static void parfunc();
47 static void partype();
48 static void signoffst();
49 static void offsets();
50 static void rpcmask();
56 static bool vtype(i,ip) address i; int ip;{
58 /* PUTS THE TYPE OF ITEM DESCRIBED AT ADDRESS IP IN IPMEM TO THE CELLS
59 m[ I ],m[ I+1 ] / NUMBER OF ARRAYOF,FINAL TYPE/ .
60 ASSIGNES TRUE TO REF IF THE TYPE IS A REFERENCE TYPE AND FALSE OTHERWISE.
61 IF THERE IS NO DESCRIPTION FOR THE TYPE YET,"I" IS ADDED TO THE LIST
62 OF UNSATISFIED REFERENCES */
64 int ft ; /* final type */
69 m[ i ] = ipmem[ ip - 4 ] ;
74 /* PRIMITIVE TYPE ? */
75 if (ft==nrint) /* integer */
78 if (ft==nrre) /* real */
79 fft = ipradr + TREAL ;
81 if (ft==nrbool) /* boolean */
82 fft = ipradr + TBOOLEAN ;
84 if (ft==nrchr) /* char */
85 fft = ipradr + TCHAR ;
87 if (ft == nrtext) /* string */
88 fft = ipradr + TSTRING ;
89 else /* REFERENCE TYPE */
93 if (ref || (ipmem[ip-4] > 0) )
98 fft=ipradr + TCOROUT ;
101 fft = ipradr + TPROCESS ;
103 if( (ipmem[ft] % 16) == 11 ) /*file*/
104 fft = ipradr + TFILE ;
107 { /* CLASS OR FORMAL TYPE */
108 if (ipmem[ ft+2 ] < 0)
109 fft = -ipmem[ ft+2 ] ;
110 else /* UNKNOWN YET, ADD TO LIST OF UNSATISFIED REFERENCES */
113 ipmem[ft-2] = -(i+1) ;
116 } /* CLASS OR FORMAL TYPE */
117 } /* REFERENCE TYPE */
128 static void param(ia, parkind) int ia,parkind;{
129 /* PREPARES A DESCRIPTION OF INPUT, OUTPUT OR INOUT PARAMETER */
130 bool aux ; /* auxilliary */
133 /* IA = PARAMETER ADDRESS IN IPMEM */
134 /* WITH PROTOTYPE[ LASTPROT ] ^ DO */
135 { curr = prototype[ lastprot ] ;
140 aux = vtype(fre+1,ia);
143 { /* REFERENCE TYPE */
144 addtolist(&(listofref[ lastprot ]), ia);
148 longaddtolist(&(listofpar[ lastprot ]), fre + base) ;
154 static void p2(pk,pda,ndscr) int pk,pda; address ndscr;{
156 /* CREATES DESCRIPTION OF PAR. INPUT,OUTPUT OR INOUT
157 OF FORMAL PROCEDURE OR FUNCTION */
160 m [ ndscr ] = fre + base ;
165 vtype(fre + 1, pda) ;
171 static void par2(am,ip) address am; int ip;{
173 /* MAKES DESCRIPTIONS FOR FORMAL PARAMETERS OF void OR FUNCTION
174 BEING A PARAMETER ITSELF .
175 AM = ADDRESS OF THIS UNIT DESCRIPTION IN M,
176 IP = ADDRESS IN IPMEM */
182 /* WITH PROTOTYPE[ LASTPROT ] ^ DO */
183 { curr = prototype[lastprot] ;
185 longaddtolist(&listofpar[ lastprot ],am+base);
187 addtolist(&listofref[ lastprot ],ip) ;
191 m [ am + 2 ]=ipmem[ ip + 4 ];
193 /* number of parameters including 'result' */
194 m [ am + 1 ] = fre + base ;
198 { /* NOT EMPTY PARAMETERS LIST */
199 reserve(m [ am+2 ]) ;
202 for (n=0; n<=m[ am+2 ]-1; n++)
204 pda = ipmem[ ipmem[ ip+3 ] + n ] ;
205 /* PARAMETER ADDRESS IN IPMEM */
206 ndscr = m [ am+1 ] - base + n ;
208 switch(itemkind(pda))
210 case IFMPROC : m [ ndscr ] = ipradr + TPROC2;
214 case IFMFUNC : m [ ndscr ] = ipradr + TFUNC2;
218 case IFMTYPE : reserve(2);
219 m [ ndscr ] = fre +base ;
221 m [ fre ] = FORMTYPE;
228 case IPARIN : p2(PARIN, pda,ndscr) ;
231 /* BECAUSE OF THE BUG IN COMPILER : 'RESULT' NOT DESCRIBED */
232 /* CORRECTLY, SHOULD BE TREATED AS OUTPUT PARAMETER */
234 case IPAROUT : p2(PAROUT, pda, ndscr);
237 case IPARINOUT : p2(PARINOUT, pda, ndscr);
241 } /* NOT EMPTY PARAMETER LIST */;
246 static void parproc(ia) int ia;{ /* FORMAL PROCEDURE DESCRIPTION */
248 m [ fre ] = FORMPROC ;
255 static void parfunc(ia) int ia;{ /* FORMAL FUNCTION DESCRIPTION */
258 m [ fre ] = FORMFUNC;
267 static void partype(ia) int ia;{ /* FORMAL TYPE PARAMETER */
270 m [ fre ] = FORMTYPE ;
272 m [ fre + 1 ] = lastprot ; /* sl */
274 m [ fre + 2 ] = offset ;
276 backpatch(ia,fre + base) ;
278 /* WITH PROTOTYPE[ LASTPROT ] ^ DO */
279 longaddtolist(&listofpar[ lastprot ],fre + base) ;
280 prototype[lastprot]->lthparlist++ ;
286 static void putaddr(ap,a) int ap,a;{
288 /* PUT PROTOTYPE AND OFFSET INTO ATTRIBUTE DESCRIPTION AT "A" IN IPMEM */
290 ipmem[ a - 2 ] = offset ;
291 ipmem[ a - 1 ] = lastprot ;
293 if(ap == APVIRT) offset += APREF ;
298 static void offsets(){
300 /* COMPUTE OFFSETS FOR ALL ATTRIBUTES, */
301 /* COMPUTE OFFSETS FOR ALL ATTRIBUTES, */
302 /* LINK PARAMETERS, */
303 /* LINK REFERENCE ATTRIBUTES */
308 curr = prototype[lastprot] ;
309 offset = curr->appetite; /* total length of attributes from prefix,if any */
311 /* GO THRU THE LIST OF ATTRIBUTES */
312 for (p = ipmem[ curr->codeaddr + 6 ] ; /* first element */
314 p = ipmem[ p+1 ] /* next element */){
316 /* LIST ELEMENT : POINTER TO ATTRIBUTE DESCRIPTION, */
317 /* POINTER TO THE NEXT ELEMENT */
319 a = ipmem[ p ] ; /* attribute address in ipmem */
320 switch (itemkind(a)){
322 case IFMPROC : parproc(a) ;
323 putaddr(APFMPROC, a) ;
326 case IFMFUNC : parfunc(a) ;
327 putaddr(APFMPROC, a) ;
330 case IFMTYPE : partype(a) ;
331 putaddr(APFMTYPE, a) ;
334 case IPARIN : param(a, PARIN) ;
335 putaddr(apet(a), a) ;
338 case IPAROUT : param(a, PAROUT) ;
339 putaddr(apet(a), a) ;
342 case IPARINOUT : param(a, PARINOUT) ;
343 putaddr(apet(a), a) ;
346 case IVAR : n = apet(a) ;
349 addtolist(&listofref[ lastprot ], a) ;
357 /* IBLOCK, IPREFBLOCK, IHANDLER, ISIGNAL : IMPOSSIBLE */
359 /* ICLASS,IRECORD,ICOROUT,IPROCESS,IFUNC,IPROC,ICONST: NOP */
365 curr->appetite = offset ;
373 static void signoffst(s) int s;{
375 /* COMPUTES THE OFFSETS OF PARAMETERS OF */
376 /* THE SIGNAL DESCRIBED IN IPMEM AT S */
380 int param ; /* POINTER TO PARAMETER DESCRIPTION */
383 offset = APINT + APINT;
385 /* GO THRU THE LIST OF ATTRIBUTES */
386 for( p = ipmem[ s+6 ] ; /* first element */
388 p = ipmem[ p+1 ] /* next element */)
391 /* LIST ELEMENT : POINTER TO ATTRIBUTE DESCRIPTION */
392 /* POINTER TO THE NEXT ELEMENT */
393 param = ipmem[ p ] ; /* attribute address in ipmem */
395 switch(itemkind(param))
398 case IFMFUNC : ap = APFMPROC ;
401 case IFMTYPE : ap = APFMTYPE ;
404 /* IPARIN,IPAROUT,IPARINOUT */
411 ipmem[ param-2 ] = offset ;
417 static void addressing()
419 /* FOR EACH UNIT ( IN TOPOLOGICAL ORDER ) : */
420 /* - NEW PROTOTYPE IS CREATED, */
421 /* ( FOR CLASS ALSO CLASS TYPE DESCRIPTION ) */
422 /* - UNIT'S ATTRIBUTES ARE ASSIGNED OFFSETS */
423 /* - REFERENCE VARIABLES ( INCLUDING FORMAL PROCEDURES ) ARE LINKED */
425 /* - PARAMETERS ARE LINKED INTO LIST */
426 /* ( THEIR DESCRIPTIONS ARE ALSO PRODUCED ) */
429 int pip ; /* PROTOTYPE IN IPMEM */
431 protkind pkind[ IFMFUNC + 1 ] ; /* AUXILIARY, READ-ONLY */
434 pointprdsc curr; /* for translation of Pascal's WITH */
436 for (it = ICLASS; it <= IFMFUNC ; it++)
439 /* START FROM THE MAIN BLOCK */
440 nextunit = MAINBLOCK ;
441 pip = nblus; /* main block in ipmem */
443 do /* GET UNIT FROM THE LIST OF ALL UNITS */
446 if ( (it == ICLASS) || (it == IRECORD) || (it == ICOROUT)
447 || (it == IPROCESS) || (it == IBLOCK) || (it == IPREFBLOCK)
448 || (it == IFUNC) || (it == IPROC) || (it == IHANDLER) )
451 if (nextunit > MAXPROT)
453 /* mb removed case which did the same in every case */
454 /* in doubts cf. Pascal version */
455 prototype[ nextunit ] = (pointprdsc) new(prototype[ nextunit ]) ;
457 /* WITH PROTOTYPE[ NEXTUNIT ] ^ DO */
458 { curr = prototype[nextunit] ;
459 curr->codeaddr = pip ; /* pointer to the description in ipmem */
460 curr->kind = pkind[ it ] ;
469 pip = ipmem[ pip+2 ] ; /* move on to the next unit */
471 while (pip != 0) ; /* END OF LIST. */
473 lastprot = MAINBLOCK ;
477 pdescr() ; /* make prototype's description */
478 offsets(); /* compute offsets for all attributes */
481 while (lastprot != nextunit) ;
483 lastprot = nextunit-1;
487 static void rpcmask(){
490 for (prot = prototype; prot <= &prototype[lastprot]; prot++)
492 if ((*prot)->kind == PROCESS)
494 (*prot)->maskbase = MAINBLOCK ;
495 (*prot)->masksize = (lastprot + 7) / 8 ;
504 /* PROTOTYPES CREATING */
507 primdescr() ; /* primitive types descriptions */
508 addressing() ; /* offsets, prototypes without lists */
509 lists() ; /* preflist, parlist, virtlist, descrlist */
510 handlers() ; /* handlers lists */
512 /*CBC Force unit kind of main to be PROCESS (instead of BLOCK) ...*/
513 prototype[ MAINBLOCK ]->kind = PROCESS ;
515 /*CBC Added computing of base and size of RPC mask */