0.8.3.76
[sbcl.git] / src / runtime / gencgc.c
index 17064ee..5ca100a 100644 (file)
 /* assembly language stub that executes trap_PendingInterrupt */
 void do_pending_interrupt(void);
 
+/* forward declarations */
+int gc_find_freeish_pages(int *restart_page_ptr, int nbytes, int unboxed, struct alloc_region *alloc_region);
+void  gc_set_region_empty(struct alloc_region *region);
+void gc_alloc_update_all_page_tables(void);
+static void  gencgc_pickup_dynamic(void);
+boolean interrupt_maybe_gc_int(int, siginfo_t *, void *);
+
 \f
 /*
  * GC parameters
@@ -129,7 +136,8 @@ boolean gencgc_zero_check_during_free_heap = 0;
 
 /* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */
 unsigned long bytes_allocated = 0;
-static unsigned long auto_gc_trigger = 0;
+extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
+unsigned long auto_gc_trigger = 0;
 
 /* the source and destination generations. These are set before a GC starts
  * scavenging. */
@@ -336,6 +344,8 @@ gen_av_mem_age(int gen)
        / ((double)generations[gen].bytes_allocated);
 }
 
+void fpu_save(int *);          /* defined in x86-assem.S */
+void fpu_restore(int *);       /* defined in x86-assem.S */
 /* The verbose argument controls how much to print: 0 for normal
  * level of detail; 1 for debugging. */
 static void
@@ -505,7 +515,7 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
     gc_assert((alloc_region->first_page == 0)
              && (alloc_region->last_page == -1)
              && (alloc_region->free_pointer == alloc_region->end_addr));
-    get_spinlock(&free_pages_lock,alloc_region);
+    get_spinlock(&free_pages_lock,(int) alloc_region);
     if (unboxed) {
        first_page =
            generations[gc_alloc_generation].alloc_unboxed_start_page;
@@ -567,7 +577,7 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
                       (lispobj)(((char *)heap_base) + last_free_page*4096),
                       0);
     }
-    free_pages_lock=0;
+    release_spinlock(&free_pages_lock);
     
     /* we can do this after releasing free_pages_lock */
     if (gencgc_zero_check) {
@@ -709,7 +719,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
 
     next_page = first_page+1;
 
-    get_spinlock(&free_pages_lock,alloc_region);
+    get_spinlock(&free_pages_lock,(int) alloc_region);
     if (alloc_region->free_pointer != alloc_region->start_addr) {
        /* some bytes were allocated in the region */
        orig_first_page_bytes_used = page_table[first_page].bytes_used;
@@ -813,7 +823,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
        page_table[next_page].allocated = FREE_PAGE;
        next_page++;
     }
-    free_pages_lock=0;
+    release_spinlock(&free_pages_lock);
     /* alloc_region is per-thread, we're ok to do this unlocked */
     gc_set_region_empty(alloc_region);
 }
@@ -856,7 +866,7 @@ gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
        index ahead of the current region and bumped up here to save a
        lot of re-scanning. */
 
-    get_spinlock(&free_pages_lock,alloc_region);
+    get_spinlock(&free_pages_lock,(int) alloc_region);
 
     if (unboxed) {
        first_page =
@@ -956,7 +966,7 @@ gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
        SetSymbolValue(ALLOCATION_POINTER,
                       (lispobj)(((char *)heap_base) + last_free_page*4096),0);
     }
-    free_pages_lock=0;
+    release_spinlock(&free_pages_lock);
 
     return((void *)(page_address(first_page)+orig_first_page_bytes_used));
 }
