Skip to content
Snippets Groups Projects
Commit c02c3223 authored by toy's avatar toy
Browse files

Add :verbose option to load-foreign to honor *load-verbose*. (From

Stig Erik Sandoe)
parent 87f8795a
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.32 2001/01/05 05:43:47 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/foreign.lisp,v 1.33 2001/05/14 14:22:53 toy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -463,7 +463,8 @@ to skip undefined symbols which don't have an address." ...@@ -463,7 +463,8 @@ to skip undefined symbols which don't have an address."
(merge-pathnames *command-line-utility-name* (merge-pathnames *command-line-utility-name*
"path:") "path:")
#+hpux "library:cmucl.orig") #+hpux "library:cmucl.orig")
(env ext:*environment-list*)) (env ext:*environment-list*)
(verbose *load-verbose*))
"Load-foreign loads a list of C object files into a running Lisp. The files "Load-foreign loads a list of C object files into a running Lisp. The files
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
specified as namestrings or as pathnames. The libraries argument should be a specified as namestrings or as pathnames. The libraries argument should be a
...@@ -478,8 +479,9 @@ to skip undefined symbols which don't have an address." ...@@ -478,8 +479,9 @@ to skip undefined symbols which don't have an address."
(error-output (make-string-output-stream)) (error-output (make-string-output-stream))
(files (if (atom files) (list files) files))) (files (if (atom files) (list files) files)))
(format t ";;; Running library:load-foreign.csh...~%") (when verbose
(force-output) (format t ";;; Running library:load-foreign.csh...~%")
(force-output))
#+hpux #+hpux
(dolist (f files) (dolist (f files)
(with-open-file (stream f :element-type '(unsigned-byte 16)) (with-open-file (stream f :element-type '(unsigned-byte 16))
...@@ -532,7 +534,9 @@ to skip undefined symbols which don't have an address." ...@@ -532,7 +534,9 @@ to skip undefined symbols which don't have an address."
(setf *previous-linked-object-file* output-file) (setf *previous-linked-object-file* output-file)
(when old-file (when old-file
(unix:unix-unlink old-file))))) (unix:unix-unlink old-file)))))
(format t ";;; Done.~%")) (when verbose
(format t ";;; Done.~%")
(force-output)))
(export '(alternate-get-global-address)) (export '(alternate-get-global-address))
...@@ -616,7 +620,8 @@ to skip undefined symbols which don't have an address." ...@@ -616,7 +620,8 @@ to skip undefined symbols which don't have an address."
(defun load-foreign (files &key (defun load-foreign (files &key
(libraries '("-lc")) (libraries '("-lc"))
(base-file nil) (base-file nil)
(env ext:*environment-list*)) (env ext:*environment-list*)
(verbose *load-verbose*))
"Load-foreign loads a list of C object files into a running Lisp. The files "Load-foreign loads a list of C object files into a running Lisp. The files
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
specified as namestrings or as pathnames. The libraries argument should be a specified as namestrings or as pathnames. The libraries argument should be a
...@@ -632,9 +637,11 @@ to skip undefined symbols which don't have an address." ...@@ -632,9 +637,11 @@ to skip undefined symbols which don't have an address."
(let ((output-file (pick-temporary-file-name (let ((output-file (pick-temporary-file-name
(concatenate 'string "/tmp/~D~C" (string (gensym))))) (concatenate 'string "/tmp/~D~C" (string (gensym)))))
(error-output (make-string-output-stream))) (error-output (make-string-output-stream)))
(format t ";;; Running ~A...~%" *dso-linker*) (when verbose
(force-output) (format t ";;; Running ~A...~%" *dso-linker*)
(force-output))
(let ((proc (ext:run-program (let ((proc (ext:run-program
*dso-linker* *dso-linker*
(list* (list*
...@@ -667,5 +674,7 @@ to skip undefined symbols which don't have an address." ...@@ -667,5 +674,7 @@ to skip undefined symbols which don't have an address."
(load-object-file output-file) (load-object-file output-file)
(unix:unix-unlink output-file) (unix:unix-unlink output-file)
)) ))
(format t ";;; Done.~%")) (when verbose
(format t ";;; Done.~%")
(force-output)))
) )
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment