X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdump.lisp;h=55b48a174026d36d11e8e5fc2e261e7411dce3db;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=6cffe9117f5d2226b8f90a5650e5b8eb8b3a0d43;hpb=8f45dd3a5a074998e1aa697ba8f2a8b1b7388427;p=sbcl.git diff --git a/src/compiler/dump.lisp b/src/compiler/dump.lisp index 6cffe91..55b48a1 100644 --- a/src/compiler/dump.lisp +++ b/src/compiler/dump.lisp @@ -298,6 +298,13 @@ :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) @@ -311,14 +318,8 @@ (format nil "~% ~ compiled from ~S~% ~ - at ~A~% ~ - on ~A~% ~ using ~A version ~A~%" where - #+sb-xc-host "cross-compile time" - #-sb-xc-host (format-universal-time nil (get-universal-time)) - #+sb-xc-host "cross-compile host" - #-sb-xc-host (machine-instance) (sb!xc:lisp-implementation-type) (sb!xc:lisp-implementation-version)))) stream) @@ -566,37 +567,55 @@ (dump-fop 'fop-long-float file) (dump-long-float x file)))) +(defun dump-complex-single-float (re im file) + (declare (single-float re im)) + (dump-fop 'fop-complex-single-float file) + (dump-integer-as-n-bytes (single-float-bits re) 4 file) + (dump-integer-as-n-bytes (single-float-bits im) 4 file)) + +(defun dump-complex-double-float (re im file) + (declare (double-float re im)) + (dump-fop 'fop-complex-double-float file) + (dump-integer-as-n-bytes (double-float-low-bits re) 4 file) + (dump-integer-as-n-bytes (double-float-high-bits re) 4 file) + (dump-integer-as-n-bytes (double-float-low-bits im) 4 file) + (dump-integer-as-n-bytes (double-float-high-bits im) 4 file)) + +(defun dump-complex-rational (re im file) + (sub-dump-object re file) + (sub-dump-object im file) + (dump-fop 'fop-complex file)) + +#+sb-xc-host +(defun dump-complex (x file) + (let ((re (realpart x)) + (im (imagpart x))) + (cond ((and (typep re 'single-float) + (typep im 'single-float)) + (dump-complex-single-float re im file)) + ((and (typep re 'double-float) + (typep im 'double-float)) + (dump-complex-double-float re im file)) + ((and (typep re 'rational) + (typep im 'rational)) + (dump-complex-rational re im file)) + (t + (bug "Complex number too complex: ~S" x))))) + +#-sb-xc-host (defun dump-complex (x file) (typecase x - #-sb-xc-host ((complex single-float) - (dump-fop 'fop-complex-single-float file) - (dump-integer-as-n-bytes (single-float-bits (realpart x)) 4 file) - (dump-integer-as-n-bytes (single-float-bits (imagpart x)) 4 file)) - #-sb-xc-host + (dump-complex-single-float (realpart x) (imagpart x) file)) ((complex double-float) - (dump-fop 'fop-complex-double-float file) - (let ((re (realpart x))) - (declare (double-float re)) - (dump-integer-as-n-bytes (double-float-low-bits re) 4 file) - (dump-integer-as-n-bytes (double-float-high-bits re) 4 file)) - (let ((im (imagpart x))) - (declare (double-float im)) - (dump-integer-as-n-bytes (double-float-low-bits im) 4 file) - (dump-integer-as-n-bytes (double-float-high-bits im) 4 file))) + (dump-complex-double-float (realpart x) (imagpart x) file)) #!+long-float ((complex long-float) - ;; (There's no easy way to mix #!+LONG-FLOAT and #-SB-XC-HOST - ;; conditionalization at read time, so we do this SB-XC-HOST - ;; conditional at runtime instead.) - #+sb-xc-host (error "can't dump COMPLEX-LONG-FLOAT in cross-compiler") (dump-fop 'fop-complex-long-float file) (dump-long-float (realpart x) file) (dump-long-float (imagpart x) file)) (t - (sub-dump-object (realpart x) file) - (sub-dump-object (imagpart x) file) - (dump-fop 'fop-complex file)))) + (dump-complex-rational (realpart x) (imagpart x) file)))) ;;;; symbol dumping @@ -1231,7 +1250,7 @@ (dump-object name file) (dump-object (sb!c::entry-info-arguments entry) file) (dump-object (sb!c::entry-info-type entry) file) - (dump-object (sb!c::entry-info-xref entry) file) + (dump-object (sb!c::entry-info-info entry) file) (dump-fop 'fop-fun-entry file) (dump-word (label-position (sb!c::entry-info-offset entry)) file) (dump-pop file)))