(FILECREATED " 8-Nov-84 21:39:08" {ERIS}<LISP>FUGUE.6>LIBRARY>HARMONYRS232>RS232.;2
 143667 

      changes to:  (FNS \RS232.CREATEFDEV)

      previous date: " 5-Nov-84 22:25:17" {ERIS}<LISPCORE>LIBRARY>RS232.;61)


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

(PRETTYCOMPRINT RS232COMS)

(RPAQQ RS232COMS
 ((LOCALVARS . T)
	(COMS (* "Remove this KLUDGE!")
	      (VARS (\KLUDGY.SEGMENT0SPACE.FOR.IOCB (\ADDBASE \IOCBPAGE 120)))
	      (GLOBALVARS \KLUDGY.SEGMENT0SPACE.FOR.IOCB))
	(COMS (* "Generally useful tools.")
	      (FNS ORDINALSUFFIXSTRING)
	      (DECLARE: DONTCOPY (MACROS #ARRAYBLOCKBYTES SIZEF BITSADD_)
			(CONSTANTS DLionMStoTICKS))
	      (FNS \#PAGES.BASEBYTES \FRESHENUPFN \ONPATHS.CCODE)
	      (CONSTANTS ACTIVE.EM)
	      (COMS (FNS \FASTMOVEBYTES \FASTMOVEBYTES.SETUP)
		    (DECLARE: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY (VARS (\RIPPL.PBBT (
\FASTMOVEBYTES.SETUP))))
		    (GLOBALVARS \RIPPL.PBBT)
		    (P (PUTD (QUOTE \FASTMOVEBYTES.SETUP)))))
	(INITVARS (RS232DLionTTYP T)
		  (\BusyWait.BOX (SETUPTIMER 0)))
	(* "Until we flush the TTYPort, make it the standard on the DLion.")
	(PROP GLOBALVAR RS232DLionTTYP)
	(GLOBALVARS \BusyWait.BOX)
	(COMS (* "DLion TTYPort stuff")
	      (ARRAY \DLErrorBitsConversion)
	      (INITVARS (\DLionTTYOutLoc NIL)
			(\DLionTTYCommandLoc NIL)
			(\DLionTTYInLoc NIL))
	      (GLOBALVARS \DLErrorBitsConversion \DLionTTYOutLoc \DLionTTYCommandLoc)
	      (PROP GLOBALVAR \DLionTTYInLoc)
	      (* "Because of the public macros on RS232PEEKBYTE and RS232READBYTE")
	      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DLTTYInCSB DLTTYOutCSB DLTTYOutCommand)
			(MACROS DLTTYOUTBUSY DLTTYPORTPOKE)
			(CONSTANTS DLTtyCommand.putChar DLTtyCommand.abortPut DLTtyOutParameter.on 
				   DLTtyOutParameter.off)
			(CONSTANTS OutControl.on OutControl.off OutControl.abortPut 
				   OutControl.breakOn (OutControl.breakOff 34560)
				   OutControl.setDSR OutControl.setCTS OutControl.setDSR&CTS 
				   OutControl.setAllParameters)
			(CONSTANTS InControl.InterruptMask InControl.charPresent InControl.errorBits)
			(* 
		    "Following bits are remnants of Domino.8 days, but are useful in many places")
			(CONSTANTS OutControl.putChar)
			(CONSTANTS InControl.breakDetected InControl.framingError InControl.dataLost 
				   InControl.parityError))
	      (FNS \DLTTYPORT.DOCOMMAND \DLTTYPORT.BUSYWAIT))
	(COMS (* "DLION RS232C stuff")
	      (DECLARE: EVAL@COMPILE (* Comment PPLossage)
			DONTCOPY
			(RECORDS DLRS232iopHardwareConfig DLRS232CMD DLIOPPAGECSBEXTRAS)
			(P (OR (EQ (INDEXF (fetch (DLRS232iopHardwareConfig rs232CAbsent)
						  of T))
				   (INDEXF (fetch (IOPAGE DLIOPHARDWARECONFIG)
						  of T)))
			       (ERROR 
			  "RS232C rs232CAbsent location wrong in DLRS232iopHardwareConfig record"))
			   (OR (EQ (INDEXF (fetch (DLRS232CMD iopMiscBusy)
						  of T))
				   (INDEXF (fetch (IOPAGE DLRS232CMISCCOMMAND)
						  of T)))
			       (ERROR "RS232C Misc Command location wrong in DLRS232CMD record")))
			(RECORDS DLRS232CIOCB DLRS232CiopParameterCSB)
			(MACROS DLRS232CMDBUSY DLRS232CMDWAIT DLRS232POKE 
				DLRS232CSETPARAMETERSUCCESS?)
			(PROP ARGNAMES DLRS232POKE DLRS232CMDWAIT)
			(CONSTANTS RS232C.asynchronous RS232C.correspondentTTYHOST)
			(* 
	       "Note that all these command constants have bit 2^15 on, which is the 'busy' bit.")
			(CONSTANTS IopCommand.on IopCommand.off IopCommand.breakOn 
				   IopCommand.breakOff IopCommand.abortInput IopCommand.abortOutput 
				   IopCommand.getStatus IopCommand.majorSetParameters 
				   IopCommand.minorSetParameters)
			(CONSTANTS IopDeviceStatus.ringIndicator IopDeviceStatus.carrierDetect 
				   IopDeviceStatus.dataLost IopDeviceStatus.breakDetected 
				   IopDeviceStatus.dataSetReady IopDeviceStatus.clearToSend))
	      (* "Following two guys are here because I want all 'locked' vars near each other.")
	      (INITVARS (\RS232DLion? NIL)
			(\RS232DLionRS232C? NIL))
	      (PROP GLOBALVAR \RS232DLion? \RS232DLionRS232C?)
	      (INITVARS (\DLionRS232CParameterCSB NIL)
			(\DLionRS232CputIOCB NIL)
			(\DLionRS232CgetIOCB NIL)
			(\RS232C.IOCBdataLength 64)
			(\RS232C.BACKGROUNDSTATUS.FREQUENCY 1)
			(\RS232C.BACKGROUNDSTATUS.COUNTER 0)
			(\RS232C.PUTTIMER NIL)
			(\RS232C.INTERPUTINTERVAL.ticks NIL)
			(\RS232C.PERIODIC.BOX (SETUPTIMER 0)))
	      (GLOBALVARS \DLionRS232CParameterCSB \DLionRS232CputIOCB \DLionRS232CgetIOCB 
			  \RS232C.IOCBdataLength \RS232C.BACKGROUNDSTATUS.FREQUENCY 
			  \RS232C.BACKGROUNDSTATUS.COUNTER \RS232C.PUTTIMER 
			  \RS232C.INTERPUTINTERVAL.ticks \RS232C.PERIODIC.BOX)
	      (FNS \RS232C.FILLINIOCB \RS232C.GETERRORSTATUS \RS232C.DOCOMMAND \RS232C.BUSYWAIT))
	(DECLARE: DONTCOPY (MACROS RS232INITIALIZECHECK RS232INTERRUPT? RS232STATUSIN 
				   RS232MODEMSTATUSIN RS232MODEMCONTROLIN RS232MODEMCONTROLSET)
		  (MACROS RS232DATAI RS232DATAO))
	(COMS (* "buffer management")
	      (* * "Chars to and from the UART may be stored in ring buffers." 
       "Note that the 'write' indices point to 1 slot beyond the active data, whereas the 'read'"
		 
    " 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)
			(\RS232IRING.SIZE 1023)
			(\RS232IRING.READ 0)
			(\RS232IRING.WRITE 0)
			(\RS232ORINGBUF NIL)
			(\RS232ORING.SIZE 511)
			(\RS232ORING.READ 0)
			(\RS232ORING.WRITE 0)
			(\RS232ORINGEVENT (CREATE.EVENT "RS232OutputStartup")))
	      (PROP GLOBALVAR \RS232IRINGBUF \RS232IRING.SIZE \RS232IRING.READ \RS232IRING.WRITE 
		    \RS232ORINGBUF \RS232ORING.SIZE \RS232ORING.READ \RS232ORING.WRITE 
		    \RS232ORINGEVENT)
	      (DECLARE: DONTCOPY EVAL@COMPILE
			(MACROS SERVICEIRING CHECKUART RINGB.INCREMENT PUSHRS232IRING POPRS232IRING 
				PUSHRS232ORING POPRS232ORING IRINGB.USED IRINGB.ATLEAST IRINGB.FREE 
				ORINGB.USED ORINGB.ATLEAST ORINGB.FREE WITHOUTRS232PERIODICFN 
				BACKGROUND? LINESTATUSERRORBITS LINESTATUSERRORSP CHECKDATAREADY 
				RS232PEEKBYTE.BACKUP RS232READBYTE.BACKUP)
			(VARS RS232BACKGROUNDLOCKEDFNS RS232BACKGROUNDIGNOREFNS 
			      RS232BACKGROUNDLOCKEDVARS))
	      (FNS \RS232.CHECKUART \RS232.DATAREADY \RS232.PERIODIC.FN \RS232.PROCESSINTERRUPT 
		   \RS232DECODE.LINESTATUS \RS232.OUTPUTBROOM \RS232.SERVICEORING 
		   \RS232C.PROCESSINTERRUPT \RS232C.PERIODIC.FN)
	      (VARS (\RS232BACKGROUNDSTATE NIL)
		    (\RS232BACKGROUNDERRORSTATUS NIL))
	      (FNS RS232BACKGROUND)
	      (GLOBALVARS \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY \RS232BACKGROUNDSTATE 
			  \RS232BACKGROUNDERRORSTATUS))
	(COMS (* "Various parameters installed by RS232INIT")
	      (INITVARS (\RS232DefaultBaudRate 1200)
			(\RS232DefaultBLOCKINTERVAL.ms 250))
	      (* "After initialization, RS232INIT holds a list of the actual args used.")
	      (VARS (RS232INIT NIL)
		    (\RS232DEVICE NIL)
		    (\RS232STREAM NIL)
		    (\RS232.TIMEOUT.BOX (SETUPTIMER 0))
		    (\RS232.DING.BOX (SETUPTIMER 0)))
	      (INITVARS \RS232Divisor \RS232.ByteIntervalCap.ms \RS232.ByteIntervalCap.tics 
			\RS232.Tovh&BIC4.tics \RS232.Tovh&BIC16.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: DONTCOPY (RECORDS RS232CHARACTERISTICS))
	      (FNS RS232INIT RS232SHUTDOWN \RS232.D0INIT \RS232.DLINIT \RS232UNLOCKBUF \RS232EVENTFN 
		   \RS232.CREATEFDEV \RS232OPENFILE \RS232REOPENFILE)
	      (GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms 
			  \RS232.ByteIntervalCap.tics \RS232.Tovh&BIC4.tics \RS232.Tovh&BIC16.tics 
			  \RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms 
			  \RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP 
			  RS232INIT \RS232DEVICE \RS232STREAM \RS232.TIMEOUT.BOX \RS232.DING.BOX))
	(COMS (* "Basic driver functions")
	      (MACROS RS232PEEKBYTE RS232READBYTE)
	      (FNS RS232PEEKBYTE RS232LISTEN RS232READBYTE RS232READWORD RS232WRITEBYTE 
		   RS232FORCEOUTPUT)
	      (* Block read and write functions)
	      (FNS RS232READLINE RS232READSTRING \RS232READBASEBYTES \RS232INSURE.LINEBUFFER 
		   RS232INPUTSTRING)
	      (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))
	(COMS (* "Modem controls")
	      (FNS RS232XON\XOFF? RS232MODEMCONTROL RS232MODIFYMODEMCONTROL RS232MODEMHANGUP 
		   RS232MODEMSTATUSP \RS232.MSP1 \RS232LINECONTROL)
	      (PROP ARGNAMES RS232MODEMCONTROL)
	      (* "Use of XON/XOFF protocols")
	      (INITVARS (RS232XON\XOFF? NIL)
			(RS232XOFF? NIL))
	      (PROP GLOBALVAR RS232XON\XOFF? RS232XOFF?)
	      (DECLARE: EVAL@COMPILE DONTCOPY (MACROS CHECKTHRE_))
	      (* "Is Transmitter 
					       Holding Register empty?")
	      (FNS \RS232CHECK.THRE)
	      (INITVARS (\RS232.THRE.BOX (SETUPTIMER 0))
			(\RS232.ADMIT.BOX (SETUPTIMER 0)))
	      (GLOBALVARS \RS232.THRE.BOX \RS232.ADMIT.BOX)
	      (* "Can BLOCK be 
					       called now?")
	      (FNS \RS232CHECK.BLOCK))
	(COMS (* * 
  "Functional interface for what to do if a character is dropped, or a break signal is received.")
	      (INITVARS (RS232LOSTCHARFN (QUOTE \RS232DING))
			(RS232DEVICEERRORFN (FUNCTION \RS232.DEVICEERROR))
			(RS232BREAKFN NIL))
	      (GLOBALVARS RS232LOSTCHARFN RS232DEVICEERRORFN RS232BREAKFN)
	      (FNS \RS232DING \RS232.DEVICEERROR \RS232STABLIZE)
	      (INITVARS (RS232BREAKSEEN? NIL)
			(\RS232.DROPPEDCHARACTER.CODE (CHARCODE #^G))
			(\RS232DING.BOX (SETUPTIMER 0))
			(\RS232STABLIZE.BOX (SETUPTIMER 0)))
	      (GLOBALVARS RS232BREAKSEEN? \RS232.DROPPEDCHARACTER.CODE \RS232DING.BOX 
			  \RS232STABLIZE.BOX)
	      (FNS RS232SENDBREAK \RS232.DOBREAK RS232CLEARBUFFER))
	(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 THROE DE)
		  (* * "Line Status Register bits, but RBOE LBOE and THROE are my own" 
		     " software RingBuffer LineBuffer and TransmittingHoldingRegister"
		     " overflow indicators.  DE is for DLion RS232C disaster error.")
		  (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)
		  (MACROS TO.REGISTER ISTROBE OSTROBE INS8250RESET))
	(COMS (* Debugging aids)
	      (FNS RS232DUMPBUFFER \D0RS232DUMP))
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML)
									      (LAMA RS232MODEMCONTROL)
									      ))))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)



(* "Remove this KLUDGE!")



(RPAQ \KLUDGY.SEGMENT0SPACE.FOR.IOCB
 (\ADDBASE \IOCBPAGE 120))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \KLUDGY.SEGMENT0SPACE.FOR.IOCB)
)



(* "Generally useful tools.")


(DEFINEQ

(ORDINALSUFFIXSTRING

  (LAMBDA (N)                                                (* JonL " 5-JAN-83 23:54")

    (SETQ N (IABS N))
    (COND
      ((AND (ILEQ 5 N)
	    (ILEQ N 20))
	"th")
      (T (SELECTC (SETQ N (IREMAINDER N 10))
		  (1 "st")
		  (2 "nd")
		  (3 "rd")
		  "th")))))
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS #ARRAYBLOCKBYTES DMACRO 
((X)
                                                             (* Warning! X must be certified as an ARRAYBLOCK before 

							     using this macro)

  (UNFOLD (IDIFFERENCE (fetch
 (ARRAYBLOCK ARLEN) of
 (\ADDBASE X (IMINUS \ArrayBlockHeaderWords)))
		       (FOLDHI \ArrayBlockOverheadWords WORDSPERCELL))
	  BYTESPERCELL)))

(PUTPROPS SIZEF MACRO 
(X
  (PROG ((RECORDNAME (CAR X))
	 FORM)
        (SETQ FORM (EXPANDMACRO (BQUOTE (LOCF (fetch
 , (MKATOM (CONCAT RECORDNAME (QUOTE .lastField)))
						 of
 T)))
				T))
        (OR (AND (EQ (CAR (LISTP FORM))
		     (QUOTE \ADDBASE))
		 (FIXP (CADDR FORM)))
	    (ERROR X "Bad form"))
        (RETURN (CADDR FORM)))))

(PUTPROPS BITSADD_ MACRO 
((VAR VAL)
                                                             (* VAR should be a variable holding a FIXP 

							     (or NIL) and VAL should be a fixp which is LOGOR'd into 

							     VAR)

  (SETQ VAR (LOGOR (OR (FIXP VAR)
		       0)
		   VAL))))
)

(DECLARE: EVAL@COMPILE 

(RPAQQ DLionMStoTICKS
 34)

(CONSTANTS DLionMStoTICKS)
)
)
(DEFINEQ

(\#PAGES.BASEBYTES

  (LAMBDA (BASE OFFST)                                       (* JonL "27-May-84 01:35")


          (* * Calculate the number of pages represented by an address and a byte offset.)



    (ADD1 (IDIFFERENCE (fetch
 (POINTER PAGE#) of
 (\ADDBASE BASE (FOLDLO (SUB1 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))
          (COND
	    ((thereis
 X in
 BASISFNSLST suchthat
 (OR (NOT (CCODEP X))
						    (FMEMB X IGNOREFNSLST)))
	      (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))))
          (COND
	    (SOFAR                                           (* 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))
		   (COND
		     ((ILESSP 0 (add
 TOWHATDEPTH? -1))
		       (GO A)))))
          (RETURN RESULTS))))
)
(DECLARE: EVAL@COMPILE 

(RPAQQ ACTIVE.EM
 299)

(CONSTANTS ACTIVE.EM)
)
(DEFINEQ

(\FASTMOVEBYTES

  (LAMBDA (SBASE SBYTE DBASE DBYTE NBYTES)                   (* JonL "31-Oct-84 20:53")

    ((LAMBDA (SOURCEADDR DESTADDR BACKWARDP)
	(
AND
 (
SETQ
 BACKWARDP (
AND
 (
NOT
 (PTRGTP SOURCEADDR DESTADDR))
				  (
NOT
 (PTRGTP DESTADDR (
\ADDBASE
 SBASE (FOLDHI (
IPLUS
 SBYTE NBYTES 
										       -1)
										BYTESPERWORD))))))
	     (
SELECTC
 \MACHINETYPE
		      (\DORADO T)
		      NIL)
	     (
ERROR
 "Can't BitBlt backwards on a Dorado yet"))
	(UNINTERRUPTABLY                                     (* Comment PPLossage)

	    (replace
 PBTSOURCE of
 \RIPPL.PBBT with
 SOURCEADDR)
	    (replace
 PBTSOURCEBIT of
 \RIPPL.PBBT with
 (if
 (
ODDP
 SBYTE)
							  then
 BITSPERBYTE
							else
 0))
	    (replace
 PBTDEST of
 \RIPPL.PBBT with
 DESTADDR)
	    (replace
 PBTDESTBIT of
 \RIPPL.PBBT with
 (if
 (
ODDP
 DBYTE)
							then
 BITSPERBYTE
						      else
 0))
	    (replace
 PBTWIDTH of
 \RIPPL.PBBT with
 (UNFOLD NBYTES BITSPERBYTE))
	    (replace
 PBTBACKWARD of
 \RIPPL.PBBT with
 BACKWARDP)
	    (\PILOTBITBLT \RIPPL.PBBT)))
      (
\ADDBASE
 SBASE (FOLDLO SBYTE BYTESPERWORD))
      (
\ADDBASE
 DBASE (FOLDLO DBYTE BYTESPERWORD)))))

(\FASTMOVEBYTES.SETUP

  (LAMBDA NIL                                                (* JonL "20-Jun-84 20:54")

                                                             (* PBTOPERATION of 0 is REPLACE;

							     PBTSOURCETYPE of 0 is non-inverted)

    (SETQ \RIPPL.PBBT
      (create
 PILOTBBT
	      PBTHEIGHT _ 1
	      PBTSOURCEBPL _ 0
	      PBTDESTBPL _ 0
	      PBTOPERATION _ 0
	      PBTSOURCETYPE _ 0))))
)
(DECLARE: DONTEVAL@LOAD DONTEVAL@COMPILE DOCOPY 

(RPAQ \RIPPL.PBBT
 (\FASTMOVEBYTES.SETUP))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RIPPL.PBBT)
)
(PUTD (QUOTE \FASTMOVEBYTES.SETUP))

(RPAQ? RS232DLionTTYP
 T)

(RPAQ? \BusyWait.BOX
 (SETUPTIMER 0))



(* "Until we flush the TTYPort, make it the standard on the DLion.")



(PUTPROPS RS232DLionTTYP GLOBALVAR 
T)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \BusyWait.BOX)
)



