sources/gen/genprot.c

   1 /*     Loglan82 Compiler&Interpreter
   2      Copyright (C) 1993 Institute of Informatics, University of Warsaw
   3      Copyright (C)  1993, 1994 LITA, Pau
   4
   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.
   9
  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.
  14
  15
  16 =======================================================================
  17 */
  18
  19 #include "glodefs.h"
  20
  21
  22 #ifndef NO_PROTOTYPES
  23
  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);
  36
  37 #else
  38
  39 static bool vtype();
  40 static void addressing();
  41 static void param();
  42 static void p2();
  43 static void par2();
  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();
  51
  52 #endif
  53
  54
  55
  56 static bool vtype(i,ip) address i; int ip;{
  57
  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  */
  63
  64   int        ft ; /* final type */
  65   address    fft ;
  66   int        n  ;
  67   bool   ref;
  68   fft = 0 ;
  69   m[ i ] = ipmem[ ip - 4 ] ;
  70 LOG(i);
  71   ft = ipmem[ ip-3 ] ;
  72   ref = FALSE ;
  73
  74   /* PRIMITIVE TYPE ? */
  75   if (ft==nrint)  /* integer */
  76     fft = ipradr + TINT ;
  77   else
  78   if (ft==nrre)  /* real */
  79     fft = ipradr + TREAL ;
  80   else
  81   if (ft==nrbool)  /* boolean */
  82     fft = ipradr + TBOOLEAN ;
  83   else
  84   if (ft==nrchr)  /* char */
  85     fft = ipradr + TCHAR ;
  86   else
  87   if (ft == nrtext)  /* string */
  88     fft = ipradr + TSTRING ;
  89   else                   /* REFERENCE TYPE */
  90     ref = TRUE;
  91
  92
  93   if (ref || (ipmem[ip-4] > 0) )
  94   {
  95     ref = TRUE ;
  96
  97     if (ft==nrcor)
  98       fft=ipradr + TCOROUT ;
  99     else
 100     if (ft==nrproc)
 101       fft = ipradr + TPROCESS ;
 102     else
 103     if( (ipmem[ft] % 16) == 11 ) /*file*/
 104       fft = ipradr + TFILE ;
 105     else
 106     if (fft == 0)
 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 */
 111       {
 112         n = -ipmem[ft-2] ;
 113         ipmem[ft-2] = -(i+1) ;
 114         fft = -n;
 115       } /* else */
 116     } /* CLASS OR FORMAL TYPE */
 117   } /* REFERENCE TYPE */
 118
 119   m[ i + 1 ] = fft ;
 120 LOG(i + 1);
 121   return(ref) ;
 122 } /* VTYPE */
 123
 124
 125
 126
 127
 128 static void param(ia, parkind) int  ia,parkind;{
 129  /* PREPARES A DESCRIPTION OF INPUT, OUTPUT OR INOUT PARAMETER */
 130   bool        aux ;  /*  auxilliary */
 131   pointprdsc  curr ;
 132
 133   /* IA = PARAMETER ADDRESS IN IPMEM */
 134   /*    WITH PROTOTYPE[ LASTPROT ] ^ DO */
 135   { curr = prototype[ lastprot ] ;
 136     reserve(3);
 137     m[ fre ]=parkind;
 138 LOG(fre);
 139
 140     aux = vtype(fre+1,ia);
 141
 142     if (aux)
 143     { /* REFERENCE TYPE */
 144       addtolist(&(listofref[ lastprot ]), ia);
 145       curr->lthreflist++ ;
 146     }
 147
 148     longaddtolist(&(listofpar[ lastprot ]), fre + base) ;
 149     curr->lthparlist++ ;
 150     fre += 3 ;
 151   }
 152 }
 153
 154 static void p2(pk,pda,ndscr) int pk,pda; address ndscr;{
 155
 156    /* CREATES DESCRIPTION OF PAR. INPUT,OUTPUT OR INOUT
 157        OF FORMAL PROCEDURE OR FUNCTION  */
 158
 159   reserve(3) ;
 160   m [ ndscr ] = fre + base ;
 161 LOG(ndscr);
 162   m [ fre ] = pk ;
 163 LOG(fre);
 164
 165   vtype(fre + 1, pda) ;
 166   fre += 3 ;  /* mb */
 167 }
 168
 169
 170
 171 static void par2(am,ip) address am; int ip;{
 172
 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                             */
 177
 178   int          pda;
 179   address      n,ndscr ;
 180   pointprdsc   curr ;
 181
 182 /*   WITH PROTOTYPE[ LASTPROT ] ^ DO */
 183   { curr = prototype[lastprot] ;
 184
 185     longaddtolist(&listofpar[ lastprot ],am+base);
 186     curr->lthparlist++ ;
 187     addtolist(&listofref[ lastprot ],ip) ;
 188      curr->lthreflist++ ;
 189   } /* with */ ;
 190
 191   m [ am + 2 ]=ipmem[ ip + 4 ];
 192 LOG(am + 2);
 193   /* number of parameters including 'result' */
 194   m [ am + 1 ] = fre + base ;
 195 LOG(am + 1);
 196
 197   if( m [ am+2 ] != 0)
 198   { /* NOT EMPTY PARAMETERS LIST */
 199     reserve(m [ am+2 ]) ;
 200     fre += m [ am+2 ] ;
 201
 202     for (n=0; n<=m[ am+2 ]-1; n++)
 203     {
 204       pda = ipmem[ ipmem[ ip+3 ] + n ] ;
 205       /* PARAMETER ADDRESS IN IPMEM */
 206       ndscr = m [ am+1 ] - base + n ;
 207
 208       switch(itemkind(pda))
 209       {
 210         case  IFMPROC : m [ ndscr ] = ipradr + TPROC2;
 211                         LOG(ndscr);
 212                         break;
 213
 214         case  IFMFUNC : m [ ndscr ] = ipradr + TFUNC2;
 215                         LOG(ndscr);
 216                         break;
 217
 218         case  IFMTYPE : reserve(2);
 219                         m [ ndscr ] = fre +base ;
 220                         LOG(ndscr);
 221                         m [ fre ] = FORMTYPE;
 222                         LOG(fre);
 223                         m [ fre + 1 ] = -1;
 224                         LOG(fre + 1);
 225                         backpatch(pda,fre);
 226                         fre += 2;
 227                         break;
 228        case   IPARIN  : p2(PARIN, pda,ndscr) ;
 229             break ;
 230        case   IVAR : ;
 231              /* BECAUSE OF THE BUG IN COMPILER : 'RESULT' NOT DESCRIBED */
 232              /*  CORRECTLY, SHOULD BE TREATED AS OUTPUT PARAMETER     */
 233
 234        case   IPAROUT : p2(PAROUT, pda, ndscr);
 235                         break;
 236
 237        case   IPARINOUT : p2(PARINOUT, pda, ndscr);
 238                           break;
 239       } /* switch */
 240     } /* for */
 241   } /* NOT EMPTY PARAMETER LIST */;
 242 } /* PAR2 */;
 243
 244
 245
 246 static void parproc(ia) int ia;{    /* FORMAL PROCEDURE DESCRIPTION */
 247   reserve(3);
 248   m [ fre ] = FORMPROC ;
 249 LOG(fre);
 250   fre += 3 ;
 251   par2(fre-3, ia) ;
 252 }
 253
 254
 255 static void parfunc(ia) int ia;{        /* FORMAL FUNCTION DESCRIPTION */
 256   address n;
 257   reserve(5);
 258   m [ fre ] = FORMFUNC;
 259 LOG(fre);
 260   fre += 5;
 261   n = fre;
 262   par2(n-5,ia);
 263   vtype(n-2,ia);
 264 }
 265
 266
 267 static void partype(ia) int ia;{        /* FORMAL TYPE PARAMETER */
 268   reserve(3);
 269
 270   m [ fre ] = FORMTYPE ;
 271 LOG(fre);
 272   m [ fre + 1 ] = lastprot ; /* sl */
 273 LOG(fre + 1);
 274   m [ fre + 2 ] = offset ;
 275 LOG(fre + 2);
 276   backpatch(ia,fre + base) ;
 277
 278   /*  WITH PROTOTYPE[ LASTPROT ] ^ DO */
 279     longaddtolist(&listofpar[ lastprot ],fre + base) ;
 280     prototype[lastprot]->lthparlist++ ;
 281
 282   fre += 3 ;
 283 }
 284
 285
 286 static void putaddr(ap,a) int ap,a;{
 287
 288       /* PUT PROTOTYPE AND OFFSET INTO ATTRIBUTE DESCRIPTION AT "A" IN IPMEM */
 289
 290   ipmem[ a - 2 ] = offset ;
 291   ipmem[ a - 1 ] = lastprot ;
 292
 293   if(ap == APVIRT) offset += APREF ;
 294   else             offset += ap ;
 295 }
 296
 297
 298 static void offsets(){
 299
 300  /* COMPUTE OFFSETS FOR ALL ATTRIBUTES,  */
 301  /* COMPUTE OFFSETS FOR ALL ATTRIBUTES,  */
 302  /*          LINK PARAMETERS,            */
 303  /*          LINK REFERENCE ATTRIBUTES   */
 304
 305   int         p, n, a ;
 306   pointprdsc  curr ;
 307   {
 308     curr = prototype[lastprot] ;
 309     offset = curr->appetite; /* total length of attributes from prefix,if any */
 310
 311     /* GO THRU THE LIST OF ATTRIBUTES */
 312     for (p = ipmem[ curr->codeaddr + 6 ] ; /* first element */
 313          p != 0 ;
 314          p = ipmem[ p+1 ]  /* next element */){
 315
 316       /* LIST ELEMENT : POINTER TO ATTRIBUTE DESCRIPTION,  */
 317       /*                     POINTER TO THE NEXT ELEMENT */
 318
 319       a = ipmem[ p ] ; /* attribute address in ipmem */
 320       switch (itemkind(a)){
 321
 322         case  IFMPROC  :  parproc(a) ;
 323                           putaddr(APFMPROC, a) ;
 324                           break ;
 325
 326         case  IFMFUNC  :  parfunc(a) ;
 327                           putaddr(APFMPROC, a) ;
 328                           break ;
 329
 330         case   IFMTYPE  :   partype(a) ;
 331                             putaddr(APFMTYPE, a) ;
 332                             break ;
 333
 334         case   IPARIN :     param(a, PARIN) ;
 335                             putaddr(apet(a), a) ;
 336                             break ;
 337
 338         case   IPAROUT  :   param(a, PAROUT) ;
 339                             putaddr(apet(a), a) ;
 340                             break ;
 341
 342         case   IPARINOUT :  param(a, PARINOUT) ;
 343                             putaddr(apet(a), a) ;
 344                             break ;
 345
 346         case   IVAR :  n = apet(a) ;
 347                        if (n == APVIRT)
 348                        {
 349                          addtolist(&listofref[ lastprot ], a) ;
 350                          curr->lthreflist++ ;
 351                          n = APREF ;
 352                         }
 353
 354                         putaddr(n, a) ;
 355                         break ;
 356         default : break ;
 357         /*  IBLOCK, IPREFBLOCK, IHANDLER, ISIGNAL :  IMPOSSIBLE */
 358
 359         /*   ICLASS,IRECORD,ICOROUT,IPROCESS,IFUNC,IPROC,ICONST: NOP */
 360
 361       } /* switch */
 362
 363     } /* for */
 364
 365     curr->appetite = offset ;
 366   } /* WITH */
 367
 368 } /* OFFSETS */
 369
 370
 371
 372
 373 static void signoffst(s) int s;{
 374
 375          /* COMPUTES THE OFFSETS OF PARAMETERS OF */
 376          /* THE SIGNAL DESCRIBED IN IPMEM AT S    */
 377
 378   int  offset  ;
 379   int  p ;
 380   int  param ; /* POINTER TO PARAMETER DESCRIPTION */
 381   int  ap ;
 382
 383   offset = APINT + APINT;
 384
 385   /* GO THRU THE LIST OF ATTRIBUTES */
 386   for( p = ipmem[ s+6 ] ; /* first element */
 387        (p != 0) ;
 388        p = ipmem[ p+1 ] /* next element */)
 389
 390   {
 391     /* LIST ELEMENT : POINTER TO ATTRIBUTE DESCRIPTION */
 392     /*                POINTER TO THE NEXT ELEMENT      */
 393     param = ipmem[ p ] ;        /* attribute address in ipmem */
 394
 395     switch(itemkind(param))
 396     {
 397       case  IFMPROC   : ;
 398       case  IFMFUNC   : ap = APFMPROC ;
 399                         break ;
 400
 401       case  IFMTYPE   : ap = APFMTYPE ;
 402                         break ;
 403              default  :
 404              /* IPARIN,IPAROUT,IPARINOUT */
 405                         ap = apet(param) ;
 406                         if (ap == APVIRT)
 407                           ap = APREF ;
 408                         break ;
 409     } /* switch */
 410
 411            ipmem[ param-2 ] = offset ;
 412            offset += ap ;
 413   } /* for */
 414 } /* SIGNOFFST */
 415
 416
 417 static void addressing()
 418
 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   */
 424     /*                 INTO LIST                                            */
 425     /*   - PARAMETERS ARE LINKED INTO LIST                                  */
 426     /*         ( THEIR DESCRIPTIONS ARE ALSO PRODUCED )                     */
 427
 428 {
 429   int  pip ;            /* PROTOTYPE IN IPMEM */
 430   protaddr  nextunit ;
 431   protkind  pkind[ IFMFUNC + 1 ] ; /* AUXILIARY, READ-ONLY */
 432   logitem   it ;
 433
 434   pointprdsc  curr;  /* for translation of Pascal's WITH */
 435
 436   for (it = ICLASS; it <= IFMFUNC ; it++)
 437          pkind[  it  ] = it;
 438
 439        /* START FROM THE MAIN BLOCK */
 440   nextunit = MAINBLOCK ;
 441   pip = nblus; /* main block in ipmem */
 442
 443   do /* GET UNIT FROM THE LIST OF ALL UNITS */
 444   {
 445     it = itemkind(pip);
 446     if ( (it == ICLASS) || (it == IRECORD) || (it == ICOROUT)
 447       || (it == IPROCESS) || (it == IBLOCK) || (it == IPREFBLOCK)
 448       || (it == IFUNC) || (it == IPROC) || (it == IHANDLER) )
 449       { /* REAL UNIT */
 450
 451            if (nextunit > MAXPROT)
 452              generror(TMPROT) ;
 453       /* mb removed case which did the same in every case */
 454       /* in doubts cf. Pascal version */
 455      prototype[ nextunit ] =  (pointprdsc) new(prototype[ nextunit ]) ;
 456
 457          /* WITH PROTOTYPE[ NEXTUNIT ] ^ DO */
 458         { curr = prototype[nextunit] ;
 459           curr->codeaddr = pip ;  /* pointer to the description in ipmem */
 460           curr->kind = pkind[ it ] ;
 461         }
 462
 463         nextunit++ ;
 464       } /* OF REAL UNIT */
 465     else
 466       if (it == ISIGNAL)
 467         signoffst(pip) ;
 468
 469       pip = ipmem[ pip+2 ] ; /* move on to the next unit */
 470   }
 471   while (pip != 0) ;            /* END OF LIST.             */
 472
 473   lastprot = MAINBLOCK ;
 474
 475   do
 476   {
 477     pdescr() ;  /* make prototype's description       */
 478     offsets();  /* compute offsets for all attributes */
 479     lastprot++ ;
 480   }
 481   while (lastprot != nextunit) ;
 482
 483   lastprot = nextunit-1;
 484 } /* ADDRESSING */
 485
 486
 487 static void rpcmask(){
 488  pointprdsc *prot ;
 489
 490  for (prot = prototype; prot <= &prototype[lastprot]; prot++)
 491  {
 492    if ((*prot)->kind == PROCESS)
 493      {
 494       (*prot)->maskbase = MAINBLOCK ;
 495        (*prot)->masksize = (lastprot + 7) / 8 ;
 496      }
 497   }
 498 }
 499
 500
 501
 502    void genprot(){
 503
 504                     /* PROTOTYPES CREATING */
 505
 506      out() ;
 507      primdescr() ;  /* primitive types descriptions           */
 508      addressing() ; /* offsets, prototypes without lists      */
 509      lists() ;      /* preflist, parlist, virtlist, descrlist */
 510      handlers() ;   /* handlers lists                         */
 511
 512 /*CBC Force unit kind of main to be PROCESS (instead of BLOCK) ...*/
 513      prototype[ MAINBLOCK ]->kind = PROCESS ;
 514
 515 /*CBC Added computing of base and size of RPC mask */
 516     rpcmask() ;
 517 /*...CBC*/
 518
 519 } /* GENPROT */
 520
 521