From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: Camm Maguire <camm@debian.org>
Date: Oct, 18 2026 14:48:07 +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.

---
The information above should follow the Patch Tagging Guidelines,
see 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/ansi-tests/expt.lsp
+++ gcl27-2.7.1/ansi-tests/expt.lsp
@@ -223,6 +223,34 @@
   (<= (realpart (expt -8 1/3)) 0.0)
   nil)
 
+(deftest expt.29
+  (< (- 10000000000000000 1) 1e16)
+  t)
+
+(deftest expt.30
+  (> (+ 10000000000000000 1) 1e16)
+  t)
+
+(deftest expt.31
+  (eql 1.0e19 (expt 10.0 19))
+  t)
+
+(deftest expt.32
+  (eql 1.0e-19 (expt 10.0 -19))
+  t)
+
+(deftest expt.33
+  (eql 1.0s19 (expt 10.0s0 19))
+  t)
+
+(deftest expt.34
+  (eql 1.0s-19 (expt 10.0s0 -19))
+  t)
+
+(deftest expt.35
+  (typep (EXPT -0.47942553860420301 2) 'long-float)
+  t)
+
 #|
 ;;; FIXME
 ;;; I need to think more about how to do approximate float
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpeval.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpeval.lsp
@@ -708,7 +708,7 @@
   (mapc (lambda (x) (merge-inl cl x pl)) inls))
 
 (defun ?add-inl (cl fms fm)
-  (let* ((tps (mapcar (lambda (x) (ensure-known-type (info-type (caddr x)))) fms))
+  (let* ((tps (mapcar (lambda (x) (bump-unreadable-individuals (ensure-known-type (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
--- gcl27-2.7.1.orig/cmpnew/gcl_cmptype.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmptype.lsp
@@ -492,7 +492,10 @@
 
 (defun complex-contagion (z &aux (z (if (listp z) (car z) z)))
   (cadar (member z
-		 '#.(mapcar (lambda (x &aux (x `(complex ,x))) (list x (cmp-norm-tp x)))
+		 '#.(mapcar (lambda (x &aux (x (case x
+						 ((integer rational) `(or ,x (complex ,x)))
+						 (otherwise `(complex ,x)))))
+			      (list x (cmp-norm-tp x)))
 			   '(integer rational short-float long-float real))
 		 :test 'typep :key 'car)))
 
@@ -951,6 +954,11 @@
        (/-propagator '/ (super-range 'pexpt t1 (super-range '- (type-and #tnegative-real t2))))))))
 (si::putprop 'expt 'expt-propagator 'type-propagator)
 
+(defun scale-float-propagator (f t1 t2)
+  (super-range '* t1 (expt-propagator 'expt #t(integer 2 2) t2)))
+(si::putprop 'scale-float 'scale-float-propagator 'type-propagator)
+
+
 ;; (defun exp-propagator (f t1)
 ;;   (declare (ignore f))
 ;;   (expt-propagator 'expt (if (type>= #tshort-float t1) (object-type (float +e+ 0.0s0)) (object-type +e+)) t1))
@@ -1237,7 +1245,7 @@
   (when a
     (when (constant-type-p b)
       (object-type (funcall f b)))))
-(dolist (l 'si::(expand-array-element-type
+(dolist (l 'si::(expand-array-element-type float-integer-p
 		 cmp-norm-tp sequence-tp-nonsimple-p sequence-tp-lengths make-sequence-element-type
 		 expand-deftype sdata-includes
 		 lookup-simple-typep-fn lookup-typep-fn))
--- gcl27-2.7.1.orig/git.tag
+++ gcl27-2.7.1/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre40"
+"Version_2_7_2pre41"
--- gcl27-2.7.1.orig/lsp/gcl_mnum.lsp
+++ gcl27-2.7.1/lsp/gcl_mnum.lsp
@@ -295,82 +295,87 @@
    (long-float (lit :boolean "__builtin_isnormal(" (:double x) ")"))))
 (setf (get 'isnormal 'compiler::cmp-inline) t)
 
-;FIXME type-propagator
-#.`(defun scale-float (x y)
-     (declare (optimize (safety 1)))
-     (check-type x float)
-     (check-type y integer)
-     (let ((y (max -4096 (min 4096 y))))
-       (typecase x
-	 (short-float (,(mdlsym "ldexpf") x y))
-	 (float (,(mdlsym "ldexp") x y)))))
-
-
-(defun l2imul (x y &optional (ly (integer-length y)) (j 0))
-  (declare (number x y))
-  (if (eql (1+ j) ly)
-      x
-      (let ((z (l2imul (* x x) y ly (1+ j))))
-	(if (logbitp j y) (* x z) z))))
+(defun scale-float (x y)
+  (declare (optimize (safety 1)))
+  (check-type x float)
+  (check-type y integer)
+  (let ((y (max -4096 (min 4096 y))))
+    (typecase x
+      (short-float (#.(mdlsym "ldexpf") x y))
+      (float (#.(mdlsym "ldexp") x y)))))
+
+(dolist (l (mapcar 'mdlsym '("ldexpf" "ldexp")))
+  (setf (get l 'compiler::type-propagator) (get 'scale-float 'compiler::type-propagator)))
+
+(declaim (inline l2imul))
+(defun l2imul (x y &optional (z 1))
+  (if (plusp y)
+      (l2imul (* x x) (ash y -1) (if (oddp y) (* z x) z))
+      z))
 
 (declaim (inline float-integer-p))
-#.`(defun float-integer-p (x)
-     (typecase x
-       (short-float (eql (,(mdlsym "truncf") x) x))
-       (long-float (eql (,(mdlsym "trunc") x) x))))
-
-;FIXME type-propagator
-#.`(defun expt (b e)
-     (declare (optimize (safety 1)))
-     (check-type b number)
-     (check-type e number)
-
-     (typecase b
+(defun float-integer-p (x)
+  (typecase x
+    (short-float (eql (#.(mdlsym "truncf") x) x))
+    (long-float (eql (#.(mdlsym "trunc") x) x))
+    (integer t)))
+
+(defun expt (b e)
+
+  (declare (optimize (safety 1)))
+  (check-type b number)
+  (check-type e number)
+
+  (typecase b
+    (integer
+     (typecase e
+       ((and fixnum (integer 0)) (mpz_pow_ui b e))
+       (fixnum (/ 1 (expt b (- e))))
        (integer
-	(typecase e
-	  ((and fixnum (integer 0)) (mpz_pow_ui b e))
-	  (fixnum (/ 1 (expt b (- e))))
-	  (integer
-	   (case b
-	     ((0 1) (if (minusp e) (/ 1 b) b))
-	     (-1 (if (oddp e) -1 1))
-	     (otherwise (error 'storage-exhausted))))
-	  (rational (expt (float b 0.0) (float e 0.0)))
-	  (float (expt (float b e) e))
-	  (fcomplex (expt (coerce b '(complex short-float)) e))
-	  (t (expt (coerce b '(complex long-float)) e))))
-       (ratio (/ (expt (numerator b) e) (expt (denominator b) e)))
-       (short-float
-	(typecase e
-	  ((or rational short-float)
-	   (if (unless (float-integer-p e) (minusp b))
-	       (expt (complex b 0.0s0) e)
-	       (,(mdlsym "powf") b (float e b))))
-	  (long-float
-	   (if (unless (float-integer-p e) (minusp b))
-	       (expt (complex b 0.0) e)
-	       (,(mdlsym "pow") (float b e) e)))
-	  (fcomplex (expt (complex b 0.0s0) e))
-	  (t (expt (complex b 0.0) e))))
+	(case b
+	  ((0 1) (if (minusp e) (/ 1 b) b))
+	  (-1 (if (oddp e) -1 1))
+	  (otherwise (error 'storage-exhausted))))
+       (rational (expt (float b 0.0) (float e 0.0)))
+       (float (expt (float b e) e))
+       (fcomplex (expt (coerce b '(complex short-float)) e))
+       (t (expt (coerce b '(complex long-float)) e))))
+    (ratio (/ (expt (numerator b) e) (expt (denominator b) e)))
+    (short-float
+     (typecase e
+       ((or rational short-float)
+	(if (unless (float-integer-p e) (minusp b))
+	    (expt (complex b 0.0s0) e)
+	    (#.(mdlsym "powf") b (float e b))))
        (long-float
-	(typecase e
-	  ((or rational float)
-	   (if (unless (float-integer-p e) (minusp b))
-	       (expt (complex b 0.0) e)
-	       (,(mdlsym "pow") b (float e b))))
-	  (t (expt (complex b 0.0) e))))
-       ((complex rational)
-	(typecase e
-	  (integer (if (zerop e) 1 (l2imul (if (minusp e) (/ 1 b) b) (abs e))))
-	  ((or rational short-float fcomplex (complex rational))
-	   (expt (coerce b '(complex short-float)) e))
-	  (t (expt (coerce b '(complex long-float)) e))))
-       (fcomplex
-	(typecase e
-	  ((or rational short-float fcomplex (complex rational))
-	   (,(mdlsym "cpowf") b (coerce e '(complex short-float))))
-	  (t (expt (coerce b '(complex long-float)) e))))
-       (t (,(mdlsym "cpow") b (coerce e '(complex long-float))))))
+	(if (unless (float-integer-p e) (minusp b))
+	    (expt (complex b 0.0) e)
+	    (#.(mdlsym "pow") (float b e) e)))
+       ((complex short-float) (expt (complex b 0.0s0) e))
+       (t (expt (complex b 0.0) e))))
+    (long-float
+     (typecase e
+       ((or rational float)
+	(if (unless (float-integer-p e) (minusp b))
+	    (expt (complex b 0.0) e)
+	    (#.(mdlsym "pow") b (float e b))))
+       (t (expt (complex b 0.0) e))))
+    ((complex rational)
+     (typecase e
+       (integer (if (zerop e) 1 (l2imul (if (minusp e) (/ 1 b) b) (abs e))))
+       ((or rational short-float (complex (or rational short-float)))
+	(expt (coerce b '(complex short-float)) e))
+       (t (expt (coerce b '(complex long-float)) e))))
+    ((complex short-float)
+     (typecase e
+       ((or rational short-float (complex (or rational short-float)))
+	(#.(mdlsym "cpowf") b (coerce e '(complex short-float))))
+       (t (expt (coerce b '(complex long-float)) e))))
+    (t (#.(mdlsym "cpow") b (coerce e '(complex long-float))))))
+
+(dolist (l (cons 'mpz_pow_ui (mapcar 'mdlsym '("pow" "powf" "cpow" "cpowf"))))
+  (setf (get l 'compiler::type-propagator) (get 'expt 'compiler::type-propagator)))
+
 
 
 )
--- gcl27-2.7.1.orig/lsp/gcl_type.lsp
+++ gcl27-2.7.1/lsp/gcl_type.lsp
@@ -724,8 +724,11 @@
 				  non-negative-real non-positive-real
 				  real
 				  fcomplex dcomplex
-				  complex-integer complex-ratio
-				  complex-ratio-integer complex-integer-ratio
+				  complex-integer
+				  (or integer complex-integer)
+				  complex-ratio complex-ratio-integer complex-integer-ratio
+				  (complex rational)
+				  (or rational (complex rational))
 				  complex
 				  number
 				  character structure package hash-table function
