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")
14 ;;; Return the 24 bits of data in the header of object X, which must
15 ;;; be an other-pointer object.
16 (defun get-header-data (x)
19 ;;; Set the 24 bits of data in the header of object X (which must be
20 ;;; an other-pointer object) to VAL.
21 (defun set-header-data (x val)
22 (set-header-data x val))
24 ;;; Return the length of the closure X. This is one more than the
25 ;;; number of variables closed over.
26 (defun get-closure-length (x)
27 (get-closure-length x))
29 ;;; Return the three-bit lowtag for the object X.
33 ;;; Return the 8-bit header type for the object X.
37 ;;; Return a System-Area-Pointer pointing to the data for the vector
38 ;;; X, which must be simple.
40 ;;; FIXME: so it should be SIMPLE-VECTOR-SAP, right?
42 (declare (type (simple-unboxed-array (*)) x))
45 ;;; Return a System-Area-Pointer pointing to the end of the binding stack.
46 (defun sb!c::binding-stack-pointer-sap ()
47 (sb!c::binding-stack-pointer-sap))
49 ;;; Return a System-Area-Pointer pointing to the next free word of the
50 ;;; current dynamic space.
51 (defun sb!c::dynamic-space-free-pointer ()
52 (sb!c::dynamic-space-free-pointer))
54 ;;; Return a System-Area-Pointer pointing to the end of the control stack.
55 (defun sb!c::control-stack-pointer-sap ()
56 (sb!c::control-stack-pointer-sap))
58 ;;; Return the header typecode for FUNCTION. Can be set with SETF.
59 (defun function-subtype (function)
60 (function-subtype function))
61 (defun (setf function-subtype) (type function)
62 (setf (function-subtype function) type))
64 ;;; Extract the arglist from the function header FUNC.
65 (defun %function-arglist (func)
66 (%function-arglist func))
68 ;;; Extract the name from the function header FUNC.
69 (defun %function-name (func)
70 (%function-name func))
72 ;;; Extract the type from the function header FUNC.
73 (defun %function-type (func)
74 (%function-type func))
76 ;;; Extract the function from CLOSURE.
77 (defun %closure-function (closure)
78 (%closure-function closure))
80 ;;; Return the length of VECTOR. There is no reason to use this in
81 ;;; ordinary code, 'cause length (the vector foo)) is the same.
82 (defun sb!c::vector-length (vector)
83 (sb!c::vector-length vector))
85 ;;; Extract the INDEXth slot from CLOSURE.
86 (defun %closure-index-ref (closure index)
87 (%closure-index-ref closure index))
89 ;;; Allocate a unboxed, simple vector with type code TYPE, length LENGTH, and
90 ;;; WORDS words long. Note: it is your responsibility to ensure that the
91 ;;; relation between LENGTH and WORDS is correct.
92 (defun allocate-vector (type length words)
93 (allocate-vector type length words))
95 ;;; Allocate an array header with type code TYPE and rank RANK.
96 (defun make-array-header (type rank)
97 (make-array-header type rank))
99 ;;; Return a SAP pointing to the instructions part of CODE-OBJ.
100 (defun code-instructions (code-obj)
101 (code-instructions code-obj))
103 ;;; Extract the INDEXth element from the header of CODE-OBJ. Can be
105 (defun code-header-ref (code-obj index)
106 (code-header-ref code-obj index))
108 (defun code-header-set (code-obj index new)
109 (code-header-set code-obj index new))
111 (defun %raw-bits (object offset)
112 (declare (type index offset))
113 (sb!kernel:%raw-bits object offset))
115 (defun %set-raw-bits (object offset value)
116 (declare (type index offset) (type (unsigned-byte #.sb!vm:word-bits) value))
117 (setf (sb!kernel:%raw-bits object offset) value))
119 (defun make-single-float (x) (make-single-float x))
120 (defun make-double-float (hi lo) (make-double-float hi lo))
122 (defun make-long-float (exp hi #!+sparc mid lo)
123 (make-long-float exp hi #!+sparc mid lo))
124 (defun single-float-bits (x) (single-float-bits x))
125 (defun double-float-high-bits (x) (double-float-high-bits x))
126 (defun double-float-low-bits (x) (double-float-low-bits x))
128 (defun long-float-exp-bits (x) (long-float-exp-bits x))
130 (defun long-float-high-bits (x) (long-float-high-bits x))
131 #!+(and long-float sparc)
132 (defun long-float-mid-bits (x) (long-float-mid-bits x))
134 (defun long-float-low-bits (x) (long-float-low-bits x))