(FILECREATED " 4-Jul-85 18:03:43" {ERIS}<LISPCORE>LIBRARY>DLRS232C.;9 68334
changes to: (FNS \DLRS232C.PARSE.STATUS \DLRS232C.SET.PARAMETERS)
(VARS DLRS232CCOMS \DLRS232C.IOCB.STATUS.CODES)
previous date: " 2-Jul-85 15:35:29" {ERIS}<LISPCORE>LIBRARY>DLRS232C.;8)
(* Copyright (c) 1985 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))
(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)
(FNS \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 (* 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.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))))
(\RS232C.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))))
(\RS232C.LIGHTNING)
(\RS232C.READY)
(\RS232C.READY.EVENT (CREATE.EVENT "RS232C is running"))
(\RS232C.FDEV)
(\RS232FLG))
(GLOBALVARS \RS232C.BAUD.RATES \RS232C.INVERSE.BAUD.RATES \RS232C.LIGHTNING
\RS232C.READY \RS232C.READY.EVENT \RS232C.FDEV \RS232FLG)
(ADDVARS (\SYSTEMCACHEVARS \RS232C.READY))
(DECLARE: DONTCOPY (EXPORT (RECORDS RS232C.ENCAPSULATION RS232C.STREAM)
(MACROS \DLRS232C.ALLOCATE.PACKET)))
(* Stream interface)
(FNS \RS232C.EVENTFN \RS232C.CREATE.FDEV \RS232C.FORCEOUTPUT \RS232C.GETNEXTBUFFER
\RS232C.READP \RS232C.OPENFILE \RS232C.CLOSEFILE \RS232C.HANDLE.PACKET
\DLRS232C.GET.PACKET \DLRS232C.SEND.PACKET \DLRS232C.WATCHER))
(COMS (* User functions)
(RECORDS RS232C.INIT RS232C.XONXOFF)
(INITVARS (RS232C.ERROR.STREAM PROMPTWINDOW)
(RS232C.DEFAULT.INIT.INFO (create RS232C.INIT BAUDRATE ← 1200 BITSPERCHAR ← 8
PARITY ← (QUOTE NONE)
STOPBITS ← 1 FLOWCONTROL ←
(create RS232C.XONXOFF FLAG ← 1 XON.CHAR ←
(CHARCODE ↑Q)
XOFF.CHAR ← (CHARCODE ↑S)))))
(GLOBALVARS RS232C.ERROR.STREAM RS232C.DEFAULT.INIT.INFO)
(FNS RS232C.INIT RS232C.OTHER.STREAM RS232C.OUTPUTSTREAM RS232C.GET.PARAMETERS
RS232C.SET.PARAMETERS RS232C.READP.EVENT))
(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)
))))
(* 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 )
(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)
)
(DEFINEQ
(\DLRS232C.ALLOCATE.IOCBS
(LAMBDA NIL (* ejs: "18-Jun-85 21:57")
(* * 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)
(COND
((NOT \DLRS232C.IOCB.PAGE)
(SETQ \DLRS232C.IOCB.PAGE (\DONEWEPHEMERALPAGE (\ADDBASE \IOPAGE (CONSTANT (IMINUS
WORDSPERPAGE)))))
(SETQ \DLRS232C.IOCB.ENDPAGE (\ADDBASE \DLRS232C.IOCB.PAGE (ITIMES (SUB1 DLRS232C.IOCB.PAGES)
WORDSPERPAGE)))))
(* * Divide the page up into a freelist of IOCB's)
(SETQ \DLRS232C.IOCB.TOTAL (QUOTIENT WORDSPERPAGE DLRS232C.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 DLRS232C.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: " 4-Jul-85 17:55")
(DECLARE (GLOBALVARS RS232C.ERROR.STREAM \DLRS232C.IOCB.STATUS.CODES))
(LET ((IOPSTATUS (\DLRS232C.ISSUE.SHORT.COMMAND GET.STATUS)))
(COND
((NUMBERP STATUS)
(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: " 4-Jul-85 17:54")
(* * 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)
(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)
(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)
(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)
(COND
((AND (SETQ VAL (CDR (SASSOC VAL \RS232C.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 (SETQ MAJORFLG T)
(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))))
(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 (replace (DLRS232C.PARAMETER.CSB REQUEST.TO.SEND)
of CSB with VAL))
(DATA.TERMINAL.READY (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: "17-Jun-85 15:04")
(* * Disables RS232C if currently running)
(LET (PACKET)
(COND
(\DLRS232C.LOCAL.NDB (SETQ \RS232C.READY NIL)
(\DLRS232C.ISSUE.SHORT.COMMAND OFF)
(DEL.PROCESS (fetch NDBWATCHER of \DLRS232C.LOCAL.NDB))
(while (SETQ PACKET (\DEQUEUE (fetch NDBIQ of \DLRS232C.LOCAL.NDB)))
do (\RELEASE.ETHERPACKET PACKET))
(while (SETQ PACKET (\DEQUEUE (fetch NDBTQ of \DLRS232C.LOCAL.NDB)))
do (\RELEASE.ETHERPACKET PACKET)))))))
(\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: "17-Jun-85 19:45")
(* 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)
(LET (IOCB)
(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 (OR (fetch (DLRS232C.IOCB NEXT) of \DLRS232C.IOCB.FREELIST)
(HELP "IOCB free list going NIL")))
(replace (DLRS232C.IOCB NEXT) of IOCB with NIL)
IOCB)))))
(\DLRS232C.GET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: " 2-Jul-85 00:09")
(* * 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)
\RS232C.INVERSE.BAUD.RATES)))))
(FLOW.CONTROL (push PLIST
(CONS PROP
(create RS232C.XONXOFF
FLAG ←(fetch
(
DLRS232C.PARAMETER.CSB FLOWCONTROL.ON) of CSB)
XON.CHAR ←(fetch
(
DLRS232C.PARAMETER.CSB FLOWCONTROL.XON.CHAR) of CSB)
XOFF.CHAR ←(fetch
(
DLRS232C.PARAMETER.CSB FLOWCONTROL.XOFF.CHAR) of CSB)))))
(RESET.RING.HEARD (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 (push PLIST
(CONS PROP (fetch (
DLRS232C.PARAMETER.CSB REQUEST.TO.SEND) of CSB))))
(DATA.TERMINAL.READY (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 BITSPERCHAR PARITY STOPBITS FLOWCONTROL)
(* ejs: "23-Jun-85 15:23")
(* * Initialize the IOP)
(COND
((NOT (fetch (DLRS232C.HDW.CONF RS232C.ABSENT) of \IOPAGE))
(\DLRS232C.SHUTDOWN)
(COND
((\DLRS232C.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 (OR (AND (OR (EQ STOPBITS 1)
(EQ STOPBITS 2))
(IDIFFERENCE STOPBITS 1))
(ERROR "ILLEGAL NUMBER OF STOP BITS (MUST BE 1 OR 2)" STOPBITS)))
(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 BITSPERCHAR 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 \RS232C.BAUD.RATES))
(ERROR "ILLEGAL BAUD RATE" 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
BITSPERCHAR ← BITSPERCHAR
PARITY ← PARITY
STOPBITS ← STOPBITS
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) (* edited: "23-Jun-85 20:13")
(* * 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))
(\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: "19-Jun-85 00:36")
(* * Poll the IOP to see if there are any output requests completed)
(LET ((PACKET (fetch SYSQUEUEHEAD of (fetch NDBTQ of NDB)))
STATUS IOCB NEXTIOCB)
(if (AND \DLRS232C.ACTIVE.PUT (NOT (fetch (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE))
(SETQ IOCB (fetch EPNETWORK of PACKET))
(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))
(\REQUEUE.ETHERPACKET PACKET)
(* (COND ((NEQ (fetch (DLRS232C.IOCB BYTE.COUNT) of IOCB) (fetch (DLRS232C.IOCB RETURNED.BYTE.COUNT) of IOCB))
(printout RS232C.ERROR.STREAM T "Tried to send " (fetch (DLRS232C.IOCB BYTE.COUNT) of IOCB) ", sent "
(fetch (DLRS232C.IOCB RETURNED.BYTE.COUNT) of IOCB)))))
(SETQ STATUS (OR (fetch (DLRS232C.IOCB SUCCESS) of IOCB)
(fetch (DLRS232C.IOCB TRANSFER.STATUS) of IOCB)))
(\DLRS232C.RELEASE.IOCB IOCB (QUOTE OUTPUT))
(\TEMPUNLOCKPAGES PACKET (FOLDHI \DLRS232C.DEFAULT.PACKET.LENGTH BYTESPERPAGE))
(COND
((AND STATUS (NEQ STATUS T))
(\DLRS232C.PARSE.STATUS STATUS (QUOTE OUT))))
STATUS))))
(\DLRS232C.QUEUE.INPUT.IOCB
(LAMBDA (IOCB BUFFER LENGTH) (* ejs: "19-Jun-85 17:46")
(* * Queue the current input request to the IOP. If the input queue is empty%, wake the IOP)
(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)))))
(\DLRS232C.QUEUE.OUTPUT.IOCB
(LAMBDA (IOCB BUFFER LENGTH) (* ejs: "19-Jun-85 00:37")
(* * 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)
(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))))))
(\DLRS232C.RELEASE.IOCB
(LAMBDA (IOCB USE) (* ejs: "17-Jun-85 18:55")
(* * Returns an IOCB to the free pool. USE is INPUT or OUTPUT, according to which side should be credited.
Must be called uninterruptably)
(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 (SELECTQ USE
(INPUT (add \DLRS232C.INPUT.IOCB.ALLOC 1))
(OUTPUT (add \DLRS232C.OUTPUT.IOCB.ALLOC 1))
(\ILLEGAL.ARG USE))
(replace (DLRS232C.IOCB NEXT) of IOCB with \DLRS232C.IOCB.FREELIST)
(SETQ \DLRS232C.IOCB.FREELIST IOCB)
NIL))))
(\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-Jun-85 17:56")
(* * 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))))
(\DLRS232C.START.INPUT
(LAMBDA (IOCB) (* ejs: "15-Jun-85 23:45")
(* * Start IOP input on the RS232C port)
(until (OR (NULL IOCB)
\DLRS232C.ACTIVE.GET
(fetch (DLRS232C.IOP.GET.FLAG BUSY) of \IOPAGE))
do (if (NOT (fetch (DLRS232C.IOCB COMPLETED) of IOCB))
then (replace DLRS232C.GET.CSB of \IOPAGE with IOCB)
(replace (DLRS232C.IOP.GET.FLAG BUSY) of \IOPAGE with T)
(SETQ \DLRS232C.ACTIVE.GET IOCB))
(SETQ IOCB (fetch (DLRS232C.IOCB NEXT) of IOCB)))))
(\DLRS232C.START.OUTPUT
(LAMBDA (IOCB) (* ejs: "17-Jun-85 20:07")
(* * Start IOP output on the RS232C port)
(until (OR (NULL IOCB)
\DLRS232C.ACTIVE.PUT
(fetch (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE))
do (if (NOT (fetch (DLRS232C.IOCB COMPLETED) of IOCB))
then (replace DLRS232C.PUT.CSB of \IOPAGE with IOCB)
(replace (DLRS232C.IOP.PUT.FLAG BUSY) of \IOPAGE with T)
(SETQ \DLRS232C.ACTIVE.PUT IOCB))
(SETQ IOCB (fetch (DLRS232C.IOCB NEXT) of IOCB)))))
)
(* More or less machine independant functions and structures. 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))))
]
(RPAQ? \RS232C.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? \RS232C.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))))
(RPAQ? \RS232C.LIGHTNING )
(RPAQ? \RS232C.READY )
(RPAQ? \RS232C.READY.EVENT (CREATE.EVENT "RS232C is running"))
(RPAQ? \RS232C.FDEV )
(RPAQ? \RS232FLG )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \RS232C.BAUD.RATES \RS232C.INVERSE.BAUD.RATES \RS232C.LIGHTNING \RS232C.READY
\RS232C.READY.EVENT \RS232C.FDEV \RS232FLG)
)
(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))))
]
(DECLARE: EVAL@COMPILE
(PUTPROPS \DLRS232C.ALLOCATE.PACKET MACRO (= . \ALLOCATE.ETHERPACKET))
)
(* END EXPORTED DEFINITIONS)
)
(* Stream interface)
(DEFINEQ
(\RS232C.EVENTFN
(LAMBDA (DEVICE EVENT) (* ejs: "19-Jun-85 17:50")
(SELECTQ EVENT
((AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
(COND
((AND \RS232FLG (NOT (fetch (DLRS232C.HDW.CONF RS232C.ABSENT) of \IOPAGE)))
(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))))
(APPLY (FUNCTION \DLRS232C.INIT)
(OR (AND \RS232C.FDEV (fetch (RS232C.DEVICEINFO INIT)
of (fetch (FDEV DEVICEINFO) of \RS232C.FDEV)))
RS232C.DEFAULT.INIT.INFO)))))))
NIL)))
(\RS232C.CREATE.FDEV
(LAMBDA (INITINFO) (* ejs: " 1-Jul-85 22:53")
(* * 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
CLOSEFILE ←(FUNCTION \RS232C.CLOSEFILE)
DELETEFILE ←(FUNCTION NILL)
EVENTFN ←(FUNCTION \RS232C.EVENTFN)
GENERATEFILES ←(FUNCTION \GENERATENOFILES)
GETFILEINFO ←(FUNCTION NILL)
SETFILEINFO ←(FUNCTION NILL)
GETFILENAME ←(FUNCTION NILL)
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)
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) (* ejs: "17-Jun-85 18:39")
(COND
((OPENP STREAM (QUOTE OUTPUT))
(LET ((PACKET (fetch (STREAM CBUFPTR) 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))))
(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))))))))
(\RS232C.GETNEXTBUFFER
(LAMBDA (STREAM WHATFOR NOERRORFLG) (* ejs: " 1-Jul-85 23:01")
(LET ((QUEUE (fetch (RS232C.STREAM PACKET.QUEUE) of STREAM))
(EVENT (fetch (RS232C.STREAM EVENT) of STREAM))
(OLDPACKET (fetch (STREAM CBUFPTR) of STREAM))
NEXTPACKET)
(SELECTQ WHATFOR
(READ (COND
(OLDPACKET (\RELEASE.ETHERPACKET OLDPACKET)
(replace CBUFPTR of STREAM with NIL)
(replace COFFSET of STREAM with (replace CBUFSIZE of STREAM
with 0))))
(until (SETQ NEXTPACKET (\DEQUEUE QUEUE)) do (AWAIT.EVENT EVENT)
finally (replace CBUFSIZE of STREAM
with
(IPLUS (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of NEXTPACKET)
(replace COFFSET of STREAM
with (UNFOLD (CONSTANT
(IPLUS (INDEXF (fetch (
RS232C.ENCAPSULATION RS232C.DATA) of T))
(INDEXF (fetch EPENCAPSULATION
of T))))
BYTESPERWORD))))
(replace 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)))
(replace CBUFSIZE of STREAM with (replace CBUFMAXSIZE of STREAM with
\DLRS232C.DEFAULT.PACKET.LENGTH))
(replace COFFSET of STREAM
with (CONSTANT (UNFOLD (IPLUS (INDEXF (fetch (RS232C.ENCAPSULATION
RS232C.DATA)
of T))
(INDEXF (fetch EPENCAPSULATION of T)))
BYTESPERWORD)))
(replace CBUFPTR of STREAM with (SETQ NEXTPACKET (\ALLOCATE.ETHERPACKET)))
(replace EPREQUEUE of NEXTPACKET with (QUOTE FREE))
T)
(ERROR "Illegal stream operation " WHATFOR)))))
(\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: " 1-Jul-85 22:28")
(COND
((NOT \RS232C.READY)
(RS232C.INIT)))
(COND
(PARAMETERS (RS232C.SET.PARAMETERS PARAMETERS)))
(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 (replace (RS232C.DEVICEINFO INSTREAM) of DEVINFO
with (create STREAM
DEVICE ← DEVICE
ACCESS ←(QUOTE INPUT)
COFFSET ← 0
CBUFSIZE ← 0)))
(OUTSTREAM (replace (RS232C.DEVICEINFO OUTSTREAM) of DEVINFO
with (create STREAM
DEVICE ← DEVICE
ACCESS ←(QUOTE OUTPUT)
COFFSET ← 0
CBUFSIZE ← 0
CBUFMAXSIZE ← 0))))
(replace (RS232C.STREAM EVENT) of INSTREAM with (CREATE.EVENT))
(replace (RS232C.STREAM PACKET.QUEUE) of INSTREAM with (create SYSQUEUE))
(replace (RS232C.STREAM EVENT) of OUTSTREAM with (CREATE.EVENT))
(replace (RS232C.STREAM PACKET.QUEUE) of OUTSTREAM with (create SYSQUEUE))
(SELECTQ ACCESS
(INPUT INSTREAM)
OUTSTREAM))))
(\RS232C.CLOSEFILE
(LAMBDA (STREAM) (* ejs: " 1-Jul-85 22:52")
(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 (\RELEASE.ETHERPACKET PACKET))
(replace (RS232C.DEVICEINFO INSTREAM) of DEVINFO with NIL))
(replace (RS232C.DEVICEINFO OUTSTREAM) of DEVINFO with NIL))
(replace (STREAM ACCESS) of STREAM with NIL)
STREAM)))
(\RS232C.HANDLE.PACKET
(LAMBDA (PACKET) (* ejs: " 1-Jul-85 22:47")
(* * 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)))
PACKET.QUEUE)
(COND
((AND (type? STREAM INSTREAM)
(type? SYSQUEUE (SETQ PACKET.QUEUE (fetch (RS232C.STREAM PACKET.QUEUE)
of INSTREAM)))
(EQ (fetch (STREAM ACCESS) of INSTREAM)
(QUOTE INPUT))
(NEQ 0 (fetch (RS232C.ENCAPSULATION RS232C.LENGTH) of PACKET)))
(\ENQUEUE PACKET.QUEUE PACKET)
(NOTIFY.EVENT (fetch (RS232C.STREAM EVENT) of INSTREAM)))
(T (\RELEASE.ETHERPACKET PACKET)))))
(T (\RELEASE.ETHERPACKET PACKET)))))
(\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) (* ejs: "19-Jun-85 00:41")
(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))) (* Put on microcode queue)
(\ENQUEUE (fetch NDBTQ of NDB)
PACKET)
(\DLRS232C.QUEUE.OUTPUT.IOCB IOCB (fetch (RS232C.ENCAPSULATION RS232C.PACKET.BASE)
of PACKET)
BUFLENGTH)
T)) (* Put on driver's queue to pick up after microcode
finishes with it)
)
(RETURN (AND IOCB T)))))
(\DLRS232C.WATCHER
(LAMBDA (NDB) (* ejs: "17-Jun-85 17:04")
(* * Process that watches the RS232C port. Passes received packets to interested party)
(DECLARE (GLOBALVARS \MAXWATCHERGETS))
(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))))
)
(* User functions)
[DECLARE: EVAL@COMPILE
(RECORD RS232C.INIT (BAUDRATE BITSPERCHAR PARITY STOPBITS FLOWCONTROL))
(RECORD RS232C.XONXOFF (FLAG XON.CHAR XOFF.CHAR))
]
(RPAQ? RS232C.ERROR.STREAM PROMPTWINDOW)
(RPAQ? RS232C.DEFAULT.INIT.INFO (create RS232C.INIT BAUDRATE ← 1200 BITSPERCHAR ← 8 PARITY ←
(QUOTE NONE)
STOPBITS ← 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)
)
(DEFINEQ
(RS232C.INIT
(LAMBDA (BAUDRATE BITSPERCHAR PARITY STOPBITS FLOWCONTROL)
(* ejs: " 2-Jul-85 15:13")
(* * 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))))
(ERROR "RS232 is currently not supported on " (MACHINETYPE)))))
(RS232C.OTHER.STREAM
(LAMBDA (STREAM) (* ejs: " 1-Jul-85 22:30")
(SELECTQ (fetch (STREAM ACCESS) of STREAM)
(INPUT (fetch (RS232C.DEVICEINFO OUTSTREAM) of (fetch (FDEV DEVICEINFO)
of (fetch (STREAM DEVICE)
of STREAM))))
(fetch (RS232C.DEVICEINFO INSTREAM) of (fetch (FDEV DEVICEINFO)
of (fetch (STREAM DEVICE) of STREAM))))))
(RS232C.OUTPUTSTREAM
(LAMBDA (INPUTSTREAM) (* ejs: "17-Jun-85 18:40")
(fetch (RS232C.DEVICEINFO OUTSTREAM) of (fetch (FDEV DEVICEINFO) of (\DTEST \RS232C.FDEV
(QUOTE FDEV))))))
(RS232C.GET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: " 1-Jul-85 21:53")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.GET.PARAMETERS PARAMETERLIST))
(ERROR "RS232C is currently not supported on " (MACHINETYPE)))))
(RS232C.SET.PARAMETERS
(LAMBDA (PARAMETERLIST) (* ejs: " 1-Jul-85 21:55")
(SELECTC \MACHINETYPE
(\DANDELION (\DLRS232C.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)))))
)
(* 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: " 2-Jul-85 01:02")
(* * Returns T if and/or/not boolean combination of CTS, DTR, RI, RLSD (CD) is true)
(LET ((STATUS (PROGN (\DLRS232C.ISSUE.SHORT.COMMAND GET.STATUS)
(fetch (DLRS232C.DEVICE.STATUS STATUS) of \IOPAGE))))
(COND
((NULL SPEC)
(for SIGNAL in (CONSTANT (LIST (QUOTE CTS)
(QUOTE DTR)
(QUOTE RI)
(QUOTE RLSD)))
join (AND (\RS232C.MSP1 SIGNAL STATUS)
(LIST SIGNAL))))
(T (\RS232C.MSP1 SPEC STATUS))))))
(\RS232C.MSP1
(LAMBDA (SPEC STATUS) (* ejs: " 2-Jul-85 01:05")
(* * Recursive subfunction of RS232MODEMSTATUSP. Does boolean combination of status flags)
(COND
((LITATOM SPEC)
(BITTEST STATUS (SELECTQ SPEC
(CTS CLEAR.TO.SEND)
(DTR 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: " 1-Jul-85 23:51")
(* * Send a .25 or 3.5 second break)
(SELECTC \MACHINETYPE
(\DANDELION (RESETLST (RESETSAVE NIL (LIST (FUNCTION (LAMBDA NIL
(\DLRS232C.ISSUE.SHORT.COMMAND BREAK.OFF))
)))
(\DLRS232C.ISSUE.SHORT.COMMAND BREAK.ON)
(BLOCK (COND
(EXTRALONG? 3500)
(T 250)))))
NIL)))
(RS232MODEMHANGUP
(LAMBDA NIL (* ejs: " 2-Jul-85 15:18")
(LET (STATUS)
(COND
((RS232MODEMSTATUSP (QUOTE DTR))
(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)
)
(PUTPROPS DLRS232C COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (14875 44476 (\DLRS232C.ALLOCATE.IOCBS 14885 . 16579) (\DLRS232C.CREATE.NDB 16581 .
17291) (\DLRS232C.PARSE.STATUS 17293 . 18335) (\DLRS232C.SET.PARAMETERS 18337 . 22918) (
\DLRS232C.SHUTDOWN 22920 . 23595) (\DLRS232C.FINISH.GET.AND.PUT 23597 . 24203) (\DLRS232C.GET.IOCB
24205 . 25150) (\DLRS232C.GET.PARAMETERS 25152 . 28157) (\DLRS232C.INIT 28159 . 31933) (
\DLRS232C.INPUT.INTERRUPT 31935 . 34468) (\DLRS232C.ISSUE.SHORT.COMMAND 34470 . 35194) (
\DLRS232C.LOADINPUTQ 35196 . 35908) (\DLRS232C.OUTPUT.INTERRUPT 35910 . 37712) (
\DLRS232C.QUEUE.INPUT.IOCB 37714 . 38787) (\DLRS232C.QUEUE.OUTPUT.IOCB 38789 . 40098) (
\DLRS232C.RELEASE.IOCB 40100 . 41021) (\DLRS232C.START.DRIVER 41023 . 42747) (\DLRS232C.STARTUP 42749
. 43166) (\DLRS232C.START.INPUT 43168 . 43819) (\DLRS232C.START.OUTPUT 43821 . 44474)) (49083 60669 (
\RS232C.EVENTFN 49093 . 50000) (\RS232C.CREATE.FDEV 50002 . 51710) (\RS232C.FORCEOUTPUT 51712 . 52647)
(\RS232C.GETNEXTBUFFER 52649 . 54845) (\RS232C.READP 54847 . 55320) (\RS232C.OPENFILE 55322 . 56684)
(\RS232C.CLOSEFILE 56686 . 57396) (\RS232C.HANDLE.PACKET 57398 . 58331) (\DLRS232C.GET.PACKET 58333 .
58566) (\DLRS232C.SEND.PACKET 58568 . 59959) (\DLRS232C.WATCHER 59961 . 60667)) (61241 63661 (
RS232C.INIT 61251 . 61911) (RS232C.OTHER.STREAM 61913 . 62410) (RS232C.OUTPUTSTREAM 62412 . 62673) (
RS232C.GET.PARAMETERS 62675 . 62966) (RS232C.SET.PARAMETERS 62968 . 63259) (RS232C.READP.EVENT 63261
. 63659)) (63725 68106 (RS232MODEMCONTROL 63735 . 64598) (RS232MODEMSTATUSP 64600 . 65253) (
\RS232C.MSP1 65255 . 66096) (RS232MODIFYMODEMCONTROL 66098 . 67129) (RS232SENDBREAK 67131 . 67625) (
RS232MODEMHANGUP 67627 . 68104)))))
STOP