LMFL#!C(:HOST "SYS" :BACKUP-DATE 2760031994. :SYSTEM-TYPE :LOGICAL :VERSION 8. :TYPE "LISP" :NAME "SERIAL-PORT" :DIRECTORY ("REL3-SOURCE" "SERIAL") :SOURCE-PATTERN "( :DIRECTORY (\"REL3-SOURCE\") :NAME :WILD :TYPE :WILD :VERSION :NEWEST)" :VERSION-LIMIT 0. :CHARACTERS T :NOT-BACKED-UP T :CREATION-DATE 2758812033. :AUTHOR "REL3" :LENGTH-IN-BYTES 5251. :LENGTH-IN-BLOCKS 6. :BYTE-SIZE 8.)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            ;;; -*- mode:common-lisp; base:10; package:system-internals -*-;;;                           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) 1984,1987 Texas Instruments Incorporated. All rights reserved.;;; Routines to initialize the global serial port definitions.;;; These should eventually be added to the cold initialization list.;;; Uses the special macros array-dpb-offset & array-ldb-offset.;;; The *Serial-Port* structure is used to interface with the RS232 chip found;;; on the SIB.  It is given to the microcode as the device descriptor block for;;; RS232 interrupt handling.  *Serial-Port* contains a number of status bits as well as two;;; data buffers uses for serial IO;  *Serial-Input-BUffer* & *Serial-Output-Buffer*.;;; The virtual address of the first data element of each of these buffers is stored in ;;; the *Serial-Port* structure.  This allows the RS232 microcode to access the buffers.;;; The input & output buffers are allocated when a stream is created & are deallocated;;; when the stream is closed or reset.(DEFVAR *SERIAL-PORT* ()) (DEFVAR *SERIAL-INPUT-BUFFER* ()) (DEFVAR *SERIAL-OUTPUT-BUFFER* ()) ;; Create an area in which to put our static structures.  This is temporary;; fix until device descriptor and data buffer accessors can be changed. ;; This area will actually be used by both serial and parallel stuff.(prog (var1)      (declare (special serial)       (ignore var1))      (UNLESS (AND (VARIABLE-BOUNDP SERIAL) (EQ (AREA-NAME SERIAL) 'SERIAL))       (MAKE-AREA :NAME 'SERIAL :GC :STATIC))) (DEFUN INITIALIZE-SERIAL-INTERRUPT ()  (declare (special *serial-port*))  (SETQ *SERIAL-PORT*(ARRAY-INITIALIZE (MAKE-ARRAY (* (LENGTH SERIAL-DESCRIPTOR-BLOCK) 2) :element-TYPE '(unsigned-byte 16) :AREA 'SERIAL) 0))  (WIRE-ARRAY *SERIAL-PORT*)  ;; store event type in information word & add interrupt  (ARRAY-DPB-OFFSET %SERIAL-EVENT-TYPE %%SERIAL-INFO-EVENT-TYPE *SERIAL-PORT*     %SERIAL-INFORMATION)  (%ADD-INTERRUPT *SERIAL-PORT* %SERIAL-EVENT-LEVEL)) ;; Replace hardcoded slot values with variable references.(DEFUN ENABLE-SERIAL-EVENT ()  (declare (special PROCESSOR-SLOT-NUMBER ))  (%NUBUS-WRITE TV::SIB-SLOT-NUMBER %SIB-SERIAL-EVENT-ADDRESS(DPB PROCESSOR-SLOT-NUMBER %%NUBUS-F-AND-SLOT-BITS     (+ %SLOT-POWER-FAIL-EVENT;power fail event is base interrupt address(* 4 %SERIAL-EVENT-LEVEL))))) ;new event address every 4 bytes(DEFUN DISABLE-SERIAL-EVENT ()  (%NUBUS-WRITE TV::SIB-SLOT-NUMBER %SIB-SERIAL-EVENT-ADDRESS 0))   ;;; miscellaneous serial port status functions;;; these should probably be macros;;; or maybe even methods to a serial port flavor ?(DEFUN SERIAL-PORT-ENABLE-XON-XOFF ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 1 %%SERIAL-INFO-ENABLE-XON-XOFF *SERIAL-PORT* %SERIAL-INFORMATION))  (DEFUN SERIAL-PORT-DISABLE-XON-XOFF ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 0 %%SERIAL-INFO-ENABLE-XON-XOFF *SERIAL-PORT* %SERIAL-INFORMATION)) (DEFUN SERIAL-PORT-XON-XOFF-ENABLE-P ()  (declare (special *serial-port*))  (= 1 (ARRAY-LDB-OFFSET %%SERIAL-INFO-ENABLE-XON-XOFF *SERIAL-PORT* %SERIAL-INFORMATION))) (DEFUN SERIAL-PORT-XOFF ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 1 %%SERIAL-INFO-XOFF-RECEIVED *SERIAL-PORT* %SERIAL-INFORMATION)) (DEFUN SERIAL-PORT-XON ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 0 %%SERIAL-INFO-XOFF-RECEIVED *SERIAL-PORT* %SERIAL-INFORMATION)) (DEFUN SERIAL-PORT-XOFF-RECEIVED-P ()  (declare (special *serial-port*))  (= 1 (ARRAY-LDB-OFFSET %%SERIAL-INFO-XOFF-RECEIVED *SERIAL-PORT* %SERIAL-INFORMATION))) (DEFUN SERIAL-PORT-CLEAR-XOFF-SENT ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 0 %%SERIAL-INFO-XOFF-SENT *SERIAL-PORT* %SERIAL-INFORMATION)) (DEFUN SERIAL-PORT-XOFF-SENT-P ()  (declare (special *serial-port*))  (= 1 (ARRAY-LDB-OFFSET %%SERIAL-INFO-XOFF-SENT *SERIAL-PORT* %SERIAL-INFORMATION))) (DEFUN SERIAL-PORT-SET-EOT ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 1 %%SERIAL-INFO-EOT-RECEIVED *SERIAL-PORT* %SERIAL-INFORMATION)) (DEFUN SERIAL-PORT-CLEAR-EOT ()  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET 0 %%SERIAL-INFO-EOT-RECEIVED *SERIAL-PORT* %SERIAL-INFORMATION)) (DEFUN SERIAL-PORT-EOT-RECEIVED-P ()  (declare (special *serial-port*))  (= 1 (ARRAY-LDB-OFFSET %%SERIAL-INFO-EOT-RECEIVED *SERIAL-PORT* %SERIAL-INFORMATION))) (DEFUN CLEAR-SERIAL-PORT-STATUS-BITS ()  (SERIAL-PORT-XON)  (SERIAL-PORT-CLEAR-XOFF-SENT)  (SERIAL-PORT-CLEAR-EOT)) (DEFUN SERIAL-PORT-SET-RECEIVE-BITS-PER-CHARACTER (BIT-MASK)    "Pass the current bits-per-character mask to the microcode for XON-XOFF processing."  (declare (special *serial-port*))  (ARRAY-DPB-OFFSET BIT-MASK %%SERIAL-INFO-BITS-PER-CHARACTER *SERIAL-PORT* %SERIAL-INFORMATION)) OP)  (LET ((STAT (PARALLEL-STATUS)))    (CASE PROP      (:STATUS STAT)      (:BUSY (IF (= 1 (LDB (BYTE 1 0) STAT))       T       ()))      (:PAPER-OUT (IF (= 1 (LDB (BYTE 1 1) STAT))    T    ()))      (:ONLINE (IF (= 1 (LDB (BYTE 1 2) STAT)) T ()))      (:FAULT (IF (= 0 (LDB (BYTE 1 3) STAT))T()))      (:OUTPUT-BUFFER-SIZE OUTPUT-BUFFER-SIZE)      (:FORCE-OUTPUT FORCE-OUTPUT)      (:OTHERWISE (FERROR () "~S not a valid property name" PROP))))) ;;; Modify parallel port parameters(DEFMETHOD (PARALLEL-STREAM-MIXIN :PUT) (PROP VAL)  (LET ()    (CASE PROP      (:OUTPUT-BUFFER-SIZE (SETQ OUTPUT-BUFFER-SIZE VAL))      (:FORCE-OUTPUT (SETQ FORCE-OUTPUT (IF VAL  T  ())))      (:OTHERWISE (FERROR () "~S not a valid property name" PROP))))) ;;; Parallel output methods(DEFMETHOD (PARALLEL-STREAM-MIXIN :TYO) (CH)  (declare (special *PA