1 ;;;; miscellaneous kernel-level definitions
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
12 (in-package "SB!KERNEL")
17 (defun get-header-data (x)
19 "Return the 24 bits of data in the header of object X, which must be an
20 other-pointer object."
23 (defun set-header-data (x val)
25 "Sets the 24 bits of data in the header of object X (which must be an
26 other-pointer object) to VAL."
27 (set-header-data x val))
29 (defun get-closure-length (x)
31 "Returns the length of the closure X. This is one more than the number
32 of variables closed over."
33 (get-closure-length x))
37 "Returns the three-bit lowtag for the object X."
42 "Returns the 8-bit header type for the object X."
47 "Return a System-Area-Pointer pointing to the data for the vector X, which
49 (declare (type (simple-unboxed-array (*)) x))
52 (defun sb!c::binding-stack-pointer-sap ()
54 "Return a System-Area-Pointer pointing to the end of the binding stack."
55 (sb!c::binding-stack-pointer-sap))
57 (defun sb!c::dynamic-space-free-pointer ()
59 "Returns a System-Area-Pointer pointing to the next free work of the current
61 (sb!c::dynamic-space-free-pointer))
63 (defun sb!c::control-stack-pointer-sap ()
65 "Return a System-Area-Pointer pointing to the end of the control stack."
66 (sb!c::control-stack-pointer-sap))
68 (defun function-subtype (function)
70 "Return the header typecode for FUNCTION. Can be set with SETF."
71 (function-subtype function))
73 (defun (setf function-subtype) (type function)
74 (setf (function-subtype function) type))
76 (defun %function-arglist (func)
78 "Extracts the arglist from the function header FUNC."
79 (%function-arglist func))
81 (defun %function-name (func)
83 "Extracts the name from the function header FUNC."
84 (%function-name func))
86 (defun %function-type (func)
88 "Extracts the type from the function header FUNC."
89 (%function-type func))
91 (defun %closure-function (closure)
93 "Extracts the function from CLOSURE."
94 (%closure-function closure))
96 (defun sb!c::vector-length (vector)
98 "Return the length of VECTOR. There is no reason to use this, 'cause
99 (length (the vector foo)) is the same."
100 (sb!c::vector-length vector))
102 (defun %closure-index-ref (closure index)
104 "Extract the INDEXth slot from CLOSURE."
105 (%closure-index-ref closure index))
107 (defun allocate-vector (type length words)
109 "Allocate a unboxed, simple vector with type code TYPE, length LENGTH, and
110 WORDS words long. Note: it is your responsibility to ensure that the
111 relation between LENGTH and WORDS is correct."
112 (allocate-vector type length words))
114 (defun make-array-header (type rank)
116 "Allocate an array header with type code TYPE and rank RANK."
117 (make-array-header type rank))
119 (defun code-instructions (code-obj)
121 "Return a SAP pointing to the instructions part of CODE-OBJ."
122 (code-instructions code-obj))
124 (defun code-header-ref (code-obj index)
126 "Extract the INDEXth element from the header of CODE-OBJ. Can be set with
128 (code-header-ref code-obj index))
130 (defun code-header-set (code-obj index new)
131 (code-header-set code-obj index new))
133 (defun %raw-bits (object offset)
134 (declare (type index offset))
135 (sb!kernel:%raw-bits object offset))
137 (defun %set-raw-bits (object offset value)
138 (declare (type index offset) (type (unsigned-byte #.sb!vm:word-bits) value))
139 (setf (sb!kernel:%raw-bits object offset) value))
141 (defun make-single-float (x) (make-single-float x))
142 (defun make-double-float (hi lo) (make-double-float hi lo))
144 (defun make-long-float (exp hi #!+sparc mid lo)
145 (make-long-float exp hi #!+sparc mid lo))
146 (defun single-float-bits (x) (single-float-bits x))
147 (defun double-float-high-bits (x) (double-float-high-bits x))
148 (defun double-float-low-bits (x) (double-float-low-bits x))
150 (defun long-float-exp-bits (x) (long-float-exp-bits x))
152 (defun long-float-high-bits (x) (long-float-high-bits x))
153 #!+(and long-float sparc)
154 (defun long-float-mid-bits (x) (long-float-mid-bits x))
156 (defun long-float-low-bits (x) (long-float-low-bits x))