(* "DLion TTYPort stuff")



(RPAQ \DLErrorBitsConversion (READARRAY 16 (QUOTE BYTE) 0))
(0 4 2 6 8 12 10 14 16 20 18 22 24 28 26 30 NIL
)

(RPAQ? \DLionTTYOutLoc
 NIL)

(RPAQ? \DLionTTYCommandLoc
 NIL)

(RPAQ? \DLionTTYInLoc
 NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \DLErrorBitsConversion \DLionTTYOutLoc \DLionTTYCommandLoc)
)

(PUTPROPS \DLionTTYInLoc GLOBALVAR 
T)



(* "Because of the public macros on RS232PEEKBYTE and RS232READBYTE")


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

(BLOCKRECORD DLTTYInCSB
 ((InControl WORD)
			 (inData BYTE)
			 (dataTerminalReady FLAG)
			 (NIL BITS 4)
			 (requestToSend FLAG)
			 (rxRDY FLAG)
			 (txRDY FLAG))                       (* Following just elaborates the InControl word)

			(BLOCKRECORD DLTTYInCSB ((charPresent FLAG)
				      (NIL BITS 7)
				      (success FLAG)
				      (breakDetected FLAG)
				      (framingError FLAG)
				      (dataLost FLAG)
				      (parityError FLAG)
				      (NIL BITS 2)
				      (notReady FLAG))))

(BLOCKRECORD DLTTYOutCSB
 ((OutParameters WORD)
			  (notifyMask WORD))                 (* Following just elaborates the OutParameters word)

			 (BLOCKRECORD DLTTYOutCSB ((onOff BITS 4)
				       (baudRate BITS 4)
				       (stopBits BITS 2)
				       (parity BITS 2)
				       (charLength BITS 2)
				       (clearToSend FLAG)
				       (dataSetReady FLAG))))

(BLOCKRECORD DLTTYOutCommand
 ((command&Data WORD))
			     (BLOCKRECORD DLTTYOutCommand ((command BYTE)
					   (outData BYTE))))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS DLTTYOUTBUSY DMACRO 
(NIL
  (NEQ 0 (fetch
 (DLTTYOutCommand command) of
 \DLionTTYCommandLoc))))

(PUTPROPS DLTTYPORTPOKE MACRO 
(X
  (LIST (QUOTE \DLTTYPORT.DOCOMMAND)
	(OR (SMALLP (CAR (NLSETQ (EVALV (MKATOM (CONCAT "OutControl." (CAR X)))))))
	    (SHOULDNT))
	(COND
	  ((FIXP (CADR X))
	    (TIMES DLionMStoTICKS (CADR X)))
	  ((MEMB (QUOTE NOWAIT)
		 (CDR X))
	    (QUOTE (QUOTE NOWAIT))))
	(AND (MEMB (QUOTE NOERROR)
		   (CDR X))
	     T))))
)

(DECLARE: EVAL@COMPILE 

(RPAQQ DLTtyCommand.putChar
 128)

(RPAQQ DLTtyCommand.abortPut
 133)

(RPAQQ DLTtyOutParameter.on
 0)

(RPAQQ DLTtyOutParameter.off
 1)

(CONSTANTS DLTtyCommand.putChar DLTtyCommand.abortPut DLTtyOutParameter.on DLTtyOutParameter.off)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ OutControl.on
 33536)

(RPAQQ OutControl.off
 33792)

(RPAQQ OutControl.abortPut
 34048)

(RPAQQ OutControl.breakOn
 34304)

(RPAQQ OutControl.breakOff
 34560)

(RPAQQ OutControl.setDSR
 33025)

(RPAQQ OutControl.setCTS
 33026)

(RPAQQ OutControl.setDSR&CTS
 33027)

(RPAQQ OutControl.setAllParameters
 33087)

(CONSTANTS OutControl.on OutControl.off OutControl.abortPut OutControl.breakOn (OutControl.breakOff
	     34560)
	   OutControl.setDSR OutControl.setCTS OutControl.setDSR&CTS OutControl.setAllParameters)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ InControl.InterruptMask
 32888)

(RPAQQ InControl.charPresent
 32768)

(RPAQQ InControl.errorBits
 120)

(CONSTANTS InControl.InterruptMask InControl.charPresent InControl.errorBits)
)




(* "Following bits are remnants of Domino.8 days, but are useful in many places")



(DECLARE: EVAL@COMPILE 

(RPAQQ OutControl.putChar
 32768)

(CONSTANTS OutControl.putChar)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ InControl.breakDetected
 64)

(RPAQQ InControl.framingError
 32)

(RPAQQ InControl.dataLost
 16)

(RPAQQ InControl.parityError
 8)

(CONSTANTS InControl.breakDetected InControl.framingError InControl.dataLost InControl.parityError)
)
)
(DEFINEQ

(\DLTTYPORT.DOCOMMAND

  (LAMBDA (COMM WAIT? NOERRORFLG)                            (* JonL "15-Jun-84 21:12")


          (* * Does one of the TTYPort commands.)


                                                             (* Returns non-NIL iff the command port is not busy at 

							     exit time.)

    (\DLTTYPORT.BUSYWAIT
 NOERRORFLG)                         (* Must wait for the synchronization *before* doing the 

							     command)

    (replace
 (DLTTYOutCommand command&Data) of
 \DLionTTYCommandLoc with
 COMM)
                                                             (* but don't necessarily have to wait after doing it.)

    (if
 (EQ WAIT? (QUOTE NOWAIT))
	then
 (NEQ 0 (fetch
 (DLTTYOutCommand command) of
 \DLionTTYCommandLoc))
      else
 (\DLTTYPORT.BUSYWAIT
 NOERRORFLG WAIT?))))

(\DLTTYPORT.BUSYWAIT

  (LAMBDA (NOERRORFLG WAIT?)                                 (* JonL "25-Jun-84 03:33")


          (* * Returns T when command port is free; either runs an error, or else returns NIL if it is still busy after the 

	  alloted time.)


                                                             (* note that 34000 is approximately 1 second in DLion 

							     ticks.)

    ((LAMBDA (LOSEP)
	(UNINTERRUPTABLY
            (during
 (OR (FIXP WAIT?)
			34000)
	       timerUnits
 (QUOTE TICKS) usingTimer
 \BusyWait.BOX when
 (NOT (DLTTYOUTBUSY))
	       do
 (RETURN) finally
 (SETQ LOSEP T)))
	(if
 (AND LOSEP (NULL NOERRORFLG))
	    then
 (ERROR (QUOTE Timeout% waiting% for% TTYPort% command% semaphore.))
	  else
 T)))))
)



(* "DLION RS232C stuff")


(DECLARE: EVAL@COMPILE 



(* Comment PPLossage)


DONTCOPY 
[DECLARE: EVAL@COMPILE 

(BLOCKRECORD DLRS232iopHardwareConfig
 ((NIL 100 WORD)
				       (rs232CAbsent FLAG)
				       (NIL BITS 15)))

(BLOCKRECORD DLRS232CMD
 ((NIL 24 WORD)                       (* Note: this is a variant record on the IOPAGE record)

			 (iopMiscBusy FLAG)
			 (NIL BITS 11)
			 (iopMiscCMD BITS 4)
			 (iopPutBusy FLAG)
			 (NIL BITS 15)
			 (iopGetBusy FLAG)
			 (NIL BITS 15))
			(BLOCKRECORD DLRS232CMD ((NIL 24 WORD)
				      (iopCMDword WORD))))

(ACCESSFNS DLIOPPAGECSBEXTRAS
 (                              (* These losers should come in from LLPARAMS, but there 

							     isn't a swappedXPOINTER field to accommodate them yet.

							     6/4/84 JonL)

			       (DLRS232CPARAMETERCSB (\VAG2 (fetch
 DLRS232CPARAMETERCSBHI
							       of
 DATUM)
							    (fetch
 DLRS232CPARAMETERCSBLO
							       of
 DATUM))
						     (PROGN (replace
 DLRS232CPARAMETERCSBHI
							       of
 DATUM with
 (\HILOC NEWVALUE))
							    (replace
 DLRS232CPARAMETERCSBLO
							       of
 DATUM with
 (\LOLOC NEWVALUE)
									     NEWVALUE)))
			       (DLRS232CPUTCSB (\VAG2 (fetch
 DLRS232CPUTCSBHI of
 DATUM)
						      (fetch
 DLRS232CPUTCSBLO of
 DATUM))
					       (PROGN (replace
 DLRS232CPUTCSBHI of
 DATUM
							 with
 (\HILOC NEWVALUE))
						      (replace
 DLRS232CPUTCSBLO of
 DATUM
							 with
 (\LOLOC NEWVALUE)
							      NEWVALUE)))
			       (DLRS232CGETCSB (\VAG2 (fetch
 DLRS232CGETCSBHI of
 DATUM)
						      (fetch
 DLRS232CGETCSBLO of
 DATUM))
					       (PROGN (replace
 DLRS232CGETCSBHI of
 DATUM
							 with
 (\HILOC NEWVALUE))
						      (replace
 DLRS232CGETCSBLO of
 DATUM
							 with
 (\LOLOC NEWVALUE)
							      NEWVALUE)))))
]

(OR (EQ (INDEXF (fetch (DLRS232iopHardwareConfig rs232CAbsent)
		       of T))
	(INDEXF (fetch (IOPAGE DLIOPHARDWARECONFIG)
		       of T)))
    (ERROR "RS232C rs232CAbsent location wrong in DLRS232iopHardwareConfig record"))
(OR (EQ (INDEXF (fetch (DLRS232CMD iopMiscBusy)
		       of T))
	(INDEXF (fetch (IOPAGE DLRS232CMISCCOMMAND)
		       of T)))
    (ERROR "RS232C Misc Command location wrong in DLRS232CMD record"))

[DECLARE: EVAL@COMPILE 

(BLOCKRECORD DLRS232CIOCB
 ((blockPointerLO WORD)
			   (blockPointerHI WORD)             (* This must always be made to point at the dataBlock 

							     field)

			   (byteCount WORD)
			   (returnedByteCount WORD)
			   (iopTransferStatus WORD)          (* Up to and including this word are what is 

							     communicated to the IOP)

			   (completed FLAG)
			   (forPut FLAG)
			   (oddByteP FLAG)
			   (NIL BITS 5)
			   (NIL BITS 8)
			   (DLRS232CIOCB.lastField WORD))
			  (BLOCKRECORD DLRS232CIOCB ((NIL 4 WORD)
					(iopTransferSuccess FLAG)
					(NIL BITS 6)
					(iopTransferDataLost FLAG)
					(iopTransferDeviceError FLAG)
					(iopTransferFrameTimeOut FLAG)
					(iopTransferChecksumError FLAG)
					(iopTransferParityError FLAG)
					(iopTransferAsyncFramingError FLAG)
					(iopTransferInvalidCharacter FLAG)
					(iopTransferAborted FLAG)
					(iopTransferDisaster FLAG)))
			  (ACCESSFNS ((blockPointer (\VAG2 (fetch
 blockPointerHI of
 DATUM)
							   (fetch
 blockPointerLO of
 DATUM))
						    (PROGN (replace
 blockPointerLO of
 DATUM
							      with
 (\LOLOC NEWVALUE))
							   (replace
 blockPointerHI of
 DATUM
							      with
 (\HILOC NEWVALUE))
							   NEWVALUE)))))

(BLOCKRECORD DLRS232CiopParameterCSB
 ((frameTimeout WORD)
				      (correspondent BITS 8)
				      (syncChar BYTE)
				      (resetRingHeard FLAG)
				      (resetBreakDetected FLAG)
				      (resetDataLost FLAG)
				      (requestToSend FLAG)
				      (dataTerminalReady FLAG)
				      (stopBits BITS 1)
				      (lineType BITS 2)
				      (parity BITS 3)
				      (charLength BITS 2)
				      (syncCount BITS 3)
				      (NIL BITS 4)
				      (lineSpeed BITS 4)
				      (NIL BITS 8)
				      (interruptMask WORD)
				      (DLRS232CiopParameterCSB.lastField WORD)))
]

(DECLARE: EVAL@COMPILE 

(PUTPROPS DLRS232CMDBUSY DMACRO 
(NIL
  (fetch
 iopMiscBusy of
 \IOPAGE)))

(PUTPROPS DLRS232CMDWAIT MACRO 
(X
  (PROG ((TIMEOUT (CAR X))
	 (NOERRORFLG (CADR X))
	 (CONSTANTTIMEOUT))
        (RETURN (COND
		  ((AND (NOT TIMEOUT)
			(NOT NOERRORFLG))
		    (QUOTE (until (NOT (DLRS232CMDBUSY)))))
		  (T (AND (SETQ CONSTANTTIMEOUT (EVALUABLE.CONSTANT.FIXP TIMEOUT))
			  (SETQ TIMEOUT (TIMES DLionMStoTICKS CONSTANTTIMEOUT)))
		     (BQUOTE (during
 , TIMEOUT timerUnits
 , (if
 CONSTANTTIMEOUT
								then
 (QUOTE TICKS)
							      else
 (QUOTE MILLISECONDS))
				when
 (NOT (DLRS232CMDBUSY)) do
 (RETURN)
				finally
 , (if
 (NULL NOERRORFLG)
					      then
 (QUOTE (ERROR (QUOTE 
					  Timeout% waiting% for% RS232C% command% to% be% unbusy.)))))
			     )))))))

(PUTPROPS DLRS232POKE MACRO 
(X
  (LIST (QUOTE \RS232C.DOCOMMAND)
	(OR (SMALLP (CAR (NLSETQ (EVALV (MKATOM (CONCAT "IopCommand." (CAR X)))))))
	    (SHOULDNT))
	((LAMBDA (N)
	    (COND
	      (N (ITIMES DLionMStoTICKS N))
	      ((MEMB (QUOTE NOWAIT)
		     (CDR X))
		(QUOTE (QUOTE NOWAIT)))))
	  (EVALUABLE.CONSTANT.FIXP (CADR X)))
	(AND (MEMB (QUOTE NOERROR)
		   (CDR X))
	     T))))

(PUTPROPS DLRS232CSETPARAMETERSUCCESS? MACRO 
(NIL
  (BITTEST (fetch
 DLRS232CPARAMETEROUTCOME of
 \IOPAGE)
	   32768)))
)


(PUTPROPS DLRS232POKE ARGNAMES 

  (signalName (... NOWAIT NOERROR)))

(PUTPROPS DLRS232CMDWAIT ARGNAMES 
(TIMEOUT NOERRORFLG))

(DECLARE: EVAL@COMPILE 

(RPAQQ RS232C.asynchronous
 2)

(RPAQQ RS232C.correspondentTTYHOST
 4)

(CONSTANTS RS232C.asynchronous RS232C.correspondentTTYHOST)
)




(* "Note that all these command constants have bit 2^15 on, which is the 'busy' bit.")



(DECLARE: EVAL@COMPILE 

(RPAQQ IopCommand.on
 32768)

(RPAQQ IopCommand.off
 32769)

(RPAQQ IopCommand.breakOn
 32770)

(RPAQQ IopCommand.breakOff
 32771)

(RPAQQ IopCommand.abortInput
 32772)

(RPAQQ IopCommand.abortOutput
 32773)

(RPAQQ IopCommand.getStatus
 32775)

(RPAQQ IopCommand.majorSetParameters
 32776)

(RPAQQ IopCommand.minorSetParameters
 32782)

(CONSTANTS IopCommand.on IopCommand.off IopCommand.breakOn IopCommand.breakOff IopCommand.abortInput 
	   IopCommand.abortOutput IopCommand.getStatus IopCommand.majorSetParameters 
	   IopCommand.minorSetParameters)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ IopDeviceStatus.ringIndicator
 1)

(RPAQQ IopDeviceStatus.carrierDetect
 8)

(RPAQQ IopDeviceStatus.dataLost
 64)

(RPAQQ IopDeviceStatus.breakDetected
 128)

(RPAQQ IopDeviceStatus.dataSetReady
 2)

(RPAQQ IopDeviceStatus.clearToSend
 32)

(CONSTANTS IopDeviceStatus.ringIndicator IopDeviceStatus.carrierDetect IopDeviceStatus.dataLost 
	   IopDeviceStatus.breakDetected IopDeviceStatus.dataSetReady IopDeviceStatus.clearToSend)
)
)



(* "Following two guys are here because I want all 'locked' vars near each other.")



(RPAQ? \RS232DLion?
 NIL)

(RPAQ? \RS232DLionRS232C?
 NIL)

(PUTPROPS \RS232DLion? GLOBALVAR 
T)

(PUTPROPS \RS232DLionRS232C? GLOBALVAR 
T)

