(defun widetag-of (x)
(widetag-of x))
+;;; WIDETAG-OF needs extra code to handle LIST and FUNCTION lowtags. When
+;;; we're only dealing with other pointers (eg. when dispatching on array
+;;; element type), this is going to be faster.
+(declaim (inline %other-pointer-widetag))
+(defun %other-pointer-widetag (x)
+ (sb!sys:sap-ref-8 (int-sap (get-lisp-obj-address x))
+ #.(ecase sb!c:*backend-byte-order*
+ (:little-endian
+ (- sb!vm:other-pointer-lowtag))
+ (:big-endian
+ (- (1- sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag)))))
+
;;; Return a System-Area-Pointer pointing to the data for the vector
;;; X, which must be simple.
;;;
(defun %simple-fun-arglist (func)
(%simple-fun-arglist func))
+(defun (setf %simple-fun-arglist) (new-value func)
+ (setf (%simple-fun-arglist func) new-value))
+
;;; Extract the name from the function header FUNC.
(defun %simple-fun-name (func)
(%simple-fun-name func))
(defun code-header-set (code-obj index new)
(code-header-set code-obj index new))
-(defun %raw-bits (object offset)
+(defun %vector-raw-bits (object offset)
(declare (type index offset))
- (sb!kernel:%raw-bits object offset))
+ (sb!kernel:%vector-raw-bits object offset))
-(defun %set-raw-bits (object offset value)
+(defun %set-vector-raw-bits (object offset value)
(declare (type index offset))
- (declare (type (unsigned-byte #.sb!vm:n-word-bits) value))
- (setf (sb!kernel:%raw-bits object offset) value))
+ (declare (type sb!vm:word value))
+ (setf (sb!kernel:%vector-raw-bits object offset) value))
(defun make-single-float (x) (make-single-float x))
(defun make-double-float (hi lo) (make-double-float hi lo))
-#!+long-float
-(defun make-long-float (exp hi #!+sparc mid lo)
- (make-long-float exp hi #!+sparc mid lo))
+
(defun single-float-bits (x) (single-float-bits x))
(defun double-float-high-bits (x) (double-float-high-bits x))
(defun double-float-low-bits (x) (double-float-low-bits x))
-#!+long-float
-(defun long-float-exp-bits (x) (long-float-exp-bits x))
-#!+long-float
-(defun long-float-high-bits (x) (long-float-high-bits x))
-#!+(and long-float sparc)
-(defun long-float-mid-bits (x) (long-float-mid-bits x))
-#!+long-float
-(defun long-float-low-bits (x) (long-float-low-bits x))
+