<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-34) unstable; urgency=medium

  * Version_2_6_13pre45

Gbp-Pq: Name Version_2_6_13pre46

diff --git a/cmpnew/gcl_cmpmain.lsp b/cmpnew/gcl_cmpmain.lsp
index b5afa4db9f411d156105cf03762d34c351863828..87d617059ba242dd832f13a3ad200bcec6476f4c 100755 (executable)
--- a/cmpnew/gcl_cmpmain.lsp
+++ b/cmpnew/gcl_cmpmain.lsp
@@ -28,7 +28,7 @@
 
 
 (export '(*compile-print* *compile-verbose*))
-(import 'si::*tmp-dir* 'compiler)
+(import 'si::(*tmp-dir* *cc* *ld* *objdump*))
 (import 'si::*error-p* 'compiler)
 
 ;;; This had been true with Linux 1.2.13 a.out or even older
@@ -85,9 +85,8 @@
   (code result) (system (mysub (ts string) "$" "\\$"))
     (unless (and (zerop code) (zerop result))
       (cerror "Continues anyway."
-              "(SYSTEM ~S) returned a non-zero value ~D."
-              string
-              result)
+              "(SYSTEM ~S) returned a non-zero value ~D ~D."
+              string code result)
       (setq *error-p* t))
     (values result)))
 
@@ -428,8 +427,8 @@ Cannot compile ~a.~%"
                             (si::copy-stream st *standard-output*))
             (with-open-file (st hn)
                             (si::copy-stream st *standard-output*))
-            (when (zerop (system "which objdump >/dev/null"))
-              (safe-system (si::string-concatenate "objdump --source " (namestring on))))
+            (when (eql (aref *objdump* 0) #\/);program found at startup in path
+              (safe-system (si::string-concatenate *objdump* (namestring on))))
             (mdelete-file cn)
             (mdelete-file dn)
             (mdelete-file hn)
@@ -470,8 +469,6 @@ Cannot compile ~a.~%"
       (terpri *compiler-output2*)))))
 
 
-(defvar *cc* "cc")
-(defvar *ld* "ld")
 (defvar *ld-libs* "ld-libs")
 (defvar *opt-three* "")
 (defvar *opt-two* "")
@@ -489,7 +486,7 @@ Cannot compile ~a.~%"
     (setq na  (namestring
               (make-pathname :name name :type (pathname-type(first args)))))
    #+(or dos winnt)
-      (format nil "~a -I~a ~a ~a -c -w ~s -o ~s"
+      (format nil "~a -I~a ~a ~a -c -w ~a -o ~a"
              *cc*
              (concatenate 'string si::*system-directory* "../h")
              (if (and (boundp '*c-debug*) *c-debug*) " -g " "")
@@ -502,7 +499,7 @@ Cannot compile ~a.~%"
              )
 
    #-(or dos winnt)
-   (format nil  "~a -I~a ~a ~a -c ~s -o ~s ~a"
+   (format nil  "~a -I~a ~a ~a -c ~a -o ~a ~a"
           *cc*
           (concatenate 'string si::*system-directory* "../h")
           (if (and (boundp '*c-debug*) *c-debug*) " -g " "")

diff --git a/h/elf32_mips_reloc_special.h b/h/elf32_mips_reloc_special.h
index 9f94f06f10d567180b5a543dfa63f286771d5857..f78510740a1a645323977b6e6769dd151f01dd16 100644 (file)
--- a/h/elf32_mips_reloc_special.h
+++ b/h/elf32_mips_reloc_special.h
@@ -147,3 +147,6 @@ label_got_symbols(void *v1,Shdr *sec1,Shdr *sece,Sym *sym1,Sym *syme,const char
          (*(a_))->address=p->st_value;                                 \
          break;                                                        \
        }}})
+
+#undef LOAD_SYM_BY_NAME
+#define LOAD_SYM_BY_NAME(sym,st1) (!strncmp(st1+sym->st_name,"__moddi3",8))

diff --git a/h/notcomp.h b/h/notcomp.h
index 65435e10ecd23c5ee01f2ba87e92881ef3528453..ef2eec98ef0f54662de02315d8e8e314c25193e7 100755 (executable)
--- a/h/notcomp.h
+++ b/h/notcomp.h
@@ -361,7 +361,7 @@ extern bool writable_malloc;
 #define prof_block(x) x
 #endif
 
-#define psystem(x) prof_block(system(x))
+#define psystem(x) prof_block(vsystem(x))
 #define pfork() prof_block(fork())
 
 #include "error.h"

diff --git a/lsp/gcl_top.lsp b/lsp/gcl_top.lsp
index d25b079c3db739bcccc403247a27b07711ebf5f2..0df721ccb51928f6b4b58c2b867ef5cebcedaf27 100755 (executable)
--- a/lsp/gcl_top.lsp
+++ b/lsp/gcl_top.lsp
@@ -601,9 +601,21 @@ First directory is checked for first name and all extensions etc."
             :device (pathname-device x)
             :directory (append (pathname-directory x) y)))))))))
 
