sources/int/compact.c

   1 /*     Loglan82 Compiler&Interpreter\r
   2      Copyright (C) 1993 Institute of Informatics, University of Warsaw\r
   3      Copyright (C)  1993, 1994 LITA, Pau\r
   4      \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
   9      \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
  14      \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
  18 \r
  19  contacts:  Andrzej.Salwicki@univ-pau.fr\r
  20 \r
  21 or             Andrzej Salwicki\r
  22                 LITA   Departement d'Informatique\r
  23                 Universite de Pau\r
  24                 Avenue de l'Universite\r
  25                 64000 Pau   FRANCE\r
  26                  tel.  ++33 59923154    fax. ++33 59841696\r
  27 \r
  28 =======================================================================\r
  29 */\r
  30 \r
  31 #include        "depend.h"\r
  32 #include        "genint.h"\r
  33 #include        "int.h"\r
  34 #include        "process.h"\r
  35 #include        "intproto.h"\r
  36 \r
  37 #include <assert.h>\r
  38 \r
  39 \r
  40 #ifndef NO_PROTOTYPES\r
  41 \r
  42 static word get_pointer(word,word);\r
  43 static void phase1(void);\r
  44 static void phase2(void);\r
  45 static void phase2a(void);\r
  46 static void phase3(void);\r
  47 static void phase4(void);\r
  48 static void phase5(void);\r
  49 static void phase6(void);\r
  50 static void curtain(void);\r
  51 static void heap_walk(word);\r
  52 static void nonefy(virtaddr *);\r
  53 static void relocate(virtaddr *);\r
  54 static void traverse(word,void (*)(virtaddr *));\r
  55 static void what_we_have(virtaddr *);\r
  56 \r
  57 #else\r
  58 \r
  59 static word get_pointer();\r
  60 static void phase1();\r
  61 static void phase2();\r
  62 static void phase2a();\r
  63 static void phase3();\r
  64 static void phase4();\r
  65 static void phase5();\r
  66 static void phase6();\r
  67 static void curtain();\r
  68 static void heap_walk();\r
  69 static void nonefy();\r
  70 static void relocate();\r
  71 static void traverse();\r
  72 static void what_we_have();\r
  73 \r
  74 #endif\r
  75 \r
  76 \r
  77 #ifdef CDBG\r
  78 FILE *ff;\r
  79 static void what_we_have(va) virtaddr *va; {\r
  80     fprintf(ff,"   pointer offset %d:|va=%d,va_m=%d,M[va]=%d,M[va+1]=%d|\n",\r
  81             ((word*)va)-M,va->addr,va->mark,M[va->addr],M[va->addr+1]);\r
  82     fflush(ff);\r
  83 }\r
  84 #endif\r
  85 \r
  86 \r
  87 /*\r
  88  * Memory compactifier - a play in 6 acts\r
  89  */\r
  90 \r
  91 static word nleng;                      /* free memory before compact. */\r
  92 static word curah;                      /* to preserve ah of current object */\r
  93 \r
  94 /* One of the actions for traverse: see below;\r
  95  * converts none to absolute none, i.e. (0, 0)\r
  96  */\r
  97 \r
  98 \r
  99 static void nonefy(va) virtaddr *va; {\r
 100 \r
 101 #ifdef CDBG\r
 102     if(va->addr==0 && va->mark!=0){\r
 103         fprintf(ff,"nonefy:|va=%d,va_m=%d,M[va]=%d,M[va+1]=%d|\n",\r
 104                 va->addr,va->mark,M[va->addr],M[va->addr+1]);\r
 105         fflush(ff);\r
 106     }\r
 107 #endif\r
 108 \r
 109 #ifndef OBJECTADDR\r
 110     if(!isprocess(va))\r
 111 #else\r
 112     assert( va->mark >= 0  );\r
 113 /*    assert( va->mark <= M[ va->addr+1 ]   );*/\r
 114 #endif\r
 115 #ifdef CDBG\r
 116         fprintf(ff,"nonefy:|va=%d,va_mark=%d,am=%d,mark=%d|\n",\r
 117                 va->addr,va->mark,M[va->addr],M[va->addr+1]);\r
 118         fflush(ff);\r
 119 #endif\r
 120     if( va->mark != M[ va->addr+1 ]   )     /* if NONE */\r
 121     {\r
 122 \r
 123 #ifdef CDBG\r
 124         fprintf(ff,"            set to NONE\n"); fflush(ff);\r
 125 #endif\r
 126         va->addr = 0;\r
 127         va->mark = 0;\r
 128     }\r
 129     assert( va->addr != 1 );\r
 130 } /* end nonefy  */\r
 131 \r
 132 \r
 133 /* One of the actions for traverse; update the virtual address to\r
 134  * correspond to its dictionary entry after compactification.\r
 135  */\r
 136 \r
 137 static void relocate(va) virtaddr *va; {\r
 138 #ifndef OBJECTADDR\r
 139     if(!isprocess(va)){\r
 140 #endif\r
 141     va->addr = M[ va->addr+1 ]; /* new ah (after compression) */\r
 142     va->mark = 0;                       /* clear mark */\r
 143 #ifndef OBJECTADDR\r
 144     }\r
 145 #endif\r
 146 } /* end relocate */\r
 147 \r
 148 \r
 149 /* Traverse all the virtual variables of object am and perform action\r
 150  * on each of them. Skip references to processes (see nonefy() and\r
 151  * relocate()).\r
 152  */\r
 153 \r
 154 static void traverse(am, action)\r
 155    word am;\r
 156 #ifndef NO_PROTOTYPES\r
 157    void (*action)(virtaddr *);\r
 158 #else\r
 159    void (*action)();\r
 160 #endif\r
 161 {\r
 162     word t1, t2, t3, length;\r
 163     protdescr *ptr;\r
 164 \r
 165     t1 = am+M[ am ];                    /* LWA+1 of the object */\r
 166     length = M[ am+PROTNUM ];           /* prototype number */\r
 167     if (length == AINT || length == AREAL || length == AVIRT ||\r
 168         length == FILEOBJECT\r
 169 #ifdef OBJECTADDR\r
 170         || length == APROCESS\r
 171 #endif\r
 172        )\r
 173     {\r
 174         if (length == AVIRT)            /* ARRAYOF <reference> */\r
 175             for (t2 = am+3;  t2 < t1;  t2 += 2)\r
 176                 (*action)((virtaddr *)(M+t2));\r
 177     }\r
 178     else                                /* neither an array nor a file */\r
 179     {\r
 180         ptr = prototype [ length ];\r
 181         switch (ptr->kind)              /* compute the number of the system */\r
 182                                         /* virtual variables */\r
 183         {\r
 184             case RECORD    : length = 0;  t3 = 0;        break;\r
 185             case COROUTINE : length = 3;  t3 = CL;       break;\r
 186             case PROCESS   : length = 5;  t3 = disp2off; break;\r
 187             case FUNCTION  :\r
 188             case PROCEDURE : length = 2;  t3 = RPCDL+1;  break; /* PS */\r
 189             case HANDLER   : length = 2;  t3 = SIGNR;    break;\r
 190             default        : length = 2;  t3 = STATSL;   break;\r
 191         }\r
 192 \r
 193         /* action for system reference variables */\r
 194         for (t2 = length;  t2 >= 1;  t2-- )\r
 195             (*action)((virtaddr *)(M+t1+offset[ t2 ]));\r
 196 \r
 197         /* action for temporary reference variables */\r
 198         t1 = am+M[ am ]+t3;\r
 199         for (t2 = am+ptr->span;  t2 < t1;  t2 += 2)\r
 200             (*action)((virtaddr *)(M+t2));\r
 201 \r
 202         /* action for user reference variables */\r
 203         t1 = ptr->reflist;\r
 204         for (t2 = t1+ptr->lthreflist-1;  t2 >= t1;  t2-- )\r
 205             (*action)((virtaddr *)(M+am+M[ t2 ]));\r
 206     }\r
 207 } /* end traverse */\r
 208 \r
 209 \r
 210 /* Mark killed objects by substituting prototype number by a special value.\r
 211  * This way we will be able to tell apart the killed objects without\r
 212  * recalling to the dictionary or to the list of killed objects.\r
 213  */\r
 214 \r
 215 static void phase1()\r
 216 {\r
 217     word t1, t2, t3, phead;\r
 218 \r
 219     nleng = thisp->lastitem-thisp->lastused-1; /* free memory before comp. */\r
 220     M[ 1 ] = 0;                         /* for proper update of none */\r
 221     phead = thisp->prochead;            /* head of current process */\r
 222     M[ phead+M[ phead ]+SL ] = 0;       /* make SL of head look like none */\r
 223     t1 = thisp->headk2;                 /* flag killed objects */\r
 224     while (t1 != 0)                     /* special list for appetite=2 */\r
 225     {\r
 226         t2 = t1+SHORTLINK;\r
 227         t1 = M[ t2 ];\r
 228         M[ t2 ] = SKILLED;              /* flag object killed */\r
 229     }\r
 230     t1 = thisp->headk;                  /* now other killed objects */\r
 231     while (t1 != thisp->lower)\r
 232     {\r
 233         t2 = t1;\r
 234         while (t2 != 0)\r
 235         {\r
 236             t3 = t2+SHORTLINK;\r
 237             t2 = M[ t3 ];\r
 238             M[ t3 ] = SKILLED;          /* flag object killed */\r
 239         }\r
 240         t1 = M[ t1+LONGLINK ];          /* goto other size list */\r
 241     }\r
 242 } /* end phase1 */\r
 243 \r
 244 \r
 245 /* Step thru the memory area containing objects. For each object not being\r
 246  * killed detect all its virtual variables pointing to none and convert\r
 247  * them to absolute none i.e. (0, 0).\r
 248  */\r
 249 \r
 250 static void phase2()\r
 251 {\r
 252     word t1;\r
 253 \r
 254     nonefy( &(thisp->procref ) );\r
 255 \r
 256     t1 = thisp->lower+1;                /* FWA of object area */\r
 257     while (t1 <= thisp->lastused)\r
 258     {\r
 259 \r
 260 #ifdef CDBG\r
 261         fprintf(ff,"OBJECT am=%d,SIZE=%d,TYPE=%d\n",t1,M[t1],M[t1+1]);\r
 262         fflush(ff);\r
 263         if (M[ t1+1 ] != SKILLED) traverse(t1,what_we_have);\r
 264 #endif\r
 265 \r
 266         if (M[ t1+1 ] != SKILLED)       /* an active object */\r
 267             traverse(t1, nonefy);\r
 268         t1 += M[ t1 ];                  /* next object address */\r
 269     }\r
 270 } /* end phase2 */\r
 271 \r
 272 \r
 273 /* garbage collection */\r
 274 \r
 275 /* Find x-th pointer in am.\r
 276  * Skip references to processes.\r
 277  */\r
 278 \r
 279 static word get_pointer(am,x) word am,x; {\r
 280 \r
 281     word t1, t2, t3, length, va;\r
 282     protdescr *ptr;\r
 283 \r
 284     t1 = am+M[ am ];                    /* LWA+1 of the object */\r
 285     length = M[ am+PROTNUM ];           /* prototype number */\r
 286 \r
 287 #ifdef CDBG\r
 288     fprintf(ff,"|get_pointer(am=%d,x=%d)lenght=%d|",am,x,length);\r
 289     fflush(ff);\r
 290 #endif\r
 291 \r
 292     if (length == AINT || length == AREAL || length == AVIRT ||\r
 293         length == FILEOBJECT\r
 294 #ifdef OBJECTADDR\r
 295         || length == APROCESS\r
 296 #endif\r
 297        )\r
 298     {\r
 299         if(length == AVIRT)             /* ARRAYOF <reference> */\r
 300             for(t2 = am+3;  t2 < t1;  t2 += 2){\r
 301 #ifndef OBJECTADDR\r
 302                 if(isprocess((virtaddr *)(M+t2))) continue;\r
 303 #endif\r
 304                 if(M[t2]==0){ assert( M[t2+1]==0 ); continue; }\r
 305 #ifdef CDBG\r
 306                 fprintf(ff,"ARR");\r
 307                 fflush(ff);\r
 308 #endif\r
 309                 if(x==0){\r
 310 #ifdef CDBG\r
 311                     fprintf(ff,"=%d|\n",t2);\r
 312                     fflush(ff);\r
 313 #endif\r
 314                     return t2;\r
 315                 }\r
 316                 x--;\r
 317             }\r
 318     }\r
 319     else                                /* neither an array nor a file */\r
 320     {\r
 321         ptr = prototype [ length ];\r
 322         switch (ptr->kind)              /* compute the number of the system */\r
 323                                         /* virtual variables */\r
 324         {\r
 325             case RECORD    : length = 0;  t3 = 0;        break;\r
 326             case COROUTINE : length = 3;  t3 = CL;       break;\r
 327             case PROCESS   : length = 5;  t3 = disp2off; break;\r
 328             case FUNCTION  :\r
 329             case PROCEDURE : length = 2;  t3 = RPCDL+1;  break; /* PS */\r
 330             case HANDLER   : length = 2;  t3 = SIGNR;    break;\r
 331             default        : length = 2;  t3 = STATSL;   break;\r
 332         }\r
 333 \r
 334         /* system reference variables */\r
 335         for(t2 = length;  t2 >= 1;  t2-- ){\r
 336             va=t1+offset[ t2 ];\r
 337 #ifndef OBJECTADDR\r
 338             if(isprocess((virtaddr *)(M+va))) continue;\r
 339 #endif\r
 340             if(M[va]==0){ assert( M[va+1]==0 ); continue; }\r
 341             if(x==0){\r
 342 #ifdef CDBG\r
 343                 fprintf(ff,"=%d|\n",va);\r
 344                 fflush(ff);\r
 345 #endif\r
 346                 return va;\r
 347             }\r
 348             x--;\r
 349         }\r
 350 \r
 351         /* temporary reference variables */\r
 352         t1 = am+M[ am ]+t3;\r
 353         for(t2 = am+ptr->span;  t2 < t1;  t2 += 2){\r
 354 #ifndef OBJECTADDR\r
 355             if(isprocess((virtaddr *)(M+t2))) continue;\r
 356 #endif\r
 357             if(M[t2]==0){ assert( M[t2+1]==0 ); continue; }\r
 358             if(x==0){\r
 359 #ifdef CDBG\r
 360                 fprintf(ff,"=%d|\n",t2);\r
 361                 fflush(ff);\r
 362 #endif\r
 363                 return t2;\r
 364             }\r
 365             x--;\r
 366         }\r
 367 \r
 368         /* user reference variables */\r
 369         t1 = ptr->reflist;\r
 370         for(t2 = t1+ptr->lthreflist-1;  t2 >= t1;  t2-- ){\r
 371             va=am+M[ t2 ];\r
 372 #ifndef OBJECTADDR\r
 373             if(isprocess((virtaddr *)(M+va))) continue;\r
 374 #endif\r
 375             if(M[va]==0){ assert( M[va+1]==0 ); continue; }\r
 376             if(x==0){\r
 377 #ifdef CDBG\r
 378                 fprintf(ff,"=%d|\n",va);\r
 379                 fflush(ff);\r
 380 #endif\r
 381                 return va;\r
 382             }\r
 383             x--;\r
 384         }\r
 385     }\r
 386 \r
 387 #ifdef CDBG\r
 388     fprintf(ff,"=-1|\n");\r
 389     fflush(ff);\r
 390 #endif\r
 391 \r
 392     return -1;\r
 393 }\r
 394 \r
 395 static void heap_walk(curr_ah) word curr_ah;{\r
 396    word aux,prev_ah=1; /* 1 is special value not expected in anyone virtaddr */\r
 397    word level=0;\r
 398 \r
 399 #ifdef CDBG\r
 400    fprintf(ff,"|prev_ah=%d|\n",prev_ah);\r
 401    fflush(ff);\r
 402 #endif\r
 403 \r
 404    for(;;){\r
 405       word am=get_pointer(M[curr_ah],M[curr_ah+1]);\r
 406       M[curr_ah+1]++;\r
 407       if(am >= 0){\r
 408          if(M[ M[am] +1] >0){\r
 409 #ifdef CDBG\r
 410             fprintf(ff,"Object %d->%d invited.\n",M[am],M[M[am]]);\r
 411             fflush(ff);\r
 412 #endif\r
 413             continue;\r
 414          }\r
 415 \r
 416          /*** go ahead ***/\r
 417          level++;\r
 418          aux=M[am];\r
 419          M[am]=prev_ah;\r
 420          prev_ah=curr_ah;\r
 421          curr_ah=aux;\r
 422 #ifdef CDBG\r
 423          fprintf(ff,"|curr_ah set to %d|\n",curr_ah);\r
 424          fflush(ff);\r
 425 #endif\r
 426          continue;\r
 427       }\r
 428       if(prev_ah > 1){\r
 429          /*** go back ***/\r
 430 #ifdef CDBG\r
 431          fprintf(ff,"going back (prev_ah=%d)(lvl=%d)\n",prev_ah,level);\r
 432          fflush(ff);\r
 433 #endif\r
 434          level--;\r
 435          aux=curr_ah;\r
 436          curr_ah=prev_ah;\r
 437          am=get_pointer(M[prev_ah],M[prev_ah+1]-1);\r
 438          prev_ah=M[am];\r
 439 #ifdef CDBG\r
 440          if(level==0)\r
 441             fprintf(ff,"|prev_ah set to %d,next set to %d|\n",prev_ah,aux);\r
 442          fflush(ff);\r
 443 #endif\r
 444          M[am]=aux;\r
 445          continue;\r
 446       }\r
 447       assert( prev_ah==1 );\r
 448       assert( level == 0 );\r
 449       break;  /*** now all 'invited' objects have its mark >0 ***/\r
 450    }\r
 451 }\r
 452 \r
 453 static void phase2a()\r
 454 {\r
 455     word t1,c1_ah;\r
 456 \r
 457     /*** generation number already is not needed so we reset it ***/\r
 458 \r
 459     t1 = thisp->upper-1;\r
 460     while(t1 >= thisp->lastitem){\r
 461        if( M[t1] == c1 ) c1_ah=t1;\r
 462        M[ t1+1 ] = 0;\r
 463        t1-=2;\r
 464     }\r
 465 \r
 466 #ifdef CDBG\r
 467     fprintf(ff,"first phase of walk |from=%d,to=%d,procah=%d|\n",\r
 468             thisp->lastitem,\r
 469             thisp->upper-1,\r
 470             thisp->procref.addr);\r
 471     fflush(ff);\r
 472 #endif\r
 473 \r
 474     heap_walk(thisp->procref.addr);\r
 475 \r
 476 #ifdef CDBG\r
 477     fprintf(ff,"second phase of walk c1_ah=%d,c1=%d\n",c1_ah,c1);\r
 478     fflush(ff);\r
 479 #endif\r
 480 \r
 481     heap_walk(c1_ah);\r
 482 \r
 483     if( thisp->blck1 != 0 )\r
 484        heap_walk(thisp->blck1);\r
 485 \r
 486     /*** Mark objects not traversed like SKILLED ***/\r
 487 \r
 488     t1 = thisp->freeitem;               /* head of free item list */\r
 489     while (t1 != 0)\r
 490     {\r
 491         word t2;\r
 492         t2 = M[ t1 ];\r
 493         M[ t1 ]= 0-1;                   /* mark not to set object SKILLED */\r
 494         t1 = t2;                        /* next free item */\r
 495     }\r
 496 \r
 497     t1 = thisp->upper-1;                /* last dictionary item pointer */\r
 498     while (t1 >= thisp->lastitem)\r
 499     {\r
 500         if (M[ t1+1 ]  == 0 ){          /* entry not traversed - so killed */\r
 501 \r
 502 #ifdef CDBG\r
 503             fprintf(ff,"MARKING dict. entry %d -> %d like SKILLED\n",t1,M[t1]);\r
 504             fflush(ff);\r
 505 #endif\r
 506 \r
 507             M[ t1+1 ] = MAXMARKER;\r
 508             if( M[ t1 ] > 0 )   M [ M[ t1 ] +1 ] = SKILLED;\r
 509                                         /* mark SKILLED if not set yet */\r
 510         }\r
 511         t1 -= 2;\r
 512     }\r
 513 } /* end phase2a */\r
 514 \r
 515 \r
 516 \r
 517 /* For each free dictionary item set its mark to unusable status.\r
 518  */\r
 519 \r
 520 static void phase3()\r
 521 {\r
 522     word t1;\r
 523 \r
 524     t1 = thisp->freeitem;               /* head of free item list */\r
 525     while (t1 != 0)\r
 526     {\r
 527         M[ t1+1 ] = MAXMARKER;          /* flag item unusable */\r
 528         t1 = M[ t1 ];                   /* next free item */\r
 529     }\r
 530 } /* end phase3 */\r
 531 \r
 532 \r
 533 /* Step thru the dictionary and virtually remove all unusable items.\r
 534  * For each active item (after phase3 we have only active and unusable\r
 535  * items) its mark is set to the new address of this item (after\r
 536  * forthcomming compression). Moreover the contents of locations am and\r
 537  * (old) ah are interchanged.\r
 538  */\r
 539 \r
 540 static void phase4()\r
 541 {\r
 542     word t1, t2, t3;\r
 543 \r
 544     t1 = thisp->upper-1;                /* last dictionary item pointer */\r
 545     t2 = t1;                            /* initialize new address */\r
 546     while (t1 >= thisp->lastitem)\r
 547     {\r
 548         if (M[ t1+1 ] == MAXMARKER)     /* entry killed - don't decrement t2 */\r
 549             M[ t1+1 ] = 0;\r
 550         else\r
 551         {\r
 552             M[ t1+1 ] = t2;             /* store new ah */;\r
 553             t2 -= 2;\r
 554             t3 = M[ t1 ];               /* am */\r
 555             M[ t1 ] = M[ t3 ];          /* save (am) in (old ah) */\r
 556             M[ t3 ] = t1;               /* move old ah to (am) */\r
 557         }\r
 558         t1 -= 2;\r
 559     }\r
 560 } /* end phase4 */\r
 561 \r
 562 \r
 563 /* The memory area of objects is traversed once again. Now the killed\r
 564  * objects are removed and the remaining ones compressed. For each active\r
 565  * object its virtual variables are relocated, their marks cleared, their\r
 566  * ah's set to the proper new values. The contents of locations am and ah\r
 567  * are interchanged back.\r
 568  */\r
 569 \r
 570 static void phase5()\r
 571 {\r
 572     word t1, t2, t3, t4, t5;\r
 573 \r
 574     t2 = t1 = thisp->lower+1;\r
 575     while (t1 <= thisp->lastused)       /* traverse object area */\r
 576     {\r
 577         t5 = M[ t1 ];                   /* old ah saved by phase4 */\r
 578         if (M[ t1+1 ] == SKILLED){      /* ignore this object */\r
 579 #ifdef CDBG\r
 580             fprintf(ff,"OBJECT am=%d,SIZE=%d,TYPE=%d\n",t1,M[t1],M[t1+1]);\r
 581             fflush(ff);\r
 582 #endif\r
 583             t1 += t5;                   /* t5=appetite in this case */\r
 584         }\r
 585         else\r
 586         {\r
 587 #ifdef CDBG\r
 588             fprintf(ff,"OBJECT am=%d,SIZE=%d,TYPE=%d\n",t1,M[t1],M[t1+1]);\r
 589             fflush(ff);\r
 590 #endif\r
 591             t3 = M[ t5 ];               /* appetite saved by phase4 */\r
 592             M[ t2 ] = t3;               /* send it to the new am */\r
 593             for (t4 = 1;  t4 < t3;  t4++ )   /* copy the object into new am */\r
 594                 M[ t2+t4 ] = M[ t1+t4 ];\r
 595 #ifdef CDBG\r
 596             traverse(t2,what_we_have);\r
 597 #endif\r
 598 \r
 599             /* Update global absolute pointer to current object : */\r
 600             if (t1 == c1)               /* locate am of current */\r
 601             {\r
 602                 c1 = t2;\r
 603                 curah = M[ t5+1 ];      /* new ah of current */\r
 604             }\r
 605             if (t1 == M[ temporary ])\r
 606                 M[ temporary ] = t2;\r
 607 \r
 608             M[ t5 ] = t2;               /* make (ah) looking ok */\r
 609             traverse(t2, relocate);     /* relocate virtual variables */\r
 610 #ifdef CDBG\r
 611             fprintf(ff,"   --> am=%d,SIZE=%d,TYPE=%d\n",t2,M[t2],M[t2+1]);\r
 612             fflush(ff);\r
 613             traverse(t2,what_we_have);\r
 614 #endif\r
 615             t1 += t3;\r
 616             t2 += t3;\r
 617         }\r
 618     }\r
 619     thisp->lastused = t2-1;\r
 620 \r
 621 \r
 622     /* Update global absolute pointers to objects : */\r
 623 \r
 624     relocate(&(thisp->procref ));\r
 625 \r
 626     {\r
 627        virtaddr v;\r
 628        v.addr=thisp->blck1;\r
 629        v.mark=0;\r
 630        relocate(&v);\r
 631        thisp->blck1=v.addr;\r
 632     }\r
 633 \r
 634 } /* end phase5 */\r
 635 \r
 636 \r
 637 /* The dictionary is compressed. The unusable entries are moved out and\r
 638  * the remaining ones are moved up to the positions indicated by their\r
 639  * marks.\r
 640  * If pointers to processes are implemented as objects we have to rebuild\r
 641  * has table of these pointers too.\r
 642  */\r
 643 \r
 644 static void phase6()\r
 645 {\r
 646     word t1, t2, t3;\r
 647 \r
 648 #ifdef OBJECTADDR\r
 649     hash_create(thisp,thisp->hash_size);\r
 650 #endif\r
 651 \r
 652     t1 = thisp->upper+1;\r
 653     for (t2 = t1-2;  t2 >= thisp->lastitem;  t2 -= 2)  /* compress dictionary */\r
 654     {\r
 655         t3 = M[ t2+1 ];\r
 656         if (t3 != 0)                    /* this is new ah */\r
 657         {\r
 658             M[ t3 ] = M[ t2 ];\r
 659             M[ t3+1 ] = 0;              /* clear mark */\r
 660             t1 = t3;\r
 661 #ifdef OBJECTADDR\r
 662             {\r
 663                virtaddr vt3;\r
 664                vt3.addr=t3;\r
 665                vt3.mark=0;\r
 666                if( isprocess(&vt3) ){\r
 667                   virtaddr obj;\r
 668                   procaddr mess;\r
 669                   obj.addr=t3;\r
 670                   obj.mark=0;\r
 671                   obj2mess(M,&obj,&mess);\r
 672                   /* force to create item - we not need it yet */\r
 673                   hash_set(&mess,t3);\r
 674                }\r
 675             }\r
 676 #endif\r
 677         }\r
 678     }\r
 679     thisp->lastitem = t1;\r
 680 \r
 681     thisp->prochead = M[ thisp->procref.addr ];\r
 682     thisp->blck2 = M[ thisp->blck1 ];\r
 683 \r
 684 } /* end phase6 */\r
 685 \r
 686 \r
 687 /* System invariants are recovered, e.g. display is rebuilt to reflect the\r
 688  * new physical addresses.\r
 689  */\r
 690 \r
 691 static void curtain()\r
 692 {\r
 693     word t1, phead;\r
 694 \r
 695     phead = thisp->prochead;\r
 696     t1=M[ c1 + PROTNUM ];\r
 697     c2 = c1+prototype[ t1 ]->span;\r
 698     t1 = phead+M[ phead ];              /* first free after process head */\r
 699     display = t1+dispoff;               /* display address */\r
 700     display2 = t1+disp2off;             /* indirect display */\r
 701     M[ t1+SL ] = DUMMY;                 /* restore head's SL */\r
 702     loosen();                           /* rebuild DISPLAY */\r
 703     update(c1, curah);\r
 704     if (infmode){\r
 705        fprintf(stderr,\r
 706       "\n(COMPACTIFIER used for process %d,%ld words reclaimed,now %ld free)\n",\r
 707                        thispix,\r
 708                        (long) (thisp->lastitem-thisp->lastused-1-nleng),\r
 709                        (long) (thisp->lastitem-thisp->lastused-1));\r
 710        fflush(stderr);\r
 711     }\r
 712 #ifdef CDBG\r
 713        fprintf(ff,\r
 714         "(COMPACTIFIER used for process %d,%ld words reclaimed,now %ld free)\n",\r
 715                    thispix,\r
 716                    (long) (thisp->lastitem-thisp->lastused-1-nleng),\r
 717                    (long) (thisp->lastitem-thisp->lastused-1));\r
 718        fflush(ff);\r
 719 #endif\r
 720     thisp->freeitem = 0;\r
 721     thisp->headk2 = 0;\r
 722     thisp->headk = thisp->lower;\r
 723     M[ 1 ] = 1;                         /* absolute none */\r
 724     ic = lastic;                        /* re-decode current instruction ! */\r
 725     decode();\r
 726     if (opcode == 3 /*LRAISE*/) ic++;   /* skip address after LRAISE */\r
 727 } /* end curtain */\r
 728 \r
 729 \r
 730 void compactify()                       /* Compactification */\r
 731 {\r
 732 #ifdef CDBG\r
 733     ff=fopen("trace","a");\r
 734     fprintf(ff,"----------------------------------------\n");\r
 735     fprintf(ff,"COMPACTIFY (thisp=%d)\n",thispix);\r
 736     fprintf(ff,"c1=%d,c2=%d,templ=%d\n",\r
 737                thisp->c1,thisp->c2,thisp->template.addr);\r
 738     fprintf(ff,"back=%d,back.mark=%d,backam=%d,backam.mark=%d\n",\r
 739                thisp->backobj.addr,thisp->backobj.mark,\r
 740                M[thisp->backobj.addr],M[thisp->backobj.addr+1]);\r
 741     fprintf(ff,"blck1=%d,blck2=%d\n",thisp->blck1,thisp->blck2);\r
 742     fflush(ff);\r
 743 #endif\r
 744 \r
 745     phase1();\r
 746     phase2();\r
 747     phase2a();  /* garbage collection */\r
 748 /*  phase3();   if only compactifier is needed uncomment this statement */\r
 749 /*              and comment statement phase2a()                         */\r
 750     phase4();\r
 751     phase5();\r
 752     phase6();\r
 753     curtain();\r
 754 \r
 755 #ifdef CDBG\r
 756     fprintf(ff,"----------------------------------------\n");\r
 757     fflush(ff);\r
 758     fclose(ff);\r
 759 #endif\r
 760 \r
 761 } /* end compactify */\r
 762 \r
 763 \r