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-24) unstable; urgency=medium
 .
   * Version_2_7_0pre27
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-07-19

--- gcl27-2.7.0.orig/clcs/makefile
+++ gcl27-2.7.0/clcs/makefile
@@ -6,7 +6,7 @@ COMPILE_FILE=./saved_clcs_gcl ./ $(LISPF
 FILES:=$(shell ls -1 gcl_clcs_*.lisp | sed 's,\.lisp,,1')
 APPEND=../xbin/append
 
-all: $(addsuffix .c,$(FILES)) $(addsuffix .o,$(FILES))
+all: $(addsuffix .c,$(FILES)) $(addsuffix .h,$(FILES)) $(addsuffix .data,$(FILES)) $(addsuffix .o,$(FILES))
 
 gprof_objs: $(addprefix ../gprof/,$(addsuffix .o,$(FILES)))
 
--- gcl27-2.7.0.orig/configure
+++ gcl27-2.7.0/configure
@@ -3107,6 +3107,7 @@ case $canonical in
     s390*linux*) use=s390-linux;;
     ia64*linux*) use=ia64-linux;;
     hppa*linux*) use=hppa-linux;;
+    loongarch64*linux*) use=loongarch64-linux;;
     powerpc*linux*) use=powerpc-linux;;
     powerpc-*-darwin*) use=powerpc-macosx;;
     *86*darwin*) use=386-macosx;;
@@ -5638,6 +5639,9 @@ case $use in
 	if ! add_arg_to_cflags -msse2 || ! add_arg_to_cflags -mfpmath=sse ; then
 	   add_arg_to_cflags -ffloat-store;
         fi;;
+    loongarch64-linux)
+        add_arg_to_cflags -mno-relax
+        add_arg_to_cflags -Wa,-mno-relax;;
     386-macosx)
 #	assert_arg_to_cflags -Wno-error=implicit-function-declaration
 	add_arg_to_cflags -Wno-incomplete-setjmp-declaration
@@ -8613,7 +8617,13 @@ printf "%s\n" "$as_me: trying to adjust
 		if test $n -lt $min ; then min=$n; fi;
 		if test $n -gt $max; then max=$n; fi;
 	    elif test $max -gt 0 ; then
-		break;
+	    	# Workaround for false island of acceptability on riscv64, 20240716
+	    	if test `$AWK 'END {print n-m}' m=$min n=$max </dev/null` -gt 2 ; then
+		   break;
+		else
+		   min=$lim
+		   max=0;
+		fi
             fi;
             n=`$AWK 'END {print n+1}' n=$n </dev/null`
 	done
@@ -8637,12 +8647,12 @@ printf "%s\n" "$as_me: max log text star
             if test $max -ge $enable_fastimmfix && test "$enable_immfix" != "no" ; then
 	        j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$max </dev/null`
 		low_shft=`$AWK 'END {print n+1}' n=$max </dev/null`;
-		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: raising log text to $j for a $max bit wide low immfix table" >&5
-printf "%s\n" "$as_me: raising log text to $j for a $max bit wide low immfix table" >&6;}
+		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: raising log text to 0x$j for a $max bit wide low immfix table" >&5
+printf "%s\n" "$as_me: raising log text to 0x$j for a $max bit wide low immfix table" >&6;}
             else
 	        j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$min </dev/null`
-		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: lowering log text to $j to maximize data area" >&5
-printf "%s\n" "$as_me: lowering log text to $j to maximize data area" >&6;}
+		{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: lowering log text to 0x$j to maximize data area" >&5
+printf "%s\n" "$as_me: lowering log text to 0x$j to maximize data area" >&6;}
 	    fi
 	fi
 
@@ -8662,7 +8672,7 @@ printf "%s\n" "#define OBJNULL NULL" >>c
 	#      echo $j;
 	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking our linker script" >&5
 printf %s "checking our linker script... " >&6; }
-	if test "$j" -ne "-1" ; then
+	if test "$j" != "-1" ; then
             cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[0-9]*","0x" j,$0);} {print}' j=$j >gcl.script
 	    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: done" >&5
 printf "%s\n" "done" >&6; }
