/[cmucl]/src/code/foreign.lisp
ViewVC logotype

Diff of /src/code/foreign.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.50.2.1 by rtoy, Mon Dec 19 01:09:50 2005 UTC revision 1.60 by rtoy, Fri Jan 21 15:44:58 2011 UTC
# Line 11  Line 11 
11  ;;;  ;;;
12  (in-package "SYSTEM")  (in-package "SYSTEM")
13    
14    (intl:textdomain "cmucl")
15    
16  (in-package "ALIEN")  (in-package "ALIEN")
17  (export '(load-foreign))  (export '(load-foreign))
18  (in-package "SYSTEM")  (in-package "SYSTEM")
# Line 44  Line 46 
46                   (unix:unix-close fd)                   (unix:unix-close fd)
47                   (return name))                   (return name))
48                  ((not (= errno unix:eexist))                  ((not (= errno unix:eexist))
49                   (error "Could not create temporary file ~S: ~A"                   (error (intl:gettext "Could not create temporary file ~S: ~A")
50                          name (unix:get-unix-error-msg errno)))                          name (unix:get-unix-error-msg errno)))
51    
52                  ((= code (char-code #\Z))                  ((= code (char-code #\Z))
# Line 73  Line 75 
75           (addr (int-sap *foreign-segment-free-pointer*))           (addr (int-sap *foreign-segment-free-pointer*))
76           (new-ptr (+ *foreign-segment-free-pointer* memory-needed)))           (new-ptr (+ *foreign-segment-free-pointer* memory-needed)))
77      (when (> new-ptr (+ foreign-segment-start foreign-segment-size))      (when (> new-ptr (+ foreign-segment-start foreign-segment-size))
78        (error "Not enough memory left."))        (error (intl:gettext "Not enough memory left.")))
79      (setf *foreign-segment-free-pointer* new-ptr)      (setf *foreign-segment-free-pointer* new-ptr)
80      (allocate-system-memory-at addr memory-needed)      (allocate-system-memory-at addr memory-needed)
81      addr))      addr))
# Line 165  Line 167 
167    (make-array 4 :element-type '(unsigned-byte 8)    (make-array 4 :element-type '(unsigned-byte 8)
168                  :initial-contents '(127 69 76 70))) ; 0x7f-E-L-F                  :initial-contents '(127 69 76 70))) ; 0x7f-E-L-F
169  (defun elf-p (h)  (defun elf-p (h)
170    "Make sure the header starts with the ELF magic value."    _N"Make sure the header starts with the ELF magic value."
171    (dotimes (i 4 t)    (dotimes (i 4 t)
172      (unless (= (alien:deref h i) (aref +elf-magic+ i))      (unless (= (alien:deref h i) (aref +elf-magic+ i))
173        (return nil))))        (return nil))))
174    
175  (defun elf-osabi (h)  (defun elf-osabi (h)
176    "Return the `osabi' field in the padding of the ELF file."    _N"Return the `osabi' field in the padding of the ELF file."
177    (alien:deref h ei-osabi))    (alien:deref h ei-osabi))
178    
179  (defun elf-osabi-name (id)  (defun elf-osabi-name (id)
# Line 194  Line 196 
196      (t (format nil "Unknown ABI (~D)" id))))      (t (format nil "Unknown ABI (~D)" id))))
197    
198  (defun elf-executable-p (n)  (defun elf-executable-p (n)
199    "Given a file type number, determine whether the file is executable."    _N"Given a file type number, determine whether the file is executable."
200    (= n et-executable))    (= n et-executable))
201    
202  (defun file-shared-library-p (pathname)  (defun file-shared-library-p (pathname)
# Line 258  Line 260 
260  (defconstant fat-header-magic #xcafebabe)  (defconstant fat-header-magic #xcafebabe)
261    
262  (defun mach-o-p (h)  (defun mach-o-p (h)
263    "Make sure the header starts with the mach-o magic value."    _N"Make sure the header starts with the mach-o magic value."
264    (eql (alien:slot h 'magic) mh-magic))    (eql (alien:slot h 'magic) mh-magic))
265    
266  ;;; Read an unsigned 32-bit big-endian number from STREAM.  ;;; Read an unsigned 32-bit big-endian number from STREAM.
# Line 355  Line 357 
357    exit 0    exit 0
358    ||#    ||#
359    
360    (format t ";;; Loading object file...~%")    (format t (intl:gettext ";;; Loading object file...~%"))
361    (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)    (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)
362      (unless fd      (unless fd
363        (error "Could not open ~S: ~A" name (unix:get-unix-error-msg errno)))        (error (intl:gettext "Could not open ~S: ~A") name (unix:get-unix-error-msg errno)))
364      (unwind-protect      (unwind-protect
365          (alien:with-alien ((header eheader))          (alien:with-alien ((header eheader))
366            (unix:unix-read fd            (unix:unix-read fd
367                            (alien:alien-sap header)                            (alien:alien-sap header)
368                            (alien:alien-size eheader :bytes))                            (alien:alien-size eheader :bytes))
369            (unless (elf-p (alien:slot header 'elf-ident))            (unless (elf-p (alien:slot header 'elf-ident))
370              (error (format nil "~A is not an ELF file." name)))              (error (format nil (intl:gettext "~A is not an ELF file.") name)))
371    
372            (let ((osabi (elf-osabi (alien:slot header 'elf-ident)))            (let ((osabi (elf-osabi (alien:slot header 'elf-ident)))
373                  (expected-osabi #+NetBSD elfosabi-netbsd                  (expected-osabi #+NetBSD elfosabi-netbsd
374                                  #+FreeBSD elfosabi-freebsd))                                  #+FreeBSD elfosabi-freebsd))
375              (unless (= osabi expected-osabi)              (unless (= osabi expected-osabi)
376                (error "~A is not a ~A executable, it's a ~A executable."                (error (intl:gettext "~A is not a ~A executable, it's a ~A executable.")
377                       name                       name
378                       (elf-osabi-name expected-osabi)                       (elf-osabi-name expected-osabi)
379                       (elf-osabi-name osabi))))                       (elf-osabi-name osabi))))
380    
381            (unless (elf-executable-p (alien:slot header 'elf-type))            (unless (elf-executable-p (alien:slot header 'elf-type))
382              (error (format nil "~A is not executable." name)))              (error (format nil (intl:gettext "~A is not executable.") name)))
383    
384            (alien:with-alien ((program-header pheader))            (alien:with-alien ((program-header pheader))
385              (unix:unix-read fd              (unix:unix-read fd
# Line 392  Line 394 
394        (unix:unix-close fd))))        (unix:unix-close fd))))
395    
396  (defun parse-symbol-table (name)  (defun parse-symbol-table (name)
397    "Parse symbol table file created by load-foreign script.  Modified    _N"Parse symbol table file created by load-foreign script.  Modified
398  to skip undefined symbols which don't have an address."  to skip undefined symbols which don't have an address."
399    (format t ";;; Parsing symbol table...~%")    (format t (intl:gettext ";;; Parsing symbol table...~%"))
400    (let ((symbol-table (make-hash-table :test #'equal)))    (let ((symbol-table (make-hash-table :test #'equal)))
401      (with-open-file (file name)      (with-open-file (file name)
402        (loop        (loop
# Line 421  to skip undefined symbols which don't ha Line 423  to skip undefined symbols which don't ha
423  ;;; expected results. It is probably good enough for now.  ;;; expected results. It is probably good enough for now.
424  #+(or (and FreeBSD (not ELF)) (and sparc (not svr4)))  #+(or (and FreeBSD (not ELF)) (and sparc (not svr4)))
425  (defun load-object-file (name)  (defun load-object-file (name)
426    (format t ";;; Loading object file...~%")    (format t (intl:gettext ";;; Loading object file...~%"))
427    (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)    (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)
428      (unless fd      (unless fd
429        (error "Could not open ~S: ~A" name (unix:get-unix-error-msg errno)))        (error (intl:gettext "Could not open ~S: ~A") name (unix:get-unix-error-msg errno)))
430      (unwind-protect      (unwind-protect
431          (alien:with-alien ((header exec))          (alien:with-alien ((header exec))
432            (unix:unix-read fd            (unix:unix-read fd
# Line 524  to skip undefined symbols which don't ha Line 526  to skip undefined symbols which don't ha
526    
527  #+hppa  #+hppa
528  (defun load-object-file (name)  (defun load-object-file (name)
529    (format t ";;; Loading object file...~%")    (format t (intl:gettext ";;; Loading object file...~%"))
530    (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)    (multiple-value-bind (fd errno) (unix:unix-open name unix:o_rdonly 0)
531      (unless fd      (unless fd
532        (error "Could not open ~S: ~A" name (unix:get-unix-error-msg errno)))        (error (intl:gettext "Could not open ~S: ~A") name (unix:get-unix-error-msg errno)))
533      (unwind-protect      (unwind-protect
534          (alien:with-alien ((header (alien:struct som_exec_auxhdr)))          (alien:with-alien ((header (alien:struct som_exec_auxhdr)))
535            (unix:unix-lseek fd (alien:alien-size (alien:struct header) :bytes)            (unix:unix-lseek fd (alien:alien-size (alien:struct header) :bytes)
# Line 566  to skip undefined symbols which don't ha Line 568  to skip undefined symbols which don't ha
568  #-(or linux bsd solaris irix)  #-(or linux bsd solaris irix)
569  (progn  (progn
570  (defun parse-symbol-table (name)  (defun parse-symbol-table (name)
571    (format t ";;; Parsing symbol table...~%")    (format t (intl:gettext ";;; Parsing symbol table...~%"))
572    (let ((symbol-table (make-hash-table :test #'equal)))    (let ((symbol-table (make-hash-table :test #'equal)))
573      (with-open-file (file name)      (with-open-file (file name)
574        (loop        (loop
# Line 593  to skip undefined symbols which don't ha Line 595  to skip undefined symbols which don't ha
595                              #+hpux "library:cmucl.orig")                              #+hpux "library:cmucl.orig")
596                             (env ext:*environment-list*)                             (env ext:*environment-list*)
597                             (verbose *load-verbose*))                             (verbose *load-verbose*))
598    "Load-foreign loads a list of C object files into a running Lisp.  The files    _N"Load-foreign loads a list of C object files into a running Lisp.  The files
599    argument should be a single file or a list of files.  The files may be    argument should be a single file or a list of files.  The files may be
600    specified as namestrings or as pathnames.  The libraries argument should be a    specified as namestrings or as pathnames.  The libraries argument should be a
601    list of library files as would be specified to ld.  They will be searched in    list of library files as would be specified to ld.  They will be searched in
# Line 608  to skip undefined symbols which don't ha Line 610  to skip undefined symbols which don't ha
610          (files (if (atom files) (list files) files)))          (files (if (atom files) (list files) files)))
611    
612      (when verbose      (when verbose
613        (format t ";;; Running library:load-foreign.csh...~%")        (format t (intl:gettext ";;; Running library:load-foreign.csh...~%"))
614        (force-output))        (force-output))
615      #+hpux      #+hpux
616      (dolist (f files)      (dolist (f files)
# Line 617  to skip undefined symbols which don't ha Line 619  to skip undefined symbols which don't ha
619                    (or (eql sysid cpu-pa-risc1-0)                    (or (eql sysid cpu-pa-risc1-0)
620                        (and (>= sysid cpu-pa-risc1-1)                        (and (>= sysid cpu-pa-risc1-1)
621                             (<= sysid cpu-pa-risc-max))))                             (<= sysid cpu-pa-risc-max))))
622            (error "Object file is wrong format, so can't load-foreign:~            (error (intl:gettext "Object file is wrong format, so can't load-foreign:~
623                    ~%  ~S"                    ~%  ~S")
624                   f))                   f))
625          (unless (eql (read-byte stream) reloc-magic)          (unless (eql (read-byte stream) reloc-magic)
626            (error "Object file is not relocatable, so can't load-foreign:~            (error (intl:gettext "Object file is not relocatable, so can't load-foreign:~
627                    ~%  ~S"                    ~%  ~S")
628                   f))))                   f))))
629    
630      (let ((proc (ext:run-program      (let ((proc (ext:run-program
# Line 650  to skip undefined symbols which don't ha Line 652  to skip undefined symbols which don't ha
652                   :output error-output                   :output error-output
653                   :error :output)))                   :error :output)))
654        (unless proc        (unless proc
655          (error "Could not run library:load-foreign.csh"))          (error (intl:gettext "Could not run library:load-foreign.csh")))
656        (unless (zerop (ext:process-exit-code proc))        (unless (zerop (ext:process-exit-code proc))
657          (system:serve-all-events 0)          (system:serve-all-events 0)
658          (error "library:load-foreign.csh failed:~%~A"          (error (intl:gettext "library:load-foreign.csh failed:~%~A")
659                 (get-output-stream-string error-output)))                 (get-output-stream-string error-output)))
660        (load-object-file output-file)        (load-object-file output-file)
661        (parse-symbol-table symbol-table-file)        (parse-symbol-table symbol-table-file)
# Line 663  to skip undefined symbols which don't ha Line 665  to skip undefined symbols which don't ha
665          (when old-file          (when old-file
666            (unix:unix-unlink old-file)))))            (unix:unix-unlink old-file)))))
667    (when verbose    (when verbose
668      (format t ";;; Done.~%")      (format t (intl:gettext ";;; Done.~%"))
669      (force-output)))      (force-output)))
670    
671    
# Line 681  to skip undefined symbols which don't ha Line 683  to skip undefined symbols which don't ha
683  (progn  (progn
684    
685  (defconstant rtld-lazy 1  (defconstant rtld-lazy 1
686    "Lazy function call binding")    _N"Lazy function call binding")
687  (defconstant rtld-now 2  (defconstant rtld-now 2
688    "Immediate function call binding")    _N"Immediate function call binding")
689  #+(and linux glibc2)  #+(and linux glibc2)
690  (defconstant rtld-binding-mask #x3  (defconstant rtld-binding-mask #x3
691    "Mask of binding time value")    _N"Mask of binding time value")
692    
693  (defconstant rtld-global #-irix #x100 #+irix 4  (defconstant rtld-global #-irix #x100 #+irix 4
694    "If set the symbols of the loaded object and its dependencies are    _N"If set the symbols of the loaded object and its dependencies are
695     made visible as if the object were linked directly into the program")     made visible as if the object were linked directly into the program")
696    
697  (defvar *global-table* nil)  (defvar *global-table* nil)
# Line 726  to skip undefined symbols which don't ha Line 728  to skip undefined symbols which don't ha
728      (setf *global-table* (acons (int-sap 0) nil nil))      (setf *global-table* (acons (int-sap 0) nil nil))
729      (setf *global-table* (acons (dlopen nil rtld-lazy) nil nil))      (setf *global-table* (acons (dlopen nil rtld-lazy) nil nil))
730      (when (zerop (system:sap-int (caar *global-table*)))      (when (zerop (system:sap-int (caar *global-table*)))
731        (error "Can't open global symbol table: ~S" (dlerror)))))        (error (intl:gettext "Can't open global symbol table: ~S") (dlerror)))))
732    
733    (defun convert-object-file-path (path)
734      ;; Convert path to something that dlopen might like, which means
735      ;; translating logical pathnames and converting search-lists to the
736      ;; first path that exists.
737      (cond ((lisp::logical-pathname-p (pathname path))
738             (translate-logical-pathname path))
739            ((ignore-errors (ext:search-list-defined-p (pathname path)))
740             (ext:enumerate-search-list (s (pathname path)
741                                           path)
742               (when (probe-file s)
743                 (return s))))
744            (t
745             path)))
746    
747  (defun load-object-file (file)  (defun load-object-file (file &optional (recordp t))
748    (ensure-lisp-table-opened)    (ensure-lisp-table-opened)
749    ; rtld global: so it can find all the symbols previously loaded    ; rtld global: so it can find all the symbols previously loaded
750    ; rtld now: that way dlopen will fail if not all symbols are defined.    ; rtld now: that way dlopen will fail if not all symbols are defined.
751    (let* ((filename (namestring (if (lisp::logical-pathname-p (pathname file))    (let* ((filename (namestring (convert-object-file-path file)))
                                    (translate-logical-pathname file)  
                                    file)))  
752           (sap (dlopen filename (logior rtld-now rtld-global))))           (sap (dlopen filename (logior rtld-now rtld-global))))
753      (cond ((zerop (sap-int sap))      (cond ((zerop (sap-int sap))
754             (let ((err-string (dlerror))             (let ((err-string (dlerror))
# Line 742  to skip undefined symbols which don't ha Line 756  to skip undefined symbols which don't ha
756               ;; For some reason dlerror always seems to return NIL,               ;; For some reason dlerror always seems to return NIL,
757               ;; which isn't very informative.               ;; which isn't very informative.
758               (when (zerop (sap-int sap))               (when (zerop (sap-int sap))
759                 (error "Can't open object ~S: ~S" file err-string))                 (return-from load-object-file
760                     (values nil (format nil  (intl:gettext "Can't open object ~S: ~S") file err-string))))
761               (dlclose sap)               (dlclose sap)
762               (error "LOAD-OBJECT-FILE: Unresolved symbols in file ~S: ~S"               (return-from load-object-file
763                      file err-string)))                 (values nil
764            ((null (assoc sap *global-table* :test #'sap=))                         (format nil (intl:gettext "LOAD-OBJECT-FILE: Unresolved symbols in file ~S: ~S")
765                                   file err-string)))))
766              ((and recordp (null (assoc sap *global-table* :test #'sap=)))
767             (setf *global-table* (acons sap file *global-table*)))             (setf *global-table* (acons sap file *global-table*)))
768            (t nil))))            (t nil))))
769    
# Line 769  to skip undefined symbols which don't ha Line 786  to skip undefined symbols which don't ha
786    (loop for lib-entry in (reverse *global-table*)    (loop for lib-entry in (reverse *global-table*)
787          for (sap . lib-path) = lib-entry          for (sap . lib-path) = lib-entry
788          when lib-path          when lib-path
789          do (let ((new-sap (dlopen (namestring lib-path)       do
790                                    (logior rtld-now rtld-global))))         (loop
791               (when (zerop (sap-int new-sap))            (restart-case
792                 ;; We're going down                (let ((new-sap (dlopen (namestring (convert-object-file-path lib-path))
793                 (error "Couldn't open library ~S: ~S" lib-path (dlerror)))                                       (logior rtld-now rtld-global))))
794               (setf (car lib-entry) new-sap)))                  (cond ((zerop (sap-int new-sap))
795                           ;; We're going down
796                           (error (intl:gettext "Couldn't open library ~S: ~S") lib-path (dlerror)))
797                          (t
798                           (format t (intl:gettext "Reloaded library ~S~%") lib-path)
799                           (force-output)))
800    
801                    (setf (car lib-entry) new-sap)
802                    (return))
803                (continue ()
804                  :report (lambda (stream)
805                            (write-string (intl:gettext "Ignore library and continue") stream))
806                  (return))
807                (try-again ()
808                  :report (lambda (stream)
809                            (write-string (intl:gettext "Try reloading again") stream))
810                  )
811                (new-library ()
812                  :report (lambda (stream)
813                            (write-string (intl:gettext "Choose new library path") stream))
814                  (format *query-io* (intl:gettext "Enter new library path: "))
815                  (setf lib-path (read))))))
816    (alien:alien-funcall (alien:extern-alien "os_resolve_data_linkage"    (alien:alien-funcall (alien:extern-alien "os_resolve_data_linkage"
817                                             (alien:function c-call:void))))                                             (alien:function c-call:void))))
818    
# Line 794  to skip undefined symbols which don't ha Line 832  to skip undefined symbols which don't ha
832                             (base-file nil)                             (base-file nil)
833                             (env ext:*environment-list*)                             (env ext:*environment-list*)
834                             (verbose *load-verbose*))                             (verbose *load-verbose*))
835    "Load C object files into the running Lisp. The FILES argument    _N"Load C object files into the running Lisp. The FILES argument
836  should be a single file or a list of files. The files may be specified  should be a single file or a list of files. The files may be specified
837  as namestrings or as pathnames. The LIBRARIES argument should be a  as namestrings or as pathnames. The LIBRARIES argument should be a
838  list of library files as would be specified to ld. They will be  list of library files as would be specified to ld. They will be
# Line 804  the starting place for defined symbols. Line 842  the starting place for defined symbols.
842  code for Lisp. The ENV argument is the Unix environment variable  code for Lisp. The ENV argument is the Unix environment variable
843  definitions for the invocation of the linker. The default is the  definitions for the invocation of the linker. The default is the
844  environment passed to Lisp."  environment passed to Lisp."
845    ;; Note: dlopen remembers the name of an object, when dlopenin    ;; Note: dlopen remembers the name of an object, when dlopen()ing
846    ;; the same name twice, the old objects is reused.    ;; the same name twice, the old object is reused.
847    (declare (ignore base-file))    (declare (ignore base-file))
848    ;; if passed a single shared object that can be loaded directly via    ;; if passed a single shared object that can be loaded directly via
849    ;; dlopen(), do that instead of using the linker    ;; dlopen(), do that instead of using the linker
850    (cond ((and (atom files)    (when (atom files)
851                (probe-file files)      (when verbose
852                (file-shared-library-p files))        (format t (intl:gettext ";;; Opening as shared library ~A ...~%") files))
853           (when verbose      (multiple-value-bind (ok error-string)
854             (format t ";;; Opening shared library ~A ...~%" files))          (load-object-file files)
855           (load-object-file files)        (cond (ok
856           (when verbose               (when verbose
857             (format t ";;; Done.~%")))                 (format t (intl:gettext ";;; Done.~%"))
858          (t                 (force-output))
859           (let ((output-file (pick-temporary-file-name               (return-from load-foreign))
860                               (concatenate 'string "/tmp/~D~C" (string (gensym)))))              (error-string
861                 (error-output (make-string-output-stream)))               (format t "~A~%" error-string)
862                 (force-output))))
863    
864        ;; If we get here, we couldn't open the file as a shared library.
865        ;; Try again assuming it's an object file.
866        (when verbose
867          (format t (intl:gettext ";;; Trying as object file ~A...~%") files)))
868    
869    
870      (let ((output-file (pick-temporary-file-name
871                          (concatenate 'string "/tmp/~D~C" (string (gensym)))))
872            (error-output (make-string-output-stream)))
873    
874             (when verbose      (when verbose
875               (format t ";;; Running ~A...~%" *dso-linker*)        (format t (intl:gettext ";;; Running ~A...~%") *dso-linker*)
876               (force-output))        (force-output))
877    
878             (let ((proc (ext:run-program      (let ((proc (ext:run-program
879                          *dso-linker*                   *dso-linker*
880                          (list*                   (list*
881                           #+(or solaris linux FreeBSD4) "-G"                    #+(or solaris linux) "-G"
882                           #+(or OpenBSD NetBSD irix) "-shared"                    #+(or freebsd OpenBSD NetBSD irix) "-shared"
883                           #+darwin "-dylib"                    #+darwin "-dylib"
884                           "-o"                    #+darwin "-arch"
885                           output-file                    #+darwin "i386"
886                           ;; Cause all specified libs to be loaded in full                    "-o"
887                           #+(or OpenBSD linux FreeBSD4 NetBSD) "--whole-archive"                    output-file
888                           #+solaris "-z" #+solaris "allextract"                    ;; Cause all specified libs to be loaded in full
889                           #+darwin "-all_load"                    #+(or freebsd OpenBSD linux NetBSD) "--whole-archive"
890                           (append (mapcar                    #+solaris "-z" #+solaris "allextract"
891                                    #'(lambda (name)                    #+darwin "-all_load"
892                                        (or (unix-namestring name)                    (append (mapcar
893                                            (error 'simple-file-error                             #'(lambda (name)
894                                                   :pathname name                                 (or (unix-namestring name)
895                                                   :format-control                                     (error 'simple-file-error
896                                                   "File does not exist: ~A."                                            :pathname name
897                                                   :format-arguments                                            :format-control
898                                                   (list name))))                                            (intl:gettext "File does not exist: ~A.")
899                                    (if (atom files)                                            :format-arguments
900                                        (list files)                                            (list name))))
901                                        files))                             (if (atom files)
902                                   ;; Return to default ld behaviour for libs                                 (list files)
903                                   (list                                 files))
904                                    #+(or OpenBSD linux FreeBSD4 NetBSD)                            ;; Return to default ld behaviour for libs
905                                    "--no-whole-archive"                            (list
906                                    #+solaris "-z" #+solaris "defaultextract")                             #+(or freebsd OpenBSD linux NetBSD)
907                                   libraries))                             "--no-whole-archive"
908                          ;; on Linux/AMD64, we need to tell the platform linker to use the 32-bit                             #+solaris "-z" #+solaris "defaultextract")
909                          ;; linking mode instead of the default 64-bit mode. This can be done either                            libraries))
910                          ;; via the LDEMULATION environment variable, or via the "-m" command-line                   ;; on Linux/AMD64, we need to tell the platform linker to use
911                          ;; option. Here we assume that LDEMULATION will be ignored by the platform                   ;; the 32-bit linking mode instead of the default 64-bit mode.
912                          ;; linker on Linux/i386 platforms.                   ;; This can be done either via the LDEMULATION environment
913                          :env `(#+(and x86 linux) (:ldemulation . "elf_i386") ,@env)                   ;; variable, or via the "-m" command-line option. Here we
914                          :input nil                   ;; assume that LDEMULATION will be ignored by the platform
915                          :output error-output                   ;; linker on Linux/i386 platforms.
916                          :error :output)))                   :env `(#+(and x86 linux) (:ldemulation . "elf_i386") ,@env)
917               (unless proc                   :input nil
918                 (error "Could not run ~A" *dso-linker*))                   :output error-output
919               (unless (zerop (ext:process-exit-code proc))                   :error :output)))
920                 (system:serve-all-events 0)        (unless proc
921                 (error "~A failed:~%~A" *dso-linker*          (error (intl:gettext "Could not run ~A") *dso-linker*))
922                        (get-output-stream-string error-output)))        (unless (zerop (ext:process-exit-code proc))
923               (load-object-file output-file)          (system:serve-all-events 0)
924               (unix:unix-unlink output-file)))          (error (intl:gettext "~A failed:~%~A") *dso-linker*
925           (when verbose                 (get-output-stream-string error-output)))
926             (format t ";;; Done.~%")        (load-object-file output-file nil)
927             (force-output)))))        (unix:unix-unlink output-file))
928        (when verbose
929          (format t (intl:gettext ";;; Done.~%"))
930          (force-output))))
931    
932    #+linkage-table
933    (pushnew #'reinitialize-global-table ext:*after-save-initializations*)
934  ) ;; #+(or linux bsd solaris irix)  ) ;; #+(or linux bsd solaris irix)

Legend:
Removed from v.1.50.2.1  
changed lines
  Added in v.1.60

  ViewVC Help
Powered by ViewVC 1.1.5