X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-var-io.lisp;h=eac1df33029128c0d13a6bb99d272652360ad563;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=087b46c1ebd3e077eabf0c22297eb9b50f697b8f;hpb=9f926721993baa5711eaf00d7c314924f269f3d2;p=sbcl.git

diff --git a/src/code/debug-var-io.lisp b/src/code/debug-var-io.lisp
index 087b46c..eac1df3 100644
--- a/src/code/debug-var-io.lisp
+++ b/src/code/debug-var-io.lisp
@@ -21,43 +21,44 @@
 
 ;;; Given a byte vector VEC and an index variable INDEX, read a
 ;;; variable length integer and advance index.
-;;;
-;;; FIXME: This is called O(20) times. It should be reimplemented
-;;; with much of its logic in a single service function which can
-;;; be called by the macro expansion:
-;;;   `(SETF ,INDEX (%READ-VAR-INTEGER ,VEC ,INDEX)).
+(defun %read-var-integer (vec index)
+  (let ((val (aref vec index)))
+    (cond ((<= val 253)
+           (values val (1+ index)))
+          ((= val 254)
+           (values
+            (logior (aref vec (+ index 1))
+                    (ash (aref vec (+ index 2)) 8))
+            (+ index 3)))
+          (t
+           (values
+            (logior (aref vec (+ index 1))
+                    (ash (aref vec (+ index 2)) 8)
+                    (ash (aref vec (+ index 3)) 16)
+                    (ash (aref vec (+ index 4)) 24))
+            (+ index 5))))))
+
 (defmacro read-var-integer (vec index)
-  (once-only ((val `(aref ,vec ,index)))
-    `(cond ((<= ,val 253)
-	    (incf ,index)
-	    ,val)
-	   ((= ,val 254)
-	    (prog1
-		(logior (aref ,vec (+ ,index 1))
-			(ash (aref ,vec (+ ,index 2)) 8))
-	      (incf ,index 3)))
-	   (t
-	    (prog1
-		(logior (aref ,vec (+ ,index 1))
-			(ash (aref ,vec (+ ,index 2)) 8)
-	      		(ash (aref ,vec (+ ,index 3)) 16)
-	      		(ash (aref ,vec (+ ,index 4)) 24))
-	      (incf ,index 5))))))
+  (once-only ((vec vec))
+    `(multiple-value-bind (value new-index)
+         (%read-var-integer ,vec ,index)
+       (setf ,index new-index)
+       value)))
 
 ;;; Take an adjustable vector VEC with a fill pointer and push the
 ;;; variable length representation of INT on the end.
 (defun write-var-integer (int vec)
   (declare (type (unsigned-byte 32) int))
   (cond ((<= int 253)
-	 (vector-push-extend int vec))
-	(t
-	 (let ((32-p (> int #xFFFF)))
-	   (vector-push-extend (if 32-p 255 254) vec)
-	   (vector-push-extend (ldb (byte 8 0) int) vec)
-	   (vector-push-extend (ldb (byte 8 8) int) vec)
-	   (when 32-p
-	     (vector-push-extend (ldb (byte 8 16) int) vec)
-	     (vector-push-extend (ldb (byte 8 24) int) vec)))))
+         (vector-push-extend int vec))
+        (t
+         (let ((32-p (> int #xFFFF)))
+           (vector-push-extend (if 32-p 255 254) vec)
+           (vector-push-extend (ldb (byte 8 0) int) vec)
+           (vector-push-extend (ldb (byte 8 8) int) vec)
+           (when 32-p
+             (vector-push-extend (ldb (byte 8 16) int) vec)
+             (vector-push-extend (ldb (byte 8 24) int) vec)))))
   (values))
 
 ;;;; packed strings
@@ -70,9 +71,10 @@
   (once-only ((len `(read-var-integer ,vec ,index)))
     (once-only ((res `(make-string ,len)))
       `(progn
-	 (%byte-blt ,vec ,index ,res 0 ,len)
-	 (incf ,index ,len)
-	 ,res))))
+         (loop for i from 0 below ,len
+               do (setf (aref ,res i)
+                        (code-char (read-var-integer ,vec ,index))))
+         ,res))))
 
 ;;; Write STRING into VEC (adjustable, with fill-pointer) represented
 ;;; as the length (in a var-length integer) followed by the codes of
@@ -82,7 +84,7 @@
   (let ((len (length string)))
     (write-var-integer len vec)
     (dotimes (i len)
-      (vector-push-extend (char-code (schar string i)) vec)))
+      (write-var-integer (char-code (schar string i)) vec)))
   (values))
 
 ;;;; packed bit vectors
@@ -93,6 +95,6 @@
   (once-only ((n-bytes bytes))
     (once-only ((n-res `(make-array (* ,n-bytes 8) :element-type 'bit)))
       `(progn
-	 (%byte-blt ,vec ,index ,n-res 0 ,n-bytes)
-	 (incf ,index ,n-bytes)
-	 ,n-res))))
+         (%byte-blt ,vec ,index ,n-res 0 ,n-bytes)
+         (incf ,index ,n-bytes)
+         ,n-res))))