Changeset 8435

Timestamp:

Feb 7, 2008, 6:41:20 AM (17 years ago)

Author:

marco baringer

Message:

Waste less space in %lfun-info.

Store pc->source mappings as vectors of 4 integers (instead of a plist). If all the characters in the source-text are 8bit
ascii (the really really common case) we store the text as an array of 8 bit integers.

Location:

branches/working-0711/ccl/compiler

Files:

• X86/x86-disassemble.lisp (modified) (1 diff)
• X86/x862.lisp (modified) (1 diff)
• nx0.lisp (modified) (5 diffs)

branches/working-0711/ccl/compiler/X86/x86-disassemble.lisp

@@ -2731 +2731 @@
              (text (if source-info
                        (string-sans-most-whitespace
-                        (subseq (getf source-note :text)
+                        (subseq (%fast-uncompact (getf source-note :%text))
                                 (car (getf source-info :source-text-range))
                                 (cdr (getf source-info :source-text-range)))

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

@@ -661 +661 @@
                 (setf (%svref v i) ref-fun)))))))))
 
+(defun pc-source-map-pc-start (source-mapping)
+  (etypecase source-mapping
+    (integer (ldb (byte 15 0) source-mapping))
+    (vector (aref source-mapping 0))))
+
+(defun pc-source-map-pc-end (source-mapping)
+  (etypecase source-mapping
+    (integer (ldb (byte 15 15) source-mapping))
+    (vector (aref source-mapping 1))))
+
+(defun pc-source-map-text-start (source-mapping)
+  (etypecase source-mapping
+    (integer (ldb (byte 15 30) source-mapping))
+    (vector (aref source-mapping 2))))
+
+(defun pc-source-map-text-end (source-mapping)
+  (etypecase source-mapping
+    (integer (ldb (byte 15 45) source-mapping))
+    (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)
+  (if (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)
+    (vector pc-start pc-end text-start text-end)))
+
+(defstruct (pc-source-mapping (:type vector))
+  pc-start
+  pc-end
+  text-start
+  text-end)
+
 (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)))
-      (mapcar (lambda (start)
-                (list :pc-range (cons (x862-vinsn-note-label-address
-                                       start
-                                       t)
-                                      (x862-vinsn-note-label-address
-                                       (vinsn-note-peer start)
-                                       nil))
-                      :source-text-range (cons (- (source-note-start (aref (vinsn-note-info start) 0))
-                                                  def-start)
-                                               (- (source-note-end (aref (vinsn-note-info start) 0))
-                                                  def-start))))
-              emitted-source-notes))))
+    (let ((def-start (source-note-start definition-source-note))
+          (vec (make-array (length emitted-source-notes))))
+      (flet ((pc-start (note) (aref note ))))
+      (map-into vec
+                (lambda (start)
+                  (make-pc-source-mapping :pc-start (x862-vinsn-note-label-address
+                                                     start
+                                                     t)
+                                          :pc-end (x862-vinsn-note-label-address
+                                                   (vinsn-note-peer start)
+                                                   nil)
+                                          :text-start (- (source-note-start (aref (vinsn-note-info start) 0))
+                                                         def-start)
+                                          :text-end (- (source-note-end (aref (vinsn-note-info start) 0))
+                                                       def-start)))
+                emitted-source-notes)
+      vec)))
 
 (defun x862-vinsn-note-label-address (note &optional start-p sym)

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

@@ -1593 +1593 @@
          string)))))
 
+(defun %fast-compact (string)
+  (let ((vec (make-array (length string) :element-type '(unsigned-byte 8))))
+    (loop
+      for char across string
+      for index upfrom 0
+      if (<= 0 (char-code char) 255)
+         do (setf (aref vec index) (char-code char))
+      else
+        do (return-from %fast-compact string))
+    vec))
+
+(defun %fast-uncompact (data)
+  (if (stringp data)
+    data
+    (let ((string (make-array (length data) :element-type 'character)))
+      (map-into string #'code-char data)
+      string)))
+
 (defun record-source-location-on-stream-p (stream)
   (and *compiler-record-source*
@@ -1602 +1620 @@
   start
   end
-  text
+  %text
   form
   children)
@@ -1612 +1630 @@
                        :start (+ start (or *compile-file-original-buffer-offset* 0))
                        :end (+ end (or *compile-file-original-buffer-offset* 0))
-                       :text (or text (substream stream start end))
+                       :%text (%fast-compact (or text (substream stream start end)))
                        :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
@@ -1622 +1646 @@
   (append (when start (list :start (source-note-start note)))
           (when end   (list :end   (source-note-end   note)))
-          (when text  (list :text  (source-note-text  note)))
+          (when text  (list :%text  (source-note-%text  note)))
           (when form  (list :form  (source-note-form  note)))
           (when children (list :children (source-note-children note)))
@@ -1668 +1692 @@
       (let* ((best-guess nil)
              (best-length nil))
-        (dolist (pc-map pc-source-map)
-          (let ((pc-start (car (getf pc-map :pc-range)))
-                (pc-end (cdr (getf pc-map :pc-range))))
-            (when (<= pc-start pc pc-end)
-              ;; possible match, see if it's the better than best-guess
-              (when (or (null best-guess)
-                        (< (- pc-end pc-start) best-length))
-                (setf best-guess pc-map
-                      best-length (- pc-end pc-start))))))
-        
+        (loop
+          for pc-map across pc-source-map
+          for pc-start = (aref pc-map 0)
+          for pc-end = (aref pc-map 1)
+          do (when (and (<= pc-start pc pc-end)
+                        (or (null best-guess)
+                            (< (- pc-end pc-start) best-length)))
+               (setf best-guess pc-map
+                     best-length (- pc-end pc-start))))
         (when best-guess
-          (list :pc-range (getf best-guess :pc-range)
-                :source-text-range (getf best-guess :source-text-range)
+          (list :pc-range (cons (aref best-guess 0)
+                                (aref best-guess 1))
+                :source-text-range (cons (aref best-guess 2)
+                                         (aref best-guess 3))
                 :file-name (getf function-source-note :file-name)
                 :text (getf function-source-note :text)))))))