;;;-*-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)))))))