mirror of
https://github.com/PDP-10/its.git
synced 2026-01-28 21:01:16 +00:00
122 lines
3.2 KiB
Common Lisp
122 lines
3.2 KiB
Common Lisp
;-*-LISP-*-
|
|
|
|
(eval-when (EVAL LOAD COMPILE)
|
|
(or (get 'DEFVST 'VERSION)
|
|
(load '((LISP) DEFVST)))
|
|
(or (get 'LFSDEF 'VERSION)
|
|
(load '((RWK) LFSDEF))))
|
|
|
|
(eval-when (eval compile)
|
|
(or (get 'IOTA 'VERSION)
|
|
(load '((LIBLSP) IOTA)))
|
|
(or (get 'UMLMAC 'VERSION)
|
|
(LOAD '((LISP) UMLMAC))))
|
|
|
|
(eval-when (eval load)
|
|
(or (get 'ERMSGC 'VERSION)
|
|
(load '((LIBMAX) ERMSGC))))
|
|
|
|
(defvst FILE-DIRECTORY
|
|
MACHINE
|
|
NAME
|
|
FILES)
|
|
|
|
(defvst FILE-BLOCK
|
|
FN1
|
|
FN2
|
|
RANDOM
|
|
DATE
|
|
RDATE)
|
|
|
|
(defmacro bp (bp)
|
|
(and (symbolp bp) (boundp bp) (setq bp (symeval bp)))
|
|
(if (fixnump bp)
|
|
(lsh bp -24.)
|
|
`(lsh ,bp -24.)))
|
|
|
|
(defmacro temp-array (idx)
|
|
`(arraycall fixnum temp-array ,idx))
|
|
|
|
|
|
(defvar temp-array (*array () 'fixnum 1024.))
|
|
|
|
(defun get-directory (name &optional (machine (STATUS SITE)))
|
|
(iota ((dir (mergef '((* *) |.FILE.| |(DIR)|)
|
|
`((,machine ,name) * *))
|
|
'(IN FIXNUM)))
|
|
(let ((ldir))
|
|
(dotimes (i 1024.)
|
|
(setf (temp-array i) (in dir)))
|
|
(setq ldir (cons-a-file-directory
|
|
NAME (sixbit-to-ascii (temp-array FS-UDNAME))
|
|
MACHINE machine))
|
|
(do ((i (temp-array FS-UDNAMP) (+ i FS-LUNBLK))
|
|
(files))
|
|
((> i 1023.) (setf (file-directory-files ldir)
|
|
(nreverse files)))
|
|
(IF (zerop (logand (lsh (temp-array (+ i FS-UNRNDM)) -18.)
|
|
(lsh FS-UNIGFL -18.)))
|
|
(push (CONS-A-FILE-BLOCK
|
|
FN1 (sixbit-to-ascii (temp-array (+ i fs-unfn1)))
|
|
FN2 (sixbit-to-ascii (temp-array (+ i fs-unfn2)))
|
|
RANDOM (temp-array (+ i fs-unrndm))
|
|
DATE (temp-array (+ i fs-undate))
|
|
RDATE (temp-array (+ i fs-unref)))
|
|
files)))
|
|
ldir)))
|
|
|
|
|
|
(defun date-to-ascii (date)
|
|
(format () "~D//~D//~D"
|
|
(ldb #o2704 date)
|
|
(ldb #o2205 date)
|
|
(ldb #o3307 date)))
|
|
|
|
(defun date-time-to-ascii (date)
|
|
(let* ((hours (// (logand #o777777 date) #.(* 60. 60. 2)))
|
|
(temp (\ (logand #o777777 date) #.(* 60. 60. 2)))
|
|
(minutes (// temp #.(* 60. 2)))
|
|
(temp (\ temp #.(* 60. 2)))
|
|
(seconds (// temp 2.)))
|
|
(format ()
|
|
"~A ~2D:~2,48D:~2,48D"
|
|
(date-to-ascii date)
|
|
hours minutes seconds)))
|
|
|
|
(defvar MFD-INDEX-ALIST () "ALIST of (mfd-index . dir-name)")
|
|
|
|
(defun get-mfd-indexes (&optional (machine (status site)))
|
|
(iota ((mfd `((,machine foo) |M.F.D.| |(FILE)|) '(IN FIXNUM)))
|
|
(dotimes (i 1024.)
|
|
(setf (temp-array i) (in mfd)))
|
|
(do ((i (temp-array fs-mdnamp) (+ i fs-lmnblk)))
|
|
((> i 1023.))
|
|
(declare (fixnum i))
|
|
(if (not (zerop (temp-array i)))
|
|
(progn
|
|
(putprop (sixbit-to-ascii (temp-array i))
|
|
(// (- i 24.) 2)
|
|
'MFD-INDEX)
|
|
(push `(,(// (- i 24.) 2) . ,(sixbit-to-ascii (temp-array i)))
|
|
MFD-INDEX-ALIST))))))
|
|
|
|
|
|
(defmethod* (display file-block-class) (self)
|
|
"Display a file"
|
|
(format T "~&~6A ~6A ~A (~A) (~A)"
|
|
(file-block-fn1 self)
|
|
(file-block-fn2 self)
|
|
(date-time-to-ascii (file-block-date self))
|
|
(date-to-ascii (logand (lsh -1 18.) (file-block-rdate self)))
|
|
(get-name-from-mfd-index (ldb (bp fs-unauth) (file-block-rdate self)))))
|
|
|
|
(defun get-name-from-mfd-index (idx)
|
|
(if (= idx #o777) '|???|
|
|
(cond ((cdr (assoc idx mfd-index-alist)))
|
|
(t '|???|))))
|
|
|
|
(defun display-files (files)
|
|
(cursorpos 'c)
|
|
(mapc #'(lambda (file) (send file 'display)) files)
|
|
())
|