From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: Camm Maguire <camm@debian.org>
Date: Oct, 08 2026 12:46:53 +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 mod_gcl/recompile #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 mod_gcl/recompile #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_cmpif.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpif.lsp
@@ -79,11 +79,32 @@
 
 (defun real-bnds (t1) (num-type-bounds t1))
 
-(defun two-tp-inf (fn t2 &aux (t2 (real-bnds (type-and #treal t2))))
+(defun =-bnds (tp &aux (ctpn (si::tp-type (tp-and tp #t(complex* real (not (real 0 0)))))))
+  (list (real-bnds (real-imag-tp ctpn t)) (real-bnds (real-imag-tp ctpn nil))
+	(real-bnds (tp-or (tp-and tp #treal)
+			  (real-imag-tp (si::tp-type (tp-and tp #t(complex* real (real 0 0)))) t)))))
+
+(defun =-tp (tp &aux (l (=-bnds tp)))
+  (flet ((f (x) (when x (cons 'real x))))
+    (tp-or (cmp-norm-tp `(complex* ,(f (car l)) ,(f (cadr l))))
+	   (tp-or (cmp-norm-tp (f (caddr l)))
+		  (cmp-norm-tp `(complex* ,(f (caddr l)) (real 0 0)))))))
+
+(defun atomic=-tp (tp &aux (l (=-bnds tp)))
+  (flet ((f (x) (when (and (numberp (car x)) (numberp (cadr x)) (= (car x) (cadr x))) (car x))))
+    (cond ((caddr l)
+	   (unless (or (car l) (cadr l))
+	     (let ((r (f (caddr l))))
+	       (when r
+		 (cmp-norm-tp `(or (real ,r ,r) (complex* (real ,r ,r) (real 0 0))))))))
+	  ((let ((cr (f (car l)))(ci (f (cadr l))))
+	     (when (and cr ci)
+	       (cmp-norm-tp `(complex* (real ,cr ,cr) (real ,ci ,ci)))))))))
+
+(defun two-tp-inf (fn t2o &aux (t2o (type-and t2o #tnumber))(t2 (real-bnds (tp-and #treal t2o))))
   (case fn
-	(= (cmp-norm-tp `(real ,(or (car t2) '*) ,(or (cadr t2) '*))))
-	(/= (if (when (numberp (car t2)) (eql (car t2) (cadr t2)))
-		(cmp-norm-tp `(and number (not (real ,@t2)))) #treal))
+	(= (=-tp t2o))
+	(/= (tp-and #tnumber (tp-not (atomic=-tp t2o))))
 	(>  (cmp-norm-tp `(real ,(cond ((numberp (car t2)) (list (car t2))) ((car t2)) ('*)))))
 	(>= (cmp-norm-tp `(real ,(or (car t2) '*))))
 	(<  (cmp-norm-tp `(real * ,(cond ((numberp (cadr t2)) (list (cadr t2))) ((cadr t2)) ('*)))))
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpmulti.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpmulti.lsp
@@ -272,9 +272,11 @@
 	 (tp (if (eq tp '*) (make-list (length vars) :initial-element t) (cdr tp))))
     (do ((v vars (cdr v)) (t1 tp (cdr t1)))
 	((not v))
-	(set-var-init-type (car v) (if t1 (car t1) #tnull))))
-
-  (dolist (v vars) (push-var v init-form))
+      (let* ((ntp (if t1 (car t1) #tnull))
+	     (ni (copy-info (cadr init-form))))
+	(setf (info-type ni) ntp)
+	(set-var-init-type (car v) ntp)
+	(push-var (car v) (list* (car init-form) ni (cddr init-form))))))
 
   (check-vdecl vnames ts is)
 
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpopt.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpopt.lsp
@@ -296,34 +296,43 @@
 (push '((t t) t #.(flags ans) "number_divide(#0,#1)") (get 'si::number-divide 'inline-always))
 (push '((cnum cnum) cnum #.(flags) "(#0)/(#1)") (get 'si::number-divide 'inline-always))
 
-;;/=
- (push '((t t) boolean #.(flags rfa)"immnum_ne(#0,#1)")
-   (get '/= 'inline-always))
-(push '((cnum cnum) boolean #.(flags rfa)"(#0)!=(#1)") (get '/= 'inline-always))
-
-;;<
- (push '((t t) boolean #.(flags rfa)"immnum_lt(#0,#1)") (get '< 'inline-always))
-(push '((creal creal) boolean #.(flags rfa)"(#0)<(#1)") (get '< 'inline-always))
+(deftype creals nil `(or float (and fixnum (signed-byte #.(1+ +sfbits+)))))
+(deftype creall nil `(or long-float (and fixnum (signed-byte #.(1+ +lfbits+)))))
+(deftype cnums nil `(or creals fcomplex dcomplex))
+(deftype cnuml nil `(or creall dcomplex))
+
+(labels ((cop (op) (or (cdr (assoc op '((= . ==)(/= . !=)))) op))
+	 (minl (args s) `(,args boolean #.(flags rfa) ,s))
+	 (str (s) (string-downcase (remove #\- (string s))))
+	 (minla (op) (ms "((#0)" (cop op) "(#1))"))
+	 (minlb (op args &aux (p (position 'fixnum args))(s (nth (- 1 p) args)))
+	   (ms "(FIX" (if (member s '(short-float fcomplex)) "S" "L") "FSP(#" p ") ? "
+	       "number_compare(make_" (if (zerop p) "fixnum" (str s)) "(#0),make_"
+	       (if (zerop p) (str s) "fixnum") "(#1))" (cop op) "0 : " (minla op) ")"))
+	 (minls (op args) (minl args (minlb op args)))
+	 (minlf (op args) (minl args (minla op)))
+	 (minlt (s iap)
+	   (mapc (lambda (x) (when x (push x (get s 'inline-always))))
+		 (list
+		  (minl '(t t) (ms "immnum_" iap "(#0,#1)"))
+		  (unless (eq (cop s) s) (minls s '(fixnum fcomplex)))
+		  (minls s '(fixnum short-float))
+		  (unless (eq (cop s) s) (minls s '(fcomplex fixnum)))
+		  (minls s '(short-float fixnum))
+		  (unless (eq (cop s) s) (minls s '(fixnum dcomplex)))
+		  (minls s '(fixnum long-float))
+		  (unless (eq (cop s) s)  (minls s '(dcomplex fixnum)))
+		  (minls s '(long-float fixnum))
+		  (minlf s '(fixnum fixnum))
+		  (minlf s (if (eq (cop s) s) '(creall creall) '(cnuml cnuml)))
+		  (minlf s (if (eq (cop s) s) '(creals creals) '(cnums cnums)))))))
+
+  (mapc (lambda (x) (apply #'minlt x)) '((< "lt")(<= "le")(> "gt")(>= "ge")(= "eq")(/= "ne"))))
+
 
 ;;compiler::objlt
  (push '((t t) boolean #.(flags rfa)"((object)(#0))<((object)(#1))") (get 'si::objlt 'inline-always))
 
-;;<=
- (push '((t t) boolean #.(flags rfa)"immnum_le(#0,#1)") (get '<= 'inline-always))
-(push '((creal creal) boolean #.(flags rfa)"(#0)<=(#1)") (get '<= 'inline-always))
-
-;;=
- (push '((t t) boolean #.(flags rfa)"immnum_eq(#0,#1)") (get '= 'inline-always))
-(push '((cnum cnum) boolean #.(flags rfa)"(#0)==(#1)") (get '= 'inline-always))
-
-;;>
- (push '((t t) boolean #.(flags rfa)"immnum_gt(#0,#1)") (get '> 'inline-always))
-(push '((creal creal) boolean #.(flags rfa)"(#0)>(#1)") (get '> 'inline-always))
-
-;;>=
- (push '((t t) boolean #.(flags rfa)"immnum_ge(#0,#1)") (get '>= 'inline-always))
-(push '((creal creal) boolean #.(flags rfa)"(#0)>=(#1)") (get '>= 'inline-always))
-
 ;;APPEND
 ;;  (push '((t t) t #.(flags ans)"append(#0,#1)")
 ;;    (get 'append 'inline-always))
--- gcl27-2.7.1.orig/git.tag
+++ gcl27-2.7.1/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre37"
+"Version_2_7_2pre38"
--- gcl27-2.7.1.orig/h/compdefs.h
+++ gcl27-2.7.1/h/compdefs.h
@@ -95,3 +95,5 @@ NO_RETURN
 CHAR_SIZE
 MAX_ARGS
 bool
+FIXSFSP(x)
+FIXLFSP(x)
--- gcl27-2.7.1.orig/h/elf32_ppc_reloc.h
+++ gcl27-2.7.1/h/elf32_ppc_reloc.h
@@ -2,7 +2,7 @@
       s+=a;
       if (ovchks(s,~MASK(26)))
         store_val(where,MASK(26),s|0x3);
-      else  if (ovchks(s-p,~MASK(26)))
+      else if (ovchks(s-p,~MASK(26)))
         store_val(where,MASK(26),(s-p)|0x1); 
       else massert(!"REL24 overflow");
         break;
--- gcl27-2.7.1.orig/h/notcomp.h
+++ gcl27-2.7.1/h/notcomp.h
@@ -362,3 +362,15 @@ EXTER gmp_randfnptr_t Mersenne_Twister_G
   type_of(strm_)==t_stream ? read_object_non_recursive(strm_) : fSread_fasd_top(strm_)
 
 #define NO_TRUENAME (raw_image || no_truename)
+
+
+#define UFIX(x) ({fixnum _x=(x);_x^(_x>>(sizeof(fixnum)*8-1));})
+
+#define SFBITS 24
+#define LFBITS 53
+
+#define FMSK(a_) ((~(0ULL))&(~((1ULL<<(a_))-1)))
+
+#define FIXSFSP(x) (UFIX(x)&FMSK(SFBITS))
+#define FIXLFSP(x) (UFIX(x)&FMSK(LFBITS))
+
--- gcl27-2.7.1.orig/lsp/gcl_deftype.lsp
+++ gcl27-2.7.1/lsp/gcl_deftype.lsp
@@ -279,7 +279,7 @@
     (ratio
      (let ((z (rational nx)))
        (if (eql z nx) (if (integerp x) (list x) x)
-	   (if a z (list z)))))
+	   (if (unless (integerp z) a) z (list z)))))
     (short-float (f 0.0s0))
     (long-float (f 0.0)))))
 
--- gcl27-2.7.1.orig/o/num_comp.c
+++ gcl27-2.7.1/o/num_comp.c
@@ -42,7 +42,6 @@ number_compare(object x, object y) {
 
   double dx;
   static double dy;
-  object q;
   enum type tx,ty;
 
   tx=type_of(x);
@@ -70,6 +69,7 @@ number_compare(object x, object y) {
       return(number_compare(x, y));
 
     case t_shortfloat:
+      if (FIXSFSP(fix(x))) return number_compare(x,double_to_rational(sf(y)));/*(fix(x)&0x7FFFFFFFFF000000)*/
       {
 	volatile float fx=fix(x);
 	dx = fx;
@@ -78,6 +78,7 @@ number_compare(object x, object y) {
       goto LONGFLOAT;
 
     case t_longfloat:
+      if (FIXLFSP(fix(x))) return number_compare(x,double_to_rational(lf(y)));
       dx = fix(x);
       dy = lf(y);
       goto LONGFLOAT;
@@ -106,21 +107,10 @@ number_compare(object x, object y) {
       return(number_compare(x, y));
 
     case t_shortfloat:
-
-      if ((float)number_to_double((q=double_to_integer((double)sf(y))))==sf(y))
-	return(number_compare(x,q));
-
-      dx=number_to_double(x);
-      dy=sf(y);
-      goto LONGFLOAT;
+      return number_compare(x,double_to_rational(sf(y)));
 
     case t_longfloat:
-      if (number_to_double((q=double_to_integer(lf(y))))==lf(y))
-	return(number_compare(x,q));
-
-      dx=number_to_double(x);
-      dy=lf(y);
-      goto LONGFLOAT;
+      return number_compare(x,double_to_rational(lf(y)));
 
     case t_complex:
       goto Y_COMPLEX;
@@ -176,6 +166,9 @@ number_compare(object x, object y) {
 
     case t_fixnum:
 
+      if (tx==t_shortfloat ? FIXSFSP(fix(y)) : FIXLFSP(fix(y)))
+	return number_compare(double_to_rational(dx),y);
+
       if (tx==t_shortfloat) {
 	volatile float fy=fix(y);
 	dy=fy;
@@ -184,11 +177,7 @@ number_compare(object x, object y) {
       goto LONGFLOAT;
 
     case t_bignum:
-
-      if (number_to_double((q=double_to_integer(dx)))==dx)
-	return(number_compare(q,y));
-      dy=number_to_double(y);
-      goto LONGFLOAT;
+      return number_compare(double_to_rational(dx),y);
 
     case t_ratio:
       return(number_compare(double_to_rational(dx),y));
@@ -332,6 +321,9 @@ DEFUN("/=2",object,fSne2,SI
 
 }
 
+DEFCONST("+SFBITS+",sSPsfbitsP,SI,small_fixnum(SFBITS),"Mantissa bits in short-float");
+DEFCONST("+LFBITS+",sSPsfbitsP,SI,small_fixnum(LFBITS),"Mantissa bits in short-float");
+
 
 DEFUN("MAX2",object,fSx2,SI
 	  ,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
--- gcl27-2.7.1.orig/o/num_sfun.c
+++ gcl27-2.7.1/o/num_sfun.c
@@ -675,8 +675,8 @@ LFD(Lexp)(void)
 
 DEFUN("EXPT",object,fLexpt,LISP,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
 
-  check_type_number(&vs_base[0]);
-  check_type_number(&vs_base[1]);
+  check_type_number(&x);
+  check_type_number(&y);
   RETURN1(number_expt(x,y));
 
 }
