Changeset 8444

Timestamp:

Feb 8, 2008, 2:22:24 AM (17 years ago)

Author:

marco baringer

Message:

More source location optimizations (and one bug fix)

Moved the binding of *definition-source-note* to compile-named-function. This ensures that when emitting source notes
the current value *definition-source-note* is the same one for the code we're compiling (it was not before). This
change also almost halves the number of times we call x862-generate-pc-mapping since we no longer call it for
note-function-info forms generated by defuns.

Merged the helper functions directly into x862-generate-pc-source-map.

Removed the unused generic functions source-note-text and (setf source-note-text).

There is still a bug in substream, or somewhere, where we're getting garbage (#\^{Z chars) in our text streams, made
%fast-compress ignore these chars.}

Location:

branches/working-0711/ccl

Files:

• compiler/X86/x862.lisp (modified) (3 diffs)
• compiler/nx.lisp (modified) (1 diff)
• compiler/nx0.lisp (modified) (4 diffs)
• level-1/l1-reader.lisp (modified) (2 diffs)
• lib/nfcomp.lisp (modified) (3 diffs)

branches/working-0711/ccl/compiler/X86/x862.lisp

@@ -610 +610 @@
                                         (list 'function-debugging-info lambda-form))
                                       (when (and *compiler-record-source* *definition-source-note*)
-                                        (list 'function-source-note
+                                        (list 'function-source-note  
                                               (source-note-for-%lfun-info *definition-source-note* :form nil :children nil)))
                                       (when *x862-recorded-symbols*
@@ -617 +617 @@
                                                  *x862-emitted-source-notes*
                                                  *definition-source-note*)
-                                        (list 'pc-source-map
+                                        (list 'pc-source-map 
                                               (x862-generate-pc-source-map *definition-source-note* *x862-emitted-source-notes*)))))
                          (setf bits (logior (ash 1 $lfbits-info-bit) bits)))
@@ -681 +681 @@
     (vector (aref source-mapping 3))))
 
