(FILECREATED "10-Feb-86 11:06:56" {ERIS}<LISPCORE>LIBRARY>DLRS232C.;35 133053
changes to: (FNS \RS232C.EVENTFN)
previous date: " 1-Feb-86 12:41:37" {ERIS}<LISPCORE>LIBRARY>DLRS232C.;34)
(* Copyright (c) 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT DLRS232CCOMS)
(RPAQQ DLRS232CCOMS ((COMS (* DLion RS232 Head. Some of these ideas may port to Daybreak, others
won't. In any case, these are DLion dependant)
(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 (QUOTE 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 (QUOTE ((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)
(28880 . 14)
(38400 . 15)
(48000 . 16)
(56000 . 17)
(57600 . 18))))
(\DLRS232C.INVERSE.BAUD.RATES (QUOTE ((0 . 50)
(1 . 75)
(2 . 110)
(3 . 134.5)
(4 . 150)
(5 . 300)
(6 . 600)
(7 . 1200)
(8 . 2400)
(9 . 3600)
(10 . 4800)
(11 . 7200)
(12 . 9600)
(13 . 19200)
(14 . 28880)
(15 . 38400)
(16 . 48000)
(17 . 56000)
(18 . 57600)))))
(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.SET.PARAMETERS \DLRS232C.SHUTDOWN
\DLRS232C.FINISH.GET.AND.PUT \DLRS232C.GET.IOCB
\DLRS232C.GET.PARAMETERS \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 (* * Daybreak RS232 head. We try to thread most of the Daybreak RS232 code into the
DLion routines, probably at the expense of clarity)
(DECLARE: DONTCOPY (FILES (LOADCOMP)
DOVERS232C))
(INITVARS (\DVRS232C.BAUD.RATES (QUOTE ((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))))
(\DVRS232C.INVERSE.BAUD.RATES (QUOTE ((5000 . 50)
(3334 . 75)
(2272 . 110)
(1667 . 150)
(833 . 300)
(417 . 600)
(208 . 1200)
(138 . 1800)
(126 . 2000)
(104 . 2400)
(69 . 3600)
(52 . 4800)
(35 . 7200)
(26 . 9600)
(13 . 19200))))
(\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.GET.PARAMETERS \DVRS232C.SET.PARAMETERS \DVRS232C.DEQUEUE.IOCB
\DVRS232C.ABORT.QUEUE \DVRS232C.SHUTDOWN))
(COMS (* * More or less machine independant functions and structures. These should port to
the Daybreak)
(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 ←
(QUOTE 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 DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA RS232MODEMCONTROL
RS232C.REPORT.STATUS
RS232C.OUTPUT.PACKET.LENGTH)))))
(* DLion RS232 Head. Some of these ideas may port to Daybreak, others won't. In any case,
these are DLion dependant)
(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 (QUOTE 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 (QUOTE ((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)
(28880 . 14)
(38400 . 15)
(48000 . 16)
(56000 . 17)
(57600 . 18))))
(RPAQ? \DLRS232C.INVERSE.BAUD.RATES (QUOTE ((0 . 50)
(1 . 75)
(2 . 110)
(3 . 134.5)
(4 . 150)
(5 . 300)
(6 . 600)
(7 . 1200)
(8 . 2400)
(9 . 3600)
(10 . 4800)
(11 . 7200)
(12 . 9600)
(13 . 19200)
(14 . 28880)
(15 . 38400)
(16 . 48000)
(17 . 56000)
(18 . 57600))))
(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)
(QUOTE 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)
(QUOTE ((RESET.DATA.LOST . T)))))
(COND
((BITTEST IOPSTATUS BREAK.DETECTED)
(QUOTE ((RESET.BREAK.DETECTED . T))))))))))
(\DLRS232C.SET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: " 7-Sep-85 23:25")
(* * 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 (QUOTE XOnXOff))
(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.GET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: "20-Oct-85 13:33")
(* * PARAMETERLIST is a list of desired parameters. The values are returned in ALIST format)
(bind PLIST (CSB ←(LOCF (fetch DLRS232CPARAMETERCSBLO.11 of \IOPAGE))) for PROP
in (REVERSE PARAMETERLIST)
do (SELECTQ PROP
(FRAME.TIMEOUT (push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
FRAME.TIMEOUT)
of CSB))))
(CORRESPONDENT (push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
CORRESPONDENT)
of CSB))))
(SYNCH.CHAR (push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
SYNCH.CHAR)
of CSB))))
((STOP.BITS NoOfStopBits)
(push PLIST (CONS PROP (ADD1 (fetch (DLRS232C.PARAMETER.CSB
STOP.BITS)
of CSB)))))
((PARITY Parity)
(push PLIST (CONS PROP (SELECTC (fetch (DLRS232C.PARAMETER.CSB
PARITY)
of CSB)
(0 (QUOTE NONE))
(1 (QUOTE ODD))
(2 (QUOTE EVEN))
(QUOTE UNKNOWN)))))
((CHAR.LENGTH BitsPerSerialChar)
(push PLIST (CONS PROP (IPLUS (fetch (DLRS232C.PARAMETER.CSB
CHAR.LENGTH)
of CSB)
5))))
(SYNCH.COUNT (push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
SYNCH.COUNT)
of CSB))))
((LINE.SPEED BaudRate)
(push PLIST (CONS PROP (CDR (SASSOC (fetch (DLRS232C.PARAMETER.CSB
LINE.SPEED)
of CSB)
\DLRS232C.INVERSE.BAUD.RATES)))))
((FLOW.CONTROL FlowControl)
(push PLIST
(CONS PROP
(LET ((FCVALUE (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))))
(COND
((EQUAL FCVALUE
(CONSTANT (create RS232C.XONXOFF
FLAG ← 1
XON.CHAR ←(CHARCODE
↑Q)
XOFF.CHAR ←(CHARCODE
↑S))))
(QUOTE XOnXOff))
(T FCVALUE))))))
(RESET.RING.HEARD (push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
RESET.RING.HEARD)
of CSB))))
(RESET.BREAK.DETECTED (push PLIST (CONS PROP (fetch (
DLRS232C.PARAMETER.CSB RESET.BREAK.DETECTED) of CSB))))
(RESET.DATA.LOST (push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
RESET.DATA.LOST)
of CSB))))
((REQUEST.TO.SEND RTS)
(push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB REQUEST.TO.SEND)
of CSB))))
((DATA.TERMINAL.READY DTR)
(push PLIST (CONS PROP (fetch (DLRS232C.PARAMETER.CSB
DATA.TERMINAL.READY)
of CSB))))
(printout RS232C.ERROR.STREAM T "Unknown parameter: " PROP))
finally (RETURN PLIST))))
(\DLRS232C.INIT
(LAMBDA (BaudRate BitsPerSerialChar Parity NoOfStopBits FlowControl)
(* ejs: " 7-Sep-85 23:52")
(* * Initialize the IOP)
(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 (QUOTE INPUT))))
(\DLRS232C.PARSE.STATUS ACCEPTSTATUS (QUOTE 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 (QUOTE OUTPUT))
(COND
((AND STATUS (NEQ STATUS T)
(OR (EQ \RS232C.REPORT.STATUS T)
(EQ \RS232C.REPORT.STATUS (QUOTE OUTPUT))))
(\DLRS232C.PARSE.STATUS STATUS (QUOTE 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) (* ejs: "20-Oct-85 14:13")
(* * 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 (QUOTE 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))
(QUOTE RESTARTABLE)
(QUOTE SYSTEM)
(QUOTE AFTEREXIT)
(QUOTE DELETE)))
NDB)))
(\DLRS232C.STARTUP
[LAMBDA NIL (* ejs: "17-Oct-85 22:58")
(* * Reinitialized the various global variables)
(for VAR in (QUOTE (\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)))))
)
(* * Daybreak RS232 head. We try to thread most of the Daybreak RS232 code into the DLion
routines, probably at the expense of clarity)
(DECLARE: DONTCOPY
(FILESLOAD (LOADCOMP)
DOVERS232C)
)
(RPAQ? \DVRS232C.BAUD.RATES (QUOTE ((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? \DVRS232C.INVERSE.BAUD.RATES (QUOTE ((5000 . 50)
(3334 . 75)
(2272 . 110)
(1667 . 150)
(833 . 300)
(417 . 600)
(208 . 1200)
(138 . 1800)
(126 . 2000)
(104 . 2400)
(69 . 3600)
(52 . 4800)
(35 . 7200)
(26 . 9600)
(13 . 19200))))
(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 (QUOTE DoveIO.OpieAddressBox)
(QUOTE RESOURCES)
(QUOTE (NEW (\CREATECELL \FIXP))))
)
(DEFINEQ
(\DVRS232C.OUTPUT.INTERRUPT
(LAMBDA (NDB) (* ejs: "24-Dec-85 14:14")
(* * 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 (QUOTE 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) (* ejs: "28-Dec-85 19:55")
(LET ((rsIOCBType (fetch (Dove.RS232IOCB rsIOCBType) of IOCB)))
(LET [(STATUS (SELECTC (fetch (Dove.RS232IOCB currentOpStatus) of IOCB)
(IOCBpollRxOrTx (QUOTE PollRxOrTx))
(IOCBaborted (QUOTE Aborted))
(IOCBdisaster (QUOTE Disaster))
[IOCBframeTimeout (COND
((EQ rsIOCBType rsIOCBTypeRx)
T)
(T (QUOTE 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)))
(QUOTE DataLost))
((fetch (Dove.i8274.RR1 rxOverrunError)
of rsIocbSB1Base)
(QUOTE DataLost))
((fetch (Dove.i8274.RR1 parityError)
of rsIocbSB1Base)
(QUOTE ParityError))
((fetch (Dove.i8274.RR1 crcFramingError)
of rsIocbSB1Base)
(COND
((EQ (fetch (Dove.RS232DCB
rs232Mode)
of \DoveRS232C.DCBPointer)
asynchMode)
(QUOTE asynchFramingError))
((fetch (Dove.i8274.RR1
endOfFrameSDLCMode)
of rsIocbSB1Base)
(QUOTE checksumError))
(T T)))
(T T]
(QUOTE Disaster]
[COND
((AND (NEQ STATUS T)
(NEQ STATUS (QUOTE Aborted))
STATUS)
(COND
((EQ \RS232C.REPORT.STATUS T)
(printout RS232C.ERROR.STREAM T "RS232 error: " STATUS T))
((AND (EQ \RS232C.REPORT.STATUS (QUOTE OUTPUT))
(EQ rsIOCBType rsIOCBTypeTx))
(printout RS232C.ERROR.STREAM T "RS232 error: " STATUS T))
((AND (EQ \RS232C.REPORT.STATUS (QUOTE INPUT))
(EQ rsIOCBType rsIOCBTypeRx))
(printout RS232C.ERROR.STREAM T "RS232 error: " STATUS T]
STATUS])
(\DVRS232C.ISSUE.SHORT.COMMAND
(LAMBDA (COMMAND) (* ejs: "17-Oct-85 23:19")
(* * 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.FAST.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 (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 (replace (Dove.i8274.WR3 rxEnable)
of (LOCF (fetch (Dove.RS232DCB rsWR3ofi8274)
of \DoveRS232C.DCBPointer))
with T)
(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)
(* ejs: "17-Oct-85 23:09")
(* * 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)
(\DVRS232C.SET.PARAMETERS (BQUOTE ((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 . T)
(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))
(\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)))
(\DVRS232C.GET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: "25-Oct-85 21:19")
(* * PARAMETERLIST is a list of desired parameters. The values are returned in ALIST format)
(bind PLIST for PROP in (REVERSE PARAMETERLIST)
do (SELECTQ PROP
(FRAME.TIMEOUT (push PLIST (CONS PROP (\DoveIO.ByteSwap
(fetch (Dove.RS232DCB
rsFrameTimeoutValue)
of \DoveRS232C.DCBPointer)))))
(CORRESPONDENT (* Not really supported on Daybreak)
(push PLIST (CONS PROP (COND
((EQ (fetch (Dove.RS232DCB
rsTTYHost)
of \DoveRS232C.DCBPointer)
\DoveIO.ByteTRUE)
RS232C.CP.TTYHOST)
(T -1)))))
(SYNCH.CHAR (* Not supported on Daybreak)
(push PLIST (CONS PROP NIL)))
((STOP.BITS NoOfStopBits)
(push PLIST (CONS PROP (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)
(push PLIST (CONS PROP (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 (QUOTE EVEN))
(parityOdd (QUOTE ODD))
(QUOTE UNKNOWN)))
(T (QUOTE NONE))))))
((CHAR.LENGTH BitsPerSerialChar)
(push PLIST (CONS PROP (IPLUS (fetch (Dove.i8274.WR5 txCharLength)
of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of
\DoveRS232C.DCBPointer)))
5))))
(SYNCH.COUNT (* Not supported on Daybreak)
(push PLIST (CONS PROP 0)))
((LINE.SPEED BaudRate)
(push PLIST (CONS PROP (CDR (SASSOC (\DoveIO.ByteSwap
(fetch (Dove.RS232DCB
rsBaudRateChA)
of \DoveRS232C.DCBPointer)
)
\DVRS232C.INVERSE.BAUD.RATES)))))
((FLOW.CONTROL FlowControl)
(push PLIST
(CONS PROP
(LET ((FCVALUE (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)))))
)
(COND
((EQUAL FCVALUE
(CONSTANT (create RS232C.XONXOFF
FLAG ← 1
XON.CHAR ←(CHARCODE
↑Q)
XOFF.CHAR ←(CHARCODE
↑S))))
(QUOTE XOnXOff))
(T FCVALUE))))))
((RING.HEARD RESET.RING.HEARD)
(push PLIST (CONS PROP (fetch (Dove.RSLatchedStatus ringHeard)
of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of \DoveRS232C.DCBPointer))))))
((BREAK.DETECTED RESET.BREAK.DETECTED)
(push PLIST (CONS PROP (fetch (Dove.RSLatchedStatus breakDetected)
of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of \DoveRS232C.DCBPointer))))))
((DATA.LOST RESET.DATA.LOST)
(push PLIST (CONS PROP (fetch (Dove.RSLatchedStatus dataLost)
of (LOCF (fetch (Dove.RS232DCB
rsLatchedStatus)
of \DoveRS232C.DCBPointer))))))
((REQUEST.TO.SEND RTS)
(push PLIST (CONS PROP (fetch (Dove.i8274.WR5 rts)
of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of \DoveRS232C.DCBPointer))))))
((DATA.TERMINAL.READY DTR)
(push PLIST (CONS PROP (fetch (Dove.i8274.WR5 dtr)
of (LOCF (fetch (Dove.RS232DCB
rsWR5ofi8274)
of \DoveRS232C.DCBPointer))))))
(printout RS232C.ERROR.STREAM T "Unknown parameter: " PROP))
finally (RETURN PLIST))))
(\DVRS232C.SET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: "16-Nov-85 16:51")
(* * PARAMETERLIST is in property list format. This function sets the parameters of the IOP accordingly)
(COND
(PARAMETERLIST
(bind (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)
(2 twoStopBits)
(\ILLEGAL.ARG 0)))
(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)
(2 twoStopBits)
(\ILLEGAL.ARG 0))))))
((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))))
(QUOTE NONE))
((EQ (fetch (Dove.i8274.WR4 enableParity)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer)))
parityOdd)
(QUOTE ODD))
((EQ (fetch (Dove.i8274.WR4 enableParity)
of (LOCF (fetch (Dove.RS232DCB rsWR4ofi8274)
of \DoveRS232C.DCBPointer)))
parityEven)
(QUOTE EVEN))))
(SETQ MAJORFLG T)
(SETQ rsWorkListImage (BITSET rsWorkListImage rsWorkWR4))
(COND
((EQ VAL (QUOTE 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)
(SETQ VAL (IDIFFERENCE VAL 5))
(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)))
(replace (Dove.i8274.WR5 txCharLength)
of (LOCF (fetch (Dove.RS232DCB rsWR5ofi8274) of
\DoveRS232C.DCBPointer))
with VAL)
(replace (Dove.i8274.WR3 rxCharLength)
of (LOCF (fetch (Dove.RS232DCB rsWR3ofi8274) of
\DoveRS232C.DCBPointer))
with VAL))))
(SYNCH.COUNT (* Not implemented on Daybreak)
NIL)
((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 \DVRS232C.BAUD.RATES)))
(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
((EQ VAL (QUOTE XOnXOff))
(SETQ VAL (CONSTANT (create RS232C.XONXOFF
FLAG ← 1
XON.CHAR ←(CHARCODE ↑Q)
XOFF.CHAR ←(CHARCODE ↑S))))))
(COND
((LISTP VAL)
(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 (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)))))
NIL)))
NIL))
finally (COND
(COMMANDWORK (replace (Dove.RS232DCB rsCommandWorkList) of
\DoveRS232C.DCBPointer
with (\DoveIO.ByteSwap rsCommandWorkListImage))
(SETQ MAJORFLG T)))
(COND
((NOT MAJORFLG)
(RETURN T))
(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 T))))))))
(\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])
)
(* * More or less machine independant functions and structures. These should port to the
Daybreak)
(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) (* ejs: "24-Dec-85 14:10")
(PROG ((DROPIT (AND \RS232C.LIGHTNING (EQ 0 (RAND 0 \RS232C.LIGHTNING))))
IOCB BUFLENGTH)
(UNINTERRUPTABLY
(replace EPTRANSMITTING of PACKET with T)
(COND
((OR DROPIT (NULL (SETQ IOCB (\DLRS232C.GET.IOCB (QUOTE OUTPUT)))))
(* Fake transmission)
(\ENQUEUE (fetch NDBTQ of NDB)
PACKET)
(replace EPNETWORK of PACKET with NIL))
(T (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)
(QUOTE 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) (* ejs: "30-Aug-85 00:01")
(* * Creates the RS232 FDEV)
(OR (type? FDEV \RS232C.FDEV)
(\DEFINEDEVICE (QUOTE RS232)
(SETQ \RS232C.FDEV (create FDEV
DEVICENAME ←(QUOTE 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)
DEVICEINFO ←(create RS232C.DEVICEINFO)))))
(replace (RS232C.DEVICEINFO INIT) of (fetch (FDEV DEVICEINFO) of \RS232C.FDEV) with INITINFO)))
(\RS232C.FORCEOUTPUT
[LAMBDA (STREAM WAITFORFINISH) (* edited: "19-Sep-85 18:47")
(COND
((OPENP STREAM (QUOTE 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 (QUOTE 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 (QUOTE 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 (QUOTE 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) (* ejs: " 8-Jul-85 09:41")
(RS232C.GET.PARAMETERS (LIST ATTR))))
(\RS232C.SETFILEINFO
(LAMBDA (NAME.OR.STREAM ATTR VALUE DEVICE) (* ejs: " 8-Jul-85 09:41")
(RS232C.SET.PARAMETERS (LIST (CONS ATTR VALUE)))))
(\RS232C.READP
(LAMBDA (STREAM) (* ejs: " 1-Jul-85 22:44")
(* * Return T if there is something in the input buffer)
(COND
((EQ (fetch (STREAM ACCESS) of STREAM)
(QUOTE INPUT))
(COND
((ILESSP (fetch COFFSET of STREAM)
(fetch CBUFSIZE of STREAM))
T)
((\QUEUEHEAD (fetch (RS232C.STREAM PACKET.QUEUE) of STREAM))
T))))))
(\RS232C.OPENFILE
(LAMBDA (NAME ACCESS RECOG PARAMETERS DEVICE) (* ejs: "24-Dec-85 13: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 (QUOTE FDEV)))
(ERROR "RS232C device doesn't agree with DEVICE argument to \RS232C.OPENFILE!" DEVICE)))
(LET* ((DEVINFO (fetch (FDEV DEVICEINFO) of DEVICE))
(INSTREAM (COND
((FMEMB ACCESS (QUOTE (INPUT BOTH)))
(replace (RS232C.DEVICEINFO INSTREAM) of DEVINFO
with (create STREAM
DEVICE ← DEVICE
ACCESS ←(QUOTE INPUT)
COFFSET ← 0
CBUFSIZE ← 0)))))
(OUTSTREAM (COND
((FMEMB ACCESS (QUOTE (OUTPUT APPEND BOTH)))
(replace (RS232C.DEVICEINFO OUTSTREAM) of DEVINFO
with (create STREAM
DEVICE ← DEVICE
ACCESS ←(QUOTE 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) (* ejs: "24-Dec-85 14:06")
(LET ((DEVINFO (fetch (FDEV DEVICEINFO) of (fetch (STREAM DEVICE) of STREAM))))
(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: "19-Sep-85 17:53")
(COND
((TYPENAMEP PACKET (QUOTE ETHERPACKET))
(SELECTQ RS232C.TRACEFLG
[T (printout RS232C.TRACEFILE T FORWHAT ": ")
(bind CH for CHINDEX from (UNFOLD [CONSTANT (IPLUS (INDEXF (fetch (
RS232C.ENCAPSULATION RS232C.DATA) of T))
(INDEXF (fetch EPENCAPSULATION
of T]
BYTESPERWORD)
to (SUB1 (IPLUS (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET)
(UNFOLD [CONSTANT (IPLUS (INDEXF (fetch (RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION
of T]
BYTESPERWORD)))
do (SETQ CH (\GETBASEBYTE PACKET CHINDEX))
(COND
((ILESSP (LOGAND CH (MASK.1'S 0 7))
(CHARCODE SPACE))
(printout RS232C.TRACEFILE "[" CH "]"))
(T (PRIN2 (CHARACTER 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 ←
(QUOTE 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)
(* ejs: "11-Aug-85 04:01")
(* * User interface to low level initialization)
(SELECTC \MACHINETYPE
(\DANDELION (COND
((NULL BAUDRATE)
(APPLY (FUNCTION \DLRS232C.INIT)
RS232C.DEFAULT.INIT.INFO))
((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))
((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 (* ejs: " 1-Feb-86 12:41")
(RS232C.SET.PARAMETERS (QUOTE ((RTS)
(DTR))))
(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 (QUOTE {RS232})
(QUOTE 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 (QUOTE {RS232})
(QUOTE 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 (QUOTE FDEV))))
(\RS232C.OPENFILE (QUOTE {RS232})
(QUOTE 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) (* ejs: "25-Oct-85 21:19")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.GET.PARAMETERS PARAMETERLIST))
(\DAYBREAK (\DVRS232C.GET.PARAMETERS PARAMETERLIST))
(ERROR "RS232C is currently not supported on " (MACHINETYPE)))))
(RS232C.SET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: "11-Aug-85 00:31")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.SET.PARAMETERS PARAMETERLIST))
(\DAYBREAK (\DVRS232C.SET.PARAMETERS PARAMETERLIST))
(ERROR "RS232C is currently not supported on " (MACHINETYPE)))))
(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)
(QUOTE INPUT))
(fetch (RS232C.STREAM EVENT) of STREAM))
(T (ERROR "FILE NOT OPEN" STREAM)))))
(RS232C.REPORT.STATUS
(LAMBDA NEWSTATUS (* ejs: " 7-Sep-85 22:04")
(* * 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 (QUOTE PEEK)))
(SETQ RS232C.TRACEFILE (CREATEW NIL "RS232 Trace File"))
(DSPFONT (QUOTE (GACHA 8))
RS232C.TRACEFILE)
(DSPSCROLL (QUOTE ON)
RS232C.TRACEFILE)
(COND
((WINDOWP RS232C.TRACEFILE)
[WINDOWPROP RS232C.TRACEFILE (QUOTE CLOSEFN)
(FUNCTION (LAMBDA (WINDOW)
(SETQ RS232C.TRACEFLG NIL]
(WINDOWPROP RS232C.TRACEFILE (QUOTE BUTTONEVENTFN)
(FUNCTION (LAMBDA (WINDOW)
(AND (MOUSESTATE (NOT UP))
(SETQ RS232C.TRACEFLG (SELECTQ RS232C.TRACEFLG
(T (printout RS232C.TRACEFILE T
"[Tracing now peek]"
T)
(QUOTE 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 (* ejs: " 2-Jul-85 00:31")
(* * Set some modem control signals, return old setting on RTS and DTR)
(LET ((MODEMSIGNALS (RS232C.GET.PARAMETERS (QUOTE (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 (QUOTE (
DATA.TERMINAL.READY . T)))
(RTS (QUOTE (REQUEST.TO.SEND
. T)))
NIL)
when (FMEMB (ARG NARGS I)
(QUOTE (DTR RTS)))))))
(for X in MODEMSIGNALS collect (SELECTQ (CAR X)
(DATA.TERMINAL.READY (QUOTE DTR))
(REQUEST.TO.SEND (QUOTE RTS))
NIL)
when (CDR X)))))
(RS232MODEMSTATUSP
(LAMBDA (SPEC) (* ejs: "24-Dec-85 15:23")
(* * Returns T if and/or/not boolean combination of CTS, DSR RI, RLSD (CD) is true)
(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 (QUOTE CTS)
(QUOTE DSR)
(QUOTE RI)
(QUOTE RLSD)))
join (AND (\RS232C.MSP1 SIGNAL STATUS)
(LIST SIGNAL))))
(T (\RS232C.MSP1 SPEC STATUS))))))
(\RS232C.MSP1
(LAMBDA (SPEC STATUS) (* ejs: "24-Dec-85 15:23")
(* * 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) (* ejs: " 2-Jul-85 00:41")
(* * Set some modem control signals, return old setting on RTS and DTR)
(LET ((MODEMSIGNALS (RS232C.GET.PARAMETERS (QUOTE (DATA.TERMINAL.READY REQUEST.TO.SEND)))))
(RS232C.SET.PARAMETERS (APPEND (for X in SIGNALSONLST collect
(CONS (SELECTQ X
(DTR (QUOTE
DATA.TERMINAL.READY))
(RTS (QUOTE
REQUEST.TO.SENT))
NIL)
T))
(for X in SIGNALSOFFLST
collect (CONS (SELECTQ X
(DTR (QUOTE DATA.TERMINAL.READY))
(RTS (QUOTE REQUEST.TO.SENT))
NIL)
NIL))))
(for X in MODEMSIGNALS collect (SELECTQ (CAR X)
(DATA.TERMINAL.READY (QUOTE DTR))
(REQUEST.TO.SEND (QUOTE RTS))
NIL)
when (CDR X)))))
(RS232SENDBREAK
(LAMBDA (EXTRALONG?) (* ejs: "24-Dec-85 15:00")
(* * Send a .25 or 3.5 second break)
(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)))
(RS232MODEMHANGUP
(LAMBDA NIL (* ejs: "24-Dec-85 14:59")
(LET (STATUS)
(RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(SETQ STATUS (RS232C.SET.PARAMETERS
(QUOTE ((DATA.TERMINAL.READY . T)))))))))
(RS232C.SET.PARAMETERS (QUOTE ((DATA.TERMINAL.READY))))
(BLOCK 3000))
STATUS)))
)
(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))
(DECLARE: DONTCOPY
(FILEMAP (NIL (18581 59505 (\DLRS232C.ABORT.OUTPUT 18591 . 19413) (\DLRS232C.ALLOCATE.IOCBS 19415 .
21408) (\DLRS232C.CREATE.NDB 21410 . 22120) (\DLRS232C.PARSE.STATUS 22122 . 23244) (
\DLRS232C.SET.PARAMETERS 23246 . 29025) (\DLRS232C.SHUTDOWN 29027 . 30538) (
\DLRS232C.FINISH.GET.AND.PUT 30540 . 31170) (\DLRS232C.GET.IOCB 31172 . 32378) (
\DLRS232C.GET.PARAMETERS 32380 . 35753) (\DLRS232C.INIT 35755 . 39598) (\DLRS232C.INPUT.INTERRUPT
39600 . 42268) (\DLRS232C.ISSUE.SHORT.COMMAND 42270 . 42994) (\DLRS232C.LOADINPUTQ 42996 . 43706) (
\DLRS232C.OUTPUT.INTERRUPT 43708 . 46006) (\DLRS232C.QUEUE.INPUT.IOCB 46008 . 49446) (
\DLRS232C.QUEUE.OUTPUT.IOCB 49448 . 53768) (\DLRS232C.RELEASE.IOCB 53770 . 55570) (
\DLRS232C.START.DRIVER 55572 . 57359) (\DLRS232C.STARTUP 57361 . 58195) (\DLRS232C.START.INPUT 58197
. 58848) (\DLRS232C.START.OUTPUT 58850 . 59503)) (60818 96071 (\DVRS232C.OUTPUT.INTERRUPT 60828 .
62199) (\DVRS232C.INPUT.INTERRUPT 62201 . 64447) (\DVRS232C.PARSE.STATUS 64449 . 66781) (
\DVRS232C.ISSUE.SHORT.COMMAND 66783 . 72029) (\DVRS232C.GATHER.STATUS 72031 . 73631) (\DVRS232C.INIT
73633 . 75103) (\DVRS232C.GET.PARAMETERS 75105 . 80298) (\DVRS232C.SET.PARAMETERS 80300 . 93131) (
\DVRS232C.DEQUEUE.IOCB 93133 . 94089) (\DVRS232C.ABORT.QUEUE 94091 . 94563) (\DVRS232C.SHUTDOWN 94565
. 96069)) (101365 121994 (\RS232C.ISSUE.SHORT.COMMAND 101375 . 101688) (\DLRS232C.GET.PACKET 101690
. 101923) (\DLRS232C.SEND.PACKET 101925 . 103936) (\RS232C.HANDLE.PACKET 103938 . 105080) (
\RS232C.PACKET.TIMEOUT 105082 . 105394) (\DLRS232C.WATCHER 105396 . 106700) (\RS232C.EVENTFN 106702 .
108022) (\RS232C.CREATE.FDEV 108024 . 109947) (\RS232C.FORCEOUTPUT 109949 . 111151) (
\RS232C.GETNEXTBUFFER 111153 . 114576) (\RS232C.BACKFILEPTR 114578 . 117047) (\RS232C.GETFILENAME
117049 . 117176) (\RS232C.GETFILEINFO 117178 . 117344) (\RS232C.SETFILEINFO 117346 . 117529) (
\RS232C.READP 117531 . 118004) (\RS232C.OPENFILE 118006 . 119889) (\RS232C.CLOSEFILE 119891 . 120758)
(\RS232C.TRACE.PACKET 120760 . 121992)) (122627 128227 (RS232C.INIT 122637 . 123606) (RS232C.SHUTDOWN
123608 . 123919) (RS232C.OTHER.STREAM 123921 . 124705) (RS232C.OUTPUTSTREAM 124707 . 125079) (
RS232C.OUTPUT.PACKET.LENGTH 125081 . 125618) (RS232C.GET.PARAMETERS 125620 . 125980) (
RS232C.SET.PARAMETERS 125982 . 126336) (RS232C.READP.EVENT 126338 . 126736) (RS232C.REPORT.STATUS
126738 . 127091) (RS232C.TRACE 127093 . 128225)) (128291 132771 (RS232MODEMCONTROL 128301 . 129164) (
RS232MODEMSTATUSP 129166 . 129923) (\RS232C.MSP1 129925 . 130794) (RS232MODIFYMODEMCONTROL 130796 .
131827) (RS232SENDBREAK 131829 . 132337) (RS232MODEMHANGUP 132339 . 132769)))))
STOP