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.0-19) unstable; urgency=medium
 .
   * Version_2_7_0pre22
Author: Camm Maguire <camm@debian.org>

---
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: 2024-02-28

--- gcl27-2.7.0.orig/cmpnew/gcl_cmpcall.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmpcall.lsp
@@ -415,9 +415,9 @@
 ;;     x))
 
 (defun g (fname n sig &optional apnarg (clp t)
-		&aux (cname (format nil "/* ~a */(*LnkLI~d)" (function-string fname) n))
-		(fnstr (ms (vv-str fname) "->s.s_gfdef"))
-		(clp (when clp fnstr)))
+	  &aux (cname (format nil "/* ~a */(~a)(*LnkLI~d)" (function-string fname) (rep-type (cadr sig)) n))
+	    (fnstr (ms (vv-str fname) "->s.s_gfdef"))
+	    (clp (when clp fnstr)))
   (g1 fnstr cname sig apnarg clp))
 
 ;; (defun g (fname n sig &optional apnarg (clp t)
@@ -489,10 +489,6 @@
 ;; 		      *inline-functions*))))))
 
 
-(defun declaration-type (type) 
-  (if (or (equal type "") (equal type "long "))
-      "object "
-    type))
 
 ;;make a function which will be called hopefully only once,
 ;;and will establish the link.
--- gcl27-2.7.0.orig/cmpnew/gcl_cmptop.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmptop.lsp
@@ -233,7 +233,7 @@
 
 (defun declaration-type (type)
   (cond ((equal type "") "void")
-	((equal type "long ") "object ")
+	((or (equal type "long ") (equal type "fixnum ")) "object ")
 	(t type)))
 
 (defvar *vaddress-list*)   ;; hold addresses of C functions, and other data
@@ -1887,7 +1887,7 @@
 		    ("")))
 	(bdsu (if *bds-used* " for (;bds_top>old_bds_top;) bds_unwind1;" ""))
 	(frsu (if *frame-used* " for (;frs_top>old_frs_top;) frs_pop();" "")))
-    (wt-h "#define VMRV" cm "(a_,b_)" vstu bdsu frsu " return(a_);")
+    (wt-h "#define VMRV" cm "(a_,b_)" vstu bdsu frsu " return((" (declaration-type (rep-type return-type)) ")a_);")
     (wt-h "#define VMR" cm "(a_) VMRV" cm "(a_,0);")))
 
 
--- gcl27-2.7.0.orig/cmpnew/gcl_cmptype.lsp
+++ gcl27-2.7.0/cmpnew/gcl_cmptype.lsp
@@ -1036,7 +1036,7 @@
   (declare (ignore f))
   (reduce 'type-or1
 	  (mapcar (lambda (x) (super-range 'atanh-pole (type-and t1 x)))
-		  '(#tcomplex #t(real * (-1)) #t(real (-1) (1)) #t(real (1))))
+		  `(,#tcomplex ,#t(real * (-1)) ,#t(real (-1) (1)) ,#t(real (1))))
 	  :initial-value nil))
 (si::putprop 'atanh 'atanh-propagator 'type-propagator)
 
--- gcl27-2.7.0.orig/configure
+++ gcl27-2.7.0/configure
@@ -5636,6 +5636,10 @@ case $use in
 	assert_arg_to_ldflags -pg
 	GPL_FLAG="-pg"
 	LDFLAGS=$OLD_LDFLAGS;;
+    386-linux)
+	if ! add_arg_to_cflags -msse2 || ! add_arg_to_cflags -mfpmath=sse ; then
+	   add_arg_to_cflags -ffloat-store;
+        fi;;
     386-macosx)
 #	assert_arg_to_cflags -Wno-error=implicit-function-declaration
 	add_arg_to_cflags -Wno-incomplete-setjmp-declaration
--- gcl27-2.7.0.orig/configure.in
+++ gcl27-2.7.0/configure.in
@@ -339,6 +339,10 @@ case $use in
 	assert_arg_to_ldflags -pg
 	GPL_FLAG="-pg"
 	LDFLAGS=$OLD_LDFLAGS;;
+    386-linux)
+	if ! add_arg_to_cflags -msse2 || ! add_arg_to_cflags -mfpmath=sse ; then
+	   add_arg_to_cflags -ffloat-store;
+        fi;;
     386-macosx)
 #	assert_arg_to_cflags -Wno-error=implicit-function-declaration
 	add_arg_to_cflags -Wno-incomplete-setjmp-declaration
@@ -1466,7 +1470,7 @@ if test "$use" != "386-gnu" ; then #hurd
      	    AC_MSG_RESULT([not found])
 	fi
 	AC_MSG_CHECKING([output_mach])
-	output_mach=`cat gcl.script |grep OUTPUT_ARCH|head -n 1|sed 's,.*(\(.*\)).*,\1:,1'|cut -f2 -d:|tr '-' '_'`;
+	output_mach=`cat gcl.script |grep OUTPUT_ARCH|head -n 1|sed 's,.*(\(.*\)).*,\1:,1'|cut -f2 -d:|tr '-' '_'|tr -d '.'`;
 dnl     FIXME
 	defaulted=""
         if test "$output_mach" = "" ; then
--- gcl27-2.7.0.orig/git.tag
+++ gcl27-2.7.0/git.tag
@@ -1,2 +1,2 @@
-"Version_2_7_0pre21"
+"Version_2_7_0pre22"
 
--- gcl27-2.7.0.orig/h/cmponly_last.h
+++ gcl27-2.7.0/h/cmponly_last.h
@@ -1,7 +1,7 @@
 
-#ifndef __ia64__/*FIXME*/
-#undef setjmp
-#define setjmp ((int(*)(void *))dlsetjmp)
-#undef _setjmp
-#define _setjmp ((int(*)(void *))dlsetjmp)
-#endif
+/* #ifndef __ia64__/\*FIXME*\/ */
+/* #undef setjmp */
+/* #define setjmp ((int(*)(void *))dlsetjmp) */
+/* #undef _setjmp */
+/* #define _setjmp ((int(*)(void *))dlsetjmp) */
+/* #endif */
--- gcl27-2.7.0.orig/h/compprotos.h
+++ gcl27-2.7.0/h/compprotos.h
@@ -97,3 +97,5 @@ object Icall_gen_error_handler_noreturn(
 object file_stream(object);
 fixnum fixnum_expt(fixnum, fixnum);
 int gcl_puts(const char *);
+int setjmp();
+int _setjmp();
--- gcl27-2.7.0.orig/h/fixnum.h
+++ gcl27-2.7.0/h/fixnum.h
@@ -9,7 +9,7 @@
 #define    unmark_imm_fixnum(a_)        ((a_)=((object)((fixnum)(a_)-(LOW_IM_FIX<<1))))
 #define        is_imm_fixnum(a_)        ((fixnum)(a_)<(fixnum)OBJNULL)
 #define is_unmrkd_imm_fixnum(a_)        ((fixnum)(a_)<LOW_IM_FIX)
-#define is_marked_imm_fixnum(a_)       p (is_imm_fixnum(a_)*!is_unmrkd_imm_fixnum(a_))
+#define is_marked_imm_fixnum(a_)        (is_imm_fixnum(a_)*!is_unmrkd_imm_fixnum(a_))
 #define           is_imm_fix(a_)        INT_IN_BITS(a_,LOW_SHFT-1)
 #elif defined (IM_FIX_BASE) && defined(IM_FIX_LIM)
 #define      make_imm_fixnum(a_)        ((object)((a_)+(IM_FIX_BASE+(IM_FIX_LIM>>1))))
--- gcl27-2.7.0.orig/h/lu.h
+++ gcl27-2.7.0/h/lu.h
@@ -216,7 +216,7 @@ struct hashtable {           /*  hash ta
   ufixnum       ht_size:LM(4);      /*  hash table size  */
   uhfixnum      ht_test:2;          /*  key test function, of enum httest  */
   uhfixnum      ht_pad3:HM(2);      /*  unused */
-  hfixnum       ht_pad4;            /*  unused */
+  uhfixnum      ht_pad4;            /*  unused */
   ufixnum       ht_pad5:4;          /*  unused */
   ufixnum       ht_max_ent:LM(4);   /*  max entries */
   htent         ht_cache;           /*  gethash cache */
@@ -232,17 +232,33 @@ struct hashtable {           /*  hash ta
 #define ARRAY_RANK_LIMIT (1UL<<ARRAY_RANK_BITS)
 
 #if SIZEOF_LONG == 8
+#ifdef WORDS_BIGENDIAN
 #define ARRAYWORD(b_,c_)						\
   FRSTWRD(J(b_,J(c_,elttype)),						\
-	  pd:LM(62),							\
+	  pd2:LM(63),							\
+	  J(b_,J(c_,eltmode)):3,					\
+          J(b_,J(c_,dim)):ARRAY_DIMENSION_BITS,				\
 	  J(b_,J(c_,hasfillp)):1,					\
+	  J(b_,J(c_,writable)):1,					\
+	  J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
+	  pd1:1,							\
 	  J(b_,J(c_,adjustable)):1,					\
+	  J(b_,J(c_,offset)):3,						\
+	  J(b_,J(c_,eltsize)):3)
+#else
+#define ARRAYWORD(b_,c_)						\
+  FRSTWRD(J(b_,J(c_,elttype)),						\
+	  pd2:LM(63),							\
+	  J(b_,J(c_,hasfillp)):1,					\
 	  J(b_,J(c_,writable)):1,					\
+	  J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
+	  pd1:1,							\
+	  J(b_,J(c_,adjustable)):1,					\
 	  J(b_,J(c_,offset)):3,						\
 	  J(b_,J(c_,eltsize)):3,					\
 	  J(b_,J(c_,eltmode)):3,					\
-	  J(b_,J(c_,rank)):ARRAY_RANK_BITS,				\
 	  J(b_,J(c_,dim)):ARRAY_DIMENSION_BITS)
+#endif
 
 #define atem(a_,b_,c_)				\
   ARRAYWORD(b_,c_);				\
@@ -446,9 +462,10 @@ struct function {
 
   FRSTWRD(tt,
 #if SIZEOF_LONG == 8
-	  fw:LM(34),
+	  fw:LM(38),
 	  fun_minarg:6,    /* required arguments */
 	  fun_maxarg:6,    /* maximum arguments */
+	  pd:4,
 	  fun_neval:5,     /* maximum extra values set */
 	  fun_vv:1         /* variable number of values */
 #else
--- gcl27-2.7.0.orig/h/type.h
+++ gcl27-2.7.0/h/type.h
@@ -80,7 +80,6 @@ enum type {
 #define TYPEWORD_TYPE_P(y_) (y_!=t_cons)
 #endif
 
-/*Note preserve sgc flag here                                         VVV*/
 #define set_type_of(x,y) ({object _x=(object)(x);enum type _y=(y);_x->d.f=0;\
     if (TYPEWORD_TYPE_P(_y)) {_x->d.e=1;_x->d.t=_y;_x->fw|=(fixnum)OBJNULL;}})
 
--- gcl27-2.7.0.orig/lsp/gcl_sf.lsp
+++ gcl27-2.7.0/lsp/gcl_sf.lsp
@@ -106,9 +106,10 @@
  (defun mm (m) (if (zerop (logand (ash 1 (1- fixnum-length)) m)) m (- m (ash 1 fixnum-length))))
  (defun m+ (a o) (if (zerop o) a `(c+ ,a ,o)))
  
- 
- (defun gk (b y &aux (k (car y))(u (when (consp k) (eq (cdr k) '|unsigned|)))(k (if (consp k) (car k) k)))
-   (cond ((< b (ks k)) (or (caar (member-if #'(lambda (x) (and (eql (bz (cadr x)) b) (eql (caddr x) (if u 1 0)))) +ks+)) (baboon)))
+ (defun gu (b k &aux (k (car k))) (when(< b fixnum-length) (when (consp k) (eq (cdr k) '|unsigned|))));no unsigned access for fixnum length
+
+ (defun gk (b y u &aux (k (car y))(k (if (consp k) (car k) k)))
+   (cond ((or u (< b (ks k))) (or (caar (member-if #'(lambda (x) (and (eql (bz (cadr x)) b) (eql (caddr x) (if u 1 0)))) +ks+)) (sferr "key mismatch" b y k u)))
 	 ((car (assoc k +ks+)))
 	 ((keywordp k) :object)
 	 (:fixnum)))
@@ -129,8 +130,8 @@
 		,@(unless (eq tp t) `((check-type x ,tp))),@(when ytp `((check-type y ,ytp)))
 	       ,@body)))
 
- (defun gbe (f tp o s sz b a &aux (s (end-shft s sz b)))
-   `((the ,tp ,(m& (m>> `(,f ,a ,o nil nil) s) (when (< (+ s sz) b) (mm (1- (ash 1 sz))))))))
+ (defun gbe (f tp o s sz b a u &aux (s (end-shft s sz b)))
+   `((the ,tp ,(m& (m>> `(,f ,a ,o nil nil) s) (when (< (+ (if u s 0) sz) b) (mm (1- (ash 1 sz))))))));cannot downshift signed without mask
  (defun sbe (f    o s sz b a &aux (s (end-shft s sz b)))
    `((,f ,a ,o t ,(m\| (m<< 'y s) (when (< sz b) `(& (,f ,a ,o nil nil) ,(~ (mm (ash (1- (ash 1 sz)) s))))))) y))
  
@@ -139,16 +140,19 @@
  (defun mnn (r z f) (intern (nstring-upcase (string-concatenate r z "-" f))))
  
  (defun mn (z p f &aux (f (strcat f))) (list (mnn "C-" z f) (mnn "C-SET-" z f)))
+
+ (defconstant +unaligned-access+ nil)
  
- (defun afn2 (z p c sz y &aux (b (sb c sz))(k (gk b y))(f (fnk k))(rtp (mtpp k y))(tp (btp z))(nl (mn z p (cadr y))))
+ (defun afn2 (z p c sz y &aux (b (sb c sz))(u (gu b y))(k (gk b y u))(f (fnk k))(rtp (mtpp k y))(tp (btp z))(nl (mn z p (cadr y))))
    (multiple-value-bind
        (o s)
        (truncate c b)
      (multiple-value-bind
 	 (bo s)
-	 (truncate s 8)
+	 (if +unaligned-access+ (truncate s 8) (values 0 s))
+       (when (> (+ s sz) b) (sferr "bit field overflow" s sz b z p y))
        (let ((a (m+ `(address x) bo)))
-	 (list (afn (pop nl) tp (gbe f rtp o s sz b a))
+	 (list (afn (pop nl) tp (gbe f rtp o s sz b a u))
 	       (afn (car nl) tp (sbe f o s sz b a) rtp))))))
  
  (defun nmf (x y &aux (p (strcat (cadr x) "_"))(f (strcat (cadr y)))(s (string= p (subseq f 0 (min (length f) (length p))))))
--- gcl27-2.7.0.orig/o/boot.c
+++ gcl27-2.7.0/o/boot.c
@@ -2,15 +2,15 @@
 #include "include.h"
 
 
-DEFUN("TP0",fixnum,fStp0,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp0(x);}
-DEFUN("TP1",fixnum,fStp1,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp1(x);}
-DEFUN("TP2",fixnum,fStp2,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp2(x);}
-DEFUN("TP3",fixnum,fStp3,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp3(x);}
-DEFUN("TP4",fixnum,fStp4,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp4(x);}
-DEFUN("TP5",fixnum,fStp5,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp5(x);}
-DEFUN("TP6",fixnum,fStp6,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp6(x);}
-DEFUN("TP7",fixnum,fStp7,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp7(x);}
-DEFUN("TP8",fixnum,fStp8,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return tp8(x);}
+DEFUN("TP0",object,fStp0,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp0(x);}
+DEFUN("TP1",object,fStp1,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp1(x);}
+DEFUN("TP2",object,fStp2,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp2(x);}
+DEFUN("TP3",object,fStp3,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp3(x);}
+DEFUN("TP4",object,fStp4,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp4(x);}
+DEFUN("TP5",object,fStp5,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp5(x);}
+DEFUN("TP6",object,fStp6,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp6(x);}
+DEFUN("TP7",object,fStp7,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp7(x);}
+DEFUN("TP8",object,fStp8,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") {return (object)(fixnum)tp8(x);}
 
 DEFUN("C-OBJECT-==",object,fSc_object_eq,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") {
   RETURN1(x==y?Ct:Cnil);
@@ -43,26 +43,26 @@ DEFUN("C-DCOMPLEX-==",object,fSc_dcomple
   RETURN1(lfc(x)==lfc(y)?Ct:Cnil);
 }
 
-DEFUN("C+",fixnum,fScp,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
-  RETURN1(x+y);
+DEFUN("C+",object,fScp,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
+  RETURN1((object)(x+y));
 }
-DEFUN("&",fixnum,fSand,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
-  RETURN1(x&y);
+DEFUN("&",object,fSand,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
+  RETURN1((object)(x&y));
 }
-DEFUN("|",fixnum,fSor,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
-  RETURN1(x|y);
+DEFUN("|",object,fSor,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
+  RETURN1((object)(x|y));
 }
-DEFUN("^",fixnum,fSxor,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
-  RETURN1(x^y);
+DEFUN("^",object,fSxor,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
+  RETURN1((object)(x^y));
 }
-DEFUN("~",fixnum,fSnot,SI,1,1,NONE,II,OO,OO,OO,(fixnum x),"") {
-  RETURN1(~x);
+DEFUN("~",object,fSnot,SI,1,1,NONE,II,OO,OO,OO,(fixnum x),"") {
+  RETURN1((object)~x);
 }
-DEFUN("<<",fixnum,fSlshft,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
-  RETURN1(x<<y);
+DEFUN("<<",object,fSlshft,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
+  RETURN1((object)(x<<y));
 }
-DEFUN(">>",fixnum,fSrshft,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
-  RETURN1(x>>y);
+DEFUN(">>",object,fSrshft,SI,2,2,NONE,II,IO,OO,OO,(fixnum x,fixnum y),"") {
+  RETURN1((object)(x>>y));
 }
 
 static inline bool
--- gcl27-2.7.0.orig/o/makefile
+++ gcl27-2.7.0/o/makefile
@@ -35,7 +35,9 @@ all:  $(OBJECTS) #$(GPROF)
 gprof_objs: $(addprefix ../gprof/,$(OBJECTS))
 
 boot.o: boot.c $(DECL) boot.h #FIXME clean, include file changes
-	$(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) 
+	$(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO)
+	! cat $< | awk -F, '/DEFUN/ {print $$1,$$2}' | grep -v object || (rm $@ && false)
+
 
 gprof.o: gprof.c $(DECL)
 	[ "$(GPROF)" = "" ] || $(CC) -c $(filter-out -fomit-frame-pointer,$(CFLAGS)) $(DEFS) -pg $*.c $(AUX_INFO)
@@ -54,6 +56,9 @@ unixtime.o: unixtime.c $(DECL)
 %.o: %.c $(DECL)
 	$(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) 
 
+../gprof/unixtime.o: unixtime.c $(DECL)
+	$(CC) -DGCL_GPROF -c -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64 $(filter-out -fomit-frame-pointer,$(CFLAGS)) $(DEFS) $< $(AUX_INFO)
+
 ../gprof/%.o: %.c $(DECL)
 	$(CC) -DGCL_GPROF -c $(filter-out -fomit-frame-pointer,$(CFLAGS)) $(DEFS) -pg $*.c $(AUX_INFO) -o $@
 
