(FILECREATED "29-JUN-83 11:19:27" {PHYLUM}<LISPCORE>SOURCES>RS232.;127 83444
changes to: (FNS RS232MODEMHANGUP)
previous date: "29-JUN-83 07:08:29" {PHYLUM}<JONL>LISP>RS232.;1)
(* Copyright (c) 1982, 1983 by Xerox Corporation)
(PRETTYCOMPRINT RS232COMS)
(RPAQQ RS232COMS ((LOCALVARS . T)
(COMS (* Generally useful tools.)
(FNS ORDINALSUFFIXSTRING)
(DECLARE: DONTCOPY (MACROS CANONICAL.TIMERUNITS)
(P (COND ((BOUNDP (QUOTE BITSPERBYTE)))
(T (* These should be in MODARITH or ADDARITH but remember the case
of LOADFROMing on Interlisp-10)
(SETQ BITSPERNIBBLE (IQUOTIENT (SETQ BITSPERBYTE 8)
2))
(SETQ BYTESPERPAGE 512)
(CONSTANTS BITSPERBYTE BYTESPERPAGE BITSPERNIBBLE)))))
(* Calculate the number of pages represented by an address and a byte offset. Touch all
the pages of a function, to be sure they are swapped in.)
(FNS \#PAGES.BASEBYTES \FRESHENUPFN \ONPATHS.CCODE)
(CONSTANTS ACTIVE.EM))
(DECLARE: DONTCOPY (* Following constants come from the terminology in the hardware
description of the INS8250 chip.)
(CONSTANTS DATAREG INTERRUPTENABLEREG INTERRUPTIDREG LINECONTROLREG MODEMCONTROLREG
LINESTATUSREG MODEMSTATUSREG LOWDIVISORREG HIDIVISORREG)
(* Register addresses, not left-shifted (i.e., as in INS8250 table))
(CONSTANTS INTRPT)
(* Interrupt bit from chip, as a READPRINTERPORT bit)
(* Interrupt Enable Register bits)
(CONSTANTS ERBFI ETBEI ELSI EDSSI)
(CONSTANTS NoInterrupt LineStatus DataAvailable HoldingRegisterEmpty MODEMstatus)
(* Meanings of value from Interrupt ID register.)
(CONSTANTS STB PEN EPS SBCB DLAB)
(* Line Control Register bits.)
(CONSTANTS DR OE PE FE BI THRE TSRE RBOE LBOE)
(* Line Status Register bits, but RBOE and LBOE are my own software RingBuffer and
LineBuffer full indicators.)
(CONSTANTS DTR RTS OUT1 OUT2 LOOP CTS DSR RI RLSD)
(* MODEM control and MODEM status register bits)
(CONSTANTS DISTR DOSTR MASTERRESET)
(* Misc bits -- Input Strobe Line, Output Strobe Line, and Master Reset.)
(* NOSTROBE has the strobe lines low, directed to a non-existent register so that
other registers won't be disturbed. REGADDRSHIFT is the LLSH factor for register
addresses when sent to the parallel port.)
(CONSTANTS NOSTROBE REGADDRSHIFT))
(DECLARE: DONTCOPY (* TO.REGISTER converts a CONSTANTEXPRESSIONP frob into the numerical bits
needed to address that numbered register in the INS8250 chip. If a
second arg is given, the value is put in the data part of the numerical
bits, so that it may be written into the register. The "strobe" macros
exists since it takes two calls to WRITEPRINTERPORT to effect any
action -- one call with the input (or output)
strobe line hi, and one call with it low.)
(MACROS TO.REGISTER ISTROBE OSTROBE RS232INTERRUPT? RS232INITIALIZECHECK RS232DATAI
RS232DATAO RS232STATUSIN))
(COMS (* buffer management)
(* Chars to and from the chip may be stored in ring buffers. Note that the "hi" indices
point to 1 slot beyond the active data, whereas the "lo" slot points to the lowest
slot of active data. Note also that the ring buffer sizes *MUST* be a power of two
so that index addition can be "IMOD" ified by merely doing a LOGAND.)
(INITVARS (\RS232IRINGBUF NIL)
(\RS232ORINGBUF NIL)
(\RS232ORINGEVENT (CREATE.EVENT "RS232OutputStartup")))
(DECLARE: DONTCOPY (CONSTANTS (\RS232RINGBUFFER.SIZE BYTESPERPAGE))
(MACROS SERVICEIRING RINGB.INCREMENT PUSHRS232IRING POPRS232IRING
PUSHRS232ORING POPRS232ORING IRINGB.ATLEAST ORINGB.ATLEAST
ORINGB.FREE LINESTATUSERRORBITS LINESTATUSERRORSP CHECKDATAREADY
RS232PEEKBYTE.BACKUP RS232READBYTE.BACKUP))
(FNS \RS232.PROCESSINTERRUPT \RS232.DATAREADY \RS232DECODE.LINESTATUS
\RS232.OUTPUTBROOM)
(GLOBALVARS \RS232IRINGBUF \RS232IRING.WRITE \RS232IRING.READ \RS232ORINGBUF
\RS232ORING.WRITE \RS232ORING.READ \RS232ORINGEVENT)
(COMS (* Functional interface for what to do if a character is dropped, or a break
signal is received.)
(INITVARS (RS232LOSTCHARFN (QUOTE \RS232DING))
(RS232BREAKFN NIL)
(RS232BREAKSEEN? NIL)
(\RS232.DROPPEDCHARACTER.CODE (CHARCODE #↑G))
(\RS232.ERROR.MASK -1)
(\RS232DING.BOX (SETUPTIMER 0)))
(FNS \RS232DING)
(SPECVARS RS232LOSTCHARFN RS232BREAKFN RS232BREAKSEEN? \RS232NoInterruptFN
\RS232.DROPPEDCHARACTER.CODE)
(GLOBALVARS \RS232.ERROR \RS232.ERROR.MASK \RS232DING.BOX)))
(COMS (* Various parameters installed by RS232INIT)
(INITVARS (\RS232DefaultBaudRate 1200)
(\RS232DefaultBLOCKINTERVAL.ms 250))
(INITVARS \RS232Divisor \RS232.ByteIntervalCap.ms \RS232.ByteIntervalCap.tics
\RS232.Tovh&BIC2.tics \RS232.Tovh&BIC8.tics \RS232.LONGBREAK.tics
\RS232.SHORTBREAK.tics \RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics
\RS232.MAX#BYTESPERLOOP)
(* The "Divisor" correlates with the INS8250 crystal to generate the baud rate.
\RS232.ByteIntervalCap.tics is a "cap" , or least upper limit, on the time-span of
one character. \RS232.BLOCKINTERVAL.tics is the typical interval in the "intensive"
RS232 routines during which no BLOCKing will be done
(i.e., other processes will be locked out))
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS RS232CHARACTERISTICS))
(INITVARS (\RS232DLion? NIL))
(FNS RS232INIT \RS232UNLOCKBUF RS232BACKGROUND \RS232.PERIODIC.FN \RS232EVENTFN)
(FNS RS232MODEMCONTROL RS232MODIFYMODEMCONTROL RS232MODEMHANGUP RS232MODEMSTATUSP
\RS232.MSP1 \RS232LINECONTROL)
(* After initialization, RS232INIT holds a list of the actual args used)
(VARS (RS232INIT NIL)
(\RS232BACKGROUNDSTATE NIL)
(\RS232BACKGROUNDERRORSTATUS NIL)
(\RS232DEVICE NIL)
(\RS232STREAM NIL)
(\RS232.TIMEOUT.BOX (SETUPTIMER 0))
(\RS232.DING.BOX (SETUPTIMER 0)))
(GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms
\RS232.ByteIntervalCap.tics \RS232.Tovh&BIC2.tics \RS232.Tovh&BIC8.tics
\RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms
\RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP
RS232INIT \RS232BACKGROUNDSTATE \RS232BACKGROUNDERRORSTATUS \RS232DEVICE
\RS232STREAM \RS232.TIMEOUT.BOX \RS232.DING.BOX \RS232DLion?)
(COMS (* DLION RS232 stuff)
(INITVARS (\DLErrorBitsConversion NIL)
(\DLionTTYPortCSB NIL)
(\RS232DLionTTYP T))
(GLOBALVARS \DLErrorBitsConversion \DLionTTYPortCSB \RS232DLionTTYP)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS DLTTYCSB Parameters InCharStatus
ModemControl)
(MACROS DLTTYOUTBUSY DLTTYOUTWAIT DLTTYPOKE)
(CONSTANTS (DLIOP.TTYCSB.OFFSET 81))
(* Following for bits in outControl word of DLTTYCSB)
(CONSTANTS (OutControl.putChar 32768)
(OutControl.setAllParameters 48897)
(OutControl.on 32771)
(OutControl.off 32772)
(OutControl.setDSR 33025)
(OutControl.setCTS 33281)
(OutControl.setDSR&CTS 33537))
(* Following for bits in inControl word of DLTTYCSB)
(CONSTANTS (InControl.InterruptMask 32888)
(InControl.charPresent 32768)
(InControl.errorBits 120)
(InControl.breakDetected 64)
(InControl.framingError 32)
(InControl.dataLost 16)
(InControl.parityError 8)))))
(COMS (* Basic driver functions)
(MACROS RS232PEEKBYTE RS232READBYTE)
(FNS RS232PEEKBYTE RS232LISTEN RS232READBYTE RS232READWORD RS232WRITEBYTE
RS232SENDBREAK RS232FORCEOUTPUT RS232CLEARBUFFER)
(* Block read and write functions)
(FNS RS232READLINE RS232READSTRING \RS232READBASEBYTES \RS232INSURE.LINEBUFFER)
(VARS (\RS232LINEBUFFER NIL)
(\RS232LINEBUFFER.SIZE NIL)
(\RS232.READLINE.BOX (SETUPTIMER 0))
(\RS232.BLOCKINTERVAL.BOX (SETUPTIMER 0))
(\RS232.DELAY.BOX (SETUPTIMER 0))
(\RS232STRPTR (ALLOCSTRING 0)))
(GLOBALVARS \RS232LINEBUFFER \RS232LINEBUFFER.SIZE \RS232.READLINE.BOX
\RS232.BLOCKINTERVAL.BOX \RS232.DELAY.BOX \RS232STRPTR)
(MACROS RS232WRITECHARS)
(FNS RS232WRITESTRING RS232WRITECHARS \RS232WRITEBASEBYTES \RS232BOUTSTRING)
(* Use of XON/XOFF protocols)
(INITVARS (RS232XON\XOFF? NIL)
(RS232XOFF? NIL))
(GLOBALVARS RS232XON\XOFF? RS232XOFF?)
(* Check to see if Transmitter Holding Register is empty.)
(FNS \RS232CHECK.THRE)
(INITVARS (\RS232.THRE.BOX (SETUPTIMER 0)))
(GLOBALVARS \RS232.THRE.BOX)
(* Check to see if BLOCK can be called now)
(FNS \RS232CHECK.BLOCK)
(GLOBALRESOURCES (\RS232.ADMIT.BOX (SETUPTIMER 0))))
(COMS (* Debugging aids)
(FNS RS232DUMPBUFFER \D0RS232DUMP))
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA RS232MODEMCONTROL)
))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(* Generally useful tools.)
(DEFINEQ
(ORDINALSUFFIXSTRING
(LAMBDA (N) (* JonL " 5-JAN-83 23:54")
(SETQ N (IABS N))
(if (AND (ILEQ 5 N)
(ILEQ N 20))
then "th"
else (SELECTC (SETQ N (IREMAINDER N 10))
(1 "st")
(2 "nd")
(3 "rd")
"th"))))
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS CANONICAL.TIMERUNITS MACRO (OPENLAMBDA (X)
(* Checks for common abbreviations before calling
\CanonicalizeTimerUnits)
(SELECTQ X
((TICKS MILLISECONDS SECONDS) (* These are the canonical forms)
X)
((TICS)
(QUOTE TICKS))
((NIL MS MILLISECS)
(QUOTE MILLISECONDS))
((SECS)
(QUOTE SECONDS))
(\CanonicalizeTimerUnits X))))
)
(COND ((BOUNDP (QUOTE BITSPERBYTE)))
(T (* These should be in MODARITH or ADDARITH but remember the case of LOADFROMing on
Interlisp-10)
(SETQ BITSPERNIBBLE (IQUOTIENT (SETQ BITSPERBYTE 8)
2))
(SETQ BYTESPERPAGE 512)
(CONSTANTS BITSPERBYTE BYTESPERPAGE BITSPERNIBBLE)))
)
(* Calculate the number of pages represented by an address and a byte offset. Touch all the
pages of a function, to be sure they are swapped in.)
(DEFINEQ
(\#PAGES.BASEBYTES
(LAMBDA (BASE OFFST) (* JonL " 5-DEC-82 21:15")
(ADD1 (IDIFFERENCE (fetch (POINTER PAGE#) of (\ADDBASE BASE (SUB1 (FOLDHI OFFST BYTESPERWORD))))
(fetch (POINTER PAGE#) of BASE)))))
(\FRESHENUPFN
(LAMBDA (F) (* JonL " 5-DEC-82 21:15")
(* Freshens up a compiled function by touching all of its pages; hopefully this will bring them "in core" and let
them stay there long enough so that a subsequent call to the function won't have a pagefault.)
(AND (CCODEP (SETQ F (GETD F)))
(bind (PAGEBASE ←(fetch (POINTER PAGEBASE) of (fetch (ARRAYP BASE) of F)))
to (\#PAGES.BASEBYTES (fetch (ARRAYP BASE) of F)
(fetch (ARRAYP LENGTH) of F))
do (* Just "touch" the page, to be sure it's in.)
(\GETBASE PAGEBASE 0)
(SETQ PAGEBASE (\ADDBASE PAGEBASE WORDSPERPAGE))))))
(\ONPATHS.CCODE
(LAMBDA (BASISFNSLST IGNOREFNSLST TOWHATDEPTH?) (* JonL "18-DEC-82 05:48")
(PROG (INCREMENTALFNSLST RESULTS SOFAR)
(OR (FIXP TOWHATDEPTH?)
(SETQ TOWHATDEPTH? 1))
(if (thereis X in BASISFNSLST suchthat (OR (NOT (CCODEP X))
(FMEMB X IGNOREFNSLST)))
then (SETQ BASISFNSLST (MAPCONC BASISFNSLST (FUNCTION (LAMBDA (X)
(AND (CCODEP X)
(NOT (FMEMB X IGNOREFNSLST))
(LIST X)))))))
(SETQ RESULTS BASISFNSLST)
(SETQ INCREMENTALFNSLST BASISFNSLST)
A (for X in INCREMENTALFNSLST first (SETQ SOFAR)
do (for Y in (CADR (CALLSCCODE X)) do (AND (CCODEP Y)
(NOT (FMEMB Y RESULTS))
(NOT (FMEMB Y IGNOREFNSLST))
(NOT (FMEMB Y SOFAR))
(push SOFAR Y))))
(if SOFAR
then (* If we garnered some more on this round, then go back
and look for paths emenating out from these new ones.)
(SETQ INCREMENTALFNSLST SOFAR)
(SETQ RESULTS (APPEND INCREMENTALFNSLST RESULTS))
(if (ILESSP 0 (add TOWHATDEPTH? -1))
then (GO A)))
(RETURN RESULTS))))
)
(DECLARE: EVAL@COMPILE
(RPAQQ ACTIVE.EM 299)
(CONSTANTS ACTIVE.EM)
)
(DECLARE: DONTCOPY
(* Following constants come from the terminology in the hardware description of the INS8250
chip.)
(DECLARE: EVAL@COMPILE
(RPAQQ DATAREG 0)
(RPAQQ INTERRUPTENABLEREG 1)
(RPAQQ INTERRUPTIDREG 2)
(RPAQQ LINECONTROLREG 3)
(RPAQQ MODEMCONTROLREG 4)
(RPAQQ LINESTATUSREG 5)
(RPAQQ MODEMSTATUSREG 6)
(RPAQQ LOWDIVISORREG 0)
(RPAQQ HIDIVISORREG 1)
(CONSTANTS DATAREG INTERRUPTENABLEREG INTERRUPTIDREG LINECONTROLREG MODEMCONTROLREG LINESTATUSREG
MODEMSTATUSREG LOWDIVISORREG HIDIVISORREG)
)
(* Register addresses, not left-shifted (i.e., as in INS8250 table))
(DECLARE: EVAL@COMPILE
(RPAQQ INTRPT 32768)
(CONSTANTS INTRPT)
)
(* Interrupt bit from chip, as a READPRINTERPORT bit)
(* Interrupt Enable Register bits)
(DECLARE: EVAL@COMPILE
(RPAQQ ERBFI 1)
(RPAQQ ETBEI 2)
(RPAQQ ELSI 4)
(RPAQQ EDSSI 8)
(CONSTANTS ERBFI ETBEI ELSI EDSSI)
)
(DECLARE: EVAL@COMPILE
(RPAQQ NoInterrupt 1)
(RPAQQ LineStatus 6)
(RPAQQ DataAvailable 4)
(RPAQQ HoldingRegisterEmpty 2)
(RPAQQ MODEMstatus 0)
(CONSTANTS NoInterrupt LineStatus DataAvailable HoldingRegisterEmpty MODEMstatus)
)
(* Meanings of value from Interrupt ID register.)
(DECLARE: EVAL@COMPILE
(RPAQQ STB 4)
(RPAQQ PEN 8)
(RPAQQ EPS 16)
(RPAQQ SBCB 64)
(RPAQQ DLAB 128)
(CONSTANTS STB PEN EPS SBCB DLAB)
)
(* Line Control Register bits.)
(DECLARE: EVAL@COMPILE
(RPAQQ DR 1)
(RPAQQ OE 2)
(RPAQQ PE 4)
(RPAQQ FE 8)
(RPAQQ BI 16)
(RPAQQ THRE 32)
(RPAQQ TSRE 64)
(RPAQQ RBOE 256)
(RPAQQ LBOE 512)
(CONSTANTS DR OE PE FE BI THRE TSRE RBOE LBOE)
)
(* Line Status Register bits, but RBOE and LBOE are my own software RingBuffer and LineBuffer
full indicators.)
(DECLARE: EVAL@COMPILE
(RPAQQ DTR 1)
(RPAQQ RTS 2)
(RPAQQ OUT1 4)
(RPAQQ OUT2 8)
(RPAQQ LOOP 16)
(RPAQQ CTS 16)
(RPAQQ DSR 32)
(RPAQQ RI 64)
(RPAQQ RLSD 128)
(CONSTANTS DTR RTS OUT1 OUT2 LOOP CTS DSR RI RLSD)
)
(* MODEM control and MODEM status register bits)
(DECLARE: EVAL@COMPILE
(RPAQQ DISTR 256)
(RPAQQ DOSTR 2048)
(RPAQQ MASTERRESET 4096)
(CONSTANTS DISTR DOSTR MASTERRESET)
)
(* Misc bits -- Input Strobe Line, Output Strobe Line, and Master Reset.)
(* NOSTROBE has the strobe lines low, directed to a non-existent register so that other
registers won't be disturbed. REGADDRSHIFT is the LLSH factor for register addresses when sent
to the parallel port.)
(DECLARE: EVAL@COMPILE
(RPAQQ NOSTROBE 57344)
(RPAQQ REGADDRSHIFT 13)
(CONSTANTS NOSTROBE REGADDRSHIFT)
)
)
(DECLARE: DONTCOPY
(* TO.REGISTER converts a CONSTANTEXPRESSIONP frob into the numerical bits needed to address
that numbered register in the INS8250 chip. If a second arg is given, the value is put in the
data part of the numerical bits, so that it may be written into the register. The "strobe"
macros exists since it takes two calls to WRITEPRINTERPORT to effect any action -- one call
with the input (or output) strobe line hi, and one call with it low.)
(DECLARE: EVAL@COMPILE
(PUTPROPS TO.REGISTER MACRO (X
(PROG ((REGISTER.NUMBER (CAR X))
(VAL (CADR X))
REGISTER.ADDR)
(SETQ REGISTER.ADDR (LIST (QUOTE LLSH)
REGISTER.NUMBER
(QUOTE REGADDRSHIFT)))
(COND
((CONSTANTEXPRESSIONP REGISTER.NUMBER)
(SETQ REGISTER.ADDR (COND
((ZEROP (EVAL REGISTER.NUMBER))
0)
(T (LIST (QUOTE CONSTANT)
REGISTER.ADDR))))))
(RETURN (COND
((OR (NULL VAL)
(ZEROP VAL)
(AND (CONSTANTEXPRESSIONP VAL)
(ZEROP (EVAL VAL))))
REGISTER.ADDR)
((ZEROP REGISTER.ADDR)
VAL)
(T (LIST (QUOTE LOGOR)
REGISTER.ADDR VAL)))))))
(PUTPROPS ISTROBE MACRO ((REGISTER)
(PROG2 (WRITEPRINTERPORT (LOGOR DISTR (TO.REGISTER REGISTER)))
(READPRINTERPORT)
(WRITEPRINTERPORT NOSTROBE))))
(PUTPROPS OSTROBE MACRO ((REGISTER VAL)
((LAMBDA (Register&Value)
(WRITEPRINTERPORT (LOGOR DOSTR Register&Value)) (* Note that this also sets the DISTR line off)
(WRITEPRINTERPORT Register&Value) (* It just so happens that the time between two
WRITEPRINTERPORT instructions is enough for the data to
be transferred to the holding register.)
Register&Value)
(TO.REGISTER REGISTER VAL))))
(PUTPROPS RS232INTERRUPT? MACRO (NIL
(if \RS232DLion?
then (BITTEST (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB)
InControl.InterruptMask)
else (IGEQ (READPRINTERPORT)
INTRPT))))
(PUTPROPS RS232INITIALIZECHECK MACRO (NIL
(OR (LISTP RS232INIT)
(ERROR (QUOTE RS232NotInitialized)))))
(PUTPROPS RS232DATAI DMACRO (NIL
(if \RS232DLion?
then (PROG1 (fetch (DLTTYCSB inChar) of \DLionTTYPortCSB)
(replace (DLTTYCSB inControl) of \DLionTTYPortCSB
with (BITCLEAR (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB)
InControl.charPresent)))
else (ISTROBE DATAREG))))
(PUTPROPS RS232DATAO DMACRO ((BYTE)
(if \RS232DLion?
then (replace (DLTTYCSB outData) of \DLionTTYPortCSB with BYTE)
(DLTTYPOKE putChar NOWAIT)
else (OSTROBE DATAREG BYTE))))
(PUTPROPS RS232STATUSIN MACRO (NIL
(UNINTERRUPTABLY
((LAMBDA (Status)
(DECLARE (LOCALVARS Status))
(if \RS232BACKGROUNDERRORSTATUS
then (add Status \RS232BACKGROUNDERRORSTATUS)
(SETQ \RS232BACKGROUNDERRORSTATUS))
Status)
(if \RS232DLion?
then ((LAMBDA (cw)
(DECLARE (LOCALVARS cw r))
((LAMBDA (r)
(if (BITTEST cw InControl.errorBits)
then (add r (\GETBASEBYTE \DLErrorBitsConversion (LOADBYTE cw 3 4))))
r)
(if (BITTEST cw InControl.charPresent)
then DR
else 0)))
(fetch (DLTTYCSB inControl) of \DLionTTYPortCSB))
else (LOADBYTE (ISTROBE LINESTATUSREG)
0 8))))))
)
)
(* buffer management)
(* Chars to and from the chip may be stored in ring buffers. Note that the "hi" indices point
to 1 slot beyond the active data, whereas the "lo" slot points to the lowest slot of active
data. Note also that the ring buffer sizes *MUST* be a power of two so that index addition can
be "IMOD" ified by merely doing a LOGAND.)
(RPAQ? \RS232IRINGBUF NIL)
(RPAQ? \RS232ORINGBUF NIL)
(RPAQ? \RS232ORINGEVENT (CREATE.EVENT "RS232OutputStartup"))
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQ \RS232RINGBUFFER.SIZE BYTESPERPAGE)
(CONSTANTS (\RS232RINGBUFFER.SIZE BYTESPERPAGE))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS SERVICEIRING DMACRO (NIL
(if (RS232INTERRUPT?)
then (\RS232.PROCESSINTERRUPT))))
(PUTPROPS RINGB.INCREMENT MACRO ((VAR AMOUNT)
(PROG1 VAR (SETQ VAR (IMOD (IPLUS VAR AMOUNT)
\RS232RINGBUFFER.SIZE)))))
(PUTPROPS PUSHRS232IRING MACRO ((BYTE)
(\PUTBASEBYTE \RS232IRINGBUF (RINGB.INCREMENT \RS232IRING.WRITE 1)
BYTE)))
(PUTPROPS POPRS232IRING MACRO (NIL
(\GETBASEBYTE \RS232IRINGBUF (RINGB.INCREMENT \RS232IRING.READ 1))))
(PUTPROPS PUSHRS232ORING MACRO ((BYTE)
(\PUTBASEBYTE \RS232ORINGBUF (RINGB.INCREMENT \RS232ORING.WRITE 1)
BYTE)))
(PUTPROPS POPRS232ORING MACRO (NIL
(\GETBASEBYTE \RS232ORINGBUF (RINGB.INCREMENT \RS232ORING.READ 1))))
(PUTPROPS IRINGB.ATLEAST DMACRO (X
(PROG ((N (LISPFORM.SIMPLIFY (CAR X)
T)))
(RETURN (COND
((AND (FIXP N)
(IEQP N 1))
(QUOTE (NEQ \RS232IRING.READ \RS232IRING.WRITE)))
(T (SUBST N (QUOTE N)
(QUOTE (ILEQ N (IMOD (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
\RS232RINGBUFFER.SIZE))))))))))
(PUTPROPS ORINGB.ATLEAST DMACRO (X
(PROG ((N (LISPFORM.SIMPLIFY (CAR X)
T)))
(RETURN (COND
((AND (FIXP N)
(IEQP N 1))
(QUOTE (NEQ \RS232ORING.READ \RS232ORING.WRITE)))
(T (SUBST N (QUOTE N)
(QUOTE (ILEQ N (IMOD (IDIFFERENCE \RS232ORING.WRITE \RS232ORING.READ)
\RS232RINGBUFFER.SIZE))))))))))
(PUTPROPS ORINGB.FREE DMACRO (NIL
(* Note the equivalence: (IMOD
(IDIFFERENCE Z (IDIFFERENCE HI LO)) Z) =
(IMOD (IDIFFERENCE LO HI) Z))
(IMOD (IDIFFERENCE \RS232ORING.READ \RS232ORING.WRITE)
\RS232RINGBUFFER.SIZE)))
(PUTPROPS LINESTATUSERRORBITS DMACRO ((STATUS)
(LOGAND STATUS \RS232.ERROR.MASK (CONSTANT (LOGOR LBOE RBOE OE PE FE BI)))))
(PUTPROPS LINESTATUSERRORSP MACRO ((STATUS)
(NEQ 0 (LINESTATUSERRORBITS STATUS))))
(PUTPROPS CHECKDATAREADY MACRO ((LineStatusVal . REST)
(AND (BITTEST DR LineStatusVal)
(\RS232.DATAREADY . REST))))
(PUTPROPS RS232PEEKBYTE.BACKUP MACRO (NIL
(PROGN (SERVICEIRING)
(if (IRINGB.ATLEAST 1)
then (\GETBASEBYTE \RS232IRINGBUF \RS232IRING.READ)))))
(PUTPROPS RS232READBYTE.BACKUP MACRO (X
(if X
then (QUOTE IGNOREMACRO)
else (* Take only easy case)
(QUOTE (PROGN (SERVICEIRING)
(if (IRINGB.ATLEAST 1)
then (POPRS232IRING)))))))
)
)
(DEFINEQ
(\RS232.PROCESSINTERRUPT
(LAMBDA (NOERRORFLG) (* JonL "29-JUN-83 06:58")
(* Returns non-NIL iff some error conditions have
occured.)
(PROG ((CNT 0)
(CUMULATIVE.STATUS 0)
ANYERRORS? STATUS RAWINTERRUPTBITS DONEIT? PERIODIC.INTERRUPT?)
A (UNINTERRUPTABLY
(if (SETQ PERIODIC.INTERRUPT? \PERIODIC.INTERRUPT)
then (SETQ \PERIODIC.INTERRUPT))
(if \RS232BACKGROUNDERRORSTATUS
then (SETQ CUMULATIVE.STATUS (LOGOR \RS232BACKGROUNDERRORSTATUS CUMULATIVE.STATUS))
(SETQ \RS232BACKGROUNDERRORSTATUS)
(SETQ ANYERRORS? T))
(SETQ RAWINTERRUPTBITS (if \RS232DLion?
then (PROG ((cw (fetch (DLTTYCSB inControl) of
\DLionTTYPortCSB)))
(DECLARE (LOCALVARS cw))
(RETURN (if (BITTEST cw InControl.errorBits)
then LineStatus
elseif (IGEQ cw InControl.charPresent)
then DataAvailable
else NoInterrupt)))
else (ISTROBE INTERRUPTIDREG)))
(SETQ STATUS (SELECTC (LOADBYTE RAWINTERRUPTBITS 0 BITSPERBYTE)
(DataAvailable (* Note that the DataAvailable interrupt is lower
priority than the LineStatus interrupt.)
(SETQ DONEIT? T)
(\RS232.DATAREADY))
(LineStatus (SETQ DONEIT? T)
(\RS232DECODE.LINESTATUS NIL T))
(NoInterrupt (* FOO!)
(SETQ DONEIT? T)
NIL)
(0 (* Grumble -- this case seems to come up when the
background process sneaks in between the
(RS232INTERRUPT?) test and here in
\RS232.PROCESSINTERRUPT)
(SETQ DONEIT? T)
NIL)
NIL))
(if PERIODIC.INTERRUPT?
then (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?)))
(if (NOT DONEIT?)
then (RESETVAR \PERIODIC.INTERRUPT NIL (PROGN (SETQ \RS232.ERROR RAWINTERRUPTBITS)
(SHOULDNT (QUOTE \RS232.PROCESSINTERRUPT))
)))
(if STATUS
then (SETQ CUMULATIVE.STATUS (LOGOR CUMULATIVE.STATUS STATUS))
(SETQ ANYERRORS? T))
(if (NOT (RS232INTERRUPT?))
then (RETURN (if (NOT ANYERRORS?)
then NIL
elseif NOERRORFLG
then CUMULATIVE.STATUS
else (\RS232DECODE.LINESTATUS CUMULATIVE.STATUS))))
B (if (ILESSP 20 (add CNT 1))
then (SHOULDNT
"Over 20 consecutive interrupts - can't get out of \RS232.PROCESSINTERRUPT")
else (SETQ DONEIT?)
(GO A)))))
(\RS232.DATAREADY
(LAMBDA NIL (* JonL "28-JUN-83 02:11")
(* NOTE WELL! This function must be called
UNINTERRUPTABLY Returns non-NIL iff there is an overflow
of the ring buffer.)
(PROG ((BYTE (LOADBYTE (RS232DATAI)
0 BITSPERBYTE)))
(if RS232XON\XOFF?
then (SELCHARQ BYTE
(↑S (SETQ RS232XOFF? T)
(RETURN))
(↑Q (SETQ RS232XOFF?)
(RETURN))
NIL))
(PUSHRS232IRING BYTE)
(if (EQ \RS232IRING.READ \RS232IRING.WRITE)
then (* If Hi and Low ptrs are EQ after a PUSHRS232IRING then
we have overflowed)
(RINGB.INCREMENT \RS232IRING.WRITE -1)
(RETURN RBOE)))))
(\RS232DECODE.LINESTATUS
(LAMBDA (STATUS NOERRORFLG) (* JonL "29-JUN-83 07:00")
(* Looks for error bits in a LINESTATUSREG reading, running errors or RS232BREAKFN if NOERRORFLG is null.
Returns the most recent reading of the LINESTATUSREG)
(PROG ((CNT 0)
BREAKINSTATUS? PERIODIC.INTERRUPT?)
A (UNINTERRUPTABLY
(if (SETQ PERIODIC.INTERRUPT? \PERIODIC.INTERRUPT)
then (SETQ \PERIODIC.INTERRUPT))
(if (NULL STATUS)
then (SETQ STATUS (RS232STATUSIN))
elseif (NOT (FIXP STATUS))
then (if PERIODIC.INTERRUPT?
then (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?))
(SHOULDNT))
(SETQ BREAKINSTATUS? (if (BITTEST STATUS BI)
then (if (BITTEST STATUS FE)
then (SETQ STATUS (BITCLEAR STATUS BI))
NIL
else (SETQ RS232BREAKSEEN? T))))
(if (BITTEST DR STATUS)
then (SETQ STATUS (LOGOR (BITCLEAR STATUS DR)
(OR (\RS232.DATAREADY)
0))))
(if PERIODIC.INTERRUPT?
then (SETQ \PERIODIC.INTERRUPT PERIODIC.INTERRUPT?)))
(if (OR NOERRORFLG (NOT (LINESTATUSERRORSP STATUS)))
then (* Here's the main return)
(RETURN STATUS))
(if BREAKINSTATUS?
then (if RS232BREAKFN
then (APPLY* RS232BREAKFN))
(SETQ STATUS (BITCLEAR STATUS BI))
(if (NOT (LINESTATUSERRORSP STATUS))
then (GO B)))
(APPLY* (PROG1 RS232LOSTCHARFN (* Comment PPLossage))
(SELECTC (LINESTATUSERRORBITS STATUS)
(OE (QUOTE DroppedCharacter))
(PE (QUOTE ParityError))
(FE (QUOTE FramingError))
(RBOE (QUOTE RingBufferFull))
(LBOE (QUOTE LineBufferFull))
(QUOTE MultipleErrors)))
B (if (IGEQ (add CNT 1)
20)
then (SHOULDNT
"Over 20 consecutive line status errors - can't get out of \RS232DECODE.LINESTATUS"))
(SETQ STATUS)
(GO A))))
(\RS232.OUTPUTBROOM
(LAMBDA NIL (* JonL "20-JUN-83 18:44")
(* Just loop around infinitely, "sweeping" all the data
in the output ring buffer out through the UART)
(do (AWAIT.EVENT \RS232ORINGEVENT)
(bind STATUS while (ORINGB.ATLEAST 1)
do (if (UNINTERRUPTABLY
(if (EQ T (SETQ STATUS (\RS232CHECK.THRE)))
then (RS232DATAO (POPRS232ORING))
NIL
else (FIXP STATUS)))
then (* Note that this call may cause an error)
(\RS232DECODE.LINESTATUS STATUS))
(BLOCK)))))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232IRINGBUF \RS232IRING.WRITE \RS232IRING.READ \RS232ORINGBUF
\RS232ORING.WRITE \RS232ORING.READ \RS232ORINGEVENT)
)
(* Functional interface for what to do if a character is dropped, or a break signal is
received.)
(RPAQ? RS232LOSTCHARFN (QUOTE \RS232DING))
(RPAQ? RS232BREAKFN NIL)
(RPAQ? RS232BREAKSEEN? NIL)
(RPAQ? \RS232.DROPPEDCHARACTER.CODE (CHARCODE #↑G))
(RPAQ? \RS232.ERROR.MASK -1)
(RPAQ? \RS232DING.BOX (SETUPTIMER 0))
(DEFINEQ
(\RS232DING
(LAMBDA NIL (* JonL "12-MAY-83 10:08")
(* This is the default RS232LOSTCHARFN)
(PROG ((FLG T)
(TEMP \RS232IRING.WRITE)
(BELLINTERIM (ITIMES 125 \RCLKMILLISECOND))
STATUS)
(RINGB.INCREMENT TEMP 1)
(if (EQ \RS232IRING.READ TEMP)
then (* FOO! no room left)
(RINGB.INCREMENT \RS232IRING.WRITE -1))
(PUSHRS232IRING \RS232.DROPPEDCHARACTER.CODE) (* Install a "dropped characters" code, and flash at the
user.)
(if (TIMEREXPIRED? \RS232DING.BOX)
then (RESETFORM (VIDEOCOLOR FLG)
(FRPTQ 7 (during BELLINTERIM timerUnits (QUOTE TICKS) usingTimer
\RS232.DING.BOX
do (SETQ STATUS (\RS232DECODE.LINESTATUS STATUS
(QUOTE NOERROR))))
(VIDEOCOLOR (SETQ FLG (NOT FLG)))))
(SETUPTIMER 2000 \RS232DING.BOX))
(until (NOT (LINESTATUSERRORSP (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))))
(* Loop until line "stabilizes")
(if (FIXP STATUS)
then (\RS232DECODE.LINESTATUS (BITCLEAR STATUS OE)))
(* Finally, check to see if there were other errors as
well.)
)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS RS232LOSTCHARFN RS232BREAKFN RS232BREAKSEEN? \RS232NoInterruptFN
\RS232.DROPPEDCHARACTER.CODE)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232.ERROR \RS232.ERROR.MASK \RS232DING.BOX)
)
(* Various parameters installed by RS232INIT)
(RPAQ? \RS232DefaultBaudRate 1200)
(RPAQ? \RS232DefaultBLOCKINTERVAL.ms 250)
(RPAQ? \RS232Divisor NIL)
(RPAQ? \RS232.ByteIntervalCap.ms NIL)
(RPAQ? \RS232.ByteIntervalCap.tics NIL)
(RPAQ? \RS232.Tovh&BIC2.tics NIL)
(RPAQ? \RS232.Tovh&BIC8.tics NIL)
(RPAQ? \RS232.LONGBREAK.tics NIL)
(RPAQ? \RS232.SHORTBREAK.tics NIL)
(RPAQ? \RS232.BLOCKINTERVAL.ms NIL)
(RPAQ? \RS232.BLOCKINTERVAL.tics NIL)
(RPAQ? \RS232.MAX#BYTESPERLOOP NIL)
(* The "Divisor" correlates with the INS8250 crystal to generate the baud rate.
\RS232.ByteIntervalCap.tics is a "cap" , or least upper limit, on the time-span of one
character. \RS232.BLOCKINTERVAL.tics is the typical interval in the "intensive" RS232 routines
during which no BLOCKing will be done (i.e., other processes will be locked out))
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD RS232CHARACTERISTICS (BAUDRATE BITSPERCHAR PARITY STOPBITS MODEMCONTROL))
]
)
(RPAQ? \RS232DLion? NIL)
(DEFINEQ
(RS232INIT
(LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits ModemControl)
(* JonL "29-JUN-83 06:37")
(AND \RS232IRINGBUF (\RS232UNLOCKBUF \RS232IRINGBUF))
(AND \RS232ORINGBUF (\RS232UNLOCKBUF \RS232ORINGBUF))
((LAMBDA (BUFSIZ)
(if (IEQP BUFSIZ BYTESPERPAGE)
then (if (NOT (TYPENAMEP \RS232IRINGBUF (QUOTE VMEMPAGEP)))
then (SETQ \RS232IRINGBUF (NCREATE (QUOTE VMEMPAGEP))))
(if (NOT (TYPENAMEP \RS232ORINGBUF (QUOTE VMEMPAGEP)))
then (SETQ \RS232ORINGBUF (NCREATE (QUOTE VMEMPAGEP))))
else (SETQ \RS232IRINGBUF (\ALLOCBLOCK BUFSIZ NIL CELLSPERPAGE))
(SETQ \RS232ORINGBUF (\ALLOCBLOCK BUFSIZ NIL CELLSPERPAGE)))
(\LOCKPAGES \RS232IRINGBUF (\#PAGES.BASEBYTES \RS232IRINGBUF BUFSIZ))
(\LOCKPAGES \RS232ORINGBUF (\#PAGES.BASEBYTES \RS232ORINGBUF BUFSIZ)))
(CEIL (OR (SMALLP \RS232RINGBUFFER.SIZE)
1)
BYTESPERPAGE))
(SETQ \RS232IRING.READ (SETQ \RS232IRING.WRITE 0))
(SETQ \RS232ORING.READ (SETQ \RS232ORING.WRITE 0))
(if (NULL BaudRate)
then (SETQ BaudRate \RS232DefaultBaudRate)
elseif (EQ BaudRate 110)
then NIL
elseif (NOT (AND (SMALLP BaudRate)
(IGEQ BaudRate 75)
(ILEQ BaudRate 19200)
(ZEROP (IREMAINDER BaudRate 75))
(POWEROFTWOP (IQUOTIENT BaudRate 75))))
then (\ILLEGAL.ARG BaudRate))
(SETQ \RS232Divisor (IQUOTIENT 115200 BaudRate)) (* 115200=1.8432MHz / 16)
(SETQ \RS232.ByteIntervalCap.ms (IQUOTIENT (IPLUS \RS232Divisor 9)
10)) (* Approximately 10 bits worth of time needed to send
one byte, what with 8-bits-per-byte and 1.5 stop bits)
(SETQ \RS232.ByteIntervalCap.tics (ITIMES \RCLKMILLISECOND \RS232.ByteIntervalCap.ms))
((LAMBDA (TimerOverhead.tics) (* Assume that the cost of SETUPTIMER and TIMERXPIRED?
combined, plus a little other setup code, is about 1/2
millisecond.)
(SETQ \RS232.Tovh&BIC2.tics (IPLUS TimerOverhead.tics (ITIMES 2 \RS232.ByteIntervalCap.tics)))
(SETQ \RS232.Tovh&BIC8.tics (IPLUS TimerOverhead.tics (ITIMES 8 \RS232.ByteIntervalCap.tics)))
(SETQ \RS232.LONGBREAK.tics (IPLUS TimerOverhead.tics (TIMES 3.5 \RCLKSECOND)))
(SETQ \RS232.SHORTBREAK.tics (IPLUS TimerOverhead.tics (TIMES .25 \RCLKSECOND))))
(CEIL \RCLKMILLISECOND 2))
(SETQ \RS232.BLOCKINTERVAL.ms \RS232DefaultBLOCKINTERVAL.ms)
(SETQ \RS232.BLOCKINTERVAL.tics (ITIMES \RCLKMILLISECOND \RS232.BLOCKINTERVAL.ms))
(SETQ \RS232.MAX#BYTESPERLOOP (IMAX (SUB1 (FOLDHI (ITIMES (FOLDHI (IMAX 128
\RS232.BLOCKINTERVAL.ms)
8)
(FOLDHI (IMAX 64 BaudRate)
8))
128))
1))
(if (SMALLP BitsPerSerialChar)
then (OR (AND (IGEQ BitsPerSerialChar 5)
(ILEQ BitsPerSerialChar 8))
(\ILLEGAL.ARG BitsPerSerialChar))
else (SETQ BitsPerSerialChar 8))
(OR (FMEMB Parity (QUOTE (NIL EVEN ODD)))
(SETQ Parity (if (NOT (SMALLP Parity))
then NIL
elseif (ODDP Parity)
then (QUOTE ODD)
else (QUOTE EVEN))))
(SETQ NoOfStopBits (if (EQP NoOfStopBits 2)
then 2
else 1))
(SELECTQ (MACHINETYPE)
(DOLPHIN (SETQ \RS232DLion?)
(PROG ((WordLengthSelect (LOADBYTE (IDIFFERENCE BitsPerSerialChar 5)
0 2))
(ParityEnable/Select (SELECTQ Parity
(NIL 0)
(ODD PEN)
(CONSTANT (LOGOR PEN EPS))))
(StopBitsSelect (if (EQP NoOfStopBits 2)
then STB
else 0)))
(SETQ BitsPerSerialChar (IPLUS WordLengthSelect 5))
(PROGN (WRITEPRINTERPORT MASTERRESET)
(WRITEPRINTERPORT NOSTROBE))
(\RS232LINECONTROL DLAB) (* Sets the DLAB (only) in LineControl register.)
(OSTROBE LOWDIVISORREG (LOADBYTE \RS232Divisor 0 8))
(OSTROBE HIDIVISORREG (LOADBYTE \RS232Divisor 8 8))
(\RS232LINECONTROL (LOGOR WordLengthSelect StopBitsSelect
ParityEnable/Select))
(* Notice this will also set the DLAB bit to 0)
(OSTROBE INTERRUPTENABLEREG (CONSTANT (LOGOR ERBFI ELSI)))))
(DANDELION (SETQ \DLErrorBitsConversion (\ALLOCBLOCK (CONSTANT (UNFOLD (EXPT 2 4)
BYTESPERCELL))))
(for I CONV from 0 to (CONSTANT (SUB1 (EXPT 2 4)))
do (SETQ CONV 0)
(for Z in (CONSTANT (for X in (MAPCAR (LIST InControl.breakDetected
InControl.framingError
InControl.parityError
InControl.dataLost)
(QUOTE (LAMBDA (Z)
(LRSH Z 3))))
as Y in (LIST BI FE PE OE)
collect (CONS X Y)))
do (if (BITTEST I (CAR Z))
then (add CONV (CDR Z))))
(\PUTBASEBYTE \DLErrorBitsConversion I CONV))
(SETQ \DLionTTYPortCSB (\ADDBASE (create POINTER
PAGE# ← \VP.IOPAGE)
DLIOP.TTYCSB.OFFSET))
(SETQ \RS232DLion? T)
(if \RS232DLionTTYP
then (DLTTYOUTWAIT)
(replace (DLTTYCSB notifyMask) of \DLionTTYPortCSB with 0)
(replace (InCharStatus charPresent?) of \DLionTTYPortCSB
with NIL) (* Or, charPresent)
(DLTTYPOKE on)
(replace (Parameters onOff) of \DLionTTYPortCSB with 1)
(replace (Parameters baudRate) of \DLionTTYPortCSB
with (if (EQ BaudRate 110)
then 2
elseif (CAR (NTH (QUOTE (15 14 12 10 7 6 5 4 1))
(IDIFFERENCE (INTEGERLENGTH \RS232Divisor)
2)))
else (SHOULDNT "DLion Baud Rate?")))
(replace (Parameters stopBits) of \DLionTTYPortCSB with NoOfStopBits)
(replace (Parameters parity) of \DLionTTYPortCSB with Parity)
(replace (Parameters charLength) of \DLionTTYPortCSB
with (IDIFFERENCE BitsPerSerialChar 5))
(replace (Parameters clearToSend) of \DLionTTYPortCSB with NIL)
(replace (Parameters dataSetReady) of \DLionTTYPortCSB with NIL)
(DLTTYPOKE setAllParameters)
else (DLTTYPOKE off)
(HELP)))
NIL)
(OR (type? FDEV \RS232DEVICE)
(SETQ \RS232DEVICE
(create FDEV
DEVICENAME ←(QUOTE RS232)
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
CLOSEFILE ←(FUNCTION (LAMBDA (STREAM)
(if RS232INIT
then (if (BITTEST (fetch ACCESSBITS of STREAM)
OutputBits)
then (RS232FORCEOUTPUT))
(\RS232EVENTFN (QUOTE BEFOREMAKESYS)))
(SETQ \OPENFILES (DREMOVE \RS232STREAM \OPENFILES))
(SETQ RS232INIT)))
DELETEFILE ←(FUNCTION NILL)
DIRECTORYNAMEP ←(FUNCTION NILL)
EVENTFN ←(FUNCTION \RS232EVENTFN)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
GETFILEINFO ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION NILL)
OPENFILE ←(FUNCTION \ILLEGAL.DEVICEOP)
READPAGES ←(FUNCTION NILL)
REOPENFILE ←(FUNCTION (LAMBDA (NAME ACCESS RECOG OTHERINFO FDEV STREAM)
(if (AND (PROG1 RS232INIT (* Comment PPLossage))
(OR (EQ (MACHINETYPE)
(QUOTE DANDELION))
(PROG ((V (LOGAND (ISTROBE MODEMCONTROLREG)
(CONSTANT (LOGOR OUT1 OUT2))))
VCOMP)
(SETQ VCOMP (LOGXOR V (CONSTANT (LOGOR OUT1 OUT2))))
(* Ascertain whether the INS8250 chip is responding)
(OSTROBE MODEMCONTROLREG VCOMP)
(RETURN (EQ VCOMP (LOADBYTE (ISTROBE MODEMCONTROLREG)
0 8))))))
then STREAM)))
SETFILEINFO ←(FUNCTION NILL)
TRUNCATEFILE ←(FUNCTION NILL)
WRITEPAGES ←(FUNCTION \ILLEGAL.DEVICEOP)
BIN ←(FUNCTION (LAMBDA (STREAM)
(RS232READBYTE T)))
BOUT ←(FUNCTION (LAMBDA (STREAM BYTE)
(RS232WRITEBYTE BYTE)))
PEEKBIN ←(FUNCTION RS232PEEKBYTE)
READP ←(FUNCTION RS232PEEKBYTE)
BACKFILEPTR ←(FUNCTION (LAMBDA (STREAM)
(PROG ((ACCESS (fetch ACCESSBITS of STREAM)))
(if (EQ ACCESS ReadBit)
then (RINGB.INCREMENT \RS232IRING.READ -1)
elseif (BITTEST ACCESS OutputBits)
then (RINGB.INCREMENT \RS232ORING.WRITE -1)
else (SHOULDNT "RS232 stream with bad access bits")))))
SETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
GETFILEPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
GETEOFPTR ←(FUNCTION \ILLEGAL.DEVICEOP)
EOFP ←(FUNCTION NILL)
BLOCKIN ←(FUNCTION \RS232READBASEBYTES)
BLOCKOUT ←(FUNCTION \RS232WRITEBASEBYTES)
RENAMEFILE ←(FUNCTION \ILLEGAL.DEVICEOP))))
(OR (type? STREAM \RS232STREAM)
(SETQ \RS232STREAM (create STREAM
USERCLOSEABLE ← T
USERVISIBLE ← NIL
ACCESSBITS ← BothBits
FULLFILENAME ←(QUOTE {RS232})
DEVICE ← \RS232DEVICE)))
(OR (FMEMB \RS232STREAM \OPENFILES)
(push \OPENFILES \RS232STREAM))
(if ModemControl
then (RS232MODEMCONTROL ModemControl)
(SETQ ModemControl (RS232MODEMCONTROL)))
(SETQ RS232INIT
(create RS232CHARACTERISTICS
BAUDRATE ← BaudRate
BITSPERCHAR ← BitsPerSerialChar
PARITY ← Parity
STOPBITS ← NoOfStopBits
MODEMCONTROL ← ModemControl))
(SETUPTIMER 0 \RS232DING.BOX)
T))
(\RS232UNLOCKBUF
(LAMBDA (BUF) (* JonL "20-JUN-83 15:26")
(if (TYPENAMEP BUF (QUOTE VMEMPAGEP))
then (\UNLOCKPAGES BUF 1)
elseif (type? ARRAYBLOCK BUF)
then (PROG ((ARRAYBASELOC (IDIFFERENCE (LOC BUF)
\ArrayBlockHeaderWords))
PAGEBASELOC #CELLS)
(SETQ PAGEBASELOC (CEIL ARRAYBASELOC WORDSPERPAGE))
(SETQ #CELLS (IDIFFERENCE (fetch (ARRAYBLOCK ARLEN) of ARRAYBASELOC)
(IDIFFERENCE PAGEBASELOC ARRAYBASELOC)))
(\UNLOCKPAGES (VAG PAGEBASELOC)
(FOLDLO #CELLS CELLSPERPAGE)))
else (SHOULDNT "Weird data type for RS232 ring buffer"))))
(RS232BACKGROUND
(LAMBDA (ON?) (* JonL "29-JUN-83 07:01")
(PROG1 (SELECTQ \RS232BACKGROUNDSTATE
(NIL (QUOTE OFF))
(QUOTE ON))
(SELECTQ ON?
(NIL)
(ON (if \PERIODIC.INTERRUPT
then (ERROR "\PERIODIC.INTERRUPT already in use"))
(SETQ \RS232BACKGROUNDERRORSTATUS)
(if (NOT (PROCESSP (FIND.PROCESS (QUOTE \RS232.OUTPUTBROOM))))
then (ADD.PROCESS (QUOTE (\RS232.OUTPUTBROOM))
(QUOTE RESTARTABLE)
T))
(SETQ \RS232BACKGROUNDSTATE T)
(SETQ \PERIODIC.INTERRUPT (FUNCTION \RS232.PERIODIC.FN))
(SETQ \PERIODIC.INTERRUPT.FREQUENCY 1))
(OFF (SETQ \PERIODIC.INTERRUPT)
(DEL.PROCESS (QUOTE \RS232.OUTPUTBROOM))
(SETQ \RS232BACKGROUNDSTATE)
(SETQ \RS232BACKGROUNDERRORSTATUS))
(\ILLEGAL.ARG ON?)))))
(\RS232.PERIODIC.FN
(LAMBDA NIL (* JonL "29-JUN-83 07:00")
(if (RS232INTERRUPT?)
then (SETQ \RS232BACKGROUNDERRORSTATUS (\RS232.PROCESSINTERRUPT (QUOTE NOERROR))))))
(\RS232EVENTFN
(LAMBDA (DEVICE EVENT) (* JonL "29-JUN-83 06:48")
(if RS232INIT
then (SELECTQ EVENT
((BEFORESYSOUT BEFOREMAKESYS)
(replace (RS232CHARACTERISTICS MODEMCONTROL) of RS232INIT
with (RS232MODEMCONTROL NIL))
(if \RS232BACKGROUNDSTATE
then (RS232BACKGROUND (QUOTE OFF))
(SETQ \RS232BACKGROUNDSTATE T))
(if (OR (NOT RS232XON\XOFF?)
(NOT RS232SOFF?))
then (RS232FORCEOUTPUT))
(if \RS232DLion?
then (DLTTYOUTWAIT)
(replace (DLTTYCSB notifyMask) of \DLionTTYPortCSB with 0)
(replace (DLTTYCSB outControl) of \DLionTTYPortCSB with
OutControl.off)))
((NIL AFTERSYSOUT AFTERMAKESYS) (* Re-open the RS232 port)
(APPLY (FUNCTION RS232INIT)
RS232INIT)
(AND \RS232BACKGROUNDSTATE (RS232BACKGROUND (QUOTE ON))))
((AFTERLOGOUT) (* If the RS232 port was open, then peek just to see if
any characters were lost.)
(APPLY (FUNCTION RS232PEEKBYTE)))
NIL))))
)
(DEFINEQ
(RS232MODEMCONTROL
(LAMBDA NARGS (* JonL "20-JUN-83 19:13")
(PROG1 (SELECTC (if \RS232DLion?
then (IPLUS (if (fetch (Parameters dataSetReady) of \DLionTTYPortCSB)
then DTR
else 0)
(if (fetch (Parameters clearToSend) of \DLionTTYPortCSB)
then RTS
else 0))
else (LOADBYTE (ISTROBE MODEMCONTROLREG)
0 8))
(0 NIL)
(DTR (QUOTE (DTR)))
(RTS (QUOTE (RTS)))
((IPLUS DTR RTS)
(QUOTE (DTR RTS)))
(SHOULDNT))
(if (IGEQ NARGS 1)
then (PROG ((BITS (for X in (MKLIST (ARG NARGS 1)) sum (SELECTQ X
(DTR DTR)
(RTS RTS)
(\ILLEGAL.ARG X)))))
(if \RS232DLion?
then (replace (Parameters dataSetReady) of \DLionTTYPortCSB
with (BITTEST BITS DTR))
(replace (Parameters clearToSend) of \DLionTTYPortCSB
with (BITTEST BITS RTS))
(DLTTYPOKE setDSR&CTS)
else (OSTROBE MODEMCONTROLREG BITS)))))))
(RS232MODIFYMODEMCONTROL
(LAMBDA (SIGNALSONLST SIGNALSOFFLST) (* JonL "29-JUN-83 04:08")
(PROG ((INDEX 0))
(for X in (PROG1 (RS232MODEMCONTROL) (* Comment PPLossage)
)
do (SETQ INDEX (LOGOR (SELECTQ X
(DTR DTR)
(RTS RTS)
(\ILLEGAL.ARG X))
INDEX)))
(for X in (MKLIST SIGNALSONLST) do (SETQ INDEX (LOGOR (SELECTQ X
(DTR DTR)
(RTS RTS)
(\ILLEGAL.ARG X))
INDEX)))
(* In effect, this is doing set-union and
set-intersection using only SMALLPs.)
(for X in (MKLIST SIGNALSOFFLST) do (SETQ INDEX (LOGAND (SELECTQ
X
(DTR (CONSTANT (LOGNOT DTR)))
(RTS (CONSTANT (LOGNOT RTS)))
(\ILLEGAL.ARG X))
INDEX)))
(RETURN (RS232MODEMCONTROL (SELECTC INDEX
(0 NIL)
(DTR (QUOTE (DTR)))
(RTS (QUOTE (RTS)))
((LOGOR DTR RTS)
(QUOTE (DTR RTS)))
(SHOULDNT)))))))
(RS232MODEMHANGUP
(LAMBDA NIL (* JonL "29-JUN-83 10:14")
(OR (NULL (RS232MODEMSTATUSP (QUOTE DSR)))
(RESETFORM (RS232MODEMCONTROL NIL)
(* Wag the DTR signal down for at least 3 second -- modem should thus "hang up" on the guy.
The DSR signal should be "up" only when there is someone there.)
(during \RS232.LONGBREAK.tics usingTimer \RS232.TIMEOUT.BOX timerUnits
(QUOTE TICKS)
when (NULL (RS232MODEMSTATUSP (QUOTE DSR))) do (RETURN T))))))
(RS232MODEMSTATUSP
(LAMBDA (SPEC) (* JonL "20-JUN-83 16:41")
(PROG ((MSTAT (if \RS232DLion?
then (* Do the rxRDY and txRDY fields in the DLion correspond
to anything like RI and/or RLSD -- JonL 6/19/83)
(IPLUS (if (fetch (ModemControl requestToSend) of \DLionTTYPortCSB)
then CTS
else 0)
(if (fetch (ModemControl dataTerminalReady) of \DLionTTYPortCSB)
then DSR
else 0))
else (LOADBYTE (ISTROBE MODEMSTATUSREG)
0 8))))
(RETURN (if (NULL SPEC)
then (for B in (CONSTANT (LIST CTS DSR RI RLSD)) as NAME
in (QUOTE (CTS DSR RI RLSD)) join (AND (BITTEST MSTAT B)
(LIST NAME)))
else (\RS232.MSP1 SPEC MSTAT))))))
(\RS232.MSP1
(LAMBDA (SPEC MSTAT) (* JonL " 5-MAY-83 21:37")
(if (LITATOM SPEC)
then (BITTEST MSTAT (SELECTQ SPEC
(CTS CTS)
(DSR DSR)
(RI RI)
(RLSD RLSD)
(\ILLEGAL.ARG SPEC)))
else (SELECTQ (CAR (LISTP SPEC))
(AND (AND (\RS232.MSP1 (CADR SPEC)
MSTAT)
(\RS232.MSP1 (CADDR SPEC)
MSTAT)))
(OR (OR (\RS232.MSP1 (CADR SPEC)
MSTAT)
(\RS232.MSP1 (CADDR SPEC)
MSTAT)))
(NOT (NOT (\RS232.MSP1 (CADR SPEC)
MSTAT)))
(\ILLEGAL.ARG SPEC)))))
(\RS232LINECONTROL
(LAMBDA (VAL MASK) (* JonL "10-MAY-83 17:00")
(PROG ((OLDVAL (if \RS232DLion?
then (HELP)
else (ISTROBE LINECONTROLREG))))
(if MASK
then (SETQ VAL (LOGOR (BITCLEAR OLDVAL MASK)
(LOGAND VAL MASK))))
(if \RS232DLion?
then (HELP)
else (OSTROBE LINECONTROLREG (LOADBYTE VAL 0 8)))
(RETURN OLDVAL))))
)
(* After initialization, RS232INIT holds a list of the actual args used)
(RPAQQ RS232INIT NIL)
(RPAQQ \RS232BACKGROUNDSTATE NIL)
(RPAQQ \RS232BACKGROUNDERRORSTATUS NIL)
(RPAQQ \RS232DEVICE NIL)
(RPAQQ \RS232STREAM NIL)
(RPAQ \RS232.TIMEOUT.BOX (SETUPTIMER 0))
(RPAQ \RS232.DING.BOX (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232DefaultBaudRate \RS232Divisor \RS232.ByteIntervalCap.ms
\RS232.ByteIntervalCap.tics \RS232.Tovh&BIC2.tics \RS232.Tovh&BIC8.tics
\RS232.LONGBREAK.tics \RS232.SHORTBREAK.tics \RS232DefaultBLOCKINTERVAL.ms
\RS232.BLOCKINTERVAL.ms \RS232.BLOCKINTERVAL.tics \RS232.MAX#BYTESPERLOOP RS232INIT
\RS232BACKGROUNDSTATE \RS232BACKGROUNDERRORSTATUS \RS232DEVICE \RS232STREAM
\RS232.TIMEOUT.BOX \RS232.DING.BOX \RS232DLion?)
)
(* DLION RS232 stuff)
(RPAQ? \DLErrorBitsConversion NIL)
(RPAQ? \DLionTTYPortCSB NIL)
(RPAQ? \RS232DLionTTYP T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \DLErrorBitsConversion \DLionTTYPortCSB \RS232DLionTTYP)
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD DLTTYCSB ((outData WORD)
(outControl WORD)
(inData WORD)
(inControl WORD)
(modemControl WORD)
(notifyMask WORD))
(BLOCKRECORD DLTTYCSB ((NIL 2 WORD)
(NIL BYTE)
(inChar BYTE))))
(ACCESSFNS Parameters (ParametersBase (LOCF (fetch (DLTTYCSB outData) of DATUM)))
(BLOCKRECORD ParametersBase ((onOff BITS 4)
(baudRate BITS 4)
(stopBits BITS 2)
(parity BITS 2)
(charLength BITS 2)
(clearToSend FLAG)
(dataSetReady FLAG))))
(ACCESSFNS InCharStatus (InCharStatusBase (LOCF (fetch (DLTTYCSB inControl) of DATUM)))
(BLOCKRECORD InCharStatusBase ((charPresent? FLAG)
(NIL BITS 7)
(success FLAG)
(breakDetected FLAG)
(framingError FLAG)
(dataLost FLAG)
(parityError FLAG)
(NIL BITS 2)
(notReady FLAG))))
(ACCESSFNS ModemControl (ModemControlBase (LOCF (fetch (DLTTYCSB modemControl) of DATUM)))
(BLOCKRECORD ModemControlBase ((NIL BITS 8)
(dataTerminalReady FLAG)
(NIL BITS 4)
(requestToSend FLAG)
(rxRDY FLAG)
(txRDY FLAG))))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS DLTTYOUTBUSY DMACRO (NIL
(IGEQ (fetch (DLTTYCSB outControl) of \DLionTTYPortCSB)
OutControl.putChar)))
(PUTPROPS DLTTYOUTWAIT MACRO (NIL
(until (NOT (DLTTYOUTBUSY)))))
(PUTPROPS DLTTYPOKE MACRO (X
(BQUOTE (PROGN (replace (DLTTYCSB outControl) of \DLionTTYPortCSB
with , (MKATOM (CONCAT "OutControl." (CAR X))))
,
(if (NULL (CDR X))
then (QUOTE (DLTTYOUTWAIT)))))))
)
(DECLARE: EVAL@COMPILE
(RPAQQ DLIOP.TTYCSB.OFFSET 81)
(CONSTANTS (DLIOP.TTYCSB.OFFSET 81))
)
(* Following for bits in outControl word of DLTTYCSB)
(DECLARE: EVAL@COMPILE
(RPAQQ OutControl.putChar 32768)
(RPAQQ OutControl.setAllParameters 48897)
(RPAQQ OutControl.on 32771)
(RPAQQ OutControl.off 32772)
(RPAQQ OutControl.setDSR 33025)
(RPAQQ OutControl.setCTS 33281)
(RPAQQ OutControl.setDSR&CTS 33537)
(CONSTANTS (OutControl.putChar 32768)
(OutControl.setAllParameters 48897)
(OutControl.on 32771)
(OutControl.off 32772)
(OutControl.setDSR 33025)
(OutControl.setCTS 33281)
(OutControl.setDSR&CTS 33537))
)
(* Following for bits in inControl word of DLTTYCSB)
(DECLARE: EVAL@COMPILE
(RPAQQ InControl.InterruptMask 32888)
(RPAQQ InControl.charPresent 32768)
(RPAQQ InControl.errorBits 120)
(RPAQQ InControl.breakDetected 64)
(RPAQQ InControl.framingError 32)
(RPAQQ InControl.dataLost 16)
(RPAQQ InControl.parityError 8)
(CONSTANTS (InControl.InterruptMask 32888)
(InControl.charPresent 32768)
(InControl.errorBits 120)
(InControl.breakDetected 64)
(InControl.framingError 32)
(InControl.dataLost 16)
(InControl.parityError 8))
)
)
(* Basic driver functions)
(DECLARE: EVAL@COMPILE
(PUTPROPS RS232PEEKBYTE MACRO (NIL
(PROGN (* This should be a canonical expansion of
RS232PEEKBYTE.BACKUP)
(if (if \RS232DLion?
then (NEQ 0 (LOGAND 32888 (FFETCHFIELD (QUOTE (NIL 3 (BITS . 15)))
\DLionTTYPortCSB)))
else (IGEQ (READPRINTERPORT)
32768))
then (\RS232.PROCESSINTERRUPT))
(if (NEQ \RS232IRING.READ \RS232IRING.WRITE)
then (\GETBASEBYTE \RS232IRINGBUF \RS232IRING.READ)))))
(PUTPROPS RS232READBYTE MACRO (X
(* This should be a canonical expansion of
RS232READBYTE.BACKUP)
(if X
then (QUOTE IGNOREMACRO)
else (* Take only easy case)
(QUOTE (PROGN (if (if \RS232DLion?
then (NEQ 0 (LOGAND 32888 (FFETCHFIELD (QUOTE (NIL 3 (BITS . 15)))
\DLionTTYPortCSB)))
else (IGEQ (READPRINTERPORT)
32768))
then (\RS232.PROCESSINTERRUPT))
(if (NEQ \RS232IRING.READ \RS232IRING.WRITE)
then (\GETBASEBYTE \RS232IRINGBUF (PROG1 \RS232IRING.READ
(SETQ \RS232IRING.READ
(LOGAND (IPLUS \RS232IRING.READ
1)
511))))))))))
)
(DEFINEQ
(RS232PEEKBYTE
(LAMBDA NIL (* JonL "25-OCT-82 19:17")
(\MACRO.MX (RS232PEEKBYTE))))
(RS232LISTEN
(LAMBDA NIL (* JonL "23-JUN-83 21:06")
(PROG NIL
A (if (RS232INTERRUPT?)
then (* This should be just (SERVICEIRING) but the DLion may
have numerous characters buffered up in the IOP)
(\RS232.PROCESSINTERRUPT)
(SELECTQ (MACHINETYPE)
(DANDELION (GO A))
NIL))
(RETURN (IMOD (IDIFFERENCE \RS232IRING.WRITE \RS232IRING.READ)
\RS232RINGBUFFER.SIZE)))))
(RS232READBYTE
(LAMBDA (WAIT? timerUnits) (* JonL "18-MAY-83 21:07")
(SERVICEIRING)
(if (IRINGB.ATLEAST 1)
then (POPRS232IRING)
elseif (NOT (FIXP WAIT?))
then (AND WAIT? (find BYTE suchthat (SETQ BYTE (RS232READBYTE 10000))))
elseif (EQ (SETQ timerUnits (CANONICAL.TIMERUNITS timerUnits))
(QUOTE TICKS))
then (during WAIT? timerUnits (QUOTE TICKS) usingTimer \RS232.TIMEOUT.BOX find FLG
suchthat (PROG2 (SERVICEIRING)
(SETQ FLG (IRINGB.ATLEAST 1)))
finally (RETURN (if FLG
then (POPRS232IRING))))
else
(* The idea here is that we break up the wait interval into lots of smaller chunks, in the case of large
timerUnits, so that a BLOCK may be run if we have to wait too long.)
(to (IQUOTIENT (SELECTQ timerUnits
(MILLISECONDS WAIT?)
(SECONDS (ITIMES WAIT? 1000))
NIL)
\RS232.BLOCKINTERVAL.ms)
bind BYTE first (SERVICEIRING)
do (* Admit BLOCKing only when timer units specify
milliseconds or seconds.)
(\RS232CHECK.BLOCK)
(find old BYTE suchthat (SETQ BYTE (RS232READBYTE \RS232.BLOCKINTERVAL.tics
(QUOTE TICKS))))
(if BYTE
then (RETURN BYTE))))))
(RS232READWORD
(LAMBDA (WAIT? timerUnits) (* JonL "28-DEC-82 08:24")
(SERVICEIRING)
(PROG (HI LO)
(if (NOT (AND (OR WAIT? (IRINGB.ATLEAST 2))
(SETQ HI (RS232READBYTE WAIT? timerUnits))))
then (* Well, not even first byte is here.)
(RETURN)
elseif (NULL (SETQ LO (RS232READBYTE WAIT? timerUnits)))
then (* FOO! Didn't get both bytes in time, so put first one
back.)
(PUSHRS232IRING HI)
(RETURN))
(RETURN (create WORD
HIBYTE ← HI
LOBYTE ← LO)))))
(RS232WRITEBYTE
(LAMBDA (BYTE FORCEOUT? IGNOREXOFF?) (* JonL "17-JUN-83 19:21")
(SETQ BYTE (LOADBYTE BYTE 0 8))
(PROG ((BUFFERSTARTSEMPTY (NOT (ORINGB.ATLEAST 1)))
BYTEHASBEENPUSHED LineStatusVal)
A (UNINTERRUPTABLY
(SETQ LineStatusVal (\RS232DECODE.LINESTATUS LineStatusVal (QUOTE NOERROR)))
(if (LINESTATUSERRORSP LineStatusVal)
then (* Foo, we just drop thru, and let the loop correct it.)
NIL
elseif (AND BUFFERSTARTSEMPTY (NULL BYTEHASBEENPUSHED)
(OR FORCEOUT? (BITTEST LineStatusVal THRE))
(OR (NOT RS232XON\XOFF?)
(NOT RS232XOFF?)
IGNOREXOFF?))
then (* If ring buffer is empty, and we aren't prohibited by
XOFF, then just output the char.)
(if (OR (BITTEST LineStatusVal THRE)
(EQ T (SETQ LineStatusVal (\RS232CHECK.THRE))))
then (RS232DATAO BYTE)
(SETQ LineStatusVal)
else (SETQ BYTEHASBEENPUSHED (PUSHRS232ORING BYTE))
(SETQ FORCEOUT? T))
else (* Otherwise, pack it into the output ring buffer
(and maybe output 1 character from the buffer.))
(if (NOT BYTEHASBEENPUSHED)
then (SETQ BYTEHASBEENPUSHED (PUSHRS232ORING BYTE)))
(if (OR FORCEOUT? (ILEQ 2 (ORINGB.FREE)))
then (* Ah, no need to force output -- there's at least one
slot left after storing the next BYTE)
(SETQ LineStatusVal)
elseif (AND RS232XON\XOFF? RS232XOFF? (NOT IGNOREXOFF?))
then (* Buffer's nearly full, but we can't send now due to
XOFF)
(SETQ LineStatusVal (QUOTE RS232XOFF?))
elseif (OR (BITTEST LineStatusVal THRE)
(until (SETQ LineStatusVal (\RS232CHECK.THRE))
finally (RETURN (EQ T LineStatusVal))))
then (* Send out 1 character, in order to relieve strain on
output ring buffer.)
(SETQ LineStatusVal)
(RS232DATAO (POPRS232ORING))
elseif (NULL LineStatusVal)
then (* Rare Losing case where we waited for the Transmitter,
but didn't get it. So just let the FORCEOUT? case handle
it.)
(SETQ FORCEOUT? T))))
(if (FIXP LineStatusVal)
then (* Foo, some error trying to get the line status
register; so try it again after cleaning up.)
(AND (LINESTATUSERRORSP LineStatusVal)
(SETQ LineStatusVal (\RS232DECODE.LINESTATUS LineStatusVal)))
(GO A)
elseif (OR (EQ LineStatusVal (QUOTE RS232XOFF?))
(AND FORCEOUT? (ORINGB.ATLEAST 1)))
then (* Block here if we really need to transmit at least one
character, but transmission prohibited by XOFF)
(until (NOT (AND RS232XON\XOFF? RS232XOFF?)) do (\RS232CHECK.BLOCK))
(if (EQ LineStatusVal (QUOTE RS232XOFF?))
then (GO A)
else (RS232FORCEOUTPUT))
else (SERVICEIRING)
(if (AND BUFFERSTARTSEMPTY BYTEPHASBEENPUSHED \RS232BACKGROUNDSTATE)
then (NOTIFY.EVENT \RS232ORINGEVENT)
(SERVICEIRING))))
BYTE))
(RS232SENDBREAK
(LAMBDA (EXTRALONG?) (* JonL "23-JUN-83 21:26")
(SERVICEIRING)
(SELECTQ (MACHINETYPE)
(DANDELION (HELP "MESA 8 can't do RS232 Break signal"))
NIL)
(PROG (STATUS)
(UNINTERRUPTABLY
(\RS232LINECONTROL SBCB SBCB)
(during (if EXTRALONG?
then \RS232.LONGBREAK.tics
else \RS232.SHORTBREAK.tics)
timerUnits (QUOTE TICKS) usingTimer \RS232.THRE.BOX
do (* Just sit around doing nothing, but watching for input
and errors.)
(SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
(if (LINESTATUSERRORSP STATUS)
then (RETURN))
finally (SETQ STATUS))
(\RS232LINECONTROL 0 SBCB))
(if STATUS
then (\RS232DECODE.LINESTATUS STATUS)
else (SERVICEIRING))
(RETURN T))))
(RS232FORCEOUTPUT
(LAMBDA NIL (* JonL "17-JUN-83 19:39")
(* Returns the number of characters found in the buffer,
which are written out "on the lines")
((LAMBDA (#BYTES OFFST)
(if (ILESSP \RS232ORING.READ \RS232ORING.WRITE)
then
(* The hope is that the characters in the ring buffer will be put out on the lines before any other process can
overwrite them by successive calls to RS232WRITEBYTE etc.)
(SETQ OFFST \RS232ORING.READ)
(SETQ #BYTES (IDIFFERENCE \RS232ORING.WRITE OFFST))
(SETQ \RS232ORING.READ \RS232ORING.WRITE)
(\RS232WRITEBASEBYTES NIL \RS232ORINGBUF OFFST #BYTES)
elseif (IGREATERP \RS232ORING.READ \RS232ORING.WRITE)
then (* Buffer has wrapped around, so we have to split up the
write-out into two parts.)
(IPLUS (PROGN (SETQ OFFST \RS232ORING.READ)
(SETQ #BYTES (IDIFFERENCE \RS232RINGBUFFER.SIZE OFFST))
(SETQ \RS232ORING.READ 0)
(\RS232WRITEBASEBYTES NIL \RS232ORINGBUF OFFST #BYTES))
(PROGN (SETQ #BYTES \RS232ORING.WRITE)
(SETQ \RS232ORING.READ \RS232ORING.WRITE)
(if (NEQ 0 #BYTES)
then (\RS232WRITEBASEBYTES NIL \RS232ORINGBUF 0 #BYTES)
else 0)))
else (SERVICEIRING)
0))
0)))
(RS232CLEARBUFFER
(LAMBDA (I/O) (* JonL "23-JUN-83 21:26")
(RS232INITIALIZECHECK)
(PROG (OP STATUS FLUSHANY?)
(until (SETQ OP (SELECTQ I/O
((INPUT)
(QUOTE INPUT))
((OUTPUT)
(QUOTE OUTPUT))
((BOTH I/O)
(QUOTE BOTH))
((IN I IRB IRING IRINGBUF)
(QUOTE INPUT))
((OUT O ORB ORING ORINGBUF)
(QUOTE OUTPUT))
(if (EQ I/O \RS232IRINGBUF)
then (QUOTE INPUT)
elseif (EQ I/O \RS232ORINGBUF)
then (QUOTE OUTPUT))))
do (SETQ I/O (LISPERROR "ILLEGAL ARG" I/O T)))
(if (FMEMB OP (QUOTE (OUTPUT BOTH)))
then (if \RS232DLion?
then (* MESA 8 can't do RS232 Break signal)
else (\RS232LINECONTROL 0 SBCB)) (* Clear the "send BREAK" bit, just in case it had been
set somehow.)
(UNINTERRUPTABLY
(AND (NEQ \RS232ORING.READ \RS232ORING.WRITE)
(SETQ FLUSHANY? T))
(SETQ \RS232ORING.READ (SETQ \RS232ORING.WRITE 0))
(SETQ STATUS (\RS232CHECK.THRE)))
(if (OR (EQ T STATUS)
(AND (FIXP STATUS)
(BITTEST STATUS OE)
(FMEMB OP (QUOTE (INPUT BOTH)))))
then (SETQ FLUSHANY? T)
elseif (NULL STATUS)
then (ERROR "Can't clear RS232 OUTPUT")))
(if (FMEMB OP (QUOTE (INPUT BOTH)))
then (UNINTERRUPTABLY
(SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
(* Flush any possible pending information about input
side errors)
(if (OR (BITTEST STATUS OE)
(NEQ \RS232IRING.READ \RS232IRING.WRITE))
then (SETQ FLUSHANY? T))
(SETQ \RS232IRING.READ (SETQ \RS232IRING.WRITE 0))))
(RETURN FLUSHANY?))))
)
(* Block read and write functions)
(DEFINEQ
(RS232READLINE
(LAMBDA (WAIT? timerUnits OLDSTRBUFFER) (* JonL " 7-MAY-83 21:40")
(\RS232INSURE.LINEBUFFER 256)
((LAMBDA (STR)
(if (AND STR (EQ (NTHCHARCODE STR -1)
(CHARCODE EOL)))
then (* GLC in order to Strip off the EOL)
(GLC STR)
(UNINTERRUPTABLY
(if (EQ (CHARCODE LF)
(during \RS232.Tovh&BIC8.tics timerUnits (QUOTE TICKS) usingTimer
\RS232.READLINE.BOX
find CHAR suchthat (SETQ CHAR (RS232PEEKBYTE))))
then (* Waits about 8 character times, to see if the line
will also have a LF after it.
(If so, it gets flushed.))
(POPRS232IRING)))
STR))
(RS232READSTRING NIL (CHARCODE EOL)
NIL WAIT? timerUnits OLDSTRBUFFER))))
(RS232READSTRING
(LAMBDA (#CHARS.LIMIT? STOPCODE? NOBLOCKSFLG WAIT? timerUnits OLDSTRBUFFER)
(* JonL "23-JUN-83 22:25")
(SERVICEIRING)
(SETQ #CHARS.LIMIT? (SMALLP #CHARS.LIMIT?))
(OR (NULL STOPCODE?)
(CHARCODEP STOPCODE?)
(AND (LITATOM STOPCODE?)
(EQ 1 (NCHARS STOPCODE?))
(SETQ STOPCODE? (CHCON1 STOPCODE?)))
(SETQ STOPCODE?))
(SERVICEIRING)
(if (AND (NULL (FIXP WAIT?))
(NULL #CHARS.LIMIT?)
(NULL STOPCODE?))
then (HELP "No termination criteria?"))
(PROG ((BOFFST 0)
BUFFER BUFFERSIZE #CHARS.READ)
(SERVICEIRING)
(if OLDSTRBUFFER
then (if (NOT (STRINGP OLDSTRBUFFER))
then (\ILLEGAL.ARG OLDSTRBUFFER))
(SETQ BUFFER (ffetch (STRINGP BASE) of OLDSTRBUFFER))
(SETQ BUFFERSIZE (ffetch (STRINGP LENGTH) of OLDSTRBUFFER))
(SETQ BOFFST (ffetch (STRINGP OFFST) of OLDSTRBUFFER))
(AND #CHARS.LIMIT? (SETQ #CHARS.LIMIT? (IMIN #CHARS.LIMIT? BUFFERSIZE)))
(SERVICEIRING)
else (if (OR (NULL \RS232LINEBUFFER.SIZE)
(AND (SMALLP #CHARS.LIMIT?)
(IGEQ #CHARS.LIMIT? \RS232LINEBUFFER.SIZE)))
then (* Time-critical users had better make sure that this
wing isn't taken.)
(\RS232INSURE.LINEBUFFER (ADD1 (OR (SMALLP #CHARS.LIMIT?)
(CONSTANT (IDIFFERENCE BYTESPERPAGE 50)))
))
(SERVICEIRING))
(SETQ BUFFER \RS232LINEBUFFER)
(SETQ BUFFERSIZE \RS232LINEBUFFER.SIZE))
(SETQ #CHARS.READ (\RS232READBASEBYTES NIL BUFFER BOFFST (OR #CHARS.LIMIT? BUFFERSIZE)
(QUOTE \RS232.BLOCKINTERVAL.BOX)
STOPCODE? NOBLOCKSFLG WAIT? timerUnits OLDSTRBUFFER))
(RETURN (if OLDSTRBUFFER
then (replace (STRINGP LENGTH) of OLDSTRBUFFER with #CHARS.READ)
OLDSTRBUFFER
elseif (ZEROP #CHARS.READ)
then NIL
elseif (AND (IGEQ #CHARS.READ BUFFERSIZE)
(NULL #CHARS.LIMIT?))
then (\RS232DECODE.LINESTATUS LBOE)
else (PROG1 (\GETBASESTRING BUFFER 0 #CHARS.READ)
(SERVICEIRING)))))))
(\RS232READBASEBYTES
(LAMBDA (STREAM BASE OFFST NBYTES CALLFROMREADSTRING.PASSWORD STOPCODE? NOBLOCKSFLG WAIT?
timerUnits OLDSTRBUFFER) (* JonL "23-JUN-83 22:34")
(SERVICEIRING)
(PROG ((READSTRINGP (OR (EQ CALLFROMREADSTRING.PASSWORD (QUOTE \RS232.BLOCKINTERVAL.BOX))
(PROGN (SETQ STOPCODE?)
(SETQ NOBLOCKSFLG T)
(SETQ WAIT?)
(SETQ OLDSTRBUFFER)
NIL)))
(#CHARS 0)
(NBASE (\ADDBASE BASE OFFST))
(WAITFORBLOCK.BOX (AND (NOT NOBLOCKSFLG)
(SETUPTIMER \RS232.BLOCKINTERVAL.tics \RS232.BLOCKINTERVAL.BOX
(QUOTE TICKS))))
WAITFORBYTE.BOX CHAR)
(* \RS232.BLOCKINTERVAL.BOX and \RS232.DELAY.BOX are scoped here -- formerly by GLOBALRESOURCE, but the GC
reference counting took too long that way, so we just use local variables instead, counting on the fact that this
isn't a re-entrant function.)
(if (ILEQ NBYTES 0)
then (RETURN 0)
elseif (AND READSTRINGP WAIT?)
then (SETQ timerUnits (CANONICAL.TIMERUNITS timerUnits)))
A (SETQ CHAR (RS232READBYTE))
(if (AND WAIT? (OR CHAR (NULL WAITFORBYTE.BOX)))
then (SETQ WAITFORBYTE.BOX (SETUPTIMER WAIT? WAITFORBYTE.BOX timerUnits)))
(if CHAR
then (SETQ CHAR (LOADBYTE CHAR 0 BITSPERBYTE))
(\PUTBASEBYTE NBASE #CHARS CHAR)
(add #CHARS 1)
(if (OR (IGEQ #CHARS NBYTES)
(AND STOPCODE? (EQ CHAR STOPCODE?)))
then (SERVICEIRING)
(RETURN #CHARS))
elseif (AND WAIT? (PROG1 (TIMEREXPIRED? WAITFORBYTE.BOX timerUnits)
(SERVICEIRING)))
then (RETURN (if OLDSTRBUFFER
then #CHARS
else 0))
elseif (AND WAITFORBLOCK.BOX (TIMEREXPIRED? WAITFORBLOCK.BOX (QUOTE TICKS)))
then (\RS232CHECK.BLOCK)
(SETQ WAITFORBLOCK.BOX (SETUPTIMER \RS232.BLOCKINTERVAL.tics WAITFORBLOCK.BOX
(QUOTE TICKS))))
(GO A))))
(\RS232INSURE.LINEBUFFER
(LAMBDA (N) (* JonL "11-MAY-83 21:43")
(PROG1 (if (OR (NOT (SMALLPOSP \RS232LINEBUFFER.SIZE))
(NOT (type? ARRAYBLOCK \RS232LINEBUFFER))
(NOT (ILEQ N \RS232LINEBUFFER.SIZE)))
then (SETQ N (CEIL (IPLUS N BYTESPERCELL)
BYTESPERPAGE)) (* Add in a little fudge factor and round up to an
integral number of pages, for LOCKPAGES purposes.)
((LAMBDA (BUF)
(SERVICEIRING)
(UNINTERRUPTABLY
(AND (SMALLPOSP \RS232LINEBUFFER.SIZE)
(type? ARRAYBLOCK \RS232LINEBUFFER)
(\UNLOCKPAGES \RS232LINEBUFFER (\#PAGES.BASEBYTES \RS232LINEBUFFER
\RS232LINEBUFFER.SIZE)))
(* Note that this UNLOCK is probably wrong, since the
pages may want to be locked for reasons other than
\RS232LINEBUFFER)
(\LOCKPAGES BUF (\#PAGES.BASEBYTES BUF N))
(SETQ \RS232LINEBUFFER BUF)
(SETQ \RS232LINEBUFFER.SIZE N)))
(\ALLOCBLOCK (FOLDHI N BYTESPERCELL)
NIL CELLSPERPAGE))
T)
(SERVICEIRING)
(\DTEST \RS232STRPTR (QUOTE STRINGP))
(UNINTERRUPTABLY
(freplace (STRINGP BASE) of \RS232STRPTR with \RS232LINEBUFFER)
(freplace (STRINGP OFFST) of \RS232STRPTR with 0)
(freplace (STRINGP LENGTH) of \RS232STRPTR with \RS232LINEBUFFER.SIZE)))))
)
(RPAQQ \RS232LINEBUFFER NIL)
(RPAQQ \RS232LINEBUFFER.SIZE NIL)
(RPAQ \RS232.READLINE.BOX (SETUPTIMER 0))
(RPAQ \RS232.BLOCKINTERVAL.BOX (SETUPTIMER 0))
(RPAQ \RS232.DELAY.BOX (SETUPTIMER 0))
(RPAQ \RS232STRPTR (ALLOCSTRING 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232LINEBUFFER \RS232LINEBUFFER.SIZE \RS232.READLINE.BOX
\RS232.BLOCKINTERVAL.BOX \RS232.DELAY.BOX \RS232STRPTR)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS RS232WRITECHARS MACRO (=
. RS232WRITESTRING))
)
(DEFINEQ
(RS232WRITESTRING
(LAMBDA (STRING.OR.LITATOM FORCEOUTPUT?) (* JonL "17-JUN-83 19:38")
(PROG ((BUFFERSTARTSEMPTY (NOT (ORINGB.ATLEAST 1)))
BASE #CHARS OFFST)
(SERVICEIRING)
(SELECTC (NTYPX STRING.OR.LITATOM)
(\STRINGP (SETQ BASE (fetch (STRINGP BASE) of STRING.OR.LITATOM))
(SETQ #CHARS (fetch (STRINGP LENGTH) of STRING.OR.LITATOM))
(SETQ OFFST (fetch (STRINGP OFFST) of STRING.OR.LITATOM))
T)
(\LITATOM (SETQ BASE (fetch (LITATOM PNAMEBASE) of STRING.OR.LITATOM))
(SETQ #CHARS (\GETBASEBYTE BASE 0))
(SETQ OFFST 1)
T)
(LISPERROR "ILLEGAL ARG" STRING.OR.LITATOM T))
(if (NOT FORCEOUTPUT?)
then (bind (NCHARSLEFT ← #CHARS)
#BYTESMOVING
(MAX#BYTES.TO.MOVE ←(if (ILESSP \RS232Divisor 24)
then 128
elseif (ILESSP \RS232Divisor 48)
then 256
else 512))
while (IGREATERP NCHARSLEFT 0)
do (if (IGEQ NCHARSLEFT (ORINGB.FREE))
then
(* Even though the loser didn't want to forceoutput, we may have to do so in order to make room for the string to
go into the buffer.)
(RS232FORCEOUTPUT))
(SERVICEIRING)
(UNINTERRUPTABLY
(SETQ #BYTESMOVING (IMIN (if (ILEQ \RS232ORING.READ \RS232ORING.WRITE)
then (IDIFFERENCE \RS232RINGBUFFER.SIZE
\RS232ORING.WRITE)
else (IDIFFERENCE \RS232ORING.READ
(ADD1 \RS232ORING.WRITE)))
NCHARSLEFT MAX#BYTES.TO.MOVE))
(* At each step, we move only as many characters as are permitted by the remaining space in the output ring
buffer, and such as can be \MOVEBYTES in a short time)
(\MOVEBYTES BASE OFFST \RS232ORINGBUF \RS232ORING.WRITE #BYTESMOVING)
(RINGB.INCREMENT \RS232ORING.WRITE #BYTESMOVING))
(SERVICEIRING)
(add OFFST #BYTESMOVING)
(add NCHARSLEFT (IMINUS #BYTESMOVING)))
(AND BUFFERSTARTSEMPTY (NOTIFY.EVENT \RS232ORINGEVENT))
else (if (ORINGB.ATLEAST 1)
then (RS232FORCEOUTPUT))
(\RS232WRITEBASEBYTES NIL BASE OFFST #CHARS))
(RETURN #CHARS))))
(RS232WRITECHARS
(LAMBDA (STRING.OR.LITATOM FORCEOUTPUT?) (* JonL "18-MAY-83 20:31")
(RS232WRITESTRING STRING.OR.LITATOM FORCEOUTPUT?)))
(\RS232WRITEBASEBYTES
(LAMBDA (STREAM BASE OFFST #BYTES) (* JonL "17-JUN-83 19:39")
(* Returns the number of bytes which are written out
"on the lines")
(bind STATUS (ITH ← 0) while (ILESSP ITH #BYTES)
do (* You may not believe it, but the
\RS232.MAX#BYTESPERLOOP is set so that interrupts are
locked out for not more than \RS232.BLOCKINTERVAL.ms
milliseconds.)
(UNINTERRUPTABLY
(to \RS232.MAX#BYTESPERLOOP while (AND (ILESSP ITH #BYTES)
(EQ T (SETQ STATUS (\RS232CHECK.THRE)))
(OR (NOT RS232XON\XOFF?)
(NOT RS232XOFF?)))
do (RS232DATAO (\GETBASEBYTE BASE (IPLUS OFFST ITH)))
(add ITH 1)))
(* Since \RS232DECODE.LINESTATUS may generate an error, we can't call it under the UNINTERRUPTABLY -- also, we
come out here if the THR isn't empty after 2 character times, and busy-wait a bit.)
(if (AND (FIXP STATUS)
(LINESTATUSERRORSP STATUS))
then (SETQ STATUS (\RS232DECODE.LINESTATUS STATUS)))
(\RS232CHECK.BLOCK))
(SERVICEIRING)
#BYTES))
(\RS232BOUTSTRING
(LAMBDA (STREAM STRING) (* JonL "22-NOV-82 23:12")
(* Foo, this could be done with a BOUTS, but we have to
intersperse in the calls to SERVICEIRING)
(for I from 1 eachtime (SERVICEIRING) do (BOUT STREAM (OR (NTHCHARCODE STRING I)
(RETURN))))
(SERVICEIRING)))
)
(* Use of XON/XOFF protocols)
(RPAQ? RS232XON\XOFF? NIL)
(RPAQ? RS232XOFF? NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS RS232XON\XOFF? RS232XOFF?)
)
(* Check to see if Transmitter Holding Register is empty.)
(DEFINEQ
(\RS232CHECK.THRE
(LAMBDA NIL (* JonL "20-JUN-83 17:23")
(* Waits for up to 2 character times for the Transmitter Holding Register to become Empty.
If any errors occur, then the status code is returned as an integer; otherwise return T if THR is empty and NIL if
it isn't empty.)
(UNINTERRUPTABLY
(during \RS232.Tovh&BIC2.tics bind ((STATUS ← NIL)) timerUnits (QUOTE TICKS)
usingTimer (PROG1 \RS232.THRE.BOX (* Comment PPLossage))
do (if (AND \RS232DLion? (NOT (DLTTYOUTBUSY))
(NOT (BITTEST (fetch (DLTTYCSB inControl) of \DLionTTYPortCSB)
InControl.errorBits)))
then (RETURN T)
else (SETQ STATUS (\RS232DECODE.LINESTATUS NIL (QUOTE NOERROR)))
(if (LINESTATUSERRORSP STATUS)
then (RETURN STATUS)
elseif (BITTEST THRE STATUS)
then (RETURN T)))))))
)
(RPAQ? \RS232.THRE.BOX (SETUPTIMER 0))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232.THRE.BOX)
)
(* Check to see if BLOCK can be called now)
(DEFINEQ
(\RS232CHECK.BLOCK
(LAMBDA (WAIT?.ms) (* JonL " 3-JAN-83 04:52")
(* Returns non-NIL iff it actually does a BLOCK)
(DECLARE (GLOBALVARS \LastWindowButtons)
(SPECVARS \INTERRUPTABLE))
(PROG1 (if (PROG2 (SERVICEIRING)
(NOT \INTERRUPTABLE)
(SERVICEIRING))
then (* Super-cautious, since the FreeVar lookup of
\INTERRUPTABLE may take a long time)
NIL
elseif (NULL WAIT?.ms)
then (if (OR (OR (KEYDOWNP (QUOTE LEFT))
(KEYDOWNP (QUOTE MIDDLE))
(KEYDOWNP (QUOTE RIGHT)))
(KEYDOWNP (QUOTE BLANK-TOP)))
then (SERVICEIRING) (* Well, one last chance before going into a long
blocked phase!)
(SETQ \LastWindowButtons) (* Darned WINDOW.MOUSE.HANDLER has a wedged idea of when
to run the menu function.)
(BLOCK)
(if \LastWindowButtons
then (* If WINDOW.MOUSE.HANDLER reset this, then it failed to
run DOWINDOWCOM so try once more!)
(SERVICEIRING)
(SETQ \LastWindowButtons)
(BLOCK))
T)
else (during (PROG1 WAIT?.ms (* Comment PPLossage)) resourceName
\RS232.ADMIT.BOX
bind FLG do (AND (\RS232CHECK.BLOCK)
(SETQ FLG T))
finally (RETURN FLG)))
(SERVICEIRING))))
)
(RPAQQ \RS232.ADMIT.BOX NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \RS232.ADMIT.BOX)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(PUTDEF (QUOTE \RS232.ADMIT.BOX)
(QUOTE GLOBALRESOURCES)
(QUOTE (SETUPTIMER 0)))
)
(* Debugging aids)
(DEFINEQ
(RS232DUMPBUFFER
(LAMBDA (I/O.BUF N M) (* JonL " 3-JAN-83 04:19")
(OR (EQ I/O.BUF \RS232IRINGBUF)
(EQ I/O.BUF \RS232ORINGBUF)
(if (FMEMB I/O.BUF (QUOTE (INPUT IN I IRB IRING IRINGBUF NIL)))
then (SETQ I/O.BUF \RS232IRINGBUF)
elseif (FMEMB I/O.BUF (QUOTE (OUTPUT OUT O ORB ORING ORINGBUF)))
then (SETQ I/O.BUF \RS232ORINGBUF)
else (LISPERROR "ILLEGAL ARG" I/O.BUF)))
(RS232INITIALIZECHECK)
(if (AND (NULL N)
(NULL M))
then (if (EQ I/O.BUF \RS232IRINGBUF)
then (SETQ N \RS232IRING.READ)
(SETQ M \RS232IRING.WRITE)
else (SETQ N \RS232ORING.READ)
(SETQ M \RS232ORING.WRITE))
elseif (AND (SMALLP N)
(IGEQ N 0)
(ILESSP N \RS232RINGBUFFER.SIZE)
(NULL M))
then (SETQ M (SUB1 N))
else (ERROR "Bad range indices" (LIST N M)))
(for I from (PROG1 0 (* Comment PPLossage))
bind (STR ←(ALLOCSTRING (IMOD (IDIFFERENCE M N)
\RS232RINGBUFFER.SIZE)
(QUOTE #)))
until (EQ N M)
do (AND (NEQ 0 (\GETBASEBYTE I/O.BUF N))
(RPLCHARCODE STR I (\GETBASEBYTE I/O.BUF N)))
(RINGB.INCREMENT N 1)
finally (RETURN STR))))
(\D0RS232DUMP
(LAMBDA NIL (* JonL " 9-MAY-83 22:01")
(for REGNAME N in (QUOTE (InterruptEnable InterruptID LineControl ModemControl LineStatus
ModemStatus))
as I from 1 do (printout T T REGNAME "Register [" I "]" 28 " = " .I8.-2
(SETQ N (LOADBYTE (ISTROBE I)
0 8))
"B, " .I3.-8 N "Q")
finally (printout T T "ReceiveBufferRegister [0]" 28 " = " .I8.-2 (SETQ N
(LOADBYTE (ISTROBE DATAREG)
0 8))
"B, " .I3.-8 N "Q"))
(RESETFORM (\RS232LINECONTROL DLAB)
(printout T T "DivisorLatchRegister " 28 " = " .I4.10 (DEPOSITBYTE (ISTROBE
LOWDIVISORREG)
8 8 (ISTROBE
HIDIVISORREG))
"D"))
(TERPRI T)))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA RS232MODEMCONTROL)
)
(PUTPROPS RS232 COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (9238 9561 (ORDINALSUFFIXSTRING 9248 . 9559)) (10545 12905 (\#PAGES.BASEBYTES 10555 .
10831) (\FRESHENUPFN 10833 . 11623) (\ONPATHS.CCODE 11625 . 12903)) (22396 28942 (
\RS232.PROCESSINTERRUPT 22406 . 25173) (\RS232.DATAREADY 25175 . 26052) (\RS232DECODE.LINESTATUS 26054
. 28188) (\RS232.OUTPUTBROOM 28190 . 28940)) (29475 30998 (\RS232DING 29485 . 30996)) (32325 44846 (
RS232INIT 32335 . 41870) (\RS232UNLOCKBUF 41872 . 42575) (RS232BACKGROUND 42577 . 43440) (
\RS232.PERIODIC.FN 43442 . 43681) (\RS232EVENTFN 43683 . 44844)) (44847 49795 (RS232MODEMCONTROL 44857
. 46011) (RS232MODIFYMODEMCONTROL 46013 . 47172) (RS232MODEMHANGUP 47174 . 47754) (RS232MODEMSTATUSP
47756 . 48676) (\RS232.MSP1 48678 . 49318) (\RS232LINECONTROL 49320 . 49793)) (55369 66224 (
RS232PEEKBYTE 55379 . 55527) (RS232LISTEN 55529 . 56076) (RS232READBYTE 56078 . 57491) (RS232READWORD
57493 . 58191) (RS232WRITEBYTE 58193 . 61750) (RS232SENDBREAK 61752 . 62724) (RS232FORCEOUTPUT 62726
. 64211) (RS232CLEARBUFFER 64213 . 66222)) (66268 73005 (RS232READLINE 66278 . 67196) (
RS232READSTRING 67198 . 69433) (\RS232READBASEBYTES 69435 . 71459) (\RS232INSURE.LINEBUFFER 71461 .
73003)) (73532 77787 (RS232WRITESTRING 73542 . 75845) (RS232WRITECHARS 75847 . 76019) (
\RS232WRITEBASEBYTES 76021 . 77343) (\RS232BOUTSTRING 77345 . 77785)) (78038 79032 (\RS232CHECK.THRE
78048 . 79030)) (79204 80820 (\RS232CHECK.BLOCK 79214 . 80818)) (81078 83214 (RS232DUMPBUFFER 81088 .
82390) (\D0RS232DUMP 82392 . 83212)))))
STOP