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 ;;; WIDETAG-OF needs extra code to handle LIST and FUNCTION lowtags. When
  36 ;;; we're only dealing with other pointers (eg. when dispatching on array
  37 ;;; element type), this is going to be faster.
  38 (declaim (inline %other-pointer-widetag))
  39 (defun %other-pointer-widetag (x)
  40   (sb!sys:sap-ref-8 (int-sap (get-lisp-obj-address x))
  41                     #.(ecase sb!c:*backend-byte-order*
  42                         (:little-endian
  43                          (- sb!vm:other-pointer-lowtag))
  44                         (:big-endian
  45                          (- (1- sb!vm:n-word-bytes) sb!vm:other-pointer-lowtag)))))
  46
  47 ;;; Return a System-Area-Pointer pointing to the data for the vector
  48 ;;; X, which must be simple.
  49 ;;;
  50 ;;; FIXME: So it should be SIMPLE-VECTOR-SAP, right? (or UNHAIRY-VECTOR-SAP,
  51 ;;; if the meaning is (SIMPLE-ARRAY * 1) instead of SIMPLE-VECTOR)
  52 ;;; (or maybe SIMPLE-VECTOR-DATA-SAP or UNHAIRY-VECTOR-DATA-SAP?)
  53 (defun vector-sap (x)
  54   (declare (type (simple-unboxed-array (*)) x))
  55   (vector-sap x))
  56
  57 ;;; Return a System-Area-Pointer pointing to the end of the binding stack.
  58 (defun sb!c::binding-stack-pointer-sap ()
  59   (sb!c::binding-stack-pointer-sap))
  60
  61 ;;; Return a System-Area-Pointer pointing to the next free word of the
  62 ;;; current dynamic space.
  63 (defun sb!c::dynamic-space-free-pointer ()
  64   (sb!c::dynamic-space-free-pointer))
  65
  66 ;;; Return a System-Area-Pointer pointing to the end of the control stack.
  67 (defun sb!c::control-stack-pointer-sap ()
  68   (sb!c::control-stack-pointer-sap))
  69
  70 ;;; Return the header typecode for FUNCTION. Can be set with SETF.
  71 (defun fun-subtype (function)
  72   (fun-subtype function))
  73 (defun (setf fun-subtype) (type function)
  74   (setf (fun-subtype function) type))
  75
  76 ;;; Extract the arglist from the function header FUNC.
  77 (defun %simple-fun-arglist (func)
  78   (%simple-fun-arglist func))
  79
  80 (defun (setf %simple-fun-arglist) (new-value func)
  81   (setf (%simple-fun-arglist func) new-value))
  82
  83 ;;; Extract the name from the function header FUNC.
  84 (defun %simple-fun-name (func)
  85   (%simple-fun-name func))
  86
  87 ;;; Extract the type from the function header FUNC.
  88 (defun %simple-fun-type (func)
  89   (%simple-fun-type func))
  90
  91 (defun %simple-fun-next (simple-fun)
  92   (%simple-fun-next simple-fun))
  93
  94 (defun %simple-fun-self (simple-fun)
  95   (%simple-fun-self simple-fun))
  96
  97 ;;; Extract the function from CLOSURE.
  98 (defun %closure-fun (closure)
  99   (%closure-fun closure))
 100
 101 ;;; Return the length of VECTOR. There is no reason to use this in
 102 ;;; ordinary code, 'cause length (the vector foo)) is the same.
 103 (defun sb!c::vector-length (vector)
 104   (sb!c::vector-length vector))
 105
 106 ;;; Extract the INDEXth slot from CLOSURE.
 107 (defun %closure-index-ref (closure index)
 108   (%closure-index-ref closure index))
 109
 110 ;;; Allocate a unboxed, simple vector with type code TYPE, length LENGTH, and
 111 ;;; WORDS words long. Note: it is your responsibility to ensure that the
 112 ;;; relation between LENGTH and WORDS is correct.
 113 (defun allocate-vector (type length words)
 114   (allocate-vector type length words))
 115
 116 ;;; Allocate an array header with type code TYPE and rank RANK.
 117 (defun make-array-header (type rank)
 118   (make-array-header type rank))
 119
 120 ;;; Return a SAP pointing to the instructions part of CODE-OBJ.
 121 (defun code-instructions (code-obj)
 122   (code-instructions code-obj))
 123
 124 ;;; Extract the INDEXth element from the header of CODE-OBJ. Can be
 125 ;;; set with SETF.
 126 (defun code-header-ref (code-obj index)
 127   (code-header-ref code-obj index))
 128
 129 (defun code-header-set (code-obj index new)
 130   (code-header-set code-obj index new))
 131
 132 (defun %vector-raw-bits (object offset)
 133   (declare (type index offset))
 134   (sb!kernel:%vector-raw-bits object offset))
 135
 136 (defun %set-vector-raw-bits (object offset value)
 137   (declare (type index offset))
 138   (declare (type sb!vm:word value))
 139   (setf (sb!kernel:%vector-raw-bits object offset) value))
 140
 141 (defun make-single-float (x) (make-single-float x))
 142 (defun make-double-float (hi lo) (make-double-float hi lo))
 143
 144 (defun single-float-bits (x) (single-float-bits x))
 145 (defun double-float-high-bits (x) (double-float-high-bits x))
 146 (defun double-float-low-bits (x) (double-float-low-bits x))
 147