X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=81ffae4bd8de7777d23dead0c48ffb679eec72ad;hb=f7faed97898dd0e94a18b0d1fca03aaa0fe24ab0;hp=92457ebb5a72e9654ca3080ba9ab69a6b0ff1b7d;hpb=973114b3cc157ea00cc9a9352aba0c888172eb7a;p=sbcl.git

diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
index 92457eb..81ffae4 100644
--- a/src/runtime/gc-common.c
+++ b/src/runtime/gc-common.c
@@ -2415,30 +2415,29 @@ gc_search_space(lispobj *start, size_t words, lispobj *pointer)
  * of the enclosing object.
  */
 int
-looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
+looks_like_valid_lisp_pointer_p(lispobj pointer, lispobj *start_addr)
 {
-    if (!is_lisp_pointer((lispobj)pointer)) {
+    if (!is_lisp_pointer(pointer)) {
         return 0;
     }
 
     /* Check that the object pointed to is consistent with the pointer
      * low tag. */
-    switch (lowtag_of((lispobj)pointer)) {
+    switch (lowtag_of(pointer)) {
     case FUN_POINTER_LOWTAG:
         /* Start_addr should be the enclosing code object, or a closure
          * header. */
         switch (widetag_of(*start_addr)) {
         case CODE_HEADER_WIDETAG:
-          /* Make sure we actually point to a function in the code object,
-           * as opposed to a random point there. */
-          if (SIMPLE_FUN_HEADER_WIDETAG==widetag_of(*((lispobj *)(((unsigned long)pointer)-FUN_POINTER_LOWTAG))))
-            return 1;
-          else
-            return 0;
+            /* Make sure we actually point to a function in the code object,
+             * as opposed to a random point there. */
+            if (SIMPLE_FUN_HEADER_WIDETAG==widetag_of(native_pointer(pointer)[0]))
+                return 1;
+            else
+                return 0;
         case CLOSURE_HEADER_WIDETAG:
         case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
-            if ((unsigned long)pointer !=
-                ((unsigned long)start_addr+FUN_POINTER_LOWTAG)) {
+            if (pointer != make_lispobj(start_addr, FUN_POINTER_LOWTAG)) {
                 return 0;
             }
             break;
@@ -2447,8 +2446,7 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
         }
         break;
     case LIST_POINTER_LOWTAG:
-        if ((unsigned long)pointer !=
-            ((unsigned long)start_addr+LIST_POINTER_LOWTAG)) {
+        if (pointer != make_lispobj(start_addr, LIST_POINTER_LOWTAG)) {
             return 0;
         }
         /* Is it plausible cons? */
@@ -2461,8 +2459,7 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
             return 0;
         }
     case INSTANCE_POINTER_LOWTAG:
-        if ((unsigned long)pointer !=
-            ((unsigned long)start_addr+INSTANCE_POINTER_LOWTAG)) {
+        if (pointer != make_lispobj(start_addr, INSTANCE_POINTER_LOWTAG)) {
             return 0;
         }
         if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
@@ -2478,8 +2475,7 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
          * cannot be found by simply walking the heap, therefore we
          * need to check for it. -- AB, 2010-Jun-04 */
         if ((widetag_of(start_addr[0]) == CODE_HEADER_WIDETAG)) {
-            lispobj *potential_lra =
-                (lispobj *)(((unsigned long)pointer) - OTHER_POINTER_LOWTAG);
+            lispobj *potential_lra = native_pointer(pointer);
             if ((widetag_of(potential_lra[0]) == RETURN_PC_HEADER_WIDETAG) &&
                 ((potential_lra - HeaderValue(potential_lra[0])) == start_addr)) {
                 return 1; /* It's as good as we can verify. */
@@ -2487,8 +2483,7 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
         }
 #endif
 
-        if ((unsigned long)pointer !=
-            ((unsigned long)start_addr+OTHER_POINTER_LOWTAG)) {
+        if (pointer != make_lispobj(start_addr, OTHER_POINTER_LOWTAG)) {
             return 0;
         }
         /* Is it plausible?  Not a cons. XXX should check the headers. */
@@ -2633,7 +2628,7 @@ valid_lisp_pointer_p(lispobj *pointer)
     if (((start=search_dynamic_space(pointer))!=NULL) ||
         ((start=search_static_space(pointer))!=NULL) ||
         ((start=search_read_only_space(pointer))!=NULL))
-        return looks_like_valid_lisp_pointer_p(pointer, start);
+        return looks_like_valid_lisp_pointer_p((lispobj)pointer, start);
     else
         return 0;
 }
@@ -2745,12 +2740,13 @@ scrub_control_stack(void)
     struct thread *th = arch_os_get_current_thread();
     os_vm_address_t guard_page_address = CONTROL_STACK_GUARD_PAGE(th);
     os_vm_address_t hard_guard_page_address = CONTROL_STACK_HARD_GUARD_PAGE(th);
-    lispobj *sp;
 #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
-    sp = (lispobj *)&sp - 1;
+    /* On these targets scrubbing from C is a bad idea, so we punt to
+     * a routine in $ARCH-assem.S. */
+    extern void arch_scrub_control_stack(struct thread *, os_vm_address_t, os_vm_address_t);
+    arch_scrub_control_stack(th, guard_page_address, hard_guard_page_address);
 #else
-    sp = access_control_stack_pointer(th);
-#endif
+    lispobj *sp = access_control_stack_pointer(th);
  scrub:
     if ((((os_vm_address_t)sp < (hard_guard_page_address + os_vm_page_size)) &&
          ((os_vm_address_t)sp >= hard_guard_page_address)) ||
@@ -2779,6 +2775,7 @@ scrub_control_stack(void)
             goto scrub;
     } while (((unsigned long)++sp) & (BYTES_ZERO_BEFORE_END - 1));
 #endif
+#endif /* LISP_FEATURE_C_STACK_IS_CONTROL_STACK */
 }
 
 #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)