(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 3-Jun-87 10:13:39" {ERIS}<LISPCORE>LIBRARY>DLRS232C.;61 189602
changes to%: (FNS \RS232C.TRACE.PACKET)
previous date%: "29-May-87 16:17:20" {ERIS}<LISPCORE>LIBRARY>DLRS232C.;60)
(* "
Copyright (c) 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT DLRS232CCOMS)
(RPAQQ DLRS232CCOMS
[
(* ;; "Merged DLion & DayBreak RS232 Head. ")
(COMS
(* ;;; "daybreak specific constants/functions RS232 head. ")
(DECLARE%: DONTCOPY DOEVAL@COMPILE (FILES (SOURCE PROP)
DOVERS232C)
(FILES (LOADCOMP)
PROC))
(INITVARS [\DVRS232C.BAUD.RATES '((50 . 5000)
(75 . 3334)
(110 . 2272)
(150 . 1667)
(300 . 833)
(600 . 417)
(1200 . 208)
(1800 . 138)
(2000 . 126)
(2400 . 104)
(3600 . 69)
(4800 . 52)
(7200 . 35)
(9600 . 26)
(19200 . 13]
(* ;;
"removed (19200 . 13) as an option (reinstated as unsupported option JDS 4/7/87 per AR 8375)")
(\DoveRS232C.FCBPointer)
(\DoveRS232C.DCBPointer))
(GLOBALVARS \DVRS232C.BAUD.RATES \DVRS232C.INVERSE.BAUD.RATES \DoveRS232C.FCBPointer
\DoveRS232C.DCBPointer)
(RESOURCES DoveIO.OpieAddressBox)
(FNS \DVRS232C.OUTPUT.INTERRUPT \DVRS232C.INPUT.INTERRUPT \DVRS232C.PARSE.STATUS
\DVRS232C.ISSUE.SHORT.COMMAND \DVRS232C.GATHER.STATUS \DVRS232C.INIT
\DVRS232C.SET.PARAMETERS \DVRS232C.DEQUEUE.IOCB \DVRS232C.ABORT.QUEUE
\DVRS232C.SHUTDOWN \DVRS232C.GET.PARAMETER))
(COMS
(* ;; "mainly DLion specific code here")
(DECLARE%: DONTCOPY
(* ;; "")
(EXPORT (CONSTANTS * DLRS232C.IOP.STATUS.CODES)
(CONSTANTS * DLRS232C.IOP.COMMANDS)
(CONSTANTS (DLRS232C.IOCB.SIZE 10)
(DLRS232C.IOCB.PAGES 1))
(CONSTANTS (\MIN2PAGEBUFLENGTH 232))
(RECORDS DLRS232C.HDW.CONF DLRS232C.IOP.GET.FLAG DLRS232C.IOP.MISC.CMD
DLRS232C.IOP.PUT.FLAG DLRS232C.CSB.PTRS DLRS232C.IOCB
DLRS232C.PARAMETER.CSB DLRS232C.PARAMETER.OUTCOME
DLRS232C.DEVICE.STATUS)))
[INITVARS (\DLRS232C.IOCB.FREELIST)
(\DLRS232C.IOCB.PAGE)
(\DLRS232C.IOCB.ENDPAGE)
(\DLRS232C.ACTIVE.GET)
(\DLRS232C.ACTIVE.PUT)
(\DLRS232C.GET.QUEUE.START)
(\DLRS232C.GET.QUEUE.END)
(\DLRS232C.PUT.QUEUE.START)
(\DLRS232C.PUT.QUEUE.END)
(\DLRS232C.LOCAL.NDB)
(\DLRS232C.IDEAL.INPUT.LENGTH)
(\DLRS232C.DEFAULT.PACKET.LENGTH 578)
(\DLRS232C.MAX.INPUT.LENGTH 10)
(\DLRS232C.RAW.PACKET.QUEUE (NCREATE 'SYSQUEUE))
(\DLRS232C.OUTPUT.LOCK (CREATE.MONITORLOCK "RS232 Output Queue Lock"))
(\DLRS232C.COMMAND.LOCK (CREATE.MONITORLOCK "RS232C Command Lock"))
(\DLRS232C.PARAMETER.CSB)
(\DLRS232C.IOCB.FREELIST.EVENT (CREATE.EVENT "IOCB Freelist non-empty"))
(\DLRS232C.BAUD.RATES '((50 . 0)
(75 . 1)
(110 . 2)
(134.5 . 3)
(150 . 4)
(300 . 5)
(600 . 6)
(1200 . 7)
(2400 . 8)
(3600 . 9)
(4800 . 10)
(7200 . 11)
(9600 . 12)
(19200 . 13)
(28800 . 14)
(38400 . 15)
(48000 . 16)
(56000 . 17)
(57600 . 18]
(VARS \DLRS232C.IOCB.STATUS.CODES)
(GLOBALVARS \DLRS232C.IOCB.FREELIST \DLRS232C.IOCB.PAGE \DLRS232C.IOCB.ENDPAGE
\DLRS232C.ACTIVE.GET \DLRS232C.ACTIVE.PUT \DLRS232C.LOCAL.NDB
\DLRS232C.IDEAL.INPUT.LENGTH \DLRS232C.DEFAULT.PACKET.LENGTH
\DLRS232C.IOCB.TOTAL \DLRS232C.INPUT.IOCB.ALLOC \DLRS232C.INPUT.IOCB.TOTAL
\DLRS232C.OUTPUT.IOCB.ALLOC \DLRS232C.OUTPUT.IOCB.TOTAL
\DLRS232C.MAX.INPUT.LENGTH \DLRS232C.GET.QUEUE.START \DLRS232C.GET.QUEUE.END
\DLRS232C.PUT.QUEUE.START \DLRS232C.PUT.QUEUE.END \DLRS232C.RAW.PACKET.QUEUE
\DLRS232C.OUTPUT.LOCK \DLRS232C.PARAMETER.CSB \DLRS232C.COMMAND.LOCK
\DLRS232C.IOCB.STATUS.CODES \DLRS232C.IOCB.FREELIST.EVENT \DLRS232C.BAUD.RATES
\DLRS232C.INVERSE.BAUD.RATES)
(FNS \DLRS232C.ABORT.OUTPUT \DLRS232C.ALLOCATE.IOCBS \DLRS232C.CREATE.NDB
\DLRS232C.PARSE.STATUS \DLRS232C.GET.PARAMETER \DLRS232C.SET.PARAMETERS
\DLRS232C.SHUTDOWN \DLRS232C.FINISH.GET.AND.PUT \DLRS232C.GET.IOCB \DLRS232C.INIT
\DLRS232C.INPUT.INTERRUPT \DLRS232C.ISSUE.SHORT.COMMAND \DLRS232C.LOADINPUTQ
\DLRS232C.OUTPUT.INTERRUPT \DLRS232C.QUEUE.INPUT.IOCB \DLRS232C.QUEUE.OUTPUT.IOCB
\DLRS232C.RELEASE.IOCB \DLRS232C.START.DRIVER \DLRS232C.STARTUP
\DLRS232C.START.INPUT \DLRS232C.START.OUTPUT))
(COMS
(* ;;; "More or less machine independant functions and structures. ")
(CONSTANTS * \RS232C.DUPLEXITIES)
(CONSTANTS * \RS232C.LINE.TYPES)
(CONSTANTS * \RS232C.CORRESPONDENTS)
(RECORDS RS232C.DEVICEINFO RS232C.STREAM)
(INITVARS (\RS232C.LIGHTNING)
(\RS232C.READY)
(\RS232C.READY.EVENT (CREATE.EVENT "RS232C is running"))
(\RS232C.FDEV)
(\RS232FLG)
(\RS232C.REPORT.STATUS T)
(\RS232C.OUTPUT.PACKET.LENGTH 578)
(\RS232C.MAX.INPUT.BUFFERS 10))
(GLOBALVARS \RS232C.LIGHTNING \RS232C.READY \RS232C.READY.EVENT \RS232C.FDEV \RS232FLG
\RS232C.REPORT.STATUS \RS232C.OUTPUT.PACKET.LENGTH \RS232C.MAX.INPUT.BUFFERS)
(ADDVARS (\SYSTEMCACHEVARS \RS232C.READY))
(DECLARE%: DONTCOPY (EXPORT (RECORDS RS232C.ENCAPSULATION RS232C.STREAM)
(MACROS \DLRS232C.ALLOCATE.PACKET)))
(* ; "Stream interface")
(FNS \RS232C.ISSUE.SHORT.COMMAND \DLRS232C.GET.PACKET \DLRS232C.SEND.PACKET
\RS232C.HANDLE.PACKET \RS232C.PACKET.TIMEOUT \DLRS232C.WATCHER \RS232C.EVENTFN
\RS232C.CREATE.FDEV \RS232C.FORCEOUTPUT \RS232C.GETNEXTBUFFER \RS232C.BACKFILEPTR
\RS232C.GETFILENAME \RS232C.GETFILEINFO \RS232C.SETFILEINFO \RS232C.READP
\RS232C.OPENFILE \RS232C.CLOSEFILE \RS232C.TRACE.PACKET))
(COMS (* ; "User functions")
(RECORDS RS232C.INIT RS232C.XONXOFF)
[INITVARS (RS232C.ERROR.STREAM PROMPTWINDOW)
(RS232C.DEFAULT.INIT.INFO (create RS232C.INIT BaudRate ← 1200 BitsPerSerialChar
← 8 Parity ← 'NONE NoOfStopBits ← 1 FlowControl
← (create RS232C.XONXOFF FLAG ← 1 XON.CHAR ←
(CHARCODE ↑Q)
XOFF.CHAR ← (CHARCODE ↑S]
(GLOBALVARS RS232C.ERROR.STREAM RS232C.DEFAULT.INIT.INFO RS232C.TRACEFLG
RS232C.TRACEFILE)
(FNS RS232C.INIT RS232C.SHUTDOWN RS232C.OTHER.STREAM RS232C.OUTPUTSTREAM
RS232C.OUTPUT.PACKET.LENGTH RS232C.GET.PARAMETERS RS232C.SET.PARAMETERS
RS232C.READP.EVENT RS232C.REPORT.STATUS RS232C.TRACE))
(COMS (* ;
"Modem control functions, compatible with old RS232")
(FNS RS232MODEMCONTROL RS232MODEMSTATUSP \RS232C.MSP1 RS232MODIFYMODEMCONTROL
RS232SENDBREAK RS232MODEMHANGUP))
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\RS232C.CREATE.FDEV RS232C.DEFAULT.INIT.INFO)))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA RS232MODEMCONTROL
RS232C.REPORT.STATUS
RS232C.OUTPUT.PACKET.LENGTH
])
(* ;; "Merged DLion & DayBreak RS232 Head. ")
(* ;;; "daybreak specific constants/functions RS232 head. ")
(DECLARE%: DONTCOPY DOEVAL@COMPILE
(FILESLOAD (SOURCE PROP)
DOVERS232C)
(FILESLOAD (LOADCOMP)
PROC)
)
(RPAQ? \DVRS232C.BAUD.RATES '((50 . 5000)
(75 . 3334)
(110 . 2272)
(150 . 1667)
(300 . 833)
(600 . 417)
(1200 . 208)
(1800 . 138)
(2000 . 126)
(2400 . 104)
(3600 . 69)
(4800 . 52)
(7200 . 35)
(9600 . 26)
(19200 . 13)))
(RPAQ? \DoveRS232C.FCBPointer )
(RPAQ? \DoveRS232C.DCBPointer )
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DVRS232C.BAUD.RATES \DVRS232C.INVERSE.BAUD.RATES \DoveRS232C.FCBPointer
\DoveRS232C.DCBPointer)
)
(DECLARE%: EVAL@COMPILE
[PUTDEF 'DoveIO.OpieAddressBox 'RESOURCES '(NEW (\CREATECELL \FIXP]
)
(DEFINEQ
(\DVRS232C.OUTPUT.INTERRUPT
[LAMBDA (NDB) (* ; "Edited 5-Dec-86 17:11 by lmm")
(* ;;; "Poll the IOP to see if there are any output requests completed")
(DECLARE (GLOBALVARS \DLRS232C.OUTPUT.TIMEOUT))
(LET ((PACKET (fetch SYSQUEUEHEAD of (fetch NDBTQ of NDB)))
ACCEPTSTATUS IOCB EVENT)
(if PACKET
then (SETQ IOCB (fetch EPNETWORK of PACKET))
(if (AND IOCB (NEQ (fetch (Dove.RS232IOCB currentOpStatus) of IOCB)
IOCBpollRxOrTx))
then (\DEQUEUE (fetch NDBTQ of NDB))
(\DVRS232C.DEQUEUE.IOCB IOCB (fetch (Dove.RS232FCB rsQueueTxChA)
of \DoveRS232C.FCBPointer))
(SETQ ACCEPTSTATUS (\DVRS232C.PARSE.STATUS IOCB))
(replace EPNETWORK of PACKET with (replace EPTRANSMITTING of PACKET
with NIL))
(\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\REQUEUE.ETHERPACKET PACKET)
(COND
((type? EVENT (SETQ EVENT (fetch (Dove.RS232IOCB rsLispSynchEvent)
of IOCB)))
(NOTIFY.EVENT EVENT)))
(\DLRS232C.RELEASE.IOCB IOCB 'OUTPUT)
ACCEPTSTATUS])
(\DVRS232C.INPUT.INTERRUPT
[LAMBDA (NDB) (* ejs%: "28-Dec-85 19:52")
(* * Poll the IOP to see if there are any input requests completed)
(LET ((PACKET (fetch SYSQUEUEHEAD of (fetch NDBIQ of NDB)))
IOCB ACCEPTSTATUS)
[if (AND PACKET (SETQ IOCB (fetch EPNETWORK of PACKET))
(NEQ (fetch (Dove.RS232IOCB currentOpStatus) of IOCB)
IOCBpollRxOrTx))
then (\DEQUEUE (fetch NDBIQ of NDB))
(SETQ ACCEPTSTATUS (\DVRS232C.PARSE.STATUS IOCB))
(\DVRS232C.DEQUEUE.IOCB IOCB (fetch (Dove.RS232FCB rsQueueRxChA) of
\DoveRS232C.FCBPointer
))
(PROG [(LENGTH (\DoveIO.ByteSwap (fetch (Dove.RS232IOCB rsTransferCountChA)
of IOCB]
(replace (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET with LENGTH)
(replace EPNETWORK of PACKET with NDB)
(COND
((IGREATERP LENGTH (CONSTANT (UNFOLD \MIN2PAGEBUFLENGTH BYTESPERWORD)))
(* * The DLion ether code doesn't dirty the pages of an etherpacket.
There are hints in the Mesa RS232C face that the IOP doesn't dirty the pages of
an RS232C packet either. Hence, we dirty the second page of the packet if it's
long enough to warrent it)
(\PUTBASE PACKET (SUB1 (ITIMES WORDSPERPAGE 2))
0)))
(COND
(\RS232FLG (\ENQUEUE \DLRS232C.RAW.PACKET.QUEUE PACKET)))
(\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH BYTESPERPAGE
)))
(* * If RS232 is still alive, queue up another packet for the receiver)
(COND
(\RS232FLG (SETQ PACKET (\DLRS232C.ALLOCATE.PACKET))
(\TEMPLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(replace EPNETWORK of PACKET with IOCB)
(\DLRS232C.QUEUE.INPUT.IOCB IOCB (fetch RS232C.PACKET.BASE of PACKET)
\DLRS232C.DEFAULT.PACKET.LENGTH)
(\ENQUEUE (fetch NDBIQ of NDB)
PACKET]
ACCEPTSTATUS])
(\DVRS232C.PARSE.STATUS
[LAMBDA (IOCB) (* ; "Edited 8-Dec-86 16:43 by lmm")
(LET ((rsIOCBType (fetch (Dove.RS232IOCB rsIOCBType) of IOCB)))
(LET [(STATUS (SELECTC (fetch (Dove.RS232IOCB currentOpStatus) of IOCB)
(IOCBpollRxOrTx
'PollRxOrTx)
(IOCBaborted 'Aborted)
(IOCBdisaster 'Disaster)
(IOCBframeTimeout
(COND
((EQ rsIOCBType rsIOCBTypeRx)
T)
(T 'FrameTimeout)))
(IOCBcomplete [COND
((EQ rsIOCBType rsIOCBTypeTx)
T)
(T (LET [(rsIocbSB1Base (LOCF (fetch (Dove.RS232IOCB
rsIocbStatusByte1)
of IOCB]
(COND
((fetch (Dove.RSLatchedStatus dataLost)
of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of \DoveRS232C.DCBPointer)))
'DataLost)
((fetch (Dove.i8274.RR1 rxOverrunError)
of rsIocbSB1Base)
'DataLost)
((fetch (Dove.i8274.RR1 parityError)
of rsIocbSB1Base)
'ParityError)
((fetch (Dove.i8274.RR1 crcFramingError)
of rsIocbSB1Base)
(COND
((EQ (fetch (Dove.RS232DCB rs232Mode)
of \DoveRS232C.DCBPointer)
asynchMode)
'asynchFramingError)
((fetch (Dove.i8274.RR1 endOfFrameSDLCMode
) of rsIocbSB1Base)
'checksumError)
(T T)))
(T T])
'Disaster]
[COND
((AND (NEQ STATUS T)
(NEQ STATUS 'Aborted)
STATUS)
(COND
((OR (EQ \RS232C.REPORT.STATUS T)
(AND (EQ \RS232C.REPORT.STATUS 'OUTPUT)
(EQ rsIOCBType rsIOCBTypeTx))
(AND (EQ \RS232C.REPORT.STATUS 'INPUT)
(EQ rsIOCBType rsIOCBTypeRx)))
(printout RS232C.ERROR.STREAM T "RS232 error: " (SELECTQ STATUS
(Aborted
"Operation aborted")
(Disaster
"Error during transmission, data lost")
(FrameTimeout
"transmission timeout")
(DataLost "data lost")
(ParityError "parity error")
(asynchFramingError
"transmission frame out of sync")
(checksumError
"checksum error")
STATUS)
T]
STATUS])
(\DVRS232C.ISSUE.SHORT.COMMAND
[LAMBDA (COMMAND) (* ; "Edited 20-Jan-87 20:06 by jds")
(* ;;; "Issue a simple command to Opie. Tis a pity issuing such commands isn't as simple as it was on the DLion")
(DECLARE (GLOBALVARS \DLRS232C.COMMAND.LOCK))
(LET (rsCommandWorkListImage rsWorkListImage)
(WITH.MONITOR \DLRS232C.COMMAND.LOCK (while (BITTEST (\DoveIO.ByteSwap (fetch (Dove.RS232DCB
rsCommandWorkList
)
of
\DoveRS232C.DCBPointer
))
rsCommandInProgress) do (BLOCK))
(SETQ rsCommandWorkListImage (\DoveIO.ByteSwap (fetch (Dove.RS232DCB
rsCommandWorkList)
of \DoveRS232C.DCBPointer)))
(SETQ rsWorkListImage (\DoveIO.ByteSwap (fetch (Dove.RS232DCB rsWorkList)
of \DoveRS232C.DCBPointer)))
(SELECTC COMMAND
(ABORT.INPUT (SETQ rsCommandWorkListImage (BITSET rsCommandWorkListImage abortRx)
))
(ABORT.OUTPUT (SETQ rsCommandWorkListImage (BITSET rsCommandWorkListImage abortTx
)))
(BREAK.ON (replace (Dove.i8274.WR5 sendBreak) of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of
\DoveRS232C.DCBPointer
)) with T)
(SETQ rsWorkListImage (BITSET rsWorkListImage (LOGOR rsWorkWR5
workFori8274))))
(BREAK.OFF (replace (Dove.i8274.WR5 sendBreak) of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of
\DoveRS232C.DCBPointer
)) with NIL)
(SETQ rsWorkListImage (BITSET rsWorkListImage (LOGOR rsWorkWR5
workFori8274))))
(GET.STATUS (SETQ rsCommandWorkListImage (BITSET rsCommandWorkListImage
getDeviceStatus)))
(OFF
(* ;; "Turning RS232 off--disable the UART.")
(replace (Dove.i8274.WR3 rxEnable) of (LOCF (fetch (Dove.RS232DCB
rsWR3ofi8274)
of \DoveRS232C.DCBPointer))
with NIL)
(replace (Dove.i8274.WR3 autoEnable) of (LOCF (fetch (Dove.RS232DCB
rsWR3ofi8274)
of \DoveRS232C.DCBPointer))
with NIL)
(replace (Dove.i8274.WR5 txEnable) of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of \DoveRS232C.DCBPointer))
with NIL)
(replace (Dove.i8274.WR1 txIntDMAenable) of (LOCF (fetch (Dove.RS232DCB
rsWR1ofi8274)
of
\DoveRS232C.DCBPointer
)) with NIL)
(replace (Dove.i8274.WR1 extInterruptEnable)
of (LOCF (fetch (Dove.RS232DCB rsWR1ofi8274) of \DoveRS232C.DCBPointer))
with NIL)
(SETQ rsWorkListImage (BITSET rsWorkListImage (LOGOR rsWorkWR1 rsWorkWR3
rsWorkWR5 workFori8274)
))
(replace (Dove.RS232DCB rsClientType) of \DoveRS232C.DCBPointer with
rsNoClient
))
(ON
(* ;; "Turning RS232 on -- enable the UART")
(replace (Dove.i8274.WR3 rxEnable) of (LOCF (fetch (Dove.RS232DCB
rsWR3ofi8274)
of \DoveRS232C.DCBPointer))
with T)
(* ;; "Change of 20-Jan-87, to Match 22-Nov-85 Mesa Head. Removed:")
(* (replace (Dove.i8274.WR3 autoEnable)
of (LOCF (fetch (Dove.RS232DCB
rsWR3ofi8274) of
\DoveRS232C.DCBPointer)) with T))
(replace (Dove.i8274.WR5 txEnable) of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of \DoveRS232C.DCBPointer))
with T)
(replace (Dove.i8274.WR1 txIntDMAenable) of (LOCF (fetch (Dove.RS232DCB
rsWR1ofi8274)
of
\DoveRS232C.DCBPointer
)) with T)
(replace (Dove.i8274.WR1 interruptCondition)
of (LOCF (fetch (Dove.RS232DCB rsWR1ofi8274) of \DoveRS232C.DCBPointer))
with intOnAllRxParityAffectsVector)
(replace (Dove.RS232DCB rsClientType) of \DoveRS232C.DCBPointer with rsNormal
)
(SETQ rsWorkListImage (BITSET rsWorkListImage (LOGOR rsWorkWR1 rsWorkWR3
rsWorkWR5 workFori8274))
))
NIL)
[COND
((BITTEST rsWorkListImage workFori8274)
(replace (Dove.RS232DCB rsWorkList) of \DoveRS232C.DCBPointer with (
\DoveIO.ByteSwap
rsWorkListImage
]
(replace (Dove.RS232DCB rsCommandWorkList) of \DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap (BITSET rsCommandWorkListImage rsCommandInProgress)))
(\DoveIO.NotifyIOP (fetch (Dove.RS232FCB rs232WorkMask) of \DoveRS232C.FCBPointer))
(repeatwhile (BITTEST (\DoveIO.ByteSwap (fetch (Dove.RS232DCB rsCommandWorkList)
of \DoveRS232C.DCBPointer))
rsCommandInProgress) do (BLOCK))
(\DVRS232C.GATHER.STATUS])
(\DVRS232C.GATHER.STATUS
[LAMBDA NIL (* ejs%: "20-Oct-85 18:10")
(* * Return status word in same format as DLion)
(LET* ((RSLatchedStatus (LOCF (fetch (Dove.RS232DCB rsLatchedStatus) of \DoveRS232C.DCBPointer)))
(RR0 (LOCF (fetch (Dove.RS232DCB rsReadRegister0) of \DoveRS232C.DCBPointer)))
(iopInputPort (LOCF (fetch (Dove.RS232DCB rsIOPSystemInputPort) of \DoveRS232C.DCBPointer)
))
(STATUS 0))
[COND
((fetch (Dove.RSLatchedStatus breakDetected) of RSLatchedStatus)
(SETQ STATUS (BITSET STATUS BREAK.DETECTED]
[COND
((fetch (Dove.RSLatchedStatus dataLost) of RSLatchedStatus)
(SETQ STATUS (BITSET STATUS DATA.LOST]
[COND
((fetch (Dove.RSLatchedStatus ringHeard) of RSLatchedStatus)
(SETQ STATUS (BITSET STATUS RING.HEARD]
[COND
((fetch (Dove.i8274.RR0 carrierDetect) of RR0)
(SETQ STATUS (BITSET STATUS CARRIER.DETECT]
[COND
((fetch (Dove.i8274.RR0 cts) of RR0)
(SETQ STATUS (BITSET STATUS CLEAR.TO.SEND]
[COND
((NOT (fetch (Dove.RSIOPSystemInputPort dataSetReady) of iopInputPort))
(SETQ STATUS (BITSET STATUS DATA.SET.READY]
[COND
((NOT (fetch (Dove.RSIOPSystemInputPort ringIndicator) of iopInputPort))
(SETQ STATUS (BITSET STATUS RING.INDICATOR]
STATUS])
(\DVRS232C.INIT
[LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits FlowControl)
(* ; "Edited 22-May-87 15:55 by jds")
(* ;;; "Initialize the IOP")
(SETQ \DoveRS232C.FCBPointer (\DoveIO.GetHandlerIORegionPtr DoveIO.rs232Handler))
[SETQ \DoveRS232C.DCBPointer (\ADDBASE \DoveRS232C.FCBPointer (CONSTANT (MESASIZE Dove.RS232FCB]
(\DVRS232C.SHUTDOWN)
(\DLRS232C.CREATE.NDB)
(* ;; "Changes 20-Jan-87 by JDS:")
(* ;; " FRAME.TIMEOUT from 5 to 32Q, to match Mesa")
(* ;; " DATA.TERMINAL.READY to NIL to match Mesa")
[\DVRS232C.SET.PARAMETERS `((FRAME.TIMEOUT . 5)
(CORRESPONDENT %,@ RS232C.CP.TTYHOST)
(RESET.RING.HEARD . T)
(RESET.BREAK.DETECTED . T)
(RESET.DATA.LOST . T)
(REQUEST.TO.SEND . T)
(DATA.TERMINAL.READY)
(LINE.TYPE %,@ RS232C.LT.ASYNCH)
(NoOfStopBits %,@ NoOfStopBits)
(Parity %,@ Parity)
(BitsPerSerialChar %,@ BitsPerSerialChar)
(BaudRate %,@ BaudRate)
(FlowControl %,@ FlowControl]
(\DVRS232C.ISSUE.SHORT.COMMAND ON)
(SETQ \DLRS232C.OUTPUT.TIMEOUT (\RS232C.PACKET.TIMEOUT BaudRate))
(SETQ \RS232C.READY T)
(SETQ \RS232FLG T])
(\DVRS232C.SET.PARAMETERS
[LAMBDA (PARAMETERLIST) (* ; "Edited 19-Feb-87 22:55 by jds")
(* ;;; "PARAMETERLIST is in association list format. This function sets the parameters of the IOP accordingly")
(COND
(PARAMETERLIST
(bind NOTFOUND (rsWorkListImage ← (\DoveIO.ByteSwap (fetch (Dove.RS232DCB rsWorkList)
of \DoveRS232C.DCBPointer)))
(rsCommandWorkListImage ← (\DoveIO.ByteSwap (fetch (Dove.RS232DCB rsCommandWorkList)
of \DoveRS232C.DCBPointer)))
MAJORFLG COMMANDWORK PROP VAL for PROP.VAL in PARAMETERLIST
do ((SETQ PROP (CAR PROP.VAL))
(SETQ VAL (CDR PROP.VAL))
(SELECTQ PROP
(FRAME.TIMEOUT [COND
((NEQ VAL (\DoveIO.ByteSwap (fetch (Dove.RS232DCB
rsFrameTimeoutValue)
of \DoveRS232C.DCBPointer)))
(replace (Dove.RS232DCB rsFrameTimeoutValue) of
\DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap (FIX (TIMES 10 VAL])
(CORRESPONDENT (replace (Dove.RS232DCB rsTTYHost) of \DoveRS232C.DCBPointer
with (COND
((EQ VAL RS232C.CP.TTYHOST)
\DoveIO.ByteTRUE)
(T \DoveIO.ByteFALSE))))
(SYNCH.CHAR (* ; "Not supported on Dove")
NIL)
((STOP.BITS NoOfStopBits)
(replace (RS232C.INIT NoOfStopBits) of RS232C.DEFAULT.INIT.INFO with VAL)
[COND
([NEQ (fetch (Dove.i8274.WR4 stopBits) of (LOCF (fetch (Dove.RS232DCB
rsWR4ofi8274)
of
\DoveRS232C.DCBPointer
)))
(SELECTC VAL
(1 oneStopBit)
(1.5 oneAndHalfStopBit)
(2 twoStopBits)
(COND
((FEQP VAL 1.5)
oneAndHalfStopBit)
(T (\ILLEGAL.ARG VAL]
(SETQ MAJORFLG T)
(SETQ rsWorkListImage (BITSET rsWorkListImage rsWorkWR4))
(replace (Dove.i8274.WR4 stopBits) of (LOCF (fetch (Dove.RS232DCB
rsWR4ofi8274)
of \DoveRS232C.DCBPointer)
)
with (SELECTC VAL
(1 oneStopBit)
(1.5 oneAndHalfStopBit)
(2 twoStopBits)
(COND
((FEQP VAL 1.5)
oneAndHalfStopBit)
(T (\ILLEGAL.ARG VAL])
((PARITY Parity)
(replace (RS232C.INIT Parity) of RS232C.DEFAULT.INIT.INFO with VAL)
[COND
([NEQ VAL (COND
([NOT (fetch (Dove.i8274.WR4 enableParity)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer]
'NONE)
((EQ (fetch (Dove.i8274.WR4 parityOddOrEven)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer)))
parityOdd)
'ODD)
((EQ (fetch (Dove.i8274.WR4 parityOddOrEven)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer)))
parityEven)
'EVEN]
(SETQ MAJORFLG T)
(SETQ rsWorkListImage (BITSET rsWorkListImage rsWorkWR4))
(COND
((EQ VAL 'NONE)
(replace (Dove.i8274.WR4 enableParity)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274) of
\DoveRS232C.DCBPointer
)) with NIL))
(T (replace (Dove.i8274.WR4 enableParity)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274) of
\DoveRS232C.DCBPointer
)) with T)
(replace (Dove.i8274.WR4 parityOddOrEven)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274) of
\DoveRS232C.DCBPointer
)) with (SELECTQ VAL
(EVEN parityEven)
(ODD parityOdd)
(\ILLEGAL.ARG VAL])
((CHAR.LENGTH BitsPerSerialChar)
(replace (RS232C.INIT BitsPerSerialChar) of RS232C.DEFAULT.INIT.INFO
with VAL)
[COND
([NEQ VAL (fetch (Dove.i8274.WR5 txCharLength)
of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274) of
\DoveRS232C.DCBPointer
]
(SETQ MAJORFLG T)
(SETQ rsWorkListImage (BITSET rsWorkListImage (LOGOR rsWorkWR3 rsWorkWR5)
))
(* ;; "Set the bits in the UART register:")
(* ;; " 8-bit chars 1 1")
(* ;; " 7-bit chars 0 1")
(* ;; " 6-bit chars 1 0")
(* ;; " 5-bit chars 0 0")
(replace (Dove.i8274.WR5 txCharLength) of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of
\DoveRS232C.DCBPointer
))
with (SELECTQ VAL
(8 3)
(7 1)
(6 2)
(5 0)
(\ILLEGAL.ARG VAL)))
(replace (Dove.i8274.WR3 rxCharLength) of (LOCF (fetch (Dove.RS232DCB
rsWR3ofi8274)
of
\DoveRS232C.DCBPointer
))
with (SELECTQ VAL
(8 3)
(7 1)
(6 2)
(5 0)
(\ILLEGAL.ARG VAL])
((LINE.SPEED BaudRate)
[LET [(NV (CDR (SASSOC VAL \DVRS232C.BAUD.RATES]
(COND
(NV (replace (RS232C.INIT BaudRate) of RS232C.DEFAULT.INIT.INFO
with VAL)
(SETQ \DLRS232C.OUTPUT.TIMEOUT (\RS232C.PACKET.TIMEOUT VAL))
(COND
([AND (SETQ VAL NV)
(NEQ VAL (\DoveIO.ByteSwap (fetch (Dove.RS232DCB
rsBaudRateChA)
of \DoveRS232C.DCBPointer]
(SETQ MAJORFLG T)
(SETQ rsWorkListImage (BITSET rsWorkListImage rsNewBaudRate))
(replace (Dove.RS232DCB rsBaudRateChA) of
\DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap VAL])
((FLOW.CONTROL FlowControl)
(SETQ MAJORFLG T)
(replace (RS232C.INIT FlowControl) of RS232C.DEFAULT.INIT.INFO with VAL)
(COND
[[OR (LISTP VAL)
(AND (OR (STRING.EQUAL VAL "xonxoff")
(STRING.EQUAL VAL "xon-xoff")
(STRING.EQUAL VAL "xon/xoff"))
(SETQ VAL (CONSTANT (create RS232C.XONXOFF
FLAG ← 1
XON.CHAR ← (CHARCODE ↑Q)
XOFF.CHAR ← (CHARCODE ↑S]
(replace (Dove.RS232FlowControl type) of (fetch (Dove.RS232DCB
rs232FlowControl)
of \DoveRS232C.DCBPointer)
with (COND
((ZEROP (fetch (RS232C.XONXOFF FLAG) of VAL))
noFlowControl)
(T XOnXOffFlowControl)))
(replace (Dove.RS232FlowControl XOn) of (fetch (Dove.RS232DCB
rs232FlowControl)
of \DoveRS232C.DCBPointer)
with (\DoveIO.ByteSwap (OR (fetch (RS232C.XONXOFF XON.CHAR)
of VAL)
0)))
(replace (Dove.RS232FlowControl XOff) of (fetch (Dove.RS232DCB
rs232FlowControl)
of \DoveRS232C.DCBPointer)
with (\DoveIO.ByteSwap (OR (fetch (RS232C.XONXOFF XOFF.CHAR)
of VAL)
0]
(T (* ; "No flow control.")
(replace (Dove.RS232FlowControl type) of (fetch (Dove.RS232DCB
rs232FlowControl
) of
\DoveRS232C.DCBPointer
) with noFlowControl))))
(LINE.TYPE (LET [(WR1Base (LOCF (fetch (Dove.RS232DCB rsWR1ofi8274) of
\DoveRS232C.DCBPointer
)))
(WR3Base (LOCF (fetch (Dove.RS232DCB rsWR3ofi8274) of
\DoveRS232C.DCBPointer
)))
(WR4Base (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274) of
\DoveRS232C.DCBPointer
)))
(WR5Base (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274) of
\DoveRS232C.DCBPointer
)))
(WR7Base (LOCF (fetch (Dove.RS232DCB rsWR7ofi8274) of
\DoveRS232C.DCBPointer
]
(SELECTC VAL
(RS232C.LT.ASYNCH
(replace (Dove.RS232DCB rs232Mode) of
\DoveRS232C.DCBPointer
with asynchMode)
(replace (Dove.i8274.WR1 extInterruptEnable) of WR3Base
with NIL)
(replace (Dove.i8274.WR3 enterHuntMode) of WR3Base
with NIL)
(replace (Dove.i8274.WR3 rxCRCenable) of WR3Base
with NIL)
(replace (Dove.i8274.WR3 addrSearchMode) of WR3Base
with NIL)
(replace (Dove.i8274.WR4 clockRate) of WR4Base
with x16clk)
(replace (Dove.i8274.WR5 txCRCenable) of WR5Base
with NIL)
(SETQ rsWorkListImage (BITSET rsWorkListImage
(LOGOR rsWorkWR1 rsWorkWR3
rsWorkWR4 rsWorkWR5))
)
(SETQ MAJORFLG T))
(RS232C.LT.BIT.SYNCH
(HELP "Bit synchronous RS232 not implemented yet"))
(ERROR "Illegal line type" VAL))))
(RESET.RING.HEARD
(replace (Dove.RSLatchedStatus ringHeard) of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of
\DoveRS232C.DCBPointer
)) with NIL))
(RESET.BREAK.DETECTED
(replace (Dove.RSLatchedStatus breakDetected)
of (LOCF (fetch (Dove.RS232DCB rsLatchedStatus) of \DoveRS232C.DCBPointer)
) with NIL))
(RESET.DATA.LOST
(replace (Dove.RSLatchedStatus dataLost) of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of
\DoveRS232C.DCBPointer
)) with NIL))
((REQUEST.TO.SEND RTS)
(SETQ COMMANDWORK T)
(SETQ rsWorkListImage (BITSET rsWorkListImage rsWorkWR5))
[COND
((replace (Dove.i8274.WR5 rts) of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274
) of
\DoveRS232C.DCBPointer
)) with VAL)
(SETQ rsCommandWorkListImage (BITSET rsCommandWorkListImage rtsCommand)))
(T (SETQ rsCommandWorkListImage (BITCLEAR rsCommandWorkListImage
rtsCommand])
((DATA.TERMINAL.READY DTR)
(SETQ COMMANDWORK T)
(SETQ rsWorkListImage (BITSET rsWorkListImage rsWorkWR5))
[COND
((replace (Dove.i8274.WR5 dtr) of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274
) of
\DoveRS232C.DCBPointer
)) with VAL)
(SETQ rsCommandWorkListImage (BITSET rsCommandWorkListImage dtrCommand)))
(T (SETQ rsCommandWorkListImage (BITCLEAR rsCommandWorkListImage
dtrCommand])
(ModemControl (for SIGNAL in VAL
do (SELECTQ SIGNAL
(RTS (SETQ COMMANDWORK T)
(SETQ rsWorkListImage (BITSET rsWorkListImage
rsWorkWR5))
[COND
((replace (Dove.i8274.WR5 rts)
of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274)
of \DoveRS232C.DCBPointer))
with VAL)
(SETQ rsCommandWorkListImage (BITSET
rsCommandWorkListImage
rtsCommand)))
(T (SETQ rsCommandWorkListImage (BITCLEAR
rsCommandWorkListImage
rtsCommand])
(DTR (SETQ COMMANDWORK T)
(SETQ rsWorkListImage (BITSET rsWorkListImage
rsWorkWR5))
[COND
((replace (Dove.i8274.WR5 dtr)
of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274)
of \DoveRS232C.DCBPointer))
with VAL)
(SETQ rsCommandWorkListImage (BITSET
rsCommandWorkListImage
dtrCommand)))
(T (SETQ rsCommandWorkListImage (BITCLEAR
rsCommandWorkListImage
dtrCommand])
(SETQ NOTFOUND T))))
(SETQ NOTFOUND T)))
finally (COND
(COMMANDWORK (replace (Dove.RS232DCB rsCommandWorkList) of
\DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap rsCommandWorkListImage))
(SETQ MAJORFLG T)))
(COND
((NOT MAJORFLG)
(RETURN (NOT NOTFOUND)))
(T (SETQ rsWorkListImage (BITSET rsWorkListImage workFori8274))
(replace (Dove.RS232DCB rsWorkList) of \DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap rsWorkListImage))
(\DoveIO.NotifyIOP (fetch (Dove.RS232FCB rs232WorkMask) of
\DoveRS232C.FCBPointer
))
(repeatwhile (BITTEST (\DoveIO.ByteSwap (fetch (Dove.RS232DCB rsWorkList)
of \DoveRS232C.DCBPointer))
workFori8274) do (BLOCK))
(RETURN (NOT NOTFOUND])
(\DVRS232C.DEQUEUE.IOCB
[LAMBDA (IOCB QUEUEBASE) (* ejs%: "17-Oct-85 23:01")
(* * Remove IOCB from the queue at QUEUEBASE)
(COND
((EQ IOCB (fetch (Dove.QueueBlock LispQueueHead) of QUEUEBASE))
(* IOCB is at head of queue)
(\BLT (fetch (Dove.QueueBlock QueueHead) of QUEUEBASE)
(LOCF (fetch (Dove.RS232IOCB rsNextIocbChA) of IOCB))
\#WDS.OpieAddress)
(COND
((EQ IOCB (fetch (Dove.QueueBlock LispQueueTail) of QUEUEBASE))
(\BLT (fetch (Dove.QueueBlock QueueTail) of QUEUEBASE)
(LOCF (fetch (Dove.RS232IOCB rsNextIocbChA) of IOCB))
\#WDS.OpieAddress)))
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB rsNextIocbChA) of IOCB))
NIL))
(T (ERROR "IOCB is not at the head of the queue" IOCB])
(\DVRS232C.ABORT.QUEUE
[LAMBDA (QueueBase) (* ejs%: "29-Dec-85 14:15")
(bind (AbortPtr ← (fetch (Dove.QueueBlock LispQueueHead) of QueueBase)) while AbortPtr
do (replace (Dove.RS232IOCB currentOpStatus) of AbortPtr with IOCBaborted)
(SETQ AbortPtr (\DoveIO.PointerFromOpieAddress (LOCF (fetch (Dove.RS232IOCB rsNextIocbChA)
of AbortPtr])
(\DVRS232C.SHUTDOWN
[LAMBDA NIL (* ejs%: "29-Dec-85 14:16")
(* * Disables RS232C if currently running)
(LET (PACKET)
(COND
(\DLRS232C.LOCAL.NDB (SETQ \RS232C.READY (SETQ \RS232FLG NIL))
(DEL.PROCESS (fetch NDBWATCHER of \DLRS232C.LOCAL.NDB))
(BLOCK)
(\DVRS232C.ABORT.QUEUE (fetch (Dove.RS232FCB rsQueueRxChA) of
\DoveRS232C.FCBPointer
))
(\RS232C.ISSUE.SHORT.COMMAND ABORT.INPUT)
(\DVRS232C.ABORT.QUEUE (fetch (Dove.RS232FCB rsQueueTxChA) of
\DoveRS232C.FCBPointer
))
(\RS232C.ISSUE.SHORT.COMMAND ABORT.OUTPUT)
(\RS232C.ISSUE.SHORT.COMMAND OFF)
(\Dove.ClearQueueBlock (fetch (Dove.RS232FCB rsQueueTxChA) of
\DoveRS232C.FCBPointer
))
(\Dove.ClearQueueBlock (fetch (Dove.RS232FCB rsQueueRxChA) of
\DoveRS232C.FCBPointer
))
(while (SETQ PACKET (\DEQUEUE (fetch NDBIQ of \DLRS232C.LOCAL.NDB)))
do (\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\RELEASE.ETHERPACKET PACKET))
(while (SETQ PACKET (\DEQUEUE (fetch NDBTQ of \DLRS232C.LOCAL.NDB)))
do (\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\RELEASE.ETHERPACKET PACKET])
(\DVRS232C.GET.PARAMETER
[LAMBDA (PROP) (* ; "Edited 22-May-87 15:56 by jds")
(CASE-EQUALP PROP (FRAME.TIMEOUT (QUOTIENT (\DoveIO.ByteSwap (fetch (Dove.RS232DCB
rsFrameTimeoutValue)
of \DoveRS232C.DCBPointer))
10))
((STOP.BITS NoOfStopBits)
(SELECTC (fetch (Dove.i8274.WR4 stopBits) of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer)))
(oneStopBit 1)
(oneAndHalfStopBit
1.5)
(twoStopBits 2)
0))
[(PARITY Parity)
(COND
((fetch (Dove.i8274.WR4 enableParity) of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer)))
(SELECTC (fetch (Dove.i8274.WR4 parityOddOrEven) of (LOCF (fetch (Dove.RS232DCB
rsWR4ofi8274)
of
\DoveRS232C.DCBPointer
)))
(parityEven 'EVEN)
(parityOdd 'ODD)
'UNKNOWN))
(T 'NONE]
((CHAR.LENGTH BitsPerSerialChar)
(IPLUS (fetch (Dove.i8274.WR5 txCharLength) of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274)
of \DoveRS232C.DCBPointer)))
5))
[(LINE.SPEED BaudRate)
(LET [(RATE (\DoveIO.ByteSwap (fetch (Dove.RS232DCB rsBaudRateChA) of
\DoveRS232C.DCBPointer
]
(FOR X IN \DVRS232C.BAUD.RATES WHEN (EQL (CDR X)
RATE) DO (RETURN (CAR X]
[(FLOW.CONTROL FlowControl)
(create RS232C.XONXOFF
FLAG ← (\DoveIO.ByteSwap (fetch (Dove.RS232FlowControl type)
of (fetch (Dove.RS232DCB rs232FlowControl)
of \DoveRS232C.DCBPointer)))
XON.CHAR ← (\DoveIO.ByteSwap (fetch (Dove.RS232FlowControl XOn)
of (fetch (Dove.RS232DCB rs232FlowControl)
of \DoveRS232C.DCBPointer)))
XOFF.CHAR ← (\DoveIO.ByteSwap (fetch (Dove.RS232FlowControl XOff)
of (fetch (Dove.RS232DCB rs232FlowControl)
of \DoveRS232C.DCBPointer]
[(RING.HEARD RESET.RING.HEARD)
(fetch (Dove.RSLatchedStatus ringHeard) of (LOCF (fetch (Dove.RS232DCB rsLatchedStatus)
of \DoveRS232C.DCBPointer]
[(BREAK.DETECTED RESET.BREAK.DETECTED)
(fetch (Dove.RSLatchedStatus breakDetected) of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of \DoveRS232C.DCBPointer]
[(DATA.LOST RESET.DATA.LOST)
(fetch (Dove.RSLatchedStatus dataLost) of (LOCF (fetch (Dove.RS232DCB rsLatchedStatus)
of \DoveRS232C.DCBPointer]
[(REQUEST.TO.SEND RTS)
(fetch (Dove.i8274.WR5 rts) of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274) of
\DoveRS232C.DCBPointer
]
[(DATA.TERMINAL.READY DTR)
(fetch (Dove.i8274.WR5 dtr) of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274) of
\DoveRS232C.DCBPointer
]
((CTS CLEAR.TO.SEND)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
CLEAR.TO.SEND))
((DSR DATA.SET.READY)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
DATA.SET.READY))
((RI RING.INDICATOR)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
RING.INDICATOR))
((RLSD CARRIER.DETECT)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
CARRIER.DETECT])
)
(* ;; "mainly DLion specific code here")
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")
(RPAQQ DLRS232C.IOP.STATUS.CODES ((IOP.DATA.LINE.OCCUPIED 4096)
(PRESENT.NEXT.DIGIT 2048)
(CALL.ORIGINATION.STATUS 1024)
(ABANDON.CALL.AND.RETRY 512)
(POWER.INDICATION 256)
(BREAK.DETECTED 128)
(DATA.LOST 64)
(CLEAR.TO.SEND 32)
(NOT.DEFINED 16)
(CARRIER.DETECT 8)
(RING.HEARD 4)
(DATA.SET.READY 2)
(RING.INDICATOR 1)))
(DECLARE%: EVAL@COMPILE
(RPAQQ IOP.DATA.LINE.OCCUPIED 4096)
(RPAQQ PRESENT.NEXT.DIGIT 2048)
(RPAQQ CALL.ORIGINATION.STATUS 1024)
(RPAQQ ABANDON.CALL.AND.RETRY 512)
(RPAQQ POWER.INDICATION 256)
(RPAQQ BREAK.DETECTED 128)
(RPAQQ DATA.LOST 64)
(RPAQQ CLEAR.TO.SEND 32)
(RPAQQ NOT.DEFINED 16)
(RPAQQ CARRIER.DETECT 8)
(RPAQQ RING.HEARD 4)
(RPAQQ DATA.SET.READY 2)
(RPAQQ RING.INDICATOR 1)
(CONSTANTS (IOP.DATA.LINE.OCCUPIED 4096)
(PRESENT.NEXT.DIGIT 2048)
(CALL.ORIGINATION.STATUS 1024)
(ABANDON.CALL.AND.RETRY 512)
(POWER.INDICATION 256)
(BREAK.DETECTED 128)
(DATA.LOST 64)
(CLEAR.TO.SEND 32)
(NOT.DEFINED 16)
(CARRIER.DETECT 8)
(RING.HEARD 4)
(DATA.SET.READY 2)
(RING.INDICATOR 1))
)
(RPAQQ DLRS232C.IOP.COMMANDS ((ON 0)
(OFF 1)
(BREAK.ON 2)
(BREAK.OFF 3)
(ABORT.INPUT 4)
(ABORT.OUTPUT 5)
(SET.RS366.STATUS 6)
(GET.STATUS 7)
(MAJOR.SET.PARAMETERS 8)
(MINOR.SET.PARAMETERS 14)
(SET.CHANNEL.RESET.FLAG 15)))
(DECLARE%: EVAL@COMPILE
(RPAQQ ON 0)
(RPAQQ OFF 1)
(RPAQQ BREAK.ON 2)
(RPAQQ BREAK.OFF 3)
(RPAQQ ABORT.INPUT 4)
(RPAQQ ABORT.OUTPUT 5)
(RPAQQ SET.RS366.STATUS 6)
(RPAQQ GET.STATUS 7)
(RPAQQ MAJOR.SET.PARAMETERS 8)
(RPAQQ MINOR.SET.PARAMETERS 14)
(RPAQQ SET.CHANNEL.RESET.FLAG 15)
(CONSTANTS (ON 0)
(OFF 1)
(BREAK.ON 2)
(BREAK.OFF 3)
(ABORT.INPUT 4)
(ABORT.OUTPUT 5)
(SET.RS366.STATUS 6)
(GET.STATUS 7)
(MAJOR.SET.PARAMETERS 8)
(MINOR.SET.PARAMETERS 14)
(SET.CHANNEL.RESET.FLAG 15))
)
(DECLARE%: EVAL@COMPILE
(RPAQQ DLRS232C.IOCB.SIZE 10)
(RPAQQ DLRS232C.IOCB.PAGES 1)
(CONSTANTS (DLRS232C.IOCB.SIZE 10)
(DLRS232C.IOCB.PAGES 1))
)
(DECLARE%: EVAL@COMPILE
(RPAQQ \MIN2PAGEBUFLENGTH 232)
(CONSTANTS (\MIN2PAGEBUFLENGTH 232))
)
(DECLARE%: EVAL@COMPILE
(ACCESSFNS DLRS232C.HDW.CONF [(CONFBASE (LOCF (fetch (IOPAGE DLIOPHARDWARECONFIG) of DATUM]
(BLOCKRECORD CONFBASE ((RS232C.ABSENT FLAG)
(NIL BITS 15))))
(ACCESSFNS DLRS232C.IOP.GET.FLAG [(GETBASE (LOCF (fetch (IOPAGE DLRS232CGETFLAG) of DATUM]
(BLOCKRECORD GETBASE ((BUSY FLAG)
(NIL BITS 15))))
(ACCESSFNS DLRS232C.IOP.MISC.CMD [(MISCCMDBASE (LOCF (fetch (IOPAGE DLRS232CMISCCOMMAND) of DATUM]
(BLOCKRECORD MISCCMDBASE ((BUSY FLAG)
(NIL BITS 11)
(COMMAND BITS 4))))
(ACCESSFNS DLRS232C.IOP.PUT.FLAG [(PUTBASE (LOCF (fetch (IOPAGE DLRS232CPUTFLAG) of DATUM]
(BLOCKRECORD PUTBASE ((BUSY FLAG)
(NIL BITS 15))))
(ACCESSFNS DLRS232C.CSB.PTRS [[DLRS232C.PARAMETER.CSB (\VAG2 (fetch (IOPAGE DLRS232CPARAMETERCSBHI.11
) of DATUM)
(fetch (IOPAGE DLRS232CPARAMETERCSBLO.11
) of DATUM))
(PROGN (replace (IOPAGE DLRS232CPARAMETERCSBHI.11) of DATUM
with (\HILOC NEWVALUE))
(replace (IOPAGE DLRS232CPARAMETERCSBLO.11) of DATUM
with (\LOLOC NEWVALUE]
[DLRS232C.PUT.CSB (\VAG2 (fetch (IOPAGE DLRS232CPUTCSBHI) of DATUM)
(fetch (IOPAGE DLRS232CPUTCSBLO) of DATUM))
(PROGN (replace (IOPAGE DLRS232CPUTCSBHI) of DATUM
with (\HILOC NEWVALUE))
(replace (IOPAGE DLRS232CPUTCSBLO) of DATUM
with (\LOLOC NEWVALUE]
(DLRS232C.GET.CSB (\VAG2 (fetch (IOPAGE DLRS232CGETCSBHI) of DATUM)
(fetch (IOPAGE DLRS232CGETCSBLO) of DATUM))
(PROGN (replace (IOPAGE DLRS232CGETCSBHI) of DATUM
with (\HILOC NEWVALUE))
(replace (IOPAGE DLRS232CGETCSBLO) of DATUM
with (\LOLOC NEWVALUE])
(BLOCKRECORD DLRS232C.IOCB ((BLOCK.POINTER.LO WORD)
(BLOCK.POINTER.HI WORD)
(BYTE.COUNT WORD)
(RETURNED.BYTE.COUNT WORD)
(TRANSFER.STATUS WORD)
(NIL WORD)
(COMPLETED FLAG)
(PUT FLAG)
(NIL BITS 6)
(SYNCH.EVENT POINTER)
(NEXT POINTER))
(BLOCKRECORD DLRS232C.IOCB ((NIL 4 WORD)
(SUCCESS FLAG)
(NIL BITS 6)
(DATA.LOST FLAG)
(DEVICE.ERROR FLAG)
(FRAME.TIMEOUT FLAG)
(CHECKSUM.ERROR FLAG)
(PARITY.ERROR FLAG)
(ASYNCH.FRAME.ERROR FLAG)
(INVALID.CHARACTER FLAG)
(ABORTED FLAG)
(DISASTER FLAG)))
[ACCESSFNS ((BLOCK.POINTER (\VAG2 (fetch BLOCK.POINTER.HI of DATUM)
(fetch BLOCK.POINTER.LO of DATUM))
(PROGN (replace BLOCK.POINTER.LO of DATUM
with (\LOLOC NEWVALUE))
(replace BLOCK.POINTER.HI of DATUM
with (\HILOC NEWVALUE])
(BLOCKRECORD DLRS232C.PARAMETER.CSB ((FRAME.TIMEOUT WORD)
(CORRESPONDENT BYTE)
(SYNCH.CHAR BYTE)
(RESET.RING.HEARD FLAG)
(RESET.BREAK.DETECTED FLAG)
(RESET.DATA.LOST FLAG)
(REQUEST.TO.SEND FLAG)
(DATA.TERMINAL.READY FLAG)
(STOP.BITS BITS 1)
(LINE.TYPE BITS 2)
(PARITY BITS 3)
(CHAR.LENGTH BITS 2)
(SYNCH.COUNT BITS 3)
(NIL BITS 3)
(LINE.SPEED BITS 5)
(NIL BYTE)
(INTERRUPT.MASK WORD)
(FLOWCONTROL 3 WORD))
(BLOCKRECORD DLRS232C.PARAMETER.CSB ((NIL 5 WORD)
(FLOWCONTROL.ON WORD)
(FLOWCONTROL.XON.CHAR WORD)
(FLOWCONTROL.XOFF.CHAR
WORD))))
(ACCESSFNS DLRS232C.PARAMETER.OUTCOME [(OUTCOMEBASE (LOCF (fetch (IOPAGE DLRS232CPARAMETEROUTCOME)
of DATUM]
(BLOCKRECORD OUTCOMEBASE ((SUCCESS FLAG)
(NIL BITS 14)
(UNIMPLEMENTED FLAG))))
(ACCESSFNS DLRS232C.DEVICE.STATUS [(STATBASE (LOCF (fetch (IOPAGE DLRS232CDEVICESTATUS) of DATUM]
(BLOCKRECORD STATBASE ((STATUS WORD)))
(BLOCKRECORD STATBASE ((NIL BITS 3)
(DATA.LINE.OCCUPIED FLAG)
(PRESENT.NEXT.DIGIT FLAG)
(CALL.ORIGINATION.STATUS FLAG)
(ABANDON.CALL.AND.RETRY FLAG)
(POWER.INDICATION FLAG)
(BREAK.DETECTED FLAG)
(DATA.LOST FLAG)
(CLEAR.TO.SEND FLAG)
(NIL BITS 1)
(CARRIER.DETECT FLAG)
(RING.HEARD FLAG)
(DATA.SET.READY FLAG)
(RING.INDICATOR FLAG))))
)
(* "END EXPORTED DEFINITIONS")
)
(RPAQ? \DLRS232C.IOCB.FREELIST )
(RPAQ? \DLRS232C.IOCB.PAGE )
(RPAQ? \DLRS232C.IOCB.ENDPAGE )
(RPAQ? \DLRS232C.ACTIVE.GET )
(RPAQ? \DLRS232C.ACTIVE.PUT )
(RPAQ? \DLRS232C.GET.QUEUE.START )
(RPAQ? \DLRS232C.GET.QUEUE.END )
(RPAQ? \DLRS232C.PUT.QUEUE.START )
(RPAQ? \DLRS232C.PUT.QUEUE.END )
(RPAQ? \DLRS232C.LOCAL.NDB )
(RPAQ? \DLRS232C.IDEAL.INPUT.LENGTH )
(RPAQ? \DLRS232C.DEFAULT.PACKET.LENGTH 578)
(RPAQ? \DLRS232C.MAX.INPUT.LENGTH 10)
(RPAQ? \DLRS232C.RAW.PACKET.QUEUE (NCREATE 'SYSQUEUE))
(RPAQ? \DLRS232C.OUTPUT.LOCK (CREATE.MONITORLOCK "RS232 Output Queue Lock"))
(RPAQ? \DLRS232C.COMMAND.LOCK (CREATE.MONITORLOCK "RS232C Command Lock"))
(RPAQ? \DLRS232C.PARAMETER.CSB )
(RPAQ? \DLRS232C.IOCB.FREELIST.EVENT (CREATE.EVENT "IOCB Freelist non-empty"))
(RPAQ? \DLRS232C.BAUD.RATES '((50 . 0)
(75 . 1)
(110 . 2)
(134.5 . 3)
(150 . 4)
(300 . 5)
(600 . 6)
(1200 . 7)
(2400 . 8)
(3600 . 9)
(4800 . 10)
(7200 . 11)
(9600 . 12)
(19200 . 13)
(28800 . 14)
(38400 . 15)
(48000 . 16)
(56000 . 17)
(57600 . 18)))
(RPAQQ \DLRS232C.IOCB.STATUS.CODES ((1 . "disaster ")
(2 . "I/O Aborted ")
(4 . "invalid character ")
(8 . "asynchrononous framing error ")
(16 . "parity error ")
(32 . "checksum error ")
(64 . "frame timeout ")
(128 . "device error ")
(256 . "data lost ")))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \DLRS232C.IOCB.FREELIST \DLRS232C.IOCB.PAGE \DLRS232C.IOCB.ENDPAGE \DLRS232C.ACTIVE.GET
\DLRS232C.ACTIVE.PUT \DLRS232C.LOCAL.NDB \DLRS232C.IDEAL.INPUT.LENGTH
\DLRS232C.DEFAULT.PACKET.LENGTH \DLRS232C.IOCB.TOTAL \DLRS232C.INPUT.IOCB.ALLOC
\DLRS232C.INPUT.IOCB.TOTAL \DLRS232C.OUTPUT.IOCB.ALLOC \DLRS232C.OUTPUT.IOCB.TOTAL
\DLRS232C.MAX.INPUT.LENGTH \DLRS232C.GET.QUEUE.START \DLRS232C.GET.QUEUE.END
\DLRS232C.PUT.QUEUE.START \DLRS232C.PUT.QUEUE.END \DLRS232C.RAW.PACKET.QUEUE
\DLRS232C.OUTPUT.LOCK \DLRS232C.PARAMETER.CSB \DLRS232C.COMMAND.LOCK
\DLRS232C.IOCB.STATUS.CODES \DLRS232C.IOCB.FREELIST.EVENT \DLRS232C.BAUD.RATES
\DLRS232C.INVERSE.BAUD.RATES)
)
(DEFINEQ
(\DLRS232C.ABORT.OUTPUT
[LAMBDA NIL (* ejs%: "24-Dec-85 16:29")
(LET ((IOCB \DLRS232C.ACTIVE.PUT)
(NDBTQ (fetch NDBTQ of \DLRS232C.LOCAL.NDB))
PACKET)
(SETQ \DLRS232C.ACTIVE.PUT NIL)
(while (SETQ PACKET (\DEQUEUE NDBTQ)) do (COND
((fetch EPNETWORK of PACKET)
(\DLRS232C.RELEASE.IOCB (fetch EPNETWORK
of PACKET)
'OUTPUT)
(replace EPNETWORK of PACKET with NIL)))
(\TEMPUNLOCKPAGES PACKET (FOLDHI
\DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERWORD))
(\RELEASE.ETHERPACKET PACKET))
(SETQ \DLRS232C.PUT.QUEUE.END (SETQ \DLRS232C.PUT.QUEUE.START NIL))
(\RS232C.ISSUE.SHORT.COMMAND ABORT.OUTPUT])
(\DLRS232C.ALLOCATE.IOCBS
[LAMBDA NIL (* ejs%: "28-Dec-85 20:55")
(* * If the RS232C IOCB page is not allocated, allocate and lock it in memory.
Divide the page into as many IOCB's as will fit, and link them into a freelist)
(* * Initialize the IOCB page if necessary.
If we have to allocate we lock it in memory;
otherwise, we assume it's already locked in memory)
(LET [(IOCB.SIZE (SELECTC \MACHINETYPE
(\DANDELION DLRS232C.IOCB.SIZE)
(\DAYBREAK DVRS232C.IOCB.SIZE)
(\NOMACHINETYPE]
[COND
((NOT \DLRS232C.IOCB.PAGE)
(SETQ \DLRS232C.IOCB.PAGE (\DONEWEPHEMERALPAGE (\ADDBASE \IOPAGE (CONSTANT (IMINUS
WORDSPERPAGE
)))
T))
(SETQ \DLRS232C.IOCB.ENDPAGE (\ADDBASE \DLRS232C.IOCB.PAGE (ITIMES (SUB1
DLRS232C.IOCB.PAGES
)
WORDSPERPAGE]
(* * Divide the page up into a freelist of IOCB's)
(\CLEARWORDS \DLRS232C.IOCB.PAGE (UNFOLD DLRS232C.IOCB.PAGES WORDSPERPAGE))
(SETQ \DLRS232C.IOCB.TOTAL (QUOTIENT WORDSPERPAGE IOCB.SIZE))
(SETQ \DLRS232C.IOCB.FREELIST \DLRS232C.IOCB.PAGE)
(bind (IOCB ← \DLRS232C.IOCB.PAGE) to (SUB1 \DLRS232C.IOCB.TOTAL)
do (replace (DLRS232C.IOCB NEXT) of IOCB with (SETQ IOCB (\ADDBASE IOCB IOCB.SIZE)))
finally (replace (DLRS232C.IOCB NEXT) of IOCB with NIL))
(SETQ \DLRS232C.IDEAL.INPUT.LENGTH (IMIN \DLRS232C.MAX.INPUT.LENGTH (FOLDLO
\DLRS232C.IOCB.TOTAL
2)))
[SETQ \DLRS232C.INPUT.IOCB.ALLOC (SETQ \DLRS232C.INPUT.IOCB.TOTAL
(SETQ \DLRS232C.OUTPUT.IOCB.ALLOC
(SETQ \DLRS232C.OUTPUT.IOCB.TOTAL (IQUOTIENT (ITIMES
\DLRS232C.IOCB.TOTAL
2)
3]
\DLRS232C.IOCB.TOTAL])
(\DLRS232C.CREATE.NDB
[LAMBDA NIL (* ejs%: "19-Jun-85 17:31")
(* * DLRS232C face entry for driver initialization.
Note that the driver resembles closely the 10MB Ethernet driver.
This will hopefully simplify our lives when we try to support Clusternet
communications)
(SETQ \DLRS232C.LOCAL.NDB (\DLRS232C.START.DRIVER (create NDB
NDBTRANSMITTER ← (FUNCTION
\DLRS232C.SEND.PACKET)
NDBENCAPSULATOR ← (FUNCTION NILL)
NDBBROADCASTP ← (FUNCTION NILL)
NDBETHERFLUSHER ← (FUNCTION
\DLRS232C.SHUTDOWN)
NDBCANHEARSELF ← NIL])
(\DLRS232C.PARSE.STATUS
[LAMBDA (STATUS DIRECTION) (* ejs%: "11-Aug-85 03:08")
(DECLARE (GLOBALVARS RS232C.ERROR.STREAM \DLRS232C.IOCB.STATUS.CODES))
(LET ((IOPSTATUS (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)))
[COND
[(NUMBERP STATUS)
(COND
((NEQ STATUS 0)
(printout RS232C.ERROR.STREAM T "RS232 Error(s) on " (SELECTQ DIRECTION
(IN "input: ")
(OUT "output: ")
"???: "))
(for ERROR in \DLRS232C.IOCB.STATUS.CODES when (BITTEST STATUS (CAR ERROR))
do (printout RS232C.ERROR.STREAM (CDR ERROR]
(T (printout RS232C.ERROR.STREAM T "Unknown RS232 error on " (SELECTQ DIRECTION
(IN "input")
(OUT "output")
"???"]
(\DLRS232C.SET.PARAMETERS (APPEND [COND
((BITTEST IOPSTATUS DATA.LOST)
'((RESET.DATA.LOST . T]
(COND
((BITTEST IOPSTATUS BREAK.DETECTED)
'((RESET.BREAK.DETECTED . T])
(\DLRS232C.GET.PARAMETER
[LAMBDA (PROP) (* ; "Edited 22-Dec-86 12:03 by lmm")
(LET [(CSB (LOCF (fetch DLRS232CPARAMETERCSBLO.11 of \IOPAGE]
(CASE-EQUALP PROP (FRAME.TIMEOUT (fetch (DLRS232C.PARAMETER.CSB FRAME.TIMEOUT) of CSB))
(CORRESPONDENT (fetch (DLRS232C.PARAMETER.CSB CORRESPONDENT) of CSB))
(SYNCH.CHAR (fetch (DLRS232C.PARAMETER.CSB SYNCH.CHAR) of CSB))
((STOP.BITS NoOfStopBits)
(ADD1 (fetch (DLRS232C.PARAMETER.CSB STOP.BITS) of CSB)))
((PARITY Parity)
(SELECTC (fetch (DLRS232C.PARAMETER.CSB PARITY) of CSB)
(0 'NONE)
(1 'ODD)
(2 'EVEN)
'UNKNOWN))
((CHAR.LENGTH BitsPerSerialChar)
(IPLUS (fetch (DLRS232C.PARAMETER.CSB CHAR.LENGTH) of CSB)
5))
(SYNCH.COUNT (fetch (DLRS232C.PARAMETER.CSB SYNCH.COUNT) of CSB))
[(LINE.SPEED BaudRate)
(LET ((RATE (fetch (DLRS232C.PARAMETER.CSB LINE.SPEED) of CSB)))
(for X in \DLRS232C.BAUD.RATES when (EQL (CDR X)
RATE) do (RETURN (CAR X]
((FLOW.CONTROL FlowControl)
(create RS232C.XONXOFF
FLAG ← (fetch (DLRS232C.PARAMETER.CSB FLOWCONTROL.ON) of CSB)
XON.CHAR ← (fetch (DLRS232C.PARAMETER.CSB FLOWCONTROL.XON.CHAR) of CSB)
XOFF.CHAR ← (fetch (DLRS232C.PARAMETER.CSB FLOWCONTROL.XOFF.CHAR)
of CSB)))
(RESET.RING.HEARD (fetch (DLRS232C.PARAMETER.CSB RESET.RING.HEARD) of CSB))
(RESET.BREAK.DETECTED (fetch (DLRS232C.PARAMETER.CSB RESET.BREAK.DETECTED)
of CSB))
(RESET.DATA.LOST (fetch (DLRS232C.PARAMETER.CSB RESET.DATA.LOST) of CSB))
((REQUEST.TO.SEND RTS)
(fetch (DLRS232C.PARAMETER.CSB REQUEST.TO.SEND) of CSB))
((DATA.TERMINAL.READY DTR)
(fetch (DLRS232C.PARAMETER.CSB DATA.TERMINAL.READY) of CSB))
((CTS CLEAR.TO.SEND)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
CLEAR.TO.SEND))
((DSR DATA.SET.READY)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
DATA.SET.READY))
((RI RING.INDICATOR)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
RING.INDICATOR))
((RLSD CARRIER.DETECT)
(BITTEST (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)
CARRIER.DETECT])
(\DLRS232C.SET.PARAMETERS
[LAMBDA (PARAMETERLIST) (* ; "Edited 21-Jan-87 02:20 by jds")
(* ;;; "PARAMETERLIST is in property list format. This function sets the parameters of the IOP accordingly")
(COND
(PARAMETERLIST (bind (CSB ← (LOCF (fetch DLRS232CPARAMETERCSBLO.11 of \IOPAGE)))
MAJORFLG PROP VAL for PROP.VAL in PARAMETERLIST
do (SETQ PROP (CAR PROP.VAL))
(SETQ VAL (CDR PROP.VAL))
(SELECTQ PROP
(FRAME.TIMEOUT (COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB
FRAME.TIMEOUT) of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB FRAME.TIMEOUT)
of CSB with VAL))))
(CORRESPONDENT (COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB
CORRESPONDENT) of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB CORRESPONDENT)
of CSB with VAL))))
(SYNCH.CHAR (COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB SYNCH.CHAR)
of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB SYNCH.CHAR)
of CSB with VAL))))
((STOP.BITS NoOfStopBits)
(replace (RS232C.INIT NoOfStopBits) of RS232C.DEFAULT.INIT.INFO
with VAL)
(SETQ VAL (IDIFFERENCE VAL 1))
(COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB STOP.BITS)
of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB STOP.BITS) of CSB
with VAL))))
((PARITY Parity)
(replace (RS232C.INIT Parity) of RS232C.DEFAULT.INIT.INFO
with VAL)
(SETQ VAL (SELECTQ VAL
(ODD 1)
(EVEN 2)
0))
(COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB PARITY) of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB PARITY) of CSB with VAL))))
((CHAR.LENGTH BitsPerSerialChar)
(replace (RS232C.INIT BitsPerSerialChar) of
RS232C.DEFAULT.INIT.INFO
with VAL)
(SETQ VAL (IDIFFERENCE VAL 5))
(COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB CHAR.LENGTH)
of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB CHAR.LENGTH) of CSB
with VAL))))
(SYNCH.COUNT (COND
((NEQ VAL (fetch (DLRS232C.PARAMETER.CSB SYNCH.COUNT)
of CSB))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB SYNCH.COUNT)
of CSB with VAL))))
((LINE.SPEED BaudRate)
(replace (RS232C.INIT BaudRate) of RS232C.DEFAULT.INIT.INFO
with VAL)
(SETQ \DLRS232C.OUTPUT.TIMEOUT (\RS232C.PACKET.TIMEOUT VAL))
(COND
((AND (SETQ VAL (CDR (SASSOC VAL \DLRS232C.BAUD.RATES)))
(NEQ VAL (fetch (DLRS232C.PARAMETER.CSB LINE.SPEED)
of CSB)))
(SETQ MAJORFLG T)
(replace (DLRS232C.PARAMETER.CSB LINE.SPEED) of CSB
with VAL))))
((FLOW.CONTROL FlowControl)
(SETQ MAJORFLG T)
(replace (RS232C.INIT FlowControl) of RS232C.DEFAULT.INIT.INFO
with VAL)
[COND
((EQ VAL 'XOnXOff)
(OR (STRING.EQUAL VAL "xonxoff")
(STRING.EQUAL VAL "xon-xoff")
(STRING.EQUAL VAL "xon/xoff"))
(SETQ VAL (CONSTANT (create RS232C.XONXOFF
FLAG ← 1
XON.CHAR ← (CHARCODE ↑Q)
XOFF.CHAR ← (CHARCODE ↑S]
(COND
((LISTP VAL)
(replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.ON)
of CSB with (fetch (RS232C.XONXOFF FLAG) of VAL))
(replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.XON.CHAR)
of CSB with (OR (fetch (RS232C.XONXOFF XON.CHAR)
of VAL)
0))
(replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.XOFF.CHAR)
of CSB with (OR (fetch (RS232C.XONXOFF XOFF.CHAR)
of VAL)
0)))
(T (replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.ON)
of CSB with 0))))
(ModemControl (for SIGNAL in VAL
do (SELECTQ SIGNAL
((DTR DATA.TERMINAL.READY)
(replace (DLRS232C.PARAMETER.CSB
DATA.TERMINAL.READY)
of CSB with T))
((RTS REQUEST.TO.SEND)
(replace (DLRS232C.PARAMETER.CSB
REQUEST.TO.SEND)
of CSB with T))
NIL)))
(RESET.RING.HEARD
(replace (DLRS232C.PARAMETER.CSB RESET.RING.HEARD) of CSB
with VAL))
(RESET.BREAK.DETECTED
(replace (DLRS232C.PARAMETER.CSB RESET.BREAK.DETECTED)
of CSB with VAL))
(RESET.DATA.LOST
(replace (DLRS232C.PARAMETER.CSB RESET.DATA.LOST) of CSB
with VAL))
((REQUEST.TO.SEND RTS)
(replace (DLRS232C.PARAMETER.CSB REQUEST.TO.SEND) of CSB
with VAL))
((DATA.TERMINAL.READY DTR)
(replace (DLRS232C.PARAMETER.CSB DATA.TERMINAL.READY)
of CSB with VAL))
NIL) finally (\DLRS232C.ISSUE.SHORT.COMMAND (COND
(MAJORFLG
MAJOR.SET.PARAMETERS
)
(T
MINOR.SET.PARAMETERS
)))
(RETURN (fetch (DLRS232C.PARAMETER.OUTCOME SUCCESS)
of \IOPAGE])
(\DLRS232C.SHUTDOWN
[LAMBDA NIL (* ejs%: "11-Aug-85 03:06")
(* * Disables RS232C if currently running)
(LET (PACKET DEVINFO)
(COND
(\DLRS232C.LOCAL.NDB (SETQ \RS232C.READY (SETQ \RS232FLG NIL))
(\RS232C.ISSUE.SHORT.COMMAND ABORT.INPUT)
(\RS232C.ISSUE.SHORT.COMMAND ABORT.OUTPUT)
(\RS232C.ISSUE.SHORT.COMMAND OFF)
(DEL.PROCESS (fetch NDBWATCHER of \DLRS232C.LOCAL.NDB))
(while (SETQ PACKET (\DEQUEUE (fetch NDBIQ of \DLRS232C.LOCAL.NDB)))
do (\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\RELEASE.ETHERPACKET PACKET))
(while (SETQ PACKET (\DEQUEUE (fetch NDBTQ of \DLRS232C.LOCAL.NDB)))
do (\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\RELEASE.ETHERPACKET PACKET))
(COND
((EQ \MACHINETYPE \DANDELION)
(replace (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE
with (replace (DLRS232C.IOP.GET.FLAG BUSY) of \IOPAGE with NIL))
(replace DLRS232C.PUT.CSB of \IOPAGE with (replace DLRS232C.GET.CSB
of \IOPAGE with NIL))
(SETQ \DLRS232C.ACTIVE.GET (SETQ \DLRS232C.ACTIVE.PUT (SETQ
\DLRS232C.LOCAL.NDB NIL
])
(\DLRS232C.FINISH.GET.AND.PUT
[LAMBDA (IOCB) (* ejs%: "16-Jun-85 00:49")
(* * Common code to complete I/O operation)
(LET (EVENT)
(replace (DLRS232C.IOCB COMPLETED) of IOCB with T)
(if (EQ \DLRS232C.ACTIVE.GET IOCB)
then (SETQ \DLRS232C.ACTIVE.GET NIL))
(if (EQ \DLRS232C.ACTIVE.PUT IOCB)
then (SETQ \DLRS232C.ACTIVE.PUT NIL))
(COND
((type? EVENT (SETQ EVENT (fetch (DLRS232C.IOCB SYNCH.EVENT) of IOCB)))
(NOTIFY.EVENT EVENT])
(\DLRS232C.GET.IOCB
[LAMBDA (USE) (* ejs%: "28-Dec-85 20:30")
(* returns a IOCB for INPUT or OUTPUT use, or NIL if none is available.
This must be called uninterruptably, since we don't have any easy way of GCing
these guys)
(DECLARE (GLOBALVARS \DLRS232C.IOCB.FREELIST.EVENT))
(PROG (IOCB)
LP (COND
((AND \DLRS232C.IOCB.FREELIST (IGREATERP (SELECTQ USE
(INPUT \DLRS232C.INPUT.IOCB.ALLOC)
(OUTPUT \DLRS232C.OUTPUT.IOCB.ALLOC)
(\ILLEGAL.ARG USE))
0))
(SELECTQ USE
(INPUT (add \DLRS232C.INPUT.IOCB.ALLOC -1))
(add \DLRS232C.OUTPUT.IOCB.ALLOC -1))
(SETQ IOCB \DLRS232C.IOCB.FREELIST)
(SETQ \DLRS232C.IOCB.FREELIST (fetch (DLRS232C.IOCB NEXT) of \DLRS232C.IOCB.FREELIST))
(replace (DLRS232C.IOCB NEXT) of IOCB with NIL)
(COND
((NEQ \MACHINETYPE \DANDELION)
(\CLEARWORDS IOCB DLRS232C.IOCB.SIZE)))
(RETURN IOCB))
(T (AWAIT.EVENT \DLRS232C.IOCB.FREELIST.EVENT)
(GO LP])
(\DLRS232C.INIT
[LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits FlowControl)
(* * Initialize the IOP)
(SELECTQ FlowControl
(XOnXoff (SETQ FlowControl '(1 17 19)))
NIL)
(COND
[(NOT (fetch (DLRS232C.HDW.CONF RS232C.ABSENT) of \IOPAGE))
(\DLRS232C.SHUTDOWN)
(COND
[(\RS232C.ISSUE.SHORT.COMMAND ON)
(SETQ \DLRS232C.PARAMETER.CSB (LOCF (fetch (IOPAGE DLRS232CPARAMETERCSBLO.11)
of \IOPAGE)))
(replace (DLRS232C.PARAMETER.CSB FRAME.TIMEOUT) of \DLRS232C.PARAMETER.CSB with 5)
(replace (DLRS232C.PARAMETER.CSB CORRESPONDENT) of \DLRS232C.PARAMETER.CSB with
RS232C.CP.TTYHOST
)
(replace (DLRS232C.PARAMETER.CSB SYNCH.CHAR) of \DLRS232C.PARAMETER.CSB with 0)
(replace (DLRS232C.PARAMETER.CSB RESET.RING.HEARD) of \DLRS232C.PARAMETER.CSB
with T)
(replace (DLRS232C.PARAMETER.CSB RESET.BREAK.DETECTED) of \DLRS232C.PARAMETER.CSB
with T)
(replace (DLRS232C.PARAMETER.CSB RESET.DATA.LOST) of \DLRS232C.PARAMETER.CSB with T)
(replace (DLRS232C.PARAMETER.CSB REQUEST.TO.SEND) of \DLRS232C.PARAMETER.CSB with T)
(replace (DLRS232C.PARAMETER.CSB DATA.TERMINAL.READY) of \DLRS232C.PARAMETER.CSB
with T)
(replace (DLRS232C.PARAMETER.CSB STOP.BITS) of \DLRS232C.PARAMETER.CSB
with (SELECTC NoOfStopBits
(1 0)
(2 1)
(ERROR "ILLEGAL NUMBER OF STOP BITS (MUST BE 1 OR 2)" NoOfStopBits)))
(replace (DLRS232C.PARAMETER.CSB LINE.TYPE) of \DLRS232C.PARAMETER.CSB with
RS232C.LT.ASYNCH
)
(replace (DLRS232C.PARAMETER.CSB PARITY) of \DLRS232C.PARAMETER.CSB
with (SELECTQ Parity
(ODD 1)
(EVEN 2)
0))
(replace (DLRS232C.PARAMETER.CSB CHAR.LENGTH) of \DLRS232C.PARAMETER.CSB
with (IDIFFERENCE BitsPerSerialChar 5))
(replace (DLRS232C.PARAMETER.CSB SYNCH.COUNT) of \DLRS232C.PARAMETER.CSB with 0)
(replace (DLRS232C.PARAMETER.CSB LINE.SPEED) of \DLRS232C.PARAMETER.CSB
with (OR (CDR (SASSOC BaudRate \DLRS232C.BAUD.RATES))
(ERROR "ILLEGAL BAUD RATE" BaudRate)))
(SETQ \DLRS232C.OUTPUT.TIMEOUT (\RS232C.PACKET.TIMEOUT BaudRate))
(replace (DLRS232C.PARAMETER.CSB INTERRUPT.MASK) of \DLRS232C.PARAMETER.CSB with 0)
(COND
((LISTP FlowControl)
(replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.ON) of \DLRS232C.PARAMETER.CSB
with (CAR FlowControl))
(replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.XON.CHAR) of \DLRS232C.PARAMETER.CSB
with (OR (CADR FlowControl)
0))
(replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.XOFF.CHAR) of \DLRS232C.PARAMETER.CSB
with (OR (CADDR FlowControl)
0)))
(T (replace (DLRS232C.PARAMETER.CSB FLOWCONTROL.ON) of \DLRS232C.PARAMETER.CSB
with 0)))
(\DLRS232C.ISSUE.SHORT.COMMAND MAJOR.SET.PARAMETERS)
(COND
((fetch (DLRS232C.PARAMETER.OUTCOME SUCCESS) of \IOPAGE)
(\DLRS232C.CREATE.NDB)
(\RS232C.CREATE.FDEV (SETQ RS232C.DEFAULT.INIT.INFO
(create RS232C.INIT
BaudRate ← BaudRate
BitsPerSerialChar ← BitsPerSerialChar
Parity ← Parity
NoOfStopBits ← NoOfStopBits
FlowControl ← FlowControl)))
(SETQ \RS232C.READY T)
(SETQ \RS232FLG T))
(T (HELP "Error setting parameters for RS232C"]
(T (HELP "Unable to activate RS232C interface"]
(T (HELP "There is no RS232C hardware in your machine!"])
(\DLRS232C.INPUT.INTERRUPT
[LAMBDA (NDB) (* ejs%: " 7-Sep-85 22:01")
(* * Poll the IOP to see if there are any input requests completed)
(LET ((PACKET (fetch SYSQUEUEHEAD of (fetch NDBIQ of NDB)))
IOCB NEXTIOCB ACCEPTSTATUS)
(if (AND PACKET \DLRS232C.ACTIVE.GET (NOT (fetch (DLRS232C.IOP.GET.FLAG BUSY) of \IOPAGE))
(SETQ IOCB (fetch EPNETWORK of PACKET))
(EQ \DLRS232C.ACTIVE.GET IOCB))
then (\DEQUEUE (fetch NDBIQ of NDB))
(if [NULL (SETQ \DLRS232C.GET.QUEUE.START (SETQ NEXTIOCB (fetch (DLRS232C.IOCB
NEXT) of IOCB]
then (SETQ \DLRS232C.GET.QUEUE.END NIL))
(SETQ ACCEPTSTATUS (OR (fetch (DLRS232C.IOCB SUCCESS) of IOCB)
(fetch (DLRS232C.IOCB TRANSFER.STATUS) of IOCB)))
(PROG ((LENGTH (fetch (DLRS232C.IOCB RETURNED.BYTE.COUNT) of IOCB)))
(replace (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET with LENGTH)
(replace EPNETWORK of PACKET with NDB)
(COND
([AND (EQ \MACHINETYPE \DANDELION)
(IGREATERP LENGTH (CONSTANT (UNFOLD \MIN2PAGEBUFLENGTH BYTESPERWORD]
(* * The DLion ether code doesn't dirty the pages of an etherpacket.
There are hints in the Mesa RS232C face that the IOP doesn't dirty the pages of
an RS232C packet either. Hence, we dirty the second page of the packet if it's
long enough to warrent it)
(\PUTBASE PACKET (SUB1 (ITIMES WORDSPERPAGE 2))
0)))
(\ENQUEUE \DLRS232C.RAW.PACKET.QUEUE PACKET)
(\DLRS232C.FINISH.GET.AND.PUT IOCB)
(if NEXTIOCB
then (\DLRS232C.START.INPUT NEXTIOCB))
(\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH BYTESPERPAGE
)))
(PROGN (SETQ PACKET (\DLRS232C.ALLOCATE.PACKET))
(\TEMPLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH BYTESPERPAGE)
)
(replace EPNETWORK of PACKET with IOCB)
(\DLRS232C.QUEUE.INPUT.IOCB IOCB (fetch RS232C.PACKET.BASE of PACKET)
\DLRS232C.DEFAULT.PACKET.LENGTH)
(\ENQUEUE (fetch NDBIQ of NDB)
PACKET)))
[COND
([AND ACCEPTSTATUS (NEQ ACCEPTSTATUS T)
(OR (EQ \RS232C.REPORT.STATUS T)
(EQ \RS232C.REPORT.STATUS 'INPUT]
(\DLRS232C.PARSE.STATUS ACCEPTSTATUS 'IN]
ACCEPTSTATUS])
(\DLRS232C.ISSUE.SHORT.COMMAND
[LAMBDA (COMMAND) (* ejs%: " 1-Jul-85 23:21")
(* * Issue a simple command to the IOP)
(DECLARE (GLOBALVARS \DLRS232C.COMMAND.LOCK))
(WITH.FAST.MONITOR \DLRS232C.COMMAND.LOCK (while (fetch (DLRS232C.IOP.MISC.CMD BUSY) of \IOPAGE)
do (BLOCK))
(replace (DLRS232C.IOP.MISC.CMD COMMAND) of \IOPAGE with COMMAND)
(replace (DLRS232C.IOP.MISC.CMD BUSY) of \IOPAGE with T)
(while (fetch (DLRS232C.IOP.MISC.CMD BUSY) of \IOPAGE) do (BLOCK))
(fetch (DLRS232C.DEVICE.STATUS STATUS) of \IOPAGE])
(\DLRS232C.LOADINPUTQ
[LAMBDA (NDB PACKETS) (* ejs%: "19-Jun-85 17:52")
(* PACKETS points at the first of several buffers of NDB's IQ.
We load them into the microcode's chain.
Value returned is the number of buffers)
(bind (CNT ← 0) while PACKETS do (\TEMPLOCKPAGES PACKETS (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\DLRS232C.QUEUE.INPUT.IOCB (fetch EPNETWORK of PACKETS)
(fetch RS232C.PACKET.BASE of PACKETS)
\DLRS232C.DEFAULT.PACKET.LENGTH)
(SETQ PACKETS (fetch EPLINK of PACKETS))
(add CNT 1) finally (RETURN CNT])
(\DLRS232C.OUTPUT.INTERRUPT
[LAMBDA (NDB) (* ejs%: " 7-Sep-85 22:00")
(* * Poll the IOP to see if there are any output requests completed)
(DECLARE (GLOBALVARS \DLRS232C.OUTPUT.TIMEOUT))
(LET ((PACKET (fetch SYSQUEUEHEAD of (fetch NDBTQ of NDB)))
STATUS IOCB NEXTIOCB)
(if PACKET
then (SETQ IOCB (fetch EPNETWORK of PACKET))
(if \DLRS232C.ACTIVE.PUT
then (if (AND (NOT (fetch (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE))
(EQ IOCB \DLRS232C.ACTIVE.PUT))
then (SETQ NEXTIOCB (fetch (DLRS232C.IOCB NEXT) of IOCB))
(if (NULL (SETQ \DLRS232C.PUT.QUEUE.START NEXTIOCB))
then (SETQ \DLRS232C.PUT.QUEUE.END NIL))
(\DLRS232C.FINISH.GET.AND.PUT IOCB)
(if NEXTIOCB
then (\DLRS232C.START.OUTPUT NEXTIOCB))
(\DEQUEUE (fetch NDBTQ of NDB))
(replace EPNETWORK of PACKET
with (replace EPTRANSMITTING of PACKET with NIL))
(\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH
BYTESPERPAGE))
(\REQUEUE.ETHERPACKET PACKET)
(SETQ STATUS (OR (fetch (DLRS232C.IOCB SUCCESS) of IOCB)
(fetch (DLRS232C.IOCB TRANSFER.STATUS)
of IOCB)))
(\DLRS232C.RELEASE.IOCB IOCB 'OUTPUT)
[COND
([AND STATUS (NEQ STATUS T)
(OR (EQ \RS232C.REPORT.STATUS T)
(EQ \RS232C.REPORT.STATUS 'OUTPUT]
(\DLRS232C.PARSE.STATUS STATUS 'OUT]
STATUS)
elseif (AND (EQ IOCB \DLRS232C.ACTIVE.PUT)
(IGREATERP (CLOCKDIFFERENCE (fetch EPTIMESTAMP of PACKET))
\DLRS232C.OUTPUT.TIMEOUT))
then (\RS232C.ISSUE.SHORT.COMMAND ABORT.OUTPUT)
(printout RS232C.ERROR.STREAM T "Output request was stuck!")
(LET ((CLOCK (CREATECELL \FIXP)))
(\CLOCK0 CLOCK)
(replace EPTIMESTAMP of PACKET with CLOCK))
(replace (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE with T])
(\DLRS232C.QUEUE.INPUT.IOCB
[LAMBDA (IOCB BUFFER LENGTH) (* ejs%: "20-Oct-85 14:12")
(* * Queue the current input request to the IOP.
If the input queue is empty, wake the IOP)
(SELECTC \MACHINETYPE
(\DANDELION (replace (DLRS232C.IOCB PUT) of IOCB with NIL)
(replace (DLRS232C.IOCB COMPLETED) of IOCB with NIL)
(replace (DLRS232C.IOCB BLOCK.POINTER) of IOCB with BUFFER)
(replace (DLRS232C.IOCB RETURNED.BYTE.COUNT) of IOCB with 0)
(replace (DLRS232C.IOCB TRANSFER.STATUS) of IOCB with 0)
(replace (DLRS232C.IOCB BYTE.COUNT) of IOCB with LENGTH)
(replace (DLRS232C.IOCB NEXT) of IOCB with NIL)
(UNINTERRUPTABLY
(if \DLRS232C.GET.QUEUE.START
then (replace (DLRS232C.IOCB NEXT) of \DLRS232C.GET.QUEUE.END
with IOCB)
else (SETQ \DLRS232C.GET.QUEUE.START IOCB))
(SETQ \DLRS232C.GET.QUEUE.END IOCB)
(if (NULL \DLRS232C.ACTIVE.GET)
then (\DLRS232C.START.INPUT IOCB))))
(\DAYBREAK (replace (Dove.RS232IOCB rsIOCBType) of IOCB with rsIOCBTypeRx)
(replace (Dove.RS232IOCB rsBufferSize) of IOCB with (\DoveIO.ByteSwap LENGTH))
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB rsBufferPtr) of IOCB))
BUFFER)
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB rsNextIocbChA) of IOCB))
NIL)
(replace (Dove.RS232IOCB currentOpStatus) of IOCB with IOCBpollRxOrTx)
(replace (Dove.RS232IOCB rsActiveIOCB) of IOCB with \DoveIO.ByteFALSE)
(* * IOCB ready to be enqueued and process in inProgress)
(LET ((rxQueueChA (fetch (Dove.RS232FCB rsQueueRxChA) of \DoveRS232C.FCBPointer)))
(COND
((NULL (fetch (Dove.QueueBlock LispQueueHead) of rxQueueChA))
(* The queue must be empty)
(replace (Dove.QueueBlock LispQueueHead) of rxQueueChA with IOCB))
(T (* Add a new iocb to the existing
queue)
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB rsNextIocbChA)
of (fetch (Dove.QueueBlock
LispQueueTail)
of rxQueueChA)))
IOCB)))
(WITH-RESOURCE DoveIO.OpieAddressBox (\DoveIO.MakeOpieAddress
DoveIO.OpieAddressBox IOCB)
(\DoveIO.LockMem \DoveIO.XCHG (ADD1 (\DoveIO.IORegionOffset
(fetch (Dove.QueueBlock QueueNext
) of rxQueueChA)))
(\LONUM DoveIO.OpieAddressBox)
0)
(\DoveIO.LockMem \DoveIO.OVERWRITEIFNIL (\DoveIO.IORegionOffset
(fetch (Dove.QueueBlock
QueueNext)
of rxQueueChA))
(\HINUM DoveIO.OpieAddressBox)
(fetch (Dove.RS232FCB rs232LockMask) of \DoveRS232C.FCBPointer)
))
(replace (Dove.QueueBlock LispQueueTail) of rxQueueChA with IOCB)))
(\NOMACHINETYPE])
(\DLRS232C.QUEUE.OUTPUT.IOCB
[LAMBDA (IOCB BUFFER LENGTH) (* ; "Edited 2-Dec-86 03:35 by lmm")
(* ;;; "Queue this IOCB to the IOP. If the IOP is currently processing an output request, queue this request on the end of the output request queue and leave. Otherwise, wake the IOP to process this packet")
(SELECTC \MACHINETYPE
(\DANDELION (replace (DLRS232C.IOCB PUT) of IOCB with T)
(replace (DLRS232C.IOCB COMPLETED) of IOCB with NIL)
(replace (DLRS232C.IOCB BLOCK.POINTER) of IOCB with BUFFER)
(replace (DLRS232C.IOCB BYTE.COUNT) of IOCB with LENGTH)
(replace (DLRS232C.IOCB NEXT) of IOCB with NIL)
(replace (DLRS232C.IOCB TRANSFER.STATUS) of IOCB with 0)
(replace (DLRS232C.IOCB RETURNED.BYTE.COUNT) of IOCB with 0)
[WITH.MONITOR \DLRS232C.OUTPUT.LOCK
(UNINTERRUPTABLY
(if \DLRS232C.PUT.QUEUE.START
then (replace (DLRS232C.IOCB NEXT) of \DLRS232C.PUT.QUEUE.END
with IOCB)
else (SETQ \DLRS232C.PUT.QUEUE.START IOCB))
(SETQ \DLRS232C.PUT.QUEUE.END IOCB)
(if (NULL \DLRS232C.ACTIVE.PUT)
then (\DLRS232C.START.OUTPUT IOCB)))])
(\DAYBREAK (replace (Dove.RS232IOCB rsIOCBType) of IOCB with rsIOCBTypeTx)
(replace (Dove.RS232IOCB rsBufferSize) of IOCB with (\DoveIO.ByteSwap LENGTH))
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB rsBufferPtr) of IOCB))
BUFFER)
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB rsNextIocbChA) of IOCB))
NIL)
(replace (Dove.RS232IOCB currentOpStatus) of IOCB with IOCBpollRxOrTx)
(replace (Dove.RS232IOCB rsActiveIOCB) of IOCB with \DoveIO.ByteFALSE)
(* ;;; "IOCB ready to be enqueued and process in inProgress")
[WITH.MONITOR \DLRS232C.OUTPUT.LOCK
(UNINTERRUPTABLY
(LET ((txQueueChA (fetch (Dove.RS232FCB rsQueueTxChA) of
\DoveRS232C.FCBPointer
)))
(COND
((NULL (fetch (Dove.QueueBlock LispQueueHead) of txQueueChA))
(* ; "The queue must be empty")
(replace (Dove.QueueBlock LispQueueHead) of txQueueChA
with IOCB))
(T (* ;
"Add a new iocb to the existing queue")
(\DoveIO.MakeOpieAddress (LOCF (fetch (Dove.RS232IOCB
rsNextIocbChA)
of (fetch (Dove.QueueBlock
LispQueueTail)
of txQueueChA)))
IOCB)))
(WITH-RESOURCE DoveIO.OpieAddressBox (\DoveIO.MakeOpieAddress
DoveIO.OpieAddressBox IOCB)
(\DoveIO.LockMem \DoveIO.XCHG
(ADD1 (\DoveIO.IORegionOffset (fetch (
Dove.QueueBlock
QueueNext)
of txQueueChA)))
(\LONUM DoveIO.OpieAddressBox)
0)
(\DoveIO.LockMem \DoveIO.OVERWRITEIFNIL
(\DoveIO.IORegionOffset (fetch (Dove.QueueBlock
QueueNext)
of txQueueChA))
(\HINUM DoveIO.OpieAddressBox)
(fetch (Dove.RS232FCB rs232LockMask) of
\DoveRS232C.FCBPointer
)))
(replace (Dove.QueueBlock LispQueueTail) of txQueueChA
with IOCB)
(* ;;; "Set new-xmit bit in rs232worklist")
(replace (Dove.RS232DCB rsCommandWorkList) of
\DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap (BITSET (\DoveIO.ByteSwap
(fetch (Dove.RS232DCB
rsCommandWorkList
) of
\DoveRS232C.DCBPointer
))
newTx)))
(\DoveIO.NotifyIOP (fetch (Dove.RS232FCB rs232WorkMask)
of \DoveRS232C.FCBPointer))))])
(\NOMACHINETYPE])
(\DLRS232C.RELEASE.IOCB
[LAMBDA (IOCB USE) (* ejs%: "20-Oct-85 14:53")
(* * Returns an IOCB to the free pool. USE is INPUT or OUTPUT, according to
which side should be credited. Must be called uninterruptably)
(DECLARE (GLOBALVARS \DLRS232C.IOCB.FREELIST.EVENT))
(LET (NOTIFYP)
[COND
([NOT (AND IOCB (LET ((PAGE# (fetch (POINTER PAGE#) of IOCB))
(IOCBPAGE# (fetch (POINTER PAGE#) of \DLRS232C.IOCB.PAGE)))
(AND (IGEQ PAGE# IOCBPAGE#)
(ILEQ PAGE# (IPLUS IOCBPAGE# (CONSTANT (SUB1
DLRS232C.IOCB.PAGES
]
(ERROR "ARG NOT IOCB" IOCB))
(T (UNINTERRUPTABLY
(SELECTQ USE
(INPUT (COND
((EQ \DLRS232C.INPUT.IOCB.ALLOC 0)
(SETQ NOTIFYP T)))
(add \DLRS232C.INPUT.IOCB.ALLOC 1))
(OUTPUT (COND
((EQ \DLRS232C.OUTPUT.IOCB.ALLOC 0)
(SETQ NOTIFYP T)))
(add \DLRS232C.OUTPUT.IOCB.ALLOC 1))
(\ILLEGAL.ARG USE))
(COND
((NEQ \MACHINETYPE \DANDELION)
(* * Machines other than DLions probably use the IOCB layout differently.
We have to clear the iocb of spurious pointer-like bit patterns to prevent Lisp
from doing a gc-related things inadvertantly)
(\CLEARWORDS IOCB DLRS232C.IOCB.SIZE)))
(replace (DLRS232C.IOCB NEXT) of IOCB with \DLRS232C.IOCB.FREELIST)
(COND
((NULL \DLRS232C.IOCB.FREELIST)
(SETQ NOTIFYP T)))
(SETQ \DLRS232C.IOCB.FREELIST IOCB))]
(COND
(NOTIFYP (NOTIFY.EVENT \DLRS232C.IOCB.FREELIST.EVENT])
(\DLRS232C.START.DRIVER
[LAMBDA (NDB RESTARTFLG) (* ejs%: "19-Jun-85 17:52")
(* * Device-specific RS232C startup)
(* * Get some IOCB space)
(OR (\DLRS232C.ALLOCATE.IOCBS)
(ERROR "Unable to create IOCB pool"))
(replace NDBTQ of NDB with (create SYSQUEUE))
(* * Initialize the device at the IOP level)
(\DLRS232C.STARTUP NDB)
(* * Load the initial RS232C input queue)
(LET ((LEN 0)
(IQ (fetch NDBIQ of NDB)))
[COND
[IQ (SETQ LEN (\DLRS232C.LOADINPUTQ NDB (fetch SYSQUEUEHEAD of IQ]
(T (replace NDBIQ of NDB with (SETQ IQ (create SYSQUEUE]
(bind IOCB PACKET to (IDIFFERENCE \DLRS232C.IDEAL.INPUT.LENGTH LEN)
while (SETQ IOCB (\DLRS232C.GET.IOCB 'INPUT))
do (SETQ PACKET (\DLRS232C.ALLOCATE.PACKET))
(\TEMPLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH BYTESPERPAGE))
(replace EPNETWORK of PACKET with IOCB)
(\DLRS232C.QUEUE.INPUT.IOCB IOCB (fetch (RS232C.ENCAPSULATION RS232C.PACKET.BASE)
of PACKET)
\DLRS232C.DEFAULT.PACKET.LENGTH)
(\ENQUEUE IQ PACKET)
(add LEN 1))
(replace NDBIQLENGTH of NDB with LEN)
(* * This process will eventually be replaced by interrupts)
(replace NDBWATCHER of NDB with (ADD.PROCESS (LIST (FUNCTION \DLRS232C.WATCHER)
(KWOTE NDB))
'RESTARTABLE
'SYSTEM
'AFTEREXIT
'DELETE))
NDB])
(\DLRS232C.STARTUP
[LAMBDA NIL (* ejs%: "17-Oct-85 22:58")
(* * Reinitialized the various global variables)
(for VAR in '(\DLRS232C.ACTIVE.GET \DLRS232C.ACTIVE.PUT \DLRS232C.GET.QUEUE.START
\DLRS232C.GET.QUEUE.END \DLRS232C.PUT.QUEUE.START \DLRS232C.PUT.QUEUE.END)
do (SET VAR NIL))
(SELECTC \MACHINETYPE
(\DANDELION (\RS232C.ISSUE.SHORT.COMMAND ABORT.INPUT)
(\RS232C.ISSUE.SHORT.COMMAND ABORT.OUTPUT))
(\DAYBREAK (\Dove.ClearQueueBlock (fetch (Dove.RS232FCB rsQueueTxChA) of
\DoveRS232C.FCBPointer
))
(\Dove.ClearQueueBlock (fetch (Dove.RS232FCB rsQueueRxChA) of
\DoveRS232C.FCBPointer
)))
(\NOMACHINETYPE])
(\DLRS232C.START.INPUT
[LAMBDA (IOCB) (* ejs%: "15-Jun-85 23:45")
(* * Start IOP input on the RS232C port)
(until (OR (NULL IOCB)
\DLRS232C.ACTIVE.GET
(fetch (DLRS232C.IOP.GET.FLAG BUSY) of \IOPAGE))
do (if (NOT (fetch (DLRS232C.IOCB COMPLETED) of IOCB))
then (replace DLRS232C.GET.CSB of \IOPAGE with IOCB)
(replace (DLRS232C.IOP.GET.FLAG BUSY) of \IOPAGE with T)
(SETQ \DLRS232C.ACTIVE.GET IOCB))
(SETQ IOCB (fetch (DLRS232C.IOCB NEXT) of IOCB])
(\DLRS232C.START.OUTPUT
[LAMBDA (IOCB) (* ejs%: "17-Jun-85 20:07")
(* * Start IOP output on the RS232C port)
(until (OR (NULL IOCB)
\DLRS232C.ACTIVE.PUT
(fetch (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE))
do (if (NOT (fetch (DLRS232C.IOCB COMPLETED) of IOCB))
then (replace DLRS232C.PUT.CSB of \IOPAGE with IOCB)
(replace (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE with T)
(SETQ \DLRS232C.ACTIVE.PUT IOCB))
(SETQ IOCB (fetch (DLRS232C.IOCB NEXT) of IOCB])
)
(* ;;; "More or less machine independant functions and structures. ")
(RPAQQ \RS232C.DUPLEXITIES ((RS232C.DUPLEX.FULL 0)
(RS232C.DUPLEX.HALF 1)))
(DECLARE%: EVAL@COMPILE
(RPAQQ RS232C.DUPLEX.FULL 0)
(RPAQQ RS232C.DUPLEX.HALF 1)
(CONSTANTS (RS232C.DUPLEX.FULL 0)
(RS232C.DUPLEX.HALF 1))
)
(RPAQQ \RS232C.LINE.TYPES ((RS232C.LT.BIT.SYNCH 0)
(RS232C.LT.BYTE.SYNCH 1)
(RS232C.LT.ASYNCH 3)
(RS232C.LT.AUTO 4)))
(DECLARE%: EVAL@COMPILE
(RPAQQ RS232C.LT.BIT.SYNCH 0)
(RPAQQ RS232C.LT.BYTE.SYNCH 1)
(RPAQQ RS232C.LT.ASYNCH 3)
(RPAQQ RS232C.LT.AUTO 4)
(CONSTANTS (RS232C.LT.BIT.SYNCH 0)
(RS232C.LT.BYTE.SYNCH 1)
(RS232C.LT.ASYNCH 3)
(RS232C.LT.AUTO 4))
)
(RPAQQ \RS232C.CORRESPONDENTS ((RS232C.CP.XEROX800 0)
(RS232C.CP.XEROX850 1)
(RS232C.CP.SYSTEM6 2)
(RS232C.CP.CMCII 3)
(RS232C.CP.TTYHOST 4)
(RS232C.CP.NS.ELEMENT 5)
(RS232C.CP.3270.HOST 6)
(RS232C.CP.2770.HOST 7)
(RS232C.CP.6670.HOST 8)
(RS232C.CP.6670 9)
(RS232C.CP.XEROX860 10)
(RS232C.CP.NS.ELEMENT.BSC 11)
(RS232C.CP.SIEMENS9750 12)))
(DECLARE%: EVAL@COMPILE
(RPAQQ RS232C.CP.XEROX800 0)
(RPAQQ RS232C.CP.XEROX850 1)
(RPAQQ RS232C.CP.SYSTEM6 2)
(RPAQQ RS232C.CP.CMCII 3)
(RPAQQ RS232C.CP.TTYHOST 4)
(RPAQQ RS232C.CP.NS.ELEMENT 5)
(RPAQQ RS232C.CP.3270.HOST 6)
(RPAQQ RS232C.CP.2770.HOST 7)
(RPAQQ RS232C.CP.6670.HOST 8)
(RPAQQ RS232C.CP.6670 9)
(RPAQQ RS232C.CP.XEROX860 10)
(RPAQQ RS232C.CP.NS.ELEMENT.BSC 11)
(RPAQQ RS232C.CP.SIEMENS9750 12)
(CONSTANTS (RS232C.CP.XEROX800 0)
(RS232C.CP.XEROX850 1)
(RS232C.CP.SYSTEM6 2)
(RS232C.CP.CMCII 3)
(RS232C.CP.TTYHOST 4)
(RS232C.CP.NS.ELEMENT 5)
(RS232C.CP.3270.HOST 6)
(RS232C.CP.2770.HOST 7)
(RS232C.CP.6670.HOST 8)
(RS232C.CP.6670 9)
(RS232C.CP.XEROX860 10)
(RS232C.CP.NS.ELEMENT.BSC 11)
(RS232C.CP.SIEMENS9750 12))
)
(DECLARE%: EVAL@COMPILE
(RECORD RS232C.DEVICEINFO (INSTREAM OUTSTREAM INIT))
(ACCESSFNS RS232C.STREAM ((EVENT (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(PACKET.QUEUE (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))
(LASTBUFFER (fetch (STREAM F3) of DATUM)
(replace (STREAM F3) of DATUM with NEWVALUE))
(LASTBUFFER.CBUFSIZE (fetch (STREAM FW6) of DATUM)
(replace (STREAM FW6) of DATUM with NEWVALUE))
(FLAGS (fetch (STREAM FW7) of DATUM)
(replace (STREAM FW7) of DATUM with NEWVALUE))
(QUEUE.LENGTH (fetch (STREAM FW8) of DATUM)
(replace (STREAM FW8) of DATUM with NEWVALUE)))
[ACCESSFNS RS232C.STREAM [(FLAGBASE (LOCF (fetch (RS232C.STREAM FLAGS)
of DATUM]
(BLOCKRECORD FLAGBASE ((DID.BACKFILEPTR FLAG])
)
(RPAQ? \RS232C.LIGHTNING )
(RPAQ? \RS232C.READY )
(RPAQ? \RS232C.READY.EVENT (CREATE.EVENT "RS232C is running"))
(RPAQ? \RS232C.FDEV )
(RPAQ? \RS232FLG )
(RPAQ? \RS232C.REPORT.STATUS T)
(RPAQ? \RS232C.OUTPUT.PACKET.LENGTH 578)
(RPAQ? \RS232C.MAX.INPUT.BUFFERS 10)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RS232C.LIGHTNING \RS232C.READY \RS232C.READY.EVENT \RS232C.FDEV \RS232FLG
\RS232C.REPORT.STATUS \RS232C.OUTPUT.PACKET.LENGTH \RS232C.MAX.INPUT.BUFFERS)
)
(ADDTOVAR \SYSTEMCACHEVARS \RS232C.READY)
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")
(DECLARE%: EVAL@COMPILE
(ACCESSFNS RS232C.ENCAPSULATION [(RS232CBASE (LOCF (fetch (ETHERPACKET EPENCAPSULATION) of DATUM]
[BLOCKRECORD RS232CBASE ((RS232C.LENGTH WORD)
(* Length of packet in words)
(RS232C.DATA WORD)
(* Data starts here)
)
(ACCESSFNS RS232C.DATA ((RS232C.PACKET.BASE (LOCF DATUM]
(TYPE? (type? ETHERPACKET DATUM)))
(ACCESSFNS RS232C.STREAM ((EVENT (fetch (STREAM F1) of DATUM)
(replace (STREAM F1) of DATUM with NEWVALUE))
(PACKET.QUEUE (fetch (STREAM F2) of DATUM)
(replace (STREAM F2) of DATUM with NEWVALUE))
(LASTBUFFER (fetch (STREAM F3) of DATUM)
(replace (STREAM F3) of DATUM with NEWVALUE))
(LASTBUFFER.CBUFSIZE (fetch (STREAM FW6) of DATUM)
(replace (STREAM FW6) of DATUM with NEWVALUE))
(FLAGS (fetch (STREAM FW7) of DATUM)
(replace (STREAM FW7) of DATUM with NEWVALUE))
(QUEUE.LENGTH (fetch (STREAM FW8) of DATUM)
(replace (STREAM FW8) of DATUM with NEWVALUE)))
[ACCESSFNS RS232C.STREAM [(FLAGBASE (LOCF (fetch (RS232C.STREAM FLAGS)
of DATUM]
(BLOCKRECORD FLAGBASE ((DID.BACKFILEPTR FLAG])
)
(DECLARE%: EVAL@COMPILE
(PUTPROPS \DLRS232C.ALLOCATE.PACKET MACRO (= . \ALLOCATE.ETHERPACKET))
)
(* "END EXPORTED DEFINITIONS")
)
(* ; "Stream interface")
(DEFINEQ
(\RS232C.ISSUE.SHORT.COMMAND
[LAMBDA (COMMAND) (* ejs%: "11-Aug-85 03:09")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.ISSUE.SHORT.COMMAND COMMAND))
(\DAYBREAK (\DVRS232C.ISSUE.SHORT.COMMAND COMMAND))
(\NOMACHINETYPE])
(\DLRS232C.GET.PACKET
[LAMBDA NIL (* ejs%: "17-Jun-85 16:06")
(* * Take the next packet off the raw input queue)
(\DEQUEUE \DLRS232C.RAW.PACKET.QUEUE])
(\DLRS232C.SEND.PACKET
[LAMBDA (NDB PACKET EVENT) (* ; "Edited 22-Dec-86 14:00 by lmm")
(PROG ([DROPIT (AND \RS232C.LIGHTNING (EQ 0 (RAND 0 \RS232C.LIGHTNING]
IOCB BUFLENGTH)
(UNINTERRUPTABLY
(replace EPTRANSMITTING of PACKET with T)
(COND
(DROPIT (* ; "Fake transmission")
(\ENQUEUE (fetch NDBTQ of NDB)
PACKET)
(replace EPNETWORK of PACKET with NIL))
(T (SETQ IOCB (\DLRS232C.GET.IOCB 'OUTPUT))
(CL:ASSERT (NOT (NULL IOCB)))
(replace EPNETWORK of PACKET with IOCB)
(SETQ BUFLENGTH (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET))
(\TEMPLOCKPAGES PACKET (COND
((IGEQ BUFLENGTH (CONSTANT (UNFOLD \MIN2PAGEBUFLENGTH
BYTESPERWORD)))
2)
(T 1)))
(LET ((CLOCK (CREATECELL \FIXP)))
(\CLOCK0 CLOCK)
(replace EPTIMESTAMP of PACKET with CLOCK))
(* ; "Put on microcode queue")
(\ENQUEUE (fetch NDBTQ of NDB)
PACKET)
(SELECTC \MACHINETYPE
(\DANDELION (replace (DLRS232C.IOCB SYNCH.EVENT) of IOCB with EVENT)
(\DLRS232C.QUEUE.OUTPUT.IOCB IOCB (fetch (RS232C.ENCAPSULATION
RS232C.PACKET.BASE)
of PACKET)
BUFLENGTH))
(\DAYBREAK (replace (Dove.RS232IOCB rsLispSynchEvent) of IOCB with EVENT)
(\DLRS232C.QUEUE.OUTPUT.IOCB IOCB (fetch (RS232C.ENCAPSULATION
RS232C.PACKET.BASE)
of PACKET)
BUFLENGTH))
(\NOMACHINETYPE))
T)) (* ;
"Put on driver's queue to pick up after microcode finishes with it")
)
(RETURN (AND IOCB T])
(\RS232C.HANDLE.PACKET
[LAMBDA (PACKET) (* ejs%: "24-Dec-85 14:04")
(* * Handle a received packet from the RS232 device)
(COND
[(type? FDEV \RS232C.FDEV)
(LET* ((INSTREAM (fetch (RS232C.DEVICEINFO INSTREAM) of (fetch (FDEV DEVICEINFO) of
\RS232C.FDEV
)))
MAX.BUFFERS PACKET.QUEUE)
(COND
((AND (type? STREAM INSTREAM)
(type? SYSQUEUE (SETQ PACKET.QUEUE (fetch (RS232C.STREAM PACKET.QUEUE)
of INSTREAM)))
(ILEQ (fetch (RS232C.STREAM QUEUE.LENGTH) of INSTREAM)
(fetch (STREAM MAXBUFFERS) of INSTREAM))
(EQ (fetch (STREAM ACCESS) of INSTREAM)
'INPUT)
(NEQ 0 (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET)))
(\ENQUEUE PACKET.QUEUE PACKET)
(add (fetch (RS232C.STREAM QUEUE.LENGTH) of INSTREAM)
1)
(NOTIFY.EVENT (fetch (RS232C.STREAM EVENT) of INSTREAM)))
(T (\RELEASE.ETHERPACKET PACKET]
(T (\RELEASE.ETHERPACKET PACKET])
(\RS232C.PACKET.TIMEOUT
[LAMBDA (BAUDRATE) (* ejs%: " 5-Jul-85 21:26")
(* * Computes the time in ms we should wait for a max length packet to be
output)
(FIX (FTIMES \DLRS232C.DEFAULT.PACKET.LENGTH (FQUOTIENT 10000.0 BAUDRATE])
(\DLRS232C.WATCHER
[LAMBDA (NDB) (* ejs%: "11-Aug-85 18:09")
(* * Process that watches the RS232C port.
Passes received packets to interested party)
(DECLARE (GLOBALVARS \MAXWATCHERGETS))
(SELECTC \MACHINETYPE
(\DANDELION (PROG ((CNTR 0)
PACKET)
LP (UNINTERRUPTABLY
(\DLRS232C.INPUT.INTERRUPT NDB)
(\DLRS232C.OUTPUT.INTERRUPT NDB))
[COND
((SETQ PACKET (\DLRS232C.GET.PACKET))
(\RS232C.HANDLE.PACKET PACKET)
(COND
((ILESSP (add CNTR 1)
\MAXWATCHERGETS)
(GO LP]
(BLOCK)
(SETQ CNTR 0)
(GO LP)))
(\DAYBREAK (PROG ((CNTR 0)
PACKET)
LP (UNINTERRUPTABLY
(\DVRS232C.INPUT.INTERRUPT NDB)
(\DVRS232C.OUTPUT.INTERRUPT NDB))
[COND
((SETQ PACKET (\DLRS232C.GET.PACKET))
(\RS232C.HANDLE.PACKET PACKET)
(COND
((ILESSP (add CNTR 1)
\MAXWATCHERGETS)
(GO LP]
(BLOCK)
(SETQ CNTR 0)
(GO LP)))
(\NOMACHINETYPE])
(\RS232C.EVENTFN
[LAMBDA (DEVICE EVENT) (* ejs%: "10-Feb-86 11:06")
(SELECTQ EVENT
((AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
[COND
[(AND \RS232FLG (SELECTC \MACHINETYPE
(\DANDELION (NOT (fetch (DLRS232C.HDW.CONF RS232C.ABSENT)
of \IOPAGE)))
(\DAYBREAK T)
NIL))
(COND
((AND \DLRS232C.IOCB.PAGE \DLRS232C.IOCB.ENDPAGE)
[bind (BASE ← \DLRS232C.IOCB.PAGE)
DONE until DONE do (\DONEWEPHEMERALPAGE BASE T)
(COND
((NEQ BASE \DLRS232C.IOCB.ENDPAGE)
(SETQ BASE (\ADDBASE BASE WORDSPERPAGE)))
(T (SETQ DONE T]
(RS232C.INIT (OR (AND \RS232C.FDEV (fetch (RS232C.DEVICEINFO INIT)
of (fetch (FDEV DEVICEINFO) of
\RS232C.FDEV
)))
RS232C.DEFAULT.INIT.INFO]
((AND \DLRS232C.IOCB.PAGE \DLRS232C.IOCB.ENDPAGE)
(bind (BASE ← \DLRS232C.IOCB.PAGE)
DONE until DONE do (\DONEWEPHEMERALPAGE BASE T)
(COND
((NEQ BASE \DLRS232C.IOCB.ENDPAGE)
(SETQ BASE (\ADDBASE BASE WORDSPERPAGE)))
(T (SETQ DONE T])
NIL])
(\RS232C.CREATE.FDEV
[LAMBDA (INITINFO) (* ; "Edited 3-Dec-86 02:24 by lmm")
(* ;;; "Creates the RS232 FDEV")
[OR (type? FDEV \RS232C.FDEV)
(\DEFINEDEVICE 'RS232
(SETQ \RS232C.FDEV
(create FDEV
DEVICENAME ← 'RS232
RANDOMACCESSP ← NIL
PAGEMAPPED ← NIL
NODIRECTORIES ← T
FDBINABLE ← T
FDBOUTABLE ← T
FDEXTENDABLE ← NIL
BUFFERED ← T
CLOSEFILE ← (FUNCTION \RS232C.CLOSEFILE)
DELETEFILE ← (FUNCTION NILL)
EVENTFN ← (FUNCTION \RS232C.EVENTFN)
GENERATEFILES ← (FUNCTION \GENERATENOFILES)
GETFILEINFO ← (FUNCTION \RS232C.GETFILEINFO)
SETFILEINFO ← (FUNCTION \RS232C.SETFILEINFO)
GETFILENAME ← (FUNCTION \RS232C.GETFILENAME)
OPENFILE ← (FUNCTION \RS232C.OPENFILE)
REOPENFILE ← (FUNCTION \RS232C.REOPENFILE)
TRUNCATEFILE ← (FUNCTION NILL)
BIN ← (FUNCTION \BUFFERED.BIN)
BOUT ← (FUNCTION \BUFFERED.BOUT)
PEEKBIN ← (FUNCTION \BUFFERED.PEEKBIN)
READP ← (FUNCTION \RS232C.READP)
FORCEOUTPUT ← (FUNCTION \RS232C.FORCEOUTPUT)
BACKFILEPTR ← (FUNCTION \RS232C.BACKFILEPTR)
GETNEXTBUFFER ← (FUNCTION \RS232C.GETNEXTBUFFER)
EOFP ← (FUNCTION NILL)
GETEOFPTR ← (FUNCTION \IS.NOT.RANDACCESSP)
SETEOFPTR ← (FUNCTION \IS.NOT.RANDACCESSP)
GETFILEPTR ← (FUNCTION ZERO)
SETFILEPTR ← (FUNCTION \IS.NOT.RANDACCESSP)
BLOCKIN ← (FUNCTION \BUFFERED.BINS)
BLOCKOUT ← (FUNCTION \BUFFERED.BOUTS)
RENAMEFILE ← (FUNCTION \ILLEGAL.DEVICEOP)
REGISTERFILE ← (FUNCTION NILL)
OPENP ← (FUNCTION \GENERIC.OPENP)
DEVICEINFO ← (create RS232C.DEVICEINFO]
(replace (RS232C.DEVICEINFO INIT) of (fetch (FDEV DEVICEINFO) of \RS232C.FDEV) with INITINFO])
(\RS232C.FORCEOUTPUT
[LAMBDA (STREAM WAITFORFINISH) (* ; "Edited 29-May-87 15:27 by Snow")
(COND
((OPENP STREAM 'OUTPUT)
(LET ((PACKET (FETCH (STREAM CBUFPTR) OF STREAM))
(EVENT (FETCH (RS232C.STREAM EVENT) OF STREAM)))
(COND
((TYPE? ETHERPACKET PACKET)
[REPLACE (RS232C.ENCAPSULATION RS232C.LENGTH) OF PACKET
WITH (IDIFFERENCE (FETCH COFFSET OF STREAM)
(CONSTANT (UNFOLD (IPLUS (INDEXF (FETCH (RS232C.ENCAPSULATION
RS232C.DATA)
OF T))
(INDEXF (FETCH EPENCAPSULATION OF T)))
BYTESPERWORD]
(\RS232C.TRACE.PACKET PACKET 'OUTPUT)
(REPLACE COFFSET OF STREAM WITH (REPLACE CBUFSIZE OF STREAM
WITH (REPLACE CBUFMAXSIZE OF STREAM WITH 0)))
(REPLACE CBUFPTR OF STREAM WITH NIL)
(\DLRS232C.SEND.PACKET \DLRS232C.LOCAL.NDB PACKET (AND WAITFORFINISH EVENT))
(COND
(WAITFORFINISH (WHILE (FETCH EPTRANSMITTING OF PACKET) DO (AWAIT.EVENT EVENT)))
(T (BLOCK])
(\RS232C.GETNEXTBUFFER
[LAMBDA (STREAM WHATFOR NOERRORFLG) (* ejs%: "24-Dec-85 14:05")
(LET
((QUEUE (fetch (RS232C.STREAM PACKET.QUEUE) of STREAM))
(EVENT (ffetch (RS232C.STREAM EVENT) of STREAM))
(OLDPACKET (ffetch (STREAM CBUFPTR) of STREAM))
(LASTBUFFER (ffetch (RS232C.STREAM LASTBUFFER) of STREAM))
NEXTPACKET)
(SELECTQ WHATFOR
(READ [COND
((ffetch (RS232C.STREAM DID.BACKFILEPTR) of STREAM)
(UNINTERRUPTABLY
(freplace (RS232C.STREAM DID.BACKFILEPTR) of STREAM with NIL)
(swap (ffetch CBUFPTR of STREAM)
(ffetch (RS232C.STREAM LASTBUFFER) of STREAM))
(swap (ffetch CBUFSIZE of STREAM)
(ffetch (RS232C.STREAM LASTBUFFER.CBUFSIZE) of STREAM))
(freplace COFFSET of STREAM
with (UNFOLD [CONSTANT (IPLUS (INDEXF (fetch (RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION of T]
BYTESPERWORD))
T))
(T
[COND
(OLDPACKET (COND
(LASTBUFFER (\RELEASE.ETHERPACKET LASTBUFFER)))
(freplace (RS232C.STREAM LASTBUFFER) of STREAM with OLDPACKET)
(freplace (RS232C.STREAM LASTBUFFER.CBUFSIZE) of STREAM
with (ffetch CBUFSIZE of STREAM))
(freplace CBUFPTR of STREAM with NIL)
(freplace COFFSET of STREAM with (freplace CBUFSIZE of STREAM
with 0]
(until (SETQ NEXTPACKET (\DEQUEUE QUEUE)) do (AWAIT.EVENT EVENT)
finally (add (fetch (RS232C.STREAM QUEUE.LENGTH) of STREAM)
-1)
(\RS232C.TRACE.PACKET NEXTPACKET 'INPUT)
[freplace CBUFSIZE of STREAM
with (IPLUS (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of NEXTPACKET)
(freplace COFFSET of STREAM
with (UNFOLD [CONSTANT
(IPLUS (INDEXF (fetch (
RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION
of T]
BYTESPERWORD]
(freplace CBUFPTR of STREAM with NEXTPACKET]
T)
(WRITE (COND
((NEQ (fetch COFFSET of STREAM)
(CONSTANT (UNFOLD (IPLUS (INDEXF (fetch (RS232C.ENCAPSULATION RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION of T)))
BYTESPERWORD)))
(\RS232C.FORCEOUTPUT STREAM)))
(freplace CBUFSIZE of STREAM with (freplace CBUFMAXSIZE of STREAM with
\RS232C.OUTPUT.PACKET.LENGTH
))
(freplace COFFSET of STREAM with (CONSTANT (UNFOLD (IPLUS (INDEXF (fetch (
RS232C.ENCAPSULATION
RS232C.DATA
)
of T))
(INDEXF (fetch
EPENCAPSULATION
of T)))
BYTESPERWORD)))
(freplace CBUFPTR of STREAM with (SETQ NEXTPACKET (\ALLOCATE.ETHERPACKET)))
(freplace EPREQUEUE of NEXTPACKET with 'FREE)
T)
(ERROR "Illegal stream operation " WHATFOR])
(\RS232C.BACKFILEPTR
[LAMBDA (STREAM NBYTES) (* ejs%: " 8-Jul-85 12:11")
(* * Back up the RS232 stream by NBYTES (Default = 1))
(LET [(BYTEDEFICIT (IDIFFERENCE (IDIFFERENCE (fetch COFFSET of STREAM)
(OR NBYTES (SETQ NBYTES 1)))
(UNFOLD [CONSTANT (IPLUS (INDEXF (fetch (RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION of T]
BYTESPERWORD]
(COND
((AND (READONLY STREAM)
(NOT (ffetch (RS232C.STREAM DID.BACKFILEPTR) of STREAM)))
(COND
[(ILESSP BYTEDEFICIT 0)
(* There aren't enough bytes in the front of the buffer to backup, so use the
last buffer)
(COND
([AND (ffetch (RS232C.STREAM LASTBUFFER) of STREAM)
(IGEQ BYTEDEFICIT (IDIFFERENCE
(UNFOLD [CONSTANT (IPLUS (INDEXF (fetch (
RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION
of T]
BYTESPERWORD)
(ffetch (RS232C.STREAM LASTBUFFER.CBUFSIZE) of STREAM]
(* There is an old buffer)
(UNINTERRUPTABLY
(swap (ffetch CBUFPTR of STREAM)
(ffetch (RS232C.STREAM LASTBUFFER) of STREAM))
(swap (ffetch CBUFSIZE of STREAM)
(ffetch (RS232C.STREAM LASTBUFFER.CBUFSIZE) of STREAM))
(freplace COFFSET of STREAM with (IPLUS (ffetch CBUFSIZE of STREAM)
BYTEDEFICIT))
(freplace (RS232C.STREAM DID.BACKFILEPTR) of STREAM with T)
T))
(T
(* Either there is no old packet (we're reading the first one)%, or we would
have had to back up past more than one packet)
(\IS.NOT.RANDACCESSP STREAM]
(T (* The easy case. Just back off the
buffer offset)
(add (ffetch COFFSET of STREAM)
(IMINUS NBYTES))
T)))
(T
(* Either stream is open for write/append, or we've already done one
backfileptr)
(\IS.NOT.RANDACCESSP STREAM])
(\RS232C.GETFILENAME
[LAMBDA (NAME RECOG DEVICE) (* ejs%: "29-Aug-85 23:59")
NAME])
(\RS232C.GETFILEINFO
[LAMBDA (NAME.OR.STREAM ATTR DEVICE) (* ; "Edited 3-Dec-86 02:47 by lmm")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.GET.PARAMETER ATTR))
(\DAYBREAK (\DVRS232C.GET.PARAMETER ATTR))
(\NOMACHINETYPE])
(\RS232C.SETFILEINFO
[LAMBDA (NAME.OR.STREAM ATTR VALUE DEVICE) (* ; "Edited 3-Dec-86 23:53 by lmm")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.SET.PARAMETERS (LIST (CONS ATTR VALUE))))
(\DAYBREAK (\DVRS232C.SET.PARAMETERS (LIST (CONS ATTR VALUE))))
(\NOMACHINETYPE])
(\RS232C.READP
[LAMBDA (STREAM) (* ; "Edited 29-May-87 15:46 by Snow")
(* ;; "Return T if there is something in the input buffer. It BLOCKS to allow the main process to notice a change in state. ")
(BLOCK)
(OR (ILESSP (FETCH (STREAM COFFSET) OF STREAM)
(FETCH (STREAM CBUFSIZE) OF STREAM))
(NOT (\PAGEDEOFP STREAM))
(FFETCH (RS232C.STREAM DID.BACKFILEPTR) OF STREAM)
(\QUEUEHEAD (FETCH (RS232C.STREAM PACKET.QUEUE) OF STREAM])
(\RS232C.OPENFILE
[LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* hdj "25-Jun-86 17:57")
(COND
((NOT \RS232C.READY)
(RS232C.INIT)))
[COND
(PARAMETERS (RS232C.SET.PARAMETERS (for PAIR in PARAMETERS collect (CONS (CAR PAIR)
(CADR PAIR]
(COND
((NEQ DEVICE (\DTEST \RS232C.FDEV 'FDEV))
(ERROR "RS232C device doesn't agree with DEVICE argument to \RS232C.OPENFILE!" DEVICE)))
(SELECTQ ACCESS
(INPUT [COND
((fetch (RS232C.DEVICEINFO INSTREAM) of (fetch (FDEV DEVICEINFO) of DEVICE))
(printout RS232C.ERROR.STREAM T "RS232C port is busy on input" T)
(ERRORX '(9 {RS232}])
(OUTPUT [COND
((fetch (RS232C.DEVICEINFO OUTSTREAM) of (fetch (FDEV DEVICEINFO) of DEVICE))
(printout RS232C.ERROR.STREAM T "RS232C port is busy on output" T)
(ERRORX '(9 {RS232}])
(BOTH [COND
((OR (fetch (RS232C.DEVICEINFO INSTREAM) of (fetch (FDEV DEVICEINFO) of DEVICE))
(fetch (RS232C.DEVICEINFO OUTSTREAM) of (fetch (FDEV DEVICEINFO) of DEVICE)))
(printout RS232C.ERROR.STREAM T "RS232C port is busy on input or output" T)
(ERRORX '(9 {RS232}])
(\ILLEGAL.ARG ACCESS))
(LET* [(DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
[INSTREAM (COND
((FMEMB ACCESS '(INPUT BOTH))
(replace (RS232C.DEVICEINFO INSTREAM) of DEVINFO
with (create STREAM
DEVICE ← DEVICE
ACCESS ← 'INPUT
COFFSET ← 0
CBUFSIZE ← 0]
(OUTSTREAM (COND
((FMEMB ACCESS '(OUTPUT APPEND BOTH))
(replace (RS232C.DEVICEINFO OUTSTREAM) of DEVINFO
with (create STREAM
DEVICE ← DEVICE
ACCESS ← 'OUTPUT
COFFSET ← 0
CBUFSIZE ← 0
CBUFMAXSIZE ← 0]
(COND
(INSTREAM (replace (RS232C.STREAM EVENT) of INSTREAM with (CREATE.EVENT))
(replace (RS232C.STREAM PACKET.QUEUE) of INSTREAM with (create SYSQUEUE))
(replace (RS232C.STREAM QUEUE.LENGTH) of INSTREAM with 0)
(replace (STREAM MAXBUFFERS) of INSTREAM with \RS232C.MAX.INPUT.BUFFERS)))
[COND
(OUTSTREAM (replace (RS232C.STREAM EVENT) of OUTSTREAM with (CREATE.EVENT]
(SELECTQ ACCESS
((INPUT BOTH)
INSTREAM)
((OUTPUT APPEND)
OUTSTREAM)
(\ILLEGAL.ARG ACCESS])
(\RS232C.CLOSEFILE
[LAMBDA (STREAM) (* hdj "25-Jun-86 17:56")
(LET* ((DEVICE (fetch (STREAM DEVICE) of STREAM))
(DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE)))
(SELECTQ (fetch (STREAM ACCESS) of STREAM)
(INPUT (bind PACKET (QUEUE ← (fetch (RS232C.STREAM PACKET.QUEUE) of STREAM))
while (SETQ PACKET (\DEQUEUE QUEUE)) do (add (fetch (RS232C.STREAM
QUEUE.LENGTH)
of STREAM)
-1)
(\RELEASE.ETHERPACKET PACKET))
(replace (RS232C.DEVICEINFO INSTREAM) of DEVINFO with NIL))
(PROGN (\RS232C.FORCEOUTPUT STREAM)
(replace (RS232C.DEVICEINFO OUTSTREAM) of DEVINFO with NIL)))
(replace (STREAM ACCESS) of STREAM with NIL)
STREAM])
(\RS232C.TRACE.PACKET
[LAMBDA (PACKET FORWHAT) (* ; "Edited 3-Jun-87 10:11 by Snow")
(COND
((TYPENAMEP PACKET 'ETHERPACKET)
(SELECTQ RS232C.TRACEFLG
(T (printout RS232C.TRACEFILE T FORWHAT ": ")
[bind CH for CHINDEX from [CONSTANT (TIMES BYTESPERWORD
(IPLUS (INDEXF (fetch (RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION
of T]
to [SUB1 (IPLUS (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET)
(CONSTANT (TIMES BYTESPERWORD (IPLUS (INDEXF (fetch (
RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION
of T]
do (SETQ CH (\GETBASEBYTE PACKET CHINDEX))
(COND
((< (LOGAND CH 127)
(CHARCODE SPACE))
(CL:FORMAT RS232C.TRACEFILE "[~a]" CH))
(T (CL:WRITE-CHAR (CL:INT-CHAR CH)
RS232C.TRACEFILE])
(PEEK (PRIN1 (SELECTQ FORWHAT
(INPUT "+")
"!")
RS232C.TRACEFILE))
NIL])
)
(* ; "User functions")
(DECLARE%: EVAL@COMPILE
(RECORD RS232C.INIT (BaudRate BitsPerSerialChar Parity NoOfStopBits FlowControl))
(RECORD RS232C.XONXOFF (FLAG XON.CHAR XOFF.CHAR))
)
(RPAQ? RS232C.ERROR.STREAM PROMPTWINDOW)
(RPAQ? RS232C.DEFAULT.INIT.INFO (create RS232C.INIT BaudRate ← 1200 BitsPerSerialChar ← 8 Parity ←
'NONE NoOfStopBits ← 1 FlowControl ←
(create RS232C.XONXOFF FLAG ← 1 XON.CHAR ← (CHARCODE ↑Q)
XOFF.CHAR ← (CHARCODE ↑S))))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS RS232C.ERROR.STREAM RS232C.DEFAULT.INIT.INFO RS232C.TRACEFLG RS232C.TRACEFILE)
)
(DEFINEQ
(RS232C.INIT
[LAMBDA (BAUDRATE BITSPERCHAR PARITY STOPBITS FLOWCONTROL)(* ; "Edited 27-Mar-87 17:52 by murage")
(* ;
"User interface to low level initialization")
(SELECTC \MACHINETYPE
(\DANDELION (COND
((NULL BAUDRATE)
(APPLY (FUNCTION \DLRS232C.INIT)
RS232C.DEFAULT.INIT.INFO))
((ZEROP BAUDRATE)
(ERROR "Invalid baudrate"))
((LISTP BAUDRATE)
(APPLY (FUNCTION \DLRS232C.INIT)
BAUDRATE))
(T (\DLRS232C.INIT BAUDRATE BITSPERCHAR PARITY STOPBITS FLOWCONTROL))))
(\DAYBREAK (COND
((NULL BAUDRATE)
(APPLY (FUNCTION \DVRS232C.INIT)
RS232C.DEFAULT.INIT.INFO))
((ZEROP BAUDRATE)
(ERROR "Invalid baudrate"))
((LISTP BAUDRATE)
(APPLY (FUNCTION \DVRS232C.INIT)
BAUDRATE))
(T (\DVRS232C.INIT BAUDRATE BITSPERCHAR PARITY STOPBITS FLOWCONTROL))))
(ERROR "RS232 is currently not supported on " (MACHINETYPE])
(RS232C.SHUTDOWN
[LAMBDA NIL (* ; "Edited 2-Dec-86 15:02 by lmm")
(COND
(\RS232FLG [RS232C.SET.PARAMETERS '((RTS)
(DTR]
(if (type? FDEV \RS232C.FDEV)
then (LET* ((DEVICE-INFO (fetch (FDEV DEVICEINFO) of \RS232C.FDEV))
(INSTREAM (fetch (RS232C.DEVICEINFO INSTREAM) of DEVICE-INFO))
(OUTSTREAM (fetch (RS232C.DEVICEINFO OUTSTREAM) of DEVICE-INFO)))
(AND (STREAMP INSTREAM)
(OPENP INSTREAM)
(\CLOSEFILE INSTREAM))
(REPLACE (RS232C.DEVICEINFO INSTREAM) of DEVICE-INFO WITH NIL)
(AND (STREAMP OUTSTREAM)
(OPENP OUTSTREAM)
(\CLOSEFILE OUTSTREAM))
(REPLACE (RS232C.DEVICEINFO OUTSTREAM) of DEVICE-INFO WITH NIL)))
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.SHUTDOWN))
(\DAYBREAK (\DVRS232C.SHUTDOWN))
NIL])
(RS232C.OTHER.STREAM
[LAMBDA (STREAM) (* ejs%: "24-Dec-85 14:00")
(SELECTQ (fetch (STREAM ACCESS) of STREAM)
(INPUT (OR (fetch (RS232C.DEVICEINFO OUTSTREAM) of (fetch (FDEV DEVICEINFO)
of (fetch (STREAM DEVICE) of STREAM)))
(\RS232C.OPENFILE '{RS232} 'OUTPUT NIL NIL (fetch (STREAM DEVICE) of STREAM))))
(OR (fetch (RS232C.DEVICEINFO INSTREAM) of (fetch (FDEV DEVICEINFO)
of (fetch (STREAM DEVICE) of STREAM)))
(\RS232C.OPENFILE '{RS232} 'INPUT NIL NIL (fetch (STREAM DEVICE) of STREAM])
(RS232C.OUTPUTSTREAM
[LAMBDA (INPUTSTREAM) (* ejs%: "24-Dec-85 14:01")
(OR [fetch (RS232C.DEVICEINFO OUTSTREAM) of (fetch (FDEV DEVICEINFO) of (\DTEST \RS232C.FDEV
'FDEV]
(\RS232C.OPENFILE '{RS232} 'OUTPUT NIL NIL \RS232C.FDEV])
(RS232C.OUTPUT.PACKET.LENGTH
[LAMBDA NEWVALUE (* ejs%: " 8-Sep-85 00:15")
(* * Return the current output packet length;
set a new one if a new value is supplied)
(PROG1 \RS232C.OUTPUT.PACKET.LENGTH (COND
((NEQ NEWVALUE 0)
(LET ((SIZE (ARG NEWVALUE 1)))
(COND
((OR (EQ SIZE 0)
(ILESSP SIZE 0))
(\ILLEGAL.ARG SIZE))
(T (SETQ \RS232C.OUTPUT.PACKET.LENGTH
(IMIN SIZE 578])
(RS232C.GET.PARAMETERS
[LAMBDA (PARAMETERLIST) (* ; "Edited 3-Dec-86 02:27 by lmm")
(for X in PARAMETERLIST collect (CONS X (GETFILEINFO (RS232C.OUTPUTSTREAM)
X])
(RS232C.SET.PARAMETERS
[LAMBDA (PARAMETERLIST) (* ejs%: "20-Apr-86 14:49")
(COND
[\RS232FLG (SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.SET.PARAMETERS PARAMETERLIST))
(\DAYBREAK (\DVRS232C.SET.PARAMETERS PARAMETERLIST))
(ERROR "RS232C is currently not supported on " (MACHINETYPE]
(T (ERROR "RS232C is not running"])
(RS232C.READP.EVENT
[LAMBDA (STREAM) (* ejs%: " 2-Jul-85 01:25")
(* * Returns an event to wait upon for characters arriving on the stream)
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
'INPUT)
(fetch (RS232C.STREAM EVENT) of STREAM))
(T (ERROR "FILE NOT OPEN" STREAM])
(RS232C.REPORT.STATUS
[LAMBDA NEWSTATUS (* ; "Edited 3-Dec-86 01:45 by lmm")
(* ;;; "Return old reporting status; set new status if NEWSTATUS was supplied")
(PROG1 \RS232C.REPORT.STATUS (COND
((EQ NEWSTATUS 1)
(SETQ \RS232C.REPORT.STATUS (ARG NEWSTATUS 1])
(RS232C.TRACE
[LAMBDA (MODE) (* edited%: "19-Sep-85 17:48")
[COND
((OR (EQ MODE T)
(EQ MODE 'PEEK))
(SETQ RS232C.TRACEFILE (CREATEW NIL "RS232 Trace File"))
(DSPFONT '(GACHA 8) RS232C.TRACEFILE)
(DSPSCROLL 'ON RS232C.TRACEFILE)
(COND
((WINDOWP RS232C.TRACEFILE)
[WINDOWPROP RS232C.TRACEFILE 'CLOSEFN (FUNCTION (LAMBDA (WINDOW)
(SETQ RS232C.TRACEFLG NIL]
(WINDOWPROP RS232C.TRACEFILE 'BUTTONEVENTFN
(FUNCTION (LAMBDA (WINDOW)
(AND (MOUSESTATE (NOT UP))
(SETQ RS232C.TRACEFLG (SELECTQ RS232C.TRACEFLG
(T (printout RS232C.TRACEFILE T
"[Tracing now peek]" T)
'PEEK)
(PEEK (printout RS232C.TRACEFILE T
"[Tracing now off]" T)
NIL)
(PROGN (printout RS232C.TRACEFILE T
"[Tracing now on]" T)
T]
(SETQ RS232C.TRACEFLG MODE])
)
(* ; "Modem control functions, compatible with old RS232")
(DEFINEQ
(RS232MODEMCONTROL
[LAMBDA NARGS (* ; "Edited 3-Dec-86 02:13 by lmm")
(* ;;; "Set some modem control signals, return old setting on RTS and DTR")
(LET [(MODEMSIGNALS (RS232C.GET.PARAMETERS '(DATA.TERMINAL.READY REQUEST.TO.SEND]
[COND
((IGEQ NARGS 1)
(RS232C.SET.PARAMETERS (for I from 1 to NARGS
collect (SELECTQ (ARG NARGS I)
(DTR '(DATA.TERMINAL.READY . T))
(RTS '(REQUEST.TO.SEND . T))
NIL) when (FMEMB (ARG NARGS I)
'(DTR RTS]
(for X in MODEMSIGNALS collect (SELECTQ (CAR X)
(DATA.TERMINAL.READY
'DTR)
(REQUEST.TO.SEND
'RTS)
NIL) when (CDR X])
(RS232MODEMSTATUSP
[LAMBDA (SPEC) (* ; "Edited 4-Dec-86 04:57 by lmm")
(* ;;; "Returns T if and/or/not boolean combination of CTS, DSR RI, RLSD (CD) is true")
(COND
[\RS232FLG (LET [(STATUS (LET ((VALUE (\RS232C.ISSUE.SHORT.COMMAND GET.STATUS)))
(SELECTC \MACHINETYPE
(\DANDELION (fetch (DLRS232C.DEVICE.STATUS STATUS)
of \IOPAGE))
(\DAYBREAK VALUE)
0]
(COND
[(NULL SPEC)
(for SIGNAL in (CONSTANT (LIST 'CTS 'DSR 'RI 'RLSD))
join (AND (\RS232C.MSP1 SIGNAL STATUS)
(LIST SIGNAL]
(T (\RS232C.MSP1 SPEC STATUS]
(T (ERROR "RS232C is not running"])
(\RS232C.MSP1
[LAMBDA (SPEC STATUS) (* ; "Edited 4-Dec-86 04:57 by lmm")
(* ;;; "Recursive subfunction of RS232MODEMSTATUSP. Does boolean combination of status flags")
(COND
[(LITATOM SPEC)
(BITTEST STATUS (SELECTQ SPEC
(CTS CLEAR.TO.SEND)
(DSR DATA.SET.READY)
(RI RING.INDICATOR)
(RLSD CARRIER.DETECT)
(\ILLEGAL.ARG SPEC]
((LISTP SPEC)
(SELECTQ (CAR SPEC)
(AND (AND (\RS232C.MSP1 (CADR SPEC)
STATUS)
(\RS232C.MSP1 (CADDR SPEC)
STATUS)))
(OR (OR (\RS232C.MSP1 (CADR SPEC)
STATUS)
(\RS232C.MSP1 (CADDR SPEC)
STATUS)))
(NOT (NOT (\RS232C.MSP1 (CADR SPEC)
STATUS)))
(\ILLEGAL.ARG SPEC])
(RS232MODIFYMODEMCONTROL
[LAMBDA (SIGNALSONLST SIGNALSOFFLST) (* ; "Edited 3-Dec-86 02:13 by lmm")
(* ;;; "Set some modem control signals, return old setting on RTS and DTR")
(LET [(MODEMSIGNALS (RS232C.GET.PARAMETERS '(DATA.TERMINAL.READY REQUEST.TO.SEND]
[RS232C.SET.PARAMETERS (APPEND (for X in SIGNALSONLST
collect (CONS (SELECTQ X
(DTR 'DATA.TERMINAL.READY)
(RTS 'REQUEST.TO.SENT)
NIL)
T))
(for X in SIGNALSOFFLST
collect (CONS (SELECTQ X
(DTR 'DATA.TERMINAL.READY)
(RTS 'REQUEST.TO.SENT)
NIL)
NIL]
(for X in MODEMSIGNALS collect (SELECTQ (CAR X)
(DATA.TERMINAL.READY
'DTR)
(REQUEST.TO.SEND
'RTS)
NIL) when (CDR X])
(RS232SENDBREAK
[LAMBDA (EXTRALONG?) (* ejs%: "20-Apr-86 14:50")
(* * Send a 0.25 or 3.5 second break)
(COND
(\RS232FLG (SELECTC \MACHINETYPE
((LIST \DAYBREAK \DANDELION)
[RESETLST [RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(\RS232C.ISSUE.SHORT.COMMAND
BREAK.OFF]
(\RS232C.ISSUE.SHORT.COMMAND BREAK.ON)
(BLOCK (COND
(EXTRALONG? 3500)
(T 250])
NIL))
(T (ERROR "RS232C is not running"])
(RS232MODEMHANGUP
[LAMBDA NIL (* ejs%: "24-Dec-85 14:59")
(LET (STATUS)
(RESETLST [RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(SETQ STATUS (RS232C.SET.PARAMETERS
'((DATA.TERMINAL.READY . T]
[RS232C.SET.PARAMETERS '((DATA.TERMINAL.READY]
(BLOCK 3000))
STATUS])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(\RS232C.CREATE.FDEV RS232C.DEFAULT.INIT.INFO)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA RS232MODEMCONTROL RS232C.REPORT.STATUS RS232C.OUTPUT.PACKET.LENGTH)
)
(PUTPROPS DLRS232C COPYRIGHT ("Xerox Corporation" 1985 1986 1987))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (11850 67864 (\DVRS232C.OUTPUT.INTERRUPT 11860 . 13632) (\DVRS232C.INPUT.INTERRUPT 13634
. 16499) (\DVRS232C.PARSE.STATUS 16501 . 21689) (\DVRS232C.ISSUE.SHORT.COMMAND 21691 . 31153) (
\DVRS232C.GATHER.STATUS 31155 . 32819) (\DVRS232C.INIT 32821 . 34463) (\DVRS232C.SET.PARAMETERS 34465
. 58743) (\DVRS232C.DEQUEUE.IOCB 58745 . 59774) (\DVRS232C.ABORT.QUEUE 59776 . 60293) (
\DVRS232C.SHUTDOWN 60295 . 62520) (\DVRS232C.GET.PARAMETER 62522 . 67862)) (82092 137748 (
\DLRS232C.ABORT.OUTPUT 82102 . 83415) (\DLRS232C.ALLOCATE.IOCBS 83417 . 86407) (\DLRS232C.CREATE.NDB
86409 . 87533) (\DLRS232C.PARSE.STATUS 87535 . 89193) (\DLRS232C.GET.PARAMETER 89195 . 92237) (
\DLRS232C.SET.PARAMETERS 92239 . 102887) (\DLRS232C.SHUTDOWN 102889 . 104847) (
\DLRS232C.FINISH.GET.AND.PUT 104849 . 105490) (\DLRS232C.GET.IOCB 105492 . 106937) (\DLRS232C.INIT
106939 . 111641) (\DLRS232C.INPUT.INTERRUPT 111643 . 114870) (\DLRS232C.ISSUE.SHORT.COMMAND 114872 .
115635) (\DLRS232C.LOADINPUTQ 115637 . 116593) (\DLRS232C.OUTPUT.INTERRUPT 116595 . 119736) (
\DLRS232C.QUEUE.INPUT.IOCB 119738 . 124284) (\DLRS232C.QUEUE.OUTPUT.IOCB 124286 . 130918) (
\DLRS232C.RELEASE.IOCB 130920 . 133199) (\DLRS232C.START.DRIVER 133201 . 135250) (\DLRS232C.STARTUP
135252 . 136344) (\DLRS232C.START.INPUT 136346 . 137044) (\DLRS232C.START.OUTPUT 137046 . 137746)) (
144304 174214 (\RS232C.ISSUE.SHORT.COMMAND 144314 . 144624) (\DLRS232C.GET.PACKET 144626 . 144868) (
\DLRS232C.SEND.PACKET 144870 . 147709) (\RS232C.HANDLE.PACKET 147711 . 149240) (\RS232C.PACKET.TIMEOUT
149242 . 149568) (\DLRS232C.WATCHER 149570 . 151343) (\RS232C.EVENTFN 151345 . 153341) (
\RS232C.CREATE.FDEV 153343 . 155812) (\RS232C.FORCEOUTPUT 155814 . 157391) (\RS232C.GETNEXTBUFFER
157393 . 162839) (\RS232C.BACKFILEPTR 162841 . 166358) (\RS232C.GETFILENAME 166360 . 166492) (
\RS232C.GETFILEINFO 166494 . 166788) (\RS232C.SETFILEINFO 166790 . 167126) (\RS232C.READP 167128 .
167717) (\RS232C.OPENFILE 167719 . 170958) (\RS232C.CLOSEFILE 170960 . 172157) (\RS232C.TRACE.PACKET
172159 . 174212)) (174940 182911 (RS232C.INIT 174950 . 176364) (RS232C.SHUTDOWN 176366 . 177667) (
RS232C.OTHER.STREAM 177669 . 178459) (RS232C.OUTPUTSTREAM 178461 . 178855) (
RS232C.OUTPUT.PACKET.LENGTH 178857 . 179731) (RS232C.GET.PARAMETERS 179733 . 180016) (
RS232C.SET.PARAMETERS 180018 . 180476) (RS232C.READP.EVENT 180478 . 180881) (RS232C.REPORT.STATUS
180883 . 181279) (RS232C.TRACE 181281 . 182909)) (182979 189231 (RS232MODEMCONTROL 182989 . 184185) (
RS232MODEMSTATUSP 184187 . 185233) (\RS232C.MSP1 185235 . 186302) (RS232MODIFYMODEMCONTROL 186304 .
187869) (RS232SENDBREAK 187871 . 188728) (RS232MODEMHANGUP 188730 . 189229)))))
STOP