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-13) unstable; urgency=medium
 .
   * Version_2_7_0pre16
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-21

--- gcl27-2.7.0.orig/gcl-tk/comm.c
+++ gcl27-2.7.0/gcl-tk/comm.c
@@ -19,7 +19,7 @@
 #endif
 
 
-DEFUN("CHECK-FD-FOR-INPUT",object,fScheck_fd_for_input,SI,2,2,NONE,OI,IO,OO,OO,(fixnum fd,fixnum timeout),
+DEFUN("CHECK-FD-FOR-INPUT",object,fScheck_fd_for_input,SI,2,2,NONE,II,IO,OO,OO,(fixnum fd,fixnum timeout),
       "Check FD a file descriptor for data to read, waiting TIMEOUT clicks \
 for data to become available.  Here there are \
 INTERNAL-TIME-UNITS-PER-SECOND in one second.  Return is 1 if data \
@@ -34,11 +34,11 @@ available on FD, 0 if timeout reached an
   FD_SET(fd, &inp);
   n = select(fd + 1, &inp, NULL, NULL, &t);
   if (n < 0)
-    return make_fixnum(-1);
+    return (object)-1;
   else if (FD_ISSET(fd, &inp))
-    return make_fixnum(1);
+    return (object)1;
   else
-    return make_fixnum(0);
+    return (object)0;
 }
 #ifdef STATIC_FUNCTION_POINTERS
 object
@@ -263,7 +263,7 @@ write1(sfd,p,bytes)
       
 }	  
 
