home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / kernel.lisp < prev    next >
Encoding:
Text File  |  1992-05-30  |  4.1 KB  |  134 lines
  1. ;;; -*- Log: code.log; Package: KERNEL -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: kernel.lisp,v 1.7 91/04/23 01:25:20 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; $Header: kernel.lisp,v 1.7 91/04/23 01:25:20 wlott Exp $
  15. ;;;    
  16. (in-package "KERNEL")
  17.  
  18. (export '(allocate-vector make-array-header))
  19.  
  20.  
  21. (defun get-header-data (x)
  22.   "Return the 24 bits of data in the header of object X, which must be an
  23.   other-pointer object."
  24.   (get-header-data x))
  25.  
  26. (defun set-header-data (x val)
  27.   "Sets the 24 bits of data in the header of object X (which must be an
  28.   other-pointer object) to VAL."
  29.   (set-header-data x val))
  30.  
  31. (defun get-closure-length (x)
  32.   "Returns the length of the closure X.  This is one more than the number
  33.   of variables closed over."
  34.   (get-closure-length x))
  35.  
  36. (defun get-lowtag (x)
  37.   "Returns the three-bit lowtag for the object X."
  38.   (get-lowtag x))
  39.  
  40. (defun get-type (x)
  41.   "Returns the 8-bit header type for the object X."
  42.   (get-type x))
  43.  
  44. (defun vector-sap (x)
  45.   "Return a System-Area-Pointer pointing to the data for the vector X, which
  46.   must be simple."
  47.   (declare (type (simple-unboxed-array (*)) x))
  48.   (vector-sap x))
  49.  
  50.  
  51. (defun c::binding-stack-pointer-sap ()
  52.   "Return a System-Area-Pointer pointing to the end of the binding stack."
  53.   (c::binding-stack-pointer-sap))
  54.  
  55. (defun c::dynamic-space-free-pointer ()
  56.   "Returns a System-Area-Pointer pointing to the next free work of the current
  57.   dynamic space."
  58.   (c::dynamic-space-free-pointer))
  59.  
  60. (defun c::control-stack-pointer-sap ()
  61.   "Return a System-Area-Pointer pointing to the end of the control stack."
  62.   (c::control-stack-pointer-sap))
  63.  
  64. (defun %function-header-arglist (func)
  65.   "Extracts the arglist from the function header FUNC."
  66.   (%function-header-arglist func))
  67.  
  68. (defun %function-header-name (func)
  69.   "Extracts the name from the function header FUNC."
  70.   (%function-header-name func))
  71.  
  72. (defun %function-header-type (func)
  73.   "Extracts the type from the function header FUNC."
  74.   (%function-header-type func))
  75.  
  76. (defun %closure-function (closure)
  77.   "Extracts the function from CLOSURE."
  78.   (%closure-function closure))
  79.  
  80. (defun c::vector-length (vector)
  81.   "Return the length of VECTOR.  There is no reason to use this, 'cause
  82.   (length (the vector foo)) is the same."
  83.   (c::vector-length vector))
  84.  
  85. (defun %sxhash-simple-string (string)
  86.   "Return the SXHASH for the simple-string STRING."
  87.   (%sxhash-simple-string string))
  88.  
  89. (defun %sxhash-simple-substrubg (string length)
  90.   "Return the SXHASH for the first LENGTH characters of the simple-string
  91.   STRING."
  92.   (%sxhash-simple-substring string length))
  93.  
  94. (defun %closure-index-ref (closure index)
  95.   "Extract the INDEXth slot from CLOSURE."
  96.   (%closure-index-ref closure index))
  97.  
  98.  
  99. (defun allocate-vector (type length words)
  100.   "Allocate a unboxed, simple vector with type code TYPE, length LENGTH, and
  101.   WORDS words long.  Note: it is your responsibility to assure that the
  102.   relation between LENGTH and WORDS is correct."
  103.   (allocate-vector type length words))
  104.  
  105. (defun make-array-header (type rank)
  106.   "Allocate an array header with type code TYPE and rank RANK."
  107.   (make-array-header type rank))
  108.  
  109.  
  110. (defun code-instructions (code-obj)
  111.   "Return a SAP pointing to the instructions part of CODE-OBJ."
  112.   (code-instructions code-obj))
  113.  
  114. (defun code-header-ref (code-obj index)
  115.   "Extract the INDEXth element from the header of CODE-OBJ.  Can be set with
  116.   setf."
  117.   (code-header-ref code-obj index))
  118.  
  119. (defun code-header-set (code-obj index new)
  120.   (code-header-set code-obj index new))
  121.  
  122. (defsetf code-header-ref code-header-set)
  123.  
  124.  
  125. (defun %raw-bits (object offset)
  126.   (declare (type index offset))
  127.   (kernel:%raw-bits object offset))
  128.  
  129. (defun %set-raw-bits (object offset value)
  130.   (declare (type index offset) (type (unsigned-byte #.vm:word-bits) value))
  131.   (setf (kernel:%raw-bits object offset) value))
  132.  
  133. (defsetf %raw-bits %set-raw-bits)
  134.