From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: Camm Maguire <camm@debian.org>
Date: Oct, 16 2026 00:47:33 +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/Makefile.am
+++ gcl27-2.7.1/Makefile.am
@@ -467,7 +467,7 @@ ansi_gcl/%.o: ansi_gcl0/%.o | unixport/a
 	cp $(patsubst %.o,%.*,$<) $(@D)
 
 
-%.go: %.o unixport/saved_ansi_gcl #FIXME parallel
+%.go: %.o | unixport/saved_ansi_gcl #FIXME parallel
 	$(CC) $(AM_CPPFLAGS) -I $(<D) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) \
 	      -fno-omit-frame-pointer -pg -c $*.c -o $@
 	cat $*.data >>$@
--- gcl27-2.7.1.orig/Makefile.in
+++ gcl27-2.7.1/Makefile.in
@@ -4798,7 +4798,7 @@ ansi_gcl0/%.o: clcs/%.lisp | unixport/an
 ansi_gcl/%.o: ansi_gcl0/%.o | unixport/ansi_gcl
 	cp $(patsubst %.o,%.*,$<) $(@D)
 
-%.go: %.o unixport/saved_ansi_gcl #FIXME parallel
+%.go: %.o | unixport/saved_ansi_gcl #FIXME parallel
 	$(CC) $(AM_CPPFLAGS) -I $(<D) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) \
 	      -fno-omit-frame-pointer -pg -c $*.c -o $@
 	cat $*.data >>$@
--- gcl27-2.7.1.orig/cmpnew/gcl_cmplet.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmplet.lsp
@@ -46,9 +46,11 @@
 		   "Setting init type of ~s to ~s" (var-name v) (cmp-unnorm-tp (var-type v)))))
 
 (defun new-c1progn (f body)
-  (let ((info (copy-info (cadr body))))
-    (add-info info (cadr f))
-    (list 'progn info (if (eq (car body) 'progn) (cons f (caddr body)) (list f body)))))
+  (if (info-type (cadr f))
+      (let ((info (copy-info (cadr body))))
+	(add-info info (cadr f))
+	(list 'progn info (if (eq (car body) 'progn) (cons f (caddr body)) (list f body))))
+      f))
 	
 ;; (defun side-effects-p (f &optional bl)
 ;;   (cond ((atom f) nil)
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpopt.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpopt.lsp
@@ -519,8 +519,6 @@
       (get 'equalp 'inline-always))
 
 ;;EXPT
- (push '((t t) t #.(flags ans)"number_expt(#0,#1)")
-   (get 'expt 'inline-always))
 (push `((fixnum fixnum) fixnum #.(flags) "fixnum_expt((#0),(#1))")
       (get 'expt 'inline-always))
 (push `(((integer 2 2) fixnum) fixnum #.(flags) "(1L<<(#1))")
@@ -1111,6 +1109,11 @@
 ;DEPOSIT-FIELD
 (push '((fixnum (cons fixnum fixnum) fixnum) t #.(compiler::flags) "fixnum_dpf(fix(#1->c.c_car),fix(#1->c.c_cdr),#0,#2)") (get 'deposit-field 'compiler::inline-always))
 
+;si::MAKE-COMPLEX
+(push '(((integer 5 5) cnum cnum) dcomplex #.(flags rfa)"(#1)+I*(#2)")
+   (get 'si::make-complex 'inline-always))
+(push '(((integer 4 4) cnum cnum) fcomplex #.(flags rfa)"(#1)+I*(#2)")
+   (get 'si::make-complex 'inline-always))
 
 ;;MINUSP
 (push '((t) boolean #.(flags) "immnum_minusp(#0)") (get 'minusp 'inline-always));"number_compare(small_fixnum(0),#0)>0"
--- gcl27-2.7.1.orig/git.tag
+++ gcl27-2.7.1/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre39"
+"Version_2_7_2pre40"
--- gcl27-2.7.1.orig/lsp/gcl_mnum.lsp
+++ gcl27-2.7.1/lsp/gcl_mnum.lsp
@@ -58,6 +58,8 @@
 
 (defrlibmfun1 "erf")
 (defrlibmfun1 "erfc")
+(defrlibmfun1 "trunc")
+(defrlibmfun1 "ceil")
 
 (defrlibmfun1 "lgamma")
 (defrlibmfun1 "tgamma")
@@ -65,6 +67,9 @@
 (defdlfun (:float    "cargf"     ) :fcomplex)
 (defdlfun (:double    "carg"     ) :dcomplex)
 
+(defdlfun (:float "ldexpf") :float :int)
+(defdlfun (:double "ldexp") :double :int)
+
 (defun bsqrt (x);this is an instruction, or a jump to main body
   (check-type x long-float)
   (lit :double "sqrt(" (:double x) ")"))
@@ -290,6 +295,84 @@
    (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))))
+
+(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
+       (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))))
+       (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))))))
+
+
 )
 
 #-c99