-(defun small-positive-integer-p (number &optional (biggest-small-value (ash 1 15)))
-  (< 0 number biggest-small-value))
-
-(defun generate-pc-source-mapping (pc-start pc-end text-start text-end)
-  (cond
-    ((every #'small-positive-integer-p (list pc-start pc-end text-start text-end))
-      (let ((mapping 0))
-        (setf (ldb (byte 15 0) mapping)  pc-start
-              (ldb (byte 15 15) mapping) pc-end
-              (ldb (byte 15 30) mapping) text-start
-              (ldb (byte 15 45) mapping) text-end)
-        mapping))
-    ((every #'plusp (list pc-start pc-end text-start text-end))
-     (vector pc-start pc-end text-start text-end))
-    (t nil)))
-
 (defun x862-generate-pc-source-map (definition-source-note emitted-source-notes)
   (when *compiler-record-source*
     (let ((def-start (source-note-start definition-source-note))
-          (vec (make-array (length emitted-source-notes) :fill-pointer 0)))
+          (vec (make-array (length emitted-source-notes))))
       (loop
         for start in emitted-source-notes
-        for mapping = (generate-pc-source-mapping (x862-vinsn-note-label-address
-                                                       start
-                                                       t)
-                                                  (x862-vinsn-note-label-address
-                                                   (vinsn-note-peer start)
-                                                       nil)
-                                                  (- (source-note-start (aref (vinsn-note-info start) 0))
-                                                            def-start)
-                                                  (- (source-note-end (aref (vinsn-note-info start) 0))
-                                                            def-start))
-        when mapping
-          do (vector-push-extend mapping vec))
-      (let ((simple-vec (make-array (length vec))))
-        (map-into simple-vec #'identity vec)
-        simple-vec))))
+        for pc-start = (x862-vinsn-note-label-address start t)
+        for pc-end   = (x862-vinsn-note-label-address (vinsn-note-peer start) nil)
+        for text-start = (- (source-note-start (aref (vinsn-note-info start) 0)) def-start)
+        for text-end = (- (source-note-end (aref (vinsn-note-info start) 0)) def-start)
+        for index upfrom 0
+        for mapping = (cond
+                        ((and (<= 0 pc-start   #x8000)
+                              (<= 0 pc-end     #x8000)
+                              (<= 0 text-start #x8000)
+                              (<= 0 text-end   #x8000))
+                         (let ((mapping 0))
+                           (setf (ldb (byte 15 0) mapping)  pc-start
+                                 (ldb (byte 15 15) mapping) pc-end
+                                 (ldb (byte 15 30) mapping) text-start
+                                 (ldb (byte 15 45) mapping) text-end)
+                           mapping))
+                        ((and (plusp pc-start) (plusp pc-end) (plusp text-start) (plusp text-end))
+                         (vector pc-start pc-end text-start text-end))
+                        (t nil))
+        do (setf (aref vec index) mapping))
+      vec)))
 
 (defun x862-vinsn-note-label-address (note &optional start-p sym)

branches/working-0711/ccl/compiler/nx.lisp

@@ -154 +154 @@
    definition
    (let ((*load-time-eval-token* load-time-eval-token)
-         (env (new-lexical-environment env)))
+         (env (new-lexical-environment env))
+         (*definition-source-note* (and *form-source-note-map* (gethash definition *form-source-note-map*))))
      (setf (lexenv.variables env) 'barrier)
        (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))

branches/working-0711/ccl/compiler/nx0.lisp

@@ -1601 +1601 @@
          do (setf (aref vec index) (char-code char))
       else
-        do (return-from %fast-compact string))
+        do (warn "Can't %fast-compact ~C in ~S." char string)
+        and do (setf (aref vec index) (char-code #\?))) 
     vec))
 
@@ -1624 +1625 @@
   children)
 
-(defun make-source-note (&key stream start end text form children)
+(defun make-source-note (&key stream start end %text form children)
   (when (record-source-location-on-stream-p stream)
     (%make-source-note :file-name (or *compile-file-original-truename*
@@ -1630 +1631 @@
                        :start (+ start (or *compile-file-original-buffer-offset* 0))
                        :end (+ end (or *compile-file-original-buffer-offset* 0))
-                       :%text text
+                       :%text %text
                        :form form
                        :children children)))
-
-(defmethod source-note-text ((source-note source-note))
-  (%fast-uncompact (source-note-%text source-note)))
-
-(defmethod (setf source-note-text) (text (source-note source-note))
-  (setf (source-note-%text source-note) (%fast-compact text)))
 
 ;;; we don't actually store source-note structs in the fasl since that runs into problems dumping
@@ -1675 +1670 @@
     map))
 
-(defun compute-children-text (source-note stream)
-  (unless (source-note-%text source-note)
-    (setf (source-note-%text source-note)
-          (substream stream (source-note-start source-note) (source-note-end source-note))))
-  (dolist (nested (source-note-children source-note))
-    (when nested
-      (unless (source-note-%text nested)
-        (setf (source-note-%text nested)
-              (make-array (- (source-note-end nested) (source-note-start nested))
-                          :displaced-to (source-note-%text source-note)
-                          :displaced-index-offset (- (source-note-start nested)
-                                                     (source-note-start source-note)))))
-      (compute-children-text nested nil)))
+(defun compute-children-text (source-note stream source-note-map)
+  (when source-note
+    (unless (source-note-%text source-note)
+      (setf (source-note-%text source-note)
+            (substream stream (source-note-start source-note) (source-note-end source-note))))
+    (dolist (nested (source-note-children source-note))
+      (when nested
+        (unless (source-note-%text nested)
+          (setf (source-note-%text nested)
+                (make-array (- (source-note-end nested) (source-note-start nested))
+                            :displaced-to (source-note-%text source-note)
+                            :displaced-index-offset (- (source-note-start nested)
+                                                       (source-note-start source-note)))))
+        (setf (gethash (source-note-form nested) source-note-map) nested)
+        (compute-children-text nested nil source-note-map))))
   source-note)
 

branches/working-0711/ccl/level-1/l1-reader.lisp

@@ -2507 +2507 @@
                                  (record-source-location-on-stream-p stream))
                         ;; mb 2008-02-07: sometime the nested-source-notes end with t, don't know
-                        ;; why. don't really care here.                        
+                        ;; why. don't really care here.
                         (make-source-note :stream stream
                                           :start (1- start)
@@ -2516 +2516 @@
                                                         (when (atom (cdr last))
                                                           ;; dotted list.
-                                                          (setf (cdr last) (list (cdr last)))))
+                                                          (setf (cdr last) (list (cdr last))))
+                                                        nested-source-notes)
                                                       '()))))))))))
 

branches/working-0711/ccl/lib/nfcomp.lisp

@@ -407 +407 @@
         (loop
           (let* ((*fcomp-stream-position* (file-position *fcomp-stream*))
-                 (*definition-source-note* *definition-source-note*)
                  form)
             (unless (eq read-package *package*)
@@ -425 +424 @@
                       (return))
                     (setf form -form
-                          *definition-source-note* (compute-children-text source-note *fcomp-stream*)
-                          *form-source-note-map* (make-source-note-form-map *definition-source-note*
-                                                                            *form-source-note-map*))))))
+                          *form-source-note-map* (make-source-note-form-map
+                                                  (compute-children-text source-note *fcomp-stream* (make-hash-table :test 'eq))))))))            
             (fcomp-form form env processing-mode)
             (setq *fcomp-previous-position* *fcomp-stream-position*))))
@@ -530 +528 @@
             ((%defparameter) (fcomp-load-%defparameter form env))
             ((%defvar %defvar-init) (fcomp-load-defvar form env))
-            ((%defun)
-               (let ((*definition-source-note* (gethash form *form-source-note-map*)))
-                 (fcomp-load-%defun form env)))
+            ((%defun) (fcomp-load-%defun form env))
             ((set-package %define-package)
              (fcomp-random-toplevel-form form env)