1.0.5.56: conditionally re-enable interrupts interrupting current thread
[sbcl.git] / src / code / kernel.lisp
1 ;;;; miscellaneous kernel-level definitions
2
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
11
12 (in-package "SB!KERNEL")
13
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)
17   (get-header-data x))
18
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))
23
24 ;;; the length of the closure X, i.e. one more than the
25 ;;; number of variables closed over
26 (defun get-closure-length (x)
27   (get-closure-length x))
28
29 (defun lowtag-of (x)
30   (lowtag-of x))
31
32 (defun widetag-of (x)
33   (widetag-of x))
34
35 ;;; Return a System-Area-Pointer pointing to the data for the vector
36 ;;; X, which must be simple.
37 ;;;
38 ;;; FIXME: So it should be SIMPLE-VECTOR-SAP, right? (or UNHAIRY-VECTOR-SAP,
39 ;;; if the meaning is (SIMPLE-ARRAY * 1) instead of SIMPLE-VECTOR)
40 ;;; (or maybe SIMPLE-VECTOR-DATA-SAP or UNHAIRY-VECTOR-DATA-SAP?)
41 (defun vector-sap (x)
42   (declare (type (simple-unboxed-array (*)) x))
43   (vector-sap x))
44
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))
48
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))
53
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))
57
58 ;;; Return the header typecode for FUNCTION. Can be set with SETF.
59 (defun fun-subtype (function)
60   (fun-subtype function))
61 (defun (setf fun-subtype) (type function)
62   (setf (fun-subtype function) type))
63
64 ;;; Extract the arglist from the function header FUNC.
65 (defun %simple-fun-arglist (func)
66   (%simple-fun-arglist func))
67
68 (defun (setf %simple-fun-arglist) (new-value func)
69   (setf (%simple-fun-arglist func) new-value))
70
71 ;;; Extract the name from the function header FUNC.
72 (defun %simple-fun-name (func)
73   (%simple-fun-name func))
74
75 ;;; Extract the type from the function header FUNC.
76 (defun %simple-fun-type (func)
77   (%simple-fun-type func))
78
79 (defun %simple-fun-next (simple-fun)
80   (%simple-fun-next simple-fun))
81
82 (defun %simple-fun-self (simple-fun)
83   (%simple-fun-self simple-fun))
84
85 ;;; Extract the function from CLOSURE.
86 (defun %closure-fun (closure)
87   (%closure-fun closure))
88
89 ;;; Return the length of VECTOR. There is no reason to use this in
90 ;;; ordinary code, 'cause length (the vector foo)) is the same.
91 (defun sb!c::vector-length (vector)
92   (sb!c::vector-length vector))
93
94 ;;; Extract the INDEXth slot from CLOSURE.
95 (defun %closure-index-ref (closure index)
96   (%closure-index-ref closure index))
97
98 ;;; Allocate a unboxed, simple vector with type code TYPE, length LENGTH, and
99 ;;; WORDS words long. Note: it is your responsibility to ensure that the
100 ;;; relation between LENGTH and WORDS is correct.
101 (defun allocate-vector (type length words)
102   (allocate-vector type length words))
103
104 ;;; Allocate an array header with type code TYPE and rank RANK.
105 (defun make-array-header (type rank)
106   (make-array-header type rank))
107
108 ;;; Return a SAP pointing to the instructions part of CODE-OBJ.
109 (defun code-instructions (code-obj)
110   (code-instructions code-obj))
111
112 ;;; Extract the INDEXth element from the header of CODE-OBJ. Can be
113 ;;; set with SETF.
114 (defun code-header-ref (code-obj index)
115   (code-header-ref code-obj index))
116
117 (defun code-header-set (code-obj index new)
118   (code-header-set code-obj index new))
119
120 (defun %raw-bits (object offset)
121   (declare (type index offset))
122   (sb!kernel:%raw-bits object offset))
123
124 (defun %set-raw-bits (object offset value)
125   (declare (type index offset))
126   (declare (type sb!vm:word value))
127   (setf (sb!kernel:%raw-bits object offset) value))
128
129 (defun %vector-raw-bits (object offset)
130   (declare (type index offset))
131   (sb!kernel:%vector-raw-bits object offset))
132
133 (defun %set-vector-raw-bits (object offset value)
134   (declare (type index offset))
135   (declare (type sb!vm:word value))
136   (setf (sb!kernel:%vector-raw-bits object offset) value))
137
138 (defun make-single-float (x) (make-single-float x))
139 (defun make-double-float (hi lo) (make-double-float hi lo))
140
141 (defun single-float-bits (x) (single-float-bits x))
142 (defun double-float-high-bits (x) (double-float-high-bits x))
143 (defun double-float-low-bits (x) (double-float-low-bits x))
144