home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Emulator / mark_copy.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-04-14  |  24.0 KB  |  957 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. /* Copyright Herve' Touati, Aquarius Project, UC Berkeley */
  5.  
  6. #ifdef WITH_GC
  7. #include <stream.h>
  8. #include <sys/types.h>
  9. #include <sys/time.h>
  10. #include <sys/resource.h>
  11. #include "tags.h"
  12. #include "instr.h"
  13. #include "hash_table.h"
  14. #include "string_table.h"
  15. #include "scan.h"
  16. #include "inst_args.h"
  17. #include "inst_table.h"
  18. #include "memory.h"
  19. #include "basics.h"
  20. #include "top_level.h"
  21. #include "gc.h"
  22. #include "mark_copy.h"
  23.  
  24.  /* LOCAL DECLARATIONS */
  25.  
  26.  /* choice point that separates copying from marking */
  27. CellPtr BMIDDLE, HMIDDLE, B2;
  28.  
  29.  /* various stacks used during marking */
  30. static DownStack MARK_STACK;
  31. static UpStack REF_STACK;
  32. static CopyStack COPY_STACK;
  33.  
  34.  /* incremented at each GC. Just a counter */
  35. int GC_COUNTER;
  36.  
  37.  /* the mark used for marking. Equals to GC_COUNTER modulo 255 + 1 */
  38. unsigned char MARK;
  39. #ifdef WITH_VIRTUAL_BACK
  40. static unsigned char MARK2;
  41.  
  42. inline void mark2(Cell* p)
  43. { MKMIN[p - HMIN] = (marked(p)) ? MARK : MARK2; }
  44.  
  45. inline int marked2(Cell* p)
  46. { return (marked(p) || MKMIN[p - HMIN] == MARK2); }
  47.  
  48. inline int unmarked2(Cell* p)
  49. { return (unmarked(p) && MKMIN[p - HMIN] != MARK2); }
  50.  
  51. #endif
  52.  
  53.  /* ENVIRONMENTS and REGISTERS */
  54.  /* creates a new environment at the top of the stack, and saves the */
  55.  /* registers in it. Then put yet another one above it, with nothing */
  56.  /* in it. Easier to restore than adding the registers to the current */
  57.  /* environment. */
  58. static Instr dummy_instr;
  59. void store_regs_in_env()
  60. {
  61.   int arity = instr_args[ARG_PROC]->get_arity(P->arg1);
  62.   arity = (NUMBER_OF_REGISTERS < arity) ? NUMBER_OF_REGISTERS : arity;
  63.   dummy_instr.arg2 = arity;
  64.   for (int i = 0; i < arity; i++)
  65.     E[Y1_ENV_OFFSET + i] = X[i];
  66.   Cell* NewE = E + arity + E_TOP_OFFSET;
  67.   NewE[B_ENV_OFFSET] = 0; /* unused */
  68.   NewE[E_ENV_OFFSET] = cell(E);
  69.   NewE[P_ENV_OFFSET] = cell(&dummy_instr);
  70.   E = NewE;
  71. }
  72.  
  73.  /* restore the top of the stack as before the call to store_regs_in_env */
  74. void restore_top_env()
  75. {
  76.   Cell* PreviousE = cellp(E[E_ENV_OFFSET]);
  77.   int arity = instrp(E[P_ENV_OFFSET])->arg2;
  78.   E = PreviousE;
  79.   for (int i = 0; i < arity; i++)
  80.     X[i] = E[Y1_ENV_OFFSET + i];
  81. }
  82.  
  83.  /* if does not point directly to new space, either it dereferences to */
  84.  /* a pointer to new space that belongs to some living environment, */
  85.  /* that will be traced later on, or to some old environment, which */
  86.  /* modification would then have been trailed. Therefore, there is no */
  87.  /* need to dereference */
  88. void Env::mark()
  89. {
  90. #ifdef WITH_VIRTUAL_BACK
  91.   Cell* y = e + Y1_ENV_OFFSET + already_treated;
  92.   Cell* y0 = e + Y1_ENV_OFFSET + size;
  93.   for (; y < y0; y++) {
  94.     Cell* ptr = y;
  95.     Cell val = *ptr;
  96.     while (get_tag(val) == TAGREF && addr(val) >= E2 && addr(val) != ptr) {
  97.       ptr = addr(val);
  98.       val = *ptr;
  99.     }
  100.     if (get_tag(val) == TAGCONST) continue;
  101.     if (to_new_space(addr(val)))
  102.       mark_from_base(ptr);
  103.   }
  104. #else
  105.   Cell* y = e + Y1_ENV_OFFSET + already_treated;
  106.   Cell* y0 = e + Y1_ENV_OFFSET + size;
  107.   for (; y < y0; y++) {
  108.     if (get_tag(*y) == TAGCONST) continue;
  109.     if (to_new_space(addr(*y)))
  110.     mark_from_base(y);
  111.   }
  112. #endif
  113. }
  114.  
  115. void Env::update()
  116. {
  117.   Cell* y = e + Y1_ENV_OFFSET + already_treated;
  118.   Cell* y0 = e + Y1_ENV_OFFSET + size;
  119.   for (; y < y0; y++)
  120.     *y = check_and_relocate(*y);
  121. }
  122.  
  123.  /* CHOICE POINTS */
  124.  
  125. ChoiceRecord SAVED_CP;
  126.  
  127.  /* if less than a threshold, use mark_compact instead */
  128. const float COPY_THRESHOLD = 0.2;
  129.  
  130. int deterministic()
  131. {
  132.   return (cellp(B[H_CP_OFFSET]) <= HMIN);
  133. }
  134.  
  135. int enough_to_copy()
  136. {
  137.   Cell* H_THRESHOLD = &HMIN[(int) ((float) (H-HMIN)*COPY_THRESHOLD)];
  138.   Cell* b = B;
  139.   while (cellp(b[H_CP_OFFSET]) > H_THRESHOLD)
  140.     b += FIXED_CP_SIZE + b[SIZE_CP_OFFSET];
  141.   return (cellp(b[H_CP_OFFSET]) <= HMIN);
  142. }
  143.  
  144.  /* creates a choice point at the top that is above everything else. */
  145.  /* It is easier to code gctrail that way: don't have to worry about */
  146.  /* boundary conditions any more.  */
  147. void setup_cps_pass1()
  148. {
  149.  /* creates a topmost choice point */
  150.   B -= FIXED_CP_SIZE;
  151.   B[E_CP_OFFSET] = cell(E);
  152.   B[H_CP_OFFSET] = cell(H);
  153.   B[TR_CP_OFFSET] = cell(TR);
  154.   B[P_CP_OFFSET] = 0; /* unused */
  155.   B[SIZE_CP_OFFSET] = 0;
  156.  
  157.  /* find BMIDDLE and B2 */
  158.   BMIDDLE = B;
  159.   Cell* b = B;
  160.   while (cellp(b[H_CP_OFFSET]) > HMIN) {
  161.     BMIDDLE = b;
  162.     b += FIXED_CP_SIZE + b[SIZE_CP_OFFSET];
  163.   }
  164.   B2 = b;
  165.  
  166.  /* treat the case of the cps under B2 such that B.h == HMIN now */
  167.   while (cellp(b[H_CP_OFFSET]) == HMIN) {
  168.     b[H_CP_OFFSET] = cell(H2);
  169.     b += FIXED_CP_SIZE + b[SIZE_CP_OFFSET];
  170.   }
  171.  
  172.  /* set B2 to be above TR2 as well; save previous contents */
  173.   SAVED_CP.tr = cellp(B2[TR_CP_OFFSET]);
  174.   SAVED_CP.e = cellp(B2[E_CP_OFFSET]);
  175.   SAVED_CP.h = cellp(B2[H_CP_OFFSET]);
  176.   TR2 = min(TR2, SAVED_CP.tr);
  177.   E2 = max(E2, SAVED_CP.e);
  178.   B2[TR_CP_OFFSET] = cell(TR2);
  179.   B2[E_CP_OFFSET] = cell(E2);
  180.   B2[H_CP_OFFSET] = cell(HMIN);
  181.  
  182.  /* cache the H entry of BMIDDLE in a global variable */
  183.   HMIDDLE = cellp(BMIDDLE[H_CP_OFFSET]);
  184. }
  185.  
  186. void setup_cps_pass2()
  187. {
  188.  /* restore B2 to its initial contents */
  189.   B2[TR_CP_OFFSET] = cell(SAVED_CP.tr);
  190.   B2[E_CP_OFFSET] = cell(SAVED_CP.e);
  191.   B2[H_CP_OFFSET] = cell(SAVED_CP.h);
  192.  
  193.  /* take BMIDDLE as B2: copied stuff appears as old form now on */
  194.   B2 = BMIDDLE;
  195.   H2 = COPY_STACK.top();
  196.   B2[H_CP_OFFSET] = cell(H2);
  197.  
  198.  /* set B2 to be above TR2 as well; save previous contents */
  199.   SAVED_CP.tr = cellp(B2[TR_CP_OFFSET]);
  200.   SAVED_CP.e = cellp(B2[E_CP_OFFSET]);
  201.   TR2 = min(TR2, SAVED_CP.tr);
  202.   E2 = max(E2, SAVED_CP.e);
  203.   B2[TR_CP_OFFSET] = cell(TR2);
  204.   B2[E_CP_OFFSET] = cell(E2);
  205. }
  206.  
  207. void restore_cps()
  208. {
  209.  /* restore B2 to its initial contents */
  210.   B2[TR_CP_OFFSET] = cell(SAVED_CP.tr);
  211.   B2[E_CP_OFFSET] = cell(SAVED_CP.e);
  212.  
  213.  /* relocate the H entries to their correct, final position */
  214.   Cell* b = B;
  215.   while (b < B2) {
  216.     b[H_CP_OFFSET] = cell(reloc_addr(cellp(b[H_CP_OFFSET])));
  217.     b += FIXED_CP_SIZE + b[SIZE_CP_OFFSET];
  218.   }
  219.  
  220.  /* compute the new values of H, H2, TR, TR2, E2 */
  221.   H = HMIN;
  222.   H2 = cellp(B[H_CP_OFFSET]);
  223.   TR = TR2 = cellp(B[TR_CP_OFFSET]);
  224.   E2 = E;
  225.  
  226.  /* remove the dummy topmost choice point */
  227.   B += FIXED_CP_SIZE;
  228. }
  229.  
  230.  /* hard to get all the benefit from this. The main problem is that we */
  231.  /* cannot mark env variables as easily. Since this is applied only */
  232.  /* after gctrail and gcenv, if an env variable is found to be */
  233.  /* pointing to a location that is unmarked2 in new space, we know we */
  234.  /* can reset it. We could extend that by dereferencing the var. If */
  235.  /* the first entry to new space is not marked, we can reset the var */
  236. void Choice::virtual_backtrack()
  237. {
  238. #ifdef WITH_VIRTUAL_BACK
  239.   Cell* var0 = tr;
  240.   Cell* var = cellp(b[TR_CP_OFFSET]);
  241.   tr = var;
  242.   for (; var > var0; var--) {
  243.     Cell* ptr = addr(*var);
  244.     if (ptr >= E0) {
  245.       Cell val = *ptr;
  246.       while (get_tag(val) == TAGREF && addr(val) >= E0 && addr(val) != ptr) {
  247.     ptr = addr(val);
  248.     val = *ptr;
  249.       }
  250.       if (pointer_to_new(*ptr) && unmarked2(addr(*ptr)))
  251.     *addr(*var) = *var;
  252.     } else if (ptr >= HMIN) {
  253.       if (unmarked2(ptr)) 
  254.     *ptr = *var;
  255.     }
  256.   }
  257. #endif
  258. }
  259.  
  260.  /* This stack exactly simulates what would happen on backtracking */
  261.  /* supposing we encounter an infinite sequence of fails. This is */
  262.  /* really virtual backtracking! The problem is really the difference */
  263.  /* in sizes of the environments, depending on the point of view! That */
  264.  /* is the only reason why we need a stack (or marking bits). Stacks */
  265.  /* are preferable in general because they are faster and cleaner. */
  266.  /* the cost is on choice points only */
  267.  
  268. Choice::Choice(Cell* E, Cell* B)
  269. {
  270.   b = B;
  271.   tr = cellp(B[TR_CP_OFFSET]);
  272.   preserved.init(cellp(b[E_CP_OFFSET]));
  273.   already_done.init(E);
  274. }
  275.  
  276. void Choice::mark()
  277. {
  278. #ifdef WITH_VIRTUAL_BACK
  279.   virtual_backtrack();
  280.   Cell* x = b + X1_CP_OFFSET;
  281.   Cell* x0 = x + b[SIZE_CP_OFFSET];
  282.   for (; x < x0; x++) {
  283.     Cell* ptr = x;
  284.     Cell val = *ptr;
  285.     while (get_tag(val) == TAGREF && addr(val) >= E2 && addr(val) != ptr) {
  286.       ptr = addr(val);
  287.       val = *ptr;
  288.     }
  289.     if (get_tag(val) == TAGCONST) continue;
  290.     if (to_new_space(addr(val)))
  291.     mark_from_base(ptr);
  292.   }
  293. #else
  294.   Cell* x = b + X1_CP_OFFSET;
  295.   Cell* x0 = x + b[SIZE_CP_OFFSET];
  296.   for (; x < x0; x++) {
  297.     if (get_tag(*x) == TAGCONST) continue;
  298.     if (to_new_space(addr(*x)))
  299.       mark_from_base(x);
  300.   }
  301. #endif
  302. }
  303.  
  304. #define use(ACTION,PROC_NAME)\
  305. void Choice::PROC_NAME()\
  306. {\
  307.   while (already_done.e > preserved.e)\
  308.     already_done.next();\
  309.   Env e_limit = already_done;\
  310.   already_done = preserved;\
  311.   while (preserved.e >= E2) {\
  312.     if (preserved.e > e_limit.e) {\
  313.       preserved.ACTION();\
  314.       preserved.next();\
  315.     } else if (preserved.e == e_limit.e) {\
  316.       preserved.treated(e_limit.size);\
  317.       preserved.ACTION();\
  318.       break;\
  319.     } else {\
  320.       top_level_error("Inconsistent Path thru Env Stack");\
  321.     }\
  322.   }\
  323. }
  324. use(mark,mark_preserved_envs)
  325. use(mark_sweep,mark_preserved_envs_sweep)
  326. use(update,update_preserved_envs)
  327. #undef use
  328.  
  329. void Choice::update()
  330. {
  331.   Cell* x = b + X1_CP_OFFSET;
  332.   Cell* x0 = x + b[SIZE_CP_OFFSET];
  333.   for (; x < x0; x++)
  334.     *x = check_and_relocate(*x);
  335. }
  336.  
  337.  /* rotates the size fields of the choice points [B2,B] down, putting */
  338.  /* the one for B2 in B[SIZE_CP_OFFSET] */
  339. void cp_to_cp_forward()
  340. {
  341.   int b2_size = B2[SIZE_CP_OFFSET];
  342.   Cell* b = B;
  343.   int size = b[SIZE_CP_OFFSET];
  344.   while (b < B2) {
  345.     b += FIXED_CP_SIZE + size;
  346.     int temp = size;
  347.     size = b[SIZE_CP_OFFSET];
  348.     b[SIZE_CP_OFFSET] = temp;
  349.   }
  350.   B[SIZE_CP_OFFSET] = b2_size;
  351. }
  352.   
  353.  /* do the opposite. composing those two should be a noop */
  354. void cp_to_cp_backward()
  355. {
  356.   int b_size = B[SIZE_CP_OFFSET];
  357.   Cell* b = B2;
  358.   int size = b[SIZE_CP_OFFSET];
  359.   while (b > B) {
  360.     b -= FIXED_CP_SIZE + size;
  361.     int temp = size;
  362.     size = b[SIZE_CP_OFFSET];
  363.     b[SIZE_CP_OFFSET] = temp;
  364.   }
  365.   B2[SIZE_CP_OFFSET] = b_size;
  366. }
  367.   
  368.  /* THE TRAIL STACK */
  369.  
  370. /* OLD VERSION
  371. void gctrail_pass1()
  372. {
  373.   TrailCP cp(B2, B);
  374.   register Cell* tr0 = cp.tr;
  375.   register Cell* tr = cp.tr;
  376.   register Cell* copy_tr = cp.tr;
  377.   while (cp.nonempty()) {
  378.     tr = tr0;
  379.     tr0 = cp.next_tr;
  380.     for (; tr > tr0; tr--) {
  381.       register Cell* ptr = addr(*tr);
  382.       switch (cp.pass1_action(ptr)) {
  383.       case TRAIL_MARK:
  384.     mark_from_base(ptr);
  385.     *copy_tr-- = *tr;
  386.     break;
  387.       case TRAIL_KEEP:
  388.     *copy_tr-- = *tr;
  389.     break;
  390.       case TRAIL_SKIP:
  391.     break;
  392.       }
  393.     }
  394.     cp.update_tr(copy_tr);
  395.     cp.next();
  396.   }
  397. }
  398. */
  399.  
  400.  /* takes advantage of the fact that the tag bit is in the lower bits */
  401. void gctrail_pass11()
  402. {
  403.   TrailCP cp(B2, B);
  404.   register Cell* tr0 = cp.tr;
  405.   register Cell* tr = cp.tr;
  406.   register Cell* copy_tr = cp.tr;
  407.   while (cp.nonempty()) {
  408.     tr = tr0;
  409.     tr0 = cp.next_tr;
  410.     Cell* e = cp.e;
  411.     Cell* h = cp.h;
  412.     for (; tr > tr0; tr--) {
  413.       if (cellp(*tr) < h || (cellp(*tr) < e && cellp(*tr) >= E0))
  414.     *copy_tr-- = *tr;
  415.     }
  416.     cp.update_tr(copy_tr);
  417.     cp.next();
  418.   }
  419. }
  420.  
  421. void gctrail_pass12()
  422. {
  423.   register Cell* tr0 = cellp(B[TR_CP_OFFSET]);
  424.   register Cell* tr = cellp(B2[TR_CP_OFFSET]);
  425.   for (; tr > tr0; tr--) {
  426.     register Cell* ptr = addr(*tr);
  427.     if (ptr >= E2 || (ptr < E0 && ptr >= HMIN))
  428.       continue;
  429.     if (pointer_to_new(*ptr))
  430.       mark_from_base(ptr);
  431.   }
  432. }
  433.  
  434. void gctrail_pass1()
  435. {
  436.   gctrail_pass11();
  437.   gctrail_pass12();
  438. }
  439.  
  440.  /* B2 has been set to BMIDDLE meanwhile; only look at the top part of */
  441.  /* the trail above BMIDDLE now. */
  442.  /* Also, there is the special case of trail entries pointing to the */
  443.  /* part that has been copied. Some of those need relocation */
  444. void gctrail_pass2()
  445. {
  446.   TrailCP cp(B2, B);
  447.   Cell* tr0 = cp.tr;
  448.   Cell* tr = cp.tr;
  449.   Cell* copy_tr = cp.tr;
  450.   while (cp.nonempty()) {
  451.     tr = tr0;
  452.     tr0 = cp.next_tr;
  453.     for (; tr > tr0; --tr) {
  454.       Cell* ptr = addr(*tr);
  455.       switch (cp.pass2_action(ptr)) {
  456.       case TRAIL_SKIP:
  457.     break;
  458.       case TRAIL_RELOC:
  459.     *copy_tr-- = relocate(TAGREF, ptr);
  460.     break;
  461.       case TRAIL_COPY_RELOC:
  462.     *copy_tr-- = relocate(TAGREF, ptr);
  463.     ptr = reloc_addr(ptr);
  464.     *ptr = check_and_relocate(*ptr);
  465.     break;
  466.       case TRAIL_IND_RELOC:
  467.     *ptr = check_and_relocate(*ptr);
  468.     *copy_tr-- = *tr;
  469.     break;
  470.       }
  471.     }
  472.     cp.update_tr(copy_tr);
  473.     cp.next();
  474.   }
  475. }
  476.  
  477.  /* control stacks */
  478.  
  479.  /* we do the traversal of the environment stack and the choice point */
  480.  /* stack together. that way we can avoid having to traverse the */
  481.  /* records twice, and we do not have to use marking nor any extra */
  482.  /* space: just two extra structures. */
  483.  /* will be quite easy to add virtual backtracking inside this routine */
  484.  /* it works as follows: first visit all envs above the topmost choice */
  485.  /* point. then visit all envs that are above the next living env. two */
  486.  /* loops alternating, one visiting next living envs, one visiting the */
  487.  /* next preserved envs. if a given env is shared, its living part is */
  488.  /* first entirely marked, then we wait until the last choice point */
  489.  /* that preserved that env and mark the part that is preserved. */ 
  490.  /* the update is simple macro substitution from the mark */
  491.  
  492. #define use(ACTION,PRESERVED_ACTION,PROC_NAME)\
  493. void PROC_NAME()\
  494. {\
  495.  /* first, take care of living cells */\
  496.   Env env(E);\
  497.   for (;;) {\
  498.     if (env.e <= E2) {\
  499.       if (env.e == E2)\
  500.     env.ACTION();\
  501.       break;\
  502.     }\
  503.     env.ACTION();\
  504.     env.next();\
  505.   }\
  506.  /* now, take care of preserved cells */\
  507.   Choice cp(E, B);\
  508.   for (;;) {\
  509.     if (cp.last()) break;\
  510.     cp.ACTION();\
  511.     cp.PRESERVED_ACTION();\
  512.     cp.next();\
  513.   }\
  514. }
  515. use(mark,mark_preserved_envs,gccontrol_pass1)
  516. use(update,update_preserved_envs,gccontrol_pass2)
  517. #undef use
  518.  
  519.  /* new space itself: compaction phase */
  520.  
  521.  /* not too hard. just go thru new area and the marking area in */
  522.  /* parallel. each time i encounter something marked, copy it down */
  523.  /* in copy space. leave behind in each location the relocation */
  524.  /* address (untagged). */
  525.  /* needs a second scan to compute the final addresses. proportional */
  526.  /* to m+n in total */
  527.  /* Also, for being able to restore global stack pointers uniformly, */
  528.  /* we add one entry at the top to relocate the topmost choice point */
  529.  /* entry correctly */
  530.  /* This is also the place to gather statistics about the efficiency */
  531.  /* of the garbage collector */
  532. static Cell* H2_copy_value;
  533. static Cell* H_copy_value;
  534. void global_sweep()
  535. {
  536.   register Cell* p = HMIDDLE; /* from lowest cp segment */
  537.   register Cell* p0 = H;
  538.   register unsigned char* m = &MKMIN[HMIDDLE - HMIN];
  539.   register Cell* h = H2;
  540.   H_copy_value = HMIDDLE;
  541.  
  542.  /* sweep pass. Should always write relocation addresses */
  543.   for (; p < p0; p++, m++) {
  544.     if (*m == MARK) {
  545.       *h = *p;
  546.       *p = cell(h);
  547.       h++;
  548.     } else {
  549.       *p = cell(h);
  550.     }
  551.   }
  552.  
  553.  /* relocation info for the topmost choice point */
  554.   *p = cell(h);
  555.  
  556.  /* relocate pointers to new space */
  557.   p = H2_copy_value = H2;
  558.   H2 = p0 = h;
  559.   for (; p < p0; p++) {
  560.     if (pointer_to_new(*p))
  561.       *p = relocate(*p);
  562.   }
  563. }
  564.  
  565.  /* the REF stack: delayed copying of variables in copy space */
  566.  /* objects in the stack should be pointers to locations containing ref */
  567.  /* pointers to cp_down */
  568.  /* if virtual backtracking, we cannot guarantee visiting only once */
  569. void gcref_pass1()
  570. {
  571.   while (REF_STACK.nonempty()) {
  572.     Cell* var = REF_STACK.pop();
  573.     Cell* ptr = addr(*var);
  574. #ifdef WITH_VIRTUAL_BACK
  575.     if (! to_new_space(ptr)) continue;
  576. #endif
  577.     if (unmarked(ptr)) {
  578.       mark(ptr);
  579.       Cell val = *ptr;
  580.       set_reloc_addr(ptr, COPY_STACK.top());
  581.       COPY_STACK.push(val);
  582.       if (get_tag(val) == TAGREF && addr(val) >= HMIN)
  583.     REF_STACK.push(reloc_addr(ptr));
  584.     } 
  585.     *var = make_ptr(TAGREF, reloc_addr(ptr));
  586.   }
  587. }
  588.  
  589.  /* marking */
  590.  
  591.  /* we pass a pointer to the cell containing the pointer to the object */
  592.  /* to mark. not necessary for marking, but necessary for copying. */
  593.  /* we use the space at the top of the choice point stack (between */
  594.  /* choice point stack and the environment stack) as the marking stack. */
  595.  /* we need to initialize the marking area at each gc. here, since we */
  596.  /* use one byte per mark, we can rotate the mark, and reduce the cost */
  597.  /* of initialization by 255. */
  598.  
  599.  /* when copying, don't mark ref pointers nor what they point to. we */
  600.  /* will do it later. also trail pointers from copy area to new area */
  601.  /* to speed up relocation. */
  602.  
  603.  /* suppose p is a global stack pointer; can't point to env stack */
  604.  /* should be recoded to use a table lookup instead of all those tests */
  605.  
  606. /* OLD VERSION
  607. inline int copy_or_mark(Cell* p)
  608. {
  609.   if (p < HMIN)
  610.     return SHOULD_NEITHER;
  611.   else if (p < HMIDDLE)
  612.     return (marked(p)) ? SHOULD_RELOC : SHOULD_COPY;
  613.   else
  614.     return (marked(p)) ? SHOULD_CHECK_MARK : SHOULD_MARK;
  615. }
  616. */
  617.  
  618. int copy_or_mark_table[2][2] = {
  619.   {SHOULD_MARK, SHOULD_CHECK_MARK},
  620.   {SHOULD_COPY, SHOULD_RELOC}
  621. };
  622.  
  623. inline int copy_or_mark(Cell* p)
  624. {
  625.   if (p >= HMIN)
  626.     return copy_or_mark_table[(p < HMIDDLE)][marked(p)];
  627.   else 
  628.     return SHOULD_NEITHER;
  629. }
  630.  
  631.  /* In the copy part, a list or a structure is marked iff any of its */
  632.  /* elements is.  */
  633. void mark_from_base(Cell* p)
  634. {
  635.   MARK_STACK.init(B);
  636.   MARK_STACK.push(p);
  637.   for (;;) {
  638.     Cell* var;
  639.     if (COPY_STACK.nonempty())
  640.       var = COPY_STACK.pop();
  641.     else if (MARK_STACK.nonempty())
  642.       var = MARK_STACK.pop();
  643.     else
  644.       break;
  645.  
  646.     switch (get_tag(*var)) {
  647.     case TAGCONST:
  648.       break;
  649.     case TAGREF: 
  650.       {
  651.     Cell* ptr = addr(*var);
  652.     switch (copy_or_mark(ptr)) {
  653.     case SHOULD_MARK:
  654.       mark(ptr);
  655.       MARK_STACK.push(ptr);
  656.       break;
  657.     case SHOULD_RELOC:    /* ptr to marked copied location */
  658.       *var = make_ptr(TAGREF, reloc_addr(ptr));
  659.       break;
  660.     case SHOULD_COPY:
  661.       REF_STACK.push(var);
  662.       for (;; var = ptr, ptr = addr(*ptr)) {
  663.         /* here, ptr is always a pointer to low cp segment */
  664. #ifdef WITH_VIRTUAL_BACK
  665.         if (get_tag(*ptr) != TAGREF) {
  666.           MARK_STACK.push(ptr);
  667.           mark2(ptr);
  668.           break;
  669.         }
  670.         if (ptr < HMIN || *var == *ptr || marked2(ptr))
  671.           break;
  672.         mark2(ptr);
  673. #else
  674.         if (get_tag(*ptr) != TAGREF) {
  675.           MARK_STACK.push(ptr);
  676.           break;
  677.         }
  678.         if (ptr < HMIN || marked(ptr) || *var == *ptr) 
  679.           break;
  680. #endif
  681.       }
  682.       break;
  683.     case SHOULD_CHECK_MARK:
  684.     case SHOULD_NEITHER:
  685.       break;
  686.     }
  687.       }
  688.       break;
  689.     case TAGLIST:
  690.       {
  691.     Cell* list = addr(*var);
  692.     switch (copy_or_mark(list)) {
  693.     case SHOULD_CHECK_MARK:    /* marked(car) && unmarked(cdr) */
  694.       if (unmarked(list + 1)) {
  695.         mark(list + 1);
  696.         MARK_STACK.push(list + 1);
  697.       }
  698.       break;
  699.     case SHOULD_MARK:
  700.       for (int i = 0; i < 2; i++) {
  701.         mark(list + i);
  702.         MARK_STACK.push(list + i);
  703.       }
  704.       break;
  705.     case SHOULD_COPY:
  706.       *var = make_ptr(TAGLIST, COPY_STACK.top());
  707.       for (i = 0; i < 2; i++) {
  708.         mark(list + i);
  709.         Cell* dest = COPY_STACK.top();
  710.         COPY_STACK.push(list[i]);
  711.         set_reloc_addr(list + i, dest);
  712.       }
  713.       break;
  714.     case SHOULD_RELOC:
  715.       *var = make_ptr(TAGLIST, reloc_addr(list));
  716.       break;
  717.     case SHOULD_NEITHER:
  718.       break;
  719.     }
  720.       }
  721.       break;
  722.     case TAGSTRUCT:
  723.       {
  724.     Cell* str = addr(*var);
  725.     switch (copy_or_mark(str)) {
  726.     case SHOULD_MARK:
  727.       int i0 = get_int(str[1]) + 2;
  728.       for (int i = 0; i < 2; i++)
  729.         mark(str + i);
  730.       for (i = 2; i < i0; i++) {
  731.         mark(str + i);
  732.         MARK_STACK.push(str + i);
  733.       }
  734.       break;
  735.     case SHOULD_COPY:
  736.       *var = make_ptr(TAGSTRUCT, COPY_STACK.top());
  737.       i0 = get_int(str[1]) + 2;
  738.       for (i = 0; i < i0; i++) {
  739.         mark(str + i);
  740.         Cell* dest = COPY_STACK.top();
  741.         COPY_STACK.push(str[i]);
  742.         set_reloc_addr(str + i, dest);
  743.       }
  744.       break;
  745.     case SHOULD_RELOC:
  746.       *var = make_ptr(TAGSTRUCT, reloc_addr(str));
  747.       break;
  748.     case SHOULD_CHECK_MARK:
  749.     case SHOULD_NEITHER:
  750.       break;
  751.     }
  752.       }
  753.       break;
  754.     }
  755.   }
  756. }
  757.  
  758.  /* should allocate a fixed size region, just under new area. Needs */
  759.  /* only be initialized once with 0s. For the rest, We can just flip */
  760.  /* and use a global variable, say MARK. MARK is initialized to the */
  761.  /* current gc number modulo 255. When it overflows, the area is */
  762.  /* cleared again. During marking, only MARK is written in the byte */
  763.  /* corresponding to the word to be written. To be marked just means */
  764.  /* that this mark is being written. Only called when MARK is null */
  765.  
  766. void init_marking_table()
  767. {
  768. #ifdef WITH_VIRTUAL_BACK
  769.   if (MARK != 2) return;
  770. #else
  771.   if (MARK != 1) return;
  772. #endif
  773.   register int* p = (int*) MKMIN;
  774.   register int* p0 = HMIN;
  775.   while (p < p0)
  776.     *p++ = 0;
  777. }
  778.  
  779.  /* basic initializations */
  780.  
  781. void gc_init()
  782. {
  783. #ifdef WITH_VIRTUAL_BACK
  784.   MARK = 2 * ((GC_COUNTER % 127) + 1); /* values from 2 to 254 */
  785.   MARK2 = MARK + 1;                    /* values from 3 to 255 */
  786. #else
  787.   MARK = (GC_COUNTER % 255) + 1;       /* values from 1 to 255 */
  788. #endif
  789.   GC_COUNTER++;
  790.   REF_STACK.init(E);
  791.   COPY_STACK.init(H2);
  792. }
  793.  
  794.  /* some basic data: mark(scan,recovered), copy(scan,recovered), cputime */
  795.  /* the data are given in number of cells, milliseconds. */
  796. struct rusage gc_rusage;
  797. Cell* H2_entry_value;
  798. Cell* H_entry_value;
  799. Cell* TR_entry_value;
  800. Cell* TR2_entry_value;
  801. void init_stats()
  802. {
  803.   getrusage(RUSAGE_SELF, &gc_rusage);
  804.   H2_entry_value = H2;
  805.   H_entry_value = H;
  806.   TR_entry_value = TR;
  807.   TR2_entry_value = TR2;
  808. }
  809.  
  810. void display_stat1(char* legend, int before, int after)
  811. {
  812.   float percent = (before) ? ((float) after/before) * 100 : 0;
  813.   printf("%s(%d,%d,%2.1f),", legend, before, after, percent);
  814. }
  815.  
  816. void display_stat2(char* legend, int tb, int cb, int ta, int ca)
  817. {
  818.   float percentb = (tb) ? ((float) cb/tb) * 100 : 0;
  819.   float percenta = (ta) ? ((float) ca/ta) * 100 : 0;
  820.   printf("%s(%2.1f,%2.1f),", legend, percentb, percenta);
  821. }
  822.  
  823. int gc_scanned;
  824. int gc_copy_scanned;
  825. int gc_survivors;
  826. int tr_scanned;
  827. int tr_survivors;
  828. float gc_time;
  829.  
  830. void compute_stats()
  831. {
  832.   struct timeval from = gc_rusage.ru_utime;
  833.   getrusage(RUSAGE_SELF, &gc_rusage);
  834.   struct timeval to = gc_rusage.ru_utime;
  835.   float mstime = (float) to.tv_usec / 1000000 + to.tv_sec;
  836.   mstime -= (float) from.tv_usec / 1000000 + from.tv_sec;
  837.   gc_time += mstime;
  838.   if (DISPLAY_GC)
  839.     printf("time(%.3f)).\n", mstime);
  840.   if (trace_heap_flag)
  841.     heap_usage.gc_enter(H_entry_value, H2_entry_value);
  842. }
  843.  
  844. void mark_copy_stats()
  845. {
  846.   gc_scanned += H_entry_value - HMIN;
  847.   gc_copy_scanned += H_copy_value - HMIN;
  848.   gc_survivors += H2 - H2_entry_value;
  849.   tr_scanned += TR2_entry_value - TR_entry_value;
  850.   tr_survivors += TR2_entry_value - TR;
  851.   if (DISPLAY_GC) {
  852.     cout << "gc(";
  853.     display_stat1("global", H_entry_value - HMIN, H2 - H2_entry_value);
  854.     display_stat2("copy", 
  855.           H_entry_value - HMIN, H_copy_value - HMIN,
  856.           H2 - H2_entry_value, H2_copy_value - H2_entry_value);
  857.     display_stat1("tr", TR2_entry_value-TR_entry_value, TR2_entry_value-TR);
  858.   }
  859. }
  860.  
  861.  /* top level */
  862.  /* assumes that GC_DOES_COPY. Should also work if everything is above */
  863.  /* the topmost choice point, though slower than the special purpose */
  864.  /* fast_copy garbage collector */
  865.  
  866. int DISPLAY_GC;
  867.  
  868. void mark_copy()
  869. {
  870.   init_stats();
  871.   store_regs_in_env();
  872.   setup_cps_pass1();
  873.   gc_init();
  874.   init_marking_table();
  875.   cp_to_cp_forward();
  876.   gctrail_pass1();
  877.   cp_to_cp_backward();
  878.   gccontrol_pass1();
  879.   gcref_pass1();
  880.   setup_cps_pass2();
  881.   global_sweep();
  882.   gccontrol_pass2();
  883.   cp_to_cp_forward();
  884.   gctrail_pass2();
  885.   cp_to_cp_backward();
  886.   restore_top_env();
  887.   restore_cps();
  888.   mark_copy_stats();
  889.   compute_stats();
  890. }
  891.  
  892. int WHICH_GC = MARK_COPY;
  893. int CHECK_GC_LIMIT;
  894. int GC_COUNT_LIMIT;
  895.  
  896.  /* we optimize the mark_copy case. Clearly, if there is nothing to */
  897.  /* copy, we should rather use mark_compact. It is faster! Around 7% */
  898.  /* faster in the case of gccomp. */
  899. void garbage_collector()
  900. {
  901.   if (CHECK_GC_LIMIT && GC_COUNTER >= GC_COUNT_LIMIT) {
  902.     cerr << "GC Limit passed\n";
  903.   }
  904.   switch (WHICH_GC) {
  905.   case MARK_COPY:
  906.     mark_copy();
  907.     break;
  908.   case MARK_COPY_FAST_COPY:
  909.     if (deterministic())
  910.       fast_copy();
  911.     else
  912.       mark_copy();
  913.     break;
  914.   case MARK_THRESHOLD:
  915.     if (enough_to_copy())
  916.       mark_copy();
  917.     else
  918.       mark_compact();
  919.     break;
  920.   case MARK_COMPACT:
  921.     mark_compact();
  922.     break;
  923.   case MARK_COMPACT_FAST_COPY:
  924.     if (deterministic())
  925.       fast_copy();
  926.     else
  927.       mark_compact();
  928.     break;
  929.   default:
  930.     top_level_error("Select GC algorithm first\n");
  931.     break;
  932.   }
  933.   if (TR - H2 <= HMAXHARD - HMIN) {
  934.     top_level_error("Global Stack Overflow\n");
  935.   }
  936. }
  937.  
  938. void find_pointer(Cell val)
  939. {
  940.   Cell* p;
  941.   Cell* p0;
  942.  
  943. #define use(FROM,TO,NAME)\
  944.   for (p = FROM, p0 = TO; p < p0; p++) {\
  945.     if (*p == val)\
  946.       cerr << NAME << "[" << (p - FROM) << "]\n";\
  947.   }
  948. use(H0,H2,"H0")
  949. use(HMIN,HMAXSOFT,"HMIN")
  950. use(E0,E,"E0")
  951. use(B,B0,"B")
  952. use(TR,TR0,"TR")
  953. #undef use
  954. }
  955.  
  956. #endif
  957.