From 11faa4e03b9402ff3c44d500b93e8c1bb2a51c2d Mon Sep 17 00:00:00 2001
From: toy <toy>
Date: Thu, 25 Sep 2003 02:40:13 +0000
Subject: [PATCH] Implmement Pierre Mai's idea of adding 2 macros for setting
 *FEATURES* and *RUNTIME-FEATURES* and setting them appropriately as files are
 loaded so that recompiling CMUCL produces a result with the same set of
 features.  *RUNTIME-FEATURES* is a subset of *FEATURES* that is written out
 to internals.h so the C code can be compiled appropriately.

A simple bootstrap with boot17 is needed.
---
 bootfiles/18e/boot17.lisp         |  3 +++
 code/foreign-linkage.lisp         |  2 ++
 code/gc.lisp                      |  5 ++++-
 code/hash-new.lisp                |  4 +++-
 code/lispinit.lisp                | 15 +++++++++++++--
 code/misc.lisp                    | 10 +++++++++-
 code/multi-proc.lisp              |  4 +++-
 code/package.lisp                 |  5 ++++-
 code/rand-mt19937.lisp            |  4 +++-
 code/sysmacs.lisp                 | 17 +++++++++++++++--
 compiler/generic/new-genesis.lisp |  6 +++---
 compiler/srctran.lisp             |  5 ++++-
 12 files changed, 66 insertions(+), 14 deletions(-)
 create mode 100644 bootfiles/18e/boot17.lisp

diff --git a/bootfiles/18e/boot17.lisp b/bootfiles/18e/boot17.lisp
new file mode 100644
index 000000000..ceccb47c4
--- /dev/null
+++ b/bootfiles/18e/boot17.lisp
@@ -0,0 +1,3 @@
+;; Boot file for adding *runtime-features*
+(in-package :sys)
+(defvar *runtime-features* nil)
\ No newline at end of file
diff --git a/code/foreign-linkage.lisp b/code/foreign-linkage.lisp
index c763e1f3c..3b655af22 100644
--- a/code/foreign-linkage.lisp
+++ b/code/foreign-linkage.lisp
@@ -1,5 +1,7 @@
 (in-package "LISP")
 
+(sys:register-lisp-runtime-feature :linkage-table)
+
 ;;; This gets created by genesis and lives in the static area.
 (defvar *linkage-table-data*)
 
