Description: <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.
 .
 gcl27 (2.7.1-7) unstable; urgency=medium
 .
   * Version_2_7_2pre6
   * Bug fix: "[INTL:nl] Dutch debconf templates translation", thanks to Frans Spiesschaert (Closes: #1106482).
Author: Camm Maguire <camm@debian.org>
Bug-Debian: https://bugs.debian.org/1106482

---
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-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
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>
Last-Update: 2025-05-29

--- gcl27-2.7.1.orig/Makefile.am
+++ gcl27-2.7.1/Makefile.am
@@ -270,7 +270,7 @@ unixport/gcl_cmpnopt_pre_gcl.lsp: # FIXM
 	touch $@
 unixport/gcl_cmpnopt_%.lsp: unixport/lib%.a | unixport/%
 	echo "(mapc (quote load) (directory \"$*/*.hsh\"))" \
-	     "(compiler::dump-inl-hash \"$@\")" | $|
+	     "(compiler::dump-inl-hash \"$@\" t)" | $|
 
 $(addprefix unixport/lib,$(addsuffix .a,pre_gcl $(MY_DIRS))): \
 unixport/lib%.a: lib/libbase_gcl.a $(LIBGPROF) unixport/sys_%.o
@@ -302,7 +302,7 @@ unixport/lib%.a: | xbin/ar_merge
 %/recompile: | unixport/%
 	$| -batch \
 	   -eval "(let ((si::*do-recomp-output-dir* \"$(@D)\")) (si::do-recomp t))" \
-	   -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\")"
+	   -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\" t)"
 	touch $@
 
 unixport/sys_%.o: unixport/sys_init.c
@@ -418,7 +418,7 @@ mod_gcl/%.o: mod_gcl0/%.o | unixport/mod
 	rm -rf $*/*.o
 	echo "(mapc (quote load) (list $(patsubst %,\"%\",$^)))" \
 	     "(pcl::compile-pcl)" \
-	     "(compiler::dump-inl-hash \"$@\")" | $|
+	     "(compiler::dump-inl-hash \"$@\" t)" | $|
 
 %/all.hsh: %/p1.lisp %/all.hs1 | unixport/pcl_gcl
 	echo "pcl conflicts:"
--- gcl27-2.7.1.orig/Makefile.in
+++ gcl27-2.7.1/Makefile.in
@@ -4701,7 +4701,7 @@ unixport/gcl_cmpnopt_pre_gcl.lsp: # FIXM
 	touch $@
 unixport/gcl_cmpnopt_%.lsp: unixport/lib%.a | unixport/%
 	echo "(mapc (quote load) (directory \"$*/*.hsh\"))" \
-	     "(compiler::dump-inl-hash \"$@\")" | $|
+	     "(compiler::dump-inl-hash \"$@\" t)" | $|
 
 $(addprefix unixport/lib,$(addsuffix .a,pre_gcl $(MY_DIRS))): \
 unixport/lib%.a: lib/libbase_gcl.a $(LIBGPROF) unixport/sys_%.o
@@ -4728,7 +4728,7 @@ unixport/lib%.a: | xbin/ar_merge
 %/recompile: | unixport/%
 	$| -batch \
 	   -eval "(let ((si::*do-recomp-output-dir* \"$(@D)\")) (si::do-recomp t))" \
-	   -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\")"
+	   -eval "(compiler::dump-inl-hash \"$(@D)/all.hsh\" t)"
 	touch $@
 
 unixport/sys_%.o: unixport/sys_init.c
@@ -4843,7 +4843,7 @@ mod_gcl/%.o: mod_gcl0/%.o | unixport/mod
 	rm -rf $*/*.o
 	echo "(mapc (quote load) (list $(patsubst %,\"%\",$^)))" \
 	     "(pcl::compile-pcl)" \
-	     "(compiler::dump-inl-hash \"$@\")" | $|
+	     "(compiler::dump-inl-hash \"$@\" t)" | $|
 
 %/all.hsh: %/p1.lisp %/all.hs1 | unixport/pcl_gcl
 	echo "pcl conflicts:"
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpeval.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpeval.lsp
@@ -648,6 +648,7 @@
   (list (this-safety-level)
 	(mapcar (lambda (x) (assert (eq (car x) 'ub)) (third x)) (when lf (fifth form)))
 	(cons (when lf (third form)) (info-type (cadr form)))
+	(ninth form)
 	(if lf (remove-comment (fourth form)) "")))
 
 (defun cl-to-fn (cl)
@@ -672,33 +673,77 @@
 			   (when (eql (length x) (length cy))
 			     (every 'type<= x cy))))))))
 
+(defun skip-inl (fm tps tr)
+  (or (member-if 'atomic-tp tps)
+      (atomic-tp (info-type (cadr fm)))
+      (exit-to-fmla-p)
+      (member nil tr)
+      (set-difference
+       (let ((i -1)) (mapcan (lambda (x &aux (y (incf i))) (unless (atomic-tp x) (list y))) tps))
+       tr)))
+
+(defun ?update-fm-propagator (fm cl tr tps)
+  (when (symbolp (car cl))
+    (when (get (car cl) 'type-propagator);?more
+      (when (eq (car fm) 'lit)
+	(when (member-if 'integerp tr) ;otherwise no point
+	  (push (list (car cl) tr tps) (ninth fm)))))))
+
+(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)))
+	     (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)
+			       "Adding inl-hash ~s: ~s" (car cl) x)
+		(push x (car pl)))))))
+
+(defun merge-inls (s inls &aux (cl (list s))(pl (get-inl-list cl t)))
+  (mapc (lambda (x) (merge-inl cl x pl)) inls))
+
 (defun ?add-inl (cl fms fm)
-  (unless (or (member-if 'atomic-tp fms :key (lambda (x) (info-type (caddr x))))
-	      (atomic-tp (info-type (cadr fm))) (exit-to-fmla-p)); (inls-match cl fms)
-    (let* ((tps (mapcar (lambda (x) (info-type (caddr x))) fms))
-	   (tr (mapcar (lambda (x &aux (v (car (last x))))
-			 (when (and (consp v) (eq (car v) 'var))
-			   (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME
-		       (if (eq (car fm) 'var) (list (list fm)) (fifth fm))))
-	   (nat (let ((i -1)) (mapcan (lambda (x &aux (y (incf i))) (unless (atomic-tp x) (list y))) tps))))
-      (unless (or (member nil tr) (set-difference nat tr))
-	(let* ((pl (get-inl-list cl t))
-	       (inl (lit-inl2 fm))
-	       (z (member-if (lambda (x) (can-coalesce x tr inl tps)) (car pl))))
-	  (cond (z (coalesce-inl cl (car z) tps (cdr (third 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)
-				  "Adding inl-hash ~s: ~s" (car cl) x)
-		   (push x (car pl))))))))))
+  (let* ((tps (mapcar (lambda (x) (info-type (caddr x))) fms))
+	 (tr (mapcar (lambda (x &aux (v (car (last x))))
+		       (when (and (consp v) (eq (car v) 'var))
+			 (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME
+		     (if (eq (car fm) 'var) (list (list fm)) (fifth fm)))))
+    (?update-fm-propagator fm cl tr tps)
+    (unless (skip-inl fm tps tr)
+      (merge-inl cl (list* tps tr (lit-inl2 fm)) (get-inl-list cl t)))))
 
 (defun prepend-comment (form s)
   (if *annotate*
       (si::string-concatenate "/* " (prin1-to-string form) " */" (remove-comment s))
       s))
 
