0.7.4.18: Fixing Alpha fixes
[sbcl.git] / src / runtime / purify.c
index 8581692..dc66cd2 100644 (file)
@@ -16,6 +16,7 @@
 #include <stdio.h>
 #include <sys/types.h>
 #include <stdlib.h>
+#include <strings.h>
 
 #include "runtime.h"
 #include "os.h"
@@ -97,11 +98,9 @@ static boolean
 dynamic_pointer_p(lispobj ptr)
 {
 #ifndef __i386__
-    /* KLUDGE: This has an implicit dependence on the ordering of
-     * address spaces, and is therefore basically wrong. I'd fix it,
-     * but I don't have a non-386 port to test it on. Porters are
-     * encouraged to fix it. -- WHN 2000-10-17 */
-    return (ptr >= (lispobj)DYNAMIC_SPACE_START);
+    return (ptr >= (lispobj)current_dynamic_space
+           &&
+           ptr < (lispobj)dynamic_space_free_pointer);
 #else
     /* Be more conservative, and remember, this is a maybe. */
     return (ptr >= (lispobj)DYNAMIC_SPACE_START
@@ -181,7 +180,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
            return 0;
        }
        /* Is it plausible cons? */
-       if((is_lisp_pointer(start_addr[0])
+       if ((is_lisp_pointer(start_addr[0])
            || ((start_addr[0] & 3) == 0) /* fixnum */
            || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
            || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
@@ -221,8 +220,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
            }
            return 0;
        }
-       /* Is it plausible?  Not a cons. X should check the headers. */
-       if(is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
+       /* Is it plausible? Not a cons. XXX should check the headers. */
+       if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
            if (pointer_filter_verbose) {
                fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer, 
                        (unsigned int) start_addr, *start_addr);
@@ -611,80 +610,82 @@ ptrans_vector(lispobj thing, int bits, int extra,
 static void
 apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
 {
-  int nheader_words, ncode_words, nwords;
-  void  *constants_start_addr, *constants_end_addr;
-  void  *code_start_addr, *code_end_addr;
-  lispobj fixups = NIL;
-  unsigned  displacement = (unsigned)new_code - (unsigned)old_code;
-  struct vector *fixups_vector;
-
-  ncode_words = fixnum_value(new_code->code_size);
-  nheader_words = HeaderValue(*(lispobj *)new_code);
-  nwords = ncode_words + nheader_words;
-
-  constants_start_addr = (void *)new_code + 5*4;
-  constants_end_addr = (void *)new_code + nheader_words*4;
-  code_start_addr = (void *)new_code + nheader_words*4;
-  code_end_addr = (void *)new_code + nwords*4;
-
-  /* The first constant should be a pointer to the fixups for this
-   * code objects. Check. */
-  fixups = new_code->constants[0];
-
-  /* It will be 0 or the unbound-marker if there are no fixups, and
-   * will be an other-pointer to a vector if it is valid. */
-  if ((fixups==0) ||
-      (fixups==UNBOUND_MARKER_WIDETAG) ||
-      !is_lisp_pointer(fixups)) {
+    int nheader_words, ncode_words, nwords;
+    void  *constants_start_addr, *constants_end_addr;
+    void  *code_start_addr, *code_end_addr;
+    lispobj fixups = NIL;
+    unsigned  displacement = (unsigned)new_code - (unsigned)old_code;
+    struct vector *fixups_vector;
+
+    ncode_words = fixnum_value(new_code->code_size);
+    nheader_words = HeaderValue(*(lispobj *)new_code);
+    nwords = ncode_words + nheader_words;
+
+    constants_start_addr = (void *)new_code + 5*4;
+    constants_end_addr = (void *)new_code + nheader_words*4;
+    code_start_addr = (void *)new_code + nheader_words*4;
+    code_end_addr = (void *)new_code + nwords*4;
+
+    /* The first constant should be a pointer to the fixups for this
+     * code objects. Check. */
+    fixups = new_code->constants[0];
+
+    /* It will be 0 or the unbound-marker if there are no fixups, and
+     * will be an other-pointer to a vector if it is valid. */
+    if ((fixups==0) ||
+       (fixups==UNBOUND_MARKER_WIDETAG) ||
+       !is_lisp_pointer(fixups)) {
 #ifdef GENCGC
-    /* Check for a possible errors. */
-    sniff_code_object(new_code,displacement);
+       /* Check for a possible errors. */
+       sniff_code_object(new_code,displacement);
 #endif
-    return;
-  }
+       return;
+    }
 
-  fixups_vector = (struct vector *)native_pointer(fixups);
+    fixups_vector = (struct vector *)native_pointer(fixups);
 
-  /* Could be pointing to a forwarding pointer. */
-  if (is_lisp_pointer(fixups) && (dynamic_pointer_p(fixups))
-      && forwarding_pointer_p(*(lispobj *)fixups_vector)) {
-    /* If so then follow it. */
-    fixups_vector = (struct vector *)native_pointer(*(lispobj *)fixups_vector);
-  }
+    /* Could be pointing to a forwarding pointer. */
+    if (is_lisp_pointer(fixups) && (dynamic_pointer_p(fixups))
+       && forwarding_pointer_p(*(lispobj *)fixups_vector)) {
+       /* If so then follow it. */
+       fixups_vector =
+           (struct vector *)native_pointer(*(lispobj *)fixups_vector);
+    }
 
-  if (widetag_of(fixups_vector->header) ==
-      SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
-    /* We got the fixups for the code block. Now work through the vector,
-     * and apply a fixup at each address. */
-    int length = fixnum_value(fixups_vector->length);
-    int i;
-    for (i=0; i<length; i++) {
-      unsigned offset = fixups_vector->data[i];
-      /* Now check the current value of offset. */
-      unsigned  old_value = *(unsigned *)((unsigned)code_start_addr + offset);
-
-      /* If it's within the old_code object then it must be an
-       * absolute fixup (relative ones are not saved) */
-      if ((old_value>=(unsigned)old_code)
-         && (old_value<((unsigned)old_code + nwords*4)))
-       /* So add the dispacement. */
-       *(unsigned *)((unsigned)code_start_addr + offset) = old_value
-         + displacement;
-      else
-       /* It is outside the old code object so it must be a relative
-        * fixup (absolute fixups are not saved). So subtract the
-        * displacement. */
-       *(unsigned *)((unsigned)code_start_addr + offset) = old_value
-         - displacement;
+    if (widetag_of(fixups_vector->header) ==
+       SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
+       /* We got the fixups for the code block. Now work through the
+        * vector, and apply a fixup at each address. */
+       int length = fixnum_value(fixups_vector->length);
+       int i;
+       for (i=0; i<length; i++) {
+           unsigned offset = fixups_vector->data[i];
+           /* Now check the current value of offset. */
+           unsigned old_value =
+               *(unsigned *)((unsigned)code_start_addr + offset);
+
+           /* If it's within the old_code object then it must be an
+            * absolute fixup (relative ones are not saved) */
+           if ((old_value>=(unsigned)old_code)
+               && (old_value<((unsigned)old_code + nwords*4)))
+               /* So add the dispacement. */
+               *(unsigned *)((unsigned)code_start_addr + offset) = old_value
+                   + displacement;
+           else
+               /* It is outside the old code object so it must be a relative
+                * fixup (absolute fixups are not saved). So subtract the
+                * displacement. */
+               *(unsigned *)((unsigned)code_start_addr + offset) = old_value
+                   - displacement;
+       }
     }
-  }
 
-  /* No longer need the fixups. */
-  new_code->constants[0] = 0;
+    /* No longer need the fixups. */
+    new_code->constants[0] = 0;
 
 #ifdef GENCGC
-  /* Check for possible errors. */
-  sniff_code_object(new_code,displacement);
+    /* Check for possible errors. */
+    sniff_code_object(new_code,displacement);
 #endif
 }
 #endif
@@ -726,7 +727,7 @@ ptrans_code(lispobj thing)
     /* Arrange to scavenge the debug info later. */
     pscav_later(&new->debug_info, 1);
 
-    if(new->trace_table_offset & 0x3)
+    if (new->trace_table_offset & 0x3)
 #if 0
       pscav(&new->trace_table_offset, 1, 0);
 #else