diff --git a/code/kernel.lisp b/code/kernel.lisp index e10d009af604df5203c8368a40141c8d9592a3bc..16f3a08ca298b482d540592120ddd3111d0b6433 100644 --- a/code/kernel.lisp +++ b/code/kernel.lisp @@ -7,15 +7,15 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.7 1991/04/23 01:25:20 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.8 1992/04/21 04:23:03 wlott Exp $") ;;; ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.7 1991/04/23 01:25:20 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.8 1992/04/21 04:23:03 wlott Exp $ ;;; (in-package "KERNEL") -(export '(allocate-vector make-array-header)) +(export '(allocate-vector make-array-header function-subtype)) (defun get-header-data (x) @@ -61,6 +61,13 @@ "Return a System-Area-Pointer pointing to the end of the control stack." (c::control-stack-pointer-sap)) +(defun function-subtype (function) + "Return the header typecode for FUNCTION. Can be set with SETF." + (function-subtype function)) + +(defun (setf function-subtype) (type function) + (setf (function-subtype function) type)) + (defun %function-header-arglist (func) "Extracts the arglist from the function header FUNC." (%function-header-arglist func))