mirror of
https://github.com/PDP-10/its.git
synced 2026-01-22 10:32:13 +00:00
79 lines
2.1 KiB
Common Lisp
Executable File
79 lines
2.1 KiB
Common Lisp
Executable File
;;;-*-LISP-*-
|
||
|
||
|
||
(HERALD BREAKLEVEL)
|
||
|
||
;;; You must do (SSTATUS BREAKLEVEL '(BREAKLEVEL))
|
||
|
||
;;; Break level with extra features, sufficiently general for
|
||
;;; binding TTY echoing on, binding readtables, creating new read buffers,
|
||
;;; and handling other environment and re-entrancy considerations.
|
||
;;; 9:15pm Friday, 20 February 1981 -GJC
|
||
|
||
(DEFVAR BREAK-VARS '(TTYON - + *)
|
||
"Variables to bind inside the breaklevel")
|
||
|
||
(DEFVAR BREAK-VALS '(NIL NIL * * *)
|
||
"Cooresponding values for above variables, this should be a
|
||
list of functions to call to get the the values, however,
|
||
the UNWIND-PROTECTed BREAK-PROCS provide the full functionality
|
||
of that and more.")
|
||
|
||
(DEFVAR BREAK-PROCS '(TTYON)
|
||
"List of procedures called with argument T for ENTER, NIL for EXIT.
|
||
Do not RPLAC* this list.")
|
||
|
||
|
||
(defun BREAKLEVEL ()
|
||
(PROGV BREAK-VARS BREAK-VALS
|
||
(LET ((HOWFAR 0)
|
||
(P BREAK-PROCS))
|
||
(UNWIND-PROTECT
|
||
(DO ((L P (CDR L)))
|
||
((NULL L)
|
||
(do ()(NIL)
|
||
(SETQ + -)
|
||
(SETQ - (*-read-eval-print))
|
||
(COND ((EQ - 'P)
|
||
(*THROW 'BREAK NIL))
|
||
((AND (NOT (ATOM -))
|
||
(EQ (CAR -) 'RETURN))
|
||
(*THROW 'BREAK (EVAL (CADR -))))
|
||
(T
|
||
(setq * (read-*-eval-print -))
|
||
(read-eval-*-print *)
|
||
(read-eval-print-*)))))
|
||
(FUNCALL (CAR L) T)
|
||
(SETQ HOWFAR (1+ HOWFAR)))
|
||
(DO ((L P (CDR L)))
|
||
((OR (NULL L)
|
||
(ZEROP HOWFAR)))
|
||
(SETQ HOWFAR (1- HOWFAR))
|
||
(FUNCALL (CAR L) NIL))))))
|
||
|
||
|
||
(DEFVAR TTYON NIL)
|
||
|
||
(DEFUN TTYON (ENTERP)
|
||
(COND (ENTERP
|
||
(COND ((STATUS FEATURE ITS)
|
||
(SETQ TTYON (SYSCALL 3. 'TTYGET TYI))
|
||
(SYSCALL 0 'TTYSET TYI
|
||
(LOGIOR (CAR TTYON) #o202020202020)
|
||
(LOGIOR (CADR TTYON) #o202020200020)))
|
||
((STATUS FEATURE TOPS-20)
|
||
(SETQ TTYON (STATUS TTY))
|
||
(SSTATUS TTY
|
||
(CAR TTYON)
|
||
(CADR TTYON)
|
||
(DPB 0. #o1301 (CADDR TTYON))))))
|
||
(T
|
||
(COND ((STATUS FEATURE ITS)
|
||
(SYSCALL 0. 'TTYSET TYI
|
||
(CAR TTYON)
|
||
(CADR TTYON)))
|
||
((STATUS FEATURE TOPS-20)
|
||
(SSTATUS TTY
|
||
(CAR TTYON)
|
||
(CADR TTYON)
|
||
(CADDR TTYON))))))) |