:use ("CL" "SB!ALIEN" "SB!INT" "SB!SYS" "SB!GRAY")
:export ( ;; Information about how the program was invoked is
;; nonstandard but very useful.
- "*POSIX-ARGV*" "*CORE-PATHNAME*"
+ "*POSIX-ARGV*" "*CORE-PATHNAME*" "*RUNTIME-PATHNAME*"
"POSIX-GETENV" "POSIX-ENVIRON"
;; Atomic operations
(defvar *software-version* nil)
-(defvar *core-pathname* nil
- #!+sb-doc
- "The absolute pathname of the running SBCL core.")
-
(sb!alien:define-alien-variable ("posix_argv" *native-posix-argv*) (* (* char)))
(sb!alien:define-alien-variable ("core_string" *native-core-string*) (* char))
+(sb!alien:define-alien-routine os-get-runtime-executable-path sb!alien:c-string)
;;; if something ever needs to be done differently for one OS, then
;;; split out the different part into per-os functions.
(/show0 "setting *CORE-PATHNAME*")
(setf *core-pathname*
(merge-pathnames (native-pathname *core-string*)))
+ (/show0 "setting *RUNTIME-PATHNAME*")
+ (setf *runtime-pathname* (native-pathname (os-get-runtime-executable-path)))
(/show0 "leaving OS-COLD-INIT-OR-REINIT"))
(in-package "SB!IMPL")
+(defvar *core-pathname* nil
+ #!+sb-doc
+ "The absolute pathname of the running SBCL core.")
+
+(defvar *runtime-pathname* nil
+ #!+sb-doc
+ "The absolute pathname of the running SBCL runtime.")
+
;;; something not EQ to anything we might legitimately READ
(defparameter *eof-object* (make-symbol "EOF-OBJECT"))
(invalid-fasl-features condition)
(invalid-fasl-expected condition)))))
+;;; Skips past the shebang line on stream, if any.
+(defun maybe-skip-shebang-line (stream)
+ (let ((p (file-position stream)))
+ (flet ((next () (read-byte stream nil)))
+ (unwind-protect
+ (when (and (eq (next) (char-code #\#))
+ (eq (next) (char-code #\!)))
+ (setf p nil)
+ (loop for x = (next)
+ until (or (not x) (eq x (char-code #\newline)))))
+ (when p
+ (file-position stream p))))
+ t))
+
+;;; Returns T if the stream is a binary input stream with a FASL header.
+(defun fasl-header-p (stream &key errorp)
+ (let ((p (file-position stream)))
+ (unwind-protect
+ (let* ((header *fasl-header-string-start-string*)
+ (buffer (make-array (length header) :element-type '(unsigned-byte 8)))
+ (n 0))
+ (flet ((scan ()
+ (maybe-skip-shebang-line stream)
+ (setf n (read-sequence buffer stream))))
+ (if errorp
+ (scan)
+ (or (ignore-errors (scan))
+ ;; no a binary input stream
+ (return-from fasl-header-p nil))))
+ (if (mismatch buffer header
+ :test #'(lambda (code char) (= code (char-code char))))
+ ;; Immediate EOF is valid -- we want to match what
+ ;; CHECK-FASL-HEADER does...
+ (or (zerop n)
+ (when errorp
+ (error 'fasl-header-missing
+ :stream stream
+ :fhsss buffer
+ :expected header)))
+ t))
+ (file-position stream p))))
+
;;;; LOAD-AS-FASL
;;;;
;;;; Note: LOAD-AS-FASL is used not only by LOAD, but also (with
;;; a helper function for LOAD-FASL-GROUP
;;;
-;;; Return true if we successfully read a FASL header from the stream,
-;;; or NIL if EOF was hit before anything was read. Signal an error if
-;;; we encounter garbage.
+;;; Return true if we successfully read a FASL header from the stream, or NIL
+;;; if EOF was hit before anything except the optional shebang line was read.
+;;; Signal an error if we encounter garbage.
(defun check-fasl-header (stream)
+ (maybe-skip-shebang-line stream)
(let ((byte (read-byte stream nil)))
(when byte
;; Read and validate constant string prefix in fasl header.
#!+sb-doc
"Load the file given by FILESPEC into the Lisp environment, returning
T on success."
- (flet ((load-stream (stream)
+ (flet ((load-stream (stream faslp)
(let* (;; Bindings required by ANSI.
(*readtable* *readtable*)
(*package* (sane-package))
;; behavior. Hmm. -- WHN 2001-04-06
(sb!c::*policy* sb!c::*policy*))
(return-from load
- (if (equal (stream-element-type stream) '(unsigned-byte 8))
+ (if faslp
(load-as-fasl stream verbose print)
(load-as-source stream verbose print))))))
+ ;; Case 1: stream.
(when (streamp pathspec)
- (return-from load (load-stream pathspec)))
+ (return-from load (load-stream pathspec (fasl-header-p pathspec))))
(let ((pathname (pathname pathspec)))
+ ;; Case 2: Open as binary, try to process as a fasl.
(with-open-stream
(stream (or (open pathspec :element-type '(unsigned-byte 8)
:if-does-not-exist nil)
:format-arguments (list pathspec)))))
(unless stream
(return-from load nil))
-
- (let* ((header-line (make-array
- (length *fasl-header-string-start-string*)
- :element-type '(unsigned-byte 8))))
- (read-sequence header-line stream)
- (if (mismatch header-line *fasl-header-string-start-string*
- :test #'(lambda (code char) (= code (char-code char))))
- (let ((truename (probe-file stream)))
- (when (and truename
- (string= (pathname-type truename) *fasl-file-type*))
- (error 'fasl-header-missing
- :stream (namestring truename)
- :fhsss header-line
- :expected *fasl-header-string-start-string*)))
- (progn
- (file-position stream :start)
- (return-from load
- (load-stream stream))))))
+ (let* ((real (probe-file stream))
+ (should-be-fasl-p
+ (and real (string= (pathname-type real) *fasl-file-type*))))
+ (when (fasl-header-p stream :errorp should-be-fasl-p)
+ (return-from load (load-stream stream t)))))
+ ;; Case 3: Open using the gived external format, process as source.
(with-open-file (stream pathname :external-format external-format)
- (load-stream stream)))))
+ (load-stream stream nil)))))
;; This implements the defaulting SBCL seems to have inherited from
;; CMU. This routine does not try to perform any loading; all it does
(dolist (option options)
(process-1 option)))))
-;;; Skips past the shebang line on stream, if any.
-(defun maybe-skip-shebang-line (stream)
- (let ((p (file-position stream)))
- (flet ((next () (read-byte stream nil)))
- (unwind-protect
- (when (and (eq (next) (char-code #\#))
- (eq (next) (char-code #\!)))
- (setf p nil)
- (loop for x = (next)
- until (or (not x) (eq x (char-code #\newline)))))
- (when p
- (file-position stream p))))
- t))
-
(defun process-script (script)
(let ((pathname (native-pathname script)))
(handling-end-of-the-world
(with-open-file (f pathname :element-type :default)
- (maybe-skip-shebang-line f)
+ (sb!fasl::maybe-skip-shebang-line f)
(load f :verbose nil :print nil)
(quit)))))
:if-exists :supersede
:element-type 'sb!assem:assembly-unit))
(res (make-fasl-output :stream stream)))
+ ;; Before the actual FASL header, write a shebang line using the current
+ ;; runtime path, so our fasls can be executed directly from the shell.
+ (when *runtime-pathname*
+ (fasl-write-string
+ (format nil "#!~A --script~%"
+ (native-namestring *runtime-pathname* :as-file t))
+ stream))
;; Begin the header with the constant machine-readable (and
;; semi-human-readable) string which is used to identify fasl files.
(fasl-write-string *fasl-header-string-start-string* stream)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.29.26"
+"1.0.29.27"
projects / sbcl.git / commitdiff