Changeset 11385

Timestamp:

Nov 17, 2008, 1:25:42 PM (12 years ago)

Author:

gz

Message:

Different fix for problem addressed by r11378

Location:

trunk/source

Files:

• compiler/X86/x86-disassemble.lisp (modified) (1 diff)
• level-1/l1-reader.lisp (modified) (2 diffs)

trunk/source/compiler/X86/x86-disassemble.lisp

@@ -2730 +2730 @@
          (pc (- addr entry)))
     (let ((source-note (find-source-note-at-pc function pc)))
-      (when source-note
-        (unless (eql (source-note-file-range source-note)
-                     (source-note-file-range *previous-source-note*))
-          (setf *previous-source-note* source-note)
-          (let* ((source-text (source-note-text source-note))
-                 (text (if source-text
-                         (string-sans-most-whitespace source-text 100)
-                         "#<no source text>")))
-            (format t "~&~%;;; ~A" text)))))
+      (unless (eql (source-note-file-range source-note)
+                   (source-note-file-range *previous-source-note*))
+        (setf *previous-source-note* source-note)
+        (let* ((source-text (source-note-text source-note))
+               (text (if source-text
+                       (string-sans-most-whitespace source-text 100)
+                       "#<no source text>")))
+          (format t "~&~%;;; ~A" text))))
     (when (x86-di-labeled instruction)
       (format t "~&L~d~%" pc)

trunk/source/level-1/l1-reader.lisp

@@ -3055 +3055 @@
 
 (defun source-note-text (source-note &optional start end)
-  (let* ((source (source-note-source source-note))
-         (start-pos (source-note-start-pos source-note))
-         (end-pos (source-note-end-pos source-note))
-         (start (or start start-pos))
-         (end (or end end-pos)))
-    (etypecase source
-      (source-note
+  (when source-note
+    (let* ((source (source-note-source source-note))
+           (start-pos (source-note-start-pos source-note))
+           (end-pos (source-note-end-pos source-note))
+           (start (or start start-pos))
+           (end (or end end-pos)))
+      (etypecase source
+        (source-note
          (assert (<= (source-note-start-pos source) start end (source-note-end-pos source)))
          (source-note-text source start end))
-      ((simple-array (unsigned-byte 8) (*))
+        ((simple-array (unsigned-byte 8) (*))
          (decf start start-pos)
          (decf end start-pos)
          (assert (and (<= 0 start end (length source))))
          (decode-string-from-octets source :start start :end end :external-format :utf-8))
-      (null source))))
+        (null source)))))
 
 (defvar *recording-source-streams* ())
@@ -3177 +3178 @@
   "Fetch source text from file if don't have it"
   (setq if-does-not-exist (require-type if-does-not-exist '(member :error nil)))
-  (let ((source (source-note-source source-note))
-        (filename (source-note-filename source-note)))
-    (etypecase source
-      (null
-         (with-open-file (stream filename :if-does-not-exist if-does-not-exist)
-           (when stream
-             (let ((start (source-note-start-pos source-note))
-                   (end (source-note-end-pos source-note))
-                   (len (file-length stream)))
-               (if (<= end len)
-                 (setf (source-note.source source-note)
-                       (fetch-octets-from-stream stream start end))
-                 (when if-does-not-exist
-                   (error 'simple-file-error :pathname filename
-                          :error-type "File ~s changed since source info recorded")))))))
-      (source-note
-         (ensure-source-note-text source))
-      ((simple-array (unsigned-byte 8) (*))
-         source))))
+  (if source-note
+    (let ((source (source-note-source source-note))
+          (filename (source-note-filename source-note)))
+      (etypecase source
+        (null
+         (with-open-file (stream filename :if-does-not-exist if-does-not-exist)
+           (when stream
+             (let ((start (source-note-start-pos source-note))
+                   (end (source-note-end-pos source-note))
+                   (len (file-length stream)))
+               (if (<= end len)
+                   (setf (source-note.source source-note)
+                         (fetch-octets-from-stream stream start end))
+                   (when if-does-not-exist
+                     (error 'simple-file-error :pathname filename
+                            :error-type "File ~s changed since source info recorded")))))))
+        (source-note
+         (ensure-source-note-text source))
+        ((simple-array (unsigned-byte 8) (*))
+         source)))
+    (when if-does-not-exist
+      (error "Missing source note"))))