Blob Blame Raw
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.
 .
 gcl (2.6.12-14) unstable; urgency=medium
 .
   * Version_2_6_13pre17
Author: Camm Maguire <camm@debian.org>

---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: <YYYY-MM-DD>

--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp
@@ -82,7 +82,7 @@
 
 (defun safe-system (string)
  (multiple-value-bind
-  (code result) (system (ts string))
+  (code result) (system (mysub (ts string) "$" "\\$"))
     (unless (and (zerop code) (zerop result))
       (cerror "Continues anyway."
               "(SYSTEM ~S) returned a non-zero value ~D."
--- gcl-2.6.12.orig/configure
+++ gcl-2.6.12/configure
@@ -715,6 +715,7 @@ infodir
 docdir
 oldincludedir
 includedir
+runstatedir
 localstatedir
 sharedstatedir
 sysconfdir
@@ -821,6 +822,7 @@ datadir='${datarootdir}'
 sysconfdir='${prefix}/etc'
 sharedstatedir='${prefix}/com'
 localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
 includedir='${prefix}/include'
 oldincludedir='/usr/include'
 docdir='${datarootdir}/doc/${PACKAGE}'
@@ -1073,6 +1075,15 @@ do
   | -silent | --silent | --silen | --sile | --sil)
     silent=yes ;;
 
+  -runstatedir | --runstatedir | --runstatedi | --runstated \
+  | --runstate | --runstat | --runsta | --runst | --runs \
+  | --run | --ru | --r)
+    ac_prev=runstatedir ;;
+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \
+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \
+  | --run=* | --ru=* | --r=*)
+    runstatedir=$ac_optarg ;;
+
   -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
     ac_prev=sbindir ;;
   -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
@@ -1210,7 +1221,7 @@ fi
 for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \
 		datadir sysconfdir sharedstatedir localstatedir includedir \
 		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
-		libdir localedir mandir
+		libdir localedir mandir runstatedir
 do
   eval ac_val=\$$ac_var
   # Remove trailing slashes.
@@ -1363,6 +1374,7 @@ Fine tuning of the installation director
   --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]
   --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]
   --localstatedir=DIR     modifiable single-machine data [PREFIX/var]
+  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]
   --libdir=DIR            object code libraries [EPREFIX/lib]
   --includedir=DIR        C header files [PREFIX/include]
   --oldincludedir=DIR     C header files for non-gcc [/usr/include]
@@ -4423,6 +4435,7 @@ case $use in
 #			if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi
 			;;
 		mips*)
+			TCFLAGS="$TCFLAGS -mplt"
 #			if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2
 			;;
 		ia64*)
--- gcl-2.6.12.orig/configure.in
+++ gcl-2.6.12/configure.in
@@ -640,6 +640,7 @@ case $use in
 #			if test "$enable_debug" != "yes" ; then TO2FLAGS="-O" ; fi
 			;;
 		mips*)
+			TCFLAGS="$TCFLAGS -mplt"
 #			if test "$enable_debug" != "yes" ; then TO3FLAGS="-O0" ; fi #FIXME needed asof gcc 4.6.2
 			;;
 		ia64*)
--- gcl-2.6.12.orig/h/elf32_mips_reloc.h
+++ gcl-2.6.12/h/elf32_mips_reloc.h
@@ -19,10 +19,7 @@
     case R_MIPS_CALL16:
       gote=got+sym->st_size-1;
       store_val(where,MASK(16),((void *)gote-(void *)got));
-      if (s>=ggot && s<ggote) {
-        massert(!write_stub(s,got,gote));
-      } else
-        *gote=s;
+      *gote=s;
       break;
     case R_MIPS_HI16:
       if (sym->st_other) s=gpd=(ul)got-(sym->st_other==2 ? 0 : (ul)where);
@@ -37,7 +34,8 @@
       a+=(a&0x8000)<<1; 
       store_val(where,MASK(16),a);
       a=0x10000|(a>>16);
-      for (hr=hr ? hr : r;--r>=hr && ELF_R_TYPE(r->r_info)==R_MIPS_HI16;)
-        relocate(sym1,r,a,start,got,gote);
+      for (hr=hr ? hr : r;--r>=hr;)
+	if (ELF_R_TYPE(r->r_info)==R_MIPS_HI16)
+	  relocate(sym1,r,a,start,got,gote);
       hr=NULL;gpd=0;
       break;
