;;; -*- Mode:Common-Lisp; Package:SYSTEM; Base:10; Patch-file:T -*-


;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987, Texas Instruments Incorporated. All rights reserved.
;;; Copyright (C) 1987 Unisys Corporation
;;; All Rights Reserved

(DEFMETHOD (SERIAL-STREAM-MIXIN :NETWORK-TYPE) () :SERIAL)

(DEFMETHOD (SERIAL-STREAM-MIXIN :TYI-WITH-TIMEOUT) (INTERVAL-IN-60THS)
  (IF (PROCESS-WAIT-WITH-TIMEOUT
	   "Serial Waiting"
	   INTERVAL-IN-60THS
	   (FUNCTION (LAMBDA (STREAM) (SEND STREAM :INPUT-CHARS-AVAILABLE-P)))
	   SELF)
	 (SEND SELF :TYI)))


(defmethod (serial-stream-mixin :SEND-LONG-BREAK) ()
 "Transmits a space condition for 3.5 seconds (long break)."
  (write-z-reg 5
	       (logand #x7F            ; Turn off DTR
		       (logior #x+10 WR5-CONTENTS)))  ;turn on send break
  (sleep 3.5 "Sending Long Break")
  (write-z-reg 5 WR5-CONTENTS)         ;restore register
  )


(defmethod (serial-stream-mixin :SEND-SHORT-BREAK) ()
 "Transmits a space condition for .275 seconds (short break)."
  (write-z-reg 5 (logior #x+10 WR5-CONTENTS))  ;turn on send break
  (sleep .275 "Sending Short Break")
  (write-z-reg 5 WR5-CONTENTS)                 ;restore register
  )

(DEFMETHOD (SERIAL-STREAM-MIXIN :CLOSE) (&OPTIONAL ABORT-P)
  ;; deallocate the serial buffers
  (WHEN (EQUAL SELF *SERIAL-PORT-OWNER*) ;can only close the real owner of the port
    (IF (NOT ABORT-P)
	(SEND SELF :FINISH))
    (WRITE-Z-REG 9   0)  ;clear master interrupt control register
    (WRITE-Z-REG 5   0)  ;DTR, RTS, Tx disable
    (WRITE-Z-REG 9   0)  ;clear master interrupt control register
    (WRITE-Z-REG 5   0)  ;DTR, RTS, Tx disable
    (WRITE-Z-REG 3   0)  ;Rx disable
    (WRITE-Z-REG 15. 0)  ;disable external interrupts
    (WRITE-Z-REG 1   0)  ;disable interrupts
    (DISABLE-SERIAL-EVENT)			;disable SIB serial event posting
    (WHEN *SERIAL-OUTPUT-BUFFER*
      (RETURN-SERIAL-BUFFER *SERIAL-OUTPUT-BUFFER*)
      (SETQ *SERIAL-OUTPUT-BUFFER* NIL))
    (WHEN *SERIAL-INPUT-BUFFER*
      (RETURN-SERIAL-BUFFER *SERIAL-INPUT-BUFFER*)
      (SETQ *SERIAL-INPUT-BUFFER* NIL))
    (CLEAR-RESOURCE 'SERIAL-BUFFER NIL NIL)
    (ARRAY-DPB-OFFSET 0 %%Q-POINTER *SERIAL-PORT* %SERIAL-RECEIVE-BUFFER)
    (ARRAY-DPB-OFFSET 0 %%Q-POINTER *SERIAL-PORT* %SERIAL-TRANSMIT-BUFFER)
    (SETQ CLOSED-P T)
    (SETQ NET:*SERIAL-HOST* NIL)
    (SETQ *SERIAL-PORT-OWNER* NIL)))

;;; The ascii-translating-input-stream-mixin expects the return character to be sent as a <CR><LF> 
;;; combination, a throw back to the TELNET protocol.  Host systems using serial streams
;;; are not required to send <CR><LF>.  Thus the standard input ascii translating can
;;; hang a serial stream by waiting for the <LF> character which never is sent. 
;;;
;;; This is the same wrapper as for the translating stream except that a
;;; modified translating function is called.
(defwrapper (serial-ascii-stream :tyi) (ignore . body)
  `(progn
     .daemon-caller-args.			;prevent compiler warnings
     (tyi-from-serial-stream #'(lambda (&rest .daemon-caller-args.
					      &aux (.daemon-mapping-table.
						     self-mapping-table))
				 .daemon-mapping-table.
				 . ,body))))

;;; Essentially the same function that is called by the ascii-translating-input-stream-mixin.
;;; The ascii CR character is converted without attempting to read a second character
;;; (a ascii LF character) from the network stream.
(defun tyi-from-serial-stream (ascii-stream &aux ch)
  (case (setq ch  (funcall ascii-stream :tyi))
    (8. #.(char-int #\BACKSPACE))
    (9. #.(char-int #\TAB))
    (10. #.(char-int #\LINEFEED))
    (12. #.(char-int #\PAGE))
    (13. #.(char-int #\NEWLINE))
    (127. #.(char-int #\RUBOUT))
    (nil nil)
    (T (char-int CH))))