(FILECREATED "29-JUN-83 11:19:27" {PHYLUM}<LISPCORE>SOURCES>RS232.;127 83444  

      changes to:  (FNS RS232MODEMHANGUP)

      previous date: "29-JUN-83 07:08:29" {PHYLUM}<JONL>LISP>RS232.;1)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT RS232COMS)

(RPAQQ RS232COMS ((LOCALVARS . T)
	(COMS (* Generally useful tools.)
	      (FNS ORDINALSUFFIXSTRING)
	      (DECLARE: DONTCOPY (MACROS CANONICAL.TIMERUNITS)
			(P (COND ((BOUNDP (QUOTE BITSPERBYTE)))
				 (T (* These should be in MODARITH or ADDARITH but remember the case 
				       of LOADFROMing on Interlisp-10)
				    (SETQ BITSPERNIBBLE (IQUOTIENT (SETQ BITSPERBYTE 8)
								   2))
				    (SETQ BYTESPERPAGE 512)
				    (CONSTANTS BITSPERBYTE BYTESPERPAGE BITSPERNIBBLE)))))
	      (* Calculate the number of pages represented by an address and a byte offset. Touch all 
		 the pages of a function, to be sure they are swapped in.)
	      (FNS \#PAGES.BASEBYTES \FRESHENUPFN \ONPATHS.CCODE)
	      (CONSTANTS ACTIVE.EM))
	(DECLARE: DONTCOPY (* Following constants come from the terminology in the hardware 
			      description of the INS8250 chip.)
		  (CONSTANTS DATAREG INTERRUPTENABLEREG INTERRUPTIDREG LINECONTROLREG MODEMCONTROLREG 
			     LINESTATUSREG MODEMSTATUSREG LOWDIVISORREG HIDIVISORREG)
		  (* Register addresses, not left-shifted (i.e., as in INS8250 table))
		  (CONSTANTS INTRPT)
		  (* Interrupt bit from chip, as a READPRINTERPORT bit)
		  (* Interrupt Enable Register bits)
		  (CONSTANTS ERBFI ETBEI ELSI EDSSI)
		  (CONSTANTS NoInterrupt LineStatus DataAvailable HoldingRegisterEmpty MODEMstatus)
		  (* Meanings of value from Interrupt ID register.)
		  (CONSTANTS STB PEN EPS SBCB DLAB)
		  (* Line Control Register bits.)
		  (CONSTANTS DR OE PE FE BI THRE TSRE RBOE LBOE)
		  (* Line Status Register bits, but RBOE and LBOE are my own software RingBuffer and 
		     LineBuffer full indicators.)
		  (CONSTANTS DTR RTS OUT1 OUT2 LOOP CTS DSR RI RLSD)
		  (* MODEM control and MODEM status register bits)
		  (CONSTANTS DISTR DOSTR MASTERRESET)
		  (* Misc bits -- Input Strobe Line, Output Strobe Line, and Master Reset.)
		  (* NOSTROBE has the strobe lines low, directed to a non-existent register so that 
		     other registers won't be disturbed. REGADDRSHIFT is the LLSH factor for register 
		     addresses when sent to the parallel port.)
		  (CONSTANTS NOSTROBE REGADDRSHIFT))
	(DECLARE: DONTCOPY (* TO.REGISTER converts a CONSTANTEXPRESSIONP frob into the numerical bits 
			      needed to address that numbered register in the INS8250 chip. If a 
			      second arg is given, the value is put in the data part of the numerical 
			      bits, so that it may be written into the register. The "strobe" macros 
			      exists since it takes two calls to WRITEPRINTERPORT to effect any 
			      action -- one call with the input (or output)
			      strobe line hi, and one call with it low.)
		  (MACROS TO.REGISTER ISTROBE OSTROBE RS232INTERRUPT? RS232INITIALIZECHECK RS232DATAI 
			  RS232DATAO RS232STATUSIN))
	(COMS (* buffer management)
	      (* Chars to and from the chip may be stored in ring buffers. Note that the "hi" indices 
		 point to 1 slot beyond the active data, whereas the "lo" slot points to the lowest 
		 slot of active data. Note also that the ring buffer sizes *MUST* be a power of two 
		 so that index addition can be "IMOD" ified by merely doing a LOGAND.)
	      (INITVARS (\RS232IRINGBUF NIL)
			(\RS232ORINGBUF NIL)
			(\RS232ORINGEVENT (CREATE.EVENT "RS232OutputStartup")))
	      (DECLARE: DONTCOPY (CONSTANTS (\RS232RINGBUFFER.SIZE BYTESPERPAGE))
			(MACROS SERVICEIRING RINGB.INCREMENT PUSHRS232IRING POPRS232IRING 
				PUSHRS232ORING POPRS232ORING IRINGB.ATLEAST ORINGB.ATLEAST 
				ORINGB.FREE LINESTATUSERRORBITS LINESTATUSERRORSP CHECKDATAREADY 
				RS232PEEKBYTE.BACKUP RS232READBYTE.BACKUP))
	      (FNS \RS232.PROCESSINTERRUPT \RS232.DATAREADY \RS232DECODE.LINESTATUS 
		   \RS232.OUTPUTBROOM)
	      (GLOBALVARS \RS232IRINGBUF \RS232IRING.WRITE \RS232IRING.READ \RS232ORINGBUF 
			  \RS232ORING.WRITE \RS232ORING.READ \RS232ORINGEVENT)
	      (COMS (* Functional interface for what to do if a character is dropped, or a break 
		       signal is received.)
		    (INITVARS (RS232LOSTCHARFN (QUOTE \RS232DING))
			      (RS232BREAKFN NIL)
			      (RS232BREAKSEEN? NIL)
			      (\RS232.DROPPEDCHARACTER.CODE (CHARCODE #↑G))
			      (\RS232.ERROR.MASK -1)
			      (\RS232DING.BOX (SETUPTIMER 0)))
		    (FNS \RS232DING)
		    (SPECVARS RS232LOSTCHARFN RS232BREAKFN RS232BREAKSEEN? \RS232NoInterruptFN 
			      \RS232.DROPPEDCHARACTER.CODE)
		    (GLOBALVARS \RS232.ERROR \RS232.ERROR.MASK \RS232DING.BOX)))
	(COMS (* Various parameters installed by RS232INIT)
	      (INITVARS (\RS232DefaultBaudRate 1200)
			(\RS232DefaultBLOCKINTERVAL.ms 250))
	      (INITVARS \RS232Divisor \RS232.ByteIntervalCap.ms \RS232.ByteIntervalCap.tics 
			\RS232.Tovh&BIC2.tics \RS232.Tovh&BIC8.tics \RS232.LONGBREAK.tics 
			\RS232.SHORTBREAK.tics \RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics 
			\RS232.MAX#BYTESPERLOOP)
	      (* The "Divisor" correlates with the INS8250 crystal to generate the baud rate. 
		 \RS232.ByteIntervalCap.tics is a "cap" , or least upper limit, on the time-span of 
		 one character. \RS232.BLOCKINTERVAL.tics is the typical interval in the "intensive" 
		 RS232 routines during which no BLOCKing will be done
		 (i.e., other processes will be locked out))
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS RS232CHARACTERISTICS))
	      (INITVARS (\RS232DLion? NIL))
	      (FNS RS232INIT \RS232UNLOCKBUF RS232BACKGROUND \RS232.PERIODIC.FN \RS232EVENTFN)
	      (FNS RS232MODEMCONTROL RS232MODIFYMODEMCONTROL RS232MODEMHANGUP RS232MODEMSTATUSP 
		   \RS232.MSP1 \RS232LINECONTROL)
	      (* After initialization, RS232INIT holds a list of the actual args used)
	      (VARS (RS232INIT NIL)
		    (\RS232BACKGROUNDSTATE NIL)
		    (\RS232BACKGROUNDERRORSTATUS NIL)
		    (\RS232DEVICE NIL)
		    (\RS232STREAM NIL)
		    (\RS232.TIMEOUT.BOX (SETUPTIMER 0))
		    (\RS232.DING.BOX (SETUPTIMER 0)))
	      (GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms 
			  \RS232.ByteIntervalCap.tics \RS232.Tovh&BIC2.tics \RS232.Tovh&BIC8.tics 
			  \RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms 
			  \RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP 
			  RS232INIT \RS232BACKGROUNDSTATE \RS232BACKGROUNDERRORSTATUS \RS232DEVICE 
			  \RS232STREAM \RS232.TIMEOUT.BOX \RS232.DING.BOX \RS232DLion?)
	      (COMS (* DLION RS232 stuff)
		    (INITVARS (\DLErrorBitsConversion NIL)
			      (\DLionTTYPortCSB NIL)
			      (\RS232DLionTTYP T))
		    (GLOBALVARS \DLErrorBitsConversion \DLionTTYPortCSB \RS232DLionTTYP)
		    (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DLTTYCSB Parameters InCharStatus 
							     ModemControl)
			      (MACROS DLTTYOUTBUSY DLTTYOUTWAIT DLTTYPOKE)
			      (CONSTANTS (DLIOP.TTYCSB.OFFSET 81))
			      (* Following for bits in outControl word of DLTTYCSB)
			      (CONSTANTS (OutControl.putChar 32768)
					 (OutControl.setAllParameters 48897)
					 (OutControl.on 32771)
					 (OutControl.off 32772)
					 (OutControl.setDSR 33025)
					 (OutControl.setCTS 33281)
					 (OutControl.setDSR&CTS 33537))
			      (* Following for bits in inControl word of DLTTYCSB)
			      (CONSTANTS (InControl.InterruptMask 32888)
					 (InControl.charPresent 32768)
					 (InControl.errorBits 120)
					 (InControl.breakDetected 64)
					 (InControl.framingError 32)
					 (InControl.dataLost 16)
					 (InControl.parityError 8)))))
	(COMS (* Basic driver functions)
	      (MACROS RS232PEEKBYTE RS232READBYTE)
	      (FNS RS232PEEKBYTE RS232LISTEN RS232READBYTE RS232READWORD RS232WRITEBYTE 
		   RS232SENDBREAK RS232FORCEOUTPUT RS232CLEARBUFFER)
	      (* Block read and write functions)
	      (FNS RS232READLINE RS232READSTRING \RS232READBASEBYTES \RS232INSURE.LINEBUFFER)
	      (VARS (\RS232LINEBUFFER NIL)
		    (\RS232LINEBUFFER.SIZE NIL)
		    (\RS232.READLINE.BOX (SETUPTIMER 0))
		    (\RS232.BLOCKINTERVAL.BOX (SETUPTIMER 0))
		    (\RS232.DELAY.BOX (SETUPTIMER 0))
		    (\RS232STRPTR (ALLOCSTRING 0)))
	      (GLOBALVARS \RS232LINEBUFFER \RS232LINEBUFFER.SIZE \RS232.READLINE.BOX 
			  \RS232.BLOCKINTERVAL.BOX \RS232.DELAY.BOX \RS232STRPTR)
	      (MACROS RS232WRITECHARS)
	      (FNS RS232WRITESTRING RS232WRITECHARS \RS232WRITEBASEBYTES \RS232BOUTSTRING)
	      (* Use of XON/XOFF protocols)
	      (INITVARS (RS232XON\XOFF? NIL)
			(RS232XOFF? NIL))
	      (GLOBALVARS RS232XON\XOFF? RS232XOFF?)
	      (* Check to see if Transmitter Holding Register is empty.)
	      (FNS \RS232CHECK.THRE)
	      (INITVARS (\RS232.THRE.BOX (SETUPTIMER 0)))
	      (GLOBALVARS \RS232.THRE.BOX)
	      (* Check to see if BLOCK can be called now)
	      (FNS \RS232CHECK.BLOCK)
	      (GLOBALRESOURCES (\RS232.ADMIT.BOX (SETUPTIMER 0))))
	(COMS (* Debugging aids)
	      (FNS RS232DUMPBUFFER \D0RS232DUMP))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA RS232MODEMCONTROL)
									      ))))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)



(* Generally useful tools.)

(DEFINEQ

(ORDINALSUFFIXSTRING
  (LAMBDA (N)                                                (* JonL " 5-JAN-83 23:54")
    (SETQ N (IABS N))
    (if (AND (ILEQ 5 N)
	     (ILEQ N 20))
	then "th"
      else (SELECTC (SETQ N (IREMAINDER N 10))
		    (1 "st")
		    (2 "nd")
		    (3 "rd")
		    "th"))))
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS CANONICAL.TIMERUNITS MACRO (OPENLAMBDA (X)
                                                             (* Checks for common abbreviations before calling 
							     \CanonicalizeTimerUnits)
  (SELECTQ X
	   ((TICKS MILLISECONDS SECONDS)                     (* These are the canonical forms)
	     X)
	   ((TICS)
	     (QUOTE TICKS))
	   ((NIL MS MILLISECS)
	     (QUOTE MILLISECONDS))
	   ((SECS)
	     (QUOTE SECONDS))
	   (\CanonicalizeTimerUnits X))))
)

(COND ((BOUNDP (QUOTE BITSPERBYTE)))
      (T (* These should be in MODARITH or ADDARITH but remember the case of LOADFROMing on 
	    Interlisp-10)
	 (SETQ BITSPERNIBBLE (IQUOTIENT (SETQ BITSPERBYTE 8)
					2))
	 (SETQ BYTESPERPAGE 512)
	 (CONSTANTS BITSPERBYTE BYTESPERPAGE BITSPERNIBBLE)))
)



(* Calculate the number of pages represented by an address and a byte offset. Touch all the 
pages of a function, to be sure they are swapped in.)