-DEFUN("CLEAR-CONNECTION",object,fSclear_connection,SI,1,1,NONE,OI,OO,OO,OO,(fixnum fd),
+DEFUN("CLEAR-CONNECTION",object,fSclear_connection,SI,1,1,NONE,II,OO,OO,OO,(fixnum fd),
       "Read on FD until nothing left to read.  Return number of bytes read") {
   
   char buffer[0x1000];
@@ -271,7 +271,7 @@ DEFUN("CLEAR-CONNECTION",object,fSclear_
   while (fix(FFN(fScheck_fd_for_input)(fd,0)))
     n+=read(fd,buffer,sizeof(buffer));
   
-  return make_fixnum(n);
+  return (object)(fixnum)n;
 
 }
 #ifdef STATIC_FUNCTION_POINTERS
--- gcl27-2.7.0.orig/git.tag
+++ gcl27-2.7.0/git.tag
@@ -1,2 +1,2 @@
-"Version_2_7_0pre15"
+"Version_2_7_0pre16"
 
--- gcl27-2.7.0.orig/h/linux.h
+++ gcl27-2.7.0/h/linux.h
@@ -182,7 +182,18 @@ do { int c = 0; \
 
 #else
 
-#define FPE_CODE(i_,v_) make_fixnum((fixnum)SF(i_)->si_code)
+#define FPE_TCODE(x_) \
+  {ufixnum _x=(x_),_y=0;			\
+   switch(_x) {					\
+   case FPE_FLTINV: _y=FE_INVALID;break;	\
+   case FPE_FLTDIV: _y=FE_DIVBYZERO;break;	\
+   case FPE_FLTOVF: _y=FE_OVERFLOW;break;	\
+   case FPE_FLTUND: _y=FE_UNDERFLOW;break;	\
+   case FPE_FLTRES: _y=FE_INEXACT;break;	\
+   }						\
+   _y;						\
+  }
+#define FPE_CODE(i_,v_) make_fixnum(FPE_TCODE((fixnum)SF(i_)->si_code))
 #define FPE_ADDR(i_,v_) make_fixnum((fixnum)SF(i_)->si_addr)
 #define FPE_CTXT(v_) Cnil
 
--- gcl27-2.7.0.orig/h/notcomp.h
+++ gcl27-2.7.0/h/notcomp.h
@@ -328,7 +328,11 @@ extern bool writable_malloc;
 /* #define BV_ALLOC (BV_BITS*SIZEOF_LONG) */
 #define BV_BITS (CHAR_SIZE*SIZEOF_LONG)
 #define BV_ALLOC BV_BITS
+#ifdef WORDS_BIGENDIAN
+#define BV_BIT(i) (1L<<(BV_BITS-1-((i)%BV_BITS)))
+#else
 #define BV_BIT(i) (1L<<((i)%BV_BITS))
+#endif
 #define BITREF(x,i) ({ufixnum _i=(i);(BV_BIT(_i)&(x->bv.bv_self[_i/BV_BITS])) ? 1 : 0;})
 #define SET_BITREF(x,i)   ({ufixnum _i=(i);(x->bv.bv_self[_i/BV_BITS]) |= BV_BIT(_i);})
 #define CLEAR_BITREF(x,i) ({ufixnum _i=(i);(x->bv.bv_self[_i/BV_BITS]) &= ~BV_BIT(_i);})
--- gcl27-2.7.0.orig/lsp/gcl_arraylib.lsp
+++ gcl27-2.7.0/lsp/gcl_arraylib.lsp
@@ -132,7 +132,7 @@
   (let* ((off (+ index (array-offset array)))
 	 (ind (>> off #.(1- (integer-length fixnum-length))))
 	 (word (*fixnum (c-array-self array) ind nil nil))
-	 (shft (& off #.(1- fixnum-length))))
+	 (shft (end-shft (& off #.(1- fixnum-length)))))
     (& (>> word shft) 1)))
 (declaim (inline 0-byte-array-self))
 
@@ -144,7 +144,7 @@
   (let* ((off (+ index (array-offset array)))
 	 (ind (>> off #.(1- (integer-length fixnum-length))))
 	 (word (*fixnum (c-array-self array) ind nil nil))
-	 (shft (& off #.(1- fixnum-length)))
+	 (shft (end-shft (& off #.(1- fixnum-length))))
 	 (val (<< 1 shft)))
     (*fixnum (c-array-self array) ind t (if (zerop bit) (& word (~ val)) (\| word val)))
     bit))
--- gcl27-2.7.0.orig/lsp/gcl_bit.lsp
+++ gcl27-2.7.0/lsp/gcl_bit.lsp
@@ -1,12 +1,23 @@
 ;; Copyright (C) 2024 Camm Maguire
 (in-package :si)
 
-(defun mask (nbits)
+(defun mask (nbits &optional (off 0))
   (if (eql nbits fixnum-length)
       -1
-      (~ (<< -1 nbits))))
+      (<< (~ (<< -1 nbits)) (end-shft off nbits))))
 (setf (get 'mask 'compiler::cmp-inline) t)
 
+(defun b<< (x y)
+#+clx-little-endian (<< x y)
+#-clx-little-endian (>> x y))
+(setf (get 'b<< 'compiler::cmp-inline) t)
+
+(defun b>> (x y)
+#+clx-little-endian (>> x y)
+#-clx-little-endian (<< x y))
+(setf (get 'b>> 'compiler::cmp-inline) t)
+
+
 (defun merge-word (x y m) (\| (& x m) (& y (~ m))))
 (setf (get 'merge-word 'compiler::cmp-inline) t)
 
@@ -25,12 +36,12 @@
   (cond ((zerop od) (bit-array-fixnum a i n))
 	((plusp od)
 	 (merge-word
-	  (>> (bit-array-fixnum a i n) od)
-	  (<< (bit-array-fixnum a (1+ i) n) (- fixnum-length od))
+	  (b>> (bit-array-fixnum a i n) od)
+	  (b<< (bit-array-fixnum a (1+ i) n) (- fixnum-length od))
 	  (mask (- fixnum-length od))))
 	((merge-word
-	  (>> (bit-array-fixnum a (1- i) n) (+ fixnum-length od))
-	  (<< (bit-array-fixnum a i n) (- od))
+	  (b>> (bit-array-fixnum a (1- i) n) (+ fixnum-length od))
+	  (b<< (bit-array-fixnum a i n) (- od))
 	  (mask (- od))))))
 (setf (get 'gw 'compiler::cmp-inline) t)
 
@@ -60,7 +71,7 @@
 	  (merge-word
 	   (funcall fn (gw ba1 i n1 o1) (gw ba2 i n2 o2)) 
 	   (bit-array-fixnum rba i n3)
-	   (<< (mask (min y (- fixnum-length o3))) o3)))
+	   (mask (min y (- fixnum-length o3)) o3)))
 	 (incf i))
        
        (do nil ((>= i nw))
--- gcl27-2.7.0.orig/lsp/gcl_s.lsp
+++ gcl27-2.7.0/lsp/gcl_s.lsp
@@ -2,7 +2,7 @@
 (in-package :s)
 
 (export '(lisp-type defdlfun +ks+ +fl+ strcat adjustable-vector adjustable-array matrix))
-(si::import-internal 'si::(\| & ^ ~ c+ c* << >> object double
+(si::import-internal 'si::(\| & ^ ~ c+ c* << >> object double end-shft
 			   c-object-== c-fixnum-== c-float-== c-double-== c-fcomplex-== c-dcomplex-== fcomplex dcomplex
 			   string-concatenate lit seqind seqbnd fixnum-length char-length cref address nani short int
 			   cnum unsigned-char unsigned-short unsigned-int
--- gcl27-2.7.0.orig/lsp/gcl_sf.lsp
+++ gcl27-2.7.0/lsp/gcl_sf.lsp
@@ -124,10 +124,14 @@
 		,@(unless (eq tp t) `((check-type x ,tp))),@(when ytp `((check-type y ,ytp)))
 	       ,@body)))
 
- (defun ends (s sz b) (if (member :clx-little-endian *features*) s (- b s sz)))
- (defun gbe (f tp o s sz b a &aux (s (ends s sz b)))
+ #.`(defun end-shft (s &optional (sz 1)(b fixnum-length))
+      (declare (ignorable sz b))
+      ,(if (member :clx-little-endian *features*) 's '(- b s sz)))
+ (si::putprop 'end-shft t 'si::cmp-inline)
+
+ (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 sbe (f    o s sz b a &aux (s (ends s sz b)))
+ (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))
  
  (defun fnk (k) (intern (string-concatenate "*" (string k))))
--- gcl27-2.7.0.orig/lsp/gcl_type.lsp
+++ gcl27-2.7.0/lsp/gcl_type.lsp
@@ -235,7 +235,7 @@
       (unless (zerop y)
 	(let* ((l (1- (integer-length y)))(l (if (minusp y) (1+ l) l)))
 	  (if (unless n (eql y (<< 1 l)))
-	      (setq n (+ (* i fixnum-length) l))
+	      (setq n (+ (* i fixnum-length) (end-shft l)))
 	    (return nil)))))))
 
 (defun atomic-tp (tp)
--- gcl27-2.7.0.orig/o/array.c
+++ gcl27-2.7.0/o/array.c
@@ -936,6 +936,7 @@ array_allocself(object x, int staticp, o
 		break;
 	case aet_bit:
 	  n=ceil(n,BV_ALLOC);
+	  n++;/*allow for arrays displaced to end BV_ALLOC access*/
 	  SET_BV_OFFSET(x,0);
 	case aet_fix:
 	case aet_nnfix:
--- gcl27-2.7.0.orig/o/makefile
+++ gcl27-2.7.0/o/makefile
@@ -48,6 +48,9 @@ gprof.ini: gprof.c grab_defs
 prelink.o: prelink.c $(DECL)
 	$(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO)
 
+unixtime.o: unixtime.c $(DECL)
+	$(CC) -c -D_FILE_OFFSET_BITS=64 -D_TIME_BITS=64 $(CFLAGS) $(DEFS) $< $(AUX_INFO)
+
 %.o: %.c $(DECL)
 	$(CC) -c $(CFLAGS) $(DEFS) $*.c $(AUX_INFO) 
 
--- gcl27-2.7.0.orig/o/predicate.c
+++ gcl27-2.7.0/o/predicate.c
@@ -232,7 +232,11 @@ equal1(register object x, register objec
 	  if (x->bv.bv_self[i]!=y->bv.bv_self[i])
 	    return(FALSE);
 	if (VLEN(x)%BV_BITS) {
+#ifdef WORDS_BIGENDIAN
+	  ufixnum m=(~0L<<(BV_BITS-(VLEN(x)%BV_BITS)));
+#else
 	  ufixnum m=(~(~0L<<(VLEN(x)%BV_BITS)));
+#endif
 	  if ((x->bv.bv_self[i]&m)!=(y->bv.bv_self[i]&m))
 	    return(FALSE);
 	}
--- gcl27-2.7.0.orig/o/sfaslelf.c
+++ gcl27-2.7.0/o/sfaslelf.c
@@ -57,9 +57,13 @@ License for more details.
 #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS))
 #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC &&  sec->sh_type==SHT_PROGBITS)
 #define LOAD_SYM(sym,st1) (sym->st_value && (EXT_SYM(sym,st1)||LOCAL_SYM(sym)))
-#define EXT_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_GLOBAL||ELF_ST_BIND(sym->st_info)==STB_WEAK||LOAD_SYM_BY_NAME(sym,st1))
 #define LOCAL_SYM(sym) ELF_ST_BIND(sym->st_info)==STB_LOCAL
-#define LOAD_SYM_BY_NAME(sym,st1) !strncmp(st1+sym->st_name,"__muldc3",8)||!strncmp(st1+sym->st_name,"__divdc3",8)
+#define EXT_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_GLOBAL||	\
+			  ELF_ST_BIND(sym->st_info)==STB_WEAK||		\
+			  GCC_SYM(sym,st1))
+#define GCC_SYM(sym,st1) (ELF_ST_BIND(sym->st_info)==STB_LOCAL &&	\
+			  ELF_ST_TYPE(sym->st_info)==STT_FUNC &&	\
+			  st1[sym->st_name]=='_')
 
 #define MASK(n) (~(~0ULL << (n)))
 
