From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: Camm Maguire <camm@debian.org>
Date: Jul, 05 2026 18:55:04 +0000
Subject: [PATCH] <short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

Bug-Debian: https://bugs.debian.org/1140970
---
The information above should follow the Patch Tagging Guidelines, please
checkout https://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: (upstream|backport|vendor|other), (<patch-url>|commit:<commit-id>)
Bug: <upstream-bugtracker-url>
Bug-<Vendor>: <vendor-bugtracker-url>
Forwarded: (no|not-needed|<patch-forwarded-url>)
Applied-Upstream: <version>, (<commit-url>|commit:<commid-id>)
Reviewed-By: <name and email of someone who approved/reviewed the patch>

--- gcl27-2.7.1.orig/Makefile.am
+++ gcl27-2.7.1/Makefile.am
@@ -210,7 +210,7 @@ gcl_tk_gcltkaux_SOURCES=$(GCLTK_SRC)
 gcl_tk_gcltkaux_CPPFLAGS=$(AM_CPPFLAGS) $(TK_INCLUDE) $(TCL_INCLUDE) $(TK_XINCLUDES)
 gcl_tk_gcltkaux_LDADD=$(TK_LIB_SPEC) $(TCL_LIB_SPEC)
 
-MY_DIRS=gcl0 gcl1 gcl2 gcl3 gcl mod_gcl0 mod_gcl pcl_gcl ansi_gcl
+MY_DIRS=gcl0 gcl1 gcl2 gcl3 gcl mod_gcl0 mod_gcl pcl_gcl ansi_gcl0 ansi_gcl
 
 L_STUBS=s sf c listlib predlib deftype typeof subtypep bit type typep typecase arraylib \
         seq seqlib bnum fle dl rm nr lr sym hash sharp \
@@ -285,8 +285,9 @@ unixport/gcl_cmpnopt_%_gprof.lsp: unixpo
 unixport/gcl_cmpnopt_pre_gcl.lsp: # FIXME necessary?
 	touch $@
 unixport/gcl_cmpnopt_%.lsp: unixport/lib%.a | unixport/%
-	echo "(mapc (quote load) (directory \"$*/*.hsh\"))" \
-	     "(compiler::dump-inl-hash \"$@\" t)" | $|
+	echo "(clrhash compiler::*inl-hash*)" \
+             "(mapc (quote load) (directory \"$*/*.hsh\"))" \
+	     "(compiler::dump-inl-hash \"$@\")" | $|
 
 $(addprefix unixport/lib,$(addsuffix .a,pre_gcl $(MY_DIRS))): \
 unixport/lib%.a: lib/libbase_gcl.a $(LIBGPROF) unixport/sys_%.o
