Description: 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 --- 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: , Bug: Bug-Debian: https://bugs.debian.org/ Bug-Ubuntu: https://launchpad.net/bugs/ Forwarded: Reviewed-By: Last-Update: --- 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 && sst_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->addresssh_addr,pe=p+sec->sh_size;psh_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;symst_value || (sym->st_value>=stub && sym->st_valuest_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;symst_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=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->addresssh_addr,pe=p+sec->sh_size;psh_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;symst_value || (sym->st_value>=stub && sym->st_valuest_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 -#include -#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