From 42e347c28944da23c9d94502d2f706fb1567330b Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Wed, 20 Aug 2003 16:54:00 +0000
Subject: [PATCH] 	* src/code/fwrappers.lisp (funwrap): Delete all
 fwrappers 	if neither type nor test is supplied.

	* src/lisp/GNUmakefile: Include internals.inc.

	* src/compiler/generic/new-genesis.lisp (emit-makefile-header): New
	function.
	(genesis): Call it.
---
 code/fwrappers.lisp               | 16 +++++++++-------
 compiler/generic/new-genesis.lisp | 18 +++++++++++++++++-
 lisp/GNUmakefile                  |  5 +++--
 3 files changed, 29 insertions(+), 10 deletions(-)

diff --git a/code/fwrappers.lisp b/code/fwrappers.lisp
index 8a5d0de07..f2bbe654d 100644
--- a/code/fwrappers.lisp
+++ b/code/fwrappers.lisp
@@ -27,7 +27,7 @@
 ;;; USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 ;;; DAMAGE.
 
-(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fwrappers.lisp,v 1.3 2003/06/18 09:38:10 gerd Exp $")
+(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/fwrappers.lisp,v 1.4 2003/08/20 16:54:00 gerd Exp $")
 
 (in-package :fwrappers)
 
@@ -123,13 +123,15 @@
 (defun funwrap (function-name &key (type nil type-p) test)
   "Remove fwrappers from the function named FUNCTION-NAME.
    If TYPE is supplied, remove fwrappers whose type is equal to TYPE.
-   If TEST is supplied, remove fwrappers satisfying TEST."
+   If TEST is supplied, remove fwrappers satisfying TEST.
+   If both are not specified, remove all fwrappers."
   (collect ((new))
-    (do-fwrappers (f (fdefn-or-lose function-name))
-      (when (or (not type-p) (not (equal type (fwrapper-type f))))
-	(when (or (null test) (not (funcall test f)))
-	  (new f))))
-    (set-fwrappers function-name (new))))
+    (when (or type-p test)
+      (do-fwrappers (f (fdefn-or-lose function-name))
+	(when (or (not type-p) (not (equal type (fwrapper-type f))))
+	  (when (or (null test) (not (funcall test f)))
+	    (new f))))
+      (set-fwrappers function-name (new)))))
 
 (defun update-fwrapper (f)
   "Update the funcallable instance function of fwrapper F from its
diff --git a/compiler/generic/new-genesis.lisp b/compiler/generic/new-genesis.lisp
index 173333189..b45de9839 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.57 2003/05/31 23:58:12 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/new-genesis.lisp,v 1.58 2003/08/20 16:53:59 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2357,6 +2357,15 @@
 	   (unix:unix-unlink unix-newname))))
   (undefined-value))
 
+(defun emit-makefile-header (name)
+  (with-open-file (*standard-output* name :direction :output
+				     :if-exists :supersede)
+    ;;
+    ;; Write out features.
+    (dolist (feature (c:backend-features c:*backend*))
+      (format t "FEATURE_~a = 1~%"
+	      (substitute #\_ #\- (symbol-name feature))))))
+
 
 ;;;; The actual genesis function.
 
@@ -2444,6 +2453,13 @@
 				    (merge-pathnames
 				     header-name
 				     (make-pathname :type "h")))
+				core-name))
+	      (emit-makefile-header
+	       (merge-pathnames (if (eq header-name t)
+				    "internals.inc"
+				    (merge-pathnames
+				     (make-pathname :type "inc")
+				     header-name))
 				core-name)))
 	    (write-initial-core-file
 	     core-name version
diff --git a/lisp/GNUmakefile b/lisp/GNUmakefile
index b8d77b1ce..5be00bd66 100644
--- a/lisp/GNUmakefile
+++ b/lisp/GNUmakefile
@@ -1,4 +1,4 @@
-# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/GNUmakefile,v 1.21 2003/05/30 02:46:53 toy Exp $
+# $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/GNUmakefile,v 1.22 2003/08/20 16:53:59 gerd Exp $
 
 all: lisp.nm
 
@@ -7,6 +7,7 @@ CC = gcc
 DEPEND = $(CC) -MM -E
 DEPEND_FLAGS = 
 
+-include internals.inc
 include Config
 
 ifndef GC_SRC
@@ -45,7 +46,7 @@ version:
 socket.o: socket.c
 	$(COMPILE.c) -DUNIXCONN $<
 
-internals.h:
+internals.h internals.inc:
 	@echo "You must run genesis to create internals.h!"
 	@false
 
-- 
GitLab