diff --git a/code/gc.lisp b/code/gc.lisp
index a4e13c0fd..23c404d93 100644
--- a/code/gc.lisp
+++ b/code/gc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.36 2003/08/05 11:00:49 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/gc.lisp,v 1.37 2003/09/25 02:40:12 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -25,6 +25,9 @@
 (in-package "LISP")
 (export '(room))
 
+#+gencgc
+(sys:register-lisp-runtime-feature :gencgc)
+
 
 ;;;; DYNAMIC-USAGE and friends.
 
diff --git a/code/hash-new.lisp b/code/hash-new.lisp
index c0363581c..d5d42348e 100644
--- a/code/hash-new.lisp
+++ b/code/hash-new.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.26 2003/07/15 19:47:16 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.27 2003/09/25 02:40:12 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -28,6 +28,8 @@
 
 (in-package :lisp)
 
+(register-lisp-runtime-feature :hash-new)
+
 
 ;;;; The hash-table structures.
 
diff --git a/code/lispinit.lisp b/code/lispinit.lisp
index 14cb558d9..e584f98e0 100644
--- a/code/lispinit.lisp
+++ b/code/lispinit.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.71 2003/09/12 20:06:05 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.72 2003/09/25 02:40:12 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -19,14 +19,25 @@
 (export '(most-positive-fixnum most-negative-fixnum sleep
 	  ++ +++ ** *** // ///))
 
+(defvar *features* '(:common :common-lisp :ansi-cl :ieee-floating-point :cmu)
+  "Holds a list of symbols that describe features provided by the
+   implementation.")
+
+
 (in-package :system)
-(export '(compiler-version scrub-control-stack))
+(export '(compiler-version scrub-control-stack *runtime-features*))
+
+(defvar *runtime-features* nil
+  "Features affecting the runtime")
 
 (in-package :extensions)
 (export '(quit *prompt*))
 
 (in-package :lisp)
 
+#+stack-checking
+(sys:register-lisp-runtime-feature :stack-checking)
+
 ;;; Make the error system enable interrupts.
 
 (defconstant most-positive-fixnum #.vm:target-most-positive-fixnum
diff --git a/code/misc.lisp b/code/misc.lisp
index ece7231ac..e81bc42e8 100644
--- a/code/misc.lisp
+++ b/code/misc.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/misc.lisp,v 1.31 2003/04/11 15:28:11 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/misc.lisp,v 1.32 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -112,10 +112,18 @@
   string)
 
 
+#+nil
 (defvar *features* '(:common :common-lisp :ansi-cl :ieee-floating-point :cmu)
   "Holds a list of symbols that describe features provided by the
    implementation.")
 
+;;; Register various Lisp features
+#+i486
+(sys:register-lisp-runtime-feature :i486)
+
+#+pentium
+(sys:register-lisp-runtime-feature :pentium)
+
 (defun featurep (x)
   "If X is an atom, see if it is present in *FEATURES*.  Also
   handle arbitrary combinations of atoms using NOT, AND, OR."
diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp
index 4b8c6a072..a569fb256 100644
--- a/code/multi-proc.lisp
+++ b/code/multi-proc.lisp
@@ -5,7 +5,7 @@
 ;;; the Public domain, and is provided 'as is'.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.41 2002/12/12 19:09:45 moore Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.42 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -14,6 +14,8 @@
 
 (in-package "MULTIPROCESSING")
 
+(sys:register-lisp-runtime-feature :mp)
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;; Handle the binding stack.
 
diff --git a/code/package.lisp b/code/package.lisp
index 92e77b86f..3f52aa668 100644
--- a/code/package.lisp
+++ b/code/package.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.71 2003/08/08 11:32:52 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/package.lisp,v 1.72 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -36,6 +36,9 @@
 
 (in-package "LISP")
 
+#+relative-package-names
+(sys:register-lisp-feature :relative-package-names)
+
 (defvar *default-package-use-list* '("COMMON-LISP")
   "The list of packages to use by default of no :USE argument is supplied
    to MAKE-PACKAGE or other package creation forms.")
diff --git a/code/rand-mt19937.lisp b/code/rand-mt19937.lisp
index 460914509..9ecc04a2b 100644
--- a/code/rand-mt19937.lisp
+++ b/code/rand-mt19937.lisp
@@ -6,7 +6,7 @@
 ;;; placed in the Public domain, and is provided 'as is'.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand-mt19937.lisp,v 1.11 2003/03/06 09:31:06 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/rand-mt19937.lisp,v 1.12 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -26,6 +26,8 @@
 (in-package "KERNEL")
 (export '(%random-single-float %random-double-float random-chunk init-random-state))
 
+(sys:register-lisp-feature :random-mt19937)
+
 
 ;;;; Random state hackery:
 
diff --git a/code/sysmacs.lisp b/code/sysmacs.lisp
index 75fcb21ff..b69b52fff 100644
--- a/code/sysmacs.lisp
+++ b/code/sysmacs.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.27 2003/07/20 11:11:46 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sysmacs.lisp,v 1.28 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -14,11 +14,24 @@
 (in-package "LISP")
 
 (in-package "SYSTEM")
-(export '(without-gcing without-hemlock))
+(export '(without-gcing without-hemlock
+	  register-lisp-feature register-lisp-runtime-feature))
+
+(defmacro register-lisp-feature (feature)
+  "Register the feature as having influenced the CMUCL build process."
+  `(pushnew ',feature *features*))
+
+(defmacro register-lisp-runtime-feature (feature)
+  "Register the feature as having influenced the CMUCL build process,
+and also the CMUCL C runtime."
+   `(progn
+     (pushnew ',feature *features*)
+     (pushnew ',feature sys::*runtime-features*)))
 
 (in-package "LISP")
 
 
+
 ;;; WITH-ARRAY-DATA  --  Interface
 ;;;
 ;;;    Checks to see if the array is simple and the start and end are in
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index b45de9839..5e8699475 100644
--- a/compiler/generic/new-genesis.lisp
+++ b/compiler/generic/new-genesis.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.58 2003/08/20 16:53:59 gerd Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.59 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2306,8 +2306,8 @@
 		   (if symbol (vm:static-symbol-offset symbol) 0)))))
   ;;
   ;; Write out features.
-  (format t "~%/* Features when built. */~2%")
-  (dolist (feature (c:backend-features c:*backend*))
+  (format t "~%/* Runtime features when built. */~2%")
+  (dolist (feature sys:*runtime-features*)
     (format t "#define FEATURE_~a 1~%"
 	    (nsubstitute #\_ #\-
 			 (remove-if #'(lambda (char)
diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index e393fe4ed..7a4b81130 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.135 2003/09/24 22:38:10 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.136 2003/09/25 02:40:13 toy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -20,6 +20,9 @@
 ;;;
 (in-package "C")
 
+#+conservative-float-type
+(sys:register-lisp-feature :conservative-float-type)
+
 ;;; Source transform for Not, Null  --  Internal
 ;;;
 ;;;    Convert into an IF so that IF optimizations will eliminate redundant
-- 
GitLab