(RPAQ? \DLionRS232CParameterCSB
 NIL)

(RPAQ? \DLionRS232CputIOCB
 NIL)

(RPAQ? \DLionRS232CgetIOCB
 NIL)

(RPAQ? \RS232C.IOCBdataLength
 64)

(RPAQ? \RS232C.BACKGROUNDSTATUS.FREQUENCY
 1)

(RPAQ? \RS232C.BACKGROUNDSTATUS.COUNTER
 0)

(RPAQ? \RS232C.PUTTIMER
 NIL)

(RPAQ? \RS232C.INTERPUTINTERVAL.ticks
 NIL)

(RPAQ? \RS232C.PERIODIC.BOX
 (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \DLionRS232CParameterCSB \DLionRS232CputIOCB \DLionRS232CgetIOCB 
	  \RS232C.IOCBdataLength \RS232C.BACKGROUNDSTATUS.FREQUENCY \RS232C.BACKGROUNDSTATUS.COUNTER 
	  \RS232C.PUTTIMER \RS232C.INTERPUTINTERVAL.ticks \RS232C.PERIODIC.BOX)
)
(DEFINEQ

(\RS232C.FILLINIOCB

  (LAMBDA (IOCB ACCESS BUF OFFST NBYTES COMPLETED ODDBYTEP)
                                                             (* JonL " 5-Aug-84 01:43")

    (OR (EVENP OFFST)
	(SHOULDNT (QUOTE ODDP)))
    (with
 DLRS232CIOCB IOCB                                  (* Comment PPLossage)

	  (SETQ blockPointer (\ADDBASE BUF (FOLDLO OFFST BYTESPERWORD)))
	  (SETQ byteCount NBYTES)
	  (SETQ returnedByteCount 0)
	  (SETQ iopTransferStatus 0)
	  (SETQ forPut (SELECTQ ACCESS
				(INPUT NIL)
				(OUTPUT T)
				(SHOULDNT)))
	  (SETQ completed COMPLETED)
	  (SETQ oddByteP ODDBYTEP))
    NIL))

(\RS232C.GETERRORSTATUS

  (LAMBDA (RESETP WAIT? WAITBOX)                             (* JonL " 4-Aug-84 17:49")

                                                             (* Must be called uninterruptably)

                                                             (* Reads the RS232C device status, and returns the 

							     status bits normalized to the INS8250 error bits)

    (if
 (NULL (\RS232C.DOCOMMAND
 IopCommand.getStatus (OR WAIT? (CONSTANT (ITIMES 250 DLionMStoTICKS))
							  )
				 (QUOTE NOERROR)
				 WAITBOX))
	then
                                                 (* Some disaster must have happened in the IOP since it 

							     isn't responding)

	     DE
      else
 (PROG ((DLSTATUS (fetch
 DLRS232CDEVICESTATUS of
 \IOPAGE))
		  (RESULT 0))
	         (SETQ RESULT (LOGOR (if
 (BITTEST DLSTATUS IopDeviceStatus.dataLost)
					 then
 OE
				       else
 0)
				     (if
 (BITTEST DLSTATUS IopDeviceStatus.breakDetected)
					 then
 BI
				       else
 0)))
	         (if
 (AND RESETP (NEQ 0 RESULT))
		     then
                                    (* Since some of these fields will "latch" we have to 

							     reset them after reading)

			  (if
 (OR (NULL (DLRS232POKE minorSetParameters 250 NOERROR))
				  (NOT (DLRS232CSETPARAMETERSUCCESS?)))
			      then
                           (* But if we fail to do the reset, then it's some kind 

							     of error)

				   (SETQ RESULT (LOGOR DE RESULT))))
	         (RETURN RESULT)))))

(\RS232C.DOCOMMAND

  (LAMBDA (COMM WAIT? NOERRORFLG WAITBOX)                    (* JonL " 9-Jul-84 17:45")


          (* * Does one of the iop commands: on, off, breakOn, abortInput, abortOutput, setRS366Status, getStatus, 

	  majorSetParameters, minorSetParameters.)




          (* * Returns non-NIL iff the command port is not busy at exit time.)



    (\RS232C.BUSYWAIT
 NOERRORFLG NIL WAITBOX)                (* Must try to wait for the synchronization *before* 

							     doing the command)

    (replace
 iopCMDword of
 \IOPAGE with
 COMM)                (* but don't necessarily have to wait after doing it.)

    (OR (EQ WAIT? (QUOTE NOWAIT))
	(\RS232C.BUSYWAIT
 NOERRORFLG WAIT? WAITBOX))
    (NOT (fetch
 iopMiscBusy of
 \IOPAGE))))

(\RS232C.BUSYWAIT

  (LAMBDA (NOERRORFLG WAIT? WAITBOX)                         (* JonL "31-Oct-84 17:59")


          (* * Returns T when command port is free; either runs an error, or else returns NIL if it is still busy after the 

	  alloted time.)



    ((LAMBDA (LOSEP)
	(UNINTERRUPTABLY
            (during
 (
OR
 (
FIXP
 WAIT?)
			\DLION.RCLKSECOND)
	       timerUnits
 (
QUOTE
 TICKS) usingTimer
 (if
 (
\TIMER.TIMERP
 WAITBOX)
						       then
 WAITBOX
						     else
 \BusyWait.BOX)
	       when
 (
NOT
 (fetch
 iopMiscBusy of
 \IOPAGE)) do
 (
RETURN
) finally
 (
SETQ
 LOSEP T)))
	(if
 LOSEP
	    then
 (if
 (
NULL
 NOERRORFLG)
		     then
 (
ERROR
 (
QUOTE
 Timeout% waiting% for% RS232C% command% semaphore.)))
	  else
 T)))))
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

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

(PUTPROPS RS232INTERRUPT? MACRO 
(NIL
  (if
 \RS232DLion?
      then
 (if
 \RS232DLionRS232C?
	       then
 \RS232BACKGROUNDERRORSTATUS
	     else
 (BITTEST (fetch
 (DLTTYInCSB InControl) of
 \DLionTTYInLoc)
			   InControl.InterruptMask))
    else
 (IGEQ (READPRINTERPORT)
	       INTRPT))))

(PUTPROPS RS232STATUSIN MACRO 
(NIL
  (if
 \RS232DLion?
      then
 (if
 \RS232DLionRS232C?
	       then
 (\RS232C.GETERRORSTATUS T)
	     else
 (PROG ((cw (fetch
 (DLTTYInCSB InControl) of
 \DLionTTYInLoc))
			 (r (if
 (DLTTYOUTBUSY)
				then
 0
			      else
 THRE)))
		        (if
 (BITTEST cw (CONSTANT (BITCLEAR InControl.InterruptMask 
							    InControl.charPresent)))
			    then
 (add
 r (ELT \DLErrorBitsConversion (LOADBYTE cw 3 4)))
				 (replace
 (DLTTYInCSB InControl) of
 \DLionTTYInLoc
				    with
 (BITCLEAR cw (CONSTANT (BITCLEAR InControl.InterruptMask 
									  InControl.charPresent)))))
		        (RETURN (if
 (BITTEST cw InControl.charPresent)
				    then
 (LOGOR r DR)
				  else
 r))))
    else
 (LOADBYTE (ISTROBE LINESTATUSREG)
		   0 8))))

(PUTPROPS RS232MODEMSTATUSIN MACRO 
(NIL
  (if
 \RS232DLion?
      then
 (if
 \RS232DLionRS232C?
	       then
 (PROG ((STATUS (\RS232C.GETERRORSTATUS))
			   DLSTATUS)                         (* Note that we didn't reset the latched parameters in 

							     the device status word.)

		          (if
 (LINESTATUSERRORSP STATUS)
			      then
 (UNINTERRUPTABLY
                                       (PROG ((OPERIODIC.FN \PERIODIC.INTERRUPT))
					     (SETQ \PERIODIC.INTERRUPT)

          (* FOO! Got to shut of the fool "interrupt" so that it doesn't squeak through in between the time we pick up the 

	  value of \RS232BACKGROUNDERRORSTATUS and when we SETQ if back.)



					     (BITSADD_ \RS232BACKGROUNDERRORSTATUS
						       (LINESTATUSERRORBITS (\RS232C.GETERRORSTATUS
									      T)))
					     (SETQ \PERIODIC.INTERRUPT OPERIODIC.FN))))
		          (SETQ DLSTATUS (fetch
 DLRS232CDEVICESTATUS of
 \IOPAGE))
		          (RETURN (IPLUS (if
 (BITTEST DLSTATUS IopDeviceStatus.dataSetReady)
					     then
 DSR
					   else
 0)
					 (if
 (BITTEST DLSTATUS IopDeviceStatus.clearToSend)
					     then
 CTS
					   else
 0)
					 (if
 (BITTEST DLSTATUS IopDeviceStatus.carrierDetect)
					     then
 RLSD
					   else
 0))))
	     else
                                            (* Do the rxRDY and txRDY fields in the DLion correspond

							     to anything like RI and/or RLSD -- JonL 6/19/83)

		  (IPLUS (if
 (fetch
 (DLTTYInCSB requestToSend) of
 \DLionTTYInLoc)
			     then
 CTS
			   else
 0)
			 (if
 (fetch
 (DLTTYInCSB dataTerminalReady) of
 \DLionTTYInLoc)
			     then
 DSR
			   else
 0)))
    else
 (LOADBYTE (ISTROBE MODEMSTATUSREG)
		   0 8))))

(PUTPROPS RS232MODEMCONTROLIN MACRO 
(NIL
  (if
 \RS232DLion?
      then
 (if
 \RS232DLionRS232C?
	       then
 (IPLUS (if
 (fetch
 (DLRS232CiopParameterCSB dataTerminalReady) of
 
									 \DLionRS232CParameterCSB)
			       then
 DTR
			     else
 0)
			   (if
 (fetch
 (DLRS232CiopParameterCSB requestToSend) of
 
									 \DLionRS232CParameterCSB)
			       then
 RTS
			     else
 0))
	     else
 (IPLUS (if
 (fetch
 (DLTTYOutCSB dataSetReady) of
 \DLionTTYOutLoc)
			     then
 DTR
			   else
 0)
			 (if
 (fetch
 (DLTTYOutCSB clearToSend) of
 \DLionTTYOutLoc)
			     then
 RTS
			   else
 0)))
    else
 (LOGAND (ISTROBE MODEMCONTROLREG)
		 (CONSTANT (LOGOR DTR RTS))))))

(PUTPROPS RS232MODEMCONTROLSET MACRO 
((X)
  (PROG ((BITS X))
        (if
 \RS232DLion?
	    then
 (if
 \RS232DLionRS232C?
		     then
 (OR (UNINTERRUPTABLY               (* Comment PPLossage)

				  (replace
 (DLRS232CiopParameterCSB dataTerminalReady) of
 
									 \DLionRS232CParameterCSB
				     with
 (BITTEST BITS DTR))
				  (replace
 (DLRS232CiopParameterCSB requestToSend) of
 
									 \DLionRS232CParameterCSB
				     with
 (BITTEST BITS RTS))
				  (DLRS232POKE minorSetParameters NOERROR))
			      (\RS232DECODE.LINESTATUS DE))
		   else
 (replace
 (DLTTYOutCSB dataSetReady) of
 \DLionTTYOutLoc
			   with
 (BITTEST BITS DTR))
			(replace
 (DLTTYOutCSB clearToSend) of
 \DLionTTYOutLoc
			   with
 (BITTEST BITS RTS))
			(DLTTYPORTPOKE setDSR&CTS))
	  else
 (OSTROBE MODEMCONTROLREG BITS)))))
)

(DECLARE: EVAL@COMPILE 

(PUTPROPS RS232DATAI DMACRO 
(NIL
  (COND
    (\RS232DLion? (PROG1 (fetch
 (DLTTYInCSB inData) of
 \DLionTTYInLoc)
			 (replace
 (DLTTYInCSB charPresent) of
 \DLionTTYInLoc with
 NIL)))
    (T (LOADBYTE (ISTROBE DATAREG)
		 0 BITSPERBYTE)))))

(PUTPROPS RS232DATAO DMACRO 
((BYTE)
  

          (* * It must have already been ascertained that the Transmitter Holding Register is Empty before calling this.)



  (if
 \RS232DLion?
      then
 (replace
 (DLTTYOutCommand outData) of
 \DLionTTYCommandLoc with
 BYTE)
	   (replace
 (DLTTYOutCommand command) of
 \DLionTTYCommandLoc with
 DLTtyCommand.putChar)
    else
 (OSTROBE DATAREG BYTE))))
)
)



(* "buffer management")


(* * "Chars to and from the UART may be stored in ring buffers." 
"Note that the 'write' indices point to 1 slot beyond the active data, whereas the 'read'" 
" 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? \RS232IRING.SIZE
 1023)

(RPAQ? \RS232IRING.READ
 0)

(RPAQ? \RS232IRING.WRITE
 0)

(RPAQ? \RS232ORINGBUF
 NIL)

(RPAQ? \RS232ORING.SIZE
 511)

(RPAQ? \RS232ORING.READ
 0)

(RPAQ? \RS232ORING.WRITE
 0)

(RPAQ? \RS232ORINGEVENT
 (CREATE.EVENT "RS232OutputStartup"))

(PUTPROPS \RS232IRINGBUF GLOBALVAR 
T)

(PUTPROPS \RS232IRING.SIZE GLOBALVAR 
T)

(PUTPROPS \RS232IRING.READ GLOBALVAR 
T)

(PUTPROPS \RS232IRING.WRITE GLOBALVAR 
T)

(PUTPROPS \RS232ORINGBUF GLOBALVAR 
T)

(PUTPROPS \RS232ORING.SIZE GLOBALVAR 
T)

(PUTPROPS \RS232ORING.READ GLOBALVAR 
T)

(PUTPROPS \RS232ORING.WRITE GLOBALVAR 
T)

(PUTPROPS \RS232ORINGEVENT GLOBALVAR 
T)
(DECLARE: DONTCOPY EVAL@COMPILE 
(DECLARE: EVAL@COMPILE 

(PUTPROPS SERVICEIRING DMACRO 
(NIL
  (if
 \RS232DLionRS232C?
      then
 (AND \RS232BACKGROUNDERRORSTATUS (\RS232C.PROCESSINTERRUPT))
    else
 (if
 (if
 \RS232DLion?
		 then
 (BITTEST (fetch
 (DLTTYInCSB InControl) of
 \DLionTTYInLoc)
			       InControl.InterruptMask)
	       else
 (IGEQ (READPRINTERPORT)
			  INTRPT))
	     then
 (\RS232.PROCESSINTERRUPT)))))

(PUTPROPS CHECKUART MACRO 
(=
   . \RS232.CHECKUART))

(PUTPROPS RINGB.INCREMENT MACRO 
((VAR AMOUNT MASK)
  (PROG1 VAR (SETQ VAR (LOGAND (IPLUS VAR AMOUNT)
			       MASK)))))

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

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

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

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

(PUTPROPS IRINGB.USED MACRO 
(NIL
  (LOGAND (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
	  \RS232IRING.SIZE)))

(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 (LOGAND (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
						   \RS232IRING.SIZE))))))))))

(PUTPROPS IRINGB.FREE DMACRO 
(NIL
                                                             (* Note the equivalence: (IMOD 

							     (IDIFFERENCE Z (IDIFFERENCE HI LO)) Z) = 

							     (IMOD (IDIFFERENCE LO HI) Z))

  (if
 (EQ \RS232IRING.READ \RS232IRING.WRITE)
      then
 \RS232IRING.SIZE
    else
 (LOGAND (IDIFFERENCE \RS232IRING.READ \RS232IRING.WRITE)
		 \RS232IRING.SIZE))))

(PUTPROPS ORINGB.USED MACRO 
(NIL
  (LOGAND (IDIFFERENCE \RS232ORING.WRITE \RS232ORING.READ)
	  \RS232ORING.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 (LOGAND (IDIFFERENCE \RS232ORING.WRITE \RS232ORING.READ)
						   \RS232ORING.SIZE))))))))))

(PUTPROPS ORINGB.FREE DMACRO 
(NIL
                                                             (* Note the equivalence: (IMOD 

							     (IDIFFERENCE Z (IDIFFERENCE HI LO)) Z) = 

							     (IMOD (IDIFFERENCE LO HI) Z))

  (COND
    ((EQ \RS232ORING.READ \RS232ORING.WRITE)
      \RS232ORING.SIZE)
    (T (LOGAND (IDIFFERENCE \RS232ORING.READ \RS232ORING.WRITE)
	       \RS232ORING.SIZE)))))

(PUTPROPS WITHOUTRS232PERIODICFN DMACRO 
(X
  (SUBST X (QUOTE FORMS)
	 (QUOTE (UNINTERRUPTABLY
                    ((LAMBDA (OPERIODICFN)
			(DECLARE
 (LOCALVARS OPERIODICFN))
			(AND OPERIODICFN (SETQ \PERIODIC.INTERRUPT))
			(PROG1 (PROGN . FORMS)
			       (AND OPERIODICFN (SETQ \PERIODIC.INTERRUPT OPERIODICFN))))
		      \PERIODIC.INTERRUPT))))))

(PUTPROPS BACKGROUND? MACRO 
(X
  (BQUOTE (SELECTQ (CAR \RS232BACKGROUNDSTATE)
		   (NIL NIL)
		   ((,@ X)
		     T)
		   NIL))))

(PUTPROPS LINESTATUSERRORBITS DMACRO 
((STATUS)
  (LOGAND STATUS (CONSTANT (LOGOR DE THROE 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)))))))
)


(RPAQQ RS232BACKGROUNDLOCKEDFNS
 (\RS232.PROCESSINTERRUPT \RS232C.PROCESSINTERRUPT \RS232.DATAREADY 
							 \RS232DECODE.LINESTATUS \RS232.OUTPUTBROOM 
							 \RS232.SERVICEORING \RS232.PERIODIC.FN 
							 \RS232C.PERIODIC.FN TIMEREXPIRED? 
							 \GETINTERNALCLOCK \DAYTIME0 \CLOCK0))

(RPAQQ RS232BACKGROUNDIGNOREFNS
 (\RS232STABLIZE \CanonicalizeTimerUnits ERROR ERRORX \LISPERROR 
						SETTOPVAL GETTOPVAL ERROR! SHOULDNT HELP))