(DEFINEQ

(\#PAGES.BASEBYTES
  (LAMBDA (BASE OFFST)                                       (* JonL " 5-DEC-82 21:15")
    (ADD1 (IDIFFERENCE (fetch (POINTER PAGE#) of (\ADDBASE BASE (SUB1 (FOLDHI OFFST BYTESPERWORD))))
		       (fetch (POINTER PAGE#) of BASE)))))

(\FRESHENUPFN
  (LAMBDA (F)                                                (* JonL " 5-DEC-82 21:15")

          (* Freshens up a compiled function by touching all of its pages; hopefully this will bring them "in core" and let 
	  them stay there long enough so that a subsequent call to the function won't have a pagefault.)


    (AND (CCODEP (SETQ F (GETD F)))
	 (bind (PAGEBASE ←(fetch (POINTER PAGEBASE) of (fetch (ARRAYP BASE) of F)))
	    to (\#PAGES.BASEBYTES (fetch (ARRAYP BASE) of F)
				  (fetch (ARRAYP LENGTH) of F))
	    do                                               (* Just "touch" the page, to be sure it's in.)
	       (\GETBASE PAGEBASE 0)
	       (SETQ PAGEBASE (\ADDBASE PAGEBASE WORDSPERPAGE))))))

(\ONPATHS.CCODE
  (LAMBDA (BASISFNSLST IGNOREFNSLST TOWHATDEPTH?)            (* JonL "18-DEC-82 05:48")
    (PROG (INCREMENTALFNSLST RESULTS SOFAR)
          (OR (FIXP TOWHATDEPTH?)
	      (SETQ TOWHATDEPTH? 1))
          (if (thereis X in BASISFNSLST suchthat (OR (NOT (CCODEP X))
						     (FMEMB X IGNOREFNSLST)))
	      then (SETQ BASISFNSLST (MAPCONC BASISFNSLST (FUNCTION (LAMBDA (X)
						  (AND (CCODEP X)
						       (NOT (FMEMB X IGNOREFNSLST))
						       (LIST X)))))))
          (SETQ RESULTS BASISFNSLST)
          (SETQ INCREMENTALFNSLST BASISFNSLST)
      A   (for X in INCREMENTALFNSLST first (SETQ SOFAR)
	     do (for Y in (CADR (CALLSCCODE X)) do (AND (CCODEP Y)
							(NOT (FMEMB Y RESULTS))
							(NOT (FMEMB Y IGNOREFNSLST))
							(NOT (FMEMB Y SOFAR))
							(push SOFAR Y))))
          (if SOFAR
	      then                                           (* If we garnered some more on this round, then go back 
							     and look for paths emenating out from these new ones.)
		   (SETQ INCREMENTALFNSLST SOFAR)
		   (SETQ RESULTS (APPEND INCREMENTALFNSLST RESULTS))
		   (if (ILESSP 0 (add TOWHATDEPTH? -1))
		       then (GO A)))
          (RETURN RESULTS))))
)
(DECLARE: EVAL@COMPILE 

(RPAQQ ACTIVE.EM 299)

(CONSTANTS ACTIVE.EM)
)
(DECLARE: DONTCOPY 



(* Following constants come from the terminology in the hardware description of the INS8250 
chip.)


(DECLARE: EVAL@COMPILE 

(RPAQQ DATAREG 0)

(RPAQQ INTERRUPTENABLEREG 1)

(RPAQQ INTERRUPTIDREG 2)

(RPAQQ LINECONTROLREG 3)

(RPAQQ MODEMCONTROLREG 4)

(RPAQQ LINESTATUSREG 5)

(RPAQQ MODEMSTATUSREG 6)

(RPAQQ LOWDIVISORREG 0)

(RPAQQ HIDIVISORREG 1)

(CONSTANTS DATAREG INTERRUPTENABLEREG INTERRUPTIDREG LINECONTROLREG MODEMCONTROLREG LINESTATUSREG 
	   MODEMSTATUSREG LOWDIVISORREG HIDIVISORREG)
)




(* Register addresses, not left-shifted (i.e., as in INS8250 table))


(DECLARE: EVAL@COMPILE 

(RPAQQ INTRPT 32768)

(CONSTANTS INTRPT)
)




(* Interrupt bit from chip, as a READPRINTERPORT bit)





(* Interrupt Enable Register bits)


(DECLARE: EVAL@COMPILE 

(RPAQQ ERBFI 1)

(RPAQQ ETBEI 2)

(RPAQQ ELSI 4)

(RPAQQ EDSSI 8)

(CONSTANTS ERBFI ETBEI ELSI EDSSI)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ NoInterrupt 1)

(RPAQQ LineStatus 6)

(RPAQQ DataAvailable 4)

(RPAQQ HoldingRegisterEmpty 2)

(RPAQQ MODEMstatus 0)

(CONSTANTS NoInterrupt LineStatus DataAvailable HoldingRegisterEmpty MODEMstatus)
)




(* Meanings of value from Interrupt ID register.)


(DECLARE: EVAL@COMPILE 

(RPAQQ STB 4)

(RPAQQ PEN 8)

(RPAQQ EPS 16)

(RPAQQ SBCB 64)

(RPAQQ DLAB 128)

(CONSTANTS STB PEN EPS SBCB DLAB)
)




(* Line Control Register bits.)


(DECLARE: EVAL@COMPILE 

(RPAQQ DR 1)

(RPAQQ OE 2)

(RPAQQ PE 4)

(RPAQQ FE 8)

(RPAQQ BI 16)

(RPAQQ THRE 32)

(RPAQQ TSRE 64)

(RPAQQ RBOE 256)

(RPAQQ LBOE 512)

(CONSTANTS DR OE PE FE BI THRE TSRE RBOE LBOE)
)




(* Line Status Register bits, but RBOE and LBOE are my own software RingBuffer and LineBuffer 
full indicators.)


(DECLARE: EVAL@COMPILE 

(RPAQQ DTR 1)

(RPAQQ RTS 2)

(RPAQQ OUT1 4)

(RPAQQ OUT2 8)

(RPAQQ LOOP 16)

(RPAQQ CTS 16)

(RPAQQ DSR 32)

(RPAQQ RI 64)

(RPAQQ RLSD 128)

(CONSTANTS DTR RTS OUT1 OUT2 LOOP CTS DSR RI RLSD)
)




(* MODEM control and MODEM status register bits)


(DECLARE: EVAL@COMPILE 

(RPAQQ DISTR 256)

(RPAQQ DOSTR 2048)

(RPAQQ MASTERRESET 4096)

(CONSTANTS DISTR DOSTR MASTERRESET)
)




(* Misc bits -- Input Strobe Line, Output Strobe Line, and Master Reset.)





(* NOSTROBE has the strobe lines low, directed to a non-existent register so that other 
registers won't be disturbed. REGADDRSHIFT is the LLSH factor for register addresses when sent 
to the parallel port.)


(DECLARE: EVAL@COMPILE 

(RPAQQ NOSTROBE 57344)

(RPAQQ REGADDRSHIFT 13)

(CONSTANTS NOSTROBE REGADDRSHIFT)
)
)
(DECLARE: DONTCOPY 



(* TO.REGISTER converts a CONSTANTEXPRESSIONP frob into the numerical bits needed to address 
that numbered register in the INS8250 chip. If a second arg is given, the value is put in the 
data part of the numerical bits, so that it may be written into the register. The "strobe" 
macros exists since it takes two calls to WRITEPRINTERPORT to effect any action -- one call 
with the input (or output) strobe line hi, and one call with it low.)


(DECLARE: EVAL@COMPILE 

(PUTPROPS TO.REGISTER MACRO (X
  (PROG ((REGISTER.NUMBER (CAR X))
	 (VAL (CADR X))
	 REGISTER.ADDR)
        (SETQ REGISTER.ADDR (LIST (QUOTE LLSH)
				  REGISTER.NUMBER
				  (QUOTE REGADDRSHIFT)))
        (COND
	  ((CONSTANTEXPRESSIONP REGISTER.NUMBER)
	    (SETQ REGISTER.ADDR (COND
		((ZEROP (EVAL REGISTER.NUMBER))
		  0)
		(T (LIST (QUOTE CONSTANT)
			 REGISTER.ADDR))))))
        (RETURN (COND
		  ((OR (NULL VAL)
		       (ZEROP VAL)
		       (AND (CONSTANTEXPRESSIONP VAL)
			    (ZEROP (EVAL VAL))))
		    REGISTER.ADDR)
		  ((ZEROP REGISTER.ADDR)
		    VAL)
		  (T (LIST (QUOTE LOGOR)
			   REGISTER.ADDR VAL)))))))

(PUTPROPS ISTROBE MACRO ((REGISTER)
  (PROG2 (WRITEPRINTERPORT (LOGOR DISTR (TO.REGISTER REGISTER)))
	 (READPRINTERPORT)
	 (WRITEPRINTERPORT NOSTROBE))))

(PUTPROPS OSTROBE MACRO ((REGISTER VAL)
  ((LAMBDA (Register&Value)
      (WRITEPRINTERPORT (LOGOR DOSTR Register&Value))        (* Note that this also sets the DISTR line off)
      (WRITEPRINTERPORT Register&Value)                      (* It just so happens that the time between two 
							     WRITEPRINTERPORT instructions is enough for the data to 
							     be transferred to the holding register.)
      Register&Value)
    (TO.REGISTER REGISTER VAL))))

(PUTPROPS RS232INTERRUPT? MACRO (NIL
  (if \RS232DLion?
      then (BITTEST (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB)
		    InControl.InterruptMask)
    else (IGEQ (READPRINTERPORT)
	       INTRPT))))

(PUTPROPS RS232INITIALIZECHECK MACRO (NIL
  (OR (LISTP RS232INIT)
      (ERROR (QUOTE RS232NotInitialized)))))

(PUTPROPS RS232DATAI DMACRO (NIL
  (if \RS232DLion?
      then (PROG1 (fetch (DLTTYCSB inChar) of \DLionTTYPortCSB)
		  (replace (DLTTYCSB inControl) of \DLionTTYPortCSB
		     with (BITCLEAR (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB)
				    InControl.charPresent)))
    else (ISTROBE DATAREG))))

(PUTPROPS RS232DATAO DMACRO ((BYTE)
  (if \RS232DLion?
      then (replace (DLTTYCSB outData) of \DLionTTYPortCSB with BYTE)
	   (DLTTYPOKE putChar NOWAIT)
    else (OSTROBE DATAREG BYTE))))

(PUTPROPS RS232STATUSIN MACRO (NIL
  (UNINTERRUPTABLY
      ((LAMBDA (Status)
	  (DECLARE (LOCALVARS Status))
	  (if \RS232BACKGROUNDERRORSTATUS
	      then (add Status \RS232BACKGROUNDERRORSTATUS)
		   (SETQ \RS232BACKGROUNDERRORSTATUS))
	  Status)
	(if \RS232DLion?
	    then ((LAMBDA (cw)
		     (DECLARE (LOCALVARS cw r))
		     ((LAMBDA (r)
			 (if (BITTEST cw InControl.errorBits)
			     then (add r (\GETBASEBYTE \DLErrorBitsConversion (LOADBYTE cw 3 4))))
			 r)
		       (if (BITTEST cw InControl.charPresent)
			   then DR
			 else 0)))
		   (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB))
	  else (LOADBYTE (ISTROBE LINESTATUSREG)
			 0 8))))))
)
)



(* buffer management)




(* Chars to and from the chip may be stored in ring buffers. Note that the "hi" indices point 
to 1 slot beyond the active data, whereas the "lo" slot points to the lowest slot of active 
data. Note also that the ring buffer sizes *MUST* be a power of two so that index addition can 
be "IMOD" ified by merely doing a LOGAND.)


(RPAQ? \RS232IRINGBUF NIL)

(RPAQ? \RS232ORINGBUF NIL)

(RPAQ? \RS232ORINGEVENT (CREATE.EVENT "RS232OutputStartup"))
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQ \RS232RINGBUFFER.SIZE BYTESPERPAGE)

(CONSTANTS (\RS232RINGBUFFER.SIZE BYTESPERPAGE))
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS SERVICEIRING DMACRO (NIL
  (if (RS232INTERRUPT?)
      then (\RS232.PROCESSINTERRUPT))))

(PUTPROPS RINGB.INCREMENT MACRO ((VAR AMOUNT)
  (PROG1 VAR (SETQ VAR (IMOD (IPLUS VAR AMOUNT)
			     \RS232RINGBUFFER.SIZE)))))

(PUTPROPS PUSHRS232IRING MACRO ((BYTE)
  (\PUTBASEBYTE \RS232IRINGBUF (RINGB.INCREMENT \RS232IRING.WRITE 1)
		BYTE)))

(PUTPROPS POPRS232IRING MACRO (NIL
  (\GETBASEBYTE \RS232IRINGBUF (RINGB.INCREMENT \RS232IRING.READ 1))))

(PUTPROPS PUSHRS232ORING MACRO ((BYTE)
  (\PUTBASEBYTE \RS232ORINGBUF (RINGB.INCREMENT \RS232ORING.WRITE 1)
		BYTE)))

(PUTPROPS POPRS232ORING MACRO (NIL
  (\GETBASEBYTE \RS232ORINGBUF (RINGB.INCREMENT \RS232ORING.READ 1))))

(PUTPROPS IRINGB.ATLEAST DMACRO (X
  (PROG ((N (LISPFORM.SIMPLIFY (CAR X)
			       T)))
        (RETURN (COND
		  ((AND (FIXP N)
			(IEQP N 1))
		    (QUOTE (NEQ \RS232IRING.READ \RS232IRING.WRITE)))
		  (T (SUBST N (QUOTE N)
			    (QUOTE (ILEQ N (IMOD (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
						 \RS232RINGBUFFER.SIZE))))))))))

(PUTPROPS ORINGB.ATLEAST DMACRO (X
  (PROG ((N (LISPFORM.SIMPLIFY (CAR X)
			       T)))
        (RETURN (COND
		  ((AND (FIXP N)
			(IEQP N 1))
		    (QUOTE (NEQ \RS232ORING.READ \RS232ORING.WRITE)))
		  (T (SUBST N (QUOTE N)
			    (QUOTE (ILEQ N (IMOD (IDIFFERENCE \RS232ORING.WRITE \RS232ORING.READ)
						 \RS232RINGBUFFER.SIZE))))))))))

(PUTPROPS ORINGB.FREE DMACRO (NIL
                                                             (* Note the equivalence: (IMOD 
							     (IDIFFERENCE Z (IDIFFERENCE HI LO)) Z) = 
							     (IMOD (IDIFFERENCE LO HI) Z))
  (IMOD (IDIFFERENCE \RS232ORING.READ \RS232ORING.WRITE)
	\RS232RINGBUFFER.SIZE)))

(PUTPROPS LINESTATUSERRORBITS DMACRO ((STATUS)
  (LOGAND STATUS \RS232.ERROR.MASK (CONSTANT (LOGOR LBOE RBOE OE PE FE BI)))))

(PUTPROPS LINESTATUSERRORSP MACRO ((STATUS)
  (NEQ 0 (LINESTATUSERRORBITS STATUS))))

(PUTPROPS CHECKDATAREADY MACRO ((LineStatusVal . REST)
  (AND (BITTEST DR LineStatusVal)
       (\RS232.DATAREADY . REST))))

(PUTPROPS RS232PEEKBYTE.BACKUP MACRO (NIL
  (PROGN (SERVICEIRING)
	 (if (IRINGB.ATLEAST 1)
	     then (\GETBASEBYTE \RS232IRINGBUF \RS232IRING.READ)))))

(PUTPROPS RS232READBYTE.BACKUP MACRO (X
  (if X
      then (QUOTE IGNOREMACRO)
    else                                                     (* Take only easy case)
	 (QUOTE (PROGN (SERVICEIRING)
		       (if (IRINGB.ATLEAST 1)
			   then (POPRS232IRING)))))))
)
)
(DEFINEQ

(\RS232.PROCESSINTERRUPT
  (LAMBDA (NOERRORFLG)                                       (* JonL "29-JUN-83 06:58")
                                                             (* Returns non-NIL iff some error conditions have 
							     occured.)
    (PROG ((CNT 0)
	   (CUMULATIVE.STATUS 0)
	   ANYERRORS? STATUS RAWINTERRUPTBITS DONEIT? PERIODIC.INTERRUPT?)
      A   (UNINTERRUPTABLY
              (if (SETQ PERIODIC.INTERRUPT? \PERIODIC.INTERRUPT)
		  then (SETQ \PERIODIC.INTERRUPT))
	      (if \RS232BACKGROUNDERRORSTATUS
		  then (SETQ CUMULATIVE.STATUS (LOGOR \RS232BACKGROUNDERRORSTATUS CUMULATIVE.STATUS))
		       (SETQ \RS232BACKGROUNDERRORSTATUS)
		       (SETQ ANYERRORS? T))
	      (SETQ RAWINTERRUPTBITS (if \RS232DLion?
					 then (PROG ((cw (fetch (DLTTYCSB inControl) of 
										 \DLionTTYPortCSB)))
						    (DECLARE (LOCALVARS cw))
						    (RETURN (if (BITTEST cw InControl.errorBits)
								then LineStatus
							      elseif (IGEQ cw InControl.charPresent)
								then DataAvailable
							      else NoInterrupt)))
				       else (ISTROBE INTERRUPTIDREG)))
	      (SETQ STATUS (SELECTC (LOADBYTE RAWINTERRUPTBITS 0 BITSPERBYTE)
				    (DataAvailable           (* Note that the DataAvailable interrupt is lower 
							     priority than the LineStatus interrupt.)
						   (SETQ DONEIT? T)
						   (\RS232.DATAREADY))
				    (LineStatus (SETQ DONEIT? T)
						(\RS232DECODE.LINESTATUS NIL T))
				    (NoInterrupt             (* FOO!)
						 (SETQ DONEIT? T)
						 NIL)
				    (0                       (* Grumble -- this case seems to come up when the 
							     background process sneaks in between the 
							     (RS232INTERRUPT?) test and here in 
							     \RS232.PROCESSINTERRUPT)
				       (SETQ DONEIT? T)
				       NIL)
				    NIL))
	      (if PERIODIC.INTERRUPT?
		  then (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?)))
          (if (NOT DONEIT?)
	      then (RESETVAR \PERIODIC.INTERRUPT NIL (PROGN (SETQ \RS232.ERROR RAWINTERRUPTBITS)
							    (SHOULDNT (QUOTE \RS232.PROCESSINTERRUPT))
							    )))
          (if STATUS
	      then (SETQ CUMULATIVE.STATUS (LOGOR CUMULATIVE.STATUS STATUS))
		   (SETQ ANYERRORS? T))
          (if (NOT (RS232INTERRUPT?))
	      then (RETURN (if (NOT ANYERRORS?)
			       then NIL
			     elseif NOERRORFLG
			       then CUMULATIVE.STATUS
			     else (\RS232DECODE.LINESTATUS CUMULATIVE.STATUS))))
      B   (if (ILESSP 20 (add CNT 1))
	      then (SHOULDNT 
		      "Over 20 consecutive interrupts - can't get out of \RS232.PROCESSINTERRUPT")
	    else (SETQ DONEIT?)
		 (GO A)))))

(\RS232.DATAREADY
  (LAMBDA NIL                                                (* JonL "28-JUN-83 02:11")
                                                             (* NOTE WELL! This function must be called 
							     UNINTERRUPTABLY Returns non-NIL iff there is an overflow
							     of the ring buffer.)
    (PROG ((BYTE (LOADBYTE (RS232DATAI)
			   0 BITSPERBYTE)))
          (if RS232XON\XOFF?
	      then (SELCHARQ BYTE
			     (↑S (SETQ RS232XOFF? T)
				 (RETURN))
			     (↑Q (SETQ RS232XOFF?)
				 (RETURN))
			     NIL))
          (PUSHRS232IRING BYTE)
          (if (EQ \RS232IRING.READ \RS232IRING.WRITE)
	      then                                           (* If Hi and Low ptrs are EQ after a PUSHRS232IRING then
							     we have overflowed)
		   (RINGB.INCREMENT \RS232IRING.WRITE -1)
		   (RETURN RBOE)))))

(\RS232DECODE.LINESTATUS
  (LAMBDA (STATUS NOERRORFLG)                                (* JonL "29-JUN-83 07:00")

          (* Looks for error bits in a LINESTATUSREG reading, running errors or RS232BREAKFN if NOERRORFLG is null.
	  Returns the most recent reading of the LINESTATUSREG)


    (PROG ((CNT 0)
	   BREAKINSTATUS? PERIODIC.INTERRUPT?)
      A   (UNINTERRUPTABLY
              (if (SETQ PERIODIC.INTERRUPT? \PERIODIC.INTERRUPT)
		  then (SETQ \PERIODIC.INTERRUPT))
	      (if (NULL STATUS)
		  then (SETQ STATUS (RS232STATUSIN))
		elseif (NOT (FIXP STATUS))
		  then (if PERIODIC.INTERRUPT?
			   then (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?))
		       (SHOULDNT))
	      (SETQ BREAKINSTATUS? (if (BITTEST STATUS BI)
				       then (if (BITTEST STATUS FE)
						then (SETQ STATUS (BITCLEAR STATUS BI))
						     NIL
					      else (SETQ RS232BREAKSEEN? T))))
	      (if (BITTEST DR STATUS)
		  then (SETQ STATUS (LOGOR (BITCLEAR STATUS DR)
					   (OR (\RS232.DATAREADY)
					       0))))
	      (if PERIODIC.INTERRUPT?
		  then (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?)))
          (if (OR NOERRORFLG (NOT (LINESTATUSERRORSP STATUS)))
	      then                                           (* Here's the main return)
		   (RETURN STATUS))
          (if BREAKINSTATUS?
	      then (if RS232BREAKFN
		       then (APPLY* RS232BREAKFN))
		   (SETQ STATUS (BITCLEAR STATUS BI))
		   (if (NOT (LINESTATUSERRORSP STATUS))
		       then (GO B)))
          (APPLY* (PROG1 RS232LOSTCHARFN                     (* Comment PPLossage))
		  (SELECTC (LINESTATUSERRORBITS STATUS)
			   (OE (QUOTE DroppedCharacter))
			   (PE (QUOTE ParityError))
			   (FE (QUOTE FramingError))
			   (RBOE (QUOTE RingBufferFull))
			   (LBOE (QUOTE LineBufferFull))
			   (QUOTE MultipleErrors)))
      B   (if (IGEQ (add CNT 1)
		    20)
	      then (SHOULDNT 
	      "Over 20 consecutive line status errors - can't get out of \RS232DECODE.LINESTATUS"))
          (SETQ STATUS)
          (GO A))))

(\RS232.OUTPUTBROOM
  (LAMBDA NIL                                                (* JonL "20-JUN-83 18:44")
                                                             (* Just loop around infinitely, "sweeping" all the data 
							     in the output ring buffer out through the UART)
    (do (AWAIT.EVENT \RS232ORINGEVENT)
	(bind STATUS while (ORINGB.ATLEAST 1)
	   do (if (UNINTERRUPTABLY
                      (if (EQ T (SETQ STATUS (\RS232CHECK.THRE)))
			  then (RS232DATAO (POPRS232ORING))
			       NIL
			else (FIXP STATUS)))
		  then                                       (* Note that this call may cause an error)
		       (\RS232DECODE.LINESTATUS STATUS))
	      (BLOCK)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232IRINGBUF \RS232IRING.WRITE \RS232IRING.READ \RS232ORINGBUF 
	  \RS232ORING.WRITE \RS232ORING.READ \RS232ORINGEVENT)
)



(* Functional interface for what to do if a character is dropped, or a break signal is 
received.)


(RPAQ? RS232LOSTCHARFN (QUOTE \RS232DING))

(RPAQ? RS232BREAKFN NIL)

(RPAQ? RS232BREAKSEEN? NIL)

(RPAQ? \RS232.DROPPEDCHARACTER.CODE (CHARCODE #↑G))

(RPAQ? \RS232.ERROR.MASK -1)

(RPAQ? \RS232DING.BOX (SETUPTIMER 0))
(DEFINEQ

(\RS232DING
  (LAMBDA NIL                                                (* JonL "12-MAY-83 10:08")
                                                             (* This is the default RS232LOSTCHARFN)
    (PROG ((FLG T)
	   (TEMP \RS232IRING.WRITE)
	   (BELLINTERIM (ITIMES 125 \RCLKMILLISECOND))
	   STATUS)
          (RINGB.INCREMENT TEMP 1)
          (if (EQ \RS232IRING.READ TEMP)
	      then                                           (* FOO! no room left)
		   (RINGB.INCREMENT \RS232IRING.WRITE -1))
          (PUSHRS232IRING \RS232.DROPPEDCHARACTER.CODE)      (* Install a "dropped characters" code, and flash at the
							     user.)
          (if (TIMEREXPIRED? \RS232DING.BOX)
	      then (RESETFORM (VIDEOCOLOR FLG)
			      (FRPTQ 7 (during BELLINTERIM timerUnits (QUOTE TICKS) usingTimer 
										  \RS232.DING.BOX
					  do (SETQ STATUS (\RS232DECODE.LINESTATUS STATUS
										   (QUOTE NOERROR))))
				     (VIDEOCOLOR (SETQ FLG (NOT FLG)))))
		   (SETUPTIMER 2000 \RS232DING.BOX))
          (until (NOT (LINESTATUSERRORSP (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))))
                                                             (* Loop until line "stabilizes")
          (if (FIXP STATUS)
	      then (\RS232DECODE.LINESTATUS (BITCLEAR STATUS OE)))
                                                             (* Finally, check to see if there were other errors as 
							     well.)
      )))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS RS232LOSTCHARFN RS232BREAKFN RS232BREAKSEEN? \RS232NoInterruptFN 
	  \RS232.DROPPEDCHARACTER.CODE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232.ERROR \RS232.ERROR.MASK \RS232DING.BOX)
)



(* Various parameters installed by RS232INIT)


(RPAQ? \RS232DefaultBaudRate 1200)

(RPAQ? \RS232DefaultBLOCKINTERVAL.ms 250)

(RPAQ? \RS232Divisor NIL)

(RPAQ? \RS232.ByteIntervalCap.ms NIL)

(RPAQ? \RS232.ByteIntervalCap.tics NIL)

(RPAQ? \RS232.Tovh&BIC2.tics NIL)

(RPAQ? \RS232.Tovh&BIC8.tics NIL)

(RPAQ? \RS232.LONGBREAK.tics NIL)

(RPAQ? \RS232.SHORTBREAK.tics NIL)

(RPAQ? \RS232.BLOCKINTERVAL.ms NIL)

(RPAQ? \RS232.BLOCKINTERVAL.tics NIL)

(RPAQ? \RS232.MAX#BYTESPERLOOP NIL)



(* The "Divisor" correlates with the INS8250 crystal to generate the baud rate. 
\RS232.ByteIntervalCap.tics is a "cap" , or least upper limit, on the time-span of one 
character. \RS232.BLOCKINTERVAL.tics is the typical interval in the "intensive" RS232 routines 
during which no BLOCKing will be done (i.e., other processes will be locked out))

(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(RECORD RS232CHARACTERISTICS (BAUDRATE BITSPERCHAR PARITY STOPBITS MODEMCONTROL))
]
)

(RPAQ? \RS232DLion? NIL)
(DEFINEQ

(RS232INIT
  (LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl)
                                                             (* JonL "29-JUN-83 06:37")
    (AND \RS232IRINGBUF (\RS232UNLOCKBUF \RS232IRINGBUF))
    (AND \RS232ORINGBUF (\RS232UNLOCKBUF \RS232ORINGBUF))
    ((LAMBDA (BUFSIZ)
	(if (IEQP BUFSIZ BYTESPERPAGE)
	    then (if (NOT (TYPENAMEP \RS232IRINGBUF (QUOTE VMEMPAGEP)))
		     then (SETQ \RS232IRINGBUF (NCREATE (QUOTE VMEMPAGEP))))
		 (if (NOT (TYPENAMEP \RS232ORINGBUF (QUOTE VMEMPAGEP)))
		     then (SETQ \RS232ORINGBUF (NCREATE (QUOTE VMEMPAGEP))))
	  else (SETQ \RS232IRINGBUF (\ALLOCBLOCK BUFSIZ NIL CELLSPERPAGE))
	       (SETQ \RS232ORINGBUF (\ALLOCBLOCK BUFSIZ NIL CELLSPERPAGE)))
	(\LOCKPAGES \RS232IRINGBUF (\#PAGES.BASEBYTES \RS232IRINGBUF BUFSIZ))
	(\LOCKPAGES \RS232ORINGBUF (\#PAGES.BASEBYTES \RS232ORINGBUF BUFSIZ)))
      (CEIL (OR (SMALLP \RS232RINGBUFFER.SIZE)
		1)
	    BYTESPERPAGE))
    (SETQ \RS232IRING.READ (SETQ \RS232IRING.WRITE 0))
    (SETQ \RS232ORING.READ (SETQ \RS232ORING.WRITE 0))
    (if (NULL BaudRate)
	then (SETQ BaudRate \RS232DefaultBaudRate)
      elseif (EQ BaudRate 110)
	then NIL
      elseif (NOT (AND (SMALLP BaudRate)
		       (IGEQ BaudRate 75)
		       (ILEQ BaudRate 19200)
		       (ZEROP (IREMAINDER BaudRate 75))
		       (POWEROFTWOP (IQUOTIENT BaudRate 75))))
	then (\ILLEGAL.ARG BaudRate))
    (SETQ \RS232Divisor (IQUOTIENT 115200 BaudRate))         (* 115200=1.8432MHz / 16)
    (SETQ \RS232.ByteIntervalCap.ms (IQUOTIENT (IPLUS \RS232Divisor 9)
					       10))          (* Approximately 10 bits worth of time needed to send 
							     one byte, what with 8-bits-per-byte and 1.5 stop bits)
    (SETQ \RS232.ByteIntervalCap.tics (ITIMES \RCLKMILLISECOND \RS232.ByteIntervalCap.ms))
    ((LAMBDA (TimerOverhead.tics)                            (* Assume that the cost of SETUPTIMER and TIMERXPIRED? 
							     combined, plus a little other setup code, is about 1/2 
							     millisecond.)
	(SETQ \RS232.Tovh&BIC2.tics (IPLUS TimerOverhead.tics (ITIMES 2 \RS232.ByteIntervalCap.tics)))
	(SETQ \RS232.Tovh&BIC8.tics (IPLUS TimerOverhead.tics (ITIMES 8 \RS232.ByteIntervalCap.tics)))
	(SETQ \RS232.LONGBREAK.tics (IPLUS TimerOverhead.tics (TIMES 3.5 \RCLKSECOND)))
	(SETQ \RS232.SHORTBREAK.tics (IPLUS TimerOverhead.tics (TIMES .25 \RCLKSECOND))))
      (CEIL \RCLKMILLISECOND 2))
    (SETQ \RS232.BLOCKINTERVAL.ms \RS232DefaultBLOCKINTERVAL.ms)
    (SETQ \RS232.BLOCKINTERVAL.tics (ITIMES \RCLKMILLISECOND \RS232.BLOCKINTERVAL.ms))
    (SETQ \RS232.MAX#BYTESPERLOOP (IMAX (SUB1 (FOLDHI (ITIMES (FOLDHI (IMAX 128 
									  \RS232.BLOCKINTERVAL.ms)
								      8)
							      (FOLDHI (IMAX 64 BaudRate)
								      8))
						      128))
					1))
    (if (SMALLP BitsPerSerialChar)
	then (OR (AND (IGEQ BitsPerSerialChar 5)
		      (ILEQ BitsPerSerialChar 8))
		 (\ILLEGAL.ARG BitsPerSerialChar))
      else (SETQ BitsPerSerialChar 8))
    (OR (FMEMB Parity (QUOTE (NIL EVEN ODD)))
	(SETQ Parity (if (NOT (SMALLP Parity))
			 then NIL
		       elseif (ODDP Parity)
			 then (QUOTE ODD)
		       else (QUOTE EVEN))))
    (SETQ NoOfStopBits (if (EQP NoOfStopBits 2)
			   then 2
			 else 1))
    (SELECTQ (MACHINETYPE)
	     (DOLPHIN (SETQ \RS232DLion?)
		      (PROG ((WordLengthSelect (LOADBYTE (IDIFFERENCE BitsPerSerialChar 5)
							 0 2))
			     (ParityEnable/Select (SELECTQ Parity
							   (NIL 0)
							   (ODD PEN)
							   (CONSTANT (LOGOR PEN EPS))))
			     (StopBitsSelect (if (EQP NoOfStopBits 2)
						 then STB
					       else 0)))
			    (SETQ BitsPerSerialChar (IPLUS WordLengthSelect 5))
			    (PROGN (WRITEPRINTERPORT MASTERRESET)
				   (WRITEPRINTERPORT NOSTROBE))
			    (\RS232LINECONTROL DLAB)         (* Sets the DLAB (only) in LineControl register.)
			    (OSTROBE LOWDIVISORREG (LOADBYTE \RS232Divisor 0 8))
			    (OSTROBE HIDIVISORREG (LOADBYTE \RS232Divisor 8 8))
			    (\RS232LINECONTROL (LOGOR WordLengthSelect StopBitsSelect 
						      ParityEnable/Select))
                                                             (* Notice this will also set the DLAB bit to 0)
			    (OSTROBE INTERRUPTENABLEREG (CONSTANT (LOGOR ERBFI ELSI)))))
	     (DANDELION (SETQ \DLErrorBitsConversion (\ALLOCBLOCK (CONSTANT (UNFOLD (EXPT 2 4)
										    BYTESPERCELL))))
			(for I CONV from 0 to (CONSTANT (SUB1 (EXPT 2 4)))
			   do (SETQ CONV 0)
			      (for Z in (CONSTANT (for X in (MAPCAR (LIST InControl.breakDetected 
									  InControl.framingError 
									  InControl.parityError 
									  InControl.dataLost)
								    (QUOTE (LAMBDA (Z)
										   (LRSH Z 3))))
						     as Y in (LIST BI FE PE OE)
						     collect (CONS X Y)))
				 do (if (BITTEST I (CAR Z))
					then (add CONV (CDR Z))))
			      (\PUTBASEBYTE \DLErrorBitsConversion I CONV))
			(SETQ \DLionTTYPortCSB (\ADDBASE (create POINTER
								 PAGE# ← \VP.IOPAGE)
							 DLIOP.TTYCSB.OFFSET))
			(SETQ \RS232DLion? T)
			(if \RS232DLionTTYP
			    then (DLTTYOUTWAIT)
				 (replace (DLTTYCSB notifyMask) of \DLionTTYPortCSB with 0)
				 (replace (InCharStatus charPresent?) of \DLionTTYPortCSB
				    with NIL)                (* Or, charPresent)
				 (DLTTYPOKE on)
				 (replace (Parameters onOff) of \DLionTTYPortCSB with 1)
				 (replace (Parameters baudRate) of \DLionTTYPortCSB
				    with (if (EQ BaudRate 110)
					     then 2
					   elseif (CAR (NTH (QUOTE (15 14 12 10 7 6 5 4 1))
							    (IDIFFERENCE (INTEGERLENGTH \RS232Divisor)
									 2)))
					   else (SHOULDNT "DLion Baud Rate?")))
				 (replace (Parameters stopBits) of \DLionTTYPortCSB with NoOfStopBits)
				 (replace (Parameters parity) of \DLionTTYPortCSB with Parity)
				 (replace (Parameters charLength) of \DLionTTYPortCSB
				    with (IDIFFERENCE BitsPerSerialChar 5))
				 (replace (Parameters clearToSend) of \DLionTTYPortCSB with NIL)
				 (replace (Parameters dataSetReady) of \DLionTTYPortCSB with NIL)
				 (DLTTYPOKE setAllParameters)
			  else (DLTTYPOKE off)
			       (HELP)))
	     NIL)
    (OR (type? FDEV \RS232DEVICE)
	(SETQ \RS232DEVICE
	  (create FDEV
		  DEVICENAME ←(QUOTE RS232)
		  RANDOMACCESSP ← NIL
		  PAGEMAPPED ← NIL
		  CLOSEFILE ←(FUNCTION (LAMBDA (STREAM)
		      (if RS232INIT
			  then (if (BITTEST (fetch ACCESSBITS of STREAM)
					    OutputBits)
				   then (RS232FORCEOUTPUT))
			       (\RS232EVENTFN (QUOTE BEFOREMAKESYS)))
		      (SETQ \OPENFILES (DREMOVE \RS232STREAM \OPENFILES))
		      (SETQ RS232INIT)))
		  DELETEFILE ←(FUNCTION NILL)
		  DIRECTORYNAMEP ←(FUNCTION NILL)
		  EVENTFN ←(FUNCTION \RS232EVENTFN)
		  GENERATEFILES ←(FUNCTION \GENERATENOFILES)
		  GETFILEINFO ←(FUNCTION NILL)
		  GETFILENAME ←(FUNCTION NILL)
		  HOSTNAMEP ←(FUNCTION NILL)
		  OPENFILE ←(FUNCTION \ILLEGAL.DEVICEOP)
		  READPAGES ←(FUNCTION NILL)
		  REOPENFILE ←(FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV STREAM)
		      (if (AND (PROG1 RS232INIT              (* Comment PPLossage))
			       (OR (EQ (MACHINETYPE)
				       (QUOTE DANDELION))
				   (PROG ((V (LOGAND (ISTROBE MODEMCONTROLREG)
						     (CONSTANT (LOGOR OUT1 OUT2))))
					  VCOMP)
				         (SETQ VCOMP (LOGXOR V (CONSTANT (LOGOR OUT1 OUT2))))
                                                             (* Ascertain whether the INS8250 chip is responding)
				         (OSTROBE MODEMCONTROLREG VCOMP)
				         (RETURN (EQ VCOMP (LOADBYTE (ISTROBE MODEMCONTROLREG)
								     0 8))))))
			  then STREAM)))
		  SETFILEINFO ←(FUNCTION NILL)
		  TRUNCATEFILE ←(FUNCTION NILL)
		  WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
		  BIN ←(FUNCTION (LAMBDA (STREAM)
		      (RS232READBYTE T)))
		  BOUT ←(FUNCTION (LAMBDA (STREAM BYTE)
		      (RS232WRITEBYTE BYTE)))
		  PEEKBIN ←(FUNCTION RS232PEEKBYTE)
		  READP ←(FUNCTION RS232PEEKBYTE)
		  BACKFILEPTR ←(FUNCTION (LAMBDA (STREAM)
		      (PROG ((ACCESS (fetch ACCESSBITS of STREAM)))
			    (if (EQ ACCESS ReadBit)
				then (RINGB.INCREMENT \RS232IRING.READ -1)
			      elseif (BITTEST ACCESS OutputBits)
				then (RINGB.INCREMENT \RS232ORING.WRITE -1)
			      else (SHOULDNT "RS232 stream with bad access bits")))))
		  SETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
		  GETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
		  GETEOFPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
		  EOFP ←(FUNCTION NILL)
		  BLOCKIN ←(FUNCTION \RS232READBASEBYTES)
		  BLOCKOUT ←(FUNCTION \RS232WRITEBASEBYTES)
		  RENAMEFILE ←(FUNCTION \ILLEGAL.DEVICEOP))))
    (OR (type? STREAM \RS232STREAM)
	(SETQ \RS232STREAM (create STREAM
				   USERCLOSEABLE ← T
				   USERVISIBLE ← NIL
				   ACCESSBITS ← BothBits
				   FULLFILENAME ←(QUOTE {RS232})
				   DEVICE ← \RS232DEVICE)))
    (OR (FMEMB \RS232STREAM \OPENFILES)
	(push \OPENFILES \RS232STREAM))
    (if ModemControl
	then (RS232MODEMCONTROL ModemControl)
	     (SETQ ModemControl (RS232MODEMCONTROL)))
    (SETQ RS232INIT
      (create RS232CHARACTERISTICS
	      BAUDRATE ← BaudRate
	      BITSPERCHAR ← BitsPerSerialChar
	      PARITY ← Parity
	      STOPBITS ← NoOfStopBits
	      MODEMCONTROL ← ModemControl))
    (SETUPTIMER 0 \RS232DING.BOX)
    T))

(\RS232UNLOCKBUF
  (LAMBDA (BUF)                                              (* JonL "20-JUN-83 15:26")
    (if (TYPENAMEP BUF (QUOTE VMEMPAGEP))
	then (\UNLOCKPAGES BUF 1)
      elseif (type? ARRAYBLOCK BUF)
	then (PROG ((ARRAYBASELOC (IDIFFERENCE (LOC BUF)
					       \ArrayBlockHeaderWords))
		    PAGEBASELOC #CELLS)
	           (SETQ PAGEBASELOC (CEIL ARRAYBASELOC WORDSPERPAGE))
	           (SETQ #CELLS (IDIFFERENCE (fetch (ARRAYBLOCK ARLEN) of ARRAYBASELOC)
					     (IDIFFERENCE PAGEBASELOC ARRAYBASELOC)))
	           (\UNLOCKPAGES (VAG PAGEBASELOC)
				 (FOLDLO #CELLS CELLSPERPAGE)))
      else (SHOULDNT "Weird data type for RS232 ring buffer"))))

(RS232BACKGROUND
  (LAMBDA (ON?)                                              (* JonL "29-JUN-83 07:01")
    (PROG1 (SELECTQ \RS232BACKGROUNDSTATE
		    (NIL (QUOTE OFF))
		    (QUOTE ON))
	   (SELECTQ ON?
		    (NIL)
		    (ON (if \PERIODIC.INTERRUPT
			    then (ERROR "\PERIODIC.INTERRUPT already in use"))
			(SETQ \RS232BACKGROUNDERRORSTATUS)
			(if (NOT (PROCESSP (FIND.PROCESS (QUOTE \RS232.OUTPUTBROOM))))
			    then (ADD.PROCESS (QUOTE (\RS232.OUTPUTBROOM))
					      (QUOTE RESTARTABLE)
					      T))
			(SETQ \RS232BACKGROUNDSTATE T)
			(SETQ \PERIODIC.INTERRUPT (FUNCTION \RS232.PERIODIC.FN))
			(SETQ \PERIODIC.INTERRUPT.FREQUENCY 1))
		    (OFF (SETQ \PERIODIC.INTERRUPT)
			 (DEL.PROCESS (QUOTE \RS232.OUTPUTBROOM))
			 (SETQ \RS232BACKGROUNDSTATE)
			 (SETQ \RS232BACKGROUNDERRORSTATUS))
		    (\ILLEGAL.ARG ON?)))))

(\RS232.PERIODIC.FN
  (LAMBDA NIL                                                (* JonL "29-JUN-83 07:00")
    (if (RS232INTERRUPT?)
	then (SETQ \RS232BACKGROUNDERRORSTATUS (\RS232.PROCESSINTERRUPT (QUOTE NOERROR))))))

(\RS232EVENTFN
  (LAMBDA (DEVICE EVENT)                                     (* JonL "29-JUN-83 06:48")
    (if RS232INIT
	then (SELECTQ EVENT
		      ((BEFORESYSOUT BEFOREMAKESYS)
			(replace (RS232CHARACTERISTICS MODEMCONTROL) of RS232INIT
			   with (RS232MODEMCONTROL NIL))
			(if \RS232BACKGROUNDSTATE
			    then (RS232BACKGROUND (QUOTE OFF))
				 (SETQ \RS232BACKGROUNDSTATE T))
			(if (OR (NOT RS232XON\XOFF?)
				(NOT RS232SOFF?))
			    then (RS232FORCEOUTPUT))
			(if \RS232DLion?
			    then (DLTTYOUTWAIT)
				 (replace (DLTTYCSB notifyMask) of \DLionTTYPortCSB with 0)
				 (replace (DLTTYCSB outControl) of \DLionTTYPortCSB with 
										   OutControl.off)))
		      ((NIL AFTERSYSOUT AFTERMAKESYS)        (* Re-open the RS232 port)
			(APPLY (FUNCTION RS232INIT)
			       RS232INIT)
			(AND \RS232BACKGROUNDSTATE (RS232BACKGROUND (QUOTE ON))))
		      ((AFTERLOGOUT)                         (* If the RS232 port was open, then peek just to see if 
							     any characters were lost.)
			(APPLY (FUNCTION RS232PEEKBYTE)))
		      NIL))))
)
(DEFINEQ

(RS232MODEMCONTROL
  (LAMBDA NARGS                                              (* JonL "20-JUN-83 19:13")
    (PROG1 (SELECTC (if \RS232DLion?
			then (IPLUS (if (fetch (Parameters dataSetReady) of \DLionTTYPortCSB)
					then DTR
				      else 0)
				    (if (fetch (Parameters clearToSend) of \DLionTTYPortCSB)
					then RTS
				      else 0))
		      else (LOADBYTE (ISTROBE MODEMCONTROLREG)
				     0 8))
		    (0 NIL)
		    (DTR (QUOTE (DTR)))
		    (RTS (QUOTE (RTS)))
		    ((IPLUS DTR RTS)
		      (QUOTE (DTR RTS)))
		    (SHOULDNT))
	   (if (IGEQ NARGS 1)
	       then (PROG ((BITS (for X in (MKLIST (ARG NARGS 1)) sum (SELECTQ X
									       (DTR DTR)
									       (RTS RTS)
									       (\ILLEGAL.ARG X)))))
		          (if \RS232DLion?
			      then (replace (Parameters dataSetReady) of \DLionTTYPortCSB
				      with (BITTEST BITS DTR))
				   (replace (Parameters clearToSend) of \DLionTTYPortCSB
				      with (BITTEST BITS RTS))
				   (DLTTYPOKE setDSR&CTS)
			    else (OSTROBE MODEMCONTROLREG BITS)))))))

(RS232MODIFYMODEMCONTROL
  (LAMBDA (SIGNALSONLST SIGNALSOFFLST)                       (* JonL "29-JUN-83 04:08")
    (PROG ((INDEX 0))
          (for X in (PROG1 (RS232MODEMCONTROL)               (* Comment PPLossage)
			   )
	     do (SETQ INDEX (LOGOR (SELECTQ X
					    (DTR DTR)
					    (RTS RTS)
					    (\ILLEGAL.ARG X))
				   INDEX)))
          (for X in (MKLIST SIGNALSONLST) do (SETQ INDEX (LOGOR (SELECTQ X
									 (DTR DTR)
									 (RTS RTS)
									 (\ILLEGAL.ARG X))
								INDEX)))
                                                             (* In effect, this is doing set-union and 
							     set-intersection using only SMALLPs.)
          (for X in (MKLIST SIGNALSOFFLST) do (SETQ INDEX (LOGAND (SELECTQ
								    X
								    (DTR (CONSTANT (LOGNOT DTR)))
								    (RTS (CONSTANT (LOGNOT RTS)))
								    (\ILLEGAL.ARG X))
								  INDEX)))
          (RETURN (RS232MODEMCONTROL (SELECTC INDEX
					      (0 NIL)
					      (DTR (QUOTE (DTR)))
					      (RTS (QUOTE (RTS)))
					      ((LOGOR DTR RTS)
						(QUOTE (DTR RTS)))
					      (SHOULDNT)))))))

(RS232MODEMHANGUP
  (LAMBDA NIL                                                (* JonL "29-JUN-83 10:14")
    (OR (NULL (RS232MODEMSTATUSP (QUOTE DSR)))
	(RESETFORM (RS232MODEMCONTROL NIL)

          (* Wag the DTR signal down for at least 3 second -- modem should thus "hang up" on the guy.
	  The DSR signal should be "up" only when there is someone there.)


		   (during \RS232.LONGBREAK.tics usingTimer \RS232.TIMEOUT.BOX timerUnits
										(QUOTE TICKS)
		      when (NULL (RS232MODEMSTATUSP (QUOTE DSR))) do (RETURN T))))))

(RS232MODEMSTATUSP
  (LAMBDA (SPEC)                                             (* JonL "20-JUN-83 16:41")
    (PROG ((MSTAT (if \RS232DLion?
		      then                                   (* Do the rxRDY and txRDY fields in the DLion correspond
							     to anything like RI and/or RLSD -- JonL 6/19/83)
			   (IPLUS (if (fetch (ModemControl requestToSend) of \DLionTTYPortCSB)
				      then CTS
				    else 0)
				  (if (fetch (ModemControl dataTerminalReady) of \DLionTTYPortCSB)
				      then DSR
				    else 0))
		    else (LOADBYTE (ISTROBE MODEMSTATUSREG)
				   0 8))))
          (RETURN (if (NULL SPEC)
		      then (for B in (CONSTANT (LIST CTS DSR RI RLSD)) as NAME
			      in (QUOTE (CTS DSR RI RLSD)) join (AND (BITTEST MSTAT B)
								     (LIST NAME)))
		    else (\RS232.MSP1 SPEC MSTAT))))))

(\RS232.MSP1
  (LAMBDA (SPEC MSTAT)                                       (* JonL " 5-MAY-83 21:37")
    (if (LITATOM SPEC)
	then (BITTEST MSTAT (SELECTQ SPEC
				     (CTS CTS)
				     (DSR DSR)
				     (RI RI)
				     (RLSD RLSD)
				     (\ILLEGAL.ARG SPEC)))
      else (SELECTQ (CAR (LISTP SPEC))
		    (AND (AND (\RS232.MSP1 (CADR SPEC)
					   MSTAT)
			      (\RS232.MSP1 (CADDR SPEC)
					   MSTAT)))
		    (OR (OR (\RS232.MSP1 (CADR SPEC)
					 MSTAT)
			    (\RS232.MSP1 (CADDR SPEC)
					 MSTAT)))
		    (NOT (NOT (\RS232.MSP1 (CADR SPEC)
					   MSTAT)))
		    (\ILLEGAL.ARG SPEC)))))

(\RS232LINECONTROL
  (LAMBDA (VAL MASK)                                         (* JonL "10-MAY-83 17:00")
    (PROG ((OLDVAL (if \RS232DLion?
		       then (HELP)
		     else (ISTROBE LINECONTROLREG))))
          (if MASK
	      then (SETQ VAL (LOGOR (BITCLEAR OLDVAL MASK)
				    (LOGAND VAL MASK))))
          (if \RS232DLion?
	      then (HELP)
	    else (OSTROBE LINECONTROLREG (LOADBYTE VAL 0 8)))
          (RETURN OLDVAL))))
)



(* After initialization, RS232INIT holds a list of the actual args used)


(RPAQQ RS232INIT NIL)

(RPAQQ \RS232BACKGROUNDSTATE NIL)

(RPAQQ \RS232BACKGROUNDERRORSTATUS NIL)

(RPAQQ \RS232DEVICE NIL)

(RPAQQ \RS232STREAM NIL)

(RPAQ \RS232.TIMEOUT.BOX (SETUPTIMER 0))

(RPAQ \RS232.DING.BOX (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms 
	  \RS232.ByteIntervalCap.tics \RS232.Tovh&BIC2.tics \RS232.Tovh&BIC8.tics 
	  \RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms 
	  \RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP RS232INIT 
	  \RS232BACKGROUNDSTATE \RS232BACKGROUNDERRORSTATUS \RS232DEVICE \RS232STREAM 
	  \RS232.TIMEOUT.BOX \RS232.DING.BOX \RS232DLion?)
)



(* DLION RS232 stuff)


(RPAQ? \DLErrorBitsConversion NIL)

(RPAQ? \DLionTTYPortCSB NIL)

(RPAQ? \RS232DLionTTYP T)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \DLErrorBitsConversion \DLionTTYPortCSB \RS232DLionTTYP)
)
(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(BLOCKRECORD DLTTYCSB ((outData WORD)
		       (outControl WORD)
		       (inData WORD)
		       (inControl WORD)
		       (modemControl WORD)
		       (notifyMask WORD))
		      (BLOCKRECORD DLTTYCSB ((NIL 2 WORD)
				    (NIL BYTE)
				    (inChar BYTE))))

(ACCESSFNS Parameters (ParametersBase (LOCF (fetch (DLTTYCSB outData) of DATUM)))
		      (BLOCKRECORD ParametersBase ((onOff BITS 4)
				    (baudRate BITS 4)
				    (stopBits BITS 2)
				    (parity BITS 2)
				    (charLength BITS 2)
				    (clearToSend FLAG)
				    (dataSetReady FLAG))))

(ACCESSFNS InCharStatus (InCharStatusBase (LOCF (fetch (DLTTYCSB inControl) of DATUM)))
			(BLOCKRECORD InCharStatusBase ((charPresent? FLAG)
				      (NIL BITS 7)
				      (success FLAG)
				      (breakDetected FLAG)
				      (framingError FLAG)
				      (dataLost FLAG)
				      (parityError FLAG)
				      (NIL BITS 2)
				      (notReady FLAG))))

(ACCESSFNS ModemControl (ModemControlBase (LOCF (fetch (DLTTYCSB modemControl) of DATUM)))
			(BLOCKRECORD ModemControlBase ((NIL BITS 8)
				      (dataTerminalReady FLAG)
				      (NIL BITS 4)
				      (requestToSend FLAG)
				      (rxRDY FLAG)
				      (txRDY FLAG))))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS DLTTYOUTBUSY DMACRO (NIL
  (IGEQ (fetch (DLTTYCSB outControl) of \DLionTTYPortCSB)
	OutControl.putChar)))

(PUTPROPS DLTTYOUTWAIT MACRO (NIL
  (until (NOT (DLTTYOUTBUSY)))))

(PUTPROPS DLTTYPOKE MACRO (X
  (BQUOTE (PROGN (replace (DLTTYCSB outControl) of \DLionTTYPortCSB
		    with , (MKATOM (CONCAT "OutControl." (CAR X))))
		 ,
		 (if (NULL (CDR X))
		     then (QUOTE (DLTTYOUTWAIT)))))))
)

(DECLARE: EVAL@COMPILE 

(RPAQQ DLIOP.TTYCSB.OFFSET 81)

(CONSTANTS (DLIOP.TTYCSB.OFFSET 81))
)




(* Following for bits in outControl word of DLTTYCSB)


(DECLARE: EVAL@COMPILE 

(RPAQQ OutControl.putChar 32768)

(RPAQQ OutControl.setAllParameters 48897)

(RPAQQ OutControl.on 32771)

(RPAQQ OutControl.off 32772)

(RPAQQ OutControl.setDSR 33025)

(RPAQQ OutControl.setCTS 33281)

(RPAQQ OutControl.setDSR&CTS 33537)

(CONSTANTS (OutControl.putChar 32768)
	   (OutControl.setAllParameters 48897)
	   (OutControl.on 32771)
	   (OutControl.off 32772)
	   (OutControl.setDSR 33025)
	   (OutControl.setCTS 33281)
	   (OutControl.setDSR&CTS 33537))
)




(* Following for bits in inControl word of DLTTYCSB)


(DECLARE: EVAL@COMPILE 

(RPAQQ InControl.InterruptMask 32888)

(RPAQQ InControl.charPresent 32768)

(RPAQQ InControl.errorBits 120)

(RPAQQ InControl.breakDetected 64)

(RPAQQ InControl.framingError 32)

(RPAQQ InControl.dataLost 16)

(RPAQQ InControl.parityError 8)

(CONSTANTS (InControl.InterruptMask 32888)
	   (InControl.charPresent 32768)
	   (InControl.errorBits 120)
	   (InControl.breakDetected 64)
	   (InControl.framingError 32)
	   (InControl.dataLost 16)
	   (InControl.parityError 8))
)
)



(* Basic driver functions)

(DECLARE: EVAL@COMPILE 

(PUTPROPS RS232PEEKBYTE MACRO (NIL
  (PROGN                                                     (* This should be a canonical expansion of 
							     RS232PEEKBYTE.BACKUP)
	 (if (if \RS232DLion?
		 then (NEQ 0 (LOGAND 32888 (FFETCHFIELD (QUOTE (NIL 3 (BITS . 15)))
							\DLionTTYPortCSB)))
	       else (IGEQ (READPRINTERPORT)
			  32768))
	     then (\RS232.PROCESSINTERRUPT))
	 (if (NEQ \RS232IRING.READ \RS232IRING.WRITE)
	     then (\GETBASEBYTE \RS232IRINGBUF \RS232IRING.READ)))))

(PUTPROPS RS232READBYTE MACRO (X
                                                             (* This should be a canonical expansion of 
							     RS232READBYTE.BACKUP)
  (if X
      then (QUOTE IGNOREMACRO)
    else                                                     (* Take only easy case)
	 (QUOTE (PROGN (if (if \RS232DLion?
			       then (NEQ 0 (LOGAND 32888 (FFETCHFIELD (QUOTE (NIL 3 (BITS . 15)))
								      \DLionTTYPortCSB)))
			     else (IGEQ (READPRINTERPORT)
					32768))
			   then (\RS232.PROCESSINTERRUPT))
		       (if (NEQ \RS232IRING.READ \RS232IRING.WRITE)
			   then (\GETBASEBYTE \RS232IRINGBUF (PROG1 \RS232IRING.READ
								    (SETQ \RS232IRING.READ
								      (LOGAND (IPLUS \RS232IRING.READ 
										     1)
									      511))))))))))
)
(DEFINEQ

(RS232PEEKBYTE
  (LAMBDA NIL                                                (* JonL "25-OCT-82 19:17")
    (\MACRO.MX (RS232PEEKBYTE))))

(RS232LISTEN
  (LAMBDA NIL                                                (* JonL "23-JUN-83 21:06")
    (PROG NIL
      A   (if (RS232INTERRUPT?)
	      then                                           (* This should be just (SERVICEIRING) but the DLion may 
							     have numerous characters buffered up in the IOP)
		   (\RS232.PROCESSINTERRUPT)
		   (SELECTQ (MACHINETYPE)
			    (DANDELION (GO A))
			    NIL))
          (RETURN (IMOD (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
			\RS232RINGBUFFER.SIZE)))))

(RS232READBYTE
  (LAMBDA (WAIT? timerUnits)                                 (* JonL "18-MAY-83 21:07")
    (SERVICEIRING)
    (if (IRINGB.ATLEAST 1)
	then (POPRS232IRING)
      elseif (NOT (FIXP WAIT?))
	then (AND WAIT? (find BYTE suchthat (SETQ BYTE (RS232READBYTE 10000))))
      elseif (EQ (SETQ timerUnits (CANONICAL.TIMERUNITS timerUnits))
		 (QUOTE TICKS))
	then (during WAIT? timerUnits (QUOTE TICKS) usingTimer \RS232.TIMEOUT.BOX find FLG
		suchthat (PROG2 (SERVICEIRING)
				(SETQ FLG (IRINGB.ATLEAST 1)))
		finally (RETURN (if FLG
				    then (POPRS232IRING))))
      else 

          (* The idea here is that we break up the wait interval into lots of smaller chunks, in the case of large 
	  timerUnits, so that a BLOCK may be run if we have to wait too long.)


	   (to (IQUOTIENT (SELECTQ timerUnits
				   (MILLISECONDS WAIT?)
				   (SECONDS (ITIMES WAIT? 1000))
				   NIL)
			  \RS232.BLOCKINTERVAL.ms)
	      bind BYTE first (SERVICEIRING)
	      do                                             (* Admit BLOCKing only when timer units specify 
							     milliseconds or seconds.)
		 (\RS232CHECK.BLOCK)
		 (find old BYTE suchthat (SETQ BYTE (RS232READBYTE \RS232.BLOCKINTERVAL.tics
								   (QUOTE TICKS))))
		 (if BYTE
		     then (RETURN BYTE))))))

(RS232READWORD
  (LAMBDA (WAIT? timerUnits)                                 (* JonL "28-DEC-82 08:24")
    (SERVICEIRING)
    (PROG (HI LO)
          (if (NOT (AND (OR WAIT? (IRINGB.ATLEAST 2))
			(SETQ HI (RS232READBYTE WAIT? timerUnits))))
	      then                                           (* Well, not even first byte is here.)
		   (RETURN)
	    elseif (NULL (SETQ LO (RS232READBYTE WAIT? timerUnits)))
	      then                                           (* FOO! Didn't get both bytes in time, so put first one 
							     back.)
		   (PUSHRS232IRING HI)
		   (RETURN))
          (RETURN (create WORD
			  HIBYTE ← HI
			  LOBYTE ← LO)))))

(RS232WRITEBYTE
  (LAMBDA (BYTE FORCEOUT? IGNOREXOFF?)                       (* JonL "17-JUN-83 19:21")
    (SETQ BYTE (LOADBYTE BYTE 0 8))
    (PROG ((BUFFERSTARTSEMPTY (NOT (ORINGB.ATLEAST 1)))
	   BYTEHASBEENPUSHED LineStatusVal)
      A   (UNINTERRUPTABLY
              (SETQ LineStatusVal (\RS232DECODE.LINESTATUS LineStatusVal (QUOTE NOERROR)))
	      (if (LINESTATUSERRORSP LineStatusVal)
		  then                                       (* Foo, we just drop thru, and let the loop correct it.)
		       NIL
		elseif (AND BUFFERSTARTSEMPTY (NULL BYTEHASBEENPUSHED)
			    (OR FORCEOUT? (BITTEST LineStatusVal THRE))
			    (OR (NOT RS232XON\XOFF?)
				(NOT RS232XOFF?)
				IGNOREXOFF?))
		  then                                       (* If ring buffer is empty, and we aren't prohibited by 
							     XOFF, then just output the char.)
		       (if (OR (BITTEST LineStatusVal THRE)
			       (EQ T (SETQ LineStatusVal (\RS232CHECK.THRE))))
			   then (RS232DATAO BYTE)
				(SETQ LineStatusVal)
			 else (SETQ BYTEHASBEENPUSHED (PUSHRS232ORING BYTE))
			      (SETQ FORCEOUT? T))
		else                                         (* Otherwise, pack it into the output ring buffer 
							     (and maybe output 1 character from the buffer.))
		     (if (NOT BYTEHASBEENPUSHED)
			 then (SETQ BYTEHASBEENPUSHED (PUSHRS232ORING BYTE)))
		     (if (OR FORCEOUT? (ILEQ 2 (ORINGB.FREE)))
			 then                                (* Ah, no need to force output -- there's at least one 
							     slot left after storing the next BYTE)
			      (SETQ LineStatusVal)
		       elseif (AND RS232XON\XOFF? RS232XOFF? (NOT IGNOREXOFF?))
			 then                                (* Buffer's nearly full, but we can't send now due to 
							     XOFF)
			      (SETQ LineStatusVal (QUOTE RS232XOFF?))
		       elseif (OR (BITTEST LineStatusVal THRE)
				  (until (SETQ LineStatusVal (\RS232CHECK.THRE))
				     finally (RETURN (EQ T LineStatusVal))))
			 then                                (* Send out 1 character, in order to relieve strain on 
							     output ring buffer.)
			      (SETQ LineStatusVal)
			      (RS232DATAO (POPRS232ORING))
		       elseif (NULL LineStatusVal)
			 then                                (* Rare Losing case where we waited for the Transmitter,
							     but didn't get it. So just let the FORCEOUT? case handle
							     it.)
			      (SETQ FORCEOUT? T))))
          (if (FIXP LineStatusVal)
	      then                                           (* Foo, some error trying to get the line status 
							     register; so try it again after cleaning up.)
		   (AND (LINESTATUSERRORSP LineStatusVal)
			(SETQ LineStatusVal (\RS232DECODE.LINESTATUS LineStatusVal)))
		   (GO A)
	    elseif (OR (EQ LineStatusVal (QUOTE RS232XOFF?))
		       (AND FORCEOUT? (ORINGB.ATLEAST 1)))
	      then                                           (* Block here if we really need to transmit at least one
							     character, but transmission prohibited by XOFF)
		   (until (NOT (AND RS232XON\XOFF? RS232XOFF?)) do (\RS232CHECK.BLOCK))
		   (if (EQ LineStatusVal (QUOTE RS232XOFF?))
		       then (GO A)
		     else (RS232FORCEOUTPUT))
	    else (SERVICEIRING)
		 (if (AND BUFFERSTARTSEMPTY BYTEPHASBEENPUSHED \RS232BACKGROUNDSTATE)
		     then (NOTIFY.EVENT \RS232ORINGEVENT)
			  (SERVICEIRING))))
    BYTE))

(RS232SENDBREAK
  (LAMBDA (EXTRALONG?)                                       (* JonL "23-JUN-83 21:26")
    (SERVICEIRING)
    (SELECTQ (MACHINETYPE)
	     (DANDELION (HELP "MESA 8 can't do RS232 Break signal"))
	     NIL)
    (PROG (STATUS)
          (UNINTERRUPTABLY
              (\RS232LINECONTROL SBCB SBCB)
	      (during (if EXTRALONG?
			  then \RS232.LONGBREAK.tics
			else \RS232.SHORTBREAK.tics)
		 timerUnits (QUOTE TICKS) usingTimer \RS232.THRE.BOX
		 do                                          (* Just sit around doing nothing, but watching for input
							     and errors.)
		    (SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
		    (if (LINESTATUSERRORSP STATUS)
			then (RETURN))
		 finally (SETQ STATUS))
	      (\RS232LINECONTROL 0 SBCB))
          (if STATUS
	      then (\RS232DECODE.LINESTATUS STATUS)
	    else (SERVICEIRING))
          (RETURN T))))

(RS232FORCEOUTPUT
  (LAMBDA NIL                                                (* JonL "17-JUN-83 19:39")
                                                             (* Returns the number of characters found in the buffer,
							     which are written out "on the lines")
    ((LAMBDA (#BYTES OFFST)
	(if (ILESSP \RS232ORING.READ \RS232ORING.WRITE)
	    then 

          (* The hope is that the characters in the ring buffer will be put out on the lines before any other process can 
	  overwrite them by successive calls to RS232WRITEBYTE etc.)


		 (SETQ OFFST \RS232ORING.READ)
		 (SETQ #BYTES (IDIFFERENCE \RS232ORING.WRITE OFFST))
		 (SETQ \RS232ORING.READ \RS232ORING.WRITE)
		 (\RS232WRITEBASEBYTES NIL \RS232ORINGBUF OFFST #BYTES)
	  elseif (IGREATERP \RS232ORING.READ \RS232ORING.WRITE)
	    then                                             (* Buffer has wrapped around, so we have to split up the
							     write-out into two parts.)
		 (IPLUS (PROGN (SETQ OFFST \RS232ORING.READ)
			       (SETQ #BYTES (IDIFFERENCE \RS232RINGBUFFER.SIZE OFFST))
			       (SETQ \RS232ORING.READ 0)
			       (\RS232WRITEBASEBYTES NIL \RS232ORINGBUF OFFST #BYTES))
			(PROGN (SETQ #BYTES \RS232ORING.WRITE)
			       (SETQ \RS232ORING.READ \RS232ORING.WRITE)
			       (if (NEQ 0 #BYTES)
				   then (\RS232WRITEBASEBYTES NIL \RS232ORINGBUF 0 #BYTES)
				 else 0)))
	  else (SERVICEIRING)
	       0))
      0)))

(RS232CLEARBUFFER
  (LAMBDA (I/O)                                              (* JonL "23-JUN-83 21:26")
    (RS232INITIALIZECHECK)
    (PROG (OP STATUS FLUSHANY?)
          (until (SETQ OP (SELECTQ I/O
				   ((INPUT)
				     (QUOTE INPUT))
				   ((OUTPUT)
				     (QUOTE OUTPUT))
				   ((BOTH I/O)
				     (QUOTE BOTH))
				   ((IN I IRB IRING IRINGBUF)
				     (QUOTE INPUT))
				   ((OUT O ORB ORING ORINGBUF)
				     (QUOTE OUTPUT))
				   (if (EQ I/O \RS232IRINGBUF)
				       then (QUOTE INPUT)
				     elseif (EQ I/O \RS232ORINGBUF)
				       then (QUOTE OUTPUT))))
	     do (SETQ I/O (LISPERROR "ILLEGAL ARG" I/O T)))
          (if (FMEMB OP (QUOTE (OUTPUT BOTH)))
	      then (if \RS232DLion?
		       then                                  (* MESA 8 can't do RS232 Break signal)
		     else (\RS232LINECONTROL 0 SBCB))        (* Clear the "send BREAK" bit, just in case it had been 
							     set somehow.)
		   (UNINTERRUPTABLY
                       (AND (NEQ \RS232ORING.READ \RS232ORING.WRITE)
			    (SETQ FLUSHANY? T))
		       (SETQ \RS232ORING.READ (SETQ \RS232ORING.WRITE 0))
		       (SETQ STATUS (\RS232CHECK.THRE)))
		   (if (OR (EQ T STATUS)
			   (AND (FIXP STATUS)
				(BITTEST STATUS OE)
				(FMEMB OP (QUOTE (INPUT BOTH)))))
		       then (SETQ FLUSHANY? T)
		     elseif (NULL STATUS)
		       then (ERROR "Can't clear RS232 OUTPUT")))
          (if (FMEMB OP (QUOTE (INPUT BOTH)))
	      then (UNINTERRUPTABLY
                       (SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
                                                             (* Flush any possible pending information about input 
							     side errors)
		       (if (OR (BITTEST STATUS OE)
			       (NEQ \RS232IRING.READ \RS232IRING.WRITE))
			   then (SETQ FLUSHANY? T))
		       (SETQ \RS232IRING.READ (SETQ \RS232IRING.WRITE 0))))
          (RETURN FLUSHANY?))))
)



(* Block read and write functions)

(DEFINEQ

(RS232READLINE
  (LAMBDA (WAIT? timerUnits OLDSTRBUFFER)                    (* JonL " 7-MAY-83 21:40")
    (\RS232INSURE.LINEBUFFER 256)
    ((LAMBDA (STR)
	(if (AND STR (EQ (NTHCHARCODE STR -1)
			 (CHARCODE EOL)))
	    then                                             (* GLC in order to Strip off the EOL)
		 (GLC STR)
		 (UNINTERRUPTABLY
                     (if (EQ (CHARCODE LF)
			     (during \RS232.Tovh&BIC8.tics timerUnits (QUOTE TICKS) usingTimer 
									      \RS232.READLINE.BOX
				find CHAR suchthat (SETQ CHAR (RS232PEEKBYTE))))
			 then                                (* Waits about 8 character times, to see if the line 
							     will also have a LF after it.
							     (If so, it gets flushed.))
			      (POPRS232IRING)))
		 STR))
      (RS232READSTRING NIL (CHARCODE EOL)
		       NIL WAIT? timerUnits OLDSTRBUFFER))))

(RS232READSTRING
  (LAMBDA (#CHARS.LIMIT? STOPCODE? NOBLOCKSFLG WAIT? timerUnits OLDSTRBUFFER)
                                                             (* JonL "23-JUN-83 22:25")
    (SERVICEIRING)
    (SETQ #CHARS.LIMIT? (SMALLP #CHARS.LIMIT?))
    (OR (NULL STOPCODE?)
	(CHARCODEP STOPCODE?)
	(AND (LITATOM STOPCODE?)
	     (EQ 1 (NCHARS STOPCODE?))
	     (SETQ STOPCODE? (CHCON1 STOPCODE?)))
	(SETQ STOPCODE?))
    (SERVICEIRING)
    (if (AND (NULL (FIXP WAIT?))
	     (NULL #CHARS.LIMIT?)
	     (NULL STOPCODE?))
	then (HELP "No termination criteria?"))
    (PROG ((BOFFST 0)
	   BUFFER BUFFERSIZE #CHARS.READ)
          (SERVICEIRING)
          (if OLDSTRBUFFER
	      then (if (NOT (STRINGP OLDSTRBUFFER))
		       then (\ILLEGAL.ARG OLDSTRBUFFER))
		   (SETQ BUFFER (ffetch (STRINGP BASE) of OLDSTRBUFFER))
		   (SETQ BUFFERSIZE (ffetch (STRINGP LENGTH) of OLDSTRBUFFER))
		   (SETQ BOFFST (ffetch (STRINGP OFFST) of OLDSTRBUFFER))
		   (AND #CHARS.LIMIT? (SETQ #CHARS.LIMIT? (IMIN #CHARS.LIMIT? BUFFERSIZE)))
		   (SERVICEIRING)
	    else (if (OR (NULL \RS232LINEBUFFER.SIZE)
			 (AND (SMALLP #CHARS.LIMIT?)
			      (IGEQ #CHARS.LIMIT? \RS232LINEBUFFER.SIZE)))
		     then                                    (* Time-critical users had better make sure that this 
							     wing isn't taken.)
			  (\RS232INSURE.LINEBUFFER (ADD1 (OR (SMALLP #CHARS.LIMIT?)
							     (CONSTANT (IDIFFERENCE BYTESPERPAGE 50)))
							 ))
			  (SERVICEIRING))
		 (SETQ BUFFER \RS232LINEBUFFER)
		 (SETQ BUFFERSIZE \RS232LINEBUFFER.SIZE))
          (SETQ #CHARS.READ (\RS232READBASEBYTES NIL BUFFER BOFFST (OR #CHARS.LIMIT? BUFFERSIZE)
						 (QUOTE \RS232.BLOCKINTERVAL.BOX)
						 STOPCODE? NOBLOCKSFLG WAIT? timerUnits OLDSTRBUFFER))
          (RETURN (if OLDSTRBUFFER
		      then (replace (STRINGP LENGTH) of OLDSTRBUFFER with #CHARS.READ)
			   OLDSTRBUFFER
		    elseif (ZEROP #CHARS.READ)
		      then NIL
		    elseif (AND (IGEQ #CHARS.READ BUFFERSIZE)
				(NULL #CHARS.LIMIT?))
		      then (\RS232DECODE.LINESTATUS LBOE)
		    else (PROG1 (\GETBASESTRING BUFFER 0 #CHARS.READ)
				(SERVICEIRING)))))))

(\RS232READBASEBYTES
  (LAMBDA (STREAM BASE OFFST NBYTES CALLFROMREADSTRING.PASSWORD STOPCODE? NOBLOCKSFLG WAIT? 
		  timerUnits OLDSTRBUFFER)                   (* JonL "23-JUN-83 22:34")
    (SERVICEIRING)
    (PROG ((READSTRINGP (OR (EQ CALLFROMREADSTRING.PASSWORD (QUOTE \RS232.BLOCKINTERVAL.BOX))
			    (PROGN (SETQ STOPCODE?)
				   (SETQ NOBLOCKSFLG T)
				   (SETQ WAIT?)
				   (SETQ OLDSTRBUFFER)
				   NIL)))
	   (#CHARS 0)
	   (NBASE (\ADDBASE BASE OFFST))
	   (WAITFORBLOCK.BOX (AND (NOT NOBLOCKSFLG)
				  (SETUPTIMER \RS232.BLOCKINTERVAL.tics \RS232.BLOCKINTERVAL.BOX
					      (QUOTE TICKS))))
	   WAITFORBYTE.BOX CHAR)

          (* \RS232.BLOCKINTERVAL.BOX and \RS232.DELAY.BOX are scoped here -- formerly by GLOBALRESOURCE, but the GC 
	  reference counting took too long that way, so we just use local variables instead, counting on the fact that this 
	  isn't a re-entrant function.)


          (if (ILEQ NBYTES 0)
	      then (RETURN 0)
	    elseif (AND READSTRINGP WAIT?)
	      then (SETQ timerUnits (CANONICAL.TIMERUNITS timerUnits)))
      A   (SETQ CHAR (RS232READBYTE))
          (if (AND WAIT? (OR CHAR (NULL WAITFORBYTE.BOX)))
	      then (SETQ WAITFORBYTE.BOX (SETUPTIMER WAIT? WAITFORBYTE.BOX timerUnits)))
          (if CHAR
	      then (SETQ CHAR (LOADBYTE CHAR 0 BITSPERBYTE))
		   (\PUTBASEBYTE NBASE #CHARS CHAR)
		   (add #CHARS 1)
		   (if (OR (IGEQ #CHARS NBYTES)
			   (AND STOPCODE? (EQ CHAR STOPCODE?)))
		       then (SERVICEIRING)
			    (RETURN #CHARS))
	    elseif (AND WAIT? (PROG1 (TIMEREXPIRED? WAITFORBYTE.BOX timerUnits)
				     (SERVICEIRING)))
	      then (RETURN (if OLDSTRBUFFER
			       then #CHARS
			     else 0))
	    elseif (AND WAITFORBLOCK.BOX (TIMEREXPIRED? WAITFORBLOCK.BOX (QUOTE TICKS)))
	      then (\RS232CHECK.BLOCK)
		   (SETQ WAITFORBLOCK.BOX (SETUPTIMER \RS232.BLOCKINTERVAL.tics WAITFORBLOCK.BOX
						      (QUOTE TICKS))))
          (GO A))))

(\RS232INSURE.LINEBUFFER
  (LAMBDA (N)                                                (* JonL "11-MAY-83 21:43")
    (PROG1 (if (OR (NOT (SMALLPOSP \RS232LINEBUFFER.SIZE))
		   (NOT (type? ARRAYBLOCK \RS232LINEBUFFER))
		   (NOT (ILEQ N \RS232LINEBUFFER.SIZE)))
	       then (SETQ N (CEIL (IPLUS N BYTESPERCELL)
				  BYTESPERPAGE))             (* Add in a little fudge factor and round up to an 
							     integral number of pages, for LOCKPAGES purposes.)
		    ((LAMBDA (BUF)
			(SERVICEIRING)
			(UNINTERRUPTABLY
                            (AND (SMALLPOSP \RS232LINEBUFFER.SIZE)
				 (type? ARRAYBLOCK \RS232LINEBUFFER)
				 (\UNLOCKPAGES \RS232LINEBUFFER (\#PAGES.BASEBYTES \RS232LINEBUFFER 
									    \RS232LINEBUFFER.SIZE)))
                                                             (* Note that this UNLOCK is probably wrong, since the 
							     pages may want to be locked for reasons other than 
							     \RS232LINEBUFFER)
			    (\LOCKPAGES BUF (\#PAGES.BASEBYTES BUF N))
			    (SETQ \RS232LINEBUFFER BUF)
			    (SETQ \RS232LINEBUFFER.SIZE N)))
		      (\ALLOCBLOCK (FOLDHI N BYTESPERCELL)
				   NIL CELLSPERPAGE))
		    T)
	   (SERVICEIRING)
	   (\DTEST \RS232STRPTR (QUOTE STRINGP))
	   (UNINTERRUPTABLY
               (freplace (STRINGP BASE) of \RS232STRPTR with \RS232LINEBUFFER)
	       (freplace (STRINGP OFFST) of \RS232STRPTR with 0)
	       (freplace (STRINGP LENGTH) of \RS232STRPTR with \RS232LINEBUFFER.SIZE)))))
)

(RPAQQ \RS232LINEBUFFER NIL)

(RPAQQ \RS232LINEBUFFER.SIZE NIL)

(RPAQ \RS232.READLINE.BOX (SETUPTIMER 0))

(RPAQ \RS232.BLOCKINTERVAL.BOX (SETUPTIMER 0))

(RPAQ \RS232.DELAY.BOX (SETUPTIMER 0))

(RPAQ \RS232STRPTR (ALLOCSTRING 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232LINEBUFFER \RS232LINEBUFFER.SIZE \RS232.READLINE.BOX 
	  \RS232.BLOCKINTERVAL.BOX \RS232.DELAY.BOX \RS232STRPTR)
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS RS232WRITECHARS MACRO (=
   . RS232WRITESTRING))
)
(DEFINEQ

(RS232WRITESTRING
  (LAMBDA (STRING.OR.LITATOM FORCEOUTPUT?)                   (* JonL "17-JUN-83 19:38")
    (PROG ((BUFFERSTARTSEMPTY (NOT (ORINGB.ATLEAST 1)))
	   BASE #CHARS OFFST)
          (SERVICEIRING)
          (SELECTC (NTYPX STRING.OR.LITATOM)
		   (\STRINGP (SETQ BASE (fetch (STRINGP BASE) of STRING.OR.LITATOM))
			     (SETQ #CHARS (fetch (STRINGP LENGTH) of STRING.OR.LITATOM))
			     (SETQ OFFST (fetch (STRINGP OFFST) of STRING.OR.LITATOM))
			     T)
		   (\LITATOM (SETQ BASE (fetch (LITATOM PNAMEBASE) of STRING.OR.LITATOM))
			     (SETQ #CHARS (\GETBASEBYTE BASE 0))
			     (SETQ OFFST 1)
			     T)
		   (LISPERROR "ILLEGAL ARG" STRING.OR.LITATOM T))
          (if (NOT FORCEOUTPUT?)
	      then (bind (NCHARSLEFT ← #CHARS)
			 #BYTESMOVING
			 (MAX#BYTES.TO.MOVE ←(if (ILESSP \RS232Divisor 24)
						 then 128
					       elseif (ILESSP \RS232Divisor 48)
						 then 256
					       else 512))
		      while (IGREATERP NCHARSLEFT 0)
		      do (if (IGEQ NCHARSLEFT (ORINGB.FREE))
			     then 

          (* Even though the loser didn't want to forceoutput, we may have to do so in order to make room for the string to 
	  go into the buffer.)


				  (RS232FORCEOUTPUT))
			 (SERVICEIRING)
			 (UNINTERRUPTABLY
                             (SETQ #BYTESMOVING (IMIN (if (ILEQ \RS232ORING.READ \RS232ORING.WRITE)
							  then (IDIFFERENCE \RS232RINGBUFFER.SIZE 
									    \RS232ORING.WRITE)
							else (IDIFFERENCE \RS232ORING.READ
									  (ADD1 \RS232ORING.WRITE)))
						      NCHARSLEFT MAX#BYTES.TO.MOVE))

          (* At each step, we move only as many characters as are permitted by the remaining space in the output ring 
	  buffer, and such as can be \MOVEBYTES in a short time)


			     (\MOVEBYTES BASE OFFST \RS232ORINGBUF \RS232ORING.WRITE #BYTESMOVING)
			     (RINGB.INCREMENT \RS232ORING.WRITE #BYTESMOVING))
			 (SERVICEIRING)
			 (add OFFST #BYTESMOVING)
			 (add NCHARSLEFT (IMINUS #BYTESMOVING)))
		   (AND BUFFERSTARTSEMPTY (NOTIFY.EVENT \RS232ORINGEVENT))
	    else (if (ORINGB.ATLEAST 1)
		     then (RS232FORCEOUTPUT))
		 (\RS232WRITEBASEBYTES NIL BASE OFFST #CHARS))
          (RETURN #CHARS))))

(RS232WRITECHARS
  (LAMBDA (STRING.OR.LITATOM FORCEOUTPUT?)                   (* JonL "18-MAY-83 20:31")
    (RS232WRITESTRING STRING.OR.LITATOM FORCEOUTPUT?)))

(\RS232WRITEBASEBYTES
  (LAMBDA (STREAM BASE OFFST #BYTES)                         (* JonL "17-JUN-83 19:39")
                                                             (* Returns the number of bytes which are written out 
							     "on the lines")
    (bind STATUS (ITH ← 0) while (ILESSP ITH #BYTES)
       do                                                    (* You may not believe it, but the 
							     \RS232.MAX#BYTESPERLOOP is set so that interrupts are 
							     locked out for not more than \RS232.BLOCKINTERVAL.ms 
							     milliseconds.)
	  (UNINTERRUPTABLY
              (to \RS232.MAX#BYTESPERLOOP while (AND (ILESSP ITH #BYTES)
						     (EQ T (SETQ STATUS (\RS232CHECK.THRE)))
						     (OR (NOT RS232XON\XOFF?)
							 (NOT RS232XOFF?)))
		 do (RS232DATAO (\GETBASEBYTE BASE (IPLUS OFFST ITH)))
		    (add ITH 1))) 

          (* Since \RS232DECODE.LINESTATUS may generate an error, we can't call it under the UNINTERRUPTABLY -- also, we 
	  come out here if the THR isn't empty after 2 character times, and busy-wait a bit.)


	  (if (AND (FIXP STATUS)
		   (LINESTATUSERRORSP STATUS))
	      then (SETQ STATUS (\RS232DECODE.LINESTATUS STATUS)))
	  (\RS232CHECK.BLOCK))
    (SERVICEIRING)
    #BYTES))

(\RS232BOUTSTRING
  (LAMBDA (STREAM STRING)                                    (* JonL "22-NOV-82 23:12")
                                                             (* Foo, this could be done with a BOUTS, but we have to 
							     intersperse in the calls to SERVICEIRING)
    (for I from 1 eachtime (SERVICEIRING) do (BOUT STREAM (OR (NTHCHARCODE STRING I)
							      (RETURN))))
    (SERVICEIRING)))
)



(* Use of XON/XOFF protocols)


(RPAQ? RS232XON\XOFF? NIL)

(RPAQ? RS232XOFF? NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS RS232XON\XOFF? RS232XOFF?)
)



(* Check to see if Transmitter Holding Register is empty.)

(DEFINEQ

(\RS232CHECK.THRE
  (LAMBDA NIL                                                (* JonL "20-JUN-83 17:23")

          (* Waits for up to 2 character times for the Transmitter Holding Register to become Empty.
	  If any errors occur, then the status code is returned as an integer; otherwise return T if THR is empty and NIL if
	  it isn't empty.)


    (UNINTERRUPTABLY
        (during \RS232.Tovh&BIC2.tics bind ((STATUS ← NIL)) timerUnits (QUOTE TICKS)
	   usingTimer (PROG1 \RS232.THRE.BOX                 (* Comment PPLossage))
	   do (if (AND \RS232DLion? (NOT (DLTTYOUTBUSY))
		       (NOT (BITTEST (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB)
				     InControl.errorBits)))
		  then (RETURN T)
		else (SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
		     (if (LINESTATUSERRORSP STATUS)
			 then (RETURN STATUS)
		       elseif (BITTEST THRE STATUS)
			 then (RETURN T)))))))
)

(RPAQ? \RS232.THRE.BOX (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232.THRE.BOX)
)



(* Check to see if BLOCK can be called now)

(DEFINEQ

(\RS232CHECK.BLOCK
  (LAMBDA (WAIT?.ms)                                         (* JonL " 3-JAN-83 04:52")
                                                             (* Returns non-NIL iff it actually does a BLOCK)
    (DECLARE (GLOBALVARS \LastWindowButtons)
	     (SPECVARS \INTERRUPTABLE))
    (PROG1 (if (PROG2 (SERVICEIRING)
		      (NOT \INTERRUPTABLE)
		      (SERVICEIRING))
	       then                                          (* Super-cautious, since the FreeVar lookup of 
							     \INTERRUPTABLE may take a long time)
		    NIL
	     elseif (NULL WAIT?.ms)
	       then (if (OR (OR (KEYDOWNP (QUOTE LEFT))
				(KEYDOWNP (QUOTE MIDDLE))
				(KEYDOWNP (QUOTE RIGHT)))
			    (KEYDOWNP (QUOTE BLANK-TOP)))
			then (SERVICEIRING)                  (* Well, one last chance before going into a long 
							     blocked phase!)
			     (SETQ \LastWindowButtons)       (* Darned WINDOW.MOUSE.HANDLER has a wedged idea of when
							     to run the menu function.)
			     (BLOCK)
			     (if \LastWindowButtons
				 then                        (* If WINDOW.MOUSE.HANDLER reset this, then it failed to
							     run DOWINDOWCOM so try once more!)
				      (SERVICEIRING)
				      (SETQ \LastWindowButtons)
				      (BLOCK))
			     T)
	     else (during (PROG1 WAIT?.ms                    (* Comment PPLossage)) resourceName
										     \RS232.ADMIT.BOX
		     bind FLG do (AND (\RS232CHECK.BLOCK)
				      (SETQ FLG T))
		     finally (RETURN FLG)))
	   (SERVICEIRING))))
)

(RPAQQ \RS232.ADMIT.BOX NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232.ADMIT.BOX)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(PUTDEF (QUOTE \RS232.ADMIT.BOX)
	(QUOTE GLOBALRESOURCES)
	(QUOTE (SETUPTIMER 0)))
)



(* Debugging aids)

(DEFINEQ

(RS232DUMPBUFFER
  (LAMBDA (I/O.BUF N M)                                      (* JonL " 3-JAN-83 04:19")
    (OR (EQ I/O.BUF \RS232IRINGBUF)
	(EQ I/O.BUF \RS232ORINGBUF)
	(if (FMEMB I/O.BUF (QUOTE (INPUT IN I IRB IRING IRINGBUF NIL)))
	    then (SETQ I/O.BUF \RS232IRINGBUF)
	  elseif (FMEMB I/O.BUF (QUOTE (OUTPUT OUT O ORB ORING ORINGBUF)))
	    then (SETQ I/O.BUF \RS232ORINGBUF)
	  else (LISPERROR "ILLEGAL ARG" I/O.BUF)))
    (RS232INITIALIZECHECK)
    (if (AND (NULL N)
	     (NULL M))
	then (if (EQ I/O.BUF \RS232IRINGBUF)
		 then (SETQ N \RS232IRING.READ)
		      (SETQ M \RS232IRING.WRITE)
	       else (SETQ N \RS232ORING.READ)
		    (SETQ M \RS232ORING.WRITE))
      elseif (AND (SMALLP N)
		  (IGEQ N 0)
		  (ILESSP N \RS232RINGBUFFER.SIZE)
		  (NULL M))
	then (SETQ M (SUB1 N))
      else (ERROR "Bad range indices" (LIST N M)))
    (for I from (PROG1 0                                     (* Comment PPLossage))
       bind (STR ←(ALLOCSTRING (IMOD (IDIFFERENCE M N)
				     \RS232RINGBUFFER.SIZE)
			       (QUOTE #)))
       until (EQ N M)
       do (AND (NEQ 0 (\GETBASEBYTE I/O.BUF N))
	       (RPLCHARCODE STR I (\GETBASEBYTE I/O.BUF N)))
	  (RINGB.INCREMENT N 1)
       finally (RETURN STR))))

(\D0RS232DUMP
  (LAMBDA NIL                                                (* JonL " 9-MAY-83 22:01")
    (for REGNAME N in (QUOTE (InterruptEnable InterruptID LineControl ModemControl LineStatus 
					      ModemStatus))
       as I from 1 do (printout T T REGNAME "Register [" I "]" 28 " =  " .I8.-2
				(SETQ N (LOADBYTE (ISTROBE I)
						  0 8))
				"B,  " .I3.-8 N "Q")
       finally (printout T T "ReceiveBufferRegister [0]" 28 " =  " .I8.-2 (SETQ N
			   (LOADBYTE (ISTROBE DATAREG)
				     0 8))
			 "B,  " .I3.-8 N "Q"))
    (RESETFORM (\RS232LINECONTROL DLAB)
	       (printout T T "DivisorLatchRegister " 28 " =   " .I4.10 (DEPOSITBYTE (ISTROBE 
										    LOWDIVISORREG)
										    8 8 (ISTROBE
										      HIDIVISORREG))
			 "D"))
    (TERPRI T)))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA )

(ADDTOVAR NLAML )

(ADDTOVAR LAMA RS232MODEMCONTROL)
)
(PUTPROPS RS232 COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (9238 9561 (ORDINALSUFFIXSTRING 9248 . 9559)) (10545 12905 (\#PAGES.BASEBYTES 10555 . 
10831) (\FRESHENUPFN 10833 . 11623) (\ONPATHS.CCODE 11625 . 12903)) (22396 28942 (
\RS232.PROCESSINTERRUPT 22406 . 25173) (\RS232.DATAREADY 25175 . 26052) (\RS232DECODE.LINESTATUS 26054
 . 28188) (\RS232.OUTPUTBROOM 28190 . 28940)) (29475 30998 (\RS232DING 29485 . 30996)) (32325 44846 (
RS232INIT 32335 . 41870) (\RS232UNLOCKBUF 41872 . 42575) (RS232BACKGROUND 42577 . 43440) (
\RS232.PERIODIC.FN 43442 . 43681) (\RS232EVENTFN 43683 . 44844)) (44847 49795 (RS232MODEMCONTROL 44857
 . 46011) (RS232MODIFYMODEMCONTROL 46013 . 47172) (RS232MODEMHANGUP 47174 . 47754) (RS232MODEMSTATUSP 
47756 . 48676) (\RS232.MSP1 48678 . 49318) (\RS232LINECONTROL 49320 . 49793)) (55369 66224 (
RS232PEEKBYTE 55379 . 55527) (RS232LISTEN 55529 . 56076) (RS232READBYTE 56078 . 57491) (RS232READWORD 
57493 . 58191) (RS232WRITEBYTE 58193 . 61750) (RS232SENDBREAK 61752 . 62724) (RS232FORCEOUTPUT 62726
 . 64211) (RS232CLEARBUFFER 64213 . 66222)) (66268 73005 (RS232READLINE 66278 . 67196) (
RS232READSTRING 67198 . 69433) (\RS232READBASEBYTES 69435 . 71459) (\RS232INSURE.LINEBUFFER 71461 . 
73003)) (73532 77787 (RS232WRITESTRING 73542 . 75845) (RS232WRITECHARS 75847 . 76019) (
\RS232WRITEBASEBYTES 76021 . 77343) (\RS232BOUTSTRING 77345 . 77785)) (78038 79032 (\RS232CHECK.THRE 
78048 . 79030)) (79204 80820 (\RS232CHECK.BLOCK 79214 . 80818)) (81078 83214 (RS232DUMPBUFFER 81088 . 
82390) (\D0RS232DUMP 82392 . 83212)))))
STOP