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