source: branches/working-0711/ccl/lisp-kernel/gc-common.c @ 13290

Last change on this file since 13290 was 13290, checked in by gz, 11 years ago

forward termination lists in tenured populations

File size: 38.8 KB
Line 
1/*
2   Copyright (C) 2009 Clozure Associates
3   Copyright (C) 1994-2001 Digitool, Inc
4   This file is part of Clozure CL. 
5
6   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7   License , known as the LLGPL and distributed with Clozure CL as the
8   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9   which is distributed with Clozure CL as the file "LGPL".  Where these
10   conflict, the preamble takes precedence. 
11
12   Clozure CL is referenced in the preamble as the "LIBRARY."
13
14   The LLGPL is also available online at
15   http://opensource.franz.com/preamble.html
16*/
17
18#include "lisp.h"
19#include "lisp_globals.h"
20#include "bits.h"
21#include "gc.h"
22#include "area.h"
23#include "Threads.h"
24#include <stddef.h>
25#include <stdlib.h>
26#include <string.h>
27
28#ifndef WINDOWS
29#include <sys/time.h>
30#endif
31
32#ifndef timeradd
33# define timeradd(a, b, result)                                               \
34  do {                                                                        \
35    (result)->tv_sec = (a)->tv_sec + (b)->tv_sec;                             \
36    (result)->tv_usec = (a)->tv_usec + (b)->tv_usec;                          \
37    if ((result)->tv_usec >= 1000000)                                         \
38      {                                                                       \
39        ++(result)->tv_sec;                                                   \
40        (result)->tv_usec -= 1000000;                                         \
41      }                                                                       \
42  } while (0)
43#endif
44#ifndef timersub
45# define timersub(a, b, result)                                               \
46  do {                                                                        \
47    (result)->tv_sec = (a)->tv_sec - (b)->tv_sec;                             \
48    (result)->tv_usec = (a)->tv_usec - (b)->tv_usec;                          \
49    if ((result)->tv_usec < 0) {                                              \
50      --(result)->tv_sec;                                                     \
51      (result)->tv_usec += 1000000;                                           \
52    }                                                                         \
53  } while (0)
54#endif
55
56void
57comma_output_decimal(char *buf, int len, natural n) 
58{
59  int nout = 0;
60
61  buf[--len] = 0;
62  do {
63    buf[--len] = n%10+'0';
64    n = n/10;
65    if (n == 0) {
66      while (len) {
67        buf[--len] = ' ';
68      }
69      return;
70    }
71    if (len == 0) return;
72    nout ++;
73    if (nout == 3) {
74      buf[--len] = ',';
75      nout = 0;
76    }
77  } while (len >= 0);
78}
79
80
81natural
82static_dnodes_for_area(area *a)
83{
84  if (a->low == tenured_area->low) {
85    return tenured_area->static_dnodes;
86  }
87  return 0;
88}
89
90Boolean GCDebug = false, GCverbose = false;
91bitvector GCmarkbits = NULL, GCdynamic_markbits = NULL;
92LispObj GCarealow = 0, GCareadynamiclow = 0;
93natural GCndnodes_in_area = 0, GCndynamic_dnodes_in_area = 0;
94LispObj GCweakvll = (LispObj)NULL;
95LispObj GCdwsweakvll = (LispObj)NULL;
96LispObj GCephemeral_low = 0;
97natural GCn_ephemeral_dnodes = 0;
98natural GCstack_limit = 0;
99
100
101void
102reapweakv(LispObj weakv)
103{
104  /*
105    element 2 of the weak vector should be tagged as a cons: if it
106    isn't, just mark it as a root.  if it is, cdr through it until a
107    "marked" cons is encountered.  If the car of any unmarked cons is
108    marked, mark the cons which contains it; otherwise, splice the
109    cons out of the list.  N.B. : elements 0 and 1 are already marked
110    (or are immediate, etc.)
111  */
112  LispObj *prev = ((LispObj *) ptr_from_lispobj(untag(weakv))+(1+2)), cell = *prev;
113  LispObj termination_list = lisp_nil;
114  natural weak_type = (natural) deref(weakv,2);
115  Boolean alistp = ((weak_type & population_type_mask) == population_weak_alist),
116    terminatablep = ((weak_type >> population_termination_bit) != 0);
117  Boolean done = false;
118  cons *rawcons;
119  natural dnode, car_dnode;
120  bitvector markbits = GCmarkbits;
121
122  if (terminatablep) {
123    termination_list = deref(weakv,1+3);
124  }
125
126  if (fulltag_of(cell) != fulltag_cons) {
127    mark_root(cell);
128  } else if (alistp) {
129    /* weak alist */
130    while (! done) {
131      dnode = gc_area_dnode(cell);
132      if ((dnode >= GCndnodes_in_area) ||
133          (ref_bit(markbits, dnode))) {
134        done = true;
135      } else {
136        /* Cons cell is unmarked. */
137        LispObj alist_cell, thecar;
138        unsigned cell_tag;
139
140        rawcons = (cons *) ptr_from_lispobj(untag(cell));
141        alist_cell = rawcons->car;
142        cell_tag = fulltag_of(alist_cell);
143
144        if ((cell_tag == fulltag_cons) &&
145            ((car_dnode = gc_area_dnode(alist_cell)) < GCndnodes_in_area) &&
146            (! ref_bit(markbits, car_dnode)) &&
147            (is_node_fulltag(fulltag_of(thecar = car(alist_cell)))) &&
148            ((car_dnode = gc_area_dnode(thecar)) < GCndnodes_in_area) &&
149            (! ref_bit(markbits, car_dnode))) {
150          *prev = rawcons->cdr;
151          if (terminatablep) {
152            rawcons->cdr = termination_list;
153            termination_list = cell;
154          }
155        } else {
156          set_bit(markbits, dnode);
157          prev = (LispObj *)(&(rawcons->cdr));
158          mark_root(alist_cell);
159        }
160        cell = *prev;
161      }
162    }
163  } else {
164    /* weak list */
165    while (! done) {
166      dnode = gc_area_dnode(cell);
167      if ((dnode >= GCndnodes_in_area) ||
168          (ref_bit(markbits, dnode))) {
169        done = true;
170      } else {
171        /* Cons cell is unmarked. */
172        LispObj thecar;
173        unsigned cartag;
174
175        rawcons = (cons *) ptr_from_lispobj(untag(cell));
176        thecar = rawcons->car;
177        cartag = fulltag_of(thecar);
178
179        if (is_node_fulltag(cartag) &&
180            ((car_dnode = gc_area_dnode(thecar)) < GCndnodes_in_area) &&
181            (! ref_bit(markbits, car_dnode))) {
182          *prev = rawcons->cdr;
183          if (terminatablep) {
184            rawcons->cdr = termination_list;
185            termination_list = cell;
186          }
187        } else {
188          set_bit(markbits, dnode);
189          prev = (LispObj *)(&(rawcons->cdr));
190        }
191        cell = *prev;
192      }
193    }
194  }
195
196  if (terminatablep) {
197    deref(weakv,1+3) = termination_list;
198  }
199  if (termination_list != lisp_nil) {
200    deref(weakv,1) = GCweakvll;
201    GCweakvll = untag(weakv);
202  } else {
203    deref(weakv,1) = lisp_global(WEAKVLL);
204    lisp_global(WEAKVLL) = untag(weakv);
205  }
206}
207
208/*
209  Screw: doesn't deal with finalization.
210  */
211
212void
213reaphashv(LispObj hashv)
214{
215  hash_table_vector_header
216    *hashp = (hash_table_vector_header *) ptr_from_lispobj(untag(hashv));
217  natural
218    dnode,
219    npairs = (header_element_count(hashp->header) - 
220              (hash_table_vector_header_count -1)) >> 1;
221  LispObj *pairp = (LispObj*) (hashp+1), weakelement;
222  Boolean
223    weak_on_value = ((hashp->flags & nhash_weak_value_mask) != 0);
224  Boolean
225    keys_frozen = ((hashp->flags & nhash_keys_frozen_mask) != 0);
226  bitvector markbits = GCmarkbits;
227  int tag;
228
229  while (npairs--) {
230    if (weak_on_value) {
231      weakelement = pairp[1];
232    } else {
233      weakelement = pairp[0];
234    }
235    tag = fulltag_of(weakelement);
236    if (is_node_fulltag(tag)) {
237      dnode = gc_area_dnode(weakelement);
238      if ((dnode < GCndnodes_in_area) && 
239          ! ref_bit(markbits, dnode)) {
240        pairp[0] = slot_unbound;
241        if (keys_frozen) {
242          if (pairp[1] != slot_unbound) {
243            pairp[1] = unbound;
244          }
245        }
246        else {
247          pairp[1] = lisp_nil;
248        }
249        hashp->weak_deletions_count += (1<<fixnumshift);
250      }
251    }
252    pairp += 2;
253  }
254}
255
256void
257traditional_dws_mark_htabv(LispObj htabv)
258{
259  /* Do nothing, just add htabv to GCweakvll */
260  LispObj *base = (LispObj *) ptr_from_lispobj(untag(htabv));
261
262  base[1] = GCweakvll;
263  GCweakvll = ptr_to_lispobj(base);
264}
265
266void
267ncircle_dws_mark_htabv(LispObj htabv)
268{
269  /* Do nothing, just add htabv to GCdwsweakvll */
270  deref(htabv,1) = GCdwsweakvll;
271  GCdwsweakvll = htabv;
272}
273
274void
275traditional_mark_weak_htabv(LispObj htabv)
276{
277  int i, skip = hash_table_vector_header_count;;
278  LispObj *base = (LispObj *) ptr_from_lispobj(untag(htabv));
279
280  for (i = 2; i <= skip; i++) {
281    rmark(base[i]);
282  }
283  base[1] = GCweakvll;
284  GCweakvll = ptr_to_lispobj(base);
285}
286
287void
288ncircle_mark_weak_htabv(LispObj htabv)
289{
290  int i, skip = hash_table_vector_header_count;
291  hash_table_vector_header *hashp = (hash_table_vector_header *)(untag(htabv));
292  natural
293    npairs = (header_element_count(hashp->header) - 
294              (hash_table_vector_header_count - 1)) >> 1;
295  LispObj *pairp = (LispObj*) (hashp+1);
296  Boolean
297    weak_on_value = ((hashp->flags & nhash_weak_value_mask) != 0);
298
299
300  for (i = 2; i <= skip; i++) {
301    rmark(deref(htabv,i));
302  }
303 
304  if (!weak_on_value) {
305    pairp++;
306  }
307  /* unconditionally mark the non-weak element of each pair */
308  while (npairs--) {
309    rmark(*pairp);
310    pairp += 2;
311  }
312  deref(htabv,1)  = GCweakvll;
313  GCweakvll = (LispObj)untag(htabv);
314}
315
316
317Boolean
318mark_weak_hash_vector(hash_table_vector_header *hashp, natural elements)
319{
320  natural flags = hashp->flags, key_dnode, val_dnode;
321  Boolean
322    marked_new = false, 
323    key_marked,
324    val_marked,
325    weak_value = ((flags & nhash_weak_value_mask) != 0);
326  int 
327    skip = hash_table_vector_header_count-1,
328    key_tag,
329    val_tag,
330    i;
331  LispObj
332    *pairp = (LispObj*) (hashp+1),
333    key,
334    val;
335
336  /* Mark everything in the header */
337 
338  for (i = 2; i<= skip; i++) {
339    mark_root(deref(ptr_to_lispobj(hashp),i));
340  }
341
342  elements -= skip;
343
344  for (i = 0; i<elements; i+=2, pairp+=2) {
345    key = pairp[0];
346    val = pairp[1];
347    key_marked = val_marked = true;
348    key_tag = fulltag_of(key);
349    val_tag = fulltag_of(val);
350    if (is_node_fulltag(key_tag)) {
351      key_dnode = gc_area_dnode(key);
352      if ((key_dnode < GCndnodes_in_area) &&
353          ! ref_bit(GCmarkbits,key_dnode)) {
354        key_marked = false;
355      }
356    }
357    if (is_node_fulltag(val_tag)) {
358      val_dnode = gc_area_dnode(val);
359      if ((val_dnode < GCndnodes_in_area) &&
360          ! ref_bit(GCmarkbits,val_dnode)) {
361        val_marked = false;
362      }
363    }
364
365    if (weak_value) {
366      if (val_marked & !key_marked) {
367        mark_root(key);
368        marked_new = true;
369      }
370    } else {
371      if (key_marked & !val_marked) {
372        mark_root(val);
373        marked_new = true;
374      }
375    }
376  }
377  return marked_new;
378}
379
380
381Boolean
382mark_weak_alist(LispObj weak_alist, int weak_type)
383{
384  natural
385    elements = header_element_count(header_of(weak_alist)),
386    dnode;
387  int pair_tag;
388  Boolean marked_new = false;
389  LispObj alist, pair, key, value;
390  bitvector markbits = GCmarkbits;
391
392  if (weak_type >> population_termination_bit) {
393    elements -= 1;
394  }
395  for(alist = deref(weak_alist, elements);
396      (fulltag_of(alist) == fulltag_cons) &&
397      ((dnode = gc_area_dnode(alist)) < GCndnodes_in_area) &&
398      (! ref_bit(markbits,dnode));
399      alist = cdr(alist)) {
400    pair = car(alist);
401    pair_tag = fulltag_of(pair);
402    if ((is_node_fulltag(pair_tag)) &&
403        ((dnode = gc_area_dnode(pair_tag)) < GCndnodes_in_area) &&
404        (! ref_bit(markbits,dnode))) {
405      if (pair_tag == fulltag_cons) {
406        key = car(pair);
407        if ((! is_node_fulltag(fulltag_of(key))) ||
408            ((dnode = gc_area_dnode(key)) >= GCndnodes_in_area) ||
409            ref_bit(markbits,dnode)) {
410          /* key is marked, mark value if necessary */
411          value = cdr(pair);
412          if (is_node_fulltag(fulltag_of(value)) &&
413              ((dnode = gc_area_dnode(value)) < GCndnodes_in_area) &&
414              (! ref_bit(markbits,dnode))) {
415            mark_root(value);
416            marked_new = true;
417          }
418        }
419      } else {
420          mark_root(pair);
421          marked_new = true;
422      }
423    }
424  }
425  return marked_new;
426}
427 
428void
429mark_termination_lists()
430{
431  /*
432     Mark the termination lists in all terminatable weak vectors, which
433     are now linked together on GCweakvll, and add them to WEAKVLL,
434     which already contains all other weak vectors.
435  */
436  LispObj pending = GCweakvll,
437          *base = (LispObj *)NULL;
438
439  while (pending) {
440    base = ptr_from_lispobj(pending);
441    pending = base[1];
442
443    mark_root(base[1+3]);
444  }
445  if (base) {
446    base[1] = lisp_global(WEAKVLL);
447    lisp_global(WEAKVLL) = GCweakvll;
448  }
449
450}
451
452
453void
454traditional_markhtabvs()
455{
456  LispObj *base, this, header, pending;
457  int subtag;
458  hash_table_vector_header *hashp;
459  Boolean marked_new;
460
461  do {
462    pending = (LispObj) NULL;
463    marked_new = false;
464   
465    while (GCweakvll) {
466      base = ptr_from_lispobj(GCweakvll);
467      GCweakvll = base[1];
468     
469      header = base[0];
470      subtag = header_subtag(header);
471     
472      if (subtag == subtag_weak) {
473        natural weak_type = base[2];
474        this = ptr_to_lispobj(base) + fulltag_misc;
475        base[1] = pending;
476        pending = ptr_to_lispobj(base);
477        if ((weak_type & population_type_mask) == population_weak_alist) {
478          if (mark_weak_alist(this, weak_type)) {
479            marked_new = true;
480          }
481        }
482      } else if (subtag == subtag_hash_vector) {
483        natural elements = header_element_count(header);
484
485        hashp = (hash_table_vector_header *) base;
486        if (hashp->flags & nhash_weak_mask) {
487          base[1] = pending;
488          pending = ptr_to_lispobj(base);
489          if (mark_weak_hash_vector(hashp, elements)) {
490            marked_new = true;
491          }
492        } 
493      } else {
494        Bug(NULL, "Strange object on weak vector linked list: " LISP "\n", base);
495      }
496    }
497
498    if (marked_new) {
499      GCweakvll = pending;
500    }
501  } while (marked_new);
502
503  /* Now, everything's marked that's going to be,  and "pending" is a list
504     of populations and weak hash tables.  CDR down that list and free
505     anything that isn't marked.
506     */
507
508  while (pending) {
509    base = ptr_from_lispobj(pending);
510    pending = base[1];
511    base[1] = (LispObj)NULL;
512
513    this = ptr_to_lispobj(base) + fulltag_misc;
514
515    subtag = header_subtag(base[0]);
516    if (subtag == subtag_weak) {
517      reapweakv(this);
518    } else {
519      reaphashv(this);
520    }
521  }
522  mark_termination_lists();
523}
524
525void
526ncircle_markhtabvs()
527{
528  LispObj *base, this, header, pending = 0;
529  int subtag;
530
531  /* First, process any weak hash tables that may have
532     been encountered by the link-inverting marker; we
533     should have more stack space now. */
534
535  while (GCdwsweakvll) {
536    this = GCdwsweakvll;
537    GCdwsweakvll = deref(this,1);
538    ncircle_mark_weak_htabv(this);
539  }
540
541  while (GCweakvll) {
542    base = ptr_from_lispobj(GCweakvll);
543    GCweakvll = base[1];
544    base[1] = (LispObj)NULL;
545
546    this = ptr_to_lispobj(base) + fulltag_misc;
547
548    header = base[0];
549    subtag = header_subtag(header);
550     
551    if (subtag == subtag_weak) {
552      natural weak_type = base[2];
553      base[1] = pending;
554      pending = ptr_to_lispobj(base);
555      if ((weak_type & population_type_mask) == population_weak_alist) {
556        mark_weak_alist(this, weak_type);
557      }
558    } else if (subtag == subtag_hash_vector) {
559      reaphashv(this);
560    }
561  }
562
563  /* Now, everything's marked that's going to be,  and "pending" is a list
564     of populations.  CDR down that list and free
565     anything that isn't marked.
566     */
567
568  while (pending) {
569    base = ptr_from_lispobj(pending);
570    pending = base[1];
571    base[1] = (LispObj)NULL;
572
573    this = ptr_to_lispobj(base) + fulltag_misc;
574
575    subtag = header_subtag(base[0]);
576    if (subtag == subtag_weak) {
577      reapweakv(this);
578    } else {
579      Bug(NULL, "Bad object on pending list: %s\n", this);
580    }
581  }
582
583  mark_termination_lists();
584}
585
586void
587mark_tcr_tlb(TCR *tcr)
588{
589  natural n = tcr->tlb_limit;
590  LispObj
591    *start = tcr->tlb_pointer,
592    *end = (LispObj *) ((BytePtr)start+n),
593    node;
594
595  while (start < end) {
596    node = *start;
597    if (node != no_thread_local_binding_marker) {
598      mark_root(node);
599    }
600    start++;
601  }
602}
603
604/*
605  Mark things that're only reachable through some (suspended) TCR.
606  (This basically means the tcr's gc_context and the exception
607  frames on its xframe_list.)
608*/
609
610void
611mark_tcr_xframes(TCR *tcr)
612{
613  xframe_list *xframes;
614  ExceptionInformation *xp;
615
616  xp = tcr->gc_context;
617  if (xp) {
618#ifndef X8632
619    mark_xp(xp);
620#else
621    mark_xp(xp, tcr->node_regs_mask);
622#endif
623  }
624#ifdef X8632
625  mark_root(tcr->save0);
626  mark_root(tcr->save1);
627  mark_root(tcr->save2);
628  mark_root(tcr->save3);
629  mark_root(tcr->next_method_context);
630#endif
631 
632  for (xframes = (xframe_list *) tcr->xframe; 
633       xframes; 
634       xframes = xframes->prev) {
635#ifndef X8632
636      mark_xp(xframes->curr);
637#else
638      mark_xp(xframes->curr, xframes->node_regs_mask);
639#endif
640  }
641}
642     
643
644void *postGCptrs = NULL;
645struct xmacptr *user_postGC_macptrs = NULL;
646
647
648void
649postGCfree(void *p)
650{
651  *(void **)p = postGCptrs;
652  postGCptrs = p;
653}
654
655void
656postGCfreexmacptr(struct xmacptr *p)
657{
658  p->class = (LispObj) user_postGC_macptrs;
659  user_postGC_macptrs = p;
660}
661
662
663xmacptr_dispose_fn xmacptr_dispose_functions[xmacptr_flag_user_last-xmacptr_flag_user_first];
664
665
666
667void
668freeGCptrs()
669{
670  void *p, *next, *addr;
671  struct xmacptr *x, *xnext;
672  int i, flags;
673  xmacptr_dispose_fn dfn;
674
675  for (p = postGCptrs; p; p = next) {
676    next = *((void **)p);
677    free(p);
678  }
679  postGCptrs = NULL;
680 
681  for (x = user_postGC_macptrs; x; x = xnext) {
682    xnext = (xmacptr *) (x->class);;
683    flags = x->flags - xmacptr_flag_user_first;
684    dfn = xmacptr_dispose_functions[flags];
685    addr = (void *) x->address;
686    x->address = 0;
687    x->flags = 0;
688    x->link = 0;
689    x->class = 0;
690    if (dfn && addr) {
691      dfn(addr);
692    }
693  }
694
695  user_postGC_macptrs = NULL;
696}
697
698int
699register_xmacptr_dispose_function(void *dfn)
700{
701  int i, k;
702 
703  for( i = 0, k = xmacptr_flag_user_first; k < xmacptr_flag_user_last; i++, k++) {
704    if (xmacptr_dispose_functions[i]==NULL) {
705      xmacptr_dispose_functions[i] = dfn;
706      return k;
707    }
708    if (xmacptr_dispose_functions[i] == dfn) {
709      return k;
710    }
711  }
712  return 0;
713}
714
715void
716reap_gcable_ptrs()
717{
718  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next, ptr;
719  xmacptr_flag flag;
720  natural dnode;
721  xmacptr *x;
722
723  while((next = *prev) != (LispObj)NULL) {
724    dnode = gc_area_dnode(next);
725    x = (xmacptr *) ptr_from_lispobj(untag(next));
726
727    if ((dnode >= GCndnodes_in_area) ||
728        (ref_bit(GCmarkbits,dnode))) {
729      prev = &(x->link);
730    } else {
731      *prev = x->link;
732      flag = (xmacptr_flag)(x->flags);
733      ptr = x->address;
734
735      if (ptr) {
736        switch (flag) {
737        case xmacptr_flag_recursive_lock:
738          destroy_recursive_lock((RECURSIVE_LOCK)ptr_from_lispobj(ptr));
739          break;
740
741        case xmacptr_flag_ptr:
742          postGCfree((void *)ptr_from_lispobj(ptr));
743          break;
744
745        case xmacptr_flag_rwlock:
746          rwlock_destroy((rwlock *)ptr_from_lispobj(ptr));
747          break;
748
749        case xmacptr_flag_semaphore:
750          destroy_semaphore((void**)&(x->address));
751          break;
752
753        default:
754          if ((flag >= xmacptr_flag_user_first) &&
755              (flag < xmacptr_flag_user_last)) {
756            set_n_bits(GCmarkbits,dnode,3);
757            postGCfreexmacptr(x);
758            break;
759          }
760          /* (warn "unknown xmacptr_flag: ~s" flag) */
761          /* Unknowd, and perhaps unknowdable. */
762          /* Fall in: */
763        case xmacptr_flag_none:
764          break;
765        }
766      }
767    }
768  }
769}
770
771
772
773#if  WORD_SIZE == 64
774unsigned short *_one_bits = NULL;
775
776unsigned short
777logcount16(unsigned short n)
778{
779  unsigned short c=0;
780 
781  while(n) {
782    n = n & (n-1);
783    c++;
784  }
785  return c;
786}
787
788void
789gc_init()
790{
791  int i;
792 
793  _one_bits = malloc(sizeof(unsigned short) * (1<<16));
794
795  for (i = 0; i < (1<<16); i++) {
796    _one_bits[i] = dnode_size*logcount16(i);
797  }
798}
799
800
801#else
802const unsigned char _one_bits[256] = {
803    0*8,1*8,1*8,2*8,1*8,2*8,2*8,3*8,1*8,2*8,2*8,3*8,2*8,3*8,3*8,4*8,
804    1*8,2*8,2*8,3*8,2*8,3*8,3*8,4*8,2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,
805    1*8,2*8,2*8,3*8,2*8,3*8,3*8,4*8,2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,
806    2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,
807    1*8,2*8,2*8,3*8,2*8,3*8,3*8,4*8,2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,
808    2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,
809    2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,
810    3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,4*8,5*8,5*8,6*8,5*8,6*8,6*8,7*8,
811    1*8,2*8,2*8,3*8,2*8,3*8,3*8,4*8,2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,
812    2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,
813    2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,
814    3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,4*8,5*8,5*8,6*8,5*8,6*8,6*8,7*8,
815    2*8,3*8,3*8,4*8,3*8,4*8,4*8,5*8,3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,
816    3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,4*8,5*8,5*8,6*8,5*8,6*8,6*8,7*8,
817    3*8,4*8,4*8,5*8,4*8,5*8,5*8,6*8,4*8,5*8,5*8,6*8,5*8,6*8,6*8,7*8,
818    4*8,5*8,5*8,6*8,5*8,6*8,6*8,7*8,5*8,6*8,6*8,7*8,6*8,7*8,7*8,8*8
819};
820
821
822void
823gc_init()
824{
825}
826
827#endif
828
829
830weak_mark_fun dws_mark_weak_htabv = traditional_dws_mark_htabv;
831weak_mark_fun mark_weak_htabv = traditional_mark_weak_htabv;
832weak_process_fun markhtabvs = traditional_markhtabvs;
833
834void
835install_weak_mark_functions(natural set) {
836  switch(set) {
837  case 0:
838  default:
839    dws_mark_weak_htabv = traditional_dws_mark_htabv;
840    mark_weak_htabv = traditional_mark_weak_htabv;
841    markhtabvs = traditional_markhtabvs;
842    break;
843  case 1:
844    dws_mark_weak_htabv = ncircle_dws_mark_htabv;
845    mark_weak_htabv = ncircle_mark_weak_htabv;
846    markhtabvs = ncircle_markhtabvs;
847    break;
848  }
849}
850
851LispObj
852node_forwarding_address(LispObj node)
853{
854  int tag_n;
855  natural dnode = gc_dynamic_area_dnode(node);
856
857  if ((dnode >= GCndynamic_dnodes_in_area) ||
858      (node < GCfirstunmarked)) {
859    return node;
860  }
861
862  tag_n = fulltag_of(node);
863  if (!is_node_fulltag(tag_n)) {
864    return node;
865  }
866
867  return dnode_forwarding_address(dnode, tag_n);
868}
869
870Boolean
871update_noderef(LispObj *noderef)
872{
873  LispObj
874    node = *noderef,
875    new = node_forwarding_address(node);
876
877  if (new != node) {
878    *noderef = new;
879    return true;
880  }
881  return false;
882}
883
884void
885update_locref(LispObj *locref)
886{
887  LispObj
888    obj = *locref,
889    new = locative_forwarding_address(obj);
890
891  if (new != obj) {
892    *locref = new;
893  }
894}
895
896void
897forward_gcable_ptrs()
898{
899  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next, new;
900  struct xmacptr **xprev, *xnext, *xnew;
901
902  while ((next = *prev) != (LispObj)NULL) {
903    new = node_forwarding_address(next);
904    if (new != next) {
905      *prev = new;
906    }
907    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
908  }
909  xprev = &user_postGC_macptrs;
910  while (xnext = *xprev) {
911    xnew = (struct xmacptr *)locative_forwarding_address((LispObj)xnext);
912    if (xnew != xnext) {
913      *xprev = xnew;
914    }
915    xprev = (struct xmacptr **)(&(xnext->class));
916  }
917}
918
919void
920forward_weakvll()
921{
922  LispObj *ptr = &(lisp_global(WEAKVLL)), this, new, old;
923
924  while (this = *ptr) {
925    old = this + fulltag_misc;
926    new = node_forwarding_address(old);
927    if (old != new) {
928      *ptr = untag(new);
929    }
930    ptr = &(deref(new,1));
931  }
932}
933
934
935void
936forward_memoized_area(area *a, natural num_memo_dnodes)
937{
938  bitvector refbits = a->refbits;
939  LispObj *p = (LispObj *) a->low, x1, x2, new;
940  natural bits, bitidx, *bitsp, nextbit, diff, memo_dnode = 0, hash_dnode_limit = 0;
941  int tag_x1;
942  hash_table_vector_header *hashp = NULL;
943  Boolean header_p;
944
945  if (GCDebug) {
946    check_refmap_consistency(p, p+(num_memo_dnodes << 1), refbits);
947  }
948
949  /* This is pretty straightforward, but we have to note
950     when we move a key in a hash table vector that wants
951     us to tell it about that. */
952
953  set_bitidx_vars(refbits, 0, bitsp, bits, bitidx);
954  while (memo_dnode < num_memo_dnodes) {
955    if (bits == 0) {
956      int remain = nbits_in_word - bitidx;
957      memo_dnode += remain;
958      p += (remain+remain);
959      bits = *++bitsp;
960      bitidx = 0;
961    } else {
962      nextbit = count_leading_zeros(bits);
963      if ((diff = (nextbit - bitidx)) != 0) {
964        memo_dnode += diff;
965        bitidx = nextbit;
966        p += (diff+diff);
967      }
968      x1 = p[0];
969      x2 = p[1];
970      tag_x1 = fulltag_of(x1);
971      bits &= ~(BIT0_MASK >> bitidx);
972      header_p = (nodeheader_tag_p(tag_x1));
973
974      if (header_p &&
975          (header_subtag(x1) == subtag_hash_vector)) {
976        hashp = (hash_table_vector_header *) p;
977        if (hashp->flags & nhash_track_keys_mask) {
978          hash_dnode_limit = memo_dnode + ((header_element_count(x1)+2)>>1);
979        } else {
980          hashp = NULL;
981        }
982      }
983
984
985      if (! header_p) {
986        new = node_forwarding_address(x1);
987        if (new != x1) {
988          *p = new;
989        }
990      }
991      p++;
992
993      new = node_forwarding_address(x2);
994      if (new != x2) {
995        *p = new;
996        if (memo_dnode < hash_dnode_limit) {
997          /* If this code is reached, 'hashp' is non-NULL and pointing
998             at the header of a hash_table_vector, and 'memo_dnode' identifies
999             a pair of words inside the hash_table_vector.  It may be
1000             hard for program analysis tools to recognize that, but I
1001             believe that warnings about 'hashp' being NULL here can
1002             be safely ignored. */
1003          hashp->flags |= nhash_key_moved_mask;
1004          hash_dnode_limit = 0;
1005          hashp = NULL;
1006        }
1007      }
1008      p++;
1009      memo_dnode++;
1010      bitidx++;
1011
1012    }
1013  }
1014}
1015
1016void
1017forward_tcr_tlb(TCR *tcr)
1018{
1019  natural n = tcr->tlb_limit;
1020  LispObj
1021    *start = tcr->tlb_pointer, 
1022    *end = (LispObj *) ((BytePtr)start+n),
1023    node;
1024
1025  while (start < end) {
1026    node = *start;
1027    if (node != no_thread_local_binding_marker) {
1028      update_noderef(start);
1029    }
1030    start++;
1031  }
1032}
1033
1034void
1035reclaim_static_dnodes()
1036{
1037  natural nstatic = tenured_area->static_dnodes, i, bits, bitnum;
1038  cons *c = (cons *)tenured_area->low, *d;
1039  bitvector bitsp = GCmarkbits;
1040  LispObj head = lisp_global(STATIC_CONSES);
1041
1042  if (nstatic) {
1043    if (head) {
1044      for (i = 0; i < nstatic; i+= nbits_in_word, c+= nbits_in_word) {
1045        bits = *bitsp++;
1046        if (bits != ALL_ONES) {
1047          for (bitnum = 0; bitnum < nbits_in_word; bitnum++) {
1048            if (! (bits & (BIT0_MASK>>bitnum))) {
1049              d = c + bitnum;
1050              d->car = 0;
1051              d->cdr = head;
1052              head = ((LispObj)d)+fulltag_cons;
1053            }
1054          }
1055        }
1056      }
1057      lisp_global(STATIC_CONSES) = head;
1058    } else {
1059      for (i = 0; i < nstatic; i+= nbits_in_word, c+= nbits_in_word) {
1060        bits = *bitsp++;
1061        if (bits != ALL_ONES) {
1062          for (bitnum = 0; bitnum < nbits_in_word; bitnum++) {
1063            if (! (bits & (BIT0_MASK>>bitnum))) {
1064              d = c + bitnum;
1065              d->car = 0;
1066              d->cdr = 0;
1067            }
1068          }
1069        }
1070      }
1071    }
1072  }
1073}
1074
1075Boolean
1076youngest_non_null_area_p (area *a)
1077{
1078  if (a->active == a->high) {
1079    return false;
1080  } else {
1081    for (a = a->younger; a; a = a->younger) {
1082      if (a->active != a->high) {
1083        return false;
1084      }
1085    }
1086  };
1087  return true;
1088}
1089
1090Boolean just_purified_p = false;
1091
1092/*
1093  All thread's stack areas have been "normalized", as
1094  has the dynamic heap.  (The "active" pointer in these areas
1095  matches the stack pointer/freeptr value at the time that
1096  the exception occurred.)
1097*/
1098
1099#define get_time(when) gettimeofday(&when, NULL)
1100
1101
1102
1103#ifdef FORCE_DWS_MARK
1104#warning recursive marker disabled for testing; remember to re-enable it
1105#endif
1106
1107
1108void 
1109gc(TCR *tcr, signed_natural param)
1110{
1111  struct timeval start, stop;
1112  area *a = active_dynamic_area, *to = NULL, *from = NULL, *note = NULL;
1113  unsigned timeidx = 1;
1114  paging_info paging_info_start;
1115  LispObj
1116    pkg = 0,
1117    itabvec = 0;
1118  BytePtr oldfree = a->active;
1119  TCR *other_tcr;
1120  natural static_dnodes;
1121  natural weak_method = lisp_global(WEAK_GC_METHOD) >> fixnumshift;
1122
1123#ifndef FORCE_DWS_MARK
1124  if ((natural) (tcr->cs_limit) == CS_OVERFLOW_FORCE_LIMIT) {
1125    GCstack_limit = CS_OVERFLOW_FORCE_LIMIT;
1126  } else {
1127    GCstack_limit = (natural)(tcr->cs_limit)+(natural)page_size;
1128  }
1129#else
1130  GCstack_limit = CS_OVERFLOW_FORCE_LIMIT;
1131#endif
1132
1133  GCephemeral_low = lisp_global(OLDEST_EPHEMERAL);
1134  if (GCephemeral_low) {
1135    GCn_ephemeral_dnodes=area_dnode(oldfree, GCephemeral_low);
1136  } else {
1137    GCn_ephemeral_dnodes = 0;
1138  }
1139 
1140  if (GCn_ephemeral_dnodes) {
1141    GCverbose = ((nrs_GC_EVENT_STATUS_BITS.vcell & egc_verbose_bit) != 0);
1142  } else {
1143    GCverbose = ((nrs_GC_EVENT_STATUS_BITS.vcell & gc_verbose_bit) != 0);
1144  }
1145
1146  if (GCephemeral_low) {
1147    weak_method = 1;   /* egc, so use faster algorithm */
1148    if ((oldfree-g1_area->low) < g1_area->threshold) {
1149      to = g1_area;
1150      note = a;
1151      timeidx = 4;
1152    } else if ((oldfree-g2_area->low) < g2_area->threshold) {
1153      to = g2_area;
1154      from = g1_area;
1155      note = g1_area;
1156      timeidx = 3;
1157    } else {
1158      to = tenured_area;
1159      from = g2_area;
1160      note = g2_area;
1161      timeidx = 2;
1162    } 
1163  } else {
1164    note = tenured_area;
1165  }
1166
1167  install_weak_mark_functions(weak_method);
1168 
1169  if (GCverbose) {
1170    char buf[16];
1171
1172    sample_paging_info(&paging_info_start);
1173    comma_output_decimal(buf,16,area_dnode(oldfree,a->low) << dnode_shift);
1174    if (GCephemeral_low) {
1175      fprintf(dbgout,
1176              "\n\n;;; Starting Ephemeral GC of generation %d",
1177              (from == g2_area) ? 2 : (from == g1_area) ? 1 : 0); 
1178    } else {
1179      fprintf(dbgout,"\n\n;;; Starting full GC");
1180    }
1181    fprintf(dbgout, ", %s bytes allocated.\n", buf);
1182  }
1183
1184  get_time(start);
1185
1186  /* The link-inverting marker might need to write to watched areas */
1187  unprotect_watched_areas();
1188
1189  lisp_global(IN_GC) = (1<<fixnumshift);
1190
1191  if (just_purified_p) {
1192    just_purified_p = false;
1193    GCDebug = false;
1194  } else {
1195    GCDebug = ((nrs_GC_EVENT_STATUS_BITS.vcell & gc_integrity_check_bit) != 0);
1196    if (GCDebug) {
1197      check_all_areas(tcr);
1198    }
1199  }
1200
1201  if (from) {
1202    untenure_from_area(from);
1203  }
1204  static_dnodes = static_dnodes_for_area(a);
1205  GCmarkbits = a->markbits;
1206  GCarealow = ptr_to_lispobj(a->low);
1207  GCareadynamiclow = GCarealow+(static_dnodes << dnode_shift);
1208  GCndnodes_in_area = gc_area_dnode(oldfree);
1209
1210  if (GCndnodes_in_area) {
1211    GCndynamic_dnodes_in_area = GCndnodes_in_area-static_dnodes;
1212    GCdynamic_markbits = 
1213      GCmarkbits + ((GCndnodes_in_area-GCndynamic_dnodes_in_area)>>bitmap_shift);
1214
1215    zero_bits(GCmarkbits, GCndnodes_in_area);
1216    GCweakvll = (LispObj)NULL;
1217
1218    if (GCn_ephemeral_dnodes) {
1219      /* For egc case, initialize GCweakvll with populations not in the
1220         GC area.  Weak hash vectors, and populations in the GC area,
1221         will be added during marking.
1222      */
1223      LispObj this = lisp_global(WEAKVLL); /* all populations as of last gc */
1224      LispObj *tenured_low = (LispObj *)tenured_area->low;
1225      natural tenured_dnodes = area_dnode(GCarealow, tenured_low);
1226      bitvector refbits = tenured_area->refbits;
1227
1228      while (this) {
1229        LispObj *base = ptr_from_lispobj(this);
1230        LispObj next = base[1];
1231        natural dnode = gc_dynamic_area_dnode(this);
1232        if (dnode >= GCndynamic_dnodes_in_area) {
1233          base[1] = GCweakvll;
1234          GCweakvll = ptr_to_lispobj(base);
1235          /* Since will be doing weak processing, don't treat the data as root */
1236          dnode = area_dnode(&base[3], tenured_low);
1237          if (dnode < tenured_dnodes) {
1238            clr_bit(refbits, dnode);
1239          }
1240        }
1241        else {
1242          base[1] = (LispObj)NULL;
1243        }
1244        this = next;
1245      }
1246    }
1247    lisp_global(WEAKVLL) = (LispObj)NULL;
1248
1249
1250    if (GCn_ephemeral_dnodes == 0) {
1251      /* For GCTWA, mark the internal package hash table vector of
1252       *PACKAGE*, but don't mark its contents. */
1253      {
1254        LispObj
1255          itab;
1256        natural
1257          dnode, ndnodes;
1258     
1259        pkg = nrs_PACKAGE.vcell;
1260        if ((fulltag_of(pkg) == fulltag_misc) &&
1261            (header_subtag(header_of(pkg)) == subtag_package)) {
1262          itab = ((package *)ptr_from_lispobj(untag(pkg)))->itab;
1263          itabvec = car(itab);
1264          dnode = gc_area_dnode(itabvec);
1265          if (dnode < GCndnodes_in_area) {
1266            ndnodes = (header_element_count(header_of(itabvec))+1) >> 1;
1267            set_n_bits(GCmarkbits, dnode, ndnodes);
1268          }
1269        }
1270      }
1271    }
1272
1273    mark_root(lisp_global(STATIC_CONSES));
1274
1275    {
1276      area *next_area;
1277      area_code code;
1278
1279      /* Could make a jump table instead of the typecase */
1280
1281      for (next_area = a->succ; (code = next_area->code) != AREA_VOID; next_area = next_area->succ) {
1282        switch (code) {
1283        case AREA_TSTACK:
1284          mark_tstack_area(next_area);
1285          break;
1286
1287        case AREA_VSTACK:
1288          mark_vstack_area(next_area);
1289          break;
1290         
1291        case AREA_CSTACK:
1292          mark_cstack_area(next_area);
1293          break;
1294
1295        case AREA_STATIC:
1296        case AREA_WATCHED:
1297        case AREA_DYNAMIC:                  /* some heap that isn't "the" heap */
1298          /* In both of these cases, we -could- use the area's "markbits"
1299             bitvector as a reference map.  It's safe (but slower) to
1300             ignore that map and process the entire area.
1301          */
1302          if (next_area->younger == NULL) {
1303            mark_simple_area_range((LispObj *) next_area->low, (LispObj *) next_area->active);
1304          }
1305          break;
1306
1307        default:
1308          break;
1309        }
1310      }
1311    }
1312 
1313    if (GCephemeral_low) {
1314      mark_memoized_area(tenured_area, area_dnode(a->low,tenured_area->low));
1315    }
1316
1317    other_tcr = tcr;
1318    do {
1319      mark_tcr_xframes(other_tcr);
1320      mark_tcr_tlb(other_tcr);
1321      other_tcr = other_tcr->next;
1322    } while (other_tcr != tcr);
1323
1324
1325
1326
1327    /* Go back through *package*'s internal symbols, marking
1328       any that aren't worthless.
1329    */
1330   
1331    if (itabvec) {
1332      natural
1333        i,
1334        n = header_element_count(header_of(itabvec));
1335      LispObj
1336        sym,
1337        *raw = 1+((LispObj *)ptr_from_lispobj(untag(itabvec)));
1338
1339      for (i = 0; i < n; i++) {
1340        sym = *raw++;
1341        if (is_symbol_fulltag(sym)) {
1342          lispsymbol *rawsym = (lispsymbol *)ptr_from_lispobj(untag(sym));
1343          natural dnode = gc_area_dnode(sym);
1344         
1345          if ((dnode < GCndnodes_in_area) &&
1346              (!ref_bit(GCmarkbits,dnode))) {
1347            /* Symbol is in GC area, not marked.
1348               Mark it if fboundp, boundp, or if
1349               it has a plist or another home package.
1350            */
1351           
1352            if (FBOUNDP(rawsym) ||
1353                BOUNDP(rawsym) ||
1354                (rawsym->flags != 0) || /* SPECIAL, etc. */
1355                (rawsym->plist != lisp_nil) ||
1356                ((rawsym->package_predicate != pkg) &&
1357                 (rawsym->package_predicate != lisp_nil))) {
1358              mark_root(sym);
1359            }
1360          }
1361        }
1362      }
1363    }
1364
1365    (void)markhtabvs();
1366
1367    if (itabvec) {
1368      natural
1369        i,
1370        n = header_element_count(header_of(itabvec));
1371      LispObj
1372        sym,
1373        *raw = 1+((LispObj *)ptr_from_lispobj(untag(itabvec)));
1374
1375      for (i = 0; i < n; i++, raw++) {
1376        sym = *raw;
1377        if (is_symbol_fulltag(sym)) {
1378          natural dnode = gc_area_dnode(sym);
1379
1380          if ((dnode < GCndnodes_in_area) &&
1381              (!ref_bit(GCmarkbits,dnode))) {
1382            *raw = unbound_marker;
1383          }
1384        }
1385      }
1386    }
1387 
1388    reap_gcable_ptrs();
1389
1390    /* Restore population data refbits for forwarding */
1391    if (GCn_ephemeral_dnodes) {
1392      LispObj *tenured_low = (LispObj *)tenured_area->low;
1393      natural tenured_dnodes = area_dnode(GCarealow, tenured_low);
1394      bitvector refbits = tenured_area->refbits;
1395      LispObj this = lisp_global(WEAKVLL);
1396
1397      while (this) {
1398        LispObj *base = ptr_from_lispobj(this);
1399        natural dnode = area_dnode(&base[3], tenured_low);
1400        if (dnode < tenured_dnodes) {
1401          if (base[3] >= GCarealow) {
1402            set_bit(refbits, dnode);
1403          }
1404          // might have set termination list to a new pointer
1405          if ((base[2] >> population_termination_bit) && (base[4] >= GCarealow)) {
1406            set_bit(refbits, dnode+1);
1407          }
1408        }
1409        this = base[1];
1410      }
1411    }
1412
1413    GCrelocptr = global_reloctab;
1414    GCfirstunmarked = calculate_relocation();
1415
1416    if (!GCephemeral_low) {
1417      reclaim_static_dnodes();
1418    }
1419
1420    forward_range((LispObj *) ptr_from_lispobj(GCarealow), (LispObj *) ptr_from_lispobj(GCfirstunmarked));
1421
1422    other_tcr = tcr;
1423    do {
1424      forward_tcr_xframes(other_tcr);
1425      forward_tcr_tlb(other_tcr);
1426      other_tcr = other_tcr->next;
1427    } while (other_tcr != tcr);
1428
1429 
1430    forward_gcable_ptrs();
1431
1432
1433
1434    {
1435      area *next_area;
1436      area_code code;
1437
1438      /* Could make a jump table instead of the typecase */
1439
1440      for (next_area = a->succ; (code = next_area->code) != AREA_VOID; next_area = next_area->succ) {
1441        switch (code) {
1442        case AREA_TSTACK:
1443          forward_tstack_area(next_area);
1444          break;
1445
1446        case AREA_VSTACK:
1447          forward_vstack_area(next_area);
1448          break;
1449
1450        case AREA_CSTACK:
1451          forward_cstack_area(next_area);
1452          break;
1453
1454        case AREA_STATIC:
1455        case AREA_WATCHED:
1456        case AREA_DYNAMIC:                  /* some heap that isn't "the" heap */
1457          if (next_area->younger == NULL) {
1458            forward_range((LispObj *) next_area->low, (LispObj *) next_area->active);
1459          }
1460          break;
1461
1462        default:
1463          break;
1464        }
1465      }
1466    }
1467
1468    if (GCephemeral_low) {
1469      forward_memoized_area(tenured_area, area_dnode(a->low, tenured_area->low));
1470    }
1471 
1472    a->active = (BytePtr) ptr_from_lispobj(compact_dynamic_heap());
1473
1474    forward_weakvll();
1475
1476    if (to) {
1477      tenure_to_area(to);
1478    }
1479
1480    zero_memory_range(a->active, oldfree);
1481
1482    resize_dynamic_heap(a->active,
1483                        (GCephemeral_low == 0) ? lisp_heap_gc_threshold : 0);
1484
1485    /*
1486      If the EGC is enabled: If there's no room for the youngest
1487      generation, untenure everything.  If this was a full GC and
1488      there's now room for the youngest generation, tenure everything.
1489    */
1490    if (a->older != NULL) {
1491      natural nfree = (a->high - a->active);
1492
1493
1494      if (nfree < a->threshold) {
1495        untenure_from_area(tenured_area);
1496      } else {
1497        if (GCephemeral_low == 0) {
1498          tenure_to_area(tenured_area);
1499        }
1500      }
1501    }
1502  }
1503  lisp_global(GC_NUM) += (1<<fixnumshift);
1504  if (note) {
1505    note->gccount += (1<<fixnumshift);
1506  }
1507
1508  if (GCDebug) {
1509    check_all_areas(tcr);
1510  }
1511
1512 
1513  lisp_global(IN_GC) = 0;
1514 
1515  protect_watched_areas();
1516
1517  nrs_GC_EVENT_STATUS_BITS.vcell |= gc_postgc_pending;
1518  get_time(stop);
1519
1520  {
1521    lispsymbol * total_gc_microseconds = (lispsymbol *) &(nrs_TOTAL_GC_MICROSECONDS);
1522    lispsymbol * total_bytes_freed = (lispsymbol *) &(nrs_TOTAL_BYTES_FREED);
1523    LispObj val;
1524    struct timeval *timeinfo, elapsed = {0, 0};
1525
1526    val = total_gc_microseconds->vcell;
1527    if ((fulltag_of(val) == fulltag_misc) &&
1528        (header_subtag(header_of(val)) == subtag_macptr)) {
1529      timersub(&stop, &start, &elapsed);
1530      timeinfo = (struct timeval *) ptr_from_lispobj(((macptr *) ptr_from_lispobj(untag(val)))->address);
1531      timeradd(timeinfo,  &elapsed, timeinfo);
1532      timeradd(timeinfo+timeidx,  &elapsed, timeinfo+timeidx);
1533    }
1534
1535    val = total_bytes_freed->vcell;
1536    if ((fulltag_of(val) == fulltag_misc) &&
1537        (header_subtag(header_of(val)) == subtag_macptr)) {
1538      long long justfreed = oldfree - a->active;
1539      *( (long long *) ptr_from_lispobj(((macptr *) ptr_from_lispobj(untag(val)))->address)) += justfreed;
1540      if (GCverbose) {
1541        char buf[16];
1542        paging_info paging_info_stop;
1543
1544        sample_paging_info(&paging_info_stop);
1545        if (justfreed <= heap_segment_size) {
1546          justfreed = 0;
1547        }
1548        comma_output_decimal(buf,16,justfreed);
1549        if (note == tenured_area) {
1550          fprintf(dbgout,";;; Finished full GC. %s bytes freed in %d.%06d s\n\n", buf, elapsed.tv_sec, elapsed.tv_usec);
1551        } else {
1552          fprintf(dbgout,";;; Finished EGC of generation %d. %s bytes freed in %d.%06d s\n\n", 
1553                  (from == g2_area) ? 2 : (from == g1_area) ? 1 : 0,
1554                  buf, 
1555                  elapsed.tv_sec, elapsed.tv_usec);
1556        }
1557        report_paging_info_delta(dbgout, &paging_info_start, &paging_info_stop);
1558      }
1559    }
1560  }
1561}
Note: See TracBrowser for help on using the repository browser.