--- gcl27-2.7.0.orig/configure.in
+++ gcl27-2.7.0/configure.in
@@ -47,6 +47,7 @@ case $canonical in
     s390*linux*) use=s390-linux;;
     ia64*linux*) use=ia64-linux;;
     hppa*linux*) use=hppa-linux;;
+    loongarch64*linux*) use=loongarch64-linux;;
     powerpc*linux*) use=powerpc-linux;;
     powerpc-*-darwin*) use=powerpc-macosx;;
     *86*darwin*) use=386-macosx;;
@@ -343,6 +344,9 @@ case $use in
 	if ! add_arg_to_cflags -msse2 || ! add_arg_to_cflags -mfpmath=sse ; then
 	   add_arg_to_cflags -ffloat-store;
         fi;;
+    loongarch64-linux)
+        add_arg_to_cflags -mno-relax
+        add_arg_to_cflags -Wa,-mno-relax;;
     386-macosx)
 #	assert_arg_to_cflags -Wno-error=implicit-function-declaration
 	add_arg_to_cflags -Wno-incomplete-setjmp-declaration
@@ -1506,7 +1510,13 @@ dnl     FIXME
 		if test $n -lt $min ; then min=$n; fi;
 		if test $n -gt $max; then max=$n; fi;
 	    elif test $max -gt 0 ; then
-		break;
+	    	# Workaround for false island of acceptability on riscv64, 20240716
+	    	if test `$AWK 'END {print n-m}' m=$min n=$max </dev/null` -gt 2 ; then
+		   break;
+		else
+		   min=$lim
+		   max=0;
+		fi
             fi;
             n=`$AWK 'END {print n+1}' n=$n </dev/null`
 	done
