0.8.3.78:
[sbcl.git] / src / runtime / purify.c
index 331f03b..15f54eb 100644 (file)
 #include <sys/types.h>
 #include <stdlib.h>
 #include <strings.h>
+#if (defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_LINUX))
 #include <sys/ptrace.h>
 #include <linux/user.h>
+#endif
 #include <errno.h>
 
 #include "runtime.h"
 
 #define PRINTNOISE
 
-#if defined(__i386__)
+#if defined(LISP_FEATURE_X86)
 /* again, what's so special about the x86 that this is differently
  * visible there than on other platforms? -dan 20010125 
  */
 static lispobj *dynamic_space_free_pointer;
 #endif
+extern unsigned long bytes_consed_between_gcs;
 
 #define gc_abort() \
   lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__)
@@ -102,7 +105,7 @@ forwarding_pointer_p(lispobj obj)
 static boolean
 dynamic_pointer_p(lispobj ptr)
 {
-#ifndef __i386__
+#ifndef LISP_FEATURE_X86
     return (ptr >= (lispobj)current_dynamic_space
            &&
            ptr < (lispobj)dynamic_space_free_pointer);
@@ -115,7 +118,7 @@ dynamic_pointer_p(lispobj ptr)
 }
 
 \f
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
 
 #ifdef LISP_FEATURE_GENCGC
 /*
@@ -130,17 +133,11 @@ dynamic_pointer_p(lispobj ptr)
 
 static unsigned pointer_filter_verbose = 0;
 
-/* FIXME: This is substantially the same code as in gencgc.c. (There
- * are some differences, at least (1) the gencgc.c code needs to worry
- * about return addresses on the stack pinning code objects, (2) the
- * gencgc.c code needs to worry about the GC maybe happening in an
- * interrupt service routine when the main thread of control was
- * interrupted just as it had allocated memory and before it
- * initialized it, while PURIFY needn't worry about that, and (3) the
- * gencgc.c code has mutated more under maintenance since the fork
- * from CMU CL than the code here has.) The two versions should be
- * made to explicitly share common code, instead of just two different
- * cut-and-pasted versions. */
+/* FIXME: This is substantially the same code as
+ * possibly_valid_dynamic_space_pointer in gencgc.c.  The only
+ * relevant difference seems to be that the gencgc code also checks
+ * for raw pointers into Code objects */
+
 static int
 valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
 {
@@ -272,7 +269,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
        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:
@@ -286,12 +284,17 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
 #ifdef LONG_FLOAT_WIDETAG
        case LONG_FLOAT_WIDETAG:
 #endif
-       case SIMPLE_STRING_WIDETAG:
+       case SIMPLE_ARRAY_NIL_WIDETAG:
+       case SIMPLE_BASE_STRING_WIDETAG:
        case SIMPLE_BIT_VECTOR_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:
@@ -616,7 +619,7 @@ ptrans_vector(lispobj thing, int bits, int extra,
     return result;
 }
 
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
 static void
 apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
 {
@@ -755,13 +758,13 @@ ptrans_code(lispobj thing)
         gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
         gc_assert(!dynamic_pointer_p(func));
 
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
        /* Temporarly convert the self pointer to a real function pointer. */
        ((struct simple_fun *)native_pointer(func))->self
            -= FUN_RAW_ADDR_OFFSET;
 #endif
         pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
        ((struct simple_fun *)native_pointer(func))->self
            += FUN_RAW_ADDR_OFFSET;
 #endif
@@ -903,6 +906,7 @@ static lispobj
 ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
 {
     switch (widetag_of(header)) {
+       /* FIXME: this needs a reindent */
       case BIGNUM_WIDETAG:
       case SINGLE_FLOAT_WIDETAG:
       case DOUBLE_FLOAT_WIDETAG:
@@ -919,12 +923,14 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
       case COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
       case SAP_WIDETAG:
-        return ptrans_unboxed(thing, header);
+         return ptrans_unboxed(thing, header);
 
       case RATIO_WIDETAG:
       case COMPLEX_WIDETAG:
       case SIMPLE_ARRAY_WIDETAG:
-      case COMPLEX_STRING_WIDETAG:
+      case COMPLEX_BASE_STRING_WIDETAG:
+      case COMPLEX_BIT_VECTOR_WIDETAG:
+      case COMPLEX_VECTOR_NIL_WIDETAG:
       case COMPLEX_VECTOR_WIDETAG:
       case COMPLEX_ARRAY_WIDETAG:
         return ptrans_boxed(thing, header, constant);
@@ -936,7 +942,10 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
       case SYMBOL_HEADER_WIDETAG:
         return ptrans_boxed(thing, header, 0);
 
-      case SIMPLE_STRING_WIDETAG:
+      case SIMPLE_ARRAY_NIL_WIDETAG:
+        return ptrans_vector(thing, 0, 0, 0, constant);
+
+      case SIMPLE_BASE_STRING_WIDETAG:
         return ptrans_vector(thing, 8, 1, 0, constant);
 
       case SIMPLE_BIT_VECTOR_WIDETAG:
@@ -954,21 +963,25 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
       case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
 #endif
         return ptrans_vector(thing, 8, 0, 0, constant);
 
       case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
 #endif
         return ptrans_vector(thing, 16, 0, 0, constant);
 
       case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
 #endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
       case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
+      case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
 #endif
         return ptrans_vector(thing, 32, 0, 0, constant);
 
@@ -980,7 +993,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
 
 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
       case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
         return ptrans_vector(thing, 96, 0, 0, constant);
 #endif
 #ifdef sparc
@@ -1000,7 +1013,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
 
 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
       case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
         return ptrans_vector(thing, 192, 0, 0, constant);
 #endif
 #ifdef sparc
@@ -1037,7 +1050,7 @@ pscav_fdefn(struct fdefn *fdefn)
     return sizeof(struct fdefn) / sizeof(lispobj);
 }
 
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
 /* now putting code objects in static space */
 static int
 pscav_code(struct code*code)
@@ -1060,14 +1073,14 @@ pscav_code(struct code*code)
         gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
         gc_assert(!dynamic_pointer_p(func));
 
-#ifdef __i386__
-       /* Temporarly convert the self pointer to a real function
+#ifdef LISP_FEATURE_X86
+       /* Temporarily convert the self pointer to a real function
         * pointer. */
        ((struct simple_fun *)native_pointer(func))->self
            -= FUN_RAW_ADDR_OFFSET;
 #endif
         pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
        ((struct simple_fun *)native_pointer(func))->self
            += FUN_RAW_ADDR_OFFSET;
 #endif
@@ -1147,7 +1160,11 @@ pscav(lispobj *addr, int nwords, boolean constant)
                 count = 1;
                 break;
 
-              case SIMPLE_STRING_WIDETAG:
+             case SIMPLE_ARRAY_NIL_WIDETAG:
+               count = 2;
+               break;
+
+              case SIMPLE_BASE_STRING_WIDETAG:
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2);
                 break;
@@ -1170,6 +1187,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
               case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
+              case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
 #endif
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
@@ -1178,6 +1196,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
               case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
+              case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
 #endif
                 vector = (struct vector *)addr;
                 count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
@@ -1186,9 +1205,11 @@ pscav(lispobj *addr, int nwords, boolean constant)
               case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
+             case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
 #endif
 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
               case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
+              case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
 #endif
                 vector = (struct vector *)addr;
                 count = CEILING(fixnum_value(vector->length)+2,2);
@@ -1210,7 +1231,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
               case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
                 vector = (struct vector *)addr;
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
                 count = fixnum_value(vector->length)*3+2;
 #endif
 #ifdef sparc
@@ -1229,7 +1250,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
               case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
                 vector = (struct vector *)addr;
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
                 count = fixnum_value(vector->length)*6+2;
 #endif
 #ifdef sparc
@@ -1239,7 +1260,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
 #endif
 
               case CODE_HEADER_WIDETAG:
-#ifndef __i386__
+#ifndef LISP_FEATURE_X86
                 gc_abort(); /* no code headers in static space */
 #else
                count = pscav_code((struct code*)addr);
@@ -1254,7 +1275,7 @@ pscav(lispobj *addr, int nwords, boolean constant)
                 gc_abort();
                break;
 
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
              case CLOSURE_HEADER_WIDETAG:
              case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
                /* The function self pointer needs special care on the
@@ -1324,7 +1345,7 @@ purify(lispobj static_roots, lispobj read_only_roots)
         return 0;
     }
 
-#if defined(__i386__)
+#if defined(LISP_FEATURE_X86)
     dynamic_space_free_pointer =
       (lispobj*)SymbolValue(ALLOCATION_POINTER,0);
 #endif
@@ -1339,11 +1360,12 @@ purify(lispobj static_roots, lispobj read_only_roots)
     fflush(stdout);
 #endif
 
+#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
 #if 0
-    /* can't do this unless the threads in question are suspended with
-     * ptrace
+    /* This is what we should do, but can't unless the threads in
+     * question are suspended with ptrace.  That's right, purify is not
+     * threadsafe
      */
-#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
     for_each_thread(thread) {
        void **ptr;
        struct user_regs_struct regs;
@@ -1354,11 +1376,11 @@ purify(lispobj static_roots, lispobj read_only_roots)
        setup_i386_stack_scav(regs.ebp,
                              ((void *)thread->control_stack_end));
     }
-#endif
-#endif
+#endif /* 0 */
+    /* stopgap until we can set things up as in preceding comment */
     setup_i386_stack_scav(((&static_roots)-2),
                          ((void *)all_threads->control_stack_end));
-
+#endif
 
     pscav(&static_roots, 1, 0);
     pscav(&read_only_roots, 1, 1);
@@ -1376,9 +1398,10 @@ purify(lispobj static_roots, lispobj read_only_roots)
     printf(" stack");
     fflush(stdout);
 #endif
-#ifndef __i386__
-    pscav((lispobj *)CONTROL_STACK_START,
-         current_control_stack_pointer - (lispobj *)CONTROL_STACK_START,
+#ifndef LISP_FEATURE_X86
+    pscav((lispobj *)all_threads->control_stack_start,
+         current_control_stack_pointer - 
+         all_threads->control_stack_start,
          0);
 #else
 #ifdef LISP_FEATURE_GENCGC
@@ -1390,9 +1413,10 @@ purify(lispobj static_roots, lispobj read_only_roots)
     printf(" bindings");
     fflush(stdout);
 #endif
-#if !defined(__i386__)
-    pscav( (lispobj *)BINDING_STACK_START,
-         (lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
+#if !defined(LISP_FEATURE_X86)
+    pscav( (lispobj *)all_threads->binding_stack_start,
+         (lispobj *)current_binding_stack_pointer -
+          all_threads->binding_stack_start,
          0);
 #else
     for_each_thread(thread) {
@@ -1469,12 +1493,11 @@ purify(lispobj static_roots, lispobj read_only_roots)
 
     /* Zero the stack. Note that the stack is also zeroed by SUB-GC
      * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */
-#ifndef __i386__
+#ifndef LISP_FEATURE_X86
     os_zero((os_vm_address_t) current_control_stack_pointer,
-            (os_vm_size_t) (CONTROL_STACK_SIZE -
-                            ((current_control_stack_pointer -
-                             (lispobj *)CONTROL_STACK_START) *
-                             sizeof(lispobj))));
+            (os_vm_size_t)
+           ((all_threads->control_stack_end -
+             current_control_stack_pointer) * sizeof(lispobj)));
 #endif
 
     /* It helps to update the heap free pointers so that free_heap can
@@ -1482,8 +1505,9 @@ purify(lispobj static_roots, lispobj read_only_roots)
     SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
     SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
 
-#if !defined(__i386__)
+#if !defined(LISP_FEATURE_X86)
     dynamic_space_free_pointer = current_dynamic_space;
+    set_auto_gc_trigger(bytes_consed_between_gcs);
 #else
 #if defined LISP_FEATURE_GENCGC
     gc_free_heap();
@@ -1496,6 +1520,5 @@ purify(lispobj static_roots, lispobj read_only_roots)
     printf(" done]\n");
     fflush(stdout);
 #endif
-
     return 0;
 }