1/* Cooperates with the GC to prune a Scheme_Prefix's variables
2   in the case that the prefix is accessible only via closures
3   and not all of the variables are used by the closures. This
4   special handling is a kind of dependent reference, where the
5   prefix itself is not marked, and then a clean-up hook ---
6   mark_pruned_prefixes() in "eval.c" --- NULLs out unused
7   fields before finally marking the prefix. If the prefix
8   is ever marked through some other reference, then
9   mark_pruned_prefixes() doesn't actually prune.
10   To support incremental collection, we rely on the fact that
11   and old-generation closure cannot point to a new-generation
12   prefix; the prefix is always allocated before the closure. */
13  if (data && (gc_mode != GC_CURRENT_MODE_BACKPOINTER_REMARK)) {
14    /* GLOBAL ASSUMPTION: prefix is at the end of a closure */
15    Scheme_Prefix *pf = (Scheme_Prefix *)c->vals[closure_size - 1];
16
17    if (pf) {
18      int *use_bits;
19      uintptr_t map;
20
21      /* pf might have been marked via fields: */
22      pf = (Scheme_Prefix *)GC_resolve2(pf, gc);
23      use_bits = PREFIX_TO_USE_BITS(pf);
24
25      if (!pf->next_final) {
26        /* We're the first to look at this prefix... */
27        /* Add it to the chain of prefixes to finish after
28           all other marking: */
29        if ((gc_mode == GC_CURRENT_MODE_INCREMENTAL)
30            || (gc_mode == GC_CURRENT_MODE_INCREMENTAL_FINAL)) {
31          pf->next_final = scheme_inc_prefix_finalize;
32          scheme_inc_prefix_finalize = pf;
33        } else {
34          pf->next_final = scheme_prefix_finalize;
35          scheme_prefix_finalize = pf;
36        }
37#ifdef MZ_GC_BACKTRACE
38        pf->backpointer = (Scheme_Object *)c;
39#endif
40      }
41
42      /* Add this closure to the chain to be repaired when the
43         prefix is marked and potentially moved; if we're here
44         in incremental mode, though, the prefix won't be moved: */
45      if (gc_mode != GC_CURRENT_MODE_INCREMENTAL) {
46        c->vals[closure_size - 1] = pf->fixup_chain;
47        pf->fixup_chain = (Scheme_Object *)c;
48      } else {
49        /* Mark the prefix as reached in incremental mode, which
50           triggers special handling for backpointers */
51        SCHEME_PREFIX_FLAGS(pf) |= 0x1;
52      }
53
54      /* Mark just the elements of the prefix that are (newly) used: */
55      if ((uintptr_t)data->tl_map & 0x1) {
56        map = (((uintptr_t)data->tl_map) >> 1) & 0x7FFFFFFF;
57        if ((use_bits[0] & map) != map) {
58          for (i = 0; i < 31; i++) {
59            if (map & ((unsigned int)1 << i)) {
60              if (!(use_bits[0] & ((unsigned int)1 << i))) {
61                gcMARK2(pf->a[i], gc); /* top level */
62              }
63            }
64          }
65          use_bits[0] |= map;
66        }
67      } else {
68        int *u = (int *)GC_resolve2(data->tl_map, gc), j, pos;
69
70        for (i = u[0]; i--; ) {
71          map = u[i+1];
72          if ((use_bits[i] & map) != map) {
73            for (j = 0; j < 32; j++) {
74              if (map & ((unsigned int)1 << j)) {
75                if (!(use_bits[i] & ((unsigned int)1 << j))) {
76                  pos = (i * 32) + j;
77                  gcMARK2(pf->a[pos], gc);  /* top level */
78                }
79              }
80            }
81            use_bits[i] |= map;
82          }
83        }
84      }
85    }
86  }
87