src/code/stubs.lisp

   1 ;;;; miscellaneous primitive stubs (ordinary FDEFINITIONs for full
   2 ;;;; call defined in terms of fundamental definitions of inline
   3 ;;;; expansions)
   4
   5 ;;;; This software is part of the SBCL system. See the README file for
   6 ;;;; more information.
   7 ;;;;
   8 ;;;; This software is derived from the CMU CL system, which was
   9 ;;;; written at Carnegie Mellon University and released into the
  10 ;;;; public domain. The software is in the public domain and is
  11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  12 ;;;; files for more information.
  13
  14 (in-package "SB!IMPL")
  15
  16 (macrolet ((def (name &optional (args '(x)))
  17              `(defun ,name ,args
  18                 (,@(if (listp name) `(funcall #',name) `(,name)) ,@args))))
  19   (def get-header-data)
  20   (def set-header-data (x val))
  21   (def get-closure-length)
  22   (def lowtag-of)
  23   (def widetag-of)
  24   (def %other-pointer-widetag)
  25   (def vector-sap)
  26   (def binding-stack-pointer-sap  ())
  27   (def dynamic-space-free-pointer ())
  28   (def control-stack-pointer-sap ())
  29   (def sb!c:safe-fdefn-fun)
  30   (def fun-subtype)
  31   (def simple-fun-p)
  32   (def %simple-fun-arglist)
  33   (def (setf %simple-fun-arglist) (new-value func))
  34   (def %simple-fun-name)
  35   (def (setf %simple-fun-name) (new-value func))
  36   (def closurep)
  37   (def %closure-fun)
  38   (def %closure-index-ref (closure index))
  39   (def sb!c::vector-length)
  40   (def allocate-vector (type length words))
  41   (def make-array-header (type rank))
  42   (def code-instructions)
  43   (def code-header-ref (code-obj index))
  44   (def code-header-set (code-obj index new))
  45   (def %vector-raw-bits (object offset))
  46   (def make-single-float)
  47   (def make-double-float (hi lo))
  48   (def single-float-bits)
  49   (def double-float-high-bits)
  50   (def double-float-low-bits)
  51   (def value-cell-ref)
  52   (def %caller-frame ())
  53   (def %caller-pc ())
  54   (def %code-code-size)
  55   (def %code-debug-info)
  56   (def %funcallable-instance-layout)
  57   (def %set-funcallable-instance-layout (x new-value)))