0.pre8.112:
[sbcl.git] / src / runtime / cheneygc.c
1 /*
2  * stop and copy GC based on Cheney's algorithm
3  */
4
5 /*
6  * This software is part of the SBCL system. See the README file for
7  * more information.
8  *
9  * This software is derived from the CMU CL system, which was
10  * written at Carnegie Mellon University and released into the
11  * public domain. The software is in the public domain and is
12  * provided with absolutely no warranty. See the COPYING and CREDITS
13  * files for more information.
14  */
15
16 #include <stdio.h>
17 #include <sys/time.h>
18 #include <sys/resource.h>
19 #include <signal.h>
20 #include "runtime.h"
21 #include "sbcl.h"
22 #include "os.h"
23 #include "gc.h"
24 #include "gc-internal.h"
25 #include "globals.h"
26 #include "interrupt.h"
27 #include "validate.h"
28 #include "lispregs.h"
29 #include "interr.h"
30 #include "genesis/static-symbols.h"
31 #include "genesis/primitive-objects.h"
32 #include "thread.h"
33
34 /* So you need to debug? */
35 #if 0
36 #define PRINTNOISE
37 #define DEBUG_SPACE_PREDICATES
38 #define DEBUG_SCAVENGE_VERBOSE
39 #define DEBUG_COPY_VERBOSE
40 #define DEBUG_CODE_GC
41 #endif
42
43 lispobj *from_space;
44 lispobj *from_space_free_pointer;
45
46 lispobj *new_space;
47 lispobj *new_space_free_pointer;
48
49 static void scavenge_newspace(void);
50 static void scavenge_interrupt_contexts(void);
51 extern struct interrupt_data * global_interrupt_data;
52
53 \f
54 /* collecting garbage */
55
56 #ifdef PRINTNOISE
57 static double
58 tv_diff(struct timeval *x, struct timeval *y)
59 {
60     return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
61             ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
62 }
63 #endif
64
65 #define BYTES_ZERO_BEFORE_END (1<<12)
66
67 /* FIXME do we need this?  Doesn't it duplicate lisp code in 
68  * scrub-control-stack? */
69
70 static void
71 zero_stack(void)
72 {
73     u32 *ptr = (u32 *)current_control_stack_pointer;
74  search:
75     do {
76         if (*ptr)
77             goto fill;
78         ptr++;
79     } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
80     return;
81  fill:
82     do {
83         *ptr++ = 0;
84     } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
85
86     goto search;
87 }
88
89
90 void *
91 gc_general_alloc(int bytes, int unboxed_p, int quick_p) {
92     lispobj *new=new_space_free_pointer;
93     new_space_free_pointer+=(bytes/4);
94     return new;
95 }
96
97 lispobj  copy_large_unboxed_object(lispobj object, int nwords) {
98     return copy_object(object,nwords);
99 }
100 lispobj  copy_unboxed_object(lispobj object, int nwords) {
101     return copy_object(object,nwords);
102 }
103 lispobj  copy_large_object(lispobj object, int nwords) {
104     return copy_object(object,nwords);
105 }
106
107 /* Note: The generic GC interface we're implementing passes us a
108  * last_generation argument. That's meaningless for us, since we're
109  * not a generational GC. So we ignore it. */
110 void
111 collect_garbage(unsigned ignore)
112 {
113 #ifdef PRINTNOISE
114     struct timeval start_tv, stop_tv;
115     struct rusage start_rusage, stop_rusage;
116     double real_time, system_time, user_time;
117     double percent_retained, gc_rate;
118     unsigned long size_discarded;
119     unsigned long size_retained;
120 #endif
121     lispobj *current_static_space_free_pointer;
122     unsigned long static_space_size; 
123     unsigned long control_stack_size, binding_stack_size; 
124     sigset_t tmp, old;
125     struct thread *th=arch_os_get_current_thread();
126     struct interrupt_data *data=
127         th ? th->interrupt_data : global_interrupt_data;
128
129
130 #ifdef PRINTNOISE
131     printf("[Collecting garbage ... \n");
132         
133     getrusage(RUSAGE_SELF, &start_rusage);
134     gettimeofday(&start_tv, (struct timezone *) 0);
135 #endif
136         
137     sigemptyset(&tmp);
138     sigaddset_blockable(&tmp);
139     sigprocmask(SIG_BLOCK, &tmp, &old);
140
141     current_static_space_free_pointer =
142         (lispobj *) ((unsigned long)
143                      SymbolValue(STATIC_SPACE_FREE_POINTER,0));
144
145
146     /* Set up from space and new space pointers. */
147
148     from_space = current_dynamic_space;
149     from_space_free_pointer = dynamic_space_free_pointer;
150
151 #ifdef PRINTNOISE
152     fprintf(stderr,"from_space = %lx\n",
153             (unsigned long) current_dynamic_space);
154 #endif
155     if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
156         new_space = (lispobj *)DYNAMIC_1_SPACE_START;
157     else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
158         new_space = (lispobj *) DYNAMIC_0_SPACE_START;
159     else {
160         lose("GC lossage.  Current dynamic space is bogus!\n");
161     }
162     new_space_free_pointer = new_space;
163
164     /* Initialize the weak pointer list. */
165     weak_pointers = (struct weak_pointer *) NULL;
166
167
168     /* Scavenge all of the roots. */
169 #ifdef PRINTNOISE
170     printf("Scavenging interrupt contexts ...\n");
171 #endif
172     scavenge_interrupt_contexts();
173
174 #ifdef PRINTNOISE
175     printf("Scavenging interrupt handlers (%d bytes) ...\n",
176            (int)sizeof(interrupt_handlers));
177 #endif
178     scavenge((lispobj *) data->interrupt_handlers,
179              sizeof(data->interrupt_handlers) / sizeof(lispobj));
180         
181     /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
182     control_stack_size = 
183         current_control_stack_pointer-
184         (lispobj *)th->control_stack_start;
185 #ifdef PRINTNOISE
186     printf("Scavenging the control stack at %p (%ld words) ...\n",
187            ((lispobj *)th->control_stack_start), 
188            control_stack_size);
189 #endif
190     scavenge(((lispobj *)th->control_stack_start), control_stack_size);
191                  
192
193     binding_stack_size = 
194         current_binding_stack_pointer - 
195         (lispobj *)th->binding_stack_start;
196 #ifdef PRINTNOISE
197     printf("Scavenging the binding stack %x - %x (%d words) ...\n",
198            th->binding_stack_start,current_binding_stack_pointer,
199            (int)(binding_stack_size));
200 #endif
201     scavenge(((lispobj *)th->binding_stack_start), binding_stack_size);
202                  
203     static_space_size = 
204         current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
205 #ifdef PRINTNOISE
206     printf("Scavenging static space %x - %x (%d words) ...\n",
207            STATIC_SPACE_START,current_static_space_free_pointer,
208            (int)(static_space_size));
209 #endif
210     scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
211
212     /* Scavenge newspace. */
213 #ifdef PRINTNOISE
214     printf("Scavenging new space (%d bytes) ...\n",
215            (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
216 #endif
217     scavenge_newspace();
218
219
220 #if defined(DEBUG_PRINT_GARBAGE)
221     print_garbage(from_space, from_space_free_pointer);
222 #endif
223
224     /* Scan the weak pointers. */
225 #ifdef PRINTNOISE
226     printf("Scanning weak pointers ...\n");
227 #endif
228     scan_weak_pointers();
229
230
231     /* Flip spaces. */
232 #ifdef PRINTNOISE
233     printf("Flipping spaces ...\n");
234 #endif
235
236     os_zero((os_vm_address_t) current_dynamic_space,
237             (os_vm_size_t) DYNAMIC_SPACE_SIZE);
238
239     current_dynamic_space = new_space;
240     dynamic_space_free_pointer = new_space_free_pointer;
241
242 #ifdef PRINTNOISE
243     size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
244     size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
245 #endif
246
247     /* Zero stack. */
248 #ifdef PRINTNOISE
249     printf("Zeroing empty part of control stack ...\n");
250 #endif
251     zero_stack();
252
253     sigprocmask(SIG_SETMASK, &old, 0);
254
255
256 #ifdef PRINTNOISE
257     gettimeofday(&stop_tv, (struct timezone *) 0);
258     getrusage(RUSAGE_SELF, &stop_rusage);
259
260     printf("done.]\n");
261         
262     percent_retained = (((float) size_retained) /
263                         ((float) size_discarded)) * 100.0;
264
265     printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
266            size_retained, size_discarded, percent_retained);
267
268     real_time = tv_diff(&stop_tv, &start_tv);
269     user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
270     system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
271
272 #if 0
273     printf("Statistics:\n");
274     printf("%10.2f sec of real time\n", real_time);
275     printf("%10.2f sec of user time,\n", user_time);
276     printf("%10.2f sec of system time.\n", system_time);
277 #else
278     printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
279            real_time, user_time, system_time);
280 #endif        
281
282     gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
283         
284     printf("%10.2f M bytes/sec collected.\n", gc_rate);
285 #endif
286     /* os_flush_icache((os_vm_address_t) 0, sizeof(unsigned long)); */
287     /* Maybe FIXME: it's possible that we could significantly reduce 
288      * RSS by zeroing the from_space or madvise(MADV_DONTNEED) or 
289      * similar os-dependent tricks here */
290 }
291
292 \f
293 /* scavenging */
294
295 static void
296 scavenge_newspace(void)
297 {
298     lispobj *here, *next;
299
300     here = new_space;
301     while (here < new_space_free_pointer) {
302         /*      printf("here=%lx, new_space_free_pointer=%lx\n",
303                 here,new_space_free_pointer); */
304         next = new_space_free_pointer;
305         scavenge(here, next - here);
306         here = next;
307     }
308     /* printf("done with newspace\n"); */
309 }
310 \f
311 /* scavenging interrupt contexts */
312
313 static int boxed_registers[] = BOXED_REGISTERS;
314
315 static void
316 scavenge_interrupt_context(os_context_t *context)
317 {
318     int i;
319 #ifdef reg_LIP
320     unsigned long lip;
321     unsigned long lip_offset;
322     int lip_register_pair;
323 #endif
324     unsigned long pc_code_offset;
325 #ifdef ARCH_HAS_LINK_REGISTER
326     unsigned long lr_code_offset;
327 #endif
328 #ifdef ARCH_HAS_NPC_REGISTER
329     unsigned long npc_code_offset;
330 #endif
331 #ifdef DEBUG_SCAVENGE_VERBOSE
332     fprintf(stderr, "Scavenging interrupt context at 0x%x\n",context);
333 #endif
334     /* Find the LIP's register pair and calculate its offset */
335     /* before we scavenge the context. */
336 #ifdef reg_LIP
337     lip = *os_context_register_addr(context, reg_LIP);
338     /*  0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
339     lip_offset = 0x7FFFFFFF;
340     lip_register_pair = -1;
341     for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
342         unsigned long reg;
343         long offset;
344         int index;
345
346         index = boxed_registers[i];
347         reg = *os_context_register_addr(context, index);
348         /* would be using PTR if not for integer length issues */
349         if ((reg & ~((1L<<N_LOWTAG_BITS)-1)) <= lip) {
350             offset = lip - reg;
351             if (offset < lip_offset) {
352                 lip_offset = offset;
353                 lip_register_pair = index;
354             }
355         }
356     }
357 #endif /* reg_LIP */
358
359     /* Compute the PC's offset from the start of the CODE */
360     /* register. */
361     pc_code_offset =
362         *os_context_pc_addr(context) - 
363         *os_context_register_addr(context, reg_CODE);
364 #ifdef ARCH_HAS_NPC_REGISTER
365     npc_code_offset =
366         *os_context_npc_addr(context) - 
367         *os_context_register_addr(context, reg_CODE);
368 #endif 
369 #ifdef ARCH_HAS_LINK_REGISTER
370     lr_code_offset =
371         *os_context_lr_addr(context) - 
372         *os_context_register_addr(context, reg_CODE);
373 #endif
374                
375     /* Scavenge all boxed registers in the context. */
376     for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
377         int index;
378         lispobj foo;
379                 
380         index = boxed_registers[i];
381         foo = *os_context_register_addr(context,index);
382         scavenge((lispobj *) &foo, 1);
383         *os_context_register_addr(context,index) = foo;
384
385         /* this is unlikely to work as intended on bigendian
386          * 64 bit platforms */
387
388         scavenge((lispobj *)
389                  os_context_register_addr(context, index), 1);
390     }
391
392 #ifdef reg_LIP
393     /* Fix the LIP */
394     *os_context_register_addr(context, reg_LIP) =
395         *os_context_register_addr(context, lip_register_pair) + lip_offset;
396 #endif /* reg_LIP */
397         
398     /* Fix the PC if it was in from space */
399     if (from_space_p(*os_context_pc_addr(context)))
400         *os_context_pc_addr(context) = 
401             *os_context_register_addr(context, reg_CODE) + pc_code_offset;
402 #ifdef ARCH_HAS_LINK_REGISTER
403     /* Fix the LR ditto; important if we're being called from 
404      * an assembly routine that expects to return using blr, otherwise
405      * harmless */
406     if (from_space_p(*os_context_lr_addr(context)))
407         *os_context_lr_addr(context) = 
408             *os_context_register_addr(context, reg_CODE) + lr_code_offset;
409 #endif
410
411 #ifdef ARCH_HAS_NPC_REGISTER
412     if (from_space_p(*os_context_npc_addr(context)))
413         *os_context_npc_addr(context) = 
414             *os_context_register_addr(context, reg_CODE) + npc_code_offset;
415 #endif
416 }
417
418 void scavenge_interrupt_contexts(void)
419 {
420     int i, index;
421     os_context_t *context;
422
423     struct thread *th=arch_os_get_current_thread();
424     struct interrupt_data *data=
425         th ? th->interrupt_data : global_interrupt_data;
426
427     index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,0));
428
429
430 #ifdef DEBUG_SCAVENGE_VERBOSE
431     fprintf(stderr, "%d interrupt contexts to scan\n",index);
432 #endif
433     for (i = 0; i < index; i++) {
434         context = th->interrupt_contexts[i];
435         scavenge_interrupt_context(context); 
436     }
437 }
438
439 \f
440 /* debugging code */
441
442 void
443 print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
444 {
445     lispobj *start;
446     int total_words_not_copied;
447
448     printf("Scanning from space ...\n");
449
450     total_words_not_copied = 0;
451     start = from_space;
452     while (start < from_space_free_pointer) {
453         lispobj object;
454         int forwardp, type, nwords;
455         lispobj header;
456
457         object = *start;
458         forwardp = is_lisp_pointer(object) && new_space_p(object);
459
460         if (forwardp) {
461             int tag;
462             lispobj *pointer;
463
464             tag = lowtag_of(object);
465
466             switch (tag) {
467             case LIST_POINTER_LOWTAG:
468                 nwords = 2;
469                 break;
470             case INSTANCE_POINTER_LOWTAG:
471                 printf("Don't know about instances yet!\n");
472                 nwords = 1;
473                 break;
474             case FUN_POINTER_LOWTAG:
475                 nwords = 1;
476                 break;
477             case OTHER_POINTER_LOWTAG:
478                 pointer = (lispobj *) native_pointer(object);
479                 header = *pointer;
480                 type = widetag_of(header);
481                 nwords = (sizetab[type])(pointer);
482                 break;
483             default: nwords=1;  /* shut yer whinging, gcc */
484             }
485         } else {
486             type = widetag_of(object);
487             nwords = (sizetab[type])(start);
488             total_words_not_copied += nwords;
489             printf("%4d words not copied at 0x%16lx; ",
490                    nwords, (unsigned long) start);
491             printf("Header word is 0x%08x\n", 
492                    (unsigned int) object);
493         }
494         start += nwords;
495     }
496     printf("%d total words not copied.\n", total_words_not_copied);
497 }
498
499 \f
500 /* code and code-related objects */
501
502 /* FIXME (1) this could probably be defined using something like
503  *  sizeof(lispobj)*floor(sizeof(struct simple_fun)/sizeof(lispobj))
504  *    -  FUN_POINTER_LOWTAG
505  * as I'm reasonably sure that simple_fun->code must always be the 
506  * last slot in the object 
507
508  * FIXME (2) it also appears in purify.c, and it has a different value
509  * for SPARC users in that bit
510  */
511
512 #define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
513
514 /* Note: on the sparc we don't have to do anything special for fdefns, */
515 /* 'cause the raw-addr has a function lowtag. */
516 #ifndef LISP_FEATURE_SPARC
517 static int
518 scav_fdefn(lispobj *where, lispobj object)
519 {
520     struct fdefn *fdefn;
521
522     fdefn = (struct fdefn *)where;
523     
524     if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) 
525         == (char *)((unsigned long)(fdefn->raw_addr))) {
526         scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
527         fdefn->raw_addr =
528             (u32)  ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
529         return sizeof(struct fdefn) / sizeof(lispobj);
530     }
531     else
532         return 1;
533 }
534 #endif
535
536
537 \f
538 /* vector-like objects */
539
540 /* #define NWORDS(x,y) (CEILING((x),(y)) / (y)) */
541
542 static int
543 scav_vector(lispobj *where, lispobj object)
544 {
545     if (HeaderValue(object) == subtype_VectorValidHashing) {
546         *where =
547             (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
548     }
549
550     return 1;
551 }
552
553 \f
554 /* weak pointers */
555
556 #define WEAK_POINTER_NWORDS \
557         CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
558
559 static int
560 scav_weak_pointer(lispobj *where, lispobj object)
561 {
562     /* Do not let GC scavenge the value slot of the weak pointer */
563     /* (that is why it is a weak pointer).  Note:  we could use */
564     /* the scav_unboxed method here. */
565
566     return WEAK_POINTER_NWORDS;
567 }
568
569 \f
570 /* initialization.  if gc_init can be moved to after core load, we could
571  * combine these two functions */
572
573 void
574 gc_init(void)
575 {
576     gc_init_tables();
577     scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
578     scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer;
579 }
580
581 void
582 gc_initialize_pointers(void)
583 {
584     /* FIXME: We do nothing here.  We (briefly) misguidedly attempted
585        to set current_dynamic_space to DYNAMIC_0_SPACE_START here,
586        forgetting that (a) actually it could be the other and (b) it's
587        set in coreparse.c anyway.  There's a FIXME note left here to
588        note that current_dynamic_space is a violation of OAOO: we can
589        tell which dynamic space we're currently in by looking at
590        dynamic_space_free_pointer.  -- CSR, 2002-08-09 */
591 }
592
593
594
595 \f
596 /* noise to manipulate the gc trigger stuff */
597
598 void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
599 {
600     os_vm_address_t addr=(os_vm_address_t)current_dynamic_space 
601         + dynamic_usage;
602         
603     long length = DYNAMIC_SPACE_SIZE - dynamic_usage;
604
605     if (addr < (os_vm_address_t)dynamic_space_free_pointer) {
606         fprintf(stderr,
607            "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
608                 (unsigned int)dynamic_usage,
609                 (os_vm_address_t)dynamic_space_free_pointer
610                 - (os_vm_address_t)current_dynamic_space);
611         lose("lost");
612     }
613     else if (length < 0) {
614         fprintf(stderr,
615                 "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
616                 dynamic_usage);
617         lose("lost");
618     }
619
620     addr=os_round_up_to_page(addr);
621     length=os_trunc_size_to_page(length);
622
623 #if defined(SUNOS) || defined(SOLARIS)
624     os_invalidate(addr,length);
625 #else
626     os_protect(addr, length, 0);
627 #endif
628
629     current_auto_gc_trigger = (lispobj *)addr;
630 }
631
632 void clear_auto_gc_trigger(void)
633 {
634     if (current_auto_gc_trigger!=NULL){
635 #if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
636         os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
637         os_vm_size_t length=
638             DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
639
640         os_validate(addr,length);
641 #else
642         os_protect((os_vm_address_t)current_dynamic_space,
643                    DYNAMIC_SPACE_SIZE,
644                    OS_VM_PROT_ALL);
645 #endif
646
647         current_auto_gc_trigger = NULL;
648     }
649 }