(RPAQQ RS232BACKGROUNDLOCKEDVARS
 (\DLionRS232CgetIOCB \TIMEREXPIRED.BOX \RS232DLion? 
						      \RS232DLionRS232C? \DLionTTYInLoc 
						      \RS232BACKGROUNDERRORSTATUS \DLionTTYCommandLoc 
						      RS232XON\XOFF? RS232XOFF? \RS232IRINGBUF 
						      \RS232IRING.READ \RS232IRING.WRITE 
						      \RS232IRING.SIZE \RS232ORINGBUF 
						      \RS232ORING.READ \RS232ORING.WRITE 
						      \RS232ORING.SIZE))
)
(DEFINEQ

(\RS232.CHECKUART

  (LAMBDA NIL                                                (* JonL "16-SEP-83 15:07")

    (SERVICEIRING)))

(\RS232.DATAREADY

  (LAMBDA NIL                                                (* JonL " 4-Jun-84 00:30")


          (* * NOTE WELL! This function must be called UNINTERRUPTABLY Returns non-NIL iff there is an overflow of the ring 

	  buffer. It should never be called when \RS232DLionRS232C? is non-NIL.)



    (PROG ((BYTE (RS232DATAI)))
          (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 \RS232IRING.SIZE)
		   (RETURN RBOE)))))

(\RS232.PERIODIC.FN

  (LAMBDA NIL                                                (* JonL "22-Jun-84 01:23")

    (if
 (if
 \RS232DLion?
	    then
                                             (* This function is installed only when 

							     \RS232DLionRS232C? is null)

		 (BITTEST (fetch
 (DLTTYInCSB InControl) of
 \DLionTTYInLoc)
			  InControl.InterruptMask)
	  else
 (IGEQ (READPRINTERPORT)
		     INTRPT))
	then
 (SETQ \RS232BACKGROUNDERRORSTATUS (\RS232.PROCESSINTERRUPT
 (QUOTE NOERROR))))))

(\RS232.PROCESSINTERRUPT

  (LAMBDA (NOERRORFLG)                                       (* JonL " 4-Oct-84 23:33")

                                                             (* Returns non-NIL iff some error conditions have 

							     occured.)

    (if
 \RS232DLionRS232C?
	then
                                                 (* We don't really expect this wing to be taken -- 

							     callers should call \RS232C.PROCESSINTERRUPT directly.)

	     (\RS232C.PROCESSINTERRUPT
 NOERRORFLG)
      else
 (
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
 (DLTTYInCSB InControl)
								   of
 \DLionTTYInLoc)))
						           (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
 (
SETQ
 \PERIODIC.INTERRUPT)
			  (
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))))))

(\RS232DECODE.LINESTATUS

  (LAMBDA (STATUS NOERRORFLG)                                (* JonL "31-Oct-84 17:56")


          (* 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?)
      A   (WITHOUTRS232PERIODICFN                            (* Temporarily gag the low-level interrupt)

				  (if
 (
NULL
 STATUS)
				      then
 (
SETQ
 STATUS (RS232STATUSIN))
				    elseif
 (
NOT
 (
FIXP
 STATUS))
				      then
 (
RAID
 "Bad STATUS arg"))
				  (if
 \RS232BACKGROUNDERRORSTATUS
				      then
                   (* Sweep up the background errors into this call)

					   (BITSADD_ STATUS \RS232BACKGROUNDERRORSTATUS)
					   (
SETQ
 \RS232BACKGROUNDERRORSTATUS))
				  (
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
 (if
 \RS232DLionRS232C?
					       then
 (
SHOULDNT
 (
QUOTE
 \RS232.DATAREADY)))
					   (
SETQ
 STATUS (
LOGOR
 (
BITCLEAR
 STATUS DR)
							       (
OR
 (\RS232.DATAREADY
)
								   0)))))
          (if
 (
OR
 NOERRORFLG (
NOT
 (LINESTATUSERRORSP STATUS)))
	      then
                                           (* Here's the main return)

		   (
RETURN
 STATUS)
	    elseif
 (
OR
 (
NOT
 BREAKINSTATUS?)
		       (
PROGN
 (if
 RS232BREAKFN
				  then
 (
APPLY*
 RS232BREAKFN))
			      (
SETQ
 STATUS (
BITCLEAR
 STATUS BI))
			      (LINESTATUSERRORSP STATUS)))
	      then
 (
SETQ
 STATUS (LINESTATUSERRORBITS STATUS))
		   (if
 (
BITTEST
 STATUS (
CONSTANT
 (
LOGOR
 THROE DE)))
		       then
                                  (* These are the device-error type errors.)

			    (
AND
 (
PROG1
 RS232DEVICEERRORFN 
                                                             (* Comment PPLossage)
)
				 (
APPLY*
 (
PROG1
 RS232DEVICEERRORFN 
                                                             (* Comment PPLossage)
)
					 (
SELECTC
 STATUS
						  (THROE (
QUOTE
 TransmitterWedged))
						  (DE (
OR
 \RS232DLionRS232C? (
SHOULDNT
))
						      (
QUOTE
 RS232Cdisaster))
						  (
QUOTE
 MultipleErrors))))
		     else
                                    (* These are the lost-data type errors.)

			  (
AND
 (
PROG1
 RS232LOSTCHARFN        (* Comment PPLossage)
)
			       (
APPLY*
 (
PROG1
 RS232LOSTCHARFN 
                                                             (* Comment PPLossage)
)
				       (
SELECTC
 STATUS
						(OE (
QUOTE
 DroppedCharacter))
						(PE (
QUOTE
 ParityError))
						(FE (
QUOTE
 FramingError))
						(RBOE (
QUOTE
 RingBufferFull))
						(LBOE (
QUOTE
 LineBufferFull))
						(
QUOTE
 MultipleErrors))))))
          (\RS232STABLIZE
)
          (
SETQ
 STATUS)
          (
GO
 A))))

(\RS232.OUTPUTBROOM

  (LAMBDA NIL                                                (* JonL "14-Jun-84 23:09")

                                                             (* Just loop around infinitely, "sweeping" all the data 

							     in the output ring buffer out through the UART)

    (do
 (AWAIT.EVENT \RS232ORINGEVENT 5000)
	(\RS232.SERVICEORING
))))

