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