OD - print binary file in human-readable formats.

src/libdoc/od.(dump)

@@ -0,0 +1,11 @@
+(comment)
+(progn
+  (close (prog1 infile (inpush -1)))
+  (load "liblsp; od fasl")
+  (sstatus toplevel '(toplevel))
+  (sstatus feature noldmsg)
+  (gctwa)
+  (gc)
+  (sstatus flush t)
+  (suspend ":KILL " (list '(dsk sys3) 'ts 'od))
+  (toplevel))

src/libdoc/od.2

@@ -0,0 +1,79 @@
+(comment)
+
+(eval-when (eval load compile)
+  (load '((liblsp) lispm fasl)))
+
+(defun print-octal (word)
+  (format t "~6,'0O" (load-byte (quotient word 1000000) 0 18.))
+  (format t "~6,'0O  " (load-byte (remainder word 1000000) 0 18.)))
+
+(defun print-half (word)
+  (let ((half (quotient word 1000000)))
+    (format t "~7O,," half)
+    (setq half (load-byte (remainder word 1000000) 0 18.))
+    (if (not (zerop (logand half 400000)))
+       (setq half (+ half -1000000)))
+    (format t "~7<~O~;~>  "half)))
+;    (format t "~7O  "half)))
+
+(defvar squoze-chars
+  '(" " "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
+    "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K"
+    "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V"
+    "W" "X" "Y" "Z" "." "$" "%"))
+
+(defun print-squoze (word)
+  (let ((result nil))
+    (setq word (load-byte word 0 32.))
+    (loop for i from 0 below 6 do
+	  (let ((ch (abs (remainder word 40.))))
+	    (setq ch (nth ch squoze-chars))
+	    (push ch result)
+	    (setq word (quotient word 40.))))
+    (dolist (x result)
+      (format t "~A" x))
+    (format t "  ")))
+
+(defun print-sixbit (word)
+  (let ((result nil))
+    (loop for i from 0 below 6 do
+	  (let ((ch (abs (remainder word 64.))))
+	    (push (+ ch 32.) result)
+	    (setq word (quotient word 64.))))
+    (format t "~A  " (implode result))))
+
+(defun print-ascii (word)
+  (setq word (quotient word 2))
+  (let ((result nil))
+    (loop for i from 0 below 5 do
+	  (let ((ch (abs (remainder word 128.))))
+	    (if (< ch 32.)
+	      (setq ch "."))
+	    (push ch result)
+	    (setq word (quotient word 128))))
+    (format t "~A  " (implode result))))
+
+(defun read-word (input)
+  (let ((word (in input)))
+    (format t "~&")
+    (print-octal word)
+    (print-half word)
+    (print-squoze word)
+    (print-sixbit word)
+    (print-ascii word)
+    (terpri)
+    word))
+
+(defun goodbye (x)
+  (format t "END OF FILE~%")
+  (quit))
+
+(defun print-binary (file)
+  (with-open-file (input file '(single fixnum in))
+    (eoffn input #'goodbye)
+    (format t "~&~12A  SQUOZE  SIXBIT  ASCII~%" "OCTAL")
+    (loop while t do 
+	  (read-word input))))
+
+(defun toplevel ()
+  (print-binary (implode (status jcl))))