(\RS232.SERVICEORING

  (LAMBDA (FREE FORCEOUTPUT?)                                (* JonL " 4-Oct-84 21:00")


          (* * When FREE is non-NIL, it is the number that we want to see free in the output ring buffer.)



    (bind
 (STATUS _ NIL)
	  (#TOSTART _(if
 (
FIXP
 FREE)
			 then
 (
IMIN
 FREE MAX.SMALLP)
		       else
 (ORINGB.USED)))
       until
 (
OR
 (
NOT
 (ORINGB.ATLEAST 1))
		 (
ILEQ
 #TOSTART 0))
       do
 (UNINTERRUPTABLY                                   (* Comment PPLossage)

	      (if
 (
NOT
 \RS232DLionRS232C?)
		  then
 (if
 (
NULL
 (
SETQ
 STATUS (\RS232CHECK.THRE
)))
			   then
 (RS232DATAO (POPRS232ORING))
				(add
 #TOSTART -1)
			 else
 

          (* FOO! Got to shut of the fool "interrupt" so that it doesn't squeak through in between the time we pick up the 

	  value of \RS232BACKGROUNDERRORSTATUS and when we SETQ if back.)



			      (WITHOUTRS232PERIODICFN (BITSADD_ \RS232BACKGROUNDERRORSTATUS STATUS)))
		else
                                         (* Checks on the progress of the output IOCB and may 

							     start up a new one.)

		     (if
 (
AND
 (fetch
 completed of
 \DLionRS232CputIOCB)
			      (
OR
 (ORINGB.ATLEAST 3)
				  (
AND
 (ORINGB.ATLEAST 1)
				       (
OR
 FORCEOUTPUT? (
TIMEREXPIRED?
 \RS232C.PUTTIMER (
QUOTE
 TICKS))
					   ))))
			 then
                                (* This wing will only be executed when starting out a 

							     new put IOCB)


          (* * Byte off enough bytes either to transport all currently in the ring buffer, or to transport all contiguous ones

	  at the high end.)



			      (
PROG
 ((RRI \RS232ORING.READ)
				     (WRI \RS232ORING.WRITE)
				     NBYTES ODDBYTEP)
				    (if
 (
ILESSP
 WRI RRI)
					then
                 (* Wrap around case)

					     (
SETQ
 WRI (
ADD1
 \RS232ORING.SIZE)) 
                                                             (* Note that \RS232ORING.SIZE must be a 2^N-1 so ADD1 

							     of it can't be odd)

				      elseif
 (
ODDP
 WRI)
					then
 (
SETQ
 ODDBYTEP T))
				    (\RS232C.FILLINIOCB
 \DLionRS232CputIOCB (
QUOTE
 OUTPUT)
							\RS232ORINGBUF RRI (
SETQ
 NBYTES
							  (
IDIFFERENCE
 WRI RRI))
							T ODDBYTEP)
				    (WITHOUTRS232PERIODICFN 
                                                             (* Comment PPLossage)

							    (if
 ODDBYTEP
								then
 (PUSHRS232ORING 0))
							    (replace
 completed of
 \DLionRS232CputIOCB
							       with
 NIL)
							    (replace
 iopPutBusy of
 \IOPAGE
							       with
 T))
                                                             (* Note that this re-activates the IOCB by setting the 

							     completed field to NIL)

				    (
SETQ
 #TOSTART (
IDIFFERENCE
 #TOSTART NBYTES))))))
	  (if
 \RS232BACKGROUNDERRORSTATUS
	      then
                                           (* Note that this call may cause an error)

		   (\RS232DECODE.LINESTATUS
))
	  (
BLOCK
)                                            (* Blocking, simply because the two callers of the 

							     function would do it.)
)))

(\RS232C.PROCESSINTERRUPT

  (LAMBDA (NOERRORFLG)                                       (* JonL "22-Jun-84 01:20")

                                                             (* Returns non-NIL iff some error conditions have 

							     occured.)

                                                             (* We only come here to decode the status bits left by 

							     the completion of an IOCB)

    (if
 (OR NOERRORFLG (NULL \RS232BACKGROUNDERRORSTATUS))
	then
 \RS232BACKGROUNDERRORSTATUS
      else
 (\RS232DECODE.LINESTATUS
 \RS232BACKGROUNDERRORSTATUS))))

(\RS232C.PERIODIC.FN

  (LAMBDA (INPUTCHECK.ONLY?)                                 (* JonL " 4-Oct-84 21:11")

    (
PROG
 ((ACTIVEIOCB \DLionRS232CgetIOCB)
	   (BUSYP (fetch
 iopGetBusy of
 \IOPAGE))
	   COMPLETED STATUS ABORTED SUPPRESS.GETERRORSTATUS)
          (if
 (
AND
 (
NOT
 (
SETQ
 COMPLETED (fetch
 completed of
 ACTIVEIOCB)))
		   (
NOT
 BUSYP))
	      then
                                           (* Allegedly, the thing "just" went unbusy.)

		   (replace
 completed of
 ACTIVEIOCB with
 (
SETQ
 COMPLETED T)) 
                                                             (* De-activate the IOCB and process its results)

		   (if
 (fetch
 iopTransferSuccess of
 ACTIVEIOCB)
		       then
                                  (* This should be the common case)

			    (
PROG
 ((NBYTES (fetch
 returnedByteCount of
 ACTIVEIOCB))
				   (WRI \RS232IRING.WRITE))
			          (if
 (
EQ
 0 NBYTES)
				      then
 (
RETURN
)          (* Weird case with nothing much to do)

				    elseif
 (fetch
 oddByteP of
 ACTIVEIOCB)
				      then
                   (* Compensate for having started the input at the next 

							     higher word boundary)

					   (
OR
 (
ODDP
 WRI)
					       (
RAID
 "oddities don't match" WRI))
					   (\FASTMOVEBYTES
 \RS232IRINGBUF (
ADD1
 WRI)
							   \RS232IRINGBUF WRI NBYTES))
			          (RINGB.INCREMENT WRI NBYTES \RS232IRING.SIZE)
			          (if
 (
ILESSP
 WRI \RS232IRING.WRITE)
				      then
                   (* Ooops, we just "wrapped around")

					   (if
 (
NEQ
 0 WRI)
					       then
          (* Got to move the dribble out of the extra page)

						    (
\BLT
 \RS232IRINGBUF (
\ADDBASE

							    \RS232IRINGBUF
							    (FOLDLO (
ADD1
 \RS232IRING.SIZE)
								    BYTESPERWORD))
							  (FOLDHI WRI BYTESPERWORD))))
			          (
SETQ
 \RS232IRING.WRITE WRI))
		     else
 (
SETQ
 ABORTED T)
			  (if
 (fetch
 iopTransferAborted of
 ACTIVEIOCB)
			      then
                           (* No cause for alarm)

			    else
                             (* Might as well consider this case an abortion too)

				 (
SETQ
 STATUS (if
 (
OR
 (fetch
 iopTransferDeviceError of
 ACTIVEIOCB)
						      (fetch
 iopTransferDisaster of
 ACTIVEIOCB))
						  then
 DE
						else
 (
IPLUS
 (if
 (fetch
 iopTransferDataLost
								   of
 ACTIVEIOCB)
								then
 OE
							      else
 0)
							    (if
 (fetch
 iopTransferParityError
								   of
 ACTIVEIOCB)
								then
 PE
							      else
 0)
							    (if
 (fetch
 iopTransferAsyncFramingError
								   of
 ACTIVEIOCB)
								then
 FE
							      else
 0))))
				 (if
 (
NEQ
 STATUS 0)
				     then
                    (* Accumulates bits in \RS232BACKGROUNDERRORSTATUS)

					  (BITSADD_ \RS232BACKGROUNDERRORSTATUS STATUS) 
                                                             (* What the heck is going on here?)
))))
          (if
 INPUTCHECK.ONLY?
	      then
 (if
 BUSYP
		       then
 (
RAID
 "InputCheck while BUSY"))
		   (
SETQ
 SUPPRESS.GETERRORSTATUS T)
	    elseif
 (
AND
 COMPLETED (
ILESSP
 \RS232C.IOCBdataLength (IRINGB.FREE)))
	      then
                                           (* As long as there's at least \RS232C.IOCBdataLength 

							     bytes free in the input buffer, start out a new input 

							     load.)

		   (
PROG
 ((OFFST \RS232IRING.WRITE))
		         (if
 (
ODDP
 \RS232IRING.WRITE)
			     then
                            (* skip a byte, which will have to be compensated by 

							     the call to \FASTMOVEBYTES when the buffer comes in.)

				  (add
 OFFST 1))
		         (\RS232C.FILLINIOCB
 ACTIVEIOCB (
QUOTE
 INPUT)
					     \RS232IRINGBUF OFFST \RS232C.IOCBdataLength NIL
					     (
NEQ
 OFFST \RS232IRING.WRITE))
                                                             (* Note that this re-activates the IOCB by setting the 

							     completed field to NIL)

		         (
\PUTBASEBYTE
 \RS232IRINGBUF OFFST 0)
                                                             (* Make the InputRingBuffer pages involved "dirty", 

							     becaus IOP writes don't hack the pageTable)

		         (
\PUTBASEBYTE
 \RS232IRINGBUF (
IPLUS
 OFFST \RS232C.IOCBdataLength -1)
				       0))
		   (replace
 iopGetBusy of
 \IOPAGE with
 T))   (* Checks on the progress of the output IOCB 

							     (if any))

          (
SETQ
 ACTIVEIOCB \DLionRS232CputIOCB)
          (if
 (
AND
 (
NOT
 (
SETQ
 COMPLETED (fetch
 completed of
 ACTIVEIOCB)))
		   (
NOT
 (fetch
 iopPutBusy of
 \IOPAGE)))
	      then
                                           (* The very first time that we notice the busy flag 

							     off, we update the ring buffer indices)

		   (replace
 completed of
 ACTIVEIOCB with
 (
SETQ
 COMPLETED T))
		   (
PROG
 ((NBYTES (CEIL (fetch
 (DLRS232CIOCB byteCount) of
 ACTIVEIOCB)
					BYTESPERWORD)))
		         (if
 (fetch
 iopTransferSuccess of
 ACTIVEIOCB)
			     then
                            (* This will be the common case)

				  (RINGB.INCREMENT \RS232ORING.READ NBYTES \RS232ORING.SIZE) 
                                                             (* Always ensure that \RS232ORING.READ will be an even 

							     number, because the IOP only takes bytes from a 

							     word-aligned vector.)

			   elseif
 (fetch
 iopTransferAborted of
 ACTIVEIOCB)
			     then
                            (* This causes no alarm for RS232LOSTCHARFN but does 

							     signal something)

				  (if
 (
AND
 (fetch
 oddByteP of
 ACTIVEIOCB)
					   (
ILEQ
 NBYTES (ORINGB.USED)))
				      then
 

          (* When this buffer was started, \RS232ORING.WRITE was incremented to account for positioning of the subsequent 

	  bufferload; but there were some bytes pushed into the buffer during the interim.)



					   (
RAID
 "Need to shuffle down one byte"))
			   elseif
 (fetch
 iopTransferDeviceError of
 ACTIVEIOCB)
			     then
                            (* If there are any output errors, it ought to be this 

							     one)

				  (
SETQ
 STATUS (\RS232C.GETERRORSTATUS
 (
SETQ
 SUPPRESS.GETERRORSTATUS 
									 T)
								       (
ITIMES
 16 DLionMStoTICKS)
								       \RS232C.PERIODIC.BOX))
				  (if
 (
AND
 (LINESTATUSERRORSP STATUS)
					   (
NEQ
 STATUS 0))
				      then
                   (* Accumulates bits in \RS232BACKGROUNDERRORSTATUS)

					   (BITSADD_ \RS232BACKGROUNDERRORSTATUS STATUS) 
                                                             (* What the heck is going on here?)
)
			   else
 (
RAID
 "unknown transfer status for putIOCB")))

          (* * Start a timer ticking whenever an IOCB is "completed")



		   (
SETQ
 \RS232C.PUTTIMER (
SETUPTIMER
 \RS232C.INTERPUTINTERVAL.ticks \RS232C.PUTTIMER
						      (
QUOTE
 TICKS))))
          (if
 (
AND
 (
NOT
 SUPPRESS.GETERRORSTATUS)
		   (
IGEQ
 0 (add
 \RS232C.BACKGROUNDSTATUS.COUNTER -1)))
	      then
 

          (* Every so often, we must stop and take a look at the status. Hopefully, we do it often enough so as not to miss a 

	  BREAK signal.)



		   (
SETQ
 \RS232C.BACKGROUNDSTATUS.COUNTER \RS232C.BACKGROUNDSTATUS.FREQUENCY) 

          (* * Note that we may have interrupted some call to \RS232C.BUSYWAIT so we have to provide a separate alternative 

	  for the busyWaitBOX.)



		   (
SETQ
 STATUS (LINESTATUSERRORBITS (\RS232C.GETERRORSTATUS
 NIL (
ITIMES
 16 
										   DLionMStoTICKS)
									     \RS232C.PERIODIC.BOX)))
                                                             (* Note that we don't reset the latched bits in the 

							     device status word during this call)

		   (if
 (
NEQ
 0 STATUS)
		       then
 (BITSADD_ \RS232BACKGROUNDERRORSTATUS STATUS))))))
)

(RPAQQ \RS232BACKGROUNDSTATE
 NIL)

(RPAQQ \RS232BACKGROUNDERRORSTATUS
 NIL)
(DEFINEQ

(RS232BACKGROUND

  (LAMBDA (ON? PERIOD.ms)                                    (* JonL " 5-Nov-84 22:09")

    (
PROG1
 (
OR
 (
CAR
 \RS232BACKGROUNDSTATE)
	       (
QUOTE
 OFF))
	   (if
 (
EQ
 ON? (
QUOTE
 ON))
	       then
 (
SETQ
 ON? (
QUOTE
 BOTH)))
	   (if
 ON?
	       then
 ((LAMBDA (PROCP)
			(
SELECTQ
 ON?
				 ((BOTH INPUT OUTPUT)
				   (
SETQ
 PERIOD.ms (
SELECTQ
 ON?
							    ((BOTH INPUT)
							      (
IMIN
 (
IMAX
 (
OR
 (
FIXP
 PERIOD.ms)
									      0)
									  16)
								    1000))
							    NIL))
                                                             (* A period of NIL means we aren't using the INPUT 

							     side)

				   (
SETQ
 \RS232BACKGROUNDSTATE (
LIST
 ON? PERIOD.ms))
				   (if
 (
SELECTQ
 ON?
						((BOTH OUTPUT)
						  T)
						NIL)
				       then
 (if
 (
NOT
 PROCP)
						then
 (
ADD.PROCESS
 (
QUOTE
 (\RS232.OUTPUTBROOM
))
								  (
QUOTE
 RESTARTABLE)
								  (
QUOTE
 HARDRESET))
					      else
 (
RESTART.PROCESS
 PROCP))
				     else
 (
DEL.PROCESS
 (
QUOTE
 \RS232.OUTPUTBROOM)))
				   (if
 (
AND
 (
SELECTQ
 ON?
						     ((BOTH INPUT)
						       T)
						     NIL)
					    (
NOT
 \RS232DLionRS232C?))
				       then
 (
MAPC
 (
CONSTANT
 (
LDIFFERENCE
 RS232BACKGROUNDLOCKEDFNS
									 (
QUOTE
 (
\RS232C.PROCESSINTERRUPT
 \RS232C.PERIODIC.FN))))
						  (
FUNCTION
 \LOCKFN))
					    (
MAPC
 (
CONSTANT
 RS232BACKGROUNDLOCKEDVARS)
						  (
FUNCTION
 \LOCKVAR))
					    (
SETQ
 \PERIODIC.INTERRUPT.FREQUENCY
					      (
IQUOTIENT
 (
ITIMES
 60 PERIOD.ms)
							 960))
					    (
SETQ
 \PERIODIC.INTERRUPT (
FUNCTION
 \RS232.PERIODIC.FN))
				     else
 (
SETQ
 \PERIODIC.INTERRUPT)))
				 (OFF (
SETQ
 \RS232BACKGROUNDSTATE)
				      (if
 (
NOT
 \RS232DLionRS232C?)
					  then
 (
SETQ
 \PERIODIC.INTERRUPT))
				      (
AND
 PROCP (
DEL.PROCESS
 (
QUOTE
 \RS232.OUTPUTBROOM)))
				      (
SETQ
 \RS232BACKGROUNDERRORSTATUS))
				 (
\ILLEGAL.ARG
 ON?)))
		      (
FIND.PROCESS
 (
QUOTE
 \RS232.OUTPUTBROOM)))))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY \RS232BACKGROUNDSTATE 
	  \RS232BACKGROUNDERRORSTATUS)
)



(* "Various parameters installed by RS232INIT")



(RPAQ? \RS232DefaultBaudRate
 1200)

(RPAQ? \RS232DefaultBLOCKINTERVAL.ms
 250)



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



(RPAQQ RS232INIT
 NIL)

(RPAQQ \RS232DEVICE
 NIL)

(RPAQQ \RS232STREAM
 NIL)

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

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

(RPAQ? \RS232Divisor
 NIL)

(RPAQ? \RS232.ByteIntervalCap.ms
 NIL)

(RPAQ? \RS232.ByteIntervalCap.tics
 NIL)

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

(RPAQ? \RS232.Tovh&BIC16.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: DONTCOPY 
[DECLARE: EVAL@COMPILE 

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

(RS232INIT

  (LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl Port)
                                                             (* JonL " 5-Nov-84 22:16")

    (
SETQ
 \RS232DLion?)
    (RS232BACKGROUND
 (
QUOTE
 OFF))
    (
SETQ
 \PERIODIC.INTERRUPT)
    (
SELECTQ
 Port
	     (NIL (
SETQ
 Port (if
 RS232DLionTTYP
				 then
 (
QUOTE
 TTYPort)
			       else
 (
QUOTE
 RS232C))))
	     ((TTYPort RS232C))
	     (
\ILLEGAL.ARG
 Port))
    (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)


          (* Ring buffers are rounded up to a multiple of the page size, and then up to a power of two.

	  The "SIZE" globalvars are stored decremented by -1 so that they serve as a modulus mask.)



    (
PROG
 ((BlockAllocationInBytes 0))
          (
SETQ
 \RS232IRING.SIZE (
SUB1
 (if
 (
SELECTC
 \MACHINETYPE
						    (\DANDELION (
EQ
 Port (
QUOTE
 RS232C)))
						    NIL)
					   then
 

          (* This extra allotment is to allow for IOCBs to dribble across the IRING end, and also to hold the IOCB at the high

	  end of this last page.)



						(add
 BlockAllocationInBytes BYTESPERPAGE)
						(
ITIMES
 BYTESPERPAGE (if
 (
ILEQ
 BaudRate 1200)
									 then
 4
								       elseif
 (
ILEQ
 BaudRate 4800)
									 then
 8
								       else
 16))
					 else
 (
ITIMES
 2 BYTESPERPAGE))))

          (* This is really unnecessary unless the user is allowed to specify the \RS232IRING.SIZE -- currently we just set it

	  according to the previous formula.)



          (
OR
 (
EQ
 (
MASK.1'S
 0 (
INTEGERLENGTH
 (
SUB1
 (CEIL \RS232IRING.SIZE BYTESPERPAGE))))
		  \RS232IRING.SIZE)
	      (
SHOULDNT
 (
QUOTE
 \RS232IRING.SIZE)))
          (add
 BlockAllocationInBytes (
ADD1
 \RS232IRING.SIZE))
          (if
 (if
 (
NOT
 (type?
 ARRAYBLOCK \RS232IRINGBUF))
		elseif
 (
IGEQ
 BlockAllocationInBytes (#ARRAYBLOCKBYTES \RS232IRINGBUF))
		  then
 (\RS232UNLOCKBUF
 \RS232IRINGBUF)
		       T)
	      then
 (
SETQ
 \RS232IRINGBUF (
\ALLOCBLOCK
 (FOLDLO BlockAllocationInBytes BYTESPERCELL)
						     NIL CELLSPERPAGE)))
          (
\TEMPLOCKPAGES
 \RS232IRINGBUF (\#PAGES.BASEBYTES
 \RS232IRINGBUF (#ARRAYBLOCKBYTES 
										   \RS232IRINGBUF)))
          (
SETQ
 \RS232IRING.READ (
SETQ
 \RS232IRING.WRITE 0)))
    (
PROG
 ((BlockAllocationInBytes (
ADD1
 (
SETQ
 \RS232ORING.SIZE
					   (
MASK.1'S
 0 (
INTEGERLENGTH
 (
SUB1
 (CEIL \RS232ORING.SIZE 
										  BYTESPERPAGE))))))))
          (if
 (if
 (
NOT
 (type?
 ARRAYBLOCK \RS232ORINGBUF))
		elseif
 (
IGEQ
 BlockAllocationInBytes (#ARRAYBLOCKBYTES \RS232ORINGBUF))
		  then
 (\RS232UNLOCKBUF
 \RS232ORINGBUF)
		       T)
	      then
 (
SETQ
 \RS232ORINGBUF (
\ALLOCBLOCK
 (FOLDLO BlockAllocationInBytes BYTESPERCELL)
						     NIL CELLSPERPAGE)))
          (
\TEMPLOCKPAGES
 \RS232ORINGBUF (\#PAGES.BASEBYTES
 \RS232ORINGBUF (#ARRAYBLOCKBYTES 
										   \RS232ORINGBUF)))
          (
SETQ
 \RS232ORING.READ (
SETQ
 \RS232ORING.WRITE 0)))
    (
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&BIC4.tics (
IPLUS
 TimerOverhead.tics (
ITIMES
 4 \RS232.ByteIntervalCap.tics)))
	(
SETQ
 \RS232.Tovh&BIC16.tics (
IPLUS
 TimerOverhead.tics (
ITIMES
 16 \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
 (
OR
 (
NULL
 NoOfStopBits)
			       (
EQP
 NoOfStopBits 1))
			   then
 1
			 else
 2))
    (
SELECTC
 \MACHINETYPE
	     (\DANDELION (
SETQ
 \RS232DLion? T)
			 (\RS232.DLINIT
 BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl 
					Port))
	     (\DOLPHIN (
SETQ
 \RS232DLion?)
		       (\RS232.D0INIT
 BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl 
				      Port))
	     (
HELP
 "RS232 not implemented on this kind of machine"))
    (if
 (
NOT
 (type?
 FDEV \RS232DEVICE))
	then
 (\RS232.CREATEFDEV
))
    (
OR
 (type?
 STREAM \RS232STREAM)
	(
SETQ
 \RS232STREAM (create
 STREAM
				   USERCLOSEABLE _ T
				   USERVISIBLE _ NIL
				   ACCESSBITS _ BothBits
				   DEVICE _ \RS232DEVICE)))
    (freplace
 FULLFILENAME of
 \RS232STREAM with
 (
QUOTE
 {RS232}))
    (
\SETACCESS
 \RS232STREAM (
QUOTE
 BOTH))
    (
SETQ
 RS232INIT
      (create
 RS232CHARACTERISTICS
	      BAUDRATE _ BaudRate
	      BITSPERCHAR _ BitsPerSerialChar
	      PARITY _ Parity
	      STOPBITS _ NoOfStopBits
	      MODEMCONTROL _ ModemControl
	      TTYP _ Port))
    (
OR
 (
FMEMB
 \RS232STREAM \OPENFILES)
	(
\ADDOFD
 \RS232STREAM))
    (if
 ModemControl
	then
 (RS232MODEMCONTROL
 ModemControl)
	     (
SETQ
 ModemControl (RS232MODEMCONTROL
)))
    (
SETUPTIMER
 0 \RS232DING.BOX)
    RS232INIT))

(RS232SHUTDOWN

  (LAMBDA (STREAM)                                           (* JonL " 5-Oct-84 00:23")

    (
OR
 STREAM (
SETQ
 STREAM \RS232STREAM))
    (if
 (
EQ
 STREAM \RS232STREAM)
	then
 (if
 (fetch
 ACCESS of
 STREAM)
		 then
                                        (* Calling the eventfn simply to "shut things down")

		      (\RS232EVENTFN
 \RS232DEVICE (
QUOTE
 BEFOREMAKESYS)))
                                                             (* A non-null value for RS232INIT is how 

							     \REVALIDATEFILE determines whether to re-open)

	     )
    (
\DELETEOFD
 STREAM)
    (
SETQ
 RS232INIT)))

(\RS232.D0INIT

  (LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl)
                                                             (* JonL "22-Jun-84 19:10")

    (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))
	   LCRegister)
          (SETQ BitsPerSerialChar (IPLUS WordLengthSelect 5))
          (INS8250RESET)
          (\RS232LINECONTROL
 DLAB)                           (* Sets the DLAB (only) in LineControl register.)

          (OSTROBE LOWDIVISORREG (LOADBYTE \RS232Divisor 0 8))
          (OSTROBE HIDIVISORREG (LOADBYTE \RS232Divisor 8 8))
          (SETQ LCRegister (\RS232LINECONTROL
 (LOGOR WordLengthSelect StopBitsSelect 
						     ParityEnable/Select))
                                                             (* Notice this will also set the DLAB bit to 0)

	    )
          (if
 (OR (NEQ DLAB (LOADBYTE LCRegister 0 8))
		  (NEQ 0 (LOADBYTE (ISTROBE MODEMCONTROLREG)
				   0 8)))
	      then
 (ERROR "RS232 UART not functioning"))
          (for
 I to
 10
	     do
 (BLOCK \RS232.ByteIntervalCap.ms)
		(if
 (OR (NOT (BITTEST (ISTROBE LINESTATUSREG)
				      DR))
			(NEQ (ISTROBE DR)
			     (MASK.1'S 0 8)))
		    then
 (RETURN))
	     finally
 (ERROR "Excessive noise on RS232 line (possibly not connected to anything?)"))
          (OSTROBE INTERRUPTENABLEREG (CONSTANT (LOGOR ERBFI ELSI))))))

(\RS232.DLINIT

  (LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl Port)
                                                             (* JonL " 5-Nov-84 22:18")

    (
OR
 (
\TIMER.TIMERP
 \BusyWait.BOX)
	(
SETQ
 \BusyWait.BOX (
SETUPTIMER
 0)))
    (if
 (
NEQ
 Port (
QUOTE
 RS232C))
	then
 (
SETQ
 \RS232DLionRS232C?)
	     (
PROGN
 (
SETQ
 \DLionTTYCommandLoc (LOCF (fetch
 DLTTYPORTCMD of
 \IOPAGE)))
		    (
SETQ
 \DLionTTYInLoc (LOCF (fetch
 DLTTYIN of
 \IOPAGE)))
		    (
SETQ
 \DLionTTYOutLoc (LOCF (fetch
 DLTTYOUT of
 \IOPAGE))))
	     (DLTTYPORTPOKE off 3000)
	     (DLTTYPORTPOKE on)
	     (replace
 (DLTTYInCSB charPresent) of
 \DLionTTYInLoc with
 NIL)
	     (with
 DLTTYOutCSB \DLionTTYOutLoc (
SETQ
 notifyMask 0)
		   (
SETQ
 onOff DLTtyOutParameter.on)
		   (
SETQ
 baudRate
		     (if
 (
EQ
 BaudRate 110)
			 then
 2
		       else
 (
CAR
 (
NTH
 (
QUOTE
 (15 14 12 10 7 6 5 4 1))
				      (
IDIFFERENCE
 (
INTEGERLENGTH
 \RS232Divisor)
						   2)))))
		   (
SETQ
 stopBits (if
 (
EQ
 NoOfStopBits 1)
				      then
 1
				    elseif
 (
ILESSP
 BitsPerSerialChar 6)
				      then
                   (* Case which mimics the INS8250 with 1.5 stop bits)

					   2
				    else
                     (* DLion code for 2 stop bits)

					 3))
		   (
SETQ
 parity (
SELECTQ
 Parity
					 (NIL 0)
					 (ODD 1)
					 (EVEN 3)
					 (
SHOULDNT
)))
		   (
SETQ
 charLength (
IDIFFERENCE
 BitsPerSerialChar 5))
		   (
SETQ
 clearToSend T)
		   (
SETQ
 dataSetReady T))
	     (DLTTYPORTPOKE setAllParameters)
      else
 (if
 (fetch
 rs232CAbsent of
 \IOPAGE)
	       then
 (
ERROR
 "This machine doesn't have an RS232C port"))
	   (
SETQ
 \RS232DLionRS232C? T) 

          (* * Note that the periodic interrupt can come in during some other call to \RS232C.BUSYWAIT even though that 

	  function is UNINTERRUPTABLY)



	   (
OR
 (
AND
 (
\TIMER.TIMERP
 \RS232C.PERIODIC.BOX)
		    (
NEQ
 \RS232C.PERIODIC.BOX \BusyWait.BOX))
	       (
SETQ
 \RS232C.PERIODIC.BOX (
SETUPTIMER
 0)))

          (* * This number must always be even, because the transfer of bytes from the IOP is to a word address;

	  hence bytes start coming in at the "hibyte" or even byte index.)



	   (
SETQ
 \RS232C.IOCBdataLength (if
 (
ILEQ
 BaudRate 600)
					    then
 8
					  elseif
 (
IGEQ
 BaudRate 9600)
					    then
 128
					  else
 (
IQUOTIENT
 BaudRate 75)))
	   (
SETQ
 \RS232C.INTERPUTINTERVAL.ticks (
ITIMES
 \RS232.ByteIntervalCap.tics 
							\RS232C.IOCBdataLength))
	   (
PROG
 ((SLOPCNTR (FOLDLO (#ARRAYBLOCKBYTES \RS232IRINGBUF)
				    BYTESPERWORD)))

          (* * Remember, the last page of the InputRingBuffer is a "slop" page that, among other things, contains some IOCB 

	  structures. Slop is needed because a bufferload may have to begin on the last word or so of the real input ring 

	  buffer; so we let it dribble in, and then fastMoveBytes it back down to the other end of the ring)



	         (
PROGN
                                      (* Create the Parameter CSB)

			(
SETQ
 \DLionRS232CParameterCSB (LOCF (fetch
 DLRS232CPARAMETERCSBLO
								of
 \IOPAGE)))
			(with
 DLRS232CiopParameterCSB \DLionRS232CParameterCSB 
                                                             (* Note that the IOP wants times in centiseconds.)

			      (
SETQ
 frameTimeout 13)         (* frameTimeout is to be essentially half the interval 

							     for a short BREAK interrupt on the line.)

			      (
SETQ
 correspondent RS232C.correspondentTTYHOST)
                                                             (* Allegedly, 4 is the ttyHost encoding!)

			      (
SETQ
 syncChar 0)
			      (
SETQ
 resetRingHeard T)
			      (
SETQ
 resetBreakDetected T)
			      (
SETQ
 resetDataLost T)
			      (
SETQ
 requestToSend T)
			      (
SETQ
 dataTerminalReady T)
			      (
SETQ
 stopBits (
LRSH
 NoOfStopBits 1))
			      (
SETQ
 lineType RS232C.asynchronous)
			      (
SETQ
 parity (
SELECTQ
 Parity
						    (ODD 1)
						    (EVEN 2)
						    0))
			      (
SETQ
 charLength (
IDIFFERENCE
 BitsPerSerialChar 5))
			      (
SETQ
 syncCount 0)
			      (
SETQ
 lineSpeed
				(if
 (
EQ
 BaudRate 110)
				    then
 2
				  else
 (
CAR
 (
NTH
 (
QUOTE
 (13 12 10 8 7 6 5 4 1))
						 (
IDIFFERENCE
 (
INTEGERLENGTH
 \RS232Divisor)
							      2)))))
			      (
SETQ
 interruptMask 0)))
	         (
PROGN
                                      (* Create the input IOCB)

			(
SELECTQ
 T
				 (T 

          (* * Stuff to be done in Domino.10)


                                                             (* Grab some segment-0 space, hopefully in a "safe" 

							     place. Try the the so-called "unused" space in the 

							     IOPAGE.)

				    (
SETQ
 \DLionRS232CgetIOCB \KLUDGY.SEGMENT0SPACE.FOR.IOCB))
				 NIL)
			(
SELECTQ
 NIL
				 (T 

          (* * Stuff to be done when switching over to Domino.11)



				    (add
 SLOPCNTR (
IMINUS
 (SIZEF DLRS232CIOCB)))
				    (
SETQ
 \DLionRS232CgetIOCB (
\ADDBASE
 \RS232IRINGBUF SLOPCNTR)))
				 NIL)
			(\RS232C.FILLINIOCB
 \DLionRS232CgetIOCB (
QUOTE
 INPUT)
					    \RS232IRINGBUF 0 \RS232C.IOCBdataLength T)
			(replace
 DLRS232CGETCSB of
 \IOPAGE with
 \DLionRS232CgetIOCB))
	         (
PROGN
                                      (* Create the output IOCB)

			(add
 SLOPCNTR (
IMINUS
 (SIZEF DLRS232CIOCB)))
			(
SETQ
 \DLionRS232CputIOCB (
\ADDBASE
 \RS232IRINGBUF SLOPCNTR))
			(\RS232C.FILLINIOCB
 \DLionRS232CputIOCB (
QUOTE
 OUTPUT)
					    \RS232ORINGBUF 0 0 T)
			(replace
 DLRS232CPUTCSB of
 \IOPAGE with
 \DLionRS232CputIOCB))
	         (DLRS232POKE off 3000)
	         (DLRS232POKE on)
	         (DLRS232POKE majorSetParameters)
	         (
OR
 (DLRS232CSETPARAMETERSUCCESS?)
		     (
SHOULDNT
 "Failed to set parameters for RS232C port"))
	         (
SETQ
 \RS232C.PUTTIMER (
SETUPTIMER
 \RS232C.INTERPUTINTERVAL.ticks \RS232C.PUTTIMER
						    (
QUOTE
 TICKS)))
	         (
MAPC
 (
CONSTANT
 (
LDIFFERENCE
 RS232BACKGROUNDLOCKEDFNS (
QUOTE
 (\RS232.DATAREADY

										\RS232.PERIODIC.FN 
									  \RS232.PROCESSINTERRUPT))))
		       (
FUNCTION
 \LOCKFN))
	         (
MAPC
 (
CONSTANT
 RS232BACKGROUNDLOCKEDVARS)
		       (
FUNCTION
 \LOCKVAR))
	         (
SETQ
 \PERIODIC.INTERRUPT.FREQUENCY (
IQUOTIENT
 (
ITIMES
 60
									(if
 (
IGEQ
 BaudRate 9600)
									    then
 16
									  elseif
 (
ILEQ
 BaudRate 1200)
									    then
 128
									  else
 (
IQUOTIENT

										 (
ITIMES
 16 9600)
										 BaudRate)))
								960))

          (* * Set the \PERIODIC.INTERRUPT.FREQUENCY such that we poll the channel at least every 128ms, and exponentially 

	  faster when going over 1200 baud.)



	         (
SETQ
 \RS232C.BACKGROUNDSTATUS.FREQUENCY (
IMAX
 1 (
IQUOTIENT
 (
IQUOTIENT
 128 16)
									     
								    \PERIODIC.INTERRUPT.FREQUENCY)))

          (* * The number 8 will divide a 16ms ticker into 128ms intervals. We need a divisor of \PERIODIC.INTERRUPT.FREQUENCY

	  to get 128ms intervals, in order to poll for BREAK signals.)



	         (
SETQ
 \RS232C.BACKGROUNDSTATUS.COUNTER 0)
	         (
SETQ
 \PERIODIC.INTERRUPT (
FUNCTION
 \RS232C.PERIODIC.FN))))))

(\RS232UNLOCKBUF

  (LAMBDA (BUF)                                              (* JonL "13-Jun-84 21:02")

    (if
 (type?
 ARRAYBLOCK BUF)
	then
 (\TEMPUNLOCKPAGES BUF (\#PAGES.BASEBYTES
 BUF (#ARRAYBLOCKBYTES BUF)))
      else
 (HELP BUF "Non standard kind of buffer"))))

(\RS232EVENTFN

  (LAMBDA (DEVICE EVENT)                                     (* JonL "31-Oct-84 19:50")

    (if
 RS232INIT
	then
 (
SELECTQ
 EVENT
		      ((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS BEFORESAVEVM)
			(
OR
 (fetch
 ACCESS of
 \RS232STREAM)
			    (
SHOULDNT
))                      (* How could the stream be closed while RS232INIT is 

							     non-null?)

			(if
 (
AND
 (
\IOMODEP
 \RS232STREAM (
QUOTE
 OUTPUT)
					   (
QUOTE
 NOERROR))
				 (
OR
 (
NOT
 RS232XON\XOFF?)
				     (
NOT
 RS232XOFF?)))
			    then
 (RS232FORCEOUTPUT
))
			(replace
 (RS232CHARACTERISTICS MODEMCONTROL) of
 RS232INIT
			   with
 (
CAR
 (
NLSETQ
 (RS232MODEMCONTROL
 NIL))))
			(
SELECTQ
 EVENT
				 (BEFORESAVEVM)
				 (
PROGN
 (if
 \RS232BACKGROUNDSTATE
					    then
             (* Preserve state over the sysout/logout)

						 (
SETQ
 \RS232BACKGROUNDSTATE
						   (
PROG1
 \RS232BACKGROUNDSTATE (RS232BACKGROUND

							    (
QUOTE
 OFF)))))
					(if
 \RS232DLion?
					    then
 (if
 \RS232DLionRS232C?
						     then
 (DLRS232POKE off NOWAIT)
						   else
 (\DLTTYPORT.BUSYWAIT
 (
QUOTE
 NOERROR)
									     2000)
							(replace
 (DLTTYOutCSB onOff) of
 
										  \DLionTTYOutLoc
							   with
 DLTtyOutParameter.off)
							(DLTTYPORTPOKE off NOWAIT NOERROR))
					  else
 (INS8250RESET))
					(
SELECTQ
 EVENT
						 ((BEFORESYSOUT BEFOREMAKESYS)
                                                             (* Flush these indicators, since we may reload onto a 

							     Dolphin)

						   (
SETQ
 \RS232DLion? (
SETQ
 \RS232DLionRS232C? NIL)))
						 NIL))))
		      ((NIL AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
                                                             (* Re-open the RS232 port. Note that it will also set 

							     RS232DLionTTYP)

			(
APPLY
 (
FUNCTION
 RS232INIT)
			       RS232INIT)
			(if
 (
NOT
 \RS232DLionRS232C?)
			    then
                             (* The \RS232DLionRS232C? case automatically turns on 

							     background.)

				 (
APPLY
 (
FUNCTION
 RS232BACKGROUND)
					\RS232BACKGROUNDSTATE)))
		      NIL))))

(\RS232.CREATEFDEV

  (LAMBDA NIL                                                (* JonL " 5-Oct-84 03:19")

    (SETQ \RS232DEVICE (create
 FDEV
			       DEVICENAME _(QUOTE RS232)
			       RANDOMACCESSP _ NIL
			       PAGEMAPPED _ NIL
			       NODIRECTORIES _ T
			       FDBINABLE _ NIL
			       FDBOUTABLE _ NIL
			       FDEXTENDABLE _ NIL
			       CLOSEFILE _(FUNCTION RS232SHUTDOWN)
			       DELETEFILE _(FUNCTION NILL)
			       EVENTFN _(FUNCTION \RS232EVENTFN)
			       GENERATEFILES _(FUNCTION \GENERATENOFILES)
			       GETFILEINFO _(FUNCTION NILL)
			       GETFILENAME _(FUNCTION NILL)
			       OPENFILE _(FUNCTION \RS232OPENFILE)
			       REOPENFILE _(FUNCTION \RS232REOPENFILE)
			       SETFILEINFO _(FUNCTION NILL)
			       TRUNCATEFILE _(FUNCTION NILL)
			       BIN _(FUNCTION (LAMBDA (STREAM)
				   (RS232READBYTE
 T)))
			       BOUT _(FUNCTION (LAMBDA (STREAM BYTE)
				   (RS232WRITEBYTE
 BYTE (NULL \RS232DLionRS232C?))))
			       PEEKBIN _(FUNCTION (LAMBDA (STREAM)
				   (bind
 C until
 (SETQ C (RS232PEEKBYTE
)) do
 (BLOCK)
				      finally
 (RETURN C))))
			       READP _(FUNCTION RS232PEEKBYTE)
			       BACKFILEPTR _(FUNCTION (LAMBDA (STREAM)
				   (RINGB.INCREMENT \RS232IRING.READ -1 \RS232IRING.SIZE)))
			       GETEOFPTR _(FUNCTION \ILLEGAL.DEVICEOP)
			       EOFP _(FUNCTION NILL)
			       BLOCKIN _(FUNCTION \RS232READBASEBYTES)
			       BLOCKOUT _(FUNCTION \RS232WRITEBASEBYTES)
			       RENAMEFILE _(FUNCTION \ILLEGAL.DEVICEOP)))
    (\DEFINEDEVICE (QUOTE RS232)
		   \RS232DEVICE)))

(\RS232OPENFILE

  (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)                 (* JonL " 5-Oct-84 00:15")

    (
APPLY
 (
FUNCTION
 RS232INIT)
	   (
MAPCAR
 (
DEFERREDCONSTANT
 (
ARGLIST
 (
QUOTE
 RS232INIT)))
		   (
FUNCTION
 (LAMBDA (
ARG
)
		       (
CADR
 (
FASSOC
 ARG OTHERINFO))))))     (* A side effect of RS232INIT is setting the globalvar 

							     \RS232STREAM)

    \RS232STREAM))

(\RS232REOPENFILE

  (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV STREAM)          (* JonL "31-Oct-84 20:28")

    (if
 (
NULL
 RS232INIT)
	then
                                                 (* Nothing to do if there is no saved info on UART 

							     state)

	     NIL
      elseif
 (if
 (
EQ
 (
MACHINETYPE
)
		     (
QUOTE
 DANDELION))
		 then
 T
	       else
 (
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 (
LOGAND
 (ISTROBE MODEMCONTROLREG)
						    (
CONSTANT
 (
LOGOR
 OUT1 OUT2)))))))
	then
                                                 (* Note the similarity to the AFTERLOGOUT case of 

							     \RS232EVENTFN)

	     (
APPLY
 (
FUNCTION
 RS232INIT)
		    RS232INIT)
	     \RS232STREAM)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms 
	  \RS232.ByteIntervalCap.tics \RS232.Tovh&BIC4.tics \RS232.Tovh&BIC16.tics 
	  \RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms 
	  \RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP RS232INIT 
	  \RS232DEVICE \RS232STREAM \RS232.TIMEOUT.BOX \RS232.DING.BOX)
)



(* "Basic driver functions")


(DECLARE: EVAL@COMPILE 

(PUTPROPS RS232PEEKBYTE MACRO 
(NIL
  (PROGN (COND
	   (\RS232DLionRS232C? (AND \RS232BACKGROUNDERRORSTATUS (\RS232C.PROCESSINTERRUPT)))
	   (T (COND
		((COND
		    (\RS232DLion? (BITTEST (FETCHFIELD (QUOTE (NIL 0 (BITS . 15)))
						       \DLionTTYInLoc)
					   32888))
		    (T (IGEQ (READPRINTERPORT)
			     INTRPT)))
		  (\RS232.PROCESSINTERRUPT)))))
	 (if
 (NEQ \RS232IRING.READ \RS232IRING.WRITE)
	     then
 (\GETBASEBYTE \RS232IRINGBUF \RS232IRING.READ)))))

(PUTPROPS RS232READBYTE MACRO 
(X
  (if
 X
      then
 (QUOTE IGNOREMACRO)
    else
                                                     (* Take only easy case)

	 (QUOTE (PROGN (COND
			 (\RS232DLionRS232C? (AND \RS232BACKGROUNDERRORSTATUS (
						    \RS232C.PROCESSINTERRUPT)))
			 (T (COND
			      ((COND
				  (\RS232DLion? (BITTEST (FETCHFIELD (QUOTE (NIL 0 (BITS . 15)))
								     \DLionTTYInLoc)
							 32888))
				  (T (IGEQ (READPRINTERPORT)
					   INTRPT)))
				(\RS232.PROCESSINTERRUPT)))))
		       (if
 (NEQ \RS232IRING.READ \RS232IRING.WRITE)
			   then
 (\GETBASEBYTE \RS232IRINGBUF (PROG1 \RS232IRING.READ
								    (SETQ \RS232IRING.READ
								      (LOGAND (IPLUS \RS232IRING.READ 
										     1)
									      \RS232IRING.SIZE))))))))
))
)
(DEFINEQ

(RS232PEEKBYTE

  (LAMBDA NIL                                                (* JonL "28-Jan-84 00:58")

    (RS232INITIALIZECHECK)
    (\MACRO.MX
 (RS232PEEKBYTE))))

(RS232LISTEN

  (LAMBDA NIL                                                (* JonL "13-Jun-84 22:57")

    (PROG NIL
      A                                                      (* This should be just (SERVICEIRING) but the DLion may 

							     have numerous characters buffered up in the IOP)

          (SERVICEIRING)
          (RETURN (LOGAND (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
			  \RS232IRING.SIZE)))))

(RS232READBYTE

  (LAMBDA (WAIT? timerUnits)                                 (* JonL "27-Jan-84 20:39")

    (RS232INITIALIZECHECK)
    (SERVICEIRING)
    (if
 (IRINGB.ATLEAST 1)
	then
 (POPRS232IRING)
      elseif
 (NOT (FIXP WAIT?))
	then
 (AND WAIT? (find
 BYTE suchthat
 (SETQ BYTE (RS232READBYTE
 \RCLKSECOND (QUOTE TICKS)))))
      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
 (ADD1 (IQUOTIENT (SELECTQ timerUnits
					 (MILLISECONDS WAIT?)
					 (SECONDS (TIMES WAIT? 1000))
					 0)
				\RS232.BLOCKINTERVAL.ms))
	      bind
 BYTE first
 (SERVICEIRING)
	      do
                                             (* Admit BLOCKing only when timer units specify 

							     milliseconds or seconds.)

		 (\RS232CHECK.BLOCK
)
		 (if
 (SETQ BYTE (RS232READBYTE
 \RS232.BLOCKINTERVAL.tics (QUOTE TICKS)))
		     then
 (RETURN BYTE))))))

(RS232READWORD

  (LAMBDA (WAIT? timerUnits)                                 (* JonL " 1-Aug-84 00:17")

    (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
 (SETQ LO (RS232READBYTE
 WAIT? timerUnits))
	      then
                                           (* Ok)

	    elseif
 (WITHOUTRS232PERIODICFN (if
 (NULL (SETQ LO (RS232READBYTE
)))
					       then
          (* Just checking to be sure that one more byte didn't 

							     creep through.)

						    (PUSHRS232IRING HI)
						    T))
	      then
                                           (* FOO! Didn't get both bytes in time, so put first one 

							     back.)

		   (RETURN))
          (RETURN (create
 WORD
			  HIBYTE _ HI
			  LOBYTE _ LO)))))

(RS232WRITEBYTE

  (LAMBDA (BYTE FORCEOUT? IGNOREXOFF?)                       (* JonL " 5-Oct-84 01:46")

    (RS232INITIALIZECHECK)
    (
SETQ
 BYTE (
LOADBYTE
 BYTE 0 8))
    (
PROG
 ((BUFFERSTARTSEMPTY (
NOT
 (ORINGB.ATLEAST 1)))
	   BYTEHASBEENPUSHED LineStatusVal)
      A   (UNINTERRUPTABLY                                   (* Comment PPLossage)

	      (if
 \RS232DLionRS232C?
		  then
 (if
 (
NOT
 BYTEHASBEENPUSHED)
			   then
 (
SETQ
 BYTEHASBEENPUSHED (PUSHRS232ORING BYTE)))
		       (
SETQ
 LineStatusVal (if
 (
OR
 FORCEOUT? (
ILEQ
 2 (ORINGB.FREE)))
					       then
 NIL
					     else
 (
QUOTE
 RS232XOFF?)))
		elseif
 (LINESTATUSERRORSP (
SETQ
 LineStatusVal (\RS232DECODE.LINESTATUS
 LineStatusVal
										       (
QUOTE
 NOERROR)
										       )))
		  then
                                       (* Foo, we just drop thru, and let the loop correct 

							     it.)

		       NIL
		elseif
 (
AND
 BUFFERSTARTSEMPTY (
NULL
 BYTEHASBEENPUSHED)
			    (
OR
 IGNOREXOFF? (
NOT
 RS232XON\XOFF?)
				(
NOT
 RS232XOFF?))
			    (
OR
 FORCEOUT? (
BITTEST
 LineStatusVal THRE)))
		  then
                                       (* If ring buffer is empty, and we aren't prohibited by

							     XOFF, then just output the char.)

		       (if
 (CHECKTHRE_ LineStatusVal)
			   then
                              (* Remember, this wing can't be taken when 

							     \RS232DLionRS232C?)

				(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 or to wait for IOCB)

			      (
SETQ
 LineStatusVal (
QUOTE
 RS232XOFF?))
		       elseif
 (CHECKTHRE_ LineStatusVal)
			 then
                                (* Send out 1 character, in order to relieve strain on 

							     output ring buffer.)

                                                             (* Remember, this wing can't be taken when 

							     \RS232DLionRS232C?)

			      (
SETQ
 LineStatusVal)
			      (RS232DATAO (POPRS232ORING))
		       elseif
 (
NULL
 LineStatusVal)
			 then
                                (* Rare Losing case where we waited one round 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
 (
EQ
 LineStatusVal (
QUOTE
 RS232XOFF?))
	      then
                                           (* Block here if we really need to transmit at least 

							     one character, but transmission prohibited by XOFF)

		   (until
 (
AND
 (
NOT
 (
AND
 RS232XON\XOFF? RS232XOFF?))
			       (
OR
 (
NULL
 \RS232DLionRS232C?)
				   (
ILEQ
 2 (ORINGB.FREE))))
		      do
 (\RS232CHECK.BLOCK
))
		   (
SETQ
 LineStatusVal)
		   (
GO
 A)
	    elseif
 (
AND
 FORCEOUT? (ORINGB.ATLEAST 1))
	      then
 (RS232FORCEOUTPUT
)
	    else
 (SERVICEIRING)
		 (if
 (
AND
 BUFFERSTARTSEMPTY BYTEHASBEENPUSHED (BACKGROUND? BOTH OUTPUT))
		     then
 (
NOTIFY.EVENT
 \RS232ORINGEVENT)
			  (CHECKUART))))
    BYTE))

(RS232FORCEOUTPUT

  (LAMBDA (WAITFORFINISH)                                    (* JonL " 5-Oct-84 00:08")

                                                             (* Returns the number of characters found in the 

							     buffer, which are written out "on the lines")

    (if
 \RS232DLionRS232C?
	then
 (
PROG1
 (ORINGB.USED)
		    (\RS232.SERVICEORING
 NIL T))
	     (if
 WAITFORFINISH
		 then
 (until
 (
NOT
 (fetch
 iopPutBusy of
 \IOPAGE)) do
 (
BLOCK
)))
      else
 ((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))
			(\RS232WRITEBASEBYTES
 NIL \RS232ORINGBUF OFFST #BYTES)
			(
SETQ
 \RS232ORING.READ \RS232ORING.WRITE)
		 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
 BYTESPERPAGE 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
                                        (* Buffer is empty -- nothing to do)

		      (SERVICEIRING)
		      0))
	     0))))
)



(* Block read and write functions)


(DEFINEQ

(RS232READLINE

  (LAMBDA (WAIT? timerUnits OLDSTRBUFFER)                    (* edited: "29-Jun-84 16:36")

    (\RS232INSURE.LINEBUFFER
 BYTESPERPAGE)
    ((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&BIC4.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 " 9-Jul-84 18:12")

    (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?))
    (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)))
	    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)))
							 ))
			  (CHECKUART))
		 (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))
          (RETURN (if
 (ZEROP #CHARS.READ)
		      then
 NIL
		    elseif
 OLDSTRBUFFER
		      then
 (replace
 (STRINGP LENGTH) of
 OLDSTRBUFFER with
 #CHARS.READ)
			   OLDSTRBUFFER
		    elseif
 (AND (IGEQ #CHARS.READ BUFFERSIZE)
				(NULL #CHARS.LIMIT?))
		      then
 (\RS232DECODE.LINESTATUS
 LBOE)
		    else
 (PROG1 (\GETBASESTRING BUFFER 0 #CHARS.READ)
				(CHECKUART)))))))

(\RS232READBASEBYTES

  (LAMBDA (STREAM BASE OFFST NBYTES CALLFROMREADSTRING.PASSWORD STOPCODE? NOBLOCKSFLG WAIT? 
		  timerUnits OLDSTRBUFFER)                   (* JonL "10-Jul-84 15:40")

    (SERVICEIRING)
    (if
 (NEQ CALLFROMREADSTRING.PASSWORD (QUOTE \RS232.BLOCKINTERVAL.BOX))
	then
 (SETQ STOPCODE?)
	     (SETQ NOBLOCKSFLG T)
	     (SETQ WAIT?))
    (PROG ((READSTRINGP)
	   (#CHARS 0)
	   (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
 WAIT?
	      then
 (SELECTQ (CANONICAL.TIMERUNITS timerUnits)
			    (TICKS)
			    (MILLISECONDS (SETQ WAIT? (ITIMES WAIT? \RCLKMILLISECOND)))
			    (SECONDS (SETQ WAIT? (ITIMES WAIT? \RCLKSECOND)))
			    (SHOULDNT)))
      A   (SETQ CHAR (RS232READBYTE
))
          (if
 (AND WAIT? (OR CHAR (NULL WAITFORBYTE.BOX)))
	      then
 (SETQ WAITFORBYTE.BOX (SETUPTIMER WAIT? \RS232.DELAY.BOX (QUOTE TICKS))))
          (if
 CHAR
	      then
 (SETQ CHAR (LOADBYTE CHAR 0 BITSPERBYTE))
		   (\PUTBASEBYTE BASE (IPLUS OFFST #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 (QUOTE TICKS))
				     (SERVICEIRING)))
	      then
 (RETURN #CHARS)
	    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 "30-May-84 22:11")

    (SERVICEIRING)
    (PROG1 (if
 (OR (NOT (SMALLPOSP \RS232LINEBUFFER.SIZE))
		   (NOT (type?
 ARRAYBLOCK \RS232LINEBUFFER))
		   (NOT (ILEQ N \RS232LINEBUFFER.SIZE)))
	       then
 (SETQ N (CEIL N BYTESPERPAGE))           (* Round up to an integral number of pages, for 

							     LOCKPAGES purposes.)

		    ((LAMBDA (BUF)
			(CHECKUART)
			(UNINTERRUPTABLY
                            (AND (SMALLPOSP \RS232LINEBUFFER.SIZE)
				 (type?
 ARRAYBLOCK \RS232LINEBUFFER)
				 (\TEMPUNLOCKPAGES \RS232LINEBUFFER (\#PAGES.BASEBYTES
 
										 \RS232LINEBUFFER 
									    \RS232LINEBUFFER.SIZE)))
			    (\TEMPLOCKPAGES BUF (\#PAGES.BASEBYTES
 BUF N))
			    (SETQ \RS232LINEBUFFER BUF)
			    (SETQ \RS232LINEBUFFER.SIZE N)))
		      (\ALLOCBLOCK (FOLDHI N BYTESPERCELL)
				   NIL CELLSPERPAGE))
		    T)
	   (\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))
	   (SERVICEIRING))))

(RS232INPUTSTRING

  (LAMBDA (STRING.OR.LITATOM NOERRORFLG)                     (* JonL "31-Oct-84 20:56")

    (
PROG
 ((OFFST 1)
	   (WINP T)
	   BASE N M)
          (until
 (
SELECTC
 (
NTYPX
 STR)
			  (\STRINGP (
SETQ
 BASE (fetch
 (
STRINGP
 BASE) of
 STR))
				    (
SETQ
 OFFST (fetch
 (
STRINGP
 OFFST) of
 STR))
				    (
SETQ
 N (fetch
 (
STRINGP
 LENGTH) of
 STR)))
			  (\LITATOM (
SETQ
 BASE (fetch
 (
LITATOM
 PNAMEBASE) of
 STR))
				    (
SETQ
 N (fetch
 (
LITATOM
 PNAMELENGTH) of
 STR)))
			  NIL)
	     bind
 (STR _ STRING.OR.LITATOM) do
 (
SETQ
 STR (
MKSTRING
 STRING.OR.LITATOM)))
          (until
 (
ILEQ
 N 0) when
 (
NULL
 (WITHOUTRS232PERIODICFN
					 (if
 \RS232DLionRS232C?
					     then
            (* Make sure that the most recent input bufferload has 

							     completed, and been serviced.)

						  (until
 (during
 \RCLKSECOND timerUnits
 (
QUOTE
 TICKS)
							    when
 (
NULL
 (fetch
 iopGetBusy
									  of
 \IOPAGE))
							    do
 (
RETURN
 T))
						     do
 (DLRS232POKE abortInput NOWAIT NOERROR)
						     finally
 (\RS232C.PERIODIC.FN
 T)))
					 (if
 (
IGREATERP
 (
SETQ
 M (IRINGB.FREE))
							1)
					     then
            (* Chew off as many bytes as possible and stuff them 

							     into the input ring buffer.)

						  (
FRPTQ
 (
SETQ
 M (
IMIN
 M N))
							 (PUSHRS232IRING (
\GETBASEBYTE
 BASE OFFST))
							 (add
 OFFST 1))
						  (
SETQ
 N (
IDIFFERENCE
 N M)))))
	     do
 (if
 NOERRORFLG
		    then
 (
SETQ
 WINP)
			 (
RETURN
)
		  else
 (\RS232DECODE.LINESTATUS
 RBOE)))
          (
RETURN
 WINP))))
)

(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? N M)               (* JonL " 4-Aug-84 17:39")

    (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
 (NULL N)
	      then
 (SETQ N 1)
	    elseif
 (OR (EQ N 0)
		       (ILESSP #CHARS (IABS N)))
	      then
 (\ILLEGAL.ARG N)
	    else
 (add
 OFFST (SUB1 (if
 (IGREATERP N 0)
				      then
 N
				    elseif
 (ILESSP N 0)
				      then
                   (* -1 means the last character of the string, -2 means 

							     next-to-last etc.)

					   (SETQ N (IPLUS #CHARS N 1))))))
          (if
 (NULL M)
	      then
 (SETQ M #CHARS)
	    elseif
 (ILESSP #CHARS (IABS M))
	      then
 (\ILLEGAL.ARG M)
	    elseif
 (ILESSP M 0)
	      then
 (SETQ M (IPLUS #CHARS M 1)))
          (if
 (EQ 0 (SETQ #CHARS (ADD1 (IDIFFERENCE M N))))
	      then
 (RETURN 0)
	    elseif
 FORCEOUTPUT?
	      then
 (\RS232WRITEBASEBYTES
 (QUOTE RS232WRITESTRING)
					 BASE OFFST #CHARS)
		   (if
 \RS232DLionRS232C?
		       then
 (RS232FORCEOUTPUT
))
	    else
 (bind
 (NCHARSLEFT _ #CHARS)
		       #BYTESMOVING
		       (MAX#BYTES.TO.MOVE _(if
 \RS232DLionRS232C?
					       then
 BYTESPERPAGE
					     elseif
 (ILESSP \RS232Divisor 24)
					       then
 128
					     elseif
 (ILESSP \RS232Divisor 48)
					       then
 256
					     else
 BYTESPERPAGE))
		    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
 T))
		       (SERVICEIRING)
		       (UNINTERRUPTABLY
                           (SETQ #BYTESMOVING (IMIN (if
 (ILEQ \RS232ORING.READ \RS232ORING.WRITE)
							then
 (IDIFFERENCE (ADD1 \RS232IRING.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)



			   (\FASTMOVEBYTES
 BASE OFFST \RS232ORINGBUF \RS232ORING.WRITE #BYTESMOVING)
			   (RINGB.INCREMENT \RS232ORING.WRITE #BYTESMOVING \RS232ORING.SIZE))
		       (SERVICEIRING)
		       (add
 OFFST #BYTESMOVING)
		       (add
 NCHARSLEFT (IMINUS #BYTESMOVING)))
		 (if
 (AND (PROG1 BUFFERSTARTSEMPTY           (* Comment PPLossage)
)
			  (BACKGROUND? BOTH OUTPUT))
		     then
 (NOTIFY.EVENT \RS232ORINGEVENT)))
          (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 " 5-Aug-84 01:26")


          (* * This function can directly be the block output stream function. Returns the number of bytes which are written

	  out "on the lines")



    (if
 (NULL STREAM)
	then
                                                 (* STREAM must be NIL for the calls from 

							     RS232FORCEOUTPUT)

      elseif
 (if
 \RS232DLionRS232C?
		 then
                                        (* Generally speaking, the RS232C case can just put the 

							     chars in the ring buffer)

		      (IGEQ #BYTES (ORINGB.FREE))
	       else
                                          (* Note: Except for the \RS232DLionRS232C? case, this 

							     actually puts the bytes out on the wires;)

		    (ORINGB.ATLEAST 1))
	then
                                                 (* The call to RS232FORCEOUTPUT is guaranteed to clean 

							     out the ring buffer)

	     (RS232FORCEOUTPUT
 T))
    (bind
 STATUS BYTE ImodMAX (#Remaining _ 1)
	  (ITH _ 0)
	  (N _ 1) while
 (ILESSP 0 #Remaining)
       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.)

	  (SETQ ImodMAX 0)
	  (UNINTERRUPTABLY
              (while
 (AND (ILESSP 0 (SETQ #Remaining (IDIFFERENCE #BYTES ITH)))
			  (ILEQ (add
 ImodMAX 1)
				\RS232.MAX#BYTESPERLOOP)
			  (NOT (if
 \RS232DLionRS232C?
				   then
                      (* Simply ascertain that there's room in the buffer)

					(AND (IGEQ 4 (SETQ N (ORINGB.FREE)))
					     (SETQ STATUS RBOE))
				 else
                        (* Ascertain that there's no errors and we're not 

							     gagged)

				      (OR (SETQ STATUS (\RS232CHECK.THRE
))
					  (AND RS232XON\XOFF? RS232XOFF?)))))
		 do
 (if
 \RS232DLionRS232C?
			then
                                 (* For this case, N has previously been set to 

							     (ORINGB.FREE))

			     (SETQ N (IMIN #Remaining \RS232.MAX#BYTESPERLOOP N
					   (ADD1 (IDIFFERENCE \RS232ORING.SIZE \RS232ORING.WRITE))))
			     (\FASTMOVEBYTES
 BASE (IPLUS OFFST ITH)
					     \RS232ORINGBUF \RS232ORING.WRITE N)
			     (RINGB.INCREMENT \RS232ORING.WRITE N \RS232ORING.SIZE)
		      else
 (RS232DATAO (\GETBASEBYTE BASE (IPLUS OFFST ITH))))
		    (add
 ITH N))) 

          (* 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 STATUS (LINESTATUSERRORSP STATUS))
	      then
 (SETQ STATUS (if
 (AND (EQ STATUS RBOE)
					 \RS232DLionRS232C?)
				    then
 (\RS232.SERVICEORING
 (IDIFFERENCE #BYTES ITH)
							      T)
					 NIL
				  else
 (\RS232DECODE.LINESTATUS
 STATUS)))
	    elseif
 (AND \RS232DLionRS232C? (IGEQ #Remaining (ORINGB.FREE)))
	      then
 (RS232FORCEOUTPUT
 T))
	  (\RS232CHECK.BLOCK
))
    (SERVICEIRING)
    #BYTES))

(\RS232BOUTSTRING

  (LAMBDA (STREAM STRING)                                    (* JonL "30-May-84 21:49")

                                                             (* Foo, this could be done with a BOUTS, but we have to 

							     intersperse in the calls to SERVICEIRING)

    (for
 C instring
 STRING eachtime
 (SERVICEIRING) do
 (BOUT STREAM C))
    (CHECKUART)))
)



(* "Modem controls")


(DEFINEQ

(RS232XON\XOFF?

  (LAMBDA (ON?)                                              (* JonL "31-Oct-84 18:24")

                                                             (* Don't even bother trying the XON\XOFF stuff in 

							     Domino.10)

    (DECLARE
 (
GLOBALVARS
 RS232XON\XOFF? RS232XOFF?))
    (
PROG1
 RS232XON\XOFF? (UNINTERRUPTABLY
                              (
SETQ
 RS232XOFF?)
			      (
SETQ
 RS232XON\XOFF? (
NOT
 (
NULL
 ON?)))))))

(RS232MODEMCONTROL

  (LAMBDA NARGS                                              (* JonL "18-Jun-84 21:20")

    (RS232INITIALIZECHECK)
    (SERVICEIRING)
    (PROG1 (SELECTC (RS232MODEMCONTROLIN)
		    (0 NIL)
		    (DTR (QUOTE (DTR)))
		    (RTS (QUOTE (RTS)))
		    ((LOGOR DTR RTS)
		      (QUOTE (DTR RTS)))
		    (SHOULDNT))
	   (if
 (IGEQ NARGS 1)
	       then
 (RS232MODEMCONTROLSET (for
 X in
 (MKLIST (ARG NARGS 1))
					     sum
 (SELECTQ X
							  (DTR DTR)
							  (RTS RTS)
							  (\ILLEGAL.ARG X)))))
	   (SERVICEIRING))))

(RS232MODIFYMODEMCONTROL

  (LAMBDA (SIGNALSONLST SIGNALSOFFLST)                       (* JonL "18-AUG-83 17:50")

    (SERVICEIRING)
    (PROG ((INDEX 0)
	   (SONN (PROG1 (MKLIST SIGNALSONLST)
			(SERVICEIRING)))
	   (SOFF (MKLIST SIGNALSOFFLST)))
          (for
 X in
 (PROG1 (RS232MODEMCONTROL
)               (* Read current state)

			   )
	     do
 (SETQ INDEX (LOGOR (SELECTQ X
					    (DTR DTR)
					    (RTS RTS)
					    (\ILLEGAL.ARG X))
				   INDEX)))
          (for
 X in
 (PROG1 SONN                              (* Comment PPLossage)
)
	     do
 (SETQ INDEX (LOGOR (SELECTQ X
					    (DTR DTR)
					    (RTS RTS)
					    (\ILLEGAL.ARG X))
				   INDEX)))
          (for
 X in
 (PROG1 SOFF                              (* Comment PPLossage)
)
	     do
 (SETQ INDEX (LOGAND (SELECTQ X
					     (DTR (CONSTANT (LOGNOT DTR)))
					     (RTS (CONSTANT (LOGNOT RTS)))
					     (\ILLEGAL.ARG X))
				    INDEX)))                 (* In effect, this is doing set-union and 

							     set-intersection using only SMALLPs.)

          (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 "11-Jun-84 19:41")

    (RS232INITIALIZECHECK)
    (SERVICEIRING)
    (PROG ((MSTAT (RS232MODEMSTATUSIN)))
          (RETURN (if
 (NULL SPEC)
		      then
 (for
 NSPEC in
 (CONSTANT (LIST CTS DSR RI RLSD)) as
 NAME
			      in
 (QUOTE (CTS DSR RI RLSD)) join
 (AND (\RS232.MSP1
 NSPEC MSTAT)
								     (LIST NAME)))
		    else
 (\RS232.MSP1
 SPEC MSTAT))))))

(\RS232.MSP1

  (LAMBDA (SPEC MSTAT)                                       (* JonL "11-May-84 21:18")

    (SERVICEIRING)
    (if
 (SMALLP SPEC)
	then
 (BITTEST MSTAT SPEC)
      elseif
 (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 "12-JUL-83 00:58")

                                                             (* Returns "oldvalue" so can be used by RESETFORM etc.)

                                                             (* Will never be called when running on DLion)

    (PROG ((OLDVAL (ISTROBE LINECONTROLREG)))
          (COND
	    (MASK (SETQ VAL (LOGOR (BITCLEAR OLDVAL MASK)
				   (LOGAND VAL MASK)))))
          (OSTROBE LINECONTROLREG (LOADBYTE VAL 0 8))
          (RETURN OLDVAL))))
)

(PUTPROPS RS232MODEMCONTROL ARGNAMES 

  ((OPTIONAL: SIGNALSONLST)))



(* "Use of XON/XOFF protocols")



(RPAQ? RS232XON\XOFF?
 NIL)

(RPAQ? RS232XOFF?
 NIL)

(PUTPROPS RS232XON\XOFF? GLOBALVAR 
T)

(PUTPROPS RS232XOFF? GLOBALVAR 
T)
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS CHECKTHRE_ MACRO 
((LineStatusVal)
                                                             (* Note that this can't be called when 

							     \RS232DLionRS232C? is true)

  (OR (BITTEST LineStatusVal THRE)
      (NULL (SETQ LineStatusVal (\RS232CHECK.THRE))))))
)
)



(* "Is Transmitter 
					       Holding Register empty?")


(DEFINEQ

(\RS232CHECK.THRE

  (LAMBDA NIL                                                (* JonL "11-Jun-84 16:00")

                                                             (* Returns non-NIL iff there is some kind of error)


          (* Waits for up to 4 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 NIL if THR is empty, and an 

	  THROE error if it isn't empty.)



    (OR (NULL \RS232DLionRS232C?)
	(SHOULDNT))
    (UNINTERRUPTABLY
        (during
 \RS232.Tovh&BIC4.tics bind
 STATUS timerUnits
 (QUOTE TICKS) usingTimer
 (PROG1 
										  \RS232.THRE.BOX 
                                                             (* Comment PPLossage)
)
	   do
 (SETQ STATUS (\RS232DECODE.LINESTATUS
 NIL (QUOTE NOERROR)))
	      (if
 (LINESTATUSERRORSP STATUS)
		  then
 (RETURN STATUS)
		elseif
 (BITTEST THRE STATUS)
		  then
 (RETURN))
	   finally
 (RETURN THROE)))))
)

(RPAQ? \RS232.THRE.BOX
 (SETUPTIMER 0))

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

(ADDTOVAR GLOBALVARS \RS232.THRE.BOX \RS232.ADMIT.BOX)
)



(* "Can BLOCK be 
					       called now?")


(DEFINEQ

(\RS232CHECK.BLOCK

  (LAMBDA (WAIT?.ms)                                         (* JonL "25-Jun-84 03:44")

                                                             (* Returns non-NIL iff it actually does a BLOCK)

    (DECLARE
 (GLOBALVARS \LastWindowButtons)
	     (SPECVARS \INTERRUPTABLE))
    (CHECKUART)
    (PROG1 (if
 WAIT?.ms
	       then
 ((LAMBDA (TIMER)
			(PROG1 (during
 WAIT?.ms usingTimer
 TIMER bind
 FLG do
 (AND (\RS232CHECK.BLOCK
)
										  (SETQ FLG T))
				  finally
 (RETURN FLG))
			       (SETQ \RS232.ADMIT.BOX TIMER)))
		      (if
 \RS232.ADMIT.BOX
			  then
 (PROG1 \RS232.ADMIT.BOX (SETQ \RS232.ADMIT.BOX))
			else
 (SETUPTIMER 0)))
	     elseif
 (OR \RS232DLionRS232C? (AND (OR (OR (KEYDOWNP (QUOTE LEFT))
							(KEYDOWNP (QUOTE MIDDLE))
							(KEYDOWNP (QUOTE RIGHT))
							(KEYDOWNP (QUOTE CENTER)))
						    (KEYDOWNP (QUOTE BLANK-TOP)))
						\INTERRUPTABLE))
	       then
                                          (* Super-cautious, since the FreeVar lookup of 

							     \INTERRUPTABLE may take a long time)

		    (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!)

			     (CHECKUART)
			     (SETQ \LastWindowButtons)
			     (BLOCK))
		    T)
	   (CHECKUART))))
)
(* * 
"Functional interface for what to do if a character is dropped, or a break signal is received."
)



(RPAQ? RS232LOSTCHARFN
 (QUOTE \RS232DING))

(RPAQ? RS232DEVICEERRORFN
 (FUNCTION \RS232.DEVICEERROR))

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

(ADDTOVAR GLOBALVARS RS232LOSTCHARFN RS232DEVICEERRORFN RS232BREAKFN)
)
(DEFINEQ

(\RS232DING

  (LAMBDA (X)                                                (* JonL "31-Oct-84 18:16")

                                                             (* This is the default RS232LOSTCHARFN)

    (if
 (
NULL
 (RS232INPUTSTRING
 (
CONSTANT
 (
MKSTRING
 (
CHARACTER
 (
CHARCODE
 #^G))))))
	then
                                                 (* FOO! no room left)

	     (
\PUTBASEBYTE
 \RS232IRINGBUF \RS232IRING.WRITE \RS232.DROPPEDCHARACTER.CODE))
    (\RS232STABLIZE
 T)))

(\RS232.DEVICEERROR

  (LAMBDA (X)                                                (* JonL "31-Oct-84 17:26")

    (
PROMPTPRINT
 "RS232 Device Error.  Continuing.")
    (\RS232STABLIZE
 T "RS232 port has become unresponsive")))

(\RS232STABLIZE

  (LAMBDA (
RINGBELLS
 ERRORMSG)                               (* JonL "31-Oct-84 17:24")


          (* Waits for up to about 3.5 seconds to see if the line will "stablize" w.r.t. errors. Of course, additional errors 

	  may occur after stablization.)



    (if
 (
AND
 RINGBELLS (
TIMEREXPIRED?
 \RS232DING.BOX))
	then
 (
RINGBELLS
)
	     (
SETUPTIMER
 3000 \RS232DING.BOX))               (* Loop until line "stabilizes")

    (during
 \RS232.LONGBREAK.tics usingTimer
 \RS232STABLIZE.BOX
       when
 (
NOT
 (LINESTATUSERRORSP (\RS232DECODE.LINESTATUS
 NIL (
QUOTE
 NOERROR)))) do
 (
RETURN
)
       finally
 (
SHOULDNT
 (
OR
 ERRORMSG "Continuous linestatus errors on RS232 port")))))
)

(RPAQ? RS232BREAKSEEN?
 NIL)

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

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

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

(ADDTOVAR GLOBALVARS RS232BREAKSEEN? \RS232.DROPPEDCHARACTER.CODE \RS232DING.BOX \RS232STABLIZE.BOX)
)
(DEFINEQ

(RS232SENDBREAK

  (LAMBDA (EXTRALONG?)                                       (* JonL "22-Jun-84 19:42")

    (RS232INITIALIZECHECK)
    (CHECKUART)
    (PROG (STATUS)
          (if
 (NOT EXTRALONG?)
	      then
 (UNINTERRUPTABLY                          (* Comment PPLossage)

		       (\RS232.DOBREAK
 (QUOTE ON)
				       (QUOTE NOWAIT)
				       (QUOTE NOERROR))
		       (during
 \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)
			       else
 (SETQ STATUS)))
		       (\RS232.DOBREAK
 NIL (QUOTE NOWAIT)
				       (QUOTE NOERROR)))
	    else
 (RESETLST (RESETSAVE NIL (QUOTE (\RS232.DOBREAK
)))
			   (\RS232.DOBREAK
 (QUOTE ON))
			   (during
 EXTRALONG? timerUnits
 (QUOTE TICKS) usingTimer
 \RS232.THRE.BOX
			      do
                             (* Just sit around doing nothing, but watching for input

							     and errors.)

				 (\RS232CHECK.BLOCK
)
				 (\RS232DECODE.LINESTATUS
))))
          (if
 STATUS
	      then
 (\RS232DECODE.LINESTATUS
 STATUS)
	    else
 (CHECKUART)
		 (if
 \RS232DLion?
		     then
                                    (* Just checking to be sure that the communication 

							     semaphore finally frees up.)

			  (if
 \RS232DLionRS232C?
			      then
 (\RS232C.BUSYWAIT
)
			    else
 (\DLTTYPORT.BUSYWAIT
))))
          (RETURN T))))

(\RS232.DOBREAK

  (LAMBDA (ON
 WAIT? NOERRORFLG)                              (* JonL "25-Jun-84 03:16")

    (if
 \RS232DLion?
	then
 (if
 \RS232DLionRS232C?
		 then
 (\RS232C.DOCOMMAND
 (if
 ON
					     then
 IopCommand.breakOn
					   else
 IopCommand.breakOff)
					 WAIT? NOERRORFLG)
	       else
 (\DLTTYPORT.DOCOMMAND
 (if
 ON
					      then
 OutControl.breakOn
					    else
 OutControl.breakOff)
					  WAIT? NOERRORFLG))
      else
 (\RS232LINECONTROL
 (if
 ON
				  then
 SBCB
				else
 0)
			      SBCB))))

(RS232CLEARBUFFER

  (LAMBDA (I/O)                                              (* JonL " 4-Oct-84 20:43")

    (RS232INITIALIZECHECK)
    (
PROG
 ((OP (
SELECTQ
 I/O
			((NIL BOTH I/O)
			  (
QUOTE
 BOTH))
			((
INPUT
 IN I)
			  (
QUOTE
 INPUT))
			((
OUTPUT
 OUT O)
			  (
QUOTE
 OUTPUT))
			(if
 (
EQ
 I/O \RS232IRINGBUF)
			    then
 (
QUOTE
 INPUT)
			  elseif
 (
EQ
 I/O \RS232ORINGBUF)
			    then
 (
QUOTE
 OUTPUT)
			  else
 (
\ILLEGAL.ARG
 I/O))))
	   STATUS FLUSHANY?)
          (if
 (
FMEMB
 OP (
QUOTE
 (
OUTPUT
 BOTH)))
	      then
 (\RS232.DOBREAK
 NIL)                      (* Clear the "send BREAK" bit, just in case it had been

							     set somehow.)

		   (WITHOUTRS232PERIODICFN (
AND
 (ORINGB.ATLEAST 1)
						(
SETQ
 FLUSHANY? T))
					   (
SETQ
 \RS232ORING.READ (
SETQ
 \RS232ORING.WRITE 0))
					   (
SETQ
 STATUS
					     (if
 \RS232DLionRS232C?
						 then
 (
PROG1
 (if
 (
NULL
 (DLRS232POKE abortOutput 
										    NOERROR))
								 then
 THROE)
							     (replace
 completed of
 
									      \DLionRS232CputIOCB
								with
 T))
					       else
 (\RS232CHECK.THRE
))))
		   (if
 (
AND
 (
FIXP
 STATUS)
			    (
BITTEST
 STATUS THROE))
		       then
 (
ERROR
 "Can't clear RS232 OUTPUT")))
          (if
 (
FMEMB
 OP (
QUOTE
 (
INPUT
 BOTH)))
	      then
 (WITHOUTRS232PERIODICFN                   (* Comment PPLossage)

					   (if
 \RS232DLionRS232C?
					       then
 (DLRS232POKE abortInput NOWAIT NOERROR)
						    (replace
 completed of
 \DLionRS232CgetIOCB
						       with
 T))
					   (
SETQ
 \RS232IRING.READ (
SETQ
 \RS232IRING.WRITE 0))
					   (
SETQ
 STATUS (\RS232DECODE.LINESTATUS
 NIL (
QUOTE
 NOERROR)))
                                                             (* Flush any possible pending information about input 

							     side errors)

					   (if
 (
OR
 (
BITTEST
 STATUS OE)
						   (IRINGB.ATLEAST 1))
					       then
 (
SETQ
 FLUSHANY? T))))
          (
RETURN
 FLUSHANY?))))
)
(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)

(RPAQQ THROE
 1024)

(RPAQQ DE
 2048)

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

(* * "Line Status Register bits, but RBOE LBOE and THROE are my own" 
" software RingBuffer LineBuffer and TransmittingHoldingRegister" 
" overflow indicators.  DE is for DLion RS232C disaster error.")



(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: EVAL@COMPILE 

(PUTPROPS TO.REGISTER MACRO 
(X
  (PROG ((REGISTER.NUMBER (CAR X))
	 (VAL (CADR X))
	 REGISTER.ADDR)

          (* 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.)



        (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)
  

          (* * It takes two calls to WRITEPRINTERPORT to effect any action -- one call with the input strobe line hi, and 

	  one call with it low.)



  (PROG2 (WRITEPRINTERPORT (LOGOR DISTR (TO.REGISTER REGISTER)))
	 (READPRINTERPORT)
	 (WRITEPRINTERPORT NOSTROBE))))

(PUTPROPS OSTROBE MACRO 
((REGISTER VAL)
  

          (* * It takes two calls to WRITEPRINTERPORT to effect any action -- one call with the output strobe line hi, and 

	  one call with it low.)



  ((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 INS8250RESET MACRO 
(NIL
  (PROGN (WRITEPRINTERPORT MASTERRESET)
	 (WRITEPRINTERPORT NOSTROBE))))
)
)



(* Debugging aids)


(DEFINEQ

(RS232DUMPBUFFER

  (LAMBDA (I/O.BUF N M)                                      (* JonL " 5-Aug-84 00:40")

    (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)
    (PROG ((BUFSIZ (ADD1 (if
 (EQ I/O.BUF \RS232IRINGBUF)
			     then
 \RS232IRING.SIZE
			   else
 \RS232ORING.SIZE)))
	   STR CHAR NCHARS)
          (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 BUFSIZ)
			(NULL M))
	      then
 (SETQ M (SUB1 N))
	    else
 (ERROR "Bad range indices" (LIST N M)))
          (if
 (NEQ 0 (SETQ NCHARS (IMOD (IDIFFERENCE M N)
					BUFSIZ)))
	      then
 (SETQ STR (ALLOCSTRING NCHARS (QUOTE #)))
		   (for
 I from
 1 to
 NCHARS
		      do
 (RPLCHARCODE STR I (SELCHARQ (SETQ CHAR (\GETBASEBYTE I/O.BUF N))
						      (NULL (CHARCODE &))
						      CHAR))
			 (SETQ N (IMOD (IPLUS N 1)
				       BUFSIZ))))
          (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 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (12637 12943 (ORDINALSUFFIXSTRING 12647 . 12941)) (14120 16561 (\#PAGES.BASEBYTES 14130
 . 14513) (\FRESHENUPFN 14515 . 15305) (\ONPATHS.CCODE 15307 . 16559)) (16638 18363 (\FASTMOVEBYTES 
16648 . 17923) (\FASTMOVEBYTES.SETUP 17925 . 18361)) (22453 24124 (\DLTTYPORT.DOCOMMAND 22463 . 23328)
 (\DLTTYPORT.BUSYWAIT 23330 . 24122)) (32127 35943 (\RS232C.FILLINIOCB 32137 . 32753) (
\RS232C.GETERRORSTATUS 32755 . 34318) (\RS232C.DOCOMMAND 34320 . 35116) (\RS232C.BUSYWAIT 35118 . 
35941)) (47706 68069 (\RS232.CHECKUART 47716 . 47850) (\RS232.DATAREADY 47852 . 48706) (
\RS232.PERIODIC.FN 48708 . 49248) (\RS232.PROCESSINTERRUPT 49250 . 52426) (\RS232DECODE.LINESTATUS 
52428 . 55599) (\RS232.OUTPUTBROOM 55601 . 55980) (\RS232.SERVICEORING 55982 . 59250) (
\RS232C.PROCESSINTERRUPT 59252 . 59856) (\RS232C.PERIODIC.FN 59858 . 68067)) (68154 70340 (
RS232BACKGROUND 68164 . 70338)) (71814 94295 (RS232INIT 71824 . 78732) (RS232SHUTDOWN 78734 . 79396) (
\RS232.D0INIT 79398 . 81018) (\RS232.DLINIT 81020 . 88608) (\RS232UNLOCKBUF 88610 . 88904) (
\RS232EVENTFN 88906 . 91170) (\RS232.CREATEFDEV 91172 . 92747) (\RS232OPENFILE 92749 . 93176) (
\RS232REOPENFILE 93178 . 94293)) (96066 105263 (RS232PEEKBYTE 96076 . 96251) (RS232LISTEN 96253 . 
96689) (RS232READBYTE 96691 . 98095) (RS232READWORD 98097 . 99082) (RS232WRITEBYTE 99084 . 103385) (
RS232FORCEOUTPUT 103387 . 105261)) (105307 113539 (RS232READLINE 105317 . 106245) (RS232READSTRING 
106247 . 108424) (\RS232READBASEBYTES 108426 . 110476) (\RS232INSURE.LINEBUFFER 110478 . 111772) (
RS232INPUTSTRING 111774 . 113537)) (114066 121211 (RS232WRITESTRING 114076 . 117368) (RS232WRITECHARS 
117370 . 117542) (\RS232WRITEBASEBYTES 117544 . 120809) (\RS232BOUTSTRING 120811 . 121209)) (121241 
125970 (RS232XON\XOFF? 121251 . 121729) (RS232MODEMCONTROL 121731 . 122293) (RS232MODIFYMODEMCONTROL 
122295 . 123601) (RS232MODEMHANGUP 123603 . 124183) (RS232MODEMSTATUSP 124185 . 124671) (\RS232.MSP1 
124673 . 125394) (\RS232LINECONTROL 125396 . 125968)) (126650 127695 (\RS232CHECK.THRE 126660 . 127693
)) (127929 129510 (\RS232CHECK.BLOCK 127939 . 129508)) (129868 131413 (\RS232DING 129878 . 130402) (
\RS232.DEVICEERROR 130404 . 130642) (\RS232STABLIZE 130644 . 131411)) (131732 136178 (RS232SENDBREAK 
131742 . 133448) (\RS232.DOBREAK 133450 . 134034) (RS232CLEARBUFFER 134036 . 136176)) (141160 143432 (
RS232DUMPBUFFER 141170 . 142608) (\D0RS232DUMP 142610 . 143430)))))
STOP