--- gcl27-2.7.1.orig/o/num_co.c
+++ gcl27-2.7.1/o/num_co.c
@@ -196,9 +196,15 @@ double_to_rational(double d) {
   int h,l,e,s;
 
   integer_decode_double(d,&h,&l,&e,&s);
+
+  mpz_set_si(MP(big_fixnum5),1);
+  mpz_mul_2exp(MP(big_fixnum5),MP(big_fixnum5),labs(e));
+
   x=number_times((h!=0 || l<0) ? bignum2(h,l) : make_fixnum(l),
-		 number_expt(make_fixnum(2),make_fixnum(e)));
+		 e<0 ? number_divide(small_fixnum(1),big_fixnum5) : big_fixnum5);
+
   if (s<0) x=number_negate(x);
+
   return x;
 
 }
@@ -545,31 +551,6 @@ DEFUNM("DECODE-FLOAT",object,fLdecode_fl
 
 }
 
-DEFUN("SCALE-FLOAT",object,fLscale_float,LISP,2,2,NONE,OO,IO,OO,OO,(object x,fixnum k),"") {
-
-  double d;
-  int e;
-
-  if (type_of(x) == t_shortfloat)
-    d = sf(x);
-  else
-    d = lf(x);
-
-  e = double_exponent(d) + k;
-
-  /* Upper bound not needed, handled by floating point overflow */
-  /* this checks if we're in the denormalized range */
-  if (!ISNORMAL(d) || (type_of(x) == t_shortfloat && e <= -126/*  || e >= 130 */) ||
-      (type_of(x) == t_longfloat && (e <= -1022 /* || e >= 1026 */))) {
-    for (;k>0;d*=2.0,k--);
-    for (;k<0;d*=0.5,k++);
-  } else
-    d = set_exponent(d, e);
-
-  RETURN1(type_of(x) == t_shortfloat ? make_shortfloat((shortfloat)d) : make_longfloat(d));
-
-}
-
 DEFUNM("INTEGER-DECODE-FLOAT",object,fLinteger_decode_float,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") {
 
   int h,l,e,s;
--- gcl27-2.7.1.orig/o/num_sfun.c
+++ gcl27-2.7.1/o/num_sfun.c
@@ -109,166 +109,6 @@ number_exp(object x)
 	}
 }
 