@@ -2146,7 +2156,8 @@ search_dynamic_space(lispobj *pointer)
 
 /* Is there any possibility that pointer is a valid Lisp object
  * reference, and/or something else (e.g. subroutine call return
- * address) which should prevent us from moving the referred-to thing? */
+ * address) which should prevent us from moving the referred-to thing?
+ * This is called from preserve_pointers() */
 static int
 possibly_valid_dynamic_space_pointer(lispobj *pointer)
 {
@@ -2173,23 +2184,6 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
 
     /* Check that the object pointed to is consistent with the pointer
      * low tag.
-     *
-     * FIXME: It's not safe to rely on the result from this check
-     * before an object is initialized. Thus, if we were interrupted
-     * just as an object had been allocated but not initialized, the
-     * GC relying on this result could bogusly reclaim the memory.
-     * However, we can't really afford to do without this check. So
-     * we should make it safe somehow. 
-     *   (1) Perhaps just review the code to make sure
-     *       that WITHOUT-GCING or WITHOUT-INTERRUPTS or some such
-     *       thing is wrapped around critical sections where allocated
-     *       memory type bits haven't been set.
-     *   (2) Perhaps find some other hack to protect against this, e.g.
-     *       recording the result of the last call to allocate-lisp-memory,
-     *       and returning true from this function when *pointer is
-     *       a reference to that result. 
-     *
-     * (surely pseudo-atomic is supposed to be used for exactly this?)
      */
     switch (lowtag_of((lispobj)pointer)) {
     case FUN_POINTER_LOWTAG:
@@ -2317,7 +2311,8 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
        case COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
        case SIMPLE_ARRAY_WIDETAG:
-       case COMPLEX_STRING_WIDETAG:
+       case COMPLEX_BASE_STRING_WIDETAG:
+       case COMPLEX_VECTOR_NIL_WIDETAG:
        case COMPLEX_BIT_VECTOR_WIDETAG:
        case COMPLEX_VECTOR_WIDETAG:
        case COMPLEX_ARRAY_WIDETAG:
@@ -2331,13 +2326,17 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer)
 #ifdef LONG_FLOAT_WIDETAG
        case LONG_FLOAT_WIDETAG:
 #endif
-       case SIMPLE_STRING_WIDETAG:
+       case SIMPLE_BASE_STRING_WIDETAG:
        case SIMPLE_BIT_VECTOR_WIDETAG:
        case SIMPLE_ARRAY_NIL_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+       case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
        case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
        case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
@@ -2415,13 +2414,17 @@ maybe_adjust_large_object(lispobj *where)
        boxed = BOXED_PAGE;
        break;
     case BIGNUM_WIDETAG:
-    case SIMPLE_STRING_WIDETAG:
+    case SIMPLE_BASE_STRING_WIDETAG:
     case SIMPLE_BIT_VECTOR_WIDETAG:
     case SIMPLE_ARRAY_NIL_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+    case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
     case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
     case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
@@ -2587,7 +2590,7 @@ preserve_pointer(void *addr)
      * (or, as a special case which also requires dont_move, a return
      * address referring to something in a CodeObject). This is
      * expensive but important, since it vastly reduces the
-     * probability that random garbage will be bogusly interpreter as
+     * probability that random garbage will be bogusly interpreted as
      * a pointer which prevents a page from moving. */
     if (!(possibly_valid_dynamic_space_pointer(addr)))
        return;
@@ -2695,8 +2698,9 @@ update_page_write_prot(int page)
     gc_assert(page_table[page].allocated != FREE_PAGE);
     gc_assert(page_table[page].bytes_used != 0);
 
-    /* Skip if it's already write-protected or an unboxed page. */
+    /* Skip if it's already write-protected, pinned, or unboxed */
     if (page_table[page].write_protected
+       || page_table[page].dont_move
        || (page_table[page].allocated & UNBOXED_PAGE))
        return (0);
 
@@ -3322,7 +3326,8 @@ verify_space(lispobj *start, size_t words)
                case RATIO_WIDETAG:
                case COMPLEX_WIDETAG:
                case SIMPLE_ARRAY_WIDETAG:
-               case COMPLEX_STRING_WIDETAG:
+               case COMPLEX_BASE_STRING_WIDETAG:
+               case COMPLEX_VECTOR_NIL_WIDETAG:
                case COMPLEX_BIT_VECTOR_WIDETAG:
                case COMPLEX_VECTOR_WIDETAG:
                case COMPLEX_ARRAY_WIDETAG:
@@ -3407,13 +3412,17 @@ verify_space(lispobj *start, size_t words)
 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
                case COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
-               case SIMPLE_STRING_WIDETAG:
+               case SIMPLE_BASE_STRING_WIDETAG:
                case SIMPLE_BIT_VECTOR_WIDETAG:
                case SIMPLE_ARRAY_NIL_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
+               case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
                case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
                case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
@@ -3587,6 +3596,7 @@ write_protect_generation_pages(int generation)
     for (i = 0; i < last_free_page; i++)
        if ((page_table[i].allocated == BOXED_PAGE)
            && (page_table[i].bytes_used != 0)
+           && !page_table[i].dont_move
            && (page_table[i].gen == generation))  {
            void *page_start;
 
@@ -3650,7 +3660,8 @@ garbage_collect_generation(int generation, int raise)
     /* Before any pointers are preserved, the dont_move flags on the
      * pages need to be cleared. */
     for (i = 0; i < last_free_page; i++)
-       page_table[i].dont_move = 0;
+       if(page_table[i].gen==from_space)
+           page_table[i].dont_move = 0;
 
     /* Un-write-protect the old-space pages. This is essential for the
      * promoted pages as they may contain pointers into the old-space
@@ -3662,30 +3673,27 @@ garbage_collect_generation(int generation, int raise)
     /* Scavenge the stacks' conservative roots. */
     for_each_thread(th) {
        void **ptr;
+       void **esp= (void **) &raise;
+       int i=0,free;
 #ifdef LISP_FEATURE_SB_THREAD
-       struct user_regs_struct regs;
-       if(ptrace(PTRACE_GETREGS,th->pid,0,&regs)){
-           /* probably doesn't exist any more. */
-           fprintf(stderr,"child pid %d, %s\n",th->pid,strerror(errno));
-           perror("PTRACE_GETREGS");
+       if(th!=arch_os_get_current_thread()) {
+           os_context_t *last_context=get_interrupt_context_for_thread(th);
+           esp = (void **)*os_context_register_addr(last_context,reg_ESP);
        }
-       preserve_pointer(regs.ebx);
-       preserve_pointer(regs.ecx);
-       preserve_pointer(regs.edx);
-       preserve_pointer(regs.esi);
-       preserve_pointer(regs.edi);
-       preserve_pointer(regs.ebp);
-       preserve_pointer(regs.eax);
-#endif
-       for (ptr = th->control_stack_end;
-#ifdef LISP_FEATURE_SB_THREAD
-            ptr > regs.esp;
-#else
-            ptr > (void **)&raise;
 #endif
-            ptr--) {
+       for (ptr = (void **)th->control_stack_end; ptr > esp;  ptr--) {
            preserve_pointer(*ptr);
        }
+       /* also need to check registers in any interrupt contexts on
+        * an alternate signal stack */
+       free=fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th));
+       for(i=0;i<free;i++){
+           os_context_t *c=th->interrupt_contexts[i];
+           if(c>=th->control_stack_end && c<esp) continue;
+           for(ptr = (void **)(c+1); ptr>=(void **)c; ptr--) {
+               preserve_pointer(*ptr);
+           }
+       }
     }
 
 #if QSHOW
@@ -3984,7 +3992,10 @@ collect_garbage(unsigned last_gen)
     gc_alloc_generation = 0;
 
     update_x86_dynamic_space_free_pointer();
-
+    auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
+    if(gencgc_verbose)
+       fprintf(stderr,"Next gc when %ld bytes have been consed\n",
+               auto_gc_trigger);
     SHOW("returning from collect_garbage");
 }
 
@@ -4165,7 +4176,6 @@ gc_initialize_pointers(void)
 
 \f
 
-extern boolean maybe_gc_pending ;
 /* alloc(..) is the external interface for memory allocation. It
  * allocates to generation 0. It is not called from within the garbage
  * collector as it is only external uses that need the check for heap
@@ -4202,7 +4212,7 @@ alloc(int nbytes)
            __asm__("movl %fs,%0" : "=r" (fs)  : );
            fprintf(stderr, "fs is %x, th->tls_cookie=%x (should be identical)\n",
                    debug_get_fs(),th->tls_cookie);
-           lose("If you see this message before 2003.05.01, mail details to sbcl-devel\n");
+           lose("If you see this message before 2003.12.01, mail details to sbcl-devel\n");
        }
 #else
     gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC,th));
@@ -4220,33 +4230,16 @@ alloc(int nbytes)
      * we should GC in the near future
      */
     if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) {
-       auto_gc_trigger *= 2;
        /* set things up so that GC happens when we finish the PA
         * section.  */
-       maybe_gc_pending=1;
-       SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1),th);
+       struct interrupt_data *data=th->interrupt_data;
+       maybe_defer_handler(interrupt_maybe_gc_int,data,0,0,0);
     }
     new_obj = gc_alloc_with_region(nbytes,0,region,0);
     return (new_obj);
 }
 
 \f
-/*
- * noise to manipulate the gc trigger stuff
- */
-
-void
-set_auto_gc_trigger(os_vm_size_t dynamic_usage)
-{
-    auto_gc_trigger += dynamic_usage;
-}
-
-void
-clear_auto_gc_trigger(void)
-{
-    auto_gc_trigger = 0;
-}
-\f
 /* Find the code object for the given pc, or return NULL on failure.
  *
  * FIXME: PC shouldn't be lispobj*, should it? Maybe void*? */
@@ -4321,10 +4314,9 @@ gencgc_handle_wp_violation(void* fault_addr)
             */
            if(page_table[page_index].write_protected_cleared != 1) 
                lose("fault in heap page not marked as write-protected");
-           
-           /* Don't worry, we can handle it. */
-           return 1;
        }
+       /* Don't worry, we can handle it. */
+       return 1;
     }
 }
 /* This is to be called when we catch a SIGSEGV/SIGBUS, determine that
@@ -4335,7 +4327,7 @@ void
 unhandled_sigmemoryfault()
 {}
 
-gc_alloc_update_all_page_tables(void)
+void gc_alloc_update_all_page_tables(void)
 {
     /* Flush the alloc regions updating the tables. */
     struct thread *th;