(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