-static inline object
-number_fix_iexpt(object x,fixnum y,fixnum ly,fixnum j) {
-  object z;
-  
-  if (j+1==ly) return x;
-  z=number_fix_iexpt(number_times(x,x),y,ly,j+1);
-  return fixnum_bitp(j,y) ? number_times(x,z) : z;
-}
-
-static inline object
-number_big_iexpt(object x,object y,fixnum ly,fixnum j) {
-  object z;
-  
-  if (j+1==ly) return x;
-  z=number_big_iexpt(number_times(x,x),y,ly,j+1);
-  return mpz_tstbit(MP(y),j) ? number_times(x,z) : z;
-
-}
-
-static inline fixnum
-number_contagion_index(object x) {
-
-  switch(type_of(x)) {
-  case t_fixnum:
-  case t_bignum:
-  case t_ratio:
-    return 0;
-  case t_shortfloat:
-    return 1;
-  case t_longfloat:
-    return 2;
-  case t_complex:
-    return 3+number_contagion_index(x->cmp.cmp_real);
-  }
-  return 0;
-}
-
-static inline object
-number_zero_expt(object x,fixnum cy) {
-
-  enum type cx=number_contagion_index(x);
-
-  if (gcl_is_not_finite(x))/*FIXME, better place?*/
-    return number_exp(number_times(number_nlog(x),small_fixnum(0)));
-
-  switch (cx<cy ? cy : cx) {
-  case 3:case 0:
-    return make_fixnum(1);
-  case 1:
-    return make_shortfloat(1.0);
-  case 2:
-    return make_longfloat(1.0);
-  case 4:
-    return make_complex(make_shortfloat(1.0),make_fixnum(0));
-  case 5:
-    return make_complex(make_longfloat(1.0),make_fixnum(0));
-  default:
-    FEwrong_type_argument(sLnumber,x);
-    return Cnil;
-  }
-
-}
-
-
-static inline object
-number_ui_expt(object x,fixnum fy) {
-
-  switch (type_of(x)) {
-  case t_fixnum:
-    { 
-      fixnum fx=fix(x);
-      object z;
-      MPOP(z=,mpz_ui_pow_ui,labs(fx),fy);
-      if (fx<0&&(fy&0x1)) return number_negate(z); else return z;
-    }
-  case t_bignum:
-    MPOP(return,mpz_pow_ui,MP(x),fy);
-  case t_ratio:
-    return make_ratio(number_ui_expt(x->rat.rat_num,fy),number_ui_expt(x->rat.rat_den,fy),1);
-
-  case t_shortfloat:
-  case t_longfloat:
-  case t_complex:
-    {
-      fixnum ly=fixnum_length(fy);
-
-      return ly ? number_fix_iexpt(x,fy,ly,0) : number_zero_expt(x,0);
-
-    }
-	
-  default:
-    FEwrong_type_argument(sLnumber,x);
-    return Cnil;
-  }
-    
-}
-
-static inline object
-number_ump_expt(object x,object y) {
-  return number_big_iexpt(x,y,fix(integer_length(y)),0);
-}
-
-static inline object
-number_log_expt(object x,object y) {
-  return number_zerop(y) ? number_zero_expt(x,number_contagion_index(y)) : number_exp(number_times(number_nlog(x),y));
-}
-
-static inline object
-number_invert(object x,object y,object z) {
-
-  switch (type_of(z)) {
-  case t_shortfloat:
-    if (!ISNORMAL(sf(z))) return number_log_expt(x,y);
-    break;
-  case t_longfloat:
-    if (!ISNORMAL(lf(z))) return number_log_expt(x,y);
-    break;
-  }
-  return number_divide(small_fixnum(1),z);
-}
-    
-
-static inline object
-number_si_expt(object x,object y) {
-  switch (type_of(y)) {
-  case t_fixnum:
-    { 
-      fixnum fy=fix(y);
-      if (fy>=0)
-	return number_ui_expt(x,fy);
-      if (fy==MOST_NEGATIVE_FIX)
-	return number_invert(x,y,number_ump_expt(x,number_negate(y)));
-      return number_invert(x,y,number_ui_expt(x,-fy));
-    }
-  case t_bignum:
-    return big_sign(y)<0 ? number_invert(x,y,number_ump_expt(x,number_negate(y))) : number_ump_expt(x,y);
-  case t_ratio:
-  case t_shortfloat:
-  case t_longfloat:
-  case t_complex:
-    return number_log_expt(x,y);
-  default:
-    FEwrong_type_argument(sLnumber,y);
-    return Cnil;
-  }
-}
-
-object
-number_expt(object x, object y) {
-
-  if (number_zerop(x)&&y!=small_fixnum(0)) {
-    if (!number_plusp(type_of(y)==t_complex?y->cmp.cmp_real:y))
-      FEerror("Cannot raise zero to the power ~S.", 1, y);
-    return(number_times(x, y));
-  }
-
-  return number_si_expt(x,y);
-
-}
-
 static object
 number_nlog(object x)
 {
@@ -369,8 +209,10 @@ number_sqrt(object x)
 	}
 
 COMPLEX:
-	{extern object plus_half;
-	z = number_expt(x, plus_half);}
+	{
+	  extern object plus_half;
+	  z = number_exp(number_times(plus_half,number_nlog(x)));
+	}
 	vs_reset;
 	return(z);
 }
@@ -673,14 +515,6 @@ LFD(Lexp)(void)
 	vs_base[0] = number_exp(vs_base[0]);
 }
 
-DEFUN("EXPT",object,fLexpt,LISP,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
-
-  check_type_number(&x);
-  check_type_number(&y);
-  RETURN1(number_expt(x,y));
-
-}
-
 LFD(Llog)(void)
 {
 	int narg;
