From c1b1673f890f5687adb17976696582864ec6d5d9 Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Tue, 21 Apr 1992 04:23:03 +0000 Subject: [PATCH] Added function-subtype and (setf function-subtype). --- code/kernel.lisp | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/code/kernel.lisp b/code/kernel.lisp index e10d009af..16f3a08ca 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)) -- GitLab