X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdebug-var-io.lisp;h=2d489d24e8dff81f6f7678044169c794e59730ab;hb=a6a12ed609d5467ec43b411283e5b3568fee81df;hp=6a61e26b23a9338e8916bee29be1941f5897aae3;hpb=0b3ec4b1d978b887db175b7b3bada8e727683e15;p=sbcl.git diff --git a/src/code/debug-var-io.lisp b/src/code/debug-var-io.lisp index 6a61e26..2d489d2 100644 --- a/src/code/debug-var-io.lisp +++ b/src/code/debug-var-io.lisp @@ -29,35 +29,35 @@ (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)))))) + (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)))))) ;;; 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 +70,10 @@ (once-only ((len `(read-var-integer ,vec ,index))) (once-only ((res `(make-string ,len))) `(progn - (%primitive 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 +83,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 +94,6 @@ (once-only ((n-bytes bytes)) (once-only ((n-res `(make-array (* ,n-bytes 8) :element-type 'bit))) `(progn - (%primitive 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))))