(FILECREATED " 7-May-84 23:09:13" {PHYLUM}<LISPCORE>LIBRARY>RS232.;2 87106
changes to: (VARS RS232COMS)
(FNS \RS232EVENTFN)
previous date: " 6-May-84 23:58:12" {PHYLUM}<LISPCORE>LIBRARY>RS232.;1)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT RS232COMS)
(RPAQQ RS232COMS ((LOCALVARS . T)
(COMS (* Generally useful tools.)
(FNS ORDINALSUFFIXSTRING)
(DECLARE: DONTCOPY (MACROS #ARRAYBLOCKBYTES)
(P (COND ((BOUNDP (QUOTE BITSPERBYTE)))
(T (* These should be in MODARITH or ADDARITH but remember the case
of LOADFROMing on Interlisp-10)
(SETQ BITSPERNIBBLE (IQUOTIENT (SETQ BITSPERBYTE 8)
2))
(SETQ BYTESPERPAGE 512)
(CONSTANTS BITSPERBYTE BYTESPERPAGE BITSPERNIBBLE)))))
(* Calculate the number of pages represented by an address and a byte offset. Touch all
the pages of a function, to be sure they are swapped in.)
(FNS \#PAGES.BASEBYTES \FRESHENUPFN \ONPATHS.CCODE)
(CONSTANTS ACTIVE.EM))
(DECLARE: DONTCOPY (* Following constants come from the terminology in the hardware
description of the INS8250 chip.)
(CONSTANTS DATAREG INTERRUPTENABLEREG INTERRUPTIDREG LINECONTROLREG MODEMCONTROLREG
LINESTATUSREG MODEMSTATUSREG LOWDIVISORREG HIDIVISORREG)
(* Register addresses, not left-shifted (i.e., as in INS8250 table))
(CONSTANTS INTRPT)
(* Interrupt bit from chip, as a READPRINTERPORT bit)
(* Interrupt Enable Register bits)
(CONSTANTS ERBFI ETBEI ELSI EDSSI)
(CONSTANTS NoInterrupt LineStatus DataAvailable HoldingRegisterEmpty MODEMstatus)
(* Meanings of value from Interrupt ID register.)
(CONSTANTS STB PEN EPS SBCB DLAB)
(* Line Control Register bits.)
(CONSTANTS DR OE PE FE BI THRE TSRE RBOE LBOE THROE)
(* Line Status Register bits, but RBOE LBOE and THROE are my own software
RingBuffer LineBuffer and TransmitterHoldingRegister overflow indicators.)
(CONSTANTS DTR RTS OUT1 OUT2 LOOP CTS DSR RI RLSD)
(* MODEM control and MODEM status register bits)
(CONSTANTS DISTR DOSTR MASTERRESET)
(* Misc bits -- Input Strobe Line, Output Strobe Line, and Master Reset.)
(* NOSTROBE has the strobe lines low, directed to a non-existent register so that
other registers won't be disturbed. REGADDRSHIFT is the LLSH factor for register
addresses when sent to the parallel port.)
(CONSTANTS NOSTROBE REGADDRSHIFT)
(* TO.REGISTER converts a CONSTANTEXPRESSIONP frob into the numerical bits needed
to address that numbered register in the INS8250 chip. If a second arg is given,
the value is put in the data part of the numerical bits, so that it may be
written into the register. The "strobe" macros exists since it takes two calls
to WRITEPRINTERPORT to effect any action -- one call with the input
(or output)
strobe line hi, and one call with it low.)
(MACROS TO.REGISTER ISTROBE OSTROBE))
(COMS (* DLION RS232 stuff)
(INITVARS (\DLionTTYInLoc NIL)
(\DLionTTYOutLoc NIL)
(\DLionTTYCommandLoc NIL)
(\RS232DLionTTYP T))
(ARRAY \DLErrorBitsConversion)
(GLOBALVARS \DLErrorBitsConversion \DLionTTYCommandLoc \DLionTTYInLoc \DLionTTYOutLoc
\RS232DLionTTYP)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DLTTYInCSB DLTTYOutCSB DLTTYOutCommandCSB
DLTTYOutCommand)
(MACROS DLTTYOUTBUSY DLTTYOUTWAIT DLTTYPOKE)
(CONSTANTS (DLTtyCommand.putChar 128)
(DLTtyCommand.abortPut 133)
(DLTtyOutParameter.on 0)
(DLTtyOutParameter.off 1))
(CONSTANTS (OutControl.on 33536)
(OutControl.off 33792)
(OutControl.abortPut 34048)
(OutControl.breakOn 34304)
(OutControl.breakOff 34560)
(OutControl.setDSR 33025)
(OutControl.setCTS 33026)
(OutControl.setDSR&CTS 33027)
(OutControl.setAllParameters 33087))
(* Following bits are remnants of Domino.8 days, but are useful in many
places)
(CONSTANTS (OutControl.putChar 32768))
(CONSTANTS (InControl.InterruptMask 32888)
(InControl.charPresent 32768)
(InControl.errorBits 120)
(InControl.breakDetected 64)
(InControl.framingError 32)
(InControl.dataLost 16)
(InControl.parityError 8))))
(DECLARE: DONTCOPY (MACROS RS232INITIALIZECHECK RS232INTERRUPT? RS232DATAI RS232DATAO
RS232STATUSIN))
(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
(MACROS SERVICEIRING RINGB.INCREMENT PUSHRS232IRING POPRS232IRING
PUSHRS232ORING POPRS232ORING IRINGB.ATLEAST ORINGB.ATLEAST
ORINGB.FREE LINESTATUSERRORBITS LINESTATUSERRORSP CHECKDATAREADY
RS232PEEKBYTE.BACKUP RS232READBYTE.BACKUP))
(FNS \RS232.CHECKUART \RS232.PROCESSINTERRUPT \RS232.DATAREADY \RS232DECODE.LINESTATUS
\RS232.OUTPUTBROOM)
(GLOBALVARS \PERIODIC.INTERRUPT)
(COMS (* Functional interface for what to do if a character is dropped, or a break
signal is received.)
(INITVARS (RS232LOSTCHARFN (QUOTE \RS232DING))
(RS232BREAKFN NIL)
(RS232BREAKSEEN? NIL)
(\RS232.DROPPEDCHARACTER.CODE (CHARCODE #↑G))
(\RS232.ERROR.MASK -1)
(\RS232DING.BOX (SETUPTIMER 0))
(\RS232STABLIZE.BOX (SETUPTIMER 0)))
(FNS \RS232DING \RS232STABLIZE)
(SPECVARS RS232LOSTCHARFN RS232BREAKFN RS232BREAKSEEN? \RS232NoInterruptFN
\RS232.DROPPEDCHARACTER.CODE)
(GLOBALVARS \RS232.ERROR \RS232.ERROR.MASK \RS232DING.BOX \RS232STABLIZE.BOX)))
(COMS (* Various parameters installed by RS232INIT)
(INITVARS (\RS232DefaultBaudRate 1200)
(\RS232DefaultBLOCKINTERVAL.ms 250))
(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))
(INITVARS (\RS232DLion? NIL))
(FNS RS232INIT \RS232UNLOCKBUF RS232BACKGROUND \RS232.PERIODIC.FN \RS232EVENTFN)
(FNS RS232MODEMCONTROL RS232MODIFYMODEMCONTROL RS232MODEMHANGUP RS232MODEMSTATUSP
\RS232.MSP1 \RS232LINECONTROL)
(* After initialization, RS232INIT holds a list of the actual args used)
(VARS (RS232INIT NIL)
(\RS232BACKGROUNDSTATE NIL)
(\RS232BACKGROUNDERRORSTATUS NIL)
(\RS232DEVICE NIL)
(\RS232STREAM NIL)
(\RS232.TIMEOUT.BOX (SETUPTIMER 0))
(\RS232.DING.BOX (SETUPTIMER 0)))
(GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms
\RS232.ByteIntervalCap.tics \RS232.Tovh&BIC4.tics \RS232.Tovh&BIC16.tics
\RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms
\RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP
RS232INIT \RS232BACKGROUNDSTATE \RS232BACKGROUNDERRORSTATUS \RS232DEVICE
\RS232STREAM \RS232.TIMEOUT.BOX \RS232.DING.BOX \RS232DLion?))
(COMS (* Basic driver functions)
(MACROS RS232PEEKBYTE RS232READBYTE)
(FNS RS232PEEKBYTE RS232LISTEN RS232READBYTE RS232READWORD RS232WRITEBYTE
RS232SENDBREAK RS232FORCEOUTPUT RS232CLEARBUFFER)
(* Block read and write functions)
(FNS RS232READLINE RS232READSTRING \RS232READBASEBYTES \RS232INSURE.LINEBUFFER)
(VARS (\RS232LINEBUFFER NIL)
(\RS232LINEBUFFER.SIZE NIL)
(\RS232.READLINE.BOX (SETUPTIMER 0))
(\RS232.BLOCKINTERVAL.BOX (SETUPTIMER 0))
(\RS232.DELAY.BOX (SETUPTIMER 0))
(\RS232STRPTR (ALLOCSTRING 0)))
(GLOBALVARS \RS232LINEBUFFER \RS232LINEBUFFER.SIZE \RS232.READLINE.BOX
\RS232.BLOCKINTERVAL.BOX \RS232.DELAY.BOX \RS232STRPTR)
(MACROS RS232WRITECHARS)
(FNS RS232WRITESTRING RS232WRITECHARS \RS232WRITEBASEBYTES \RS232BOUTSTRING)
(* Use of XON/XOFF protocols)
(INITVARS (RS232XON\XOFF? NIL)
(RS232XOFF? NIL))
(GLOBALVARS RS232XON\XOFF? RS232XOFF?)
(* Check to see if Transmitter Holding Register is empty.)
(FNS \RS232CHECK.THRE)
(INITVARS (\RS232.THRE.BOX (SETUPTIMER 0)))
(GLOBALVARS \RS232.THRE.BOX)
(* Check to see if BLOCK can be called now)
(FNS \RS232CHECK.BLOCK)
(GLOBALRESOURCES \RS232.ADMIT.BOX))
(COMS (* Debugging aids)
(FNS RS232DUMPBUFFER \D0RS232DUMP))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA RS232MODEMCONTROL)
))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(* Generally useful tools.)
(DEFINEQ
(ORDINALSUFFIXSTRING
[LAMBDA (N) (* JonL " 5-JAN-83 23:54")
(SETQ N (IABS N))
(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)))
)
(COND ((BOUNDP (QUOTE BITSPERBYTE)))
(T (* These should be in MODARITH or ADDARITH but remember the case of LOADFROMing on
Interlisp-10)
(SETQ BITSPERNIBBLE (IQUOTIENT (SETQ BITSPERBYTE 8)
2))
(SETQ BYTESPERPAGE 512)
(CONSTANTS BITSPERBYTE BYTESPERPAGE BITSPERNIBBLE)))
)
(* Calculate the number of pages represented by an address and a byte offset. Touch all the
pages of a function, to be sure they are swapped in.)
(DEFINEQ
(\#PAGES.BASEBYTES
[LAMBDA (BASE OFFST) (* JonL " 3-Dec-83 13:49")
(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)
)
(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)
(CONSTANTS DR OE PE FE BI THRE TSRE RBOE LBOE THROE)
)
(* Line Status Register bits, but RBOE LBOE and THROE are my own software RingBuffer LineBuffer
and TransmitterHoldingRegister overflow indicators.)
(DECLARE: EVAL@COMPILE
(RPAQQ DTR 1)
(RPAQQ RTS 2)
(RPAQQ OUT1 4)
(RPAQQ OUT2 8)
(RPAQQ LOOP 16)
(RPAQQ CTS 16)
(RPAQQ DSR 32)
(RPAQQ RI 64)
(RPAQQ RLSD 128)
(CONSTANTS DTR RTS OUT1 OUT2 LOOP CTS DSR RI RLSD)
)
(* MODEM control and MODEM status register bits)
(DECLARE: EVAL@COMPILE
(RPAQQ DISTR 256)
(RPAQQ DOSTR 2048)
(RPAQQ MASTERRESET 4096)
(CONSTANTS DISTR DOSTR MASTERRESET)
)
(* Misc bits -- Input Strobe Line, Output Strobe Line, and Master Reset.)
(* NOSTROBE has the strobe lines low, directed to a non-existent register so that other
registers won't be disturbed. REGADDRSHIFT is the LLSH factor for register addresses when sent
to the parallel port.)
(DECLARE: EVAL@COMPILE
(RPAQQ NOSTROBE 57344)
(RPAQQ REGADDRSHIFT 13)
(CONSTANTS NOSTROBE REGADDRSHIFT)
)
(* TO.REGISTER converts a CONSTANTEXPRESSIONP frob into the numerical bits needed to address
that numbered register in the INS8250 chip. If a second arg is given, the value is put in the
data part of the numerical bits, so that it may be written into the register. The "strobe"
macros exists since it takes two calls to WRITEPRINTERPORT to effect any action -- one call
with the input (or output) strobe line hi, and one call with it low.)
(DECLARE: EVAL@COMPILE
(PUTPROPS TO.REGISTER MACRO (X
(PROG ((REGISTER.NUMBER (CAR X))
(VAL (CADR X))
REGISTER.ADDR)
(SETQ REGISTER.ADDR (LIST (QUOTE LLSH)
REGISTER.NUMBER
(QUOTE REGADDRSHIFT)))
(COND
((CONSTANTEXPRESSIONP REGISTER.NUMBER)
(SETQ REGISTER.ADDR (COND
((ZEROP (EVAL REGISTER.NUMBER))
0)
(T (LIST (QUOTE CONSTANT)
REGISTER.ADDR))))))
(RETURN (COND
((OR (NULL VAL)
(ZEROP VAL)
(AND (CONSTANTEXPRESSIONP VAL)
(ZEROP (EVAL VAL))))
REGISTER.ADDR)
((ZEROP REGISTER.ADDR)
VAL)
(T (LIST (QUOTE LOGOR)
REGISTER.ADDR VAL)))))))
(PUTPROPS ISTROBE MACRO ((REGISTER)
(PROG2 (WRITEPRINTERPORT (LOGOR DISTR (TO.REGISTER REGISTER)))
(READPRINTERPORT)
(WRITEPRINTERPORT NOSTROBE))))
(PUTPROPS OSTROBE MACRO ((REGISTER VAL)
((LAMBDA (Register&Value)
(WRITEPRINTERPORT (LOGOR DOSTR Register&Value)) (* Note that this also sets the DISTR line off)
(WRITEPRINTERPORT Register&Value) (* It just so happens that the time between two
WRITEPRINTERPORT instructions is enough for the data to
be transferred to the holding register.)
Register&Value)
(TO.REGISTER REGISTER VAL))))
)
)
(* DLION RS232 stuff)
(RPAQ? \DLionTTYInLoc NIL)
(RPAQ? \DLionTTYOutLoc NIL)
(RPAQ? \DLionTTYCommandLoc NIL)
(RPAQ? \RS232DLionTTYP T)
(RPAQ \DLErrorBitsConversion (READARRAY 16 (QUOTE BYTE) 0))
(0 4 2 6 8 12 10 14 16 20 18 22 24 28 26 30 NIL
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \DLErrorBitsConversion \DLionTTYCommandLoc \DLionTTYInLoc \DLionTTYOutLoc
\RS232DLionTTYP)
)
(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))))
(QUOTE (no RECORD declaration for DLTTYOutCommandCSB))
(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 DLTTYOUTWAIT MACRO (X
(COND
((AND (NOT (CAR X))
(NOT (CADR X)))
(QUOTE (until (NOT (DLTTYOUTBUSY)))))
(T (SUBST (CAR X)
(QUOTE INTERVAL)
(COND
((CADR X)
(QUOTE (during INTERVAL until (NOT (DLTTYOUTBUSY))
do NIL)))
(T (QUOTE (during INTERVAL do (if (NOT (DLTTYOUTBUSY))
then (RETURN))
finally
(ERROR (QUOTE Timeout% waiting% for% TTYPort)))))))))))
(PUTPROPS DLTTYPOKE MACRO (X
(PROG ((FORM (SUBST (MKATOM (CONCAT "OutControl." (CAR X)))
(QUOTE SignalName)
(QUOTE (replace (DLTTYOutCommand command&Data)
of \DLionTTYCommandLoc with SignalName)))))
(RETURN (COND
((OR (NULL (CDR X))
(FIXP (CADR X)))
(LIST (QUOTE PROGN)
FORM
(CONS (QUOTE DLTTYOUTWAIT)
(CDR X))))
(T FORM))))))
)
(DECLARE: EVAL@COMPILE
(RPAQQ DLTtyCommand.putChar 128)
(RPAQQ DLTtyCommand.abortPut 133)
(RPAQQ DLTtyOutParameter.on 0)
(RPAQQ DLTtyOutParameter.off 1)
(CONSTANTS (DLTtyCommand.putChar 128)
(DLTtyCommand.abortPut 133)
(DLTtyOutParameter.on 0)
(DLTtyOutParameter.off 1))
)
(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 33536)
(OutControl.off 33792)
(OutControl.abortPut 34048)
(OutControl.breakOn 34304)
(OutControl.breakOff 34560)
(OutControl.setDSR 33025)
(OutControl.setCTS 33026)
(OutControl.setDSR&CTS 33027)
(OutControl.setAllParameters 33087))
)
(* Following bits are remnants of Domino.8 days, but are useful in many places)
(DECLARE: EVAL@COMPILE
(RPAQQ OutControl.putChar 32768)
(CONSTANTS (OutControl.putChar 32768))
)
(DECLARE: EVAL@COMPILE
(RPAQQ InControl.InterruptMask 32888)
(RPAQQ InControl.charPresent 32768)
(RPAQQ InControl.errorBits 120)
(RPAQQ InControl.breakDetected 64)
(RPAQQ InControl.framingError 32)
(RPAQQ InControl.dataLost 16)
(RPAQQ InControl.parityError 8)
(CONSTANTS (InControl.InterruptMask 32888)
(InControl.charPresent 32768)
(InControl.errorBits 120)
(InControl.breakDetected 64)
(InControl.framingError 32)
(InControl.dataLost 16)
(InControl.parityError 8))
)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS RS232INITIALIZECHECK MACRO (NIL
(OR (LISTP RS232INIT)
(ERROR (QUOTE RS232NotInitialized)))))
(PUTPROPS RS232INTERRUPT? MACRO (NIL
(COND
(\RS232DLion? (BITTEST (fetch (DLTTYInCSB InControl) of \DLionTTYInLoc)
InControl.InterruptMask))
(T (IGEQ (READPRINTERPORT)
INTRPT)))))
(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)
(COND
(\RS232DLion? (replace (DLTTYOutCommand outData) of \DLionTTYCommandLoc with BYTE)
(replace (DLTTYOutCommand command) of \DLionTTYCommandLoc with DLTtyCommand.putChar)
)
(T (OSTROBE DATAREG BYTE)))))
(PUTPROPS RS232STATUSIN MACRO (NIL
(UNINTERRUPTABLY
((LAMBDA (Status)
(DECLARE (LOCALVARS Status))
(COND
(\RS232BACKGROUNDERRORSTATUS (LOGOR Status (PROG1 \RS232BACKGROUNDERRORSTATUS
(SETQ \RS232BACKGROUNDERRORSTATUS))))
(T Status)))
(COND
(\RS232DLion? (PROG ((cw (fetch (DLTTYInCSB InControl) of \DLionTTYInLoc))
(r (COND
((DLTTYOUTBUSY)
0)
(T THRE))))
(COND
((BITTEST cw (CONSTANT (BITCLEAR InControl.InterruptMask
InControl.charPresent)))
(add r (ELT \DLErrorBitsConversion (LOADBYTE cw 3 4)))
(replace (DLTTYInCSB InControl) of \DLionTTYInLoc
with (BITCLEAR cw (CONSTANT (BITCLEAR InControl.InterruptMask
InControl.charPresent))))))
(RETURN (COND
((BITTEST cw InControl.charPresent)
(LOGOR r DR))
(T r)))))
(T (LOADBYTE (ISTROBE LINESTATUSREG)
0 8)))))))
)
)
(* 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
(DECLARE: EVAL@COMPILE
(PUTPROPS SERVICEIRING DMACRO (NIL
(COND
((RS232INTERRUPT?)
(\RS232.PROCESSINTERRUPT)))))
(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.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 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))
(LOGAND (IDIFFERENCE \RS232ORING.READ \RS232ORING.WRITE)
\RS232ORING.SIZE)))
(PUTPROPS LINESTATUSERRORBITS DMACRO ((STATUS)
(LOGAND STATUS \RS232.ERROR.MASK (CONSTANT (LOGOR 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)))))))
)
)
(DEFINEQ
(\RS232.CHECKUART
[LAMBDA NIL (* JonL "16-SEP-83 15:07")
(SERVICEIRING])
(\RS232.PROCESSINTERRUPT
(LAMBDA (NOERRORFLG) (* JonL "27-Jan-84 23:28")
(* Returns non-NIL iff some error conditions have
occured.)
(PROG ((CNT 0)
(CUMULATIVE.STATUS 0)
ANYERRORS? STATUS RAWINTERRUPTBITS DONEIT? PERIODIC.INTERRUPT?)
A (UNINTERRUPTABLY
(if (SETQ PERIODIC.INTERRUPT? \PERIODIC.INTERRUPT)
then (SETQ \PERIODIC.INTERRUPT))
(if \RS232BACKGROUNDERRORSTATUS
then (SETQ CUMULATIVE.STATUS (LOGOR \RS232BACKGROUNDERRORSTATUS CUMULATIVE.STATUS))
(SETQ \RS232BACKGROUNDERRORSTATUS)
(SETQ ANYERRORS? T))
(SETQ RAWINTERRUPTBITS (if \RS232DLion?
then (PROG ((cw (fetch (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 (RESETVAR \PERIODIC.INTERRUPT NIL (PROGN (SETQ \RS232.ERROR RAWINTERRUPTBITS)
(SHOULDNT (QUOTE \RS232.PROCESSINTERRUPT))
)))
(if STATUS
then (SETQ CUMULATIVE.STATUS (LOGOR CUMULATIVE.STATUS STATUS))
(SETQ ANYERRORS? T))
(if (NOT (RS232INTERRUPT?))
then (RETURN (if (NOT ANYERRORS?)
then NIL
elseif NOERRORFLG
then CUMULATIVE.STATUS
else (\RS232DECODE.LINESTATUS CUMULATIVE.STATUS))))
B (if (ILESSP 20 (add CNT 1))
then (SHOULDNT
"Over 20 consecutive interrupts - can't get out of \RS232.PROCESSINTERRUPT")
else (SETQ DONEIT?)
(GO A)))))
(\RS232.DATAREADY
(LAMBDA NIL (* JonL "27-Jan-84 23:53")
(* NOTE WELL! This function must be called
UNINTERRUPTABLY Returns non-NIL iff there is an overflow
of the ring buffer.)
(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)))))
(\RS232DECODE.LINESTATUS
[LAMBDA (STATUS NOERRORFLG) (* JonL "25-JUL-83 20:01")
(* Looks for error bits in a LINESTATUSREG reading, running errors or RS232BREAKFN if NOERRORFLG is null.
Returns the most recent reading of the LINESTATUSREG)
(PROG ((CNT 0)
BREAKINSTATUS? PERIODIC.INTERRUPT?)
A (UNINTERRUPTABLY
(COND
((SETQ PERIODIC.INTERRUPT? \PERIODIC.INTERRUPT)
(SETQ \PERIODIC.INTERRUPT)))
(COND
((NULL STATUS)
(SETQ STATUS (RS232STATUSIN)))
((NOT (FIXP STATUS))
(COND
(PERIODIC.INTERRUPT? (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?)))
(SHOULDNT "Bad STATUS arg")))
[SETQ BREAKINSTATUS? (COND
((BITTEST STATUS BI)
(COND
((BITTEST STATUS FE)
(SETQ STATUS (BITCLEAR STATUS BI))
NIL)
(T (SETQ RS232BREAKSEEN? T]
[COND
((BITTEST DR STATUS)
(SETQ STATUS (LOGOR (BITCLEAR STATUS DR)
(OR (\RS232.DATAREADY)
0]
(COND
(PERIODIC.INTERRUPT? (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?))))
[COND
((OR NOERRORFLG (NOT (LINESTATUSERRORSP STATUS)))
(* Here's the main return)
(RETURN STATUS))
((COND
((NOT BREAKINSTATUS?))
(T (COND
(RS232BREAKFN (APPLY* RS232BREAKFN)))
(SETQ STATUS (BITCLEAR STATUS BI))
(LINESTATUSERRORSP STATUS)))
(APPLY* (PROG1 RS232LOSTCHARFN (* Comment PPLossage))
(SELECTC (LINESTATUSERRORBITS STATUS)
(OE (QUOTE DroppedCharacter))
(PE (QUOTE ParityError))
(FE (QUOTE FramingError))
(RBOE (QUOTE RingBufferFull))
(LBOE (QUOTE LineBufferFull))
(THROE (QUOTE TransmitterWedged))
(QUOTE MultipleErrors]
(\RS232STABLIZE)
(SETQ STATUS)
(GO A])
(\RS232.OUTPUTBROOM
[LAMBDA NIL (* JonL "24-JUL-83 17:23")
(* Just loop around infinitely, "sweeping" all the data
in the output ring buffer out through the UART)
(do (AWAIT.EVENT \RS232ORINGEVENT 5000)
(bind STATUS while (ORINGB.ATLEAST 1)
do (COND
((UNINTERRUPTABLY
(COND
((EQ T (SETQ STATUS (\RS232CHECK.THRE)))
(RS232DATAO (POPRS232ORING))
NIL)
(T (FIXP STATUS)))) (* Note that this call may cause an error)
(\RS232DECODE.LINESTATUS STATUS)))
(BLOCK])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \PERIODIC.INTERRUPT)
)
(* Functional interface for what to do if a character is dropped, or a break signal is
received.)
(RPAQ? RS232LOSTCHARFN (QUOTE \RS232DING))
(RPAQ? RS232BREAKFN NIL)
(RPAQ? RS232BREAKSEEN? NIL)
(RPAQ? \RS232.DROPPEDCHARACTER.CODE (CHARCODE #↑G))
(RPAQ? \RS232.ERROR.MASK -1)
(RPAQ? \RS232DING.BOX (SETUPTIMER 0))
(RPAQ? \RS232STABLIZE.BOX (SETUPTIMER 0))
(DEFINEQ
(\RS232DING
[LAMBDA NIL (* JonL " 3-Dec-83 21:21")
(* This is the default RS232LOSTCHARFN)
(PROG ((FLG T)
(TEMP \RS232IRING.WRITE)
STATUS)
(RINGB.INCREMENT TEMP 1 \RS232IRING.SIZE)
(COND
((EQ \RS232IRING.READ TEMP) (* FOO! no room left)
(RINGB.INCREMENT \RS232IRING.WRITE -1 \RS232IRING.SIZE)))
(PUSHRS232IRING \RS232.DROPPEDCHARACTER.CODE) (* Install a "dropped characters" code, and flash at the
user.)
(COND
((TIMEREXPIRED? \RS232DING.BOX)
(RINGBELLS)
(SETUPTIMER (COND
(\RS232DLion? 3000)
(T 1500))
\RS232DING.BOX)))
(\RS232STABLIZE) (* Loop until line "stabilizes")
])
(\RS232STABLIZE
[LAMBDA NIL (* JonL " 2-Dec-83 20:09")
(* 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.)
(during \RS232.LONGBREAK.tics usingTimer \RS232STABLIZE.BOX
when [NOT (LINESTATUSERRORSP (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR] do (RETURN)
finally (SHOULDNT "Continuous linestatus errors on RS232 port"])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS RS232LOSTCHARFN RS232BREAKFN RS232BREAKSEEN? \RS232NoInterruptFN
\RS232.DROPPEDCHARACTER.CODE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232.ERROR \RS232.ERROR.MASK \RS232DING.BOX \RS232STABLIZE.BOX)
)
(* Various parameters installed by RS232INIT)
(RPAQ? \RS232DefaultBaudRate 1200)
(RPAQ? \RS232DefaultBLOCKINTERVAL.ms 250)
(RPAQ? \RS232Divisor NIL)
(RPAQ? \RS232.ByteIntervalCap.ms NIL)
(RPAQ? \RS232.ByteIntervalCap.tics NIL)
(RPAQ? \RS232.Tovh&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))
]
)
(RPAQ? \RS232DLion? NIL)
(DEFINEQ
(RS232INIT
(LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl)
(* JonL "14-Mar-84 03:47")
(* 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.)
(PROGN (SETQ \RS232IRING.SIZE (MASK.1'S 0 (INTEGERLENGTH (SUB1 (CEIL \RS232IRING.SIZE
BYTESPERPAGE)))))
(if (OR (NOT (type? ARRAYBLOCK \RS232IRINGBUF))
(ILESSP (#ARRAYBLOCKBYTES \RS232IRINGBUF)
(ADD1 \RS232IRING.SIZE)))
then (AND \RS232IRINGBUF (\RS232UNLOCKBUF \RS232IRINGBUF))
(SETQ \RS232IRINGBUF (\ALLOCBLOCK (FOLDLO (ADD1 \RS232IRING.SIZE)
BYTESPERCELL)
NIL CELLSPERPAGE)))
(\LOCKPAGES \RS232IRINGBUF (\#PAGES.BASEBYTES \RS232IRINGBUF (ADD1 \RS232IRING.SIZE)))
(SETQ \RS232IRING.READ (SETQ \RS232IRING.WRITE 0)))
(PROGN (SETQ \RS232ORING.SIZE (MASK.1'S 0 (INTEGERLENGTH (SUB1 (CEIL \RS232ORING.SIZE
BYTESPERPAGE)))))
(if (OR (NOT (type? ARRAYBLOCK \RS232ORINGBUF))
(ILESSP (#ARRAYBLOCKBYTES \RS232ORINGBUF)
(ADD1 \RS232ORING.SIZE)))
then (AND \RS232ORINGBUF (\RS232UNLOCKBUF \RS232ORINGBUF))
(SETQ \RS232ORINGBUF (\ALLOCBLOCK (FOLDLO (ADD1 \RS232ORING.SIZE)
BYTESPERCELL)
NIL CELLSPERPAGE)))
(\LOCKPAGES \RS232ORINGBUF (\#PAGES.BASEBYTES \RS232ORINGBUF (ADD1 \RS232ORING.SIZE)))
(SETQ \RS232ORING.READ (SETQ \RS232ORING.WRITE 0)))
(if (NULL BaudRate)
then (SETQ BaudRate \RS232DefaultBaudRate)
elseif (EQ BaudRate 110)
then NIL
elseif (NOT (AND (SMALLP BaudRate)
(IGEQ BaudRate 75)
(ILEQ BaudRate 19200)
(ZEROP (IREMAINDER BaudRate 75))
(POWEROFTWOP (IQUOTIENT BaudRate 75))))
then (\ILLEGAL.ARG BaudRate))
(SETQ \RS232Divisor (IQUOTIENT 115200 BaudRate)) (* 115200=1.8432MHz / 16)
(SETQ \RS232.ByteIntervalCap.ms (IQUOTIENT (IPLUS \RS232Divisor 9)
10)) (* Approximately 10 bits worth of time needed to send
one byte, what with 8-bits-per-byte and 1.5 stop bits)
(SETQ \RS232.ByteIntervalCap.tics (ITIMES \RCLKMILLISECOND \RS232.ByteIntervalCap.ms))
((LAMBDA (TimerOverhead.tics) (* Assume that the cost of SETUPTIMER and TIMERXPIRED?
combined, plus a little other setup code, is about 1/2
millisecond.)
(SETQ \RS232.Tovh&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))
(SELECTQ (MACHINETYPE)
(DOLPHIN (SETQ \RS232DLion?)
(PROG ((WordLengthSelect (LOADBYTE (IDIFFERENCE BitsPerSerialChar 5)
0 2))
(ParityEnable/Select (SELECTQ Parity
(NIL 0)
(ODD PEN)
(CONSTANT (LOGOR PEN EPS))))
(StopBitsSelect (if (EQP NoOfStopBits 2)
then STB
else 0))
LCRegister)
(SETQ BitsPerSerialChar (IPLUS WordLengthSelect 5))
(PROGN (WRITEPRINTERPORT MASTERRESET)
(WRITEPRINTERPORT NOSTROBE))
(\RS232LINECONTROL DLAB) (* Sets the DLAB (only) in LineControl register.)
(OSTROBE LOWDIVISORREG (LOADBYTE \RS232Divisor 0 8))
(OSTROBE HIDIVISORREG (LOADBYTE \RS232Divisor 8 8))
(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)))))
(DANDELION (SETQ \DLionTTYCommandLoc (LOCF (fetch DLTTYPORTCMD of \IOPAGE)))
(SETQ \DLionTTYInLoc (LOCF (fetch DLTTYIN of \IOPAGE)))
(SETQ \DLionTTYOutLoc (LOCF (fetch DLTTYOUT of \IOPAGE)))
(SETQ \RS232DLion? T)
(DLTTYPOKE off 2000 NOERROR)
(DLTTYPOKE on)
(replace (DLTTYOutCSB notifyMask) of \DLionTTYOutLoc with 0)
(replace (DLTTYInCSB charPresent) of \DLionTTYInLoc with NIL)
(replace (DLTTYOutCSB onOff) of \DLionTTYOutLoc with DLTtyOutParameter.on)
(replace (DLTTYOutCSB baudRate) of \DLionTTYOutLoc
with (if (EQ BaudRate 110)
then 2
else (CAR (NTH (QUOTE (15 14 12 10 7 6 5 4 1))
(IDIFFERENCE (INTEGERLENGTH \RS232Divisor)
2)))))
(replace (DLTTYOutCSB stopBits) of \DLionTTYOutLoc
with (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))
(replace (DLTTYOutCSB parity) of \DLionTTYOutLoc with (SELECTQ Parity
(NIL 0)
(ODD 1)
(EVEN 3)
(SHOULDNT)))
(replace (DLTTYOutCSB charLength) of \DLionTTYOutLoc with (IDIFFERENCE
BitsPerSerialChar 5))
(replace (DLTTYOutCSB clearToSend) of \DLionTTYOutLoc with T)
(replace (DLTTYOutCSB dataSetReady) of \DLionTTYOutLoc with T)
(DLTTYPOKE setAllParameters))
NIL)
(if (NOT (type? FDEV \RS232DEVICE))
then (SETQ \RS232DEVICE
(create FDEV
DEVICENAME ←(QUOTE RS232)
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
FDBINABLE ← NIL
FDBOUTABLE ← NIL
FDEXTENDABLE ← NIL
CLOSEFILE ←(FUNCTION (LAMBDA (STREAM)
(if (EQ STREAM \RS232STREAM)
then (if (fetch ACCESS of STREAM)
then (* Calling the eventfn simply to "shut things down")
(\RS232EVENTFN (QUOTE BEFOREMAKESYS)))
(\DELETEOFD STREAM) (* A non-null value for RS232INIT is how \REVALIDATEFILE
determines whether to re-open)
(SETQ RS232INIT))))
DELETEFILE ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION NILL)
EVENTFN ←(FUNCTION \RS232EVENTFN)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
GETFILEINFO ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
OPENFILE ←(FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV)
(APPLY (FUNCTION RS232INIT)
(MAPCAR (ARGLIST (QUOTE RS232INIT))
(FUNCTION (LAMBDA (ARG)
(CADR (FASSOC ARG OTHERINFO))))))
(* A side-effect of RS232INIT is to set this globalvar)
\RS232STREAM))
READPAGES ←(FUNCTION NILL)
REOPENFILE ←(FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV STREAM)
(if (NULL RS232INIT)
then (* Nothing to do if there is no saved info on UART
state)
NIL
elseif (if (EQ (MACHINETYPE)
(QUOTE DANDELION))
then (* Set the parameters for IOP etc. To be done sometime
in 1984 -- JonL)
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 STREAM)))
SETFILEINFO ←(FUNCTION NILL)
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
BIN ←(FUNCTION (LAMBDA (STREAM)
(RS232READBYTE T)))
BOUT ←(FUNCTION (LAMBDA (STREAM BYTE)
(RS232WRITEBYTE BYTE T)))
PEEKBIN ←(FUNCTION RS232PEEKBYTE)
READP ←(FUNCTION RS232PEEKBYTE)
BACKFILEPTR ←(FUNCTION (LAMBDA (STREAM)
(RINGB.INCREMENT \RS232IRING.READ -1 \RS232IRING.SIZE)))
SETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
GETEOFPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
EOFP ←(FUNCTION NILL)
BLOCKIN ←(FUNCTION \RS232READBASEBYTES)
BLOCKOUT ←(FUNCTION \RS232WRITEBASEBYTES)
RENAMEFILE ←(FUNCTION \ILLEGAL.DEVICEOP)))
(\DEFINEDEVICE (QUOTE RS232)
\RS232DEVICE))
(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))
(OR (FMEMB \RS232STREAM \OPENFILES)
(\ADDOFD \RS232STREAM))
(if ModemControl
then (RS232MODEMCONTROL ModemControl)
(SETQ ModemControl (RS232MODEMCONTROL)))
(SETQ RS232INIT
(create RS232CHARACTERISTICS
BAUDRATE ← BaudRate
BITSPERCHAR ← BitsPerSerialChar
PARITY ← Parity
STOPBITS ← NoOfStopBits
MODEMCONTROL ← ModemControl))
(SETUPTIMER 0 \RS232DING.BOX)
RS232INIT))
(\RS232UNLOCKBUF
[LAMBDA (BUF) (* JonL " 3-Dec-83 21:37")
(COND
((type? ARRAYBLOCK BUF)
(\UNLOCKPAGES BUF (FOLDHI (#ARRAYBLOCKBYTES BUF)
BYTESPERPAGE)))
(T (HELP BUF "Non standard kind of buffer"])
(RS232BACKGROUND
[LAMBDA (ON?) (* JonL "17-AUG-83 23:00")
([LAMBDA (PROCP)
(PROG1 [COND
[(NULL \RS232BACKGROUNDSTATE)
(COND
(PROCP (QUOTE OUTPUT))
(T (QUOTE OFF]
(T (COND
(PROCP (QUOTE BOTH))
(T (QUOTE INPUT]
(SELECTQ (COND
((EQ ON? (QUOTE ON))
(SETQ ON? (QUOTE BOTH)))
(T ON?))
(NIL)
[(BOTH INPUT OUTPUT)
(SETQ \RS232BACKGROUNDSTATE)
(SETQ \RS232BACKGROUNDERRORSTATUS)
[COND
[(OR (EQ ON? (QUOTE BOTH))
(EQ ON? (QUOTE OUTPUT)))
(COND
((NOT PROCP)
(ADD.PROCESS (QUOTE (\RS232.OUTPUTBROOM))
(QUOTE RESTARTABLE)
(QUOTE HARDRESET)))
(T (RESTART.PROCESS PROCP]
(T (DEL.PROCESS (QUOTE \RS232.OUTPUTBROOM]
(COND
((OR (EQ ON? (QUOTE BOTH))
(EQ ON? (QUOTE INPUT)))
(SETQ \RS232BACKGROUNDSTATE T)
(SETQ \PERIODIC.INTERRUPT (FUNCTION \RS232.PERIODIC.FN))
(SETQ \PERIODIC.INTERRUPT.FREQUENCY 1))
(T (SETQ \PERIODIC.INTERRUPT]
(OFF (SETQ \PERIODIC.INTERRUPT)
(AND PROCP (DEL.PROCESS (QUOTE \RS232.OUTPUTBROOM)))
(SETQ \RS232BACKGROUNDSTATE)
(SETQ \RS232BACKGROUNDERRORSTATUS))
(\ILLEGAL.ARG ON?]
(FIND.PROCESS (QUOTE \RS232.OUTPUTBROOM])
(\RS232.PERIODIC.FN
[LAMBDA NIL (* JonL "29-JUN-83 07:00")
(COND
((RS232INTERRUPT?)
(SETQ \RS232BACKGROUNDERRORSTATUS (\RS232.PROCESSINTERRUPT (QUOTE NOERROR])
(\RS232EVENTFN
(LAMBDA (DEVICE EVENT) (* JonL " 7-May-84 23:08")
(if RS232INIT
then (SELECTQ EVENT
((BEFORELOGOUT BEFORESYSOUT BEFOREMAKESYS)
(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 (RS232MODEMCONTROL NIL))
(if \RS232BACKGROUNDSTATE
then (if (EQ (SETQ \RS232BACKGROUNDSTATE (RS232BACKGROUND (QUOTE OFF)))
(QUOTE OFF))
then (SETQ \RS232BACKGROUNDSTATE)))
(if \RS232DLion?
then (DLTTYOUTWAIT 2000 NOERROR)
(replace (DLTTYOutCSB notifyMask) of \DLionTTYOutLoc with 0)
(replace (DLTTYOutCSB onOff) of \DLionTTYOutLoc with
DLTtyOutParameter.off)
(DLTTYPOKE off NOWAIT)))
((NIL AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS)
(* Re-open the RS232 port)
(APPLY (FUNCTION RS232INIT)
RS232INIT)
(if \RS232BACKGROUNDSTATE
then (SETQ \RS232BACKGROUNDSTATE)
(RS232BACKGROUND \RS232BACKGROUNDSTATE)))
NIL))))
)
(DEFINEQ
(RS232MODEMCONTROL
(LAMBDA NARGS (* JonL "27-Jan-84 23:11")
(RS232INITIALIZECHECK)
(SERVICEIRING)
(PROG1 (SELECTC (if \RS232DLion?
then (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))))
(0 NIL)
(DTR (QUOTE (DTR)))
(RTS (QUOTE (RTS)))
((LOGOR DTR RTS)
(QUOTE (DTR RTS)))
(SHOULDNT))
(if (IGEQ NARGS 1)
then (PROG ((BITS (for X in (MKLIST (ARG NARGS 1)) sum (SELECTQ X
(DTR DTR)
(RTS RTS)
(\ILLEGAL.ARG X)))))
(if \RS232DLion?
then (replace (DLTTYOutCSB dataSetReady) of \DLionTTYOutLoc
with (BITTEST BITS DTR))
(replace (DLTTYOutCSB clearToSend) of \DLionTTYOutLoc
with (BITTEST BITS RTS))
(DLTTYPOKE setDSR&CTS 2000)
else (OSTROBE MODEMCONTROLREG BITS))))
(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 "27-Jan-84 23:12")
(RS232INITIALIZECHECK)
(SERVICEIRING)
(PROG ((MSTAT (if \RS232DLion?
then (* Do the rxRDY and txRDY fields in the DLion correspond
to anything like RI and/or RLSD -- JonL 6/19/83)
(IPLUS (if (fetch (DLTTYInCSB requestToSend) of \DLionTTYInLoc)
then CTS
else 0)
(if (fetch (DLTTYInCSB dataTerminalReady) of \DLionTTYInLoc)
then DSR
else 0))
else (LOADBYTE (ISTROBE MODEMSTATUSREG)
0 8))))
(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 "13-JUL-83 18:44")
(SERVICEIRING)
(COND
((SMALLP SPEC)
(BITTEST MSTAT SPEC))
[(LITATOM SPEC)
(BITTEST MSTAT (SELECTQ SPEC
(CTS CTS)
(DSR DSR)
(RI RI)
(RLSD RLSD)
(\ILLEGAL.ARG SPEC]
(T (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])
)
(* After initialization, RS232INIT holds a list of the actual args used)
(RPAQQ RS232INIT NIL)
(RPAQQ \RS232BACKGROUNDSTATE NIL)
(RPAQQ \RS232BACKGROUNDERRORSTATUS NIL)
(RPAQQ \RS232DEVICE NIL)
(RPAQQ \RS232STREAM NIL)
(RPAQ \RS232.TIMEOUT.BOX (SETUPTIMER 0))
(RPAQ \RS232.DING.BOX (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms
\RS232.ByteIntervalCap.tics \RS232.Tovh&BIC4.tics \RS232.Tovh&BIC16.tics
\RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms
\RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP RS232INIT
\RS232BACKGROUNDSTATE \RS232BACKGROUNDERRORSTATUS \RS232DEVICE \RS232STREAM
\RS232.TIMEOUT.BOX \RS232.DING.BOX \RS232DLion?)
)
(* Basic driver functions)
(DECLARE: EVAL@COMPILE
(PUTPROPS RS232PEEKBYTE MACRO (NIL
(PROGN (* This should be a canonical expansion of
RS232PEEKBYTE.BACKUP)
(COND
((COND
(\RS232DLion? (NEQ 0 (LOGAND (FFETCHFIELD (QUOTE (NIL 0 (BITS . 15)))
\DLionTTYInLoc)
32888)))
(T (IGEQ (READPRINTERPORT)
INTRPT)))
(\RS232.PROCESSINTERRUPT)))
(COND
((NEQ \RS232IRING.READ \RS232IRING.WRITE)
(\GETBASEBYTE \RS232IRINGBUF \RS232IRING.READ))))))
(PUTPROPS RS232READBYTE MACRO (X
(* This should be a canonical expansion of
RS232READBYTE.BACKUP)
(COND
(X (QUOTE IGNOREMACRO))
(T (* Take only easy case)
(QUOTE (PROGN (COND
((COND
(\RS232DLion? (NEQ 0 (LOGAND (FFETCHFIELD (QUOTE (NIL 0 (BITS . 15)))
\DLionTTYInLoc)
32888)))
(T (IGEQ (READPRINTERPORT)
INTRPT)))
(\RS232.PROCESSINTERRUPT)))
(COND
((NEQ \RS232IRING.READ \RS232IRING.WRITE)
(\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 " 3-Dec-83 21:19")
(PROG NIL
A [COND
((RS232INTERRUPT?) (* This should be just (SERVICEIRING) but the DLion may
have numerous characters buffered up in the IOP)
(\RS232.PROCESSINTERRUPT)
(COND
(\RS232DLion? (GO A]
(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 "28-DEC-82 08:24")
(SERVICEIRING)
(PROG (HI LO)
(COND
([NOT (AND (OR WAIT? (IRINGB.ATLEAST 2))
(SETQ HI (RS232READBYTE WAIT? timerUnits]
(* Well, not even first byte is here.)
(RETURN))
((NULL (SETQ LO (RS232READBYTE WAIT? timerUnits)))
(* FOO! Didn't get both bytes in time, so put first one
back.)
(PUSHRS232IRING HI)
(RETURN)))
(RETURN (create WORD
HIBYTE ← HI
LOBYTE ← LO])
(RS232WRITEBYTE
(LAMBDA (BYTE FORCEOUT? IGNOREXOFF?) (* JonL "27-Jan-84 19:59")
(RS232INITIALIZECHECK)
(SETQ BYTE (LOADBYTE BYTE 0 8))
(PROG ((BUFFERSTARTSEMPTY (NOT (ORINGB.ATLEAST 1)))
BYTEHASBEENPUSHED LineStatusVal)
A (UNINTERRUPTABLY
(SETQ LineStatusVal (\RS232DECODE.LINESTATUS LineStatusVal (QUOTE NOERROR)))
(COND
((LINESTATUSERRORSP LineStatusVal) (* Foo, we just drop thru, and let the loop correct it.)
NIL)
((AND BUFFERSTARTSEMPTY (NULL BYTEHASBEENPUSHED)
(OR FORCEOUT? (BITTEST LineStatusVal THRE))
(OR (NOT RS232XON\XOFF?)
(NOT RS232XOFF?)
IGNOREXOFF?)) (* If ring buffer is empty, and we aren't prohibited by
XOFF, then just output the char.)
(COND
((OR (BITTEST LineStatusVal THRE)
(EQ T (SETQ LineStatusVal (\RS232CHECK.THRE))))
(RS232DATAO BYTE)
(SETQ LineStatusVal))
(T (SETQ BYTEHASBEENPUSHED (PUSHRS232ORING BYTE))
(SETQ FORCEOUT? T))))
(T (* Otherwise, pack it into the output ring buffer
(and maybe output 1 character from the buffer.))
(COND
((NOT BYTEHASBEENPUSHED)
(SETQ BYTEHASBEENPUSHED (PUSHRS232ORING BYTE))))
(COND
((OR FORCEOUT? (ILEQ 2 (ORINGB.FREE)))
(* Ah, no need to force output -- there's at least one
slot left after storing the next BYTE)
(SETQ LineStatusVal))
((AND RS232XON\XOFF? RS232XOFF? (NOT IGNOREXOFF?))
(* Buffer's nearly full, but we can't send now due to
XOFF)
(SETQ LineStatusVal (QUOTE RS232XOFF?)))
((OR (BITTEST LineStatusVal THRE)
(EQ T (SETQ LineStatusVal (\RS232CHECK.THRE))))
(* Send out 1 character, in order to relieve strain on
output ring buffer.)
(SETQ LineStatusVal)
(RS232DATAO (POPRS232ORING)))
((NULL LineStatusVal) (* Rare Losing case where we waited for the Transmitter,
but didn't get it. So just let the FORCEOUT? case handle
it.)
(SETQ FORCEOUT? T))))))
(COND
((FIXP LineStatusVal) (* 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))
((EQ LineStatusVal (QUOTE RS232XOFF?)) (* Block here if we really need to transmit at least one
character, but transmission prohibited by XOFF)
(until (NOT (AND RS232XON\XOFF? RS232XOFF?)) do (\RS232CHECK.BLOCK))
(SETQ LineStatusVal)
(GO A))
((AND FORCEOUT? (ORINGB.ATLEAST 1))
(RS232FORCEOUTPUT))
(T (SERVICEIRING)
(COND
((AND BUFFERSTARTSEMPTY BYTEHASBEENPUSHED (OR (EQ \RS232BACKGROUNDSTATE
(QUOTE INPUT))
(EQ \RS232BACKGROUNDSTATE
(QUOTE BOTH))))
(NOTIFY.EVENT \RS232ORINGEVENT)
(SERVICEIRING))))))
BYTE))
(RS232SENDBREAK
(LAMBDA (EXTRALONG?) (* JonL "28-Jan-84 01:08")
(RS232INITIALIZECHECK)
(SERVICEIRING)
(PROG (STATUS)
(if \RS232DLion?
then (DLTTYOUTWAIT 2000))
(UNINTERRUPTABLY
(if \RS232DLion?
then (DLTTYPOKE breakOn NOWAIT)
else (\RS232LINECONTROL SBCB SBCB))
(during (if EXTRALONG?
then \RS232.LONGBREAK.tics
else \RS232.SHORTBREAK.tics)
timerUnits (QUOTE TICKS) usingTimer \RS232.THRE.BOX
do (* Just sit around doing nothing, but watching for input
and errors.)
(SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
(if (LINESTATUSERRORSP STATUS)
then (RETURN))
finally (SETQ STATUS))
(if \RS232DLion?
then (DLTTYPOKE breakOff NOWAIT)
else (\RS232LINECONTROL 0 SBCB)))
(if STATUS
then (\RS232DECODE.LINESTATUS STATUS)
else (SERVICEIRING))
(if \RS232DLion?
then (DLTTYOUTWAIT))
(RETURN T))))
(RS232FORCEOUTPUT
[LAMBDA NIL (* JonL " 1-Dec-83 04:35")
(* Returns the number of characters found in the buffer,
which are written out "on the lines")
([LAMBDA (#BYTES OFFST)
(COND
((ILESSP \RS232ORING.READ \RS232ORING.WRITE)
(* The hope is that the characters in the ring buffer will be put out on the lines before any other process can
overwrite them by successive calls to RS232WRITEBYTE etc.)
(SETQ OFFST \RS232ORING.READ)
(SETQ #BYTES (IDIFFERENCE \RS232ORING.WRITE OFFST))
(SETQ \RS232ORING.READ \RS232ORING.WRITE)
(\RS232WRITEBASEBYTES NIL \RS232ORINGBUF OFFST #BYTES))
[(IGREATERP \RS232ORING.READ \RS232ORING.WRITE) (* 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)
(COND
((NEQ 0 #BYTES)
(\RS232WRITEBASEBYTES NIL \RS232ORINGBUF 0 #BYTES))
(T 0]
(T (SERVICEIRING)
0]
0])
(RS232CLEARBUFFER
[LAMBDA (I/O) (* JonL "23-JUN-83 21:26")
(RS232INITIALIZECHECK)
(PROG (OP STATUS FLUSHANY?)
(until [SETQ OP (SELECTQ I/O
((INPUT)
(QUOTE INPUT))
((OUTPUT)
(QUOTE OUTPUT))
((BOTH I/O)
(QUOTE BOTH))
((IN I IRB IRING IRINGBUF)
(QUOTE INPUT))
((OUT O ORB ORING ORINGBUF)
(QUOTE OUTPUT))
(COND
((EQ I/O \RS232IRINGBUF)
(QUOTE INPUT))
((EQ I/O \RS232ORINGBUF)
(QUOTE OUTPUT]
do (SETQ I/O (LISPERROR "ILLEGAL ARG" I/O T)))
[COND
((FMEMB OP (QUOTE (OUTPUT BOTH)))
(COND
(\RS232DLion? (* MESA 8 can't do RS232 Break signal))
(T (\RS232LINECONTROL 0 SBCB))) (* Clear the "send BREAK" bit, just in case it had been
set somehow.)
(UNINTERRUPTABLY
(AND (NEQ \RS232ORING.READ \RS232ORING.WRITE)
(SETQ FLUSHANY? T))
(SETQ \RS232ORING.READ (SETQ \RS232ORING.WRITE 0))
(SETQ STATUS (\RS232CHECK.THRE)))
(COND
([OR (EQ T STATUS)
(AND (FIXP STATUS)
(BITTEST STATUS OE)
(FMEMB OP (QUOTE (INPUT BOTH]
(SETQ FLUSHANY? T))
((NULL STATUS)
(ERROR "Can't clear RS232 OUTPUT"]
[COND
((FMEMB OP (QUOTE (INPUT BOTH)))
(UNINTERRUPTABLY
(SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
(* Flush any possible pending information about input
side errors)
(COND
((OR (BITTEST STATUS OE)
(NEQ \RS232IRING.READ \RS232IRING.WRITE))
(SETQ FLUSHANY? T)))
(SETQ \RS232IRING.READ (SETQ \RS232IRING.WRITE 0)))]
(RETURN FLUSHANY?])
)
(* Block read and write functions)
(DEFINEQ
(RS232READLINE
[LAMBDA (WAIT? timerUnits OLDSTRBUFFER) (* JonL " 2-Dec-83 21:22")
(\RS232INSURE.LINEBUFFER 256)
([LAMBDA (STR)
(COND
((AND STR (EQ (NTHCHARCODE STR -1)
(CHARCODE EOL))) (* GLC in order to Strip off the EOL)
(GLC STR)
(UNINTERRUPTABLY
(COND
([EQ (CHARCODE LF)
(during \RS232.Tovh&BIC4.tics timerUnits (QUOTE TICKS) usingTimer
\RS232.READLINE.BOX
find CHAR suchthat (SETQ CHAR (RS232PEEKBYTE]
(* Waits about 8 character times, to see if the line
will also have a LF after it.
(If so, it gets flushed.))
(POPRS232IRING))))
STR]
(RS232READSTRING NIL (CHARCODE EOL)
NIL WAIT? timerUnits OLDSTRBUFFER])
(RS232READSTRING
[LAMBDA (#CHARS.LIMIT? STOPCODE? NOBLOCKSFLG WAIT? timerUnits OLDSTRBUFFER)
(* JonL "23-JUN-83 22:25")
(SERVICEIRING)
(SETQ #CHARS.LIMIT? (SMALLP #CHARS.LIMIT?))
(OR (NULL STOPCODE?)
(CHARCODEP STOPCODE?)
(AND (LITATOM STOPCODE?)
(EQ 1 (NCHARS STOPCODE?))
(SETQ STOPCODE? (CHCON1 STOPCODE?)))
(SETQ STOPCODE?))
(SERVICEIRING)
(COND
((AND (NULL (FIXP WAIT?))
(NULL #CHARS.LIMIT?)
(NULL STOPCODE?))
(HELP "No termination criteria?")))
(PROG ((BOFFST 0)
BUFFER BUFFERSIZE #CHARS.READ)
(SERVICEIRING)
(COND
(OLDSTRBUFFER (COND
((NOT (STRINGP OLDSTRBUFFER))
(\ILLEGAL.ARG OLDSTRBUFFER)))
(SETQ BUFFER (ffetch (STRINGP BASE) of OLDSTRBUFFER))
(SETQ BUFFERSIZE (ffetch (STRINGP LENGTH) of OLDSTRBUFFER))
(SETQ BOFFST (ffetch (STRINGP OFFST) of OLDSTRBUFFER))
(AND #CHARS.LIMIT? (SETQ #CHARS.LIMIT? (IMIN #CHARS.LIMIT? BUFFERSIZE)))
(SERVICEIRING))
(T (COND
((OR (NULL \RS232LINEBUFFER.SIZE)
(AND (SMALLP #CHARS.LIMIT?)
(IGEQ #CHARS.LIMIT? \RS232LINEBUFFER.SIZE)))
(* Time-critical users had better make sure that this
wing isn't taken.)
[\RS232INSURE.LINEBUFFER (ADD1 (OR (SMALLP #CHARS.LIMIT?)
(CONSTANT (IDIFFERENCE BYTESPERPAGE 50]
(SERVICEIRING)))
(SETQ BUFFER \RS232LINEBUFFER)
(SETQ BUFFERSIZE \RS232LINEBUFFER.SIZE)))
(SETQ #CHARS.READ (\RS232READBASEBYTES NIL BUFFER BOFFST (OR #CHARS.LIMIT? BUFFERSIZE)
(QUOTE \RS232.BLOCKINTERVAL.BOX)
STOPCODE? NOBLOCKSFLG WAIT? timerUnits OLDSTRBUFFER))
(RETURN (COND
(OLDSTRBUFFER (replace (STRINGP LENGTH) of OLDSTRBUFFER with #CHARS.READ)
OLDSTRBUFFER)
((ZEROP #CHARS.READ)
NIL)
((AND (IGEQ #CHARS.READ BUFFERSIZE)
(NULL #CHARS.LIMIT?))
(\RS232DECODE.LINESTATUS LBOE))
(T (PROG1 (\GETBASESTRING BUFFER 0 #CHARS.READ)
(SERVICEIRING])
(\RS232READBASEBYTES
[LAMBDA (STREAM BASE OFFST NBYTES CALLFROMREADSTRING.PASSWORD STOPCODE? NOBLOCKSFLG WAIT?
timerUnits OLDSTRBUFFER) (* JonL "23-JUN-83 22:34")
(SERVICEIRING)
(PROG ((READSTRINGP (OR (EQ CALLFROMREADSTRING.PASSWORD (QUOTE \RS232.BLOCKINTERVAL.BOX))
(PROGN (SETQ STOPCODE?)
(SETQ NOBLOCKSFLG T)
(SETQ WAIT?)
(SETQ OLDSTRBUFFER)
NIL)))
(#CHARS 0)
(NBASE (\ADDBASE BASE OFFST))
[WAITFORBLOCK.BOX (AND (NOT NOBLOCKSFLG)
(SETUPTIMER \RS232.BLOCKINTERVAL.tics \RS232.BLOCKINTERVAL.BOX
(QUOTE TICKS]
WAITFORBYTE.BOX CHAR)
(* \RS232.BLOCKINTERVAL.BOX and \RS232.DELAY.BOX are scoped here -- formerly by GLOBALRESOURCE, but the GC
reference counting took too long that way, so we just use local variables instead, counting on the fact that this
isn't a re-entrant function.)
[COND
((ILEQ NBYTES 0)
(RETURN 0))
((AND READSTRINGP WAIT?)
(SETQ timerUnits (CANONICAL.TIMERUNITS timerUnits]
A (SETQ CHAR (RS232READBYTE))
[COND
((AND WAIT? (OR CHAR (NULL WAITFORBYTE.BOX)))
(SETQ WAITFORBYTE.BOX (SETUPTIMER WAIT? WAITFORBYTE.BOX timerUnits]
[COND
[CHAR (SETQ CHAR (LOADBYTE CHAR 0 BITSPERBYTE))
(\PUTBASEBYTE NBASE #CHARS CHAR)
(add #CHARS 1)
(COND
((OR (IGEQ #CHARS NBYTES)
(AND STOPCODE? (EQ CHAR STOPCODE?)))
(SERVICEIRING)
(RETURN #CHARS]
[(AND WAIT? (PROG1 (TIMEREXPIRED? WAITFORBYTE.BOX timerUnits)
(SERVICEIRING)))
(RETURN (COND
(OLDSTRBUFFER #CHARS)
(T 0]
((AND WAITFORBLOCK.BOX (TIMEREXPIRED? WAITFORBLOCK.BOX (QUOTE TICKS)))
(\RS232CHECK.BLOCK)
(SETQ WAITFORBLOCK.BOX (SETUPTIMER \RS232.BLOCKINTERVAL.tics WAITFORBLOCK.BOX
(QUOTE TICKS]
(GO A])
(\RS232INSURE.LINEBUFFER
[LAMBDA (N) (* JonL "11-MAY-83 21:43")
(PROG1 (COND
((OR (NOT (SMALLPOSP \RS232LINEBUFFER.SIZE))
(NOT (type? ARRAYBLOCK \RS232LINEBUFFER))
(NOT (ILEQ N \RS232LINEBUFFER.SIZE)))
(SETQ N (CEIL (IPLUS N BYTESPERCELL)
BYTESPERPAGE)) (* Add in a little fudge factor and round up to an
integral number of pages, for LOCKPAGES purposes.)
([LAMBDA (BUF)
(SERVICEIRING)
(UNINTERRUPTABLY
(AND (SMALLPOSP \RS232LINEBUFFER.SIZE)
(type? ARRAYBLOCK \RS232LINEBUFFER)
(\UNLOCKPAGES \RS232LINEBUFFER (\#PAGES.BASEBYTES \RS232LINEBUFFER
\RS232LINEBUFFER.SIZE)))
(* Note that this UNLOCK is probably wrong, since the
pages may want to be locked for reasons other than
\RS232LINEBUFFER)
(\LOCKPAGES BUF (\#PAGES.BASEBYTES BUF N))
(SETQ \RS232LINEBUFFER BUF)
(SETQ \RS232LINEBUFFER.SIZE N))]
(\ALLOCBLOCK (FOLDHI N BYTESPERCELL)
NIL CELLSPERPAGE))
T))
(SERVICEIRING)
(\DTEST \RS232STRPTR (QUOTE STRINGP))
(UNINTERRUPTABLY
(freplace (STRINGP BASE) of \RS232STRPTR with \RS232LINEBUFFER)
(freplace (STRINGP OFFST) of \RS232STRPTR with 0)
(freplace (STRINGP LENGTH) of \RS232STRPTR with \RS232LINEBUFFER.SIZE))])
)
(RPAQQ \RS232LINEBUFFER NIL)
(RPAQQ \RS232LINEBUFFER.SIZE NIL)
(RPAQ \RS232.READLINE.BOX (SETUPTIMER 0))
(RPAQ \RS232.BLOCKINTERVAL.BOX (SETUPTIMER 0))
(RPAQ \RS232.DELAY.BOX (SETUPTIMER 0))
(RPAQ \RS232STRPTR (ALLOCSTRING 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232LINEBUFFER \RS232LINEBUFFER.SIZE \RS232.READLINE.BOX
\RS232.BLOCKINTERVAL.BOX \RS232.DELAY.BOX \RS232STRPTR)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS RS232WRITECHARS MACRO (=
. RS232WRITESTRING))
)
(DEFINEQ
(RS232WRITESTRING
(LAMBDA (STRING.OR.LITATOM FORCEOUTPUT?) (* JonL "26-Apr-84 19:59")
(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))
(COND
((NOT FORCEOUTPUT?)
(bind (NCHARSLEFT ← #CHARS)
#BYTESMOVING
(MAX#BYTES.TO.MOVE ←(COND
((ILESSP \RS232Divisor 24)
128)
((ILESSP \RS232Divisor 48)
256)
(T 512)))
while (IGREATERP NCHARSLEFT 0)
do (COND
((IGEQ NCHARSLEFT (ORINGB.FREE))
(* Even though the loser didn't want to forceoutput, we may have to do so in order to make room for the string to
go into the buffer.)
(RS232FORCEOUTPUT)))
(SERVICEIRING)
(UNINTERRUPTABLY
(SETQ #BYTESMOVING (IMIN (COND
((ILEQ \RS232ORING.READ \RS232ORING.WRITE)
(IDIFFERENCE (ADD1 \RS232IRING.SIZE)
\RS232ORING.WRITE))
(T (IDIFFERENCE \RS232ORING.READ (ADD1
\RS232ORING.WRITE))))
NCHARSLEFT MAX#BYTES.TO.MOVE))
(* At each step, we move only as many characters as are permitted by the remaining space in the output ring
buffer, and such as can be \MOVEBYTES in a short time)
(\MOVEBYTES BASE OFFST \RS232ORINGBUF \RS232ORING.WRITE #BYTESMOVING)
(RINGB.INCREMENT \RS232ORING.WRITE #BYTESMOVING
(CONSTANT (MASK.1'S 0 (INTEGERLENGTH (SUB1 BYTESPERPAGE))))))
(SERVICEIRING)
(add OFFST #BYTESMOVING)
(add NCHARSLEFT (IMINUS #BYTESMOVING)))
(AND (PROG1 BUFFERSTARTSEMPTY (* Comment PPLossage))
(OR (EQ \RS232BACKGROUNDSTATE (QUOTE OUTPUT))
(EQ \RS232BACKGROUNDSTATE (QUOTE BOTH)))
(NOTIFY.EVENT \RS232ORINGEVENT)))
(T (COND
((ORINGB.ATLEAST 1)
(RS232FORCEOUTPUT)))
(\RS232WRITEBASEBYTES NIL BASE OFFST #CHARS)))
(RETURN #CHARS))))
(RS232WRITECHARS
[LAMBDA (STRING.OR.LITATOM FORCEOUTPUT?) (* JonL "18-MAY-83 20:31")
(RS232WRITESTRING STRING.OR.LITATOM FORCEOUTPUT?])
(\RS232WRITEBASEBYTES
[LAMBDA (STREAM BASE OFFST #BYTES) (* JonL "17-JUN-83 19:39")
(* Returns the number of bytes which are written out
"on the lines")
(bind STATUS (ITH ← 0) while (ILESSP ITH #BYTES)
do (* You may not believe it, but the
\RS232.MAX#BYTESPERLOOP is set so that interrupts are
locked out for not more than \RS232.BLOCKINTERVAL.ms
milliseconds.)
(UNINTERRUPTABLY
(to \RS232.MAX#BYTESPERLOOP while (AND (ILESSP ITH #BYTES)
(EQ T (SETQ STATUS (\RS232CHECK.THRE)))
(OR (NOT RS232XON\XOFF?)
(NOT RS232XOFF?)))
do (RS232DATAO (\GETBASEBYTE BASE (IPLUS OFFST ITH)))
(add ITH 1)))
(* Since \RS232DECODE.LINESTATUS may generate an error, we can't call it under the UNINTERRUPTABLY -- also, we
come out here if the THR isn't empty after 2 character times, and busy-wait a bit.)
[COND
((AND (FIXP STATUS)
(LINESTATUSERRORSP STATUS))
(SETQ STATUS (\RS232DECODE.LINESTATUS STATUS]
(\RS232CHECK.BLOCK))
(SERVICEIRING)
#BYTES])
(\RS232BOUTSTRING
[LAMBDA (STREAM STRING) (* JonL "22-NOV-82 23:12")
(* Foo, this could be done with a BOUTS, but we have to
intersperse in the calls to SERVICEIRING)
[for I from 1 eachtime (SERVICEIRING) do (BOUT STREAM (OR (NTHCHARCODE STRING I)
(RETURN]
(SERVICEIRING])
)
(* Use of XON/XOFF protocols)
(RPAQ? RS232XON\XOFF? NIL)
(RPAQ? RS232XOFF? NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS RS232XON\XOFF? RS232XOFF?)
)
(* Check to see if Transmitter Holding Register is empty.)
(DEFINEQ
(\RS232CHECK.THRE
[LAMBDA NIL (* JonL " 2-Dec-83 21:34")
(* 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 T if THR is empty, and an
THROE error if it isn't empty.)
(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)))
(COND
((LINESTATUSERRORSP STATUS)
(RETURN STATUS))
((BITTEST THRE STATUS)
(RETURN T)))
finally (RETURN THROE)))])
)
(RPAQ? \RS232.THRE.BOX (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232.THRE.BOX)
)
(* Check to see if BLOCK can be called now)
(DEFINEQ
(\RS232CHECK.BLOCK
[LAMBDA (WAIT?.ms) (* JonL " 3-Dec-83 11:11")
(* Returns non-NIL iff it actually does a BLOCK)
(DECLARE (GLOBALVARS \LastWindowButtons)
(SPECVARS \INTERRUPTABLE))
(SERVICEIRING)
(PROG1 (COND
(WAIT?.ms (during (PROG1 WAIT?.ms (* Comment PPLossage)) resourceName
\RS232.ADMIT.BOX
bind FLG do (AND (\RS232CHECK.BLOCK)
(SETQ FLG T))
finally (RETURN FLG)))
((AND (OR (OR (KEYDOWNP (QUOTE LEFT))
(KEYDOWNP (QUOTE MIDDLE))
(KEYDOWNP (QUOTE RIGHT))
(KEYDOWNP (QUOTE CENTER)))
(KEYDOWNP (QUOTE BLANK-TOP)))
\INTERRUPTABLE) (* 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)
(COND
(\LastWindowButtons (* If WINDOW.MOUSE.HANDLER reset this, then it failed to
run DOWINDOWCOM so try once more!)
(\RS232.CHECKUART)
(SETQ \LastWindowButtons)
(BLOCK)))
T))
(\RS232.CHECKUART])
)
(RPAQQ \\RS232.ADMIT.BOX.GLOBALRESOURCE NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(PUTDEF (QUOTE \RS232.ADMIT.BOX)
(QUOTE GLOBALRESOURCES)
(QUOTE (NEW (SETUPTIMER 0))))
)
(* Debugging aids)
(DEFINEQ
(RS232DUMPBUFFER
[LAMBDA (I/O.BUF N M) (* JonL " 3-Dec-83 21:14")
[OR (EQ I/O.BUF \RS232IRINGBUF)
(EQ I/O.BUF \RS232ORINGBUF)
(COND
((FMEMB I/O.BUF (QUOTE (INPUT IN I IRB IRING IRINGBUF NIL)))
(SETQ I/O.BUF \RS232IRINGBUF))
((FMEMB I/O.BUF (QUOTE (OUTPUT OUT O ORB ORING ORINGBUF)))
(SETQ I/O.BUF \RS232ORINGBUF))
(T (LISPERROR "ILLEGAL ARG" I/O.BUF]
(RS232INITIALIZECHECK)
(PROG [(BUFSIZ (ADD1 (COND
((EQ I/O.BUF \RS232IRINGBUF)
\RS232IRING.SIZE)
(T \RS232ORING.SIZE]
[COND
[(AND (NULL N)
(NULL M))
(COND
((EQ I/O.BUF \RS232IRINGBUF)
(SETQ N \RS232IRING.READ)
(SETQ M \RS232IRING.WRITE))
(T (SETQ N \RS232ORING.READ)
(SETQ M \RS232ORING.WRITE]
((AND (SMALLP N)
(IGEQ N 0)
(ILESSP N BUFSIZ)
(NULL M))
(SETQ M (SUB1 N)))
(T (ERROR "Bad range indices" (LIST N M]
(for I from (PROG1 0 (* Comment PPLossage))
bind (STR ←(ALLOCSTRING (IMOD (IDIFFERENCE M N)
BUFSIZ)
(QUOTE #)))
until (EQ N M)
do (AND (NEQ 0 (\GETBASEBYTE I/O.BUF N))
(RPLCHARCODE STR (ADD1 I)
(\GETBASEBYTE I/O.BUF N)))
(SETQ N (IMOD (IPLUS N 1)
BUFSIZ))
finally (RETURN STR])
(\D0RS232DUMP
[LAMBDA NIL (* JonL " 9-MAY-83 22:01")
(for REGNAME N in (QUOTE (InterruptEnable InterruptID LineControl ModemControl LineStatus
ModemStatus))
as I from 1 do (printout T T REGNAME "Register [" I "]" 28 " = " .I8.-2
(SETQ N (LOADBYTE (ISTROBE I)
0 8))
"B, " .I3.-8 N "Q")
finally (printout T T "ReceiveBufferRegister [0]" 28 " = " .I8.-2 (SETQ N
(LOADBYTE (ISTROBE DATAREG)
0 8))
"B, " .I3.-8 N "Q"))
(RESETFORM (\RS232LINECONTROL DLAB)
(printout T T "DivisorLatchRegister " 28 " = " .I4.10 (DEPOSITBYTE (ISTROBE
LOWDIVISORREG)
8 8 (ISTROBE
HIDIVISORREG))
"D"))
(TERPRI T])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA RS232MODEMCONTROL)
)
(PUTPROPS RS232 COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9833 10136 (ORDINALSUFFIXSTRING 9843 . 10134)) (11018 13338 (\#PAGES.BASEBYTES 11028 .
11310) (\FRESHENUPFN 11312 . 12098) (\ONPATHS.CCODE 12100 . 13336)) (27940 34353 (\RS232.CHECKUART
27950 . 28083) (\RS232.PROCESSINTERRUPT 28085 . 30854) (\RS232.DATAREADY 30856 . 31719) (
\RS232DECODE.LINESTATUS 31721 . 33640) (\RS232.OUTPUTBROOM 33642 . 34351)) (34832 36287 (\RS232DING
34842 . 35747) (\RS232STABLIZE 35749 . 36285)) (37621 52127 (RS232INIT 37631 . 48794) (\RS232UNLOCKBUF
48796 . 49075) (RS232BACKGROUND 49077 . 50405) (\RS232.PERIODIC.FN 50407 . 50638) (\RS232EVENTFN
50640 . 52125)) (52128 57465 (RS232MODEMCONTROL 52138 . 53381) (RS232MODIFYMODEMCONTROL 53383 . 54684)
(RS232MODEMHANGUP 54686 . 55262) (RS232MODEMSTATUSP 55264 . 56238) (\RS232.MSP1 56240 . 56895) (
\RS232LINECONTROL 56897 . 57463)) (59695 70318 (RS232PEEKBYTE 59705 . 59880) (RS232LISTEN 59882 .
60372) (RS232READBYTE 60374 . 61778) (RS232READWORD 61780 . 62486) (RS232WRITEBYTE 62488 . 65885) (
RS232SENDBREAK 65887 . 67064) (RS232FORCEOUTPUT 67066 . 68436) (RS232CLEARBUFFER 68438 . 70316)) (
70362 76894 (RS232READLINE 70372 . 71268) (RS232READSTRING 71270 . 73441) (\RS232READBASEBYTES 73443
. 75337) (\RS232INSURE.LINEBUFFER 75339 . 76892)) (77421 81808 (RS232WRITESTRING 77431 . 79879) (
RS232WRITECHARS 79881 . 80052) (\RS232WRITEBASEBYTES 80054 . 81368) (\RS232BOUTSTRING 81370 . 81806))
(82059 82915 (\RS232CHECK.THRE 82069 . 82913)) (83087 84491 (\RS232CHECK.BLOCK 83097 . 84489)) (84695
86871 (RS232DUMPBUFFER 84705 . 86048) (\D0RS232DUMP 86050 . 86869)))))
STOP