X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fkernel.lisp;h=1311ee316294c634c7bcf6879ae1e07e0e96c92d;hb=6ddaf294e5a7e3b1792ed1d9c342894c38538773;hp=7624d2cf2a064fbb674b26bd494136be2d341b4d;hpb=4eb1a6d3ad2b7dcc19ac0ec979a1eb1eb049659a;p=sbcl.git diff --git a/src/code/kernel.lisp b/src/code/kernel.lisp index 7624d2c..1311ee3 100644 --- a/src/code/kernel.lisp +++ b/src/code/kernel.lisp @@ -56,10 +56,10 @@ (sb!c::control-stack-pointer-sap)) ;;; Return the header typecode for FUNCTION. Can be set with SETF. -(defun function-subtype (function) - (function-subtype function)) -(defun (setf function-subtype) (type function) - (setf (function-subtype function) type)) +(defun fun-subtype (function) + (fun-subtype function)) +(defun (setf fun-subtype) (type function) + (setf (fun-subtype function) type)) ;;; Extract the arglist from the function header FUNC. (defun %simple-fun-arglist (func) @@ -120,22 +120,22 @@ (defun %set-raw-bits (object offset value) (declare (type index offset)) - (declare (type (unsigned-byte #.sb!vm:n-word-bits) value)) + (declare (type sb!vm:word value)) (setf (sb!kernel:%raw-bits object offset) value)) +(defun %vector-raw-bits (object offset) + (declare (type index offset)) + (sb!kernel:%vector-raw-bits object offset)) + +(defun %set-vector-raw-bits (object offset value) + (declare (type index offset)) + (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)) +