@@ -1527,10 +1537,10 @@ dnl     FIXME
             if test $max -ge $enable_fastimmfix && test "$enable_immfix" != "no" ; then
 	        j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$max </dev/null`
 		low_shft=`$AWK 'END {print n+1}' n=$max </dev/null`;
-		AC_MSG_NOTICE([raising log text to $j for a $max bit wide low immfix table])
+		AC_MSG_NOTICE([raising log text to 0x$j for a $max bit wide low immfix table])
             else					
 	        j=`$AWK 'END {for (i=j=0;j<=n;j++) i=i ? i*2 : 1;printf("%x\n",3*i)}' n=$min </dev/null`
-		AC_MSG_NOTICE([lowering log text to $j to maximize data area])
+		AC_MSG_NOTICE([lowering log text to 0x$j to maximize data area])
 	    fi
 	fi
 
@@ -1543,7 +1553,7 @@ dnl     FIXME
 
 	#      echo $j;
 	AC_MSG_CHECKING([our linker script])
-	if test "$j" -ne "-1" ; then
+	if test "$j" != "-1" ; then
             cat gcl.script.def | $AWK '/SIZEOF_HEADERS/ {gsub("0x[[0-9]]*","0x" j,$0);} {print}' j=$j >gcl.script
 	    AC_MSG_RESULT([done])
 	    rm -f gcl.script.def
--- gcl27-2.7.0.orig/git.tag
+++ gcl27-2.7.0/git.tag
@@ -1,2 +1,2 @@
-"Version_2_7_0pre26"
+"Version_2_7_0pre27"
 
--- /dev/null
+++ gcl27-2.7.0/h/elf64_loongarch64_reloc.h
@@ -0,0 +1,93 @@
+#define get_insn_page(x) ((x) & ~0xffful)
+#define get_page_delta(dest, pc) ({                  \
+  ul res = get_insn_page(dest) - get_insn_page(pc);  \
+  if ((dest) & 0x800)                                  \
+    res += 0x1000ul - 0x100000000ul;                 \
+  if (res & 0x80000000)                              \
+    res += 0x100000000ul;                            \
+  res;                                               \
+})
+#define get_page_low(dest) ((dest) & 0xfff)
+#define bdest (((long)((s+a)-p))>>2)
+#define bgdest (((long)(((ul)got)-p))>>2)
+
+    case R_LARCH_RELAX:
+    case R_LARCH_ALIGN:
+      massert(!emsg("Unsupport relaxation, please compile with '-mno-relax -Wa,-mno-relax'\n"));
+      break;
+    case R_LARCH_64:
+      store_val(where,~0L,(s+a));
+      break;
+    case R_LARCH_32:
+      store_val(where,MASK(32),(s+a));
+      break;
+    case R_LARCH_32_PCREL:
+      store_val(where,MASK(32),(s+a)-p);
+      break;
+    case R_LARCH_ADD6:
+      add_val(where,MASK(6),(s+a));
+      break;
+    case R_LARCH_ADD8:
+      add_val(where,MASK(8),(s+a));
+      break;
+    case R_LARCH_ADD16:
+      add_val(where,MASK(16),(s+a));
+      break;
+    case R_LARCH_ADD32:
+      add_val(where,MASK(32),(s+a));
+      break;
+    case R_LARCH_ADD64:
+      add_val(where,~0L,(s+a));
+      break;
+    case R_LARCH_SUB6:
+      add_val(where,MASK(6),-(s+a));
+      break;
+    case R_LARCH_SUB8:
+      add_val(where,MASK(8),-(s+a));
+      break;
+    case R_LARCH_SUB16:
+      add_val(where,MASK(16),-(s+a));
+      break;
+    case R_LARCH_SUB32:
+      add_val(where,MASK(32),-(s+a));
+      break;
+    case R_LARCH_SUB64:
+      add_val(where,~0L,-(s+a));
+      break;
+    case R_LARCH_B16:
+      store_val(where,MASK(16)<<10,bdest<<10);
+      break;
+    case R_LARCH_B21:
+      store_val(where,(MASK(16)<<10)|MASK(5),bdest<<10|((bdest>>16)&0x1f));
+      break;
+    case R_LARCH_B26:
+      {
+	if ((bdest&(~MASK(25)))==0||((~bdest)&(~MASK(25)))==0) {
+	  store_val(where,MASK(26),bdest<<10|((bdest>>16)&0x3ff));
+	  break;
+	}
+	if (!(sym->st_size&0x2))
+	  massert(!emsg("Unresolved R_LARCH_B26 symbol\n"));
+	got+=(sym->st_size>>2)+(sym->st_size&0x1?1:0);
+	store_val(where,MASK(26),bgdest<<10|((bgdest>>16)&0x3ff));
+	memcpy(got,tramp,sizeof(tramp));
+	store_val(got,MASK(20)<<5,(get_insn_page(s+a)-get_insn_page((ul)got))>>12<<5);
+	store_val((ul*)((ul)got+4),MASK(16)<<10,(((s+a)>>2)&0x3ff)<<10);
+      }
+      break;
+    case R_LARCH_PCALA_HI20:
+      store_val(where,MASK(20)<<5,get_page_delta(s+a,p)>>12<<5);
+      break;
+    case R_LARCH_PCALA_LO12:
+      store_val(where,MASK(12)<<10,get_page_low(s+a)<<10);
+      break;
+    case R_LARCH_GOT_PC_HI20:
+      got+=sym->st_size>>2;
+      *got=s+a;
+      store_val(where,MASK(20)<<5,get_page_delta((ul)got,p)>>12<<5);
+      break;
+    case R_LARCH_GOT_PC_LO12:
+      got+=sym->st_size>>2;
+      // *got=s+a;
+      store_val(where,MASK(12)<<10,get_page_low((ul)got)<<10);
+      break;
--- /dev/null
+++ gcl27-2.7.0/h/elf64_loongarch64_reloc_special.h
@@ -0,0 +1,70 @@
+#define R_LARCH_B16 64
+#define R_LARCH_B21 65
+#define R_LARCH_B26 66
+#define R_LARCH_PCALA_HI20 71
+#define R_LARCH_PCALA_LO12 72
+#define R_LARCH_GOT_PC_HI20 75
+#define R_LARCH_GOT_PC_LO12 76
+#define R_LARCH_32_PCREL 99
+#define R_LARCH_RELAX 100
+#define R_LARCH_ALIGN 102
+#define R_LARCH_ADD6 105
+#define R_LARCH_SUB6 106
+
+static unsigned int tramp[] = {
+				0x1a00000c, /* pcalau12i $t0, %hi(sym) */
+				0x4c000180 /* jirl $zero, $t0, %lo(sym) */};
+
+static int
+find_special_params(void *v,Shdr *sec1,Shdr *sece,const char *sn,
+		    const char *st1,Sym *ds1,Sym *dse,Sym *sym,Sym *syme) {
+  return 0;
+
+}
+
+static int
+label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char *st1,const char *sn,ul *gs) {
+  Rela *r;
+  Sym *sym;
+  Shdr *sec;
+  void *v,*ve;
+  int idx;
+  const int gz = sizeof(ul)/sizeof(ul), tz = sizeof(tramp)/sizeof(ul);
+  massert(gz==1);
+  massert(tz==1);
+
+  for (sym=sym1;sym<syme;sym++)
+    sym->st_size=0;
+
+  /* Count the symbols need to be fixed first. */
+  for (sec=sec1;sec<sece;sec++)
+    if (sec->sh_type==SHT_RELA)
+      for (v=v1+sec->sh_offset,ve=v+sec->sh_size,r=v;v<ve;v+=sec->sh_entsize,r=v)
+	if (
+	    ELF_R_TYPE(r->r_info)==R_LARCH_GOT_PC_HI20 ||
+	    ELF_R_TYPE(r->r_info)==R_LARCH_B26
+	    ) {
+	  sym=sym1+ELF_R_SYM(r->r_info);
+	  if (ELF_R_TYPE(r->r_info)==R_LARCH_B26 && LOCAL_SYM(sym))
+	    continue;
+
+	  if (ELF_R_TYPE(r->r_info)==R_LARCH_GOT_PC_HI20)
+	    sym->st_size|=0x1;
+	  if (ELF_R_TYPE(r->r_info)==R_LARCH_B26)
+	    sym->st_size|=0x2;
+	}
+
+  for (idx=0,sym=sym1;sym<syme;sym++) {
+    if (sym->st_size==0)
+      continue;
+    massert(!(sym->st_size>>2));
+    sym->st_size|=idx<<2;
+    if (sym->st_size&0x1)
+      idx+=gz;
+    if (sym->st_size&0x2)
+      idx+=tz;
+  }
+
+  *gs=idx;
+  return 0;
+}
--- /dev/null
+++ gcl27-2.7.0/h/loongarch64-linux.h
@@ -0,0 +1,27 @@
+#include "linux.h"
+
+#ifdef IN_GBC
+#undef MPROTECT_ACTION_FLAGS
+#define MPROTECT_ACTION_FLAGS SA_RESTART|SA_SIGINFO
+#define GET_FAULT_ADDR(sig,code,sv,a) \
+ ((siginfo_t *)code)->si_addr
+#endif
+
+/*#define NULL_OR_ON_C_STACK(x) ((x)==0 || ((unsigned int)x) > (unsigned int)(pagetochar(MAXPAGE+1)))*/
+
+/* #define ADDITIONAL_FEATURES \ */
+/* 		     ADD_FEATURE("BSD386"); \ */
+/*       	             ADD_FEATURE("MC68020") */
+
+
+/* #define	I386 */
+#define SGC
+
+/* Apparently stack pointers can be 4 byte aligned, at least &argc -- CM */
+#define C_GC_OFFSET 4
+
+#define RELOC_H "elf64_loongarch64_reloc.h"
+#define SPECIAL_RELOC_H "elf64_loongarch64_reloc_special.h"
+/* #define MAX_CODE_ADDRESS (1L<<31)/\*large memory model broken gcc 4.8*\/ */
+
+#define NEED_STACK_CHK_GUARD
--- gcl27-2.7.0.orig/h/protoize.h
+++ gcl27-2.7.0/h/protoize.h
@@ -1610,6 +1610,9 @@ apply_format_function(object,object,obje
 object
 fSstring_match2(object,object);
 
+object
+aelttype_list(void);
+
 object alloc_simple_string(int);
 object alloc_string(int);
 object append(object,object);
--- gcl27-2.7.0.orig/lsp/gcl_export.lsp
+++ gcl27-2.7.0/lsp/gcl_export.lsp
@@ -487,28 +487,3 @@
        use-value                            y-or-n-p                  
        user-homedir-pathname                yes-or-no-p               
        values                               zerop))
-
-(in-package :si)
-
-
-;FIXME bootstrap code
-
-(fset 'intersection #'intersection-eq)
-(fset 'union #'union-eq)
-(fset 'set-difference #'set-difference-eq)
-(fset 'nunion #'nunion-eq)
-
-(*make-constant '+array-types+ (si::aelttype-list))
-(*make-constant '+sfix+ (eql (truncate fixnum-length char-length) 4))
-
-
-(defun num-comp (x y tp) 
-  (if (c-fixnum-== tp 1) (c-fixnum-== x y)
-    (if (c-fixnum-== tp 2) (eql 0 (gmp::mpz_cmp x y))
-      (if (c-fixnum-== tp 3) (and (eql (numerator x) (numerator y))
-				  (eql (denominator x) (denominator y)))
-	(if (c-fixnum-== tp 4) (c-float-== x y)
-	  (if (c-fixnum-== tp 5) (c-double-== x y)
-	    (if (c-fixnum-== tp 6) (and (eql (realpart x) (realpart y)) (eql (imagpart x) (imagpart y)))
-	      (if (c-fixnum-== tp 7) (c-fcomplex-== x y)
-		(if (c-fixnum-== tp 8) (c-dcomplex-== x y))))))))))
--- gcl27-2.7.0.orig/o/array.c
+++ gcl27-2.7.0/o/array.c
@@ -431,7 +431,9 @@ fSmake_vector(object etp,fixnum n,object
 }
 #endif
 
-DEFUN("AELTTYPE-LIST",object,fSaelttype_list,SI,0,0,NONE,OO,OO,OO,OO,(),"") {
+
+object
+aelttype_list(void) {
 
   aet_type_struct *p,*pe;
   object f=Cnil,x,y=OBJNULL;
@@ -444,6 +446,7 @@ DEFUN("AELTTYPE-LIST",object,fSaelttype_
   return f;
 
 }
+DEFCONST("+ARRAY-TYPES+",sSParray_typesP,SI,aelttype_list(),"");
   
 
 DEFUN("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") {
--- gcl27-2.7.0.orig/o/assignment.c
+++ gcl27-2.7.0/o/assignment.c
@@ -161,6 +161,7 @@ DEFUN("FUNCTION-NAME",object,fSfunction_
 DEFUN("FSET",object,fSfset,SI,2,2,NONE,OO,OO,OO,OO,(object sym,object function),"") {
 
   object x;
+  extern int initializing_boot;
 
   if (type_of(sym)!=t_symbol)
     sym=ifuncall1(sSfunid_to_sym,sym);
@@ -174,7 +175,7 @@ DEFUN("FSET",object,fSfset,SI,2,2,NONE,O
 	      1, sym);
   }
   if (sym->s.s_hpack == lisp_package &&
-      sym->s.s_gfdef != OBJNULL && !raw_image && sLwarn->s.s_gfdef)
+      sym->s.s_gfdef != OBJNULL && !initializing_boot && sLwarn->s.s_gfdef)
     ifuncall2(sLwarn,make_simple_string("~S is being redefined."),sym);
   sym = clear_compiler_properties(sym,function);
   if (type_of(function) == t_function) {
--- gcl27-2.7.0.orig/o/boot.c
+++ gcl27-2.7.0/o/boot.c
@@ -546,7 +546,7 @@ DEFUN("WILD-PATHNAME-P",object,fLwild_pa
   return Cnil;
 }
 
-DEFUN("SET-DIFFERENCE-EQ",object,fSset_difference_eq,SI,2,8,NONE,OO,OO,OO,OO,
+DEFUN("SET-DIFFERENCE",object,fLset_difference,LISP,2,8,NONE,OO,OO,OO,OO,
 	  (object x,object y,...),"") {
   object z=Cnil,yy;
   for (;x!=Cnil;x=x->c.c_cdr) {
@@ -558,7 +558,7 @@ DEFUN("SET-DIFFERENCE-EQ",object,fSset_d
 
 }
 
-DEFUN("UNION-EQ",object,fSunion_eq,SI,2,8,NONE,OO,OO,OO,OO,
+DEFUN("UNION",object,fLunion,LISP,2,8,NONE,OO,OO,OO,OO,
 	  (object x,object y,...),"") {
   object z=y,yy;
   for (;x!=Cnil;x=x->c.c_cdr) {
@@ -570,7 +570,7 @@ DEFUN("UNION-EQ",object,fSunion_eq,SI,2,
 
 }
 
-DEFUN("NUNION-EQ",object,fSnunion_eq,SI,2,8,NONE,OO,OO,OO,OO,
+DEFUN("NUNION",object,fLnunion,LISP,2,8,NONE,OO,OO,OO,OO,
 	  (object x,object y,...),"") {
   object z=Cnil,zp=z,yy;
   for (;x!=Cnil;x=x->c.c_cdr) {
@@ -585,7 +585,7 @@ DEFUN("NUNION-EQ",object,fSnunion_eq,SI,
 
 }
 
-DEFUN("INTERSECTION-EQ",object,fSintersection_eq,SI,2,8,NONE,OO,OO,OO,OO,
+DEFUN("INTERSECTION",object,fLintersection,LISP,2,8,NONE,OO,OO,OO,OO,
 	  (object x,object y,...),"") {
   object z=Cnil,yy;
   for (;x!=Cnil;x=x->c.c_cdr) {
--- gcl27-2.7.0.orig/o/gmp_big.c
+++ gcl27-2.7.0/o/gmp_big.c
@@ -324,54 +324,25 @@ big_minus(object x)
 #endif
 
 
-static int
-double_exponent(double d) {
-  
-  union {double d;int i[2];} u;
-  
-  if (d == 0.0)
-    return(0);
-
-  u.d=d;
-  return (((u.i[HIND] & 0x7ff00000) >> 20) - 1022);
-
-}
-
-static double
-set_exponent(double d, int e) {
-
-  union {double d;int i[2];} u;
-  
-  if (d == 0.0)
-    return(0.0);
-  
-  u.d=d;
-  u.i[HIND]= (u.i[HIND] & 0x800fffff) | (((e + 1022) << 20) & 0x7ff00000);
-  return(u.d);
-
-}
-	
 double
 big_to_double(object x) {
 
-  double d=mpz_get_d(MP(x));
-  int s=mpz_sizeinbase(MP(x),2);
-  if (s>=54 && mpz_tstbit(MP(x),s-54)) {
-
-    union {double d;int i[2];} u;
-    
-    u.i[HIND]=0;
-    u.i[LIND]=1;
-    
-    d+=(d>0.0 ? 1.0 : -1.0)*set_exponent(u.d,double_exponent(d)-53);
+  int s=mpz_sizeinbase(MP(x),2),i=0,j;
 
+  if (s>=54 && mpz_tstbit(MP(x),s-54))
+    for (i=mpz_tstbit(MP(x),s-53),j=s-55;!i && j>=0 && !(i=mpz_tstbit(MP(x),j));j--);
+
+  if (i) {
+    mpz_set_si(MP(big_fixnum1),mpz_sgn(MP(x))>0 ? 1 : -1);
+    mpz_mul_2exp(MP(big_fixnum1),MP(big_fixnum1),s-54);
+    mpz_add(MP(big_fixnum1),MP(big_fixnum1),MP(x));
+    x=big_fixnum1;
   }
 
-  return d;
+  return mpz_get_d(MP(x));
 
 }
 
-
 /* static object copy_big(object x) */
 /* { */
 /*   if (type_of(x)==t_bignum) */