@@ -306,9 +307,14 @@ $(addprefix unixport/lib,$(addsuffix .a,
 unixport/lib%.a: $(addprefix %/,$(L_OBJS))
 unixport/libmod_gcl0.a unixport/libmod_gcl.a:\
 unixport/lib%.a: $(addprefix %/,$(MOD_OBJS)) $(L_FOBJS) $(X_LIB)
-unixport/libgcl.a unixport/libmod_gcl.a: unixport/lib%.a: %/recompile
 unixport/libpcl_gcl.a: $(PCL_FOBJS)
-unixport/libansi_gcl.a: $(ANSI_FOBJS)
+unixport/libansi_gcl0.a unixport/libansi_gcl.a: \
+unixport/lib%.a: $(addprefix %/,$(CLCS_OBJS)) $(PCL_FOBJS)
+
+unixport/libgcl.a unixport/libmod_gcl.a unixport/libansi_gcl.a: unixport/lib%.a: %/recompile
+gcl/recompile: $(L_FOBJS)
+mod_gcl/recompile: $(MOD_FOBJS)
+ansi_gcl/recompile: $(ANSI_FOBJS)
 
 unixport/libgcl_gprof.a: $(patsubst %.o,%.go,$(L_FOBJS))
 unixport/libansi_gcl_gprof.a: $(patsubst %.o,%.go,$(ANSI_FOBJS))
@@ -319,6 +325,7 @@ unixport/lib%.a: | xbin/ar_merge
 %/recompile: | unixport/%
 	$| -batch \
 	   -eval "(let ((si::*do-recomp-output-dir* \"$(@D)\")) (si::do-recomp t))" \
+	   -eval "(mapc (quote delete-file) (directory \"$(@D)/*.hsh\"))" \
 	   -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\" t)"
 	touch $@
 
@@ -334,11 +341,12 @@ unixport/gcl:  | unixport/saved_gcl3
 unixport/mod_gcl0:  | unixport/saved_gcl
 unixport/mod_gcl:  | unixport/saved_mod_gcl0
 unixport/pcl_gcl:  | unixport/saved_mod_gcl
-unixport/ansi_gcl:  | unixport/saved_pcl_gcl
+unixport/ansi_gcl0:  | unixport/saved_pcl_gcl
+unixport/ansi_gcl:  | unixport/saved_ansi_gcl0
 $(addprefix unixport/,gcl0 gcl1): unixport/% : unixport/cinit.lisp | %
 	echo "(system:save-system \"$@\")" | cat $< - | $(word 2,$|)
 
-$(addprefix unixport/,gcl2 gcl3 gcl mod_gcl): unixport/% : | %
+$(addprefix unixport/,gcl2 gcl3 gcl mod_gcl ansi_gcl): unixport/% : | %
 	ln -snf $$(basename $(word 2,$|)) $@
 
 unixport/mod_gcl0: xgcl-2/sysdef.lisp | mod_gcl0
@@ -359,9 +367,9 @@ unixport/pcl_gcl: clcs/package.lisp cmpn
 	      "(setq pcl::*pathname-extensions* (cons \"lisp\" \"o\"))" \
 	      "(si::save-system \"$@\")" | $(word 2,$|)
 
-unixport/ansi_gcl: clcs/package.lisp clcs/gcl_clcs_precom.lisp \
+unixport/ansi_gcl0: clcs/package.lisp clcs/gcl_clcs_precom.lisp \
 		   clcs/gcl_clcs_conditions.lisp clcs/gcl_clcs_condition_definitions.lisp \
-		   | ansi_gcl
+		   | ansi_gcl0
 	echo "(mapc (quote load) (list $(patsubst %,\"%\",$^)))" \
              "(compiler::cdebug)" \
              "(si::save-system \"$@\")" | $(word 2,$|)
@@ -388,12 +396,12 @@ gcl1/%.o: | unixport/gcl1
 $(addprefix gcl2/,$(LL_OBJS)): gcl2/%.o : lsp/%.lsp
 $(addprefix gcl2/,$(LC_OBJS)): gcl2/%.o : cmpnew/%.lsp
 gcl2/%.o: | unixport/gcl2
-	$| -eval "(compiler::cdebug)(setq compiler::*dump-inl-hash* t)" -compile $< -o $@
+	$| -eval "(progn (compiler::cdebug)(setq compiler::*dump-inl-hash* t))" -compile $< -o $@
 
 $(addprefix gcl3/,$(LL_OBJS)): gcl3/%.o : lsp/%.lsp
 $(addprefix gcl3/,$(LC_OBJS)): gcl3/%.o : cmpnew/%.lsp
 gcl3/%.o: | unixport/gcl3
-	$| -eval "(compiler::cdebug)(setq compiler::*dump-inl-hash* t)" -compile $< -o $@
+	$| -eval "(progn (compiler::cdebug)(setq compiler::*dump-inl-hash* t))" -compile $< -o $@
 
 gcl/%.o: gcl3/%.o | gcl
 	cp $(patsubst %.o,%.*,$<) $(@D)
@@ -406,7 +414,6 @@ mod_gcl0/%.o: | unixport/mod_gcl0
 mod_gcl/%.o: mod_gcl0/%.o | unixport/mod_gcl
 	cp $(patsubst %.o,%.*,$<) $(@D)
 
-
 %/c1: | unixport/%
 	echo "(pcl::compile-pcl)" | $|
 	touch $@
@@ -450,9 +457,13 @@ $(addprefix pcl_gcl/,$(PCL_OBJS)): pcl_g
 	touch $@
 
 
-ansi_gcl/%.o: clcs/%.lisp | unixport/ansi_gcl
+ansi_gcl0/%.o: clcs/%.lisp | unixport/ansi_gcl0
 	$| -eval "(setq compiler::*dump-inl-hash* t)" -compile $< -o $@
 
+ansi_gcl/%.o: ansi_gcl0/%.o | unixport/ansi_gcl
+	cp $(patsubst %.o,%.*,$<) $(@D)
+
+
 %.go: %.o mod_gcl/recompile #FIXME parallel
 	$(CC) $(AM_CPPFLAGS) -I $(<D) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) \
 	      -fno-omit-frame-pointer -pg -c $*.c -o $@
--- gcl27-2.7.1.orig/Makefile.in
+++ gcl27-2.7.1/Makefile.in
@@ -1100,7 +1100,7 @@ GCLTK_SRC = gcl-tk/guis.c gcl-tk/tkAppIn
 gcl_tk_gcltkaux_SOURCES = $(GCLTK_SRC)
 gcl_tk_gcltkaux_CPPFLAGS = $(AM_CPPFLAGS) $(TK_INCLUDE) $(TCL_INCLUDE) $(TK_XINCLUDES)
 gcl_tk_gcltkaux_LDADD = $(TK_LIB_SPEC) $(TCL_LIB_SPEC)
-MY_DIRS = gcl0 gcl1 gcl2 gcl3 gcl mod_gcl0 mod_gcl pcl_gcl ansi_gcl
+MY_DIRS = gcl0 gcl1 gcl2 gcl3 gcl mod_gcl0 mod_gcl pcl_gcl ansi_gcl0 ansi_gcl
 L_STUBS = s sf c listlib predlib deftype typeof subtypep bit type typep typecase arraylib \
         seq seqlib bnum fle dl rm nr lr sym hash sharp \
 	cmptype cmpeval cmpvar cmpwt cmpif \
@@ -4624,8 +4624,9 @@ unixport/gcl_cmpnopt_%_gprof.lsp: unixpo
 unixport/gcl_cmpnopt_pre_gcl.lsp: # FIXME necessary?
 	touch $@
 unixport/gcl_cmpnopt_%.lsp: unixport/lib%.a | unixport/%
-	echo "(mapc (quote load) (directory \"$*/*.hsh\"))" \
-	     "(compiler::dump-inl-hash \"$@\" t)" | $|
+	echo "(clrhash compiler::*inl-hash*)" \
+             "(mapc (quote load) (directory \"$*/*.hsh\"))" \
+	     "(compiler::dump-inl-hash \"$@\")" | $|
 
 $(addprefix unixport/lib,$(addsuffix .a,pre_gcl $(MY_DIRS))): \
 unixport/lib%.a: lib/libbase_gcl.a $(LIBGPROF) unixport/sys_%.o
@@ -4639,9 +4640,14 @@ $(addprefix unixport/lib,$(addsuffix .a,
 unixport/lib%.a: $(addprefix %/,$(L_OBJS))
 unixport/libmod_gcl0.a unixport/libmod_gcl.a:\
 unixport/lib%.a: $(addprefix %/,$(MOD_OBJS)) $(L_FOBJS) $(X_LIB)
-unixport/libgcl.a unixport/libmod_gcl.a: unixport/lib%.a: %/recompile
 unixport/libpcl_gcl.a: $(PCL_FOBJS)
-unixport/libansi_gcl.a: $(ANSI_FOBJS)
+unixport/libansi_gcl0.a unixport/libansi_gcl.a: \
+unixport/lib%.a: $(addprefix %/,$(CLCS_OBJS)) $(PCL_FOBJS)
+
+unixport/libgcl.a unixport/libmod_gcl.a unixport/libansi_gcl.a: unixport/lib%.a: %/recompile
+gcl/recompile: $(L_FOBJS)
+mod_gcl/recompile: $(MOD_FOBJS)
+ansi_gcl/recompile: $(ANSI_FOBJS)
 
 unixport/libgcl_gprof.a: $(patsubst %.o,%.go,$(L_FOBJS))
 unixport/libansi_gcl_gprof.a: $(patsubst %.o,%.go,$(ANSI_FOBJS))
@@ -4652,6 +4658,7 @@ unixport/lib%.a: | xbin/ar_merge
 %/recompile: | unixport/%
 	$| -batch \
 	   -eval "(let ((si::*do-recomp-output-dir* \"$(@D)\")) (si::do-recomp t))" \
+	   -eval "(mapc (quote delete-file) (directory \"$(@D)/*.hsh\"))" \
 	   -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\" t)"
 	touch $@
 
@@ -4667,11 +4674,12 @@ unixport/gcl:  | unixport/saved_gcl3
 unixport/mod_gcl0:  | unixport/saved_gcl
 unixport/mod_gcl:  | unixport/saved_mod_gcl0
 unixport/pcl_gcl:  | unixport/saved_mod_gcl
-unixport/ansi_gcl:  | unixport/saved_pcl_gcl
+unixport/ansi_gcl0:  | unixport/saved_pcl_gcl
+unixport/ansi_gcl:  | unixport/saved_ansi_gcl0
 $(addprefix unixport/,gcl0 gcl1): unixport/% : unixport/cinit.lisp | %
 	echo "(system:save-system \"$@\")" | cat $< - | $(word 2,$|)
 
-$(addprefix unixport/,gcl2 gcl3 gcl mod_gcl): unixport/% : | %
+$(addprefix unixport/,gcl2 gcl3 gcl mod_gcl ansi_gcl): unixport/% : | %
 	ln -snf $$(basename $(word 2,$|)) $@
 
 unixport/mod_gcl0: xgcl-2/sysdef.lisp | mod_gcl0
@@ -4692,9 +4700,9 @@ unixport/pcl_gcl: clcs/package.lisp cmpn
 	      "(setq pcl::*pathname-extensions* (cons \"lisp\" \"o\"))" \
 	      "(si::save-system \"$@\")" | $(word 2,$|)
 
-unixport/ansi_gcl: clcs/package.lisp clcs/gcl_clcs_precom.lisp \
+unixport/ansi_gcl0: clcs/package.lisp clcs/gcl_clcs_precom.lisp \
 		   clcs/gcl_clcs_conditions.lisp clcs/gcl_clcs_condition_definitions.lisp \
-		   | ansi_gcl
+		   | ansi_gcl0
 	echo "(mapc (quote load) (list $(patsubst %,\"%\",$^)))" \
              "(compiler::cdebug)" \
              "(si::save-system \"$@\")" | $(word 2,$|)
@@ -4721,12 +4729,12 @@ gcl1/%.o: | unixport/gcl1
 $(addprefix gcl2/,$(LL_OBJS)): gcl2/%.o : lsp/%.lsp
 $(addprefix gcl2/,$(LC_OBJS)): gcl2/%.o : cmpnew/%.lsp
 gcl2/%.o: | unixport/gcl2
-	$| -eval "(compiler::cdebug)(setq compiler::*dump-inl-hash* t)" -compile $< -o $@
+	$| -eval "(progn (compiler::cdebug)(setq compiler::*dump-inl-hash* t))" -compile $< -o $@
 
 $(addprefix gcl3/,$(LL_OBJS)): gcl3/%.o : lsp/%.lsp
 $(addprefix gcl3/,$(LC_OBJS)): gcl3/%.o : cmpnew/%.lsp
 gcl3/%.o: | unixport/gcl3
-	$| -eval "(compiler::cdebug)(setq compiler::*dump-inl-hash* t)" -compile $< -o $@
+	$| -eval "(progn (compiler::cdebug)(setq compiler::*dump-inl-hash* t))" -compile $< -o $@
 
 gcl/%.o: gcl3/%.o | gcl
 	cp $(patsubst %.o,%.*,$<) $(@D)
@@ -4781,9 +4789,12 @@ mod_gcl/%.o: mod_gcl0/%.o | unixport/mod
 $(addprefix pcl_gcl/,$(PCL_OBJS)): pcl_gcl/all.hsh 
 	touch $@
 
-ansi_gcl/%.o: clcs/%.lisp | unixport/ansi_gcl
+ansi_gcl0/%.o: clcs/%.lisp | unixport/ansi_gcl0
 	$| -eval "(setq compiler::*dump-inl-hash* t)" -compile $< -o $@
 
+ansi_gcl/%.o: ansi_gcl0/%.o | unixport/ansi_gcl
+	cp $(patsubst %.o,%.*,$<) $(@D)
+
 %.go: %.o mod_gcl/recompile #FIXME parallel
 	$(CC) $(AM_CPPFLAGS) -I $(<D) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) \
 	      -fno-omit-frame-pointer -pg -c $*.c -o $@
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpeval.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpeval.lsp
@@ -619,7 +619,7 @@
   (if (unless (type-and t1 t2) (and a1 a2 (listp t1) (listp t2) (equal (car t1) (car t2))))
       (car t1) (type-or1 t1 t2)))
 
-(defun coalesce-inl (cl inl tps rt &aux (lev (this-safety-level)))
+(defun coalesce-inl (cl inl tps rt lev);&aux (lev (this-safety-level))
   (when (> lev (third inl))
     (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-coalesce)
 		   "Coalescing safety ~s: ~s ~s" (car cl) (third inl) lev)
@@ -694,7 +694,7 @@
 
 (defun merge-inl (cl inl pl &aux (tps (pop inl))(tr (pop inl)))
   (let ((z (member-if (lambda (x) (can-coalesce x tr inl tps)) (car pl))))
-    (cond (z (coalesce-inl cl (car z) tps (cdr (third inl)))
+    (cond (z (coalesce-inl cl (car z) tps (cdr (third inl)) (car inl))
 	     (setf (cdr z) (remove-if (lambda (x) (can-coalesce x tr inl tps)) (cdr z))))
 	  (pl (let ((x (list* tps tr inl)))
 		(keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-add)
@@ -766,25 +766,86 @@
 	  x)))))
 
 
-(defun compress-inl (s &aux (i (car (gethash s *inl-hash*))))
-  (when (> (length i) 1)
-    (let ((l (length i))
-	  (x (reduce (lambda (y x)
-		       (list
-			(mapl (lambda (z w) (setf (car z) (type-or1 (car z) (car w))))
-			      (car y) (car x))
-			(max (cadr y) (third x))))
-		     (cdr i) :initial-value (list (copy-list (caar i)) (third (car i)))))
-	  (syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) (make-list (length (caar i))))))
-      (compile nil `(lambda ,syms
-		      (declare (optimize (safety ,(cadr x)))
-			       ,@(mapcar (lambda (x y) (list (cmp-unnorm-tp x) y)) (car x) syms))
-		      (,s ,@syms)))
-      (when (< (length (car (gethash s *inl-hash*))) l)
-	(format t "compress-inl ~s: ~s -> ~s~%" s l (length (car (gethash s *inl-hash*))))))))
+(defvar *ncompiles* 0)
 
-(defun dump-inl-hash (f &optional compress &aux (si::*print-package* t))
-  (when compress (maphash (lambda (x y) (declare (ignore y)) (compress-inl x)) *inl-hash*))
+(defun try-compile (nm s tps
+		    &aux (*sig-discovery* t)
+		      *compile-verbose*
+		      (syms (mapcar (lambda (x) (declare (ignore x)) (gensym)) tps)))
+  (incf *ncompiles*)
+  (compile nil `(lambda ,syms
+		  (declare (optimize (safety ,s)))
+		  (declare ,@(mapcar (lambda (x y) (list (cmp-unnorm-tp x) y)) tps syms))
+		  (,nm ,@syms))))
+
+(defun extend-arg-tps (at tps s)
+  (let* ((st (member '* at))
+	 (at (ldiff at st))
+	 (at (if (< s 2) at (make-list (length at) :initial-element #tt))))
+    (append at
+	    (when st
+	      (make-list (- (length tps) (length at)) :initial-element #tt)))))
+
+(defun restrict-inl-1-tps (nm at inls)
+  (mapc (lambda (inl)
+	  (mapl (lambda (ptp pstp &aux (tp (car ptp))(stp (car pstp)))
+		  (unless (tp<= tp stp)
+		    (let ((ntp (tp-and tp stp)))
+		      (print (list nm (caddr inl) (cmp-unnorm-tp tp) 'to (cmp-unnorm-tp ntp)))
+		      (setf (car ptp) ntp))))
+		  (car inl)
+		  (extend-arg-tps at (car inl) (caddr inl))))
+	(car inls)))
+
+(defun iterate-over-inls (nm at &optional (it 0)
+			  &aux (inls (copy-tree (get-inl-list (list nm))))
+			    (have-2 (member 2 (car inls) :key 'caddr)))
+
+  (flet ((try (s tps chg) ;(print (list 'trying nm s (mapcar 'cmp-unnorm-tp tps)))
+	   (try-compile nm s tps)
+	   (unless (equal inls (get-inl-list (list nm)))
+	     (print (list nm s (mapcar 'cmp-unnorm-tp tps) chg))
+	     (return-from iterate-over-inls (iterate-over-inls nm at (1+ it))))))
+    (mapc (lambda (inl &aux (tps (copy-list (car inl))))
+	    (when (eql 0 (caddr inl))
+	      (try 1 (car inl) (list 0 '-> 1)))
+	    (mapl (lambda (ptp pstp &aux (tp (car ptp))(stp (car pstp)))
+		    (unless (tp>= tp stp)
+		      (let ((ntp (tp-and stp (or (parent tp) t))))
+			(setf (car ptp) ntp)
+			(try (caddr inl) tps (list (cmp-unnorm-tp tp) '-> (cmp-unnorm-tp ntp)))
+			(setf (car ptp) tp))))
+		  tps (extend-arg-tps at tps (caddr inl)))
+	    (unless have-2
+	      (when (eq (caddr inl) 1)
+		(try 2 (car inl) (list 1 '-> 2))
+		(let ((tps (copy-list (car inl))))
+		  (mapl (lambda (ptp &aux (tp (car ptp)))
+			  (mapc (lambda (c)
+				  (setf (car ptp) c)
+				  (try 2 tps (list (cmp-unnorm-tp tp) '-> (cmp-unnorm-tp c))))
+				(all-children tp))
+			  (setf (car ptp) tp))
+			tps)))))
+	  (car inls))
+    it))
+
+(defun finalize-inls (nm &aux (*ncompiles* 0)(at (get-arg-types nm))(inls (get-inl-list (list nm))))
+  (restrict-inl-1-tps nm at inls)
+  (list (iterate-over-inls nm at) *ncompiles*  (show-inls nm)))
+
+(defun finalize-all-inls (&aux redo)
+  (maphash (lambda (x y)
+	     (declare (ignore y))
+	     (unless (zerop (car (finalize-inls x)))
+	       (setq redo t)))
+	   *inl-hash*)
+  (when redo
+    (finalize-all-inls)))
+
+(defun dump-inl-hash (f &optional finalize &aux (si::*print-package* t))
+  (when finalize (finalize-all-inls))
+;  (when compress (maphash (lambda (x y) (declare (ignore y)) (compress-inl x)) *inl-hash*))
   (with-open-file (s f :direction :output)
     (prin1 '(in-package :compiler) s)
     (terpri s)
@@ -800,9 +861,9 @@
 				      (list ,@(mapcan
 					       (lambda (x)
 						 `((list ',(pop x) ',(pop x) ',(mapcar 'export-type (car x)))))
-					       (cadr z)))
+					       (sort (cadr z) '< :key (lambda (x) (hash-equal x -5)))))
 				      ,(caddr z)))
-			     (car y))))
+			     (sort (car y) '< :key (lambda (x) (hash-equal x -5))))))
 		s)
 	       (terpri s))
 	  (let (r)
--- gcl27-2.7.1.orig/git.tag
+++ gcl27-2.7.1/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre34"
+"Version_2_7_2pre35"
--- gcl27-2.7.1.orig/h/protoize.h
+++ gcl27-2.7.1/h/protoize.h
@@ -1670,7 +1670,6 @@ int msbrk_end(void);
 object quick_call_function_vec(object,ufixnum,object *);
 int msbrk_initialized(void);
 void *mdlopen(const char *,int);
-void close_dlopen_list(void);
 void set_global_env_defaults(void);
 void disable_aslr(int,char **,char **);
 void set_leak_malloc_on(void);
--- gcl27-2.7.1.orig/lsp/gcl_callhash.lsp
+++ gcl27-2.7.1/lsp/gcl_callhash.lsp
@@ -290,7 +290,7 @@
   (dolist (s (gen-all-ftype-symbols))
     (let* ((f (or (file s) ""))
 	   (sig (car (sym-plist s))))
-      (when (and sig (member f fl :test 'string=));e.g. fns in o/, interpreted, wrong-file
+      (when (and sig (member f fl :test 'search));e.g. fns in o/, interpreted, wrong-file
 	(push (list s sig) r))))
   (write-sys-proclaims1 sp r))
 
--- gcl27-2.7.1.orig/lsp/gcl_iolib.lsp
+++ gcl27-2.7.1/lsp/gcl_iolib.lsp
@@ -533,6 +533,7 @@
 
 (declaim (inline byte-index))
 (defun byte-index (k n)
+  #+:clx-little-endian (declare (ignore n))
   #+:clx-little-endian k #-:clx-little-endian (- n 1 k))
 
 (defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0)(tp (stream-element-type s)))
--- gcl27-2.7.1.orig/lsp/gcl_mnum.lsp
+++ gcl27-2.7.1/lsp/gcl_mnum.lsp
@@ -66,12 +66,12 @@
 (defdlfun (:double    "carg"     ) :dcomplex)
 
 (defun bsqrt (x);this is an instruction, or a jump to main body
-  (declare (long-float x))
+  (check-type x long-float)
   (lit :double "sqrt(" (:double x) ")"))
 (setf (get 'bsqrt 'compiler::cmp-inline) t)
 
 (defun bsqrtf (x);this is an instruction, or a jump to main body
-  (declare (short-float x))
+  (check-type x short-float)
   (lit :float "sqrtf(" (:float x) ")"))
 (setf (get 'bsqrtf 'compiler::cmp-inline) t)
 
--- gcl27-2.7.1.orig/lsp/gcl_subtypep.lsp
+++ gcl27-2.7.1/lsp/gcl_subtypep.lsp
@@ -601,8 +601,10 @@
     (cond ((ntp-subtp x m) x)
 	  ((unless ux (ntp-subtp xy xx)) oy)
 	  ((unless uy (ntp-subtp xx xy)) ox)
-	  ((list (list x m `(and ,(if ux (car lx) (car (nreconstruct-type ox)))
-				 ,(if uy (car ly) (car (nreconstruct-type oy)))))
+	  ((list (list x m
+		       (let ((x (if ux (car lx) (car (nreconstruct-type ox))))
+			     (y (if uy (car ly) (car (nreconstruct-type oy)))))
+			 (if (equal x y) x `(and ,x ,y))))
 		 d t)))))
 
 (defun ntp-or-unknown (ox lx ux oy ly uy d)
@@ -611,8 +613,10 @@
     (cond ((ntp-subtp x m) x)
 	  ((unless ux (ntp-subtp mx my)) oy)
 	  ((unless uy (ntp-subtp my mx)) ox)
-	  ((list (list x m `(or ,(if ux (car lx) (car (nreconstruct-type ox)))
-				,(if uy (car ly) (car (nreconstruct-type oy)))))
+	  ((list (list x m
+		       (let ((x (if ux (car lx) (car (nreconstruct-type ox))))
+			     (y (if uy (car ly) (car (nreconstruct-type oy)))))
+			 (if (equal x y) x `(or ,x ,y))))
 		 d t)))))
 
 (defun ntp-and?c2-nil-p (x y ?c2)
--- gcl27-2.7.1.orig/lsp/gcl_type.lsp
+++ gcl27-2.7.1/lsp/gcl_type.lsp
@@ -4,7 +4,7 @@
 (export '(cmp-norm-tp tp-p
 	  cmp-unnorm-tp
 ;	  type-and type-or1 type>= type<=
-	  tp-not tp-and tp-or tp<= tp>= tp= uniq-tp tsrch uniq-sig
+	  tp-not tp-and tp-or tp<= tp>= tp= uniq-tp tsrch parent all-children uniq-sig
 	  atomic-tp tp-bnds object-tp
 	  cmpt t-to-nil returs-exactly funcallable-symbol-function
 	  infer-tp cnum creal long
@@ -758,6 +758,23 @@
     (when x
       (or (tsrch tp (cdar x)) (caar x)))))
 
+(defun parent (tp &optional (y *useful-type-tree*))
+  (let ((x (member tp y :test (lambda (x y) (unless (tp<= y x) (tp<= x y))) :key 'car)))
+    (when x
+	(or (parent tp (cdar x)) (caar x)))))
+
+(defun children (tp &optional (y (list (cons #tt *useful-type-tree*))))
+  (let ((x (member tp y :test 'tp<= :key 'car)))
+    (when x
+      (or (children tp (cdar x)) (cdar x)))))
+
+(defun flatten-children (c)
+  (mapcan (lambda (x) (cons (car x) (flatten-children (cdr x)))) c))
+
+(defun all-children (tp)
+  (remove-duplicates (flatten-children (children tp))))
+
+
 (defvar *uniq-tp* (make-hash-table :test 'eq))
 
 (defun uniq-tp (tp)
--- gcl27-2.7.1.orig/o/alloc.c
+++ gcl27-2.7.1/o/alloc.c
@@ -1841,12 +1841,12 @@ realloc(void *ptr, size_t size) {
 	VFILLP_SET(x,size);
 	return(ptr);
       } else {
-	memset(x->st.st_self,0,x->st.st_dim);
 	x->st.st_self = alloc_contblock(size);
+	for (i = 0;  i < x->st.st_dim;  i++)
+	  x->st.st_self[i] = ((char *)ptr)[i];
+	memset(ptr,0,x->st.st_dim);
 	x->st.st_dim = size;
 	VSET_MAX_FILLP(x);
-	for (i = 0;  i < size;  i++)
-	  x->st.st_self[i] = ((char *)ptr)[i];
 	return(x->st.st_self);
       }
     }
--- gcl27-2.7.1.orig/o/cfun.c
+++ gcl27-2.7.1/o/cfun.c
@@ -76,14 +76,6 @@ DEFUN("CFDL",object,fScfdl,SI,0,0,NONE,O
   RETURN1(Cnil);
 }
 
-DEFVAR("*DLOPEN-HANDLES*",sSAdlopen_handlesA,SI,Cnil,"");
-
-void
-close_dlopen_list(void) {
-  for (;sSAdlopen_handlesA->s.s_dbind!=Cnil;sSAdlopen_handlesA->s.s_dbind=sSAdlopen_handlesA->s.s_dbind->c.c_cdr)
-    dlclose((void *)fix(sSAdlopen_handlesA->s.s_dbind->c.c_car));
-}
-
 void *
 mdlopen(const char *name,int flags) {
 
@@ -95,13 +87,8 @@ mdlopen(const char *name,int flags) {
   set_leak_malloc_off();
   if ((err=dlerror()))
     FEerror("dlopen failure on ~s: ~s",2,name,make_simple_string(err));
-  if (name) {
-    object x=sSAdlopen_handlesA->s.s_dbind;
-    for (;x!=Cnil && fix(x->c.c_car)!=(fixnum)v;x=x->c.c_cdr);
-    if (x==Cnil)
-      sSAdlopen_handlesA->s.s_dbind=MMcons(make_fixnum((fixnum)v),sSAdlopen_handlesA->s.s_dbind);
+  if (name)
     update_real_maxpage();
-  }
 
   return v;
 }
--- gcl27-2.7.1.orig/o/error.c
+++ gcl27-2.7.1/o/error.c
@@ -33,7 +33,7 @@ object siSuniversal_error_handler;
 object sSterminal_interrupt;
 
 #if defined(__APPLE__)
-char *
+const char *
 strerrordesc_np(int errnum) {
   return (errnum >= 0 && errnum < sys_nerr) ? sys_errlist[errnum] : "Unknown error";
 }
--- gcl27-2.7.1.orig/o/save.c
+++ gcl27-2.7.1/o/save.c
@@ -21,17 +21,17 @@ LFD(siLsave)(void) {
   extern void *shared_lib_start;
   extern jmp_buf gmp_jmp;
   extern object sSreset_lib_syms;
+  object x=vs_base[0];
 
   check_arg(1);
 
-  memset(FN1,0,sizeof(FN1));
-  coerce_to_filename(vs_base[0], FN1);
-
   ifuncall1(sSreset_lib_syms,Cnil);
-  close_dlopen_list();
   frs_top=frs_org-1;
   gcl_cleanup(1);
 
+  memset(FN1,0,sizeof(FN1));
+  coerce_to_filename(x,FN1);
+
   /*FIXME clean this up when done*/
 
   set_leak_malloc_on();
--- gcl27-2.7.1.orig/unixport/init_raw.lsp.in
+++ gcl27-2.7.1/unixport/init_raw.lsp.in
@@ -55,6 +55,7 @@
        (lsp (append x (list "lsp")))
        (cmpnew (append x (list "cmpnew")))
        (h (append x (list "h")))
+       (u (append x (list "unixport")))
        (xgcl-2 (append x (list "xgcl-2")))
        (pcl (append x (list "pcl")))
        (clcs (append x (list "clcs")))
@@ -64,7 +65,7 @@
   (load (make-pathname :name "tk-package" :type "lsp" :directory gtk))
   (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew))
   (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew))
-  (let* ((x (merge-pathnames (make-pathname :name "gcl_cmpnopt" :type "lsp") *system-directory*)))
+  (let* ((x (make-pathname :name "gcl_cmpnopt" :type "lsp" :directory u)))
     (when (probe-file x) (load x)))
   (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp))
   