-(defun apply-inl (cl fms &aux (inl (inls-match cl fms)))
+(defvar *apply-inl-hash* t)
+
+(defun update-info-type-from-inl (i inl fms &aux (tps (mapcar (lambda (x) (info-type (caddr x))) fms)))
+  (setf (info-type i)
+	(reduce 'type-and
+		(cons (cdr (fifth inl))
+		      (mapcar (lambda (x)
+				(or
+				 (result-type-from-args
+				  (pop x)
+				  (let ((i -1))
+				    (mapcar (lambda (tp &aux (p (position (incf i) (car x))))
+					      (if p (nth (nth p (second inl)) tps) tp))
+					    (cadr x))))
+				 t))
+			      (sixth inl)))
+		:initial-value (info-type i))))
+
+(defun merge-fm-propagator (x fms inl)
+  (let* ((tr (mapcar (lambda (x &aux (v (car (last x))))
+ 		       (when (and (consp v) (eq (car v) 'var))
+ 			 (position (cddr v) fms :key 'cdddr :test 'equalp)));FIXME
+ 		     (fifth x))))
+    (mapc (lambda (y) (?update-fm-propagator x y tr (caddr y)))
+	  (sixth inl))))
+
+
+(defun apply-inl (cl fms &aux (inl (when *apply-inl-hash* (inls-match cl fms))))
   (when inl
     (let* ((c1fms (mapcar (lambda (x) (cdr (nth x fms))) (second inl))))
       (unless (member-if-not (lambda (x)
@@ -706,35 +751,56 @@
 				 (var (eq (var-kind (caaddr x)) 'lexical))
 				 ((lit location) t)))
 			     c1fms)
-	(cond ((zerop (length (car (last inl))))
-	       (let* ((x (car c1fms))(h (pop x))
-		      (i (copy-info (pop x))))
-		 (setf (info-type i) (type-and (cdr (fifth inl)) (info-type i)))
-		 (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply)
-				"Applying var inl-hash ~s" (car cl))
-		 (list* h i x)))
-	      ((let ((x (c1lit (list (car (fifth inl)) (prepend-comment (cons 'applied cl) (car (last inl)))) (mapcar 'list  (fourth inl) c1fms))))
-		 (setf (info-type (cadr x)) (type-and (cdr (fifth inl)) (info-type (cadr x))))
-		 (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply)
-				"Applying inl-hash ~s: ~s: ~s" (car cl) (fourth x))
-		 x)))))))
+	(let* ((z (zerop (length (car (last inl)))))
+	       (x (if z
+		      (list* (caar c1fms) (copy-info (cadar c1fms)) (cddar c1fms))
+		      (c1lit (list (car (fifth inl)) (prepend-comment (cons 'applied cl) (car (last inl))))
+			     (mapcar 'list  (fourth inl) c1fms)))))
+	  (unless z (merge-fm-propagator x fms inl))
+	  (update-info-type-from-inl (cadr x) inl fms)
+	  (keyed-cmpnote (list (car cl) 'inl-hash 'inl-hash-apply)
+			 "Applying inl-hash ~s: ~s" (car cl) (unless z (fourth x)))
+	  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*))))))))
 
-(defun dump-inl-hash (f)
+(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*))
   (with-open-file (s f :direction :output)
     (prin1 '(in-package :compiler) s)
     (terpri s)
     (maphash (lambda (x y)
 	       (prin1
-		`(setf (gethash ',x *inl-hash*)
-		       (list
-			(list
-			 ,@(mapcar (lambda (z)
-				     `(list (mapcar 'uniq-tp ',(mapcar 'export-type (pop z)))
-					    ',(pop z) ',(pop z) ',(pop z)
-					    (cons ',(caar z) (uniq-tp ',(cdar z)))
-					    ,(cadr z)))
-				   (car y)))))
-		      s)
+		`(merge-inls
+		  ',x
+		  (list
+		   ,@(mapcar (lambda (z)
+			       `(list (mapcar 'uniq-tp ',(mapcar 'export-type (pop z)))
+				      ',(pop z) ',(pop z) ',(pop z)
+				      (cons ',(caar z) (uniq-tp ',(cdar z)))
+				      (list ,@(mapcan
+					       (lambda (x)
+						 `((list ',(pop x) ',(pop x) ',(mapcar 'export-type (car x)))))
+					       (cadr z)))
+				      ,(caddr z)))
+			     (car y))))
+		s)
 	       (terpri s))
 	     *inl-hash*))
   nil)
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpinline.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpinline.lsp
@@ -355,7 +355,7 @@
     (coerce-loc *value-to-go* type)))
     
 
-(defun lit-loc (key inl args bind safety oargs stores &aux (tp (get key 'cmp-lisp-type)))
+(defun lit-loc (key inl args bind safety oargs syms stores &aux (tp (get key 'cmp-lisp-type)))
   (declare (ignore bind safety oargs stores))
   (let ((sig (list (mapcar (lambda (x) (info-type (cadr x))) args) tp))) 
     (get-inline-loc (list (car sig) (cadr sig) (flags rfa) inl) args)))
--- gcl27-2.7.1.orig/cmpnew/gcl_cmptag.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmptag.lsp
@@ -130,7 +130,7 @@
 			 "Initializing ~s at label ~s:~%   type from ~s to ~s,~%   store from ~s to ~s"
 			 (car x) (tag-name z) (var-type (car x)) (cadr x)
 			 (var-store (car x)) (if (eq (var-store (car x)) (caddr x)) (caddr x) +opaque+))
-	  (do-setq-tp (car x) 'mch-set (cadr x));FIXME too prolix
+	  (do-setq-tp (car x) '(mch-set) (cadr x));FIXME too prolix
 	  (push-vbinds (car x) (caddr x)))
 	l))
 
--- gcl27-2.7.1.orig/cmpnew/gcl_cmptop.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmptop.lsp
@@ -865,14 +865,14 @@
 				   (incf i lff)(copy-list ff));FIXME?
 				((incf i)(list x))))
 			nargs))
-	 (form (list 'lit info key inl nargs nil lev oargs (make-vs info))))
+	 (form (list 'lit info key inl nargs nil lev oargs nil (make-vs info))))
     (when (find #\= inl)
       (c1side-effects nil)
       (setf (info-flags info) (logior (iflags side-effects) (info-flags info))))
     (setf (sixth form) (new-bind form))
     form))
 
-(defun c2lit (key inl args bind safety &rest r &aux (oargs (pop r)) (stores (car r)) (tp (get key 'cmp-lisp-type :opaque)))
+(defun c2lit (key inl args bind safety &rest r &aux (oargs (pop r)) (syms (pop r)) (stores (car r)) (tp (get key 'cmp-lisp-type :opaque)))
   (declare (dynamic-extent r))
   (let* ((*inline-blocks* 0)
 	 (*restore-avma*  *restore-avma*)
@@ -881,7 +881,7 @@
 	 (*compiler-new-safety* *compiler-new-safety*)
 	 (*compiler-push-events* *compiler-push-events*))
     (local-compile-decls `((safety ,safety)))
-    (unwind-exit (lit-loc key inl args bind safety oargs stores) nil
+    (unwind-exit (lit-loc key inl args bind safety oargs syms stores) nil
 		 (cons 'values (if (equal tp #t(returns-exactly)) 0 1)))
     (close-inline-blocks)))
 
--- gcl27-2.7.1.orig/cmpnew/gcl_cmptype.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmptype.lsp
@@ -731,7 +731,7 @@
 	  (keyed-cmpnote (list (var-name v) 'type-propagation 'type 'bump-cons-tp-if)
 			 "Bumping var ~s cons type ~s -> ~s, tp ~s"
 			 (var-name v) (cmp-unnorm-tp (var-type v)) (cmp-unnorm-tp (tp-or (var-type v) tp)) (cmp-unnorm-tp tp))
-	  (do-setq-tp v 'bump-cons-tp-if (tp-or (var-type v) tp))))
+	  (do-setq-tp v '(bump-cons-tp-if) (tp-or (var-type v) tp))))
       (let ((s (var-store v)))
 	(when (listp s);FIXME
 	  (dolist (b s)
--- gcl27-2.7.1.orig/git.tag
+++ gcl27-2.7.1/git.tag
@@ -1,2 +1,2 @@
-"Version_2_7_2ore5"
+"Version_2_7_2pre6"
 
--- gcl27-2.7.1.orig/info/c-interface.texi
+++ gcl27-2.7.1/info/c-interface.texi
@@ -50,7 +50,7 @@ Unsigned versions available are:
 
 Complex float and complex double types can be access via:
 
-    :fcomplex :dcomples
+    :fcomplex :dcomplex
 
 Pointers to types available are
 
--- gcl27-2.7.1.orig/o/assignment.c
+++ gcl27-2.7.1/o/assignment.c
@@ -184,7 +184,7 @@ DEFUN("FSET",object,fSfset,SI,2,2,NONE,O
     sym->s.s_gfdef = function;
     sym->s.s_mflag = TRUE;
   } else {
-    sym->s.s_gfdef = function;
+    sym->s.s_gfdef = function; /*FIXME*/
     sym->s.s_mflag = FALSE;
   }
   
--- gcl27-2.7.1.orig/o/num_arith.c
+++ gcl27-2.7.1/o/num_arith.c
@@ -1001,25 +1001,25 @@ number_divide(object x, object y)
 
 	case t_complex:
 	COMPLEX:
+
+	  x = number_to_complex(x);
+	  y = number_to_complex(y);
+
 	{
-		object z1, z2, z3;
 
-		x = number_to_complex(x);
-		y = number_to_complex(y);
-		z1 = number_times(y->cmp.cmp_real, y->cmp.cmp_real);
-		z2 = number_times(y->cmp.cmp_imag, y->cmp.cmp_imag);
-		z3 = number_plus(z1, z2);
-		/* if (number_zerop(z3 = number_plus(z1, z2))) DIVISION_BY_ZERO(sLD,list(2,x,y)); */
-		z1 = number_times(x->cmp.cmp_real, y->cmp.cmp_real);
-		z2 = number_times(x->cmp.cmp_imag, y->cmp.cmp_imag);
-		z1 = number_plus(z1, z2);
-		z = number_times(x->cmp.cmp_imag, y->cmp.cmp_real);
-		z2 = number_times(x->cmp.cmp_real, y->cmp.cmp_imag);
-		z2 = number_minus(z, z2);
-		z1 = number_divide(z1, z3);
-		z2 = number_divide(z2, z3);
-		z = make_complex(z1, z2);
-		return(z);
+	  object yl=y->cmp.cmp_real,ys=y->cmp.cmp_imag,xl=x->cmp.cmp_real,xs=x->cmp.cmp_imag,r,dn,w;
+	  int s;
+
+	  if ((s=(number_compare(number_abs(y->cmp.cmp_real),number_abs(y->cmp.cmp_imag))<0))) {
+	    w=ys;ys=yl;yl=w;w=xs;xs=xl;xl=w;
+	  }
+
+	  r=number_divide(ys,yl);
+	  dn=number_plus(yl,number_times(r,ys));
+	  w=number_times(xl,r);
+
+	  return make_complex(number_divide(number_plus(xl,number_times(xs,r)),dn),
+			      number_divide(s ? number_minus(w,xs) : number_minus(xs,w),dn));
 	}
 
 	default:
--- gcl27-2.7.1.orig/xgcl-2/gcl_editors.lsp
+++ gcl27-2.7.1/xgcl-2/gcl_editors.lsp
@@ -131,7 +131,7 @@
     (draw-line-xy w (offsetx + 12) (offsety + 35)
 		    (offsetx + 12)
 		    (offsety + 48 + hdel * ((val - nmin) / ndel)) 7)
-    (editors-update-in-box val w offsetx offsety 40 20))))
+    (editors-update-in-box val w offsetx offsety 40 20)))
 
 
 ; 20 Nov 91; 03 Dec 91; 15 Oct 93; 02 Dec 93; 08 Jan 04
