[yalo commit] r116 - trunk/cc

[codesite...@google.com]

Author: yujian.zhang
Date: Tue Feb 10 06:50:15 2009
New Revision: 116

Modified:
trunk/cc/lap.lisp
trunk/cc/util.lisp

Log:
Add pp-hex, pp-asm, and pp-image.

Modified: trunk/cc/lap.lisp
==============================================================================
--- trunk/cc/lap.lisp (original)
+++ trunk/cc/lap.lisp Tue Feb 10 06:50:15 2009
@@ -71,6 +71,10 @@
(t (error "asm: wrong byte for final processing: ~A"
c))))
code)))

+(defun pp-asm (listing)
+ "Processing the list with asm, and pretty print the bytes with pp-hex."
+ (pp-hex (asm listing)))
+
(defun arith-syntax (mnemonic)
"Return syntax table for arithmetic operations: add, and, cmp, or,
sub, and xor."
@@ -259,6 +263,10 @@
(loop for byte = (read-byte s nil)
while byte do (push byte output))
(nreverse output)))))
+
+(defun pp-image (filename)
+ "Pretty print the image file."
+ (pp-hex (read-image filename)))

(defparameter *prefix-mapping*
`((lock . #xf0)

Modified: trunk/cc/util.lisp
==============================================================================
--- trunk/cc/util.lisp (original)
+++ trunk/cc/util.lisp Tue Feb 10 06:50:15 2009
@@ -56,3 +56,31 @@
"Return the cdr of the result of assoc."
(cdr (apply #'assoc args)))

+(defun segment (list n)
+ "Segment list with each sublist containing n elements."
+ (cond
+ ((null list) nil)
+ ((<= (length list) n) (list list))
+ (t (append (list (subseq list 0 n)) (segment (nthcdr n list) n)))))
+
+(defun printable? (c)
+ "Returns T if char (as integer) is printable."
+ (<= 32 c 126)) ; Seems that graphic-char-p allows more chars as
printable.
+
+(defun pp-char (c)
+ "Returns the character form of c if printable; otherwise ."
+ (if (printable? c) (code-char c) #\.))
+
+(defun pp-hex (s)
+ "Pretty print S (stream of bytes) in hexadecimal manner. Output is
+same as Emacs hexl-mode."
+ (format
+ t "87654321 0011 2233 4455 6677 8899 aabb ccdd eeff
0123456789abcdef~%")
+ (let ((ss (segment s 16)))
+ (loop for i from 0 below (length ss)
+ do (format t "~8,'0X: ~{~{~2,'0X~} ~}~51T~{~c~}~%"
+ (* i 16) (segment (nth i ss) 2)
+ (mapcar #'pp-char (nth i ss))))))
+
+
+