0.pre8.100:

[sbcl.git] / src / compiler / debug-dump.lisp

diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp
index 8e264a9..19f6a0f 100644 (file)
--- a/src/compiler/debug-dump.lisp
+++ b/src/compiler/debug-dump.lisp
@@ -240,7 +240,7 @@
 \f
 ;;; Return a list of DEBUG-SOURCE structures containing information
 ;;; derived from INFO. Unless :BYTE-COMPILE T was specified, we always
-;;; dump the Start-Positions, since it is too hard figure out whether
+;;; dump the START-POSITIONS, since it is too hard figure out whether
 ;;; we need them or not.
 (defun debug-source-for-info (info)
   (declare (type source-info info))
@@ -277,7 +277,8 @@
 ;;; a vector whose element size is an integer multiple of output byte
 ;;; size.
 (defun coerce-to-smallest-eltype (seq)
-  (let ((maxoid #-sb-xc-host 0
+  (let ((maxoid ;; It's probably better to avoid (UNSIGNED-BYTE 0).
+               #-sb-xc-host 1 
                ;; An initial value of 255 prevents us from
                ;; specializing the array to anything smaller than
                ;; (UNSIGNED-BYTE 8), which keeps the cross-compiler's
@@ -294,7 +295,17 @@
            (frob i))
          (dovector (i seq)
            (frob i)))
-      (coerce seq `(simple-array (integer 0 ,maxoid) (*))))))
+      (let ((specializer `(unsigned-byte ,(integer-length maxoid))))
+       ;; cross-compilers beware! It would be possible for the
+       ;; upgraded-array-element-type of (UNSIGNED-BYTE 15) to be
+       ;; (SIGNED-BYTE 16), and this is completely valid by
+       ;; ANSI. However, the cross-compiler doesn't know how to dump
+       ;; SIGNED-BYTE arrays, so better make it break now if it ever
+       ;; will:
+       #+sb-xc-host
+       (aver (subtypep (upgraded-array-element-type specializer) 
+                       'unsigned-byte))
+       (coerce seq `(simple-array ,specializer (*)))))))
 \f
 ;;;; variables
 
@@ -417,14 +428,14 @@
 \f
 ;;;; arguments/returns
 
-;;; Return a vector to be used as the
-;;; COMPILED-DEBUG-FUN-ARGUMENTS for Fun. If fun is the
-;;; MAIN-ENTRY for an optional dispatch, then look at the ARGLIST to
-;;; determine the syntax, otherwise pretend all arguments are fixed.
+;;; Return a vector to be used as the COMPILED-DEBUG-FUN-ARGS for FUN.
+;;; If FUN is the MAIN-ENTRY for an optional dispatch, then look at
+;;; the ARGLIST to determine the syntax, otherwise pretend all
+;;; arguments are fixed.
 ;;;
 ;;; ### This assumption breaks down in EPs other than the main-entry,
 ;;; since they may or may not have supplied-p vars, etc.
-(defun compute-arguments (fun var-locs)
+(defun compute-args (fun var-locs)
   (declare (type clambda fun) (type hash-table var-locs))
   (collect ((res))
     (let ((od (lambda-optional-dispatch fun)))
@@ -505,7 +516,7 @@
           (setf (compiled-debug-fun-vars dfun)
                 (compute-vars fun level var-locs))
           (setf (compiled-debug-fun-arguments dfun)
-                (compute-arguments fun var-locs))))
+                (compute-args fun var-locs))))
 
     (when (>= level 2)
       (multiple-value-bind (blocks tlf-num) (compute-debug-blocks fun var-locs)