1 /* Loglan82 Compiler&Interpreter
2 Copyright (C) 1993 Institute of Informatics, University of Warsaw
3 Copyright (C) 1993, 1994 LITA, Pau
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
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.
19 contacts: Andrzej.Salwicki@univ-pau.fr
22 LITA Departement d'Informatique
24 Avenue de l'Universite
26 tel. ++33 59923154 fax. ++33 59841696
28 =======================================================================
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 *);
58 static word get_pointer();
61 static void phase2a();
66 static void curtain();
67 static void heap_walk();
69 static void relocate();
70 static void traverse();
71 static void what_we_have();
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]);
87 * Memory compactifier - a play in 6 acts
89 /** free memory before compact. */
91 /** to preserve ah of current object */
95 * One of the actions for traverse: see below;
96 * converts none to absolute none, i.e. (0, 0)
98 static void nonefy(virtaddr *va) {
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]);
111 assert(va->mark >= 0);
112 /* assert(va->mark <= M[va->addr + 1]);*/
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]);
120 if(va->mark != M[va->addr + 1]) {
123 fprintf(ff,"\t\tset to NONE\n");
129 assert(va->addr != 1);
133 * One of the actions for traverse; update the virtual address to
134 * correspond to its dictionary entry after compactification.
136 static void relocate(va) virtaddr *va; {
140 /* new ah (after compression) */
141 va->addr = M[va->addr + 1];
150 * Traverse all the virtual variables of object am and perform action
151 * on each of them. Skip references to processes (see nonefy() and
154 #ifndef NO_PROTOTYPES
155 static void traverse(word am, void (*action)(virtaddr *))
157 static void traverse(word am, void (*action)())
160 word t1, t2, t3, length;
163 /* LWA+1 of the object */
165 /* prototype number */
166 length = M[ am+PROTNUM ];
167 if (length == AINT || length == AREAL || length == AVIRT ||
170 || length == APROCESS
173 /* ARRAYOF <reference> */
175 for (t2 = am + 3; t2 < t1; t2 += 2)
176 (*action)((virtaddr *)(M+t2));
179 /* neither an array nor a file */
180 ptr = prototype[length];
181 /* compute the number of the system virtual variables */
211 /* action for system reference variables */
212 for (t2 = length; t2 >= 1; t2--)
213 (*action)((virtaddr *)(M+t1+offset[t2]));
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));
220 /* action for user reference variables */
222 for (t2 = t1 + ptr->lthreflist - 1; t2 >= t1; t2--)
223 (*action)((virtaddr *)(M + am + M[t2]));
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.
234 word t1, t2, t3, phead;
236 /* free memory before comp. */
237 nleng = thisp->lastitem - thisp->lastused - 1;
238 /* for proper update of none */
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 */
246 /* special list for appetite=2 */
250 /* flag object killed */
253 /* now other killed objects */
255 while (t1 != thisp->lower) {
260 /* flag object killed */
263 /* goto other size list */
264 t1 = M[ t1+LONGLINK ];
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).
277 nonefy(&(thisp->procref));
278 /* FWA of object area */
279 t1 = thisp->lower + 1;
280 while (t1 <= thisp->lastused) {
283 fprintf(ff, "OBJECT am=%d,SIZE=%d,TYPE=%d\n", t1, M[t1], M[t1 + 1]);
285 if (M[t1 + 1] != SKILLED)
286 traverse(t1, what_we_have);
289 /* an active object */
290 if (M[t1 + 1] != SKILLED)
291 traverse(t1, nonefy);
292 /* next object address */
298 /* garbage collection */
301 * Find x-th pointer in am.
302 * Skip references to processes.
304 static word get_pointer(word am, word x) {
305 word t1, t2, t3, length, va;
308 /* LWA+1 of the object */
310 /* prototype number */
311 length = M[am + PROTNUM];
314 fprintf(ff, "|get_pointer(am=%d,x=%d)lenght=%d|", am, x, length);
318 if (length == AINT || length == AREAL || length == AVIRT ||
321 || length == APROCESS
324 /* ARRAYOF <reference> */
325 if(length == AVIRT) {
326 for(t2 = am + 3; t2 < t1; t2 += 2) {
328 if(isprocess((virtaddr *)(M + t2)))
332 assert(M[t2 + 1] == 0);
341 fprintf(ff, "=%d|\n", t2);
350 /* neither an array nor a file */
351 ptr = prototype[length];
352 /* compute the number of the system virtual variables */
382 /* system reference variables */
383 for(t2 = length; t2 >= 1; t2--) {
384 va = t1 + offset[t2];
386 if(isprocess((virtaddr *)(M+va)))
390 assert(M[va + 1] == 0);
395 fprintf(ff,"=%d|\n",va);
403 /* temporary reference variables */
405 for(t2 = am+ptr->span; t2 < t1; t2 += 2) {
407 if(isprocess((virtaddr *)(M + t2)))
411 assert(M[t2 + 1] == 0);
416 fprintf(ff, "=%d|\n", t2);
424 /* user reference variables */
426 for(t2 = t1 + ptr->lthreflist - 1; t2 >= t1; t2--) {
429 if(isprocess((virtaddr *)(M + va)))
433 assert(M[va + 1] == 0);
438 fprintf(ff, "=%d|\n", va);
448 fprintf(ff, "=-1|\n");
455 static void heap_walk(word curr_ah) {
456 /* 1 is special value not expected in anyone virtaddr */
457 word aux, prev_ah = 1;
461 fprintf(ff, "|prev_ah=%d|\n", prev_ah);
466 word am = get_pointer(M[curr_ah], M[curr_ah + 1]);
469 if(M[M[am] +1] > 0) {
471 fprintf(ff, "Object %d->%d invited.\n",
485 fprintf(ff, "|curr_ah set to %d|\n", curr_ah);
493 fprintf(ff, "going back (prev_ah=%d)(lvl=%d)\n",
500 am = get_pointer(M[prev_ah], M[prev_ah + 1] - 1);
505 "|prev_ah set to %d,next set to %d|\n",
512 assert(prev_ah == 1);
514 /*** now all 'invited' objects have its mark >0 ***/
519 static void phase2a()
523 /*** generation number already is not needed so we reset it ***/
526 while(t1 >= thisp->lastitem) {
534 fprintf(ff, "first phase of walk |from=%d,to=%d,procah=%d|\n",
537 thisp->procref.addr);
541 heap_walk(thisp->procref.addr);
544 fprintf(ff, "second phase of walk c1_ah=%d,c1=%d\n", c1_ah, c1);
550 if(thisp->blck1 != 0)
551 heap_walk(thisp->blck1);
553 /*** Mark objects not traversed like SKILLED ***/
555 /* head of free item list */
556 t1 = thisp->freeitem;
560 /* mark not to set object SKILLED */
566 /* last dictionary item pointer */
568 while (t1 >= thisp->lastitem) {
569 /* entry not traversed - so killed */
570 if (M[t1 + 1] == 0) {
572 fprintf(ff, "MARKING dict. entry %d -> %d like SKILLED\n",t1, M[t1]);
576 M[t1 + 1] = MAXMARKER;
578 M[M[t1] + 1] = SKILLED;
579 /* mark SKILLED if not set yet */
586 * For each free dictionary item set its mark to unusable status.
592 /* head of free item list */
593 t1 = thisp->freeitem;
595 /* flag item unusable */
596 M[t1 + 1] = MAXMARKER;
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.
614 /* last dictionary item pointer */
615 t1 = thisp->upper - 1;
616 /* initialize new address */
618 while (t1 >= thisp->lastitem) {
619 /* entry killed - don't decrement t2 */
620 if (M[ t1+1 ] == MAXMARKER)
628 /* save (am) in (old ah) */
630 /* move old ah to (am) */
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.
647 word t1, t2, t3, t4, t5;
649 t2 = t1 = thisp->lower+1;
650 /* traverse object area */
651 while (t1 <= thisp->lastused) {
652 /* old ah saved by phase4 */
654 /* ignore this object */
655 if (M[t1 + 1] == SKILLED) {
657 fprintf(ff, "OBJECT am=%d,SIZE=%d,TYPE=%d\n",
658 t1, M[t1], M[t1 + 1]);
661 /* t5=appetite in this case */
665 fprintf(ff, "OBJECT am=%d,SIZE=%d,TYPE=%d\n",
666 t1, M[t1], M[t1 + 1]);
669 /* appetite saved by phase4 */
671 /* send it to the new am */
673 /* copy the object into new am */
674 for (t4 = 1; t4 < t3; t4++)
675 M[t2 + t4] = M[t1 + t4];
677 traverse(t2,what_we_have);
680 /* Update global absolute pointer to current object : */
681 /* locate am of current */
684 /* new ah of current */
687 if (t1 == M[temporary])
690 /* make (ah) looking ok */
693 /* relocate virtual variables */
694 traverse(t2, relocate);
696 fprintf(ff," --> am=%d,SIZE=%d,TYPE=%d\n",
697 t2, M[t2], M[t2 + 1]);
699 traverse(t2, what_we_have);
705 thisp->lastused = t2 - 1;
708 /* Update global absolute pointers to objects : */
710 relocate(&(thisp->procref));
714 v.addr = thisp->blck1;
717 thisp->blck1 = v.addr;
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
726 * If pointers to processes are implemented as objects we have to rebuild
727 * has table of these pointers too.
734 hash_create(thisp,thisp->hash_size);
738 /* compress dictionary */
739 for (t2 = t1 - 2; t2 >= thisp->lastitem; t2 -= 2) {
752 if( isprocess(&vt3) ){
757 obj2mess(M, &obj, &mess);
758 /* force to create item -
759 we not need it yet */
766 thisp->lastitem = t1;
768 thisp->prochead = M[thisp->procref.addr];
769 thisp->blck2 = M[thisp->blck1];
774 * System invariants are recovered, e.g. display is rebuilt to reflect the
775 * new physical addresses.
777 static void curtain()
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 */
792 /* rebuild DISPLAY */
796 fprintf(stderr, "\n(COMPACTIFIER used for process %d,"
797 "%ld words reclaimed,now %ld free)\n",
799 (long)(thisp->lastitem-thisp->lastused-1-nleng),
800 (long)(thisp->lastitem-thisp->lastused-1));
804 fprintf(ff, "(COMPACTIFIER used for process %d,"
805 "%ld words reclaimed,now %ld free)\n",
807 (long) (thisp->lastitem-thisp->lastused-1-nleng),
808 (long) (thisp->lastitem-thisp->lastused-1));
813 thisp->headk = thisp->lower;
816 /* re-decode current instruction ! */
819 if (opcode == 3 /*LRAISE*/) {
820 /* skip address after LRAISE */
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);
845 /* garbage collection */
847 /* phase3(); if only compactifier is needed uncomment this statement */
848 /* and comment statement phase2a() */
855 fprintf(ff,"----------------------------------------\n");