;; -*- Mode:LISP; Package:LAMBDA; Base:8; Readtable:ZL -*- ;;; ;;; (c) Copyright 1984,1985,1986 - Lisp Machine, Inc. ;;; ;;this file contains the code for handling serial communications to an sdu, causing ;;it to perform bus cycles and special diagnostic functions on a remote nubus (defflavor basic-bus-communication () ()) (defflavor nu-debug-bus-communication () (basic-bus-communication) :settable-instance-variables) (defmethod (nu-debug-bus-communication :bus-write) (address data &optional ignore-bus-errors &aux code) (ferror nil "got here") (set-nd-address-mode-low) (nd-write 1 (low-16-bits data)) (nd-write 2 (high-16-bits data)) (set-nd-address-mode-high) (nd-write 2 (low-16-bits address)) (nd-write 3 (high-16-bits address)) (nd-write 1 0) ;start nubus write (cond ((and check-for-nubus-timeouts (not ignore-bus-errors)) (dotimes (i 3.)) ;delay until transfer is sure to be over (if (not (= 3 (setq code (ldb 1002 (nd-read 0))))) (ferror nil "bus timeout") ;(print-nubus-timeout-information code address t) )))) (defmethod (nu-debug-bus-communication :bus-read) (address &optional ignore-bus-errors &aux code) (ferror nil "got here") (set-nd-address-mode-high) (nd-write 2 (low-16-bits address)) (nd-write 3 (high-16-bits address)) (nd-read 1) ;start nubus read (dotimes (i 3.)) ;delay until transfer is sure to be over ;dotimes compiles to code that ;takes 7 "units" according to the ;manual. Each unit is about 2 microsecs. ;We need to dealy for the maximum time, ;or 256 * 100ns = 25 microsecs. Call ;that 3 times around the loop. This ;should be much better than the 100. ;that was there before. (and check-for-nubus-timeouts (not ignore-bus-errors) (not (= 3 (setq code (ldb 1002 (nd-read 0))))) (ferror nil "bus timeout") ;(print-nubus-timeout-information code address t) ) (dpb (nd-read 3) 2020 (nd-read 2))) (defconst nu-debug-bus-communication-instance (make-instance 'nu-debug-bus-communication)) (defflavor serial-bus-communication (serial-stream baud serial-trace serial-last-direction unrchf) (basic-bus-communication) :settable-instance-variables :inittable-instance-variables (:default-init-plist :baud 9600.)) (DEFMETHOD (SERIAL-BUS-COMMUNICATION :RESET) (&optional amount) (FUNCALL SERIAL-STREAM ':RESET) (FUNCALL SERIAL-STREAM ':CLEAR-INPUT) (SELECT SI:PROCESSOR-TYPE-CODE (SI:LAMBDA-TYPE-CODE (SEND SERIAL-STREAM ':SET-BAUD-RATE BAUD)) (SI:CADR-TYPE-CODE (FUNCALL SERIAL-STREAM ':PUT ':BAUD BAUD))) (cond ((not (eq amount ':serial-line-only)) (FUNCALL-SELF ':SET-TRACE NIL))) ) (defmethod (serial-bus-communication :listen) () (funcall serial-stream ':listen)) (defmethod (serial-bus-communication :set-up) () (if (or (not (variable-boundp serial-stream)) (null serial-stream)) (setq serial-stream (SELECT SI:PROCESSOR-TYPE-CODE (SI:LAMBDA-TYPE-CODE (OPEN "SDU-SERIAL-B:")) (SI:CADR-TYPE-CODE (si:make-serial-stream ':ascii-characters nil ':baud baud ':ascii-characters t ':number-of-data-bits 7. ':input-buffer-size 20000.))))) (FUNCALL-SELF ':SET-TRACE NIL)) (defmethod (serial-bus-communication :close) (&rest ignore) (if (and (variable-boundp serial-stream) serial-stream) (funcall serial-stream ':close)) (setq serial-stream nil)) (DEFMETHOD (SERIAL-BUS-COMMUNICATION :SET-TRACE) (ON-P) (COND ((AND (VARIABLE-BOUNDP SERIAL-TRACE) SERIAL-TRACE (NOT (SYMBOLP SERIAL-TRACE))) (FUNCALL-SELF ':TYO-CR #\SPACE) ;assure file ends in output direction. (FUNCALL SERIAL-TRACE ':CLOSE))) (SETQ SERIAL-TRACE ON-P) (SETQ SERIAL-LAST-DIRECTION 'OUTPUT UNRCHF NIL)) (DEFMETHOD (SERIAL-BUS-COMMUNICATION :SET-BAUD) (NEW-BAUD) (LET ((NUM-BAUD (FIND-POSITION-IN-LIST NEW-BAUD '(50. 75. 110. 134. 150. 300. 600. 1200. 1800. 2000. 2400. 3600. 4800. 7200. 9600. 19200.)))) (COND ((AND (VARIABLE-BOUNDP SERIAL-STREAM) SERIAL-STREAM) ; (FORMAT SELF "~OA" NUM-BAUD) (SELECT SI:PROCESSOR-TYPE-CODE (SI:LAMBDA-TYPE-CODE (SEND SERIAL-STREAM ':SET-BAUD-RATE NEW-BAUD)) (SI:CADR-TYPE-CODE (FUNCALL SERIAL-STREAM ':PUT ':BAUD NEW-BAUD))))) (SETQ BAUD NEW-BAUD))) (DEFMETHOD (SERIAL-BUS-COMMUNICATION :TYO) (CHAR) (COND (SERIAL-TRACE (COND ((NOT (EQ SERIAL-LAST-DIRECTION 'OUTPUT)) (SETQ SERIAL-LAST-DIRECTION 'OUTPUT) (COND ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':STRING-OUT " OUTPUT ")) (T (FUNCALL SERIAL-TRACE ':TYO #/s) (funcall serial-trace ':tyo 40))))) (COND ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':TYO CHAR)) (T (FUNCALL SERIAL-TRACE ':TYO CHAR))))) (cond ((= char #\return) (setq char 15))) ;avoid getting both cr and lf (FUNCALL SERIAL-STREAM ':TYO CHAR) (comment (cond ((< char 200) (do ((ch) (waited-p)) (()) (setq ch (funcall serial-stream ':tyi-no-hang)) (cond ((null ch) (cond (waited-p (return nil)) (t (process-sleep 15.) (setq waited-p t)))) ((= ch char) (return t)))))) ;attempt to ignore echo ) ) (defmethod (serial-bus-communication :tyo-cr) (char) (funcall-self ':tyo char) (funcall-self ':tyo #\cr)) (DEFMETHOD (SERIAL-BUS-COMMUNICATION :TYI) (&OPTIONAL IGNORE) (cond (unrchf (prog1 unrchf (setq unrchf nil))) (t (COND (SERIAL-TRACE (COND ((NOT (EQ SERIAL-LAST-DIRECTION 'INPUT)) (SETQ SERIAL-LAST-DIRECTION 'INPUT) (COND ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':STRING-OUT " INPUT ")) (T (FUNCALL SERIAL-TRACE ':TYO #/S) (funcall serial-trace ':tyo 40))))))) (DO ((CHAR (FUNCALL SERIAL-STREAM ':TYI) (FUNCALL SERIAL-STREAM ':TYI))) (NIL) ; (OR (ODDP (CHARACTER-PARITY CHAR)) ; (FERROR NIL "BAD PARITY RECEIVED - ~O" CHAR)) (SETQ CHAR (LOGAND CHAR 177)) (COND ((= CHAR 12) (SETQ CHAR 40))) ;read doesnt like line feeds. (cond ((and (> char 41) (not (and (>= char #/0) (<= char #/9)))) (format terminal-io "~%Received non-numeric reply from SDU, entering SDU-CONSOLE mode~%") (funcall serial-stream ':untyi char) (sdu-console) (format terminal-io "~%entering LAM top level") (signal 'lam-restart-from-top :format-string "returning from sdu-console after error"))) (COND ((= CHAR 15)) ;will be ignored. ((NULL SERIAL-TRACE)) ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':TYO CHAR)) (T (FUNCALL SERIAL-TRACE ':TYO CHAR))) (SELECTQ CHAR (7 (FERROR NIL "ERRONEOUS COMMAND RECEIVED BY DEBUGGER")) (10 (FUNCALL SERIAL-STREAM ':TYO 33) (FERROR NIL "DEBUGGER GOT PARITY ERROR, RESETTING DEBUGGER")) ; (12 (return 40)) ;READ doesnt like line feeds (15) (T (RETURN CHAR))))))) (defmethod (serial-bus-communication :untyi) (ch) (setq unrchf ch)) (comment (DEFMETHOD (SERIAL-BUS-COMMUNICATION :STRING-OUT) (STRING &OPTIONAL (START 0) end) (OR END (SETQ END (ARRAY-ACTIVE-LENGTH STRING))) (COND (SERIAL-TRACE (COND ((NOT (EQ SERIAL-LAST-DIRECTION 'OUTPUT)) (SETQ SERIAL-LAST-DIRECTION 'OUTPUT) (COND ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':STRING-OUT " OUTPUT ")) (T (FUNCALL SERIAL-TRACE ':TYO #/s) (funcall serial-trace ':tyo 40))))) (COND ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':STRING-OUT STRING START END)) (T (FUNCALL SERIAL-TRACE ':STRING-OUT STRING START END))))) (FUNCALL SERIAL-STREAM ':STRING-OUT STRING START END)) ) ;temporarily turn everything into :TYOs so cr's can be hacked. Probably not any slower anyway (DEFMETHOD (SERIAL-BUS-COMMUNICATION :STRING-OUT) (STRING &OPTIONAL (START 0) end) (OR END (SETQ END (ARRAY-ACTIVE-LENGTH STRING))) (do ((idx start (1+ idx))) ((>= idx end)) (funcall-self ':tyo (aref string idx)))) (DEFMETHOD (SERIAL-BUS-COMMUNICATION :PRIN1) (NUM) (COND (SERIAL-TRACE (COND ((NOT (EQ SERIAL-LAST-DIRECTION 'OUTPUT)) (SETQ SERIAL-LAST-DIRECTION 'OUTPUT) (COND ((EQ SERIAL-TRACE T) (FUNCALL TERMINAL-IO ':STRING-OUT " OUTPUT ")) (T (FUNCALL SERIAL-TRACE ':TYO #/s) (funcall serial-trace ':tyo 40))))) (COND ((EQ SERIAL-TRACE T) (PRIN1 NUM TERMINAL-IO)) (T (PRIN1 NUM SERIAL-TRACE))))) (PRIN1 NUM SERIAL-STREAM)) (defmethod (serial-bus-communication :read-32) (&optional mask) (cond (mask (COND (SERIAL-TRACE (COND ((NOT (EQ SERIAL-LAST-DIRECTION 'INPUT)) (SETQ SERIAL-LAST-DIRECTION 'INPUT) (COND ((EQ SERIAL-TRACE T) (FORMAT TERMINAL-IO " <~S>INPUT " MASK)) (T (PRIN1 MASK SERIAL-TRACE) (FUNCALL SERIAL-TRACE ':TYO #/S) (FUNCALL SERIAL-TRACE ':TYO 40))))))))) (read self)) (defmethod (serial-bus-communication :bus-write) (address data &optional ignore-bus-errors) ignore-bus-errors (error "got to (serial-bus-communication :bus-write)") ;cant win for now due to byte ops. (format serial-stream "wx ~o ~o~%" address data)) (defun write-serial-trace (ch) (ferror nil "can't work") ch (comment (cond ((and serial-trace (not (eq serial-trace t))) (funcall serial-trace ':tyo ch)))) ) (defun simple-control-char-p (ch) (if (and (= 1 (ldb si:%%kbd-control ch)) (= 0 (ldb si:%%kbd-meta ch)) (= 0 (ldb si:%%kbd-super ch)) (= 0 (ldb si:%%kbd-hyper ch))) (- ch 500))) (defmethod (serial-bus-communication :console) (&optional write-trace) (do ((ch)(tch)) (()) (process-wait "tyi or sdu" #'(lambda (term sdu) (or (funcall term ':listen) (funcall sdu ':listen))) terminal-io serial-stream) (cond ((setq ch (funcall serial-stream ':tyi-no-hang)) (if (numberp ch) (setq ch (ldb 0007 ch))) ;; this is enough for a primitive but effective ;; terminal simulator. (selectq ch (#o10 ; back-space (cursorpos 'x terminal-io)) (#o12) ; line-feed (#o11 ; tab (send terminal-io ':tyo #\tab) (and write-trace (write-serial-trace #\tab))) (#o14 (send terminal-io ':clear-screen) (and write-trace (write-serial-trace #\form))) (#o7 (send terminal-io ':beep)) (#o15 (send terminal-io ':fresh-line) (and write-trace (write-serial-trace #\return))) (otherwise (send terminal-io ':tyo ch) (and write-trace (write-serial-trace ch)))))) (cond ((setq ch (funcall terminal-io ':tyi-no-hang)) (cond ((setq tch (simple-control-char-p ch)) (funcall serial-stream ':tyo tch)) ('else (selectq ch (#\network (format terminal-io "~&Network>") (selectq (prog1 (tyi terminal-io) (terpri terminal-io)) ((#/? #\help #\h #\H) (format terminal-io "~& send a CONTROL-^~ ~%S Status~ ~%E or Q EXIT.~%")) ((#/s #/S) (SELECT SI:PROCESSOR-TYPE-CODE (SI:LAMBDA-TYPE-CODE (si:sdu-serial-status)) (SI:CADR-TYPE-CODE (si:serial-status)))) (#\network (send serial-stream ':tyo (simple-control-char-p #\control-^))) ((#\e #\E #\q #\Q) (return nil)) (t (send terminal-io ':beep)))) (#\altmode (send serial-stream ':tyo #o33)) (#\return (funcall serial-stream ':tyo 15)) (#\line (funcall serial-stream ':tyo 12)) ((#\rubout #\delete) (send serial-stream ':tyo #o177)) (#\OVERSTRIKE (FUNCALL SERIAL-STREAM ':tyo #o10)) (t (funcall serial-stream ':tyo (logand #o177 ch)))))))))) (defmethod (serial-bus-communication :bus-read) (address &optional ignore-bus-errors) ignore-bus-errors (error "got to (serial-bus-communcation :bus-read)") (format serial-stream "rx ~o~%" address) (read serial-stream)) (defconst serial-bus-communication-instance (make-instance 'serial-bus-communication)) (defun serial-on (&OPTIONAL NEW-BAUD) (let ((i serial-bus-communication-instance)) (send i ':set-up) (send i ':reset) (IF NEW-BAUD (SEND I ':SET-BAUD NEW-BAUD)) (send i ':set-up) (send i ':reset) (setq *bus-communication-instance* i))) (defun serial-off (&optional and-close) (if and-close (send *proc* ':close)) (setq *bus-communication-instance* nil)) (DEFUN SERIAL-TRACE (&OPTIONAL T-NIL-OR-FILE) (IF (OR (STRINGP T-NIL-OR-FILE) (AND (TYPEP T-NIL-OR-FILE ':INSTANCE) (TYPEP T-NIL-OR-FILE 'FS:PATHNAME))) (SETQ T-NIL-OR-FILE (OPEN T-NIL-OR-FILE ':DIRECTION ':OUTPUT ':CHARACTERS T))) (SEND SERIAL-BUS-COMMUNICATION-INSTANCE ':SET-TRACE T-NIL-OR-FILE)) (defun serial-set-speed (baud) (funcall serial-bus-communication-instance ':set-baud baud)) (DEFUN SDU-CONSOLE (&optional write-trace) (FUNCALL SERIAL-BUS-COMMUNICATION-INSTANCE ':CONSOLE write-trace))