1
0
mirror of https://github.com/PDP-10/its.git synced 2026-01-15 16:07:01 +00:00
2017-02-03 21:06:12 +01:00

86 lines
2.2 KiB
Groff

(comment)
(eval-when (eval load compile)
(load '((liblsp) lispm fasl)))
(defun print-file-offset (x)
(format t "~&~6,'0O: " x))
(defun print-octal (word)
(format t "~12,'0O " word))
(defun print-half (word)
(let ((half (quotient word 1000000)))
(if (not (zerop (logand half 400000)))
(setq half (+ half -1000000)))
(format t "~7O,," half)
(setq half (remainder word 1000000))
(if (not (zerop (logand half 400000)))
(setq half (+ half -1000000)))
(format t "~7<~O~;~> "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 (remainder word (times 65536. 65536.)))
(loop for i from 0 below 6 do
(let ((ch (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 (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 (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)))
(if (minusp word)
(setq word (plus word (times 1000000 1000000))))
(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 ~16A SQUOZE SIXBIT ASCII~%"
"OCTAL" "HALF-WORDS")
(loop for i from 0 while t do
(print-file-offset i)
(read-word input))))
(defun toplevel ()
(print-binary (implode (status jcl))))