diff --git a/build/build.tcl b/build/build.tcl index a1aeb3d6..0df98358 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -723,6 +723,14 @@ expect ":KILL" respond "*" ":midas inquir;inqupd bin_inquir;inqupd\r" expect ":KILL" +# od +respond "*" "complr\013" +respond "_" "liblsp;_libdoc; od\r" +respond "_" "\032" +type ":kill\r" +respond "*" ":lisp libdoc;od (dump)\r" +expect ":KILL" + respond "*" ":link inquir;lsrtns 1,syseng;lsrtns >\r" respond "*" ":midas inquir;ts lookup_inquir;lookup\r" diff --git a/src/libdoc/od.(dump) b/src/libdoc/od.(dump) new file mode 100644 index 00000000..19582260 --- /dev/null +++ b/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)) diff --git a/src/libdoc/od.2 b/src/libdoc/od.2 new file mode 100644 index 00000000..5461d9ed --- /dev/null +++ b/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))))