(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."
docdir
oldincludedir
includedir
+runstatedir
localstatedir
sharedstatedir
sysconfdir
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
+runstatedir='${localstatedir}/run'
includedir='${prefix}/include'
oldincludedir='/usr/include'
docdir='${datarootdir}/doc/${PACKAGE}'
| -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=* \
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.
--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]
# 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*)
# 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*)
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);
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;
-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;
}
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));
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));
- }
}
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);
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;
-static ul ggot,ggote; static Rela *hr;
+static Rela *hr;
#undef ELF_R_SYM
#define ELF_R_SYM(a_) (a_&0xffffffff)
#define ELF_R_TYPE(a_) (((a_>>40)&0xff) ? ((a_>>40)&0xff) : ((a_>>56)&0xff))
#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;
}
sym->st_size|=(q<<(a*16));
}
- massert(!make_got_room_for_stub(sec1,sece,sym,st1,gs));
-
}
b=sizeof(r->r_addend)*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
(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)))
-
-
-(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))))
-
+ (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))))))
+
(defun read-from-string (string
&optional (eof-error-p t) eof-value
(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)
;(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
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.
*/
object x;
BEGIN:
+ strm->d.tt=1;
+
switch (strm->sm.sm_mode) {
case smm_output:
if (strm->sm.sm_fp == stdout)
#include <stdio.h>
#include <stdlib.h>
#include "unrandomize.h"
-#endif
-
-#ifdef LD_BIND_NOW
-#include <stdio.h>
-#include <stdlib.h>
-#include "ld_bind_now.h"
#endif
setbuf(stdin, stdin_buf);
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;
}
projects / gcl27.git / commitdiff