+(defun get-path (s &aux (m (string-match "([^/ ]*)( |$)" s))(b (match-beginning 1))(e (match-end 1))
+                  (r (with-open-file (s (concatenate 'string "|which " (subseq s b e))) (read s nil 'eof))))
+  (if (eq r 'eof) s (concatenate 'string (string-downcase r) (subseq s e))))
+
+
+(defvar *cc* "cc")
+(defvar *ld* "ld")
+(defvar *objdump* "objdump --source ")
+
 (defun set-up-top-level (&aux (i (argc)) tem)
   (declare (fixnum i))
-  (setq *tmp-dir* (get-temp-dir))
+  (setq *tmp-dir* (get-temp-dir)
+       *cc* (get-path *cc*)
+       *ld* (get-path *ld*)
+       *objdump* (get-path *objdump*))
   (dotimes (j i) (push (argv j) tem))
   (setq *command-args* (nreverse tem))
   (setq tem *lib-directory*)

diff --git a/o/file.d b/o/file.d
index 95c0204941255a74e50628cf6c3d147bb88c0003..1c67e15c67a1706793a1e964bd177a115c0e54c0 100755 (executable)
--- a/o/file.d
+++ b/o/file.d
@@ -613,7 +613,8 @@ BEGIN:
                else 
                  fclose(strm->sm.sm_fp);
                strm->sm.sm_fp = NULL;
-               if (type_of(strm->sm.sm_object0 ) == t_cons &&
+               if (strm->sm.sm_object0 &&
+                   type_of(strm->sm.sm_object0 ) == t_cons &&
                    Mcar(strm->sm.sm_object0 ) == sSAallow_gzipped_fileA)
                  fLdelete_file(Mcdr(strm->sm.sm_object0));
                break;

diff --git a/o/run_process.c b/o/run_process.c
index 75023cddebe0b9ea02d11ca1db8056c72b139a13..3dce94b4cc99800b4533de7114d1645dadf67770 100755 (executable)
--- a/o/run_process.c
+++ b/o/run_process.c
@@ -502,6 +502,7 @@ make_socket_pair()
   stream_in->sm.sm_buffer = 0;
   stream_in->sm.sm_int0 = sockets_in[1];
   stream_in->sm.sm_int1 = 0;
+  stream_in->sm.sm_object0=stream_in->sm.sm_object1=OBJNULL;
   stream_out = (object) alloc_object(t_stream);
   stream_out->sm.sm_mode = smm_output;
   stream_out->sm.sm_fp = fp2;
@@ -510,6 +511,7 @@ make_socket_pair()
   setup_stream_buffer(stream_out);
   stream_out->sm.sm_int0 = sockets_out[1];
   stream_out->sm.sm_int1 = 0;
+  stream_out->sm.sm_object0=stream_out->sm.sm_object1=OBJNULL;
   stream = make_two_way_stream(stream_in, stream_out);
   return(stream);
 }

diff --git a/o/sfaslelf.c b/o/sfaslelf.c
index 0901be6d3e11c8d1506aa84e76333076fb358138..8bc47a46ba9853761007092df803df408211d816 100755 (executable)
--- a/o/sfaslelf.c
+++ b/o/sfaslelf.c
@@ -54,9 +54,10 @@ License for more details.
 
 #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;})
 #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) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \
-      sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));})
+#define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC &&  sec->sh_type==SHT_PROGBITS)
+#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);})
+#define LOAD_SYM_BY_NAME(sym,st1) 0
+#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1))
 
 #define MASK(n) (~(~0ULL << (n)))
 
@@ -410,7 +411,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym *syme,const char *st1,Sym *d1,Sym *de,con
 
   for (sym=sym1;sym<syme;sym++) {
     
-    if (!LOAD_SYM(sym))
+    if (!LOAD_SYM(sym,st1))
       continue;
 
     if (d1) {
@@ -436,7 +437,7 @@ load_ptable(struct node **a,char **s,Sym *sym1,Sym *syme,const char *st1,
 
   for (sym=sym1;sym<syme;sym++) {
 
-    if (!LOAD_SYM(sym))
+    if (!LOAD_SYM(sym,st1))
       continue;
 
     if (d1) {

diff --git a/o/unixsys.c b/o/unixsys.c
index 17435647bbb7ca8994260ef608f180c372c96264..ee1dd8188d29fc8a853e11c938d99b2330c11c2e 100755 (executable)
--- a/o/unixsys.c
+++ b/o/unixsys.c
@@ -24,10 +24,38 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 #include <string.h>
 #include <sys/stat.h>
 #include <sys/types.h>
-
+#include <sys/wait.h>
 
 #include "include.h"
 
+int
+vsystem(const char *command) {
+
+  unsigned j,n=strlen(command);
+  char *z=alloca(n+1),**p1,**pp,*c;
+  int s;
+  pid_t pid;
+
+  memcpy(z,command,n+1);
+  for (j=0,c=z;strtok(c," \n\t");c=NULL,j++);
+
+  memcpy(z,command,n+1);
+  p1=alloca((j+1)*sizeof(*p1));
+  for (pp=p1,c=z;(*pp=strtok(c," \n\t"));c=NULL,pp++);
+
+  if (!(pid=vfork())) {
+    execvp(*p1,p1);
+    _exit(2);
+  }
+
+  massert(pid>0);
+  massert(pid==waitpid(pid,&s,0));
+
+  return s;
+
+}
+
+
 #ifdef ATT3B2
 #include <signal.h>
 int