changes in sbcl-0.6.13 relative to sbcl-0.6.12:
* a port to the Alpha CPU, thanks to Dan Barlow
+* Martin Atzmueller ported Tim Moore's marvellous CMU CL DISASSEMBLE
+ patch, so that DISASSEMBLE output is much nicer.
* better error handling in CLOS method combination, thanks to
Martin Atzmueller and Pierre Mai
+* Hash tables can be printed readably, as inspired by CMU CL code
+ of Eric Marsden and SBCL code of Martin Atzmueller.
+* a new slam.sh hack to shorten the edit/compile/debug cycle for
+ low-level changes to SBCL itself, and a new :SB-AFTER-XC-CORE
+ target feature to control the generation of the after-xc.core
+ file needed by slam.sh.
+* Compiler trace output (the :TRACE-FILE option to COMPILE-FILE)
+ is now a supported extension again, since the consensus is that
+ it can be useful for ordinary development work, not just for
+ debugging SBCL itself.
+?? more overflow fixes for >16Mbyte i/o buffers
+* minor incompatible change: The ENTRY-POINTS &KEY argument to
+ COMPILE-FILE is no longer supported, so that now every function
+ gets an entry point, so that block compilation looks a little
+ more like the plain vanilla ANSI section 3.2.2.3 scheme.
planned incompatible changes in 0.7.x:
* The debugger prompt sequence now goes "5]", "5[2]", "5[3]", etc.
and UNTRACE. (This shouldn't matter, though, unless you are
using profiling. If you never profile anything, TRACE should
continue to behave as before.)
+* The BYTE-COMPILE &KEY argument for COMPILE-FILE is deprecated,
+ since this behavior can be controlled by (DECLAIM (OPTIMIZE (SPEED 0))).
+ ("An ounce of orthogonality is worth a pound of features.")
;;; Return a list of keyword args and values to use for MAKE-HASH-TABLE
;;; when reconstructing HASH-TABLE.
-(defun hash-table-ctor-args (hash-table)
+(defun %hash-table-ctor-args (hash-table)
(when (hash-table-weak-p hash-table)
;; FIXME: This might actually work with no trouble, but as of
;; sbcl-0.6.12.10 when this code was written, weak hash tables
:rehash-threshold ',(hash-table-rehash-threshold hash-table)))
;;; Return an association list representing the same data as HASH-TABLE.
-(defun hash-table-alist (hash-table)
+(defun %hash-table-alist (hash-table)
(let ((result nil))
(maphash (lambda (key value)
(push (cons key value) result))
;;; so that we can use this for the *PRINT-READABLY* case in
;;; PRINT-OBJECT (HASH-TABLE T) without having to worry about LET
;;; forms and readable gensyms and stuff.
-(defun stuff-hash-table (hash-table alist)
+(defun %stuff-hash-table (hash-table alist)
(dolist (x alist)
(setf (gethash (car x) hash-table) (cdr x)))
hash-table)
(with-standard-io-syntax
(format stream
"#.~W"
- `(stuff-hash-table (make-hash-table ,@(hash-table-ctor-args
- hash-table))
- ',(hash-table-alist hash-table)))))))
+ `(%stuff-hash-table (make-hash-table ,@(%hash-table-ctor-args
+ hash-table))
+ ',(%hash-table-alist hash-table)))))))
(def!method make-load-form ((hash-table hash-table) &optional environment)
(declare (ignore environment))
- (values `(make-hash-table ,@(hash-table-ctor-args hash-table))
- `(stuff-hash-table ,hash-table ',(hash-table-alist hash-table))))
+ (values `(make-hash-table ,@(%hash-table-ctor-args hash-table))
+ `(%stuff-hash-table ,hash-table ',(%hash-table-alist hash-table))))
(xeps (generate-xeps component))
(constants (byte-component-info-constants
(component-info component))))
- #!+sb-show
(when *compiler-trace-output*
(describe-component component *compiler-trace-output*)
(describe-byte-component component xeps segment
(defvar *prev-segment*)
(defvar *prev-vop*)
-#!+sb-show
(defun trace-instruction (segment vop inst args)
(let ((*standard-output* *compiler-trace-output*))
(unless (eq *prev-segment* segment)
(block-next (component-head *component-being-compiled*))))
(or (> speed compilation-speed) (> space compilation-speed)))))
(defun default-segment-inst-hook ()
- #!+sb-show
- (and *compiler-trace-output* #'trace-instruction))
+ (and *compiler-trace-output*
+ #'trace-instruction))
(defun init-assembler ()
(setf *code-segment*
(values))
(defun generate-code (component)
- #!+sb-show
(when *compiler-trace-output*
(format *compiler-trace-output*
"~|~%assembly code for ~S~2%"
(defvar *compiler-warning-count*)
(defvar *compiler-style-warning-count*)
(defvar *compiler-note-count*)
+(defvar *compiler-trace-output*)
(defvar *constraint-number*)
(defvar *converting-for-interpreter*)
(defvar *count-vop-usages*)
(defknown compile-file
(filename
&key
+
+ ;; ANSI options
(:output-file (or filename
null
;; FIXME: This last case is a non-ANSI hack.
(:verbose t)
(:print t)
(:external-format t)
+
+ ;; extensions
+ (:trace-file t)
(:block-compile t)
- (:entry-points list)
(:byte-compile (member t nil :maybe)))
(values (or pathname null) boolean boolean))
(defvar *all-components*)
;;; Bind this to a stream to capture various internal debugging output.
-#!+sb-show
(defvar *compiler-trace-output* nil)
;;; The current block compilation state. These are initialized to the
(maybe-mumble "check-pack ")
(check-pack-consistency component))
- #!+sb-show
(when *compiler-trace-output*
(describe-component component *compiler-trace-output*)
(describe-ir2-component component *compiler-trace-output*))
(multiple-value-bind (code-length trace-table fixups)
(generate-code component)
- #!+sb-show
(when *compiler-trace-output*
(format *compiler-trace-output*
"~|~%disassembly of code for ~S~2%" component)
;;; Open some files and call SUB-COMPILE-FILE. If something unwinds
;;; out of the compile, then abort the writing of the output file, so
-;;; we don't overwrite it with known garbage.
+;;; that we don't overwrite it with known garbage.
(defun sb!xc:compile-file
(input-file
&key
+
+ ;; ANSI options
(output-file (cfp-output-file-default input-file))
;; FIXME: ANSI doesn't seem to say anything about
;; *COMPILE-VERBOSE* and *COMPILE-PRINT* being rebound by this
((:verbose sb!xc:*compile-verbose*) sb!xc:*compile-verbose*)
((:print sb!xc:*compile-print*) sb!xc:*compile-print*)
(external-format :default)
+
+ ;; extensions
+ (trace-file nil)
((:block-compile *block-compile-argument*) nil)
- ((:entry-points *entry-points*) nil)
((:byte-compile *byte-compile*) *byte-compile-default*))
+
#!+sb-doc
- "Compile INPUT-FILE, producing a corresponding fasl file.
- :Output-File
- The name of the fasl to output.
- :Block-Compile
- Determines whether multiple functions are compiled together as a unit,
- resolving function references at compile time. NIL means that global
- function names are never resolved at compilation time.
- :Entry-Points
- This specifies a list of function names for functions in the file(s) that
- must be given global definitions. This only applies to block
- compilation. If the value is NIL (the default) then all functions
- will be globally defined.
- :Byte-Compile {T | NIL | :MAYBE}
- Determines whether to compile into interpreted byte code instead of
- machine instructions. Byte code is several times smaller, but much
- slower. If :MAYBE, then only byte-compile when SPEED is 0 and
- DEBUG <= 1. The default is the value of SB-EXT:*BYTE-COMPILE-DEFAULT*,
- which is initially :MAYBE."
+ "Compile INPUT-FILE, producing a corresponding fasl file and returning
+ its filename. Besides the ANSI &KEY arguments :OUTPUT-FILE, :VERBOSE,
+ :PRINT, and :EXTERNAL-FORMAT,the following extensions are supported:
+ :TRACE-FILE
+ If given, internal data structures are dumped to the specified
+ file, or if a value of T is given, to a file of *.trace type
+ derived from the input file name.
+ :BYTE-COMPILE {T | NIL | :MAYBE}
+ Determines whether to compile into interpreted byte code instead of
+ machine instructions. Byte code is several times smaller, but much
+ slower. If :MAYBE, then only byte-compile when SPEED is 0 and
+ DEBUG <= 1. The default is the value of SB-EXT:*BYTE-COMPILE-DEFAULT*,
+ which is initially :MAYBE. (This option will probably become
+ formally deprecated starting around sbcl-0.7.0, when various
+ cleanups related to the byte interpreter are planned.)
+ Also, as a workaround for vaguely-non-ANSI behavior, the :BLOCK-COMPILE
+ argument is quasi-supported, to determine whether multiple
+ functions are compiled together as a unit, resolving function
+ references at compile time. NIL means that global function names
+ are never resolved at compilation time. Currently NIL is the
+ default behavior, because although section 3.2.2.3, \"Semantic
+ Constraints\", of the ANSI spec allows this behavior under all
+ circumstances, the compiler's runtime scales badly when it
+ tries to do this for large files. If/when this performance
+ problem is fixed, the block compilation default behavior will
+ probably be made dependent on the SPEED and COMPILATION-SPEED
+ optimization values, and the :BLOCK-COMPILE argument will probably
+ become deprecated."
+
(unless (eq external-format :default)
(error "Non-:DEFAULT EXTERNAL-FORMAT values are not supported."))
(let* ((fasl-file nil)
(compile-won nil)
(warnings-p nil)
(failure-p t) ; T in case error keeps this from being set later
- ;; KLUDGE: The listifying and unlistifying in the next calls
- ;; is to interface to old CMU CL code which accepted and
- ;; returned lists of multiple source files. It would be
- ;; cleaner to redo VERIFY-SOURCE-FILES and as
- ;; VERIFY-SOURCE-FILE, accepting a single source file, and
- ;; do a similar transformation on MAKE-FILE-SOURCE-INFO too.
- ;; -- WHN 20000201
+ ;; KLUDGE: The listifying and unlistifying in the stuff
+ ;; related to VERIFY-SOURCE-FILES below is to interface to
+ ;; old CMU CL code which accepted and returned lists of
+ ;; multiple source files. It would be cleaner to redo
+ ;; VERIFY-SOURCE-FILES as VERIFY-SOURCE-FILE, accepting a
+ ;; single source file, and do a similar transformation on
+ ;; MAKE-FILE-SOURCE-INFO too. -- WHN 20000201
(input-pathname (first (verify-source-files (list input-file))))
- (source-info (make-file-source-info (list input-pathname))))
+ (source-info (make-file-source-info (list input-pathname)))
+ (*compiler-trace-output* nil)) ; might be modified below
+
(unwind-protect
(progn
(when output-file
(open-fasl-file output-file-name
(namestring input-pathname)
(eq *byte-compile* t))))
+ (when trace-file
+ (let* ((default-trace-file-pathname
+ (make-pathname :type "trace" :defaults input-pathname))
+ (trace-file-pathname
+ (if (eql trace-file t)
+ default-trace-file-pathname
+ (make-pathname trace-file
+ default-trace-file-pathname))))
+ (setf *compiler-trace-output*
+ (open trace-file-pathname
+ :if-exists :supersede
+ :direction :output))))
(when sb!xc:*compile-verbose*
(start-error-output source-info))
(compiler-mumble "~2&; ~A written~%" (namestring output-file-name))))
(when sb!xc:*compile-verbose*
- (finish-error-output source-info compile-won)))
+ (finish-error-output source-info compile-won))
+
+ (when *compiler-trace-output*
+ (close *compiler-trace-output*)))
(values (if output-file
;; Hack around filesystem race condition...
;;; (Note: As of sbcl-0.6.7, this is target-only code not because it's
;;; logically target-only, but just because it's still implemented in
;;; terms of SAPs.)
-#!+sb-show
(defun describe-byte-component (component xeps segment *standard-output*)
(format t "~|~%;;;; byte component ~S~2%" (component-name component))
(format t ";;; functions:~%")
;; -- WHN 19990811
(sb!assem:on-segment-contents-vectorly segment
(lambda (chunk) (chunks chunk)))
- (let* ((total-bytes (reduce #'+ (mapcar #'cdr (chunks))))
- ;; KLUDGE: It's not clear that BUF has to be a SAP instead
- ;; of a nice high-level, safe, friendly vector. Perhaps
- ;; this code could be rewritten to use ordinary indices and
- ;; vectors instead of SAP references to chunks of raw
- ;; system memory? -- WHN 19990811
- (buf (allocate-system-memory total-bytes)))
- (let ((offset 0))
- (dolist (chunk (chunks))
- (declare (type (simple-array (unsigned-byte 8)) chunk))
- (copy-byte-vector-to-system-area chunk buf offset)
- (incf offset chunk-n-bits)))
-
- (disassem-byte-sap buf
- total-bytes
- (map 'vector
- #'(lambda (x)
+ (flet ((chunk-n-bytes (chunk) (length chunk)))
+ (let* ((total-bytes (reduce #'+ (chunks) :key #'chunk-n-bytes))
+ ;; FIXME: It's not clear that BUF has to be a SAP instead
+ ;; of a nice high-level, safe, friendly vector. Perhaps
+ ;; this code could be rewritten to use ordinary indices and
+ ;; vectors instead of SAP references to chunks of raw
+ ;; system memory? Failing that, the DEALLOCATE-SYSTEM-MEMORY
+ ;; operation below should probably be tied to the
+ ;; allocation here with an UNWIND-PROTECT relationship.
+ (buf (allocate-system-memory total-bytes)))
+ (let ((offset 0))
+ (dolist (chunk (chunks))
+ (let ((chunk-n-bits (* (chunk-n-bytes chunk) sb!vm:byte-bits)))
+ (declare (type (simple-array (unsigned-byte 8)) chunk))
+ (copy-byte-vector-to-system-area chunk buf offset)
+ (incf offset chunk-n-bits))))
+ (disassem-byte-sap buf
+ total-bytes
+ (map 'vector
+ (lambda (x)
(if (constant-p x)
(constant-value x)
x))
- (byte-component-info-constants
- (component-info component)))
- (sort (eps) #'<))
- (terpri)
- (deallocate-system-memory buf total-bytes)
- (values))))
+ (byte-component-info-constants
+ (component-info component)))
+ (sort (eps) #'<))
+ (terpri)
+ (deallocate-system-memory buf total-bytes)
+ (values)))))
;;; Given a byte-compiled function, disassemble it to standard output.
(defun disassem-byte-fun (xep)
;;; not just 4 on a risc machine!
(defconstant max-instruction-size 16)
-(defun sap-to-vector (sap start end)
- (let* ((length (- end start))
- (result (make-array length :element-type '(unsigned-byte 8)))
- (sap (sb!sys:sap+ sap start)))
- (dotimes (i length)
- (setf (aref result i) (sb!sys:sap-ref-8 sap i)))
- result))
-
-(defun add-block-segments (sap amount seglist location connecting-vec dstate)
+(defun add-block-segments (seg-code-block
+ seglist
+ location
+ connecting-vec
+ dstate)
(declare (type list seglist)
(type integer location)
(type (or null (vector (unsigned-byte 8))) connecting-vec)
(setf (seg-length seg) length)
(incf location length)
(push seg seglist)))))
- (let ((connecting-overflow 0))
+ (let ((connecting-overflow 0)
+ (amount (length seg-code-block)))
(when connecting-vec
;; Tack on some of the new block to the old overflow vector.
(let* ((beginning-of-block-amount
- (if sap (min max-instruction-size amount) 0))
+ (if seg-code-block (min max-instruction-size amount) 0))
(connecting-vec
- (if sap
+ (if seg-code-block
(concatenate
'(vector (unsigned-byte 8))
connecting-vec
- (sap-to-vector sap 0 beginning-of-block-amount))
+ (subseq seg-code-block 0 beginning-of-block-amount))
connecting-vec)))
(when (and (< (length connecting-vec) max-instruction-size)
- (not (null sap)))
+ (not (null seg-code-block)))
(return-from add-block-segments
;; We want connecting vectors to be large enough to hold
- ;; any instruction, and since the current sap wasn't large
- ;; enough to do this (and is now entirely on the end of the
- ;; overflow-vector), just save it for next time.
+ ;; any instruction, and since the current seg-code-block
+ ;; wasn't large enough to do this (and is now entirely
+ ;; on the end of the overflow-vector), just save it for
+ ;; next time.
(values seglist location connecting-vec)))
(when (> (length connecting-vec) 0)
(let ((seg
:virtual-location location)))
(setf connecting-overflow (segment-overflow seg dstate))
(addit seg connecting-overflow)))))
- (cond ((null sap)
+ (cond ((null seg-code-block)
;; nothing more to add
(values seglist location nil))
((< (- amount connecting-overflow) max-instruction-size)
;; in the overflow vector for the time-being.
(values seglist
location
- (sap-to-vector sap connecting-overflow amount)))
+ (subseq seg-code-block connecting-overflow amount)))
(t
;; Put as much as we can into a new segment, and the rest
;; into the overflow-vector.
(let* ((initial-length
(- amount connecting-overflow max-instruction-size))
(seg
- (make-segment (lambda ()
- (sb!sys:sap+ sap connecting-overflow))
- initial-length
- :virtual-location location))
+ (make-vector-segment seg-code-block
+ connecting-overflow
+ initial-length
+ :virtual-location location))
(overflow
(segment-overflow seg dstate)))
(addit seg overflow)
(values seglist
location
- (sap-to-vector sap
- (+ connecting-overflow (seg-length seg))
- amount))))))))
+ (subseq seg-code-block
+ (+ connecting-overflow (seg-length seg))
+ amount))))))))
\f
;;;; code to disassemble assembler segments
(let ((location 0)
(disassem-segments nil)
(connecting-vec nil))
- (error "stub: code not converted to new SEGMENT WHN 19990322" ; KLUDGE
- assem-segment) ; (to avoid "ASSEM-SEGMENT defined but never used")
- ;; old code, needs to be converted to use less-SAPpy ASSEM-SEGMENTs:
- #|(sb!assem:segment-map-output
+ (sb!assem:on-segment-contents-vectorly
assem-segment
- (lambda (sap amount)
+ (lambda (seg-code-block)
(multiple-value-setq (disassem-segments location connecting-vec)
- (add-block-segments sap amount
- disassem-segments location
+ (add-block-segments seg-code-block
+ disassem-segments
+ location
connecting-vec
- dstate))))|#
+ dstate))))
(when connecting-vec
(setf disassem-segments
- (add-block-segments nil nil
- disassem-segments location
+ (add-block-segments nil
+ disassem-segments
+ location
connecting-vec
dstate)))
(sort disassem-segments #'< :key #'seg-virtual-location)))
-;;; FIXME: I noticed that this is only called by #!+SB-SHOW code. It would
-;;; be good to see whether this is the only caller of any other functions.
-;;;
;;; Disassemble the machine code instructions associated with
;;; ASSEM-SEGMENT (of type assem:segment).
-#!+sb-show
(defun disassemble-assem-segment (assem-segment stream)
(declare (type sb!assem:segment assem-segment)
(type stream stream))
(setf *backend-fasl-file-type* "x86f")
(setf *backend-fasl-file-implementation* :x86)
-(setf *backend-fasl-file-version* 10)
+(setf *backend-fasl-file-version* 11)
;;; 2 = sbcl-0.6.4 uses COMPILE-OR-LOAD-DEFGENERIC.
;;; 3 = sbcl-0.6.6 uses private symbol, not :EMPTY, for empty HASH-TABLE slot.
;;; 4 = sbcl-0.6.7 uses HAIRY-DATA-VECTOR-REF and HAIRY-DATA-VECTOR-SET
;;; 9 = deleted obsolete CONS-UNIQUE-TAG bytecode in sbcl-0.6.11.8
;;; (somewhere in here also changes to AND and OR CTYPE layouts)
;;; 10 = new layout for CONDITION in sbcl-0.6.11.38
+;;; 11 = new helper functions for MAKE-LOAD-FORM (HASH-TABLE) in
+;;; sbcl-0.6.12.11
(setf *backend-register-save-penalty* 3)
(t
(format stream "~A PTR [" (symbol-name (ea-size ea)))
(when (ea-base ea)
- (write-string (x86-location-print-name (ea-base ea)) stream)
+ (write-string (sb!c::location-print-name (ea-base ea)) stream)
(when (ea-index ea)
(write-string "+" stream)))
(when (ea-index ea)
- (write-string (x86-location-print-name (ea-index ea)) stream))
+ (write-string (sb!c::location-print-name (ea-index ea)) stream))
(unless (= (ea-scale ea) 1)
(format stream "*~A" (ea-scale ea)))
(typecase (ea-disp ea)
;;; versions, and a string like "0.6.5.12" is used for versions which
;;; aren't released but correspond only to CVS tags or snapshots.
-"0.6.12.10"
+"0.6.12.11"
projects / sbcl.git / commitdiff