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