(sb!alien:define-alien-routine component-ptr-from-pc (system-area-pointer)
(pc system-area-pointer))
-#!+gencgc (declaim (inline valid-lisp-pointer-p))
-#!+gencgc
+(declaim (inline valid-lisp-pointer-p))
(sb!alien:define-alien-routine valid-lisp-pointer-p sb!alien:int
(pointer system-area-pointer))
;;; (Such values can arise in registers on machines with conservative
;;; GC, and might also arise in debug variable locations when
;;; those variables are invalid.)
+;;;
+;;; NOTE: this function is not GC-safe in the slightest when creating
+;;; a pointer to an object in dynamic space. If a GC occurs between
+;;; the start of the call to VALID-LISP-POINTER-P and the end of
+;;; %MAKE-LISP-OBJ then the object could move before the boxed pointer
+;;; is constructed. This can happen on CHENEYGC if an asynchronous
+;;; interrupt occurs within the window. This can happen on GENCGC
+;;; under the same circumstances, but is more likely due to all GENCGC
+;;; platforms supporting threaded operation. This is somewhat
+;;; mitigated on x86oids due to the conservative stack and interrupt
+;;; context "scavenging" on such platforms, but there still may be a
+;;; vulnerable window.
(defun make-lisp-obj (val &optional (errorp t))
(if (or
;; fixnum
;; unbound marker
(= val sb!vm:unbound-marker-widetag)
;; pointer
- #!+gencgc
- (not (zerop (valid-lisp-pointer-p (int-sap val))))
- ;; FIXME: There is no fundamental reason not to use the above
- ;; function on other platforms as well, but I didn't have
- ;; others available while doing this. --NS 2007-06-21
- #!-gencgc
- (and (logbitp 0 val)
- (or (< sb!vm:read-only-space-start val
- (ash sb!vm:*read-only-space-free-pointer*
- sb!vm:n-fixnum-tag-bits))
- (< sb!vm:static-space-start val
- (ash sb!vm:*static-space-free-pointer*
- sb!vm:n-fixnum-tag-bits))
- (< (current-dynamic-space-start) val
- (sap-int (dynamic-space-free-pointer))))))
+ (not (zerop (valid-lisp-pointer-p (int-sap val)))))
(values (%make-lisp-obj val) t)
(if errorp
(error "~S is not a valid argument to ~S"