--- gcl-2.6.12.orig/h/elf32_mips_reloc_special.h
+++ gcl-2.6.12/h/elf32_mips_reloc_special.h
@@ -1,65 +1,9 @@
-static ul gpd,ggot,ggote; static Rel *hr;
-
-static int
-write_stub(ul s,ul *got,ul *gote) {
-
-  *gote=(ul)(gote+2);
-  *++gote=s;
-  s=((void *)gote-(void *)got);
-  *++gote=(0x23<<26)|(0x1c<<21)|(0x19<<16)|s;
-  *++gote=(0x23<<26)|(0x19<<21)|(0x19<<16)|0;
-  *++gote=0x03200008;
-  *++gote=0x00200825;
-
-  return 0;
-  
-}
-
-static int
-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) {
-
-  Shdr *ssec=sec1+sym->st_shndx;
-  struct node *a;
-  if ((ssec>=sece || !ALLOC_SEC(ssec)) && 
-      (a=find_sym_ptable(st1+sym->st_name)) &&
-      a->address>=ggot && a->address<ggote)
-    (*gs)+=5;
-
-  return 0;
-
-}
+static ul gpd; static Rel *hr;
 
 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) {
   
-  Shdr *sec;
-  ul *q,gotsym=0,locgotno=0,stub,stube;
-  void *p,*pe;
-
-  massert(sec=get_section(".dynamic",sec1,sece,sn));
-  for (p=(void *)sec->sh_addr,pe=p+sec->sh_size;p<pe;p+=sec->sh_entsize) {
-    q=p;
-    if (q[0]==DT_MIPS_GOTSYM)
-      gotsym=q[1];
-    if (q[0]==DT_MIPS_LOCAL_GOTNO)
-      locgotno=q[1];
-    
-  }
-  massert(gotsym && locgotno);
-
-  massert(sec=get_section(".MIPS.stubs",sec1,sece,sn));
-  stub=sec->sh_addr;
-  stube=sec->sh_addr+sec->sh_size;
-      
-  massert(sec=get_section(".got",sec1,sece,sn));
-  ggot=sec->sh_addr+locgotno*sec->sh_entsize;
-  ggote=sec->sh_addr+sec->sh_size;
-
-  for (ds1+=gotsym,sym=ds1;sym<dse;sym++)
-    if (!sym->st_value || (sym->st_value>=stub && sym->st_value<stube))
-      sym->st_value=ggot+(sym-ds1)*sec->sh_entsize;
-
   return 0;
 
 }
@@ -74,7 +18,7 @@ label_got_symbols(void *v1,Shdr *sec1,Sh
   ul q;
 
   for (q=0,sym=sym1;sym<syme;sym++) {
-    char *s=st1+sym->st_name;
+    const char *s=st1+sym->st_name;
     if ((sym->st_other=strcmp(s,"_gp_disp") ? (strcmp(s,"__gnu_local_gp") ? 0 : 2) : 1)) {
       q++;
       sym->st_info=ELF_ST_INFO(STB_LOCAL,ELF_ST_TYPE(sym->st_info));
@@ -94,10 +38,8 @@ label_got_symbols(void *v1,Shdr *sec1,Sh
 
 	  sym=sym1+ELF_R_SYM(r->r_info);
 
-	  if (!sym->st_size) { 
+	  if (!sym->st_size)
 	    sym->st_size=++*gs; 
-	    massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs));
-	  }
 
 	}
   
--- gcl-2.6.12.orig/h/elf64_mips_reloc.h
+++ gcl-2.6.12/h/elf64_mips_reloc.h
@@ -15,10 +15,7 @@
       gote=got+(a>>32)-1;
       a&=MASK(32);
       store_val(where,MASK(16),((void *)gote-(void *)got));
-      if (s>=ggot && s<ggote) {
-        massert(!write_stub(s,got,gote));
-      } else
-        *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
+      *gote=s+(a&~MASK(16))+((a&0x8000)<<1);
       break;
     case R_MIPS_GOT_OFST:
       store_val(where,MASK(16),a);
@@ -40,8 +37,9 @@
       a&=~MASK(16);
       {
         Rela *ra=(void *)r;				
-        for (hr=hr ? hr : (void *)ra;--ra>=hr && ELF_R_TYPE(ra->r_info)==R_MIPS_HI16;)
-	  relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote);
+        for (hr=hr ? hr : (void *)ra;--ra>=hr;)
+	  if (ELF_R_TYPE(ra->r_info)==R_MIPS_HI16)
+	    relocate(sym1,ra,ra->r_addend|(1L<<32)|(a<<32),start,got,gote);
       }
       hr=NULL;
       break;
--- gcl-2.6.12.orig/h/elf64_mips_reloc_special.h
+++ gcl-2.6.12/h/elf64_mips_reloc_special.h
@@ -1,4 +1,4 @@
-static ul ggot,ggote; static Rela *hr;
+static Rela *hr;
 
 #undef ELF_R_SYM 
 #define ELF_R_SYM(a_) (a_&0xffffffff) 
@@ -7,68 +7,9 @@ static ul ggot,ggote; static Rela *hr;
 #define ELF_R_FTYPE(a_) ((a_>>56)&0xff)
 
 static int
-write_stub(ul s,ul *got,ul *gote) {
-
-  int *goti;
-  
-
-  *gote=(ul)(goti=(void *)(gote+2));
-  *++gote=s;
-  s=((void *)gote-(void *)got);
-  *goti++=(0x37<<26)|(0x1c<<21)|(0x19<<16)|s;
-  *goti++=(0x37<<26)|(0x19<<21)|(0x19<<16)|0;
-  *goti++=0x03200008;
-  *goti++=0x00200825;
-
-  return 0;
-  
-}
-
-static int
-make_got_room_for_stub(Shdr *sec1,Shdr *sece,Sym *sym,const char *st1,ul *gs) {
-
-  Shdr *ssec=sec1+sym->st_shndx;
-  struct node *a;
-  if ((ssec>=sece || !ALLOC_SEC(ssec)) && 
-      (a=find_sym_ptable(st1+sym->st_name)) &&
-      a->address>=ggot && a->address<ggote)
-    (*gs)+=3;
-
-  return 0;
-
-}
-
-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) {
   
-  Shdr *sec;
-  ul *q,gotsym=0,locgotno=0,stub,stube;
-  void *p,*pe;
-
-  massert(sec=get_section(".dynamic",sec1,sece,sn));
-  for (p=(void *)sec->sh_addr,pe=p+sec->sh_size;p<pe;p+=sec->sh_entsize) {
-    q=p;
-    if (q[0]==DT_MIPS_GOTSYM)
-      gotsym=q[1];
-    if (q[0]==DT_MIPS_LOCAL_GOTNO)
-      locgotno=q[1];
-    
-  }
-  massert(gotsym && locgotno);
-
-  massert(sec=get_section(".MIPS.stubs",sec1,sece,sn));
-  stub=sec->sh_addr;
-  stube=sec->sh_addr+sec->sh_size;
-      
-  massert(sec=get_section(".got",sec1,sece,sn));
-  ggot=sec->sh_addr+locgotno*sec->sh_entsize;
-  ggote=sec->sh_addr+sec->sh_size;
-
-  for (ds1+=gotsym,sym=ds1;sym<dse;sym++)
-    if (!sym->st_value || (sym->st_value>=stub && sym->st_value<stube))
-      sym->st_value=ggot+(sym-ds1)*sec->sh_entsize;
-
   return 0;
 
 }
@@ -104,8 +45,6 @@ label_got_symbols(void *v1,Shdr *sec1,Sh
 	      sym->st_size|=(q<<(a*16));
 	    }
 	    
-	    massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs));
-
 	  }
 
 	  b=sizeof(r->r_addend)*4; 
--- gcl-2.6.12.orig/h/mips-linux.h
+++ gcl-2.6.12/h/mips-linux.h
@@ -21,5 +21,4 @@
 #define SPECIAL_RELOC_H "elf64_mips_reloc_special.h"
 #endif
 
-/*Remove when .MIPS.stubs are replaced with callable .plt entries*/
-#define LD_BIND_NOW
+#define NEED_STACK_CHK_GUARD
--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp
+++ gcl-2.6.12/lsp/gcl_iolib.lsp
@@ -38,26 +38,24 @@
 
 
 (defmacro with-input-from-string ((var string &key index start end) . body)
-  (if index
-      (multiple-value-bind (ds b)
-          (find-declarations body)
-        `(let ((,var (make-string-input-stream ,string ,start ,end)))
-           ,@ds
-           (unwind-protect
-             (progn ,@b)
-             (setf ,index (si:get-string-input-stream-index ,var)))))
-      `(let ((,var (make-string-input-stream ,string ,start ,end)))
-         ,@body)))
+  (multiple-value-bind (ds b)
+      (find-declarations body)
+    `(let ((,var (make-string-input-stream ,string ,start ,end)))
+       ,@ds
+       (unwind-protect
+	   (progn ,@b)
+	 (when ,index (setf ,index (si:get-string-input-stream-index ,var)))
+	 (when ,var (close ,var))))))
 
+(defmacro with-output-to-string ((var &optional string &key element-type) . body)
+  (multiple-value-bind (ds b)
+      (find-declarations body)
+    `(let ((,var ,(if string `(make-string-output-stream-from-string ,string) `(make-string-output-stream))))
+       ,@ds
+       (unwind-protect
+	   (progn ,@b ,@(unless string `((get-output-stream-string ,var))))
+	 (when ,var (close ,var))))))
 
-(defmacro with-output-to-string ((var &optional string) . body)
-  (if string
-      `(let ((,var (make-string-output-stream-from-string ,string)))
-         ,@body)
-      `(let ((,var (make-string-output-stream)))
-         ,@body
-         (get-output-stream-string ,var))))
-        
 
 (defun read-from-string (string
                          &optional (eof-error-p t) eof-value
--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp
+++ gcl-2.6.12/lsp/gcl_numlib.lsp
@@ -71,29 +71,53 @@
 
 (defun cis (x) (exp (* imag-one x)))
 
-(defun asin (x)
-       (let ((c (- (* imag-one
-                      (log (+ (* imag-one x)
-                              (sqrt (- 1.0d0 (* x x)))))))))
-            (if (or (and (not (complexp x))
-			  (<= x 1.0d0)
-			   (>= x -1.0d0)
-			    )
-		        (zerop (imagpart c)))
-                (realpart c)
-                c)))
-
-(defun acos (x)
-       (let ((c (- (* imag-one
-                      (log (+ x (* imag-one
-                                   (sqrt (- 1.0d0 (* x x))))))))))
-            (if (or (and (not (complexp x))
-			  (<= x 1.0d0)
-			   (>= x -1.0d0)
-			    )
-		        (zerop (imagpart c)))
-                (realpart c)
-                c)))
+(defun real-asinh (x)
+  (declare (real x))
+  (float (log (+ x (sqrt (+ 1.0 (* x x))))) (float x)))
+
+(defun asin (z)
+  (declare (optimize (safety 1)))
+  (check-type z number)
+  (if (unless (complexp z) (<= -1 z 1))
+      (atan z (sqrt (- 1 (* z z))))
+    (let* ((a (sqrt (- 1 z)))
+	   (b (sqrt (+ 1 z))))
+      (complex (atan (realpart z) (realpart (* a b)))
+	       (real-asinh (imagpart (* (conjugate a) b)))))))
+
+(defun acos (z)
+  (declare (optimize (safety 1)))
+  (check-type z number)
+  (if (unless (complexp z) (<= -1 z 1))
+      (* 2 (atan (- 1 z) (sqrt (- 1 (* z z)))))
+    (let* ((a (sqrt (- 1 z)))
+	   (b (sqrt (+ 1 z))))
+      (complex (* 2 (atan (realpart a) (realpart b)))
+	       (real-asinh (imagpart (* (conjugate b) a)))))))
+
+(defun asinh (x)
+  (declare (optimize (safety 1)))
+  (check-type x number)
+  (if (realp x)
+      (real-asinh x)
+    (let* ((r (asin (complex (- (imagpart x)) (realpart x)))))
+      (complex (imagpart r) (- (realpart r))))))
+
+(defun acosh (z)
+  (declare (optimize (safety 1)))
+  (check-type z number)
+  (if (unless (complexp z) (>= z 1))
+      (real-asinh (sqrt (- (* z z) 1)))
+    (let* ((a (sqrt (- z 1)))
+	   (b (sqrt (+ z 1))))
+      (complex (real-asinh (realpart (* (conjugate a) b))) (* 2 (atan (imagpart a) (realpart b)))))))
+
+(defun atanh (x)
+  (declare (optimize (safety 1)))
+  (check-type x number)
+  (if (unless (complexp x) (< -1 x 1))
+      (/ (log (/ (+ 1 x) (- 1 x))) 2)
+    (/ (- (log (+ 1 x)) (log (- 1 x))) 2)))
 
 
 (defun sinh (z)
@@ -140,27 +164,6 @@
 ;(defun cosh (x) (/ (+ (exp x) (exp (- x))) 2.0d0))
 (defun tanh (x) (/ (sinh x) (cosh x)))
 
-(defun asinh (x) (log (+ x (sqrt (+ 1.0d0 (* x x))))))
-;(defun acosh (x)
-;  (log (+ x
-;	  (* (1+ x)
-;	     (sqrt (/ (1- x) (1+ x)))))))
-;(defun acosh (x)
-;       (log (+ x
-;	       (sqrt (* (1- x) (1+ x))))))
-(defun acosh (x)
-  (* 2 (log (+ (sqrt (/ (1+ x) 2)) (sqrt (/ (1- x) 2))))))
-(defun atanh (x)
-       (when (or (= x 1.0d0) (= x -1.0d0))
-             (error "The argument, ~s, is a logarithmic singularity.~
-                    ~%Don't be foolish, GLS."
-                    x))
-       (log (/ (1+ x) (sqrt (- 1 (* x x))))))
-;;        (let ((y (log (/ (1+ x) (sqrt (- 1 (* x x)))))))
-;; 	 (if (and (= (imagpart x) 0) (complexp y))
-;; 	     (complex (realpart y) (- (imagpart y)))
-;; 	   y)))
-
 
 (defun rational (x)
   (etypecase x
--- gcl-2.6.12.orig/o/file.d
+++ gcl-2.6.12/o/file.d
@@ -523,7 +523,41 @@ object if_exists, if_does_not_exist;
 
 static void
 gclFlushSocket(object);
-/*
+
+
+DEFUN_NEW("OPEN-STREAM-P",object,fLopen_stream_p,LISP,1,1,NONE,OO,OO,OO,OO,(object x),"") {
+
+  check_type_stream(&x);
+
+  switch(x->sm.sm_mode) {
+  case smm_output:
+  case smm_input:
+  case smm_io:
+  case smm_probe:
+  case smm_socket:
+  case smm_string_input:
+  case smm_string_output:
+    return x->d.tt==1 ? Cnil : Ct;
+  case smm_synonym:
+    return FFN(fLopen_stream_p)(symbol_value(x->sm.sm_object0));
+  case smm_broadcast:
+  case smm_concatenated:
+    for (x=x->sm.sm_object0;!endp(x);x=x->c.c_cdr)
+      if (!FFN(fLopen_stream_p(x)))
+	return Cnil;
+    return Ct;
+  case smm_two_way:
+  case smm_echo:
+    if (FFN(fLopen_stream_p(STREAM_INPUT_STREAM(x)))==Cnil)
+      return Cnil;
+    return FFN(fLopen_stream_p(STREAM_OUTPUT_STREAM(x)));
+  default:
+    error("illegal stream mode");
+    return Cnil;
+  }
+
+}
+    /*
 	Close_stream(strm) closes stream strm.
 	The abort_flag is not used now.
 */
@@ -535,6 +569,8 @@ object strm;
 	object x;
 
 BEGIN:
+	strm->d.tt=1;
+
 	switch (strm->sm.sm_mode) {
 	case smm_output:
 		if (strm->sm.sm_fp == stdout)
--- gcl-2.6.12.orig/o/main.c
+++ gcl-2.6.12/o/main.c
@@ -471,12 +471,6 @@ main(int argc, char **argv, char **envp)
 #include "unrandomize.h"
 #endif
   
-#ifdef LD_BIND_NOW
-#include <stdio.h>
-#include <stdlib.h>
-#include "ld_bind_now.h"
-#endif
-  
   setbuf(stdin, stdin_buf); 
   setbuf(stdout, stdout_buf);
 #ifdef _WIN32
--- gcl-2.6.12.orig/o/print.d
+++ gcl-2.6.12/o/print.d
@@ -349,7 +349,7 @@ truncate_double(char *b,double d,int dp)
   for (p=c;*p && *p!='e';p++);
   if (p[-1]!='.' && char_inc(c,p-1) && COMP(c,&pp,d,dp)) {
     j=truncate_double(c,d,dp);
-    if (j<k) {
+    if (j<=k) {
       k=j;
       n=c;
     }