.title KRTKM Kermit-11 RT-11/TSX modem driver .ident "V03.63" .ASECT . = 110 ; for RESORC/V .rad50 "V03" ; handler is for this version .word 63. ; and this revision of Kermit .word 0. ; patch level .word -1 ; terminator ; /63/ 27-Sep-97 Billy Youdelman V03.63 ; ; Add SPFUNs to support Xmodem compatibly with the TSX CL handler: ; ; CLSET <250> Set CL options (binin and binout only) ; CLRSET <251> Clear CL options (binin and binout only) ; CLIPND <261> Get number of input chars pending ; CLWBYT <263> Write with byte count ; CLCHAR <266> Get CL characteristics (options flags only) ; ; Enabling binin or binout does not in itself bypass XOFF flow control ; processing in the input or output routines here, one must explicitly ; set RTS/CTS flow control as well, or uncomment the appropriate lines ; in the kiint (binin) and kmint/koint (binout) routines, below. ; ; This driver does not currrently support "no flow control" -- RTS/CTS ; must be enabled when binin or binout is used. Flow control may then ; be ignored if desired by using a cable that doesn't connect pins 4 & ; 5. ; ; Added .br macro for clarity. ; /62/ 27-Jul-93 Billy Y.. V03.62-7 (for KRT V03.62-8) ; ; KM is a "Kermit Modem" communications handler provided to support ; TSX-Plus features not otherwise available under RT-11, as well as ; older releases of TSX that preceded its CL handler. KM combines ; the best of both worlds, including the following under RT-11: ; ; o Works with DL(V), Falcon and PRO serial interfaces ; o Speed may be SET and SHOWn from within Kermit ; o Automatic fallback to the connected speed ; o An eight-bit data path ; o Selectable hardware (RTS/CTS) flow control ; o Emulation of TSX's CLCLR (flush pending I/O) ; o DTR toggling to support Kermit's HANGUP command ; o Usable with RT-11 V4.0 and up, and TSX-Plus V5.0 and up ; ; To use KM you must first edit the appropriate conditional assembly ; files for the serial line interface in your system: ; ; KRTSJ .CND - for RT-11FB, RT-11SB, and RT-11SJ ; KRTXM .CND - for RT-11XB, RT-11XM, RT-11ZB and RT-11ZM ; KRTTSX.CND - for TSX-Plus ; ; Then assemble and link using KRTSYS.COM if being done under RT-11 ; V5.0 or above, or KRTSV4.COM if using any RT-11 V4 release. This ; will create KM.SYS, KMX.SYS and KM.TSX, which should be copied to ; your system device (SY) where they may be INSTALLed and LOADed as ; needed. Note that KRTKM.MAC (the handler source file) must be on ; the default disk for this assembly. Under TSX you'll have to use ; TSXMOD to add a definition for KM as shown below, or define it in ; TSGEN.MAC and rebuild the system. In either case you must reboot ; as it only loads handlers when started. KM may be mapped to save ; low memory: ; ; DEVDEF ,MAPH ; ; To build KM under RT-11 V5 (KRTSYS.COM): ; MAC/OBJ:KM KRTSJ.CND+KRTKM ; LINK/NOBIT/EXE:KM.SYS KM ; MAC/OBJ:KMX KRTXM.CND+KRTKM ; LINK/NOBIT/EXE:KMX.SYS KMX ; MAC/OBJ:KMTSX KRTTSX.CND+KRTKM ; LINK/NOBIT/EXE:KM.TSX KMTSX ; ; To build KM under RT-11 V4 (KRTSV4.COM): ; MAC/OBJ:KM KRTSJ.CND+KRTKM ! KRT will only run under RT-11FB if V4 ; LINK/EXE:KM.SYS KM ; MAC/OBJ:KMTSX KMTSX.CND+KRTKM ; LINK/EXE:KM.TSX KMTSX ; ; Comments must be stripped to run these command files under RT-11. ; ; WARNING: Earlier versions of RT-11 may choke on the "dma=no" in ; the .drdef macro. If it causes an error your system doesn't need ; it and it should be dumped to allow successful assembly. ; ; KM supports the following SET commands from the monitor (KMON): ; ; SET KM CSR=oct_address ! except on the PRO for ; SET KM VECTOR=oct_address ! which these are fixed ; ; Hardware flow control REQUIRES pins 4 and 5 be carried through in ; the modem cable, 4 to 4 (RTS) and 5 to 5 (CTS), DTE (the port) to ; DCE (the modem), in addition to those otherwise normally present. ; ; The port should be set up for 8 data bits and NO parity as Kermit ; does parity in software. ; ; WARNING: If the interface provides selectable interrupt priority ; and your max speed will be greater than 4800 you will likely have ; to use BIRQ 5 to avoid dropping chars. ; ; NOTE: This handler does NOT support VTCOM, nor is it intended to ; be used with anything other than KRT V03.62 or future releases. ; ; WARNING: Because it's impossible to bomb an outstanding read ; completion routine once KM has been assigned the link the only ; way to deassign KM is to exit Kermit. .sbttl Interface and operating system defaults .iif ndf km$dve km$dve = 0 ; if <> DL(V)-11/E interface .iif ndf km$pdt km$pdt = 0 ; if <> display holds on PDT-11 LEDs .iif ndf km$pro km$pro = 0 ; if <> PRO-series modem interface .iif ndf km$sbc km$sbc = 0 ; if <> Falcon SBC-11 interface rte$m =: 0 ; RTEM is not supported here .iif ndf tsx$p tsx$p = 0 ; if <> support TSX-Plus .iif ne km$dve km$dve = 1 ; ensure proper assembly .iif ne km$pdt km$pdt = 1 .iif ne km$pro km$pro = 1 .iif ne km$sbc km$sbc = 1 .iif ne tsx$p mmg$t = 1 ; the "Plus" is 22-bit addressing .iif gt .error <; Too many interface types!> .iif gt .error <; PDT LEDs don't exist on the PRO!> .iif ndf km$csr km$csr = 176500 ; default CSR .iif ndf km$vec km$vec = 300 ; and its interrupt vector .iif ne km$pro km$csr = 173300 ; PRO modem port CSR .iif ne km$pro km$vec = 210 ; and its vector .iif ndf km$pri km$pri = 4 ; default interrupt priority .iif ne km$sbc km$pri = 5 ; Falcon must use priority 5 .iif ndf km$spd km$spd = 9600. ; default speed .iif ndf km$bsz km$bsz = 256. ; default input buffer size in bytes .iif ndf km$xof km$xof = km$bsz/4 ; default low water mark, hold I/O .iif ndf km$xon km$xon = km$bsz/4 ; default hi water mark, resume I/O .sbttl Local macros .macro .assume a1 ,cnd ,a2 ,msg .if cnd - .iff .error <; 'a1 is not 'cnd 'a2 'msg> .endc .endm .assume .macro .br to ; /63/ added.. .if df to .if ne to-. .error <; not at location to;> .endc .endc .endm .br .macro df.speed speedval ; get code for default speed .if eq speedval-50. ; not available on Falcon .iif eq km$sbc b.code = 0 ; DL(V)-11/E or PRO-series .endc .if eq speedval-75. ; not available on Falcon .iif eq km$sbc b.code = 1 ; DL(V)-11/E or PRO-series .endc .if eq speedval-110. ; not available on Falcon .iif eq km$sbc b.code = 2 ; DL(V)-11/E or PRO-series .endc .if eq speedval-134. ; not available on Falcon .iif eq km$sbc b.code = 3 ; DL(V)-11/E or PRO-series .endc .if eq speedval-150. ; not available on Falcon .iif eq km$sbc b.code = 4 ; DL(V)-11/E or PRO-series .endc .if eq speedval-300. .iif ne km$sbc b.code = 0 ; Falcon .iif eq km$sbc b.code = 5 ; DL(V)-11/E or PRO-series .endc .if eq speedval-600. .iif ne km$sbc b.code = 1 ; Falcon .iif eq km$sbc b.code = 6 ; DL(V)-11/E or PRO-series .endc .if eq speedval-1200. .iif ne km$sbc b.code = 2 ; Falcon .iif eq km$sbc b.code = 7 ; DL(V)-11/E or PRO-series .endc .if eq speedval-1800. ; not available on Falcon .iif eq km$sbc b.code = 10 ; DL(V)-11/E or PRO-series .endc .if eq speedval-2000. ; not available on Falcon .iif eq km$sbc b.code = 11 ; DL(V)-11/E or PRO-series .endc .if eq speedval-2400. .iif ne km$sbc b.code = 3 ; Falcon .iif eq km$sbc b.code = 12 ; DL(V)-11/E or PRO-series .endc .if eq speedval-3600. ; not available on Falcon .iif eq km$sbc b.code = 13 ; DL(V)-11/E or PRO-series .endc .if eq speedval-4800. .iif ne km$sbc b.code = 4 ; Falcon .iif eq km$sbc b.code = 14 ; DL(V)-11/E or PRO-series .endc .if eq speedval-7200. ; not available on Falcon .iif eq km$sbc b.code = 15 ; DL(V)-11/E or PRO-series .endc .if eq speedval-9600. .iif ne km$sbc b.code = 5 ; Falcon .iif eq km$sbc b.code = 16 ; DL(V)-11/E or PRO-series .endc .if eq speedval-19200. .iif ne km$sbc b.code = 6 ; Falcon .iif eq km$sbc b.code = 17 ; DL(V)-11/E or PRO-series .endc .if eq speedval-38400. ; not available on PRO-series or DL(V)-11/E .iif ne km$sbc b.code = 7 ; Falcon .endc .if ge b.code ; speed is ok, set it .iif ne km$dve b.deflt = !dve.en ; DL(V)-11/E .iif ne km$pro b.deflt = +b.code ; PRO-series .iif ne km$sbc b.deflt = !sbc.en ; Falcon SBC-11 .iff .error <; default speed ('speedval) isn't supported on interface specified> .endc .endm df.speed .macro picadr src ,dst=r0 ; position independent code addressing mov pc ,dst ; where we are now add src-. ,dst ; where we want to be .endm picadr .sbttl Define the driver and its parameters .mcall .drdef ,.inten ,.mtps .drdef KM ,57 ,abtio$!hndlr$!spfun$ ,0 ,km$csr ,km$vec ,dma=no q.job = 30 ; TSX+ queue element job (line) number offset q$job = q.job-4 ; and its offset from Q.BLKN psw = 177776 ; processor status word address sysptr = 54 ; location of address of RMON base qcomp = 270 ; offset to I/O exit routine address confg2 = 370 ; offset to second configuration word pros$ = 20000 ; if <> it's a PRO-series system b.code = -1 ; init as speed not settable b.deflt = 0 ; init as nothing to set for speed sbc.en = 2 ; Falcon SBC-11 speed enable dve.en = 4000 ; DL(V)-11/E speed enable ctrlq = 21 ; ^Q (XON) flow ctrls = 23 ; ^S (XOFF) control lowater = km$xof ; hold when this # free bytes remain hiwater = km$bsz-km$xon ; resume when this # bytes become free ; SPFUNs clrdrv = 201 ; flow control reset brkdrv = 202 ; send a break srddrv = 203 ; read at least 1 byte stsdrv = 204 ; short and fast style driver status rt.hold = 2 ; /63/ received flow control hold from remote rt.dcd = 10 ; /63/ dcd offdrv = 205 ; disable interrupts dtrdrv = 206 ; set or clear DTR and RTS clset = 250 ; /63/ set some TSX options clrset = 251 ; /63/ reset some TSX options clstat = 255 ; TSX style modem status cl.dcd = 2 ; /63/ dcd cl.dtr = 4 ; /63/ dtr cl.rts = 10 ; /63/ rts cl.cts = 20 ; /63/ cts cl.flow = 40 ; /63/ <> for rts/cts flow control clspeed = 256 ; get or set speed clclr = 257 ; abort pending I/O clipnd = 261 ; /63/ get number of input chars pending clwbyt = 263 ; /63/ write with byte count clchar = 266 ; /63/ get CL characteristics t.form = 1 ; /63/ transmit form feed t.tab = 2 ; /63/ transmit horizontal tab t.lc = 4 ; /63/ transmit lower case lfout = 10 ; /63/ transmit line feed lfin = 20 ; /63/ receive line feed binout = 100 ; /63/ transmit binary output binin = 200 ; /63/ receive binary input t.cr = 400 ; /63/ transmit carriage return t.ctrl = 1000 ; /63/ transmit control chars eightbit= 4000 ; /63/ receive and transmit 8-bit chars kmflow = 277 ; select XOFF/XON or RTS/CTS flow control ; DL style serial interface in$csr = 176 ; installation CSR stored here rx.dtr = 2 ; data terminal ready rx.rts = 4 ; request to send rx.ie = 100 ; interrupt enable rx.dcd = 10000 ; data carrier detect rx.cts = 20000 ; clear to send tx.br = 1 ; break tx.ie = 100 ; interrupt enable ; PRO serial interface ic$buf = 173200 ; interrupt controller base ic$csr = ic$buf+2 ; and its CSR com.ie = 33 ; enable comm port interrupts km$buf = km$csr ; rx/tx data register km$csa = km$csr+2 ; CSR A sel.r0 = 0 ; goto reg 0 cmd.cr = 30 ; reset channel cmd.rt = 50 ; reset xmit interrupt pending cmd.er = 60 ; reset error latches cmd.ei = 70 ; end of interrupt cmd.tr = 300 ; reset xmit underrun/end of message latch sel.r1 = 1 ; goto reg 1 w1.tie = 2 ; xmit interrupt enable w1.rie = 30 ; receive interrupt enable sel.r2 = 2 ; goto reg 2 req.a2 = 0 ; _required_ sel.r3 = 3 ; goto reg 3 w3.rxe = 1 ; receive enable rcl.8 = 300 ; 8-bit receive char length sel.r4 = 4 ; goto reg 4 stp.1 = 4 ; 1 stop bit clk.16 = 100 ; 16x rate multiplier sel.r5 = 5 ; goto reg 5 w5.txe = 10 ; transmit enable w5.brk = 20 ; send a break tcl.8 = 140 ; 8-bit xmit char length km$csb = km$csr+6 ; CSR B sel.r1 = 1 ; goto reg 1 req.b1 = 4 ; _required_ sel.r2 = 2 ; goto reg 2 req.b2 = 0 ; _required_ cmd.re = 20 ; reset ext/status interrupts r2.imk = 34 ; interrupt vector mask km$mc0 = km$csr+10 ; modem control 0 clk.bg = 0 ; modem baud rate generator m0.rts = 10 ; request to send m0.dtr = 20 ; data terminal ready km$mc1 = km$csr+12 ; modem control 1 m1.dcd = 20 ; data carrier detect m1.cts = 40 ; clear to send km$bdr = km$csr+14 ; speed control ledcsr = 177420 ; PDT LEDs display CSR led.tx = 100 ; send hold (LED #1) led.rx = 200 ; received hold (LED #2) led.en = 40000 ; update enable .sbttl Installation code .if ne km$pro!km$dve!km$sbc df.speed km$spd ; calculate desired default speed .endc .ASECT . = 200 nop ; boot ept, unused here.. mov @#sysptr,r0 ; get RMON base bit #pros$ ,confg2(r0) ; is this a PRO-series system? .if eq km$pro bne o.bad ; a PRO, but handler not built for it .iff beq o.bad ; built for PRO but not running on one .ift .if ne km$dve!km$sbc mov in$csr ,r0 ; recover base (rx$csr) address mov #b.deflt,4(r0) ; set default speed in tx$csr .endc .iff movb #b.deflt ,@#km$bdr ; set PRO default speed mov #km$csa ,r0 ; CSR A (reg 0) movb #cmd.cr ,@r0 ; reset chan A movb #cmd.tr ,@r0 ; reset xmit underrun latch movb #sel.r4 ,@r0 ; goto reg 4 movb #clk.16!stp.1,@r0 ; clock rate 16x, 1 stop bit movb #sel.r3 ,@r0 ; goto reg 3 movb #w3.rxe!rcl.8,@r0 ; receive enable, 8-bit chars movb #sel.r5 ,@r0 ; goto reg 5 movb #w5.txe!tcl.8,@r0 ; xmit enable, 8-bit chars movb #sel.r2 ,@r0 ; goto reg 2 movb #req.a2 ,@r0 ; _required_ movb #cmd.re ,@r0 ; reset external/status interrupts mov #km$csb ,r0 ; CSR B (reg 0) movb #cmd.cr ,@r0 ; reset chan B movb #sel.r2 ,@r0 ; goto reg 2 movb #req.b2 ,@r0 ; _required_ movb #sel.r1 ,@r0 ; goto reg 1 movb #req.b1 ,@r0 ; _required_ movb #com.ie ,@#ic$csr ; enable comm port interrupts movb #clk.bg ,@#km$mc0 ; set PRO modem baud rate generator .endc ; eq km$pro tst (pc)+ ; installed OK, clear carry o.bad: sec ; something failed, set carry rts pc .assume . le 400 msg=<;*** INSTALL CODE IS TOO LARGE ***> .if eq km$pro ; these are not settable on PRO-series .sbttl SET CSR and VECTOR ; Kermit SETs everything else.. .drset CSR ,160000 ,o.csr ,oct ; SET KM CSR=oct_address .drset VECTOR ,474 ,o.vec ,oct ; SET KM VECTOR=oct_address o.csr: cmp r0 ,r3 ; is address ok? bcs o.bad ; no, out of range.. bit #7 ,r0 ; must also be multiple of 10 (octal) bne o.bad ; it wasn't.. mov r0 ,in$csr ; copy for installation code mov r0 ,rx$csr ; receive (from modem) CSR address add #2 ,r0 mov r0 ,rx$buf ; receive buffer address add #2 ,r0 mov r0 ,tx$csr ; xmit (to modem) CSR address add #2 ,r0 ; this also clears the carry bit mov r0 ,tx$buf ; xmit buffer address rts pc o.vec: bit #3 ,r0 ; multiple of 4? bne o.bad ; no, it's no good cmp r3 ,r0 ; ya, but is it within range? bcs o.bad ; nope.. mov r0 ,km$vtb ; input interrupt vector add #4 ,r0 ; this also clears carry mov r0 ,km$vtb+6 ; output interrupt vector rts pc .endc ; eq km$pro .assume . le 1000 msg=<;*** SET CODE IS TOO LARGE ***> .sbttl Driver entry .drbeg KM mov kmcqe ,r4 ; mon/handler current queue element tst q$blkn(r4) ; doing I/O to block 0? bne 10$ ; no clr kicqe ; ya, reset the input queue clr kocqe ; and the output queue 10$: .if eq km$pro bis #rx.ie ,@rx$csr ; enable receive interrupts .iftf asr (pc)+ ; are tx interrupts already enabled? stsflg: .word 1 bcc 20$ ; hopefully.. .ift bis #tx.ie ,@tx$csr ; no, turn them on .if ne km$pdt jsr pc ,setled ; update the PDT-11 lights .endc .iff bis #w1.rie!w1.tie,sts$r1 ; set tx and rx interrupts enable bits mov #sel.r1 ,@#km$csa ; goto CSR A reg 1 mov sts$r1 ,@#km$csa ; turn them on .iftf ; /63/ 20$: movb q$func(r4),r5 ; check for a SPFUN bne spfun ; found one.. asl q$wcnt(r4) ; words -> bytes, check & dump hi bit .ift ; /63/ if not PRO branch is in range bcc km$err ; reads must be via SPFUN 203 only .iff ; /63/ old PRO code + new SPFUN code bcs bwrite ; /63/ = too far to branch.. jmp km$err ; /63/ reads via SPFUN 203 only .iftf ; /63/ bwrite: inc qchflg ; flag queue is about to be changed jsr r5 ,enqueue ; place write on internal queue kocqe: .word 0 ; output current queue element kolqe: .word 0 ; output last queue element clr qchflg ; queue is no longer changing .ift ; /63/ bis #tx.ie ,@tx$csr ; enable interrupts .iff jsr pc ,txproc ; try to get a char beq 30$ ; nothing there movb r5 ,@#km$buf ; got one, send it .endc ; eq km$pro 30$: rts pc .sbttl Registers and vector tables .if eq km$pro rx$csr: .word km$csr ; input (rx from modem) status rx$buf: .word km$csr+2 ; input (rx) buffer tx$csr: .word km$csr+4 ; output (tx to modem) status tx$buf: .word km$csr+6 ; output (tx) buffer .drvtb KM,km$vec,kiint ; input interrupts .drvtb ,km$vec+4,kmint ; output interrupts .iff ; PRO CSR and vector are not settable sts$r1: .word 0 ; status reg 1 sts$r5: .word w5.txe!tcl.8 ; status reg 5 tx enable, 8-bit chars .drvtb KM,km$vec,kmint ; for PRO-series kmint .drvtb ,km$vec+4,kmint ; dispatches everything.. .endc ; eq km$pro .assume . le kmstrt+1000 msg=<;*** BLOCK 1 CODE IS TOO LARGE ***> .sbttl Break request ; here so everything else can branch.. s.brk: tst q$wcnt(r4) ; start break or stop break? beq 10$ ; stop it inc brkflg ; start it, flag it's being done .if eq km$pro bis #tx.br ,@tx$csr ; begin the break .iff bis #w5.brk ,sts$r5 ; set the break enable bit mov #sel.r5 ,@#km$csa ; goto CSR A reg 5 mov sts$r5 ,@#km$csa ; begin the break .iftf br km$fin ; done 10$: .ift bic #tx.br ,@tx$csr ; stop the break .iff bic #w5.brk ,sts$r5 ; reset the break enable bit mov #sel.r5 ,@#km$csa ; goto CSR A reg 5 mov sts$r5 ,@#km$csa ; stop the break .iftf clr brkflg ; no longer doing a break .ift bis #tx.ie ,@tx$csr ; re-enable output interrupts .endc ; eq km$pro br km$fin ; done .sbttl Set CL options ; /63/ added to support xmodem.. ; NOTE: If you add an option flagged in the hi byte uncomment the appropriate ; two lines here and in cl.clr (below). Doing this will require making ; the bcs bwrite/jmp km$err code in the driver entry code unconditional ; as km$err will then be too far to branch. Currently this driver only ; checks and uses the binin <000200> and binout <000100> option bits. cl.set: .if eq mmg$t bis @q$buff(r4),clopts ; set the desired options .iff jsr pc ,@$gtbyt ; recover low byte of options word bisb (sp)+ ,clopts ; set it ; jsr pc ,@$gtbyt ; recover hi byte of options word ; bisb (sp)+ ,clopts+1 ; set it .endc br km$fin ; done .sbttl Clear CL options ; /63/ added to support xmodem.. cl.clr:.if eq mmg$t bic @q$buff(r4),clopts ; reset the desired options .iff jsr pc ,@$gtbyt ; recover low byte of options word bicb (sp)+ ,clopts ; reset it ; jsr pc ,@$gtbyt ; recover hi byte of options word ; bicb (sp)+ ,clopts+1 ; reset it .endc br km$fin ; done .sbttl Get CL options ; /63/ added to support xmodem.. ; NOTE: Functions which this driver provides by design are returned ; as enabled by setting same in the clopts configuration word. ; While it's possible to set or clear anything, and then view ; the results with this routine, currently only the the binin ; and binout bits actually do anything here.. clopts: .word t.form!t.tab!t.lc!lfout!lfin!t.cr!t.ctrl!eightbit ; "defaults" cl.char:.if eq mmg$t mov q$buff(r4),r5 ; buffer address clr (r5)+ ; handler status word unsupported here mov clopts ,(r5) ; options_status_word_offset = 2 .iff clr -(sp) ; handler status word unsupported here jsr pc ,@$ptwrd ; first word of data buffer mov clopts ,-(sp) ; put the options status word jsr pc ,@$ptwrd ; in second word of buffer .endc br km$fin ; only options word is needed here.. .sbttl SPFUN dispatching .enabl lsb spfun: cmpb r5 ,#srddrv ; read at least 1 byte? bne 10$ ; no jsr r5 ,enqueue ; ya, place on the internal queue.. kicqe: .word 0 ; input current queue element kilqe: .word 0 ; input last queue element jmp rxproc ; ..then get whatever is ready now 10$: cmpb r5 ,#clipnd ; /63/ number of input chars pending? bne 20$ ; /63/ no mov #km$bsz ,r5 ; /63/ size of the input ring buffer sub rxfree ,r5 ; /63/ - bytes free = chars waiting br s.out ; return number of chars pending 20$: cmpb r5 ,#stsdrv ; /63/ moved this forward for speed beq s.stat ; driver status cmpb r5 ,#clwbyt ; /63/ write with byte count? beq bwrite ; /63/ ya.. cmpb r5 ,#clrdrv ; /63/ moved forward beq s.clr ; flow control reset cmpb r5 ,#clclr ; emulate TSX+ abort pending I/O? bne 30$ ; no inc stsflg ; ya, force reinit of interrupts jmp abort ; and go hose the queue 30$: cmpb r5 ,#brkdrv beq s.brk ; break cmpb r5 ,#dtrdrv beq s.dtr ; set or clear DTR and RTS cmpb r5 ,#clstat beq cl.stat ; TSX+ style get modem status cmpb r5 ,#clset beq cl.set ; /63/ set some TSX+ options cmpb r5 ,#clrset beq cl.clr ; /63/ reset some TSX+ options .if ne km$pro!km$dve!km$sbc cmpb r5 ,#clspeed beq s.speed ; TSX+ style get/set line speed .endc cmpb r5 ,#kmflow ; selecting flow control type? beq s.flow ; ya cmpb r5 ,#offdrv ; disable interrupts? bne km$err ; /63/ no inc stsflg ; ya, revert to uninitialized state br km$fin ; done km$err: bis #hderr$ ,@-(r4) ; set error bit if none of above cause km$fin: .drfin KM ; knowing's more important than noping .dsabl lsb .sbttl Set and/or clear flow control s.flow: mov q$wcnt(r4),ctsflg ; set it (0=XOFF,<>=CTS) then clear it s.clr: clr rxhold ; hose possible received hold .if eq km$pro bis #tx.ie ,@tx$csr ; ensure output interrupts are on .iftf tst ctsflg ; doing hardware flow control? bne x.dtr ; ya, go turn it on .ift mov #-2 ,txhold ; set flag to send an XON .if ne km$pdt jsr pc ,setled ; update the PDT lights .endc .iff clr txhold ; xmit XOFF is no longer pending movb #ctrlq ,@#km$buf ; send an XON .endc ; eq km$pro br km$fin ; done .sbttl Set or clear DTR and RTS .enabl lsb s.dtr: tst q$wcnt(r4) ; set or clear? bne x.dtr ; set.. .if eq km$pro bic #rx.dtr!rx.rts,@rx$csr ; clear .iff bicb #m0.dtr!m0.rts,@#km$mc0 ; clear .iftf tst ctsflg ; doing hardware flow control? beq 20$ ; no mov #1 ,txhold ; flag RTS has been dropped br 10$ x.dtr: .ift bis #rx.dtr!rx.rts,@rx$csr ; turn them on .iff bisb #m0.dtr!m0.rts,@#km$mc0 ; PRO turns them on this way .iftf tst ctsflg ; doing hardware flow control? beq 20$ ; no clr txhold ; ya, xmit hold is no longer pending 10$: .ift .if ne km$pdt jsr pc ,setled ; update the PDT lights .endc .endc ; eq km$pro 20$: br km$fin ; done .dsabl lsb .sbttl RT-11 style status ; NOTE: This is called by Kermit once every 0.5 second. ; Any added extra function(s) should go anywhere but here. s.stat: clr r5 ; init tst rxhold ; has remote asserted flow control? beq 10$ ; no bis #rt.hold,r5 ; /63/ ya, set bit 1 10$: .if eq km$pro bit #rx.dcd ,@rx$csr ; DCD asserted? .iff bit #m1.dcd ,@#km$mc1 ; DCD asserted? .endc beq s.out ; no bis #rt.dcd ,r5 ; /63/ ya, set bit 3 s.out: .if eq mmg$t mov r5 ,@q$buff(r4) ; return the status word .iff mov r5 ,-(sp) ; pass the status word to jsr pc ,@$ptwrd ; the $_put_word subroutine .endc br km$fin ; done .sbttl TSX style status cl.stat:clr r5 ; init .if eq km$pro bit #rx.dcd ,@rx$csr ; DCD asserted? .iff bit #m1.dcd ,@#km$mc1 ; DCD asserted? .iftf beq 10$ ; no bis #cl.dcd ,r5 ; /63/ ya, flag it 10$: .ift bit #rx.dtr ,@rx$csr ; DTR asserted? .iff bit #m0.dtr ,@#km$mc1 ; DTR asserted? .iftf beq 20$ ; no bis #cl.dtr ,r5 ; /63/ ya, flag it 20$: .ift bit #rx.rts ,@rx$csr ; RTS asserted? .iff bit #m0.rts ,@#km$mc0 ; RTS asserted? .iftf beq 30$ ; no bis #cl.rts ,r5 ; /63/ ya, flag it 30$: .ift bit #rx.cts ,@rx$csr ; CTS asserted? .iff bit #m1.cts ,@#km$mc1 ; CTS asserted? .endc ; eq km$pro beq 40$ ; no bis #cl.cts ,r5 ; /63/ ya, flag it 40$: tst ctsflg ; RTS/CTS flow control? beq s.out ; no bis #cl.flow,r5 ; /63/ ya, flag it br s.out ; common code.. .if ne km$pro!km$dve!km$sbc .sbttl Set or get speed s.speed:tst q$wcnt(r4) ; set it or get it? bmi 10$ ; hi bit set flags get speed .if eq mmg$t mov @q$buff(r4),r1 ; recover desired set speed value .iff jsr pc ,@$gtbyt ; recover desired set speed value mov (sp)+ ,r1 ; hi byte here is "undefined".. .endc bic #^c<37> ,r1 ; hose any possible garbage in hi bits .if eq km$sbc cmp r1 ,#16. ; if not a Falcon, beq km$err ; 38.4k is unavailable .endc mov r1 ,curspd ; save to return speed when asked.. .if ne km$pro ; speed = +b.code mov r1 ,-(sp) ; save copy of speed code for receive asl r1 ; then shift it into xmit speed bits asl r1 asl r1 asl r1 bis (sp)+ ,r1 ; restore the receive speed bits movb r1 ,@#km$bdr ; set both tx and rx speeds .iff .if ne km$dve swab r1 ; speed = !dve.en asl r1 asl r1 asl r1 asl r1 bis #dve.en ,r1 ; now set the speed enable bit .endc .if ne km$sbc ; speed = !sbc.en picadr #sbcspd ; get conversion table pointer add r1 ,r0 ; add speed offset movb (r0) ,r1 ; copy real speed code from table bmi km$err ; not a valid SBC-11 speed .endc mov r1 ,@tx$csr ; set the new speed .endc ; ne km$pro br km$fin ; done 10$: .if eq mmg$t mov curspd ,@q$buff(r4) ; put current speed into user's buffer .iff mov curspd ,-(sp) ; pass speed value to $_put_word jsr pc ,@$ptwrd ; which places it into user's buffer .endc br km$fin ; done curspd: .word b.code ; the current speed, -1 if unsettable .if ne km$sbc ; Falcon speed translation table sbcspd: .byte -1 ,-1 ,-1 ,-1 ,-1 ,02 .byte 12 ,22 ,-1 ,-1 ,32 ,-1 .byte 42 ,-1 ,52 ,62 ,72 .even .endc .endc ; ne km$pro!km$dve!km$sbc .if ne km$pdt .sbttl Display flow control status on PDT-11 lamps setled: mov #led.en ,r5 ; enable with both LEDs preset off tst txhold ; is a sent XOFF or RTS hold pending? ble 10$ ; no bis #led.tx ,r5 ; ya, illuminate LED #1 10$: tst rxhold ; received XOFF or CTS hold pending? beq 20$ ; no bis #led.rx ,r5 ; ya, illuminate LED #2 20$: mov r5 ,@#ledcsr ; send the results to the hardware rts pc .endc .sbttl Driver reset abort: mov r0 ,-(sp) .if eq km$pro bic #rx.ie ,@rx$csr ; disable input interrupts .iff bic #w1.rie ,sts$r1 ; set to disable input interrupts mov #sel.r1 ,@#km$csa ; goto CSR A reg 1 mov sts$r1 ,@#km$csa ; do it .iftf jsr r4 ,delink ; dump entries .word kicqe-q$link-del.pc ; from the input queue tst stsflg ; re-enable interrupts? bne 10$ ; no .ift bis #rx.ie ,@rx$csr ; ya, turn them on .iff bis #w1.rie ,sts$r1 ; set to enable receive interrupts mov #sel.r1 ,@#km$csa ; goto CSR A reg 1 mov sts$r1 ,@#km$csa ; do it .iftf 10$: inc qchflg ; flag queue is about to be changed jsr r4 ,delink ; dump entries .word kocqe-q$link-del.pc ; from the output queue clr qchflg ; queue is no longer changing tst stsflg ; re-enable interrupts? bne 30$ ; no .ift bis #tx.ie ,@tx$csr ; ya, turn them on .iff mov r5 ,-(sp) jsr pc ,txproc ; try to get an ouput char beq 20$ ; nothing there movb r5 ,@#km$buf ; send it 20$: mov (sp)+ ,r5 .endc ; eq km$pro 30$: mov (sp)+ ,r0 tst kmcqe ; any data in current queue element? bne 40$ ; ya, go unload it rts pc ; no, done 40$: jmp km$fin .if ne km$pro .sbttl PRO interrupt service dispatcher br abort ; abort entry point kmint: jsr r5 ,@$inptr ; drop back to the .word ^c&340 ; device priority mov #sel.r2 ,@#km$csb ; goto CSR B reg 2 mov @#km$csb,-(sp) ; recover the interrupt bic #^c,@sp ; mask non-relevant data asr @sp ; word indexing add pc ,@sp ; calculate and add the add #inttab-.,@sp ; top of the table address mov @(sp)+ ,-(sp) ; entry for this type interrupt add pc ,@sp ; calculate its address intdsp: jmp @(sp)+ ; service the interrupt esint: mov #cmd.re ,@#km$csa ; reset external/status interrupts xxint: mov #cmd.ei ,@#km$csa ; end of interrupt rts pc srint: mov #cmd.er ,@#km$csa ; reset error latches and jmp kiint ; treat as a rec'd char inttab: .word xxint-intdsp ; unknown interrupts .word xxint-intdsp .word xxint-intdsp .word xxint-intdsp .word koint-intdsp ; xmit buffer empty .word esint-intdsp ; external/status interrupts .word kiint-intdsp ; rec'd char ready .word srint-intdsp ; special receive interrupt .endc ; ne km$pro .sbttl Output (to modem) interrupt service .enabl lsb .if eq km$pro br abort ; abort entry point .iff koint: .ift kmint: jsr r5 ,@$inptr ; drop back to the .word ^c&340 ; device priority .iftf tst (pc)+ ; if sending a break.. brkflg: .word 0 ; <> if break is asserted bne 40$ ; ..then output can't be done tst (pc)+ ; flow control status -2=doRESUME txhold: .word 0 ; -1=doHOLD, 0=RESUMEed, 1=onHOLD bpl 20$ ; nothing to do tst (pc)+ ; check flow control type ctsflg: .word 0 ; if <> do RTS/CTS flow control bne 10$ ; go get CTS status into rxhold ; /63/ use hardware flow control with binout or uncomment the next 2 lines ; bit #binout ,clopts ; /63/ if doing binary output ; bne 10$ ; /63/ don't send XOFF or XON chars movb #ctrlq ,r5 ; preset an XON add #2 ,txhold ; really need one? beq 30$ ; ya movb #ctrls ,r5 ; no, thus it's an XOFF that's needed br 30$ 10$: clr rxhold ; preset to no hold .ift bit #rx.cts ,@rx$csr ; CTS asserted? .iff bit #m1.cts ,@#km$mc1 ; CTS asserted? .iftf bne 20$ ; ya mov #1 ,rxhold ; no, set the hold flag 20$: tst (pc)+ ; is other end ready for more data..? rxhold: .word 0 ; <> if it sent an XOFF or CTS is low bne 40$ ; ..not yet tst (pc)+ ; is the queue being changed? qchflg: .word 0 ; <> if queue is being updated bne 40$ ; ya, output must wait.. jsr pc ,txproc ; no, try to get something to output beq 40$ ; nothing was there.. 30$: .ift movb r5 ,@tx$buf ; something was there, send it .if ne km$pdt jmp setled ; update the PDT lights .endc rts pc ; if not a PRO, done.. .iff movb r5 ,@#km$buf ; something was there, send it .iftf 40$: .ift bic #tx.ie ,@tx$csr ; disable xmit interrupts .iff mov #cmd.rt ,@#km$csa ; reset xmit interrupt pending mov #cmd.ei ,@#km$csa ; end of interrupt .endc ; eq km$pro rts pc .dsabl lsb .sbttl Get next output (to modem) character txproc: mov kocqe ,r4 ; pointer to current queue element beq 10$ ; nothing is ready .if eq mmg$t add #q$wcnt ,r4 ; where word count lives tst @r4 ; anything left? beq 20$ ; no, done inc @r4 ; ya, decrement count movb @-(r4) ,r5 ; get the char inc @r4 ; point to possible next char .iff tst q$wcnt(r4) ; anything left? beq 20$ ; no, done inc q$wcnt(r4) ; ya, decrement count jsr pc ,@$gtbyt ; get the char mov (sp)+ ,r5 ; save a copy .endc ; eq mmg$t bic #^c<377>,r5 ; mask to 8 bits bne 10$ ; /63/ not a null, something is left.. bit #binout ,clopts ; /63/ ignore nulls? beq txproc ; yes 10$: rts pc 20$: inc qchflg ; flag queue is about to be changed .if eq km$pro bic #tx.ie ,@tx$csr ; disable xmit interrupts .iftf mov kocqe ,r4 ; point to current queue element mov q$link(r4),kocqe ; put next element at top of queue jsr pc ,dequeue ; give current element to the os clr qchflg ; queue is no longer changing .ift bis #tx.ie ,@tx$csr ; re-enable xmit interrupts .endc ; eq km$pro br txproc ; always return a char if possible .sbttl Input (from modem) interrupt service .if eq km$pro rts pc ; abort entry point .iftf kiint: .ift jsr r5 ,@$inptr ; drop back to the .word ^c&340 ; device priority movb @rx$buf ,r5 ; get a char .iff movb @#km$buf,r5 ; get a char .iftf bic #^c<377>,r5 ; mask to 8 bits, dump possible sxt bne 10$ ; /63/ not a null, something is left.. bit #binin ,clopts ; /63/ was a null, check disposition beq 30$ ; ignore nulls 10$: tst ctsflg ; doing hardware flow control? bne 50$ ; ya, ^Q and ^S are normal chars.. ; /63/ use hardware flow control with binin or uncomment the following 2 lines ; bit #binin ,clopts ; /63/ or if doing binary input ; bne 50$ ; /63/ they are normal here too cmp r5 ,#ctrls ; no, is it an XOFF? bne 40$ ; no mov #1 ,rxhold ; ya, flag it 20$: .ift .if ne km$pdt jmp setled ; update the PDT lights .endc .iftf 30$: .iff mov #cmd.ei ,@#km$csa ; end of interrupt .iftf rts pc 40$: cmp r5 ,#ctrlq ; is it an XON? bne 50$ ; no clr rxhold ; ya, flag it .ift bis #tx.ie ,@tx$csr ; re-enable xmit interrupts .iff clr txhold ; flag xmit XOFF is no longer pending movb #ctrlq ,@#km$buf ; because this XON has just been sent .iftf br 20$ ; common code.. 50$: tst rxfree ; input buffer full? beq 70$ ; ya, go send an XOFF mov rxputc ,r4 ; no, point to where char goes in buff add pc ,r4 ; calculate and add add #rxbuff-.,r4 ; the top of the buffer's address movb r5 ,@r4 ; stuff the char into the buffer dec rxfree ; decrement the free byte count inc rxputc ; next char goes here cmp rxputc ,#km$bsz ; unless at the end blo 60$ ; not yet.. clr rxputc ; wrap to top of the buffer 60$: cmp rxfree ,#lowater ; time to put the brakes on yet? bhi 100$ ; no.. tst txhold ; ya, done an XOFF or dropped RTS yet? bgt 100$ ; ya.. 70$: tst ctsflg ; no, doing hardware flow control? bne 80$ ; ya .ift mov #-1 ,txhold ; no, flag to send an XOFF bis #tx.ie ,@tx$csr ; enable output interrupts br 100$ .iff movb #ctrls ,@#km$buf ; send an XOFF br 90$ ; go flag it's been sent .iftf 80$: .ift bic #rx.rts ,@rx$csr ; clear RTS .iff bicb #m0.rts ,@#km$mc0 ; clear RTS .iftf 90$: mov #1 ,txhold ; flag the hold 100$: tst kicqe ; anything in the input queue? beq 20$ ; no .iff mov #cmd.ei ,@#km$csa ; end of interrupt .endc ; eq km$pro .br rxproc ; /63/ fall through to rxproc .sbttl Process chars from the modem rxproc: inc rx.proc ; is this process already running? bne 80$ ; ya.. jsr r0 ,90$ ; no, but save r0-r3, drop pri first 10$: clr rx.proc ; flag input is now being processed cmp rxfree ,#hiwater ; enough room to allow more input yet? blo 40$ ; no.. tst txhold ; ya, has an XON been sent yet? beq 40$ ; ya.. tst ctsflg ; doing hardware flow control? bne 20$ ; ya .if eq km$pro mov #-2 ,txhold ; no, flag to send an XON bis #tx.ie ,@tx$csr ; enable output interrupts br 40$ .iff movb #ctrlq ,@#km$buf ; send an XON br 30$ .iftf 20$: .ift bis #rx.rts ,@rx$csr ; set RTS .iff bisb #m0.rts ,@#km$mc0 ; set RTS .endc ; eq km$pro 30$: clr txhold ; xmit hold is no longer pending 40$: mov kicqe ,r4 ; is there input to do? beq 70$ ; no.. cmp rxfree ,#km$bsz ; ya, check input ring buffer beq 70$ ; it's empty.. mov rxgetc ,r5 ; this is the offset to the next char add pc ,r5 ; calculate and add add #rxbuff-.,r5 ; the top of the buffer's address movb @r5 ,r5 ; get the char inc rxfree ; this byte is now free inc rxgetc ; next char will be here cmp rxgetc ,#km$bsz ; unless at the end blo 50$ ; not yet.. clr rxgetc ; wrap to top of the buffer 50$: .if eq mmg$t add #q$wcnt ,r4 ; get the word count movb r5 ,@-(r4) ; return the char inc (r4)+ ; next char goes here dec @r4 ; done? .iff movb r5 ,-(sp) ; pass char to jsr pc ,@$ptbyt ; $_put_byte dec q$wcnt(r4) ; done? .iftf beq 60$ ; ya.. cmp rxfree ,#km$bsz ; no, is there more to do? bne 10$ ; ya.. bit #binin ,clopts ; /63/ binary input mode enabled? bne 60$ ; /63/ ya, no need to terminate.. mov kicqe ,r4 ; no, restore pointer to current entry .ift add #q$wcnt ,r4 ; location of next free byte in buffer clrb @-(r4) ; null terminate the data .iff clrb -(sp) ; pass a null byte to jsr pc ,@$ptbyt ; $_put_byte to terminate the data .endc ; eq mmg$t 60$: mov kicqe ,r4 ; point to current queue element mov q$link(r4),kicqe ; put next element at top of queue jsr pc ,dequeue ; give current element to the os br 10$ ; next one.. 70$: dec rx.proc ; something new to do? bpl 10$ ; ya.. 80$: rts pc ; see code just below re: r0 vs. pc.. 90$: mov r1 ,-(sp) ; r0 was just pushed by jsr r0 ,90$ mov r2 ,-(sp) ; note r0 is NOT preserved here as it mov r3 ,-(sp) ; isn't needed in routine following.. mov r0 ,-(sp) ; save return address on top of stack .mtps #0 ; drop priority, then jsr pc ,@(sp)+ ; go back to the caller after which mov (sp)+ ,r3 ; we arrive here to pop the regs as mov (sp)+ ,r2 ; calling routine ends with rts pc mov (sp)+ ,r1 ; ..all this saves a few words.. mov (sp)+ ,r0 ; <- pushed by originating jsr r0,90$ rts pc ; now return from whence we came.. rx.proc:.word -1 ; -1=RXPROC is free, =>0 RXPROC is not rxbuff: .blkb km$bsz ; receive high speed ring buffer rxfree: .word km$bsz ; number of bytes free rxputc: .word 0 ; put_next_char pointer rxgetc: .word 0 ; get_next_char pointer .sbttl Place an entry on the internal queue enqueue:clr kmcqe ; this is where it's coming from clr kmlqe ; also here, as never more than one.. tst @r5 ; anything in the internal queue? bne 10$ ; ya.. mov r4 ,(r5)+ ; no, so this becomes the first mov r4 ,(r5)+ ; and the last one too rts r5 10$: mov r4 ,-(sp) ; address of the new element tst (r5)+ ; get the pointer mov @r5 ,r4 ; to the last element mov @sp ,q$link(r4) ; link to the one being added mov (sp)+ ,(r5)+ ; which then becomes the last one.. rts r5 .sbttl Remove internal queue elements to monitor/handler queue delink: mov (r4)+ ,r5 ; get the queue to check (in or out) mov r4 ,-(sp) ; r4 now has return address, save it add pc ,r5 ; get queue's actual location del.pc = . ; with respect to where we are now mov r5 ,-(sp) ; and save a copy 10$: mov q$link(r5),r4 ; get link to next entry beq 40$ ; done .if eq tsx$p movb q$jnum(r4),r0 ; recover the RT-11 job number asr r0 asr r0 asr r0 bic #^c<17> ,r0 ; got it.. .iff movb q$job(r4),r0 ; support TSX job numbers >16 bic #^c<77> ,r0 ; but it'll never be >63. .endc ; eq tsx$p cmp r0 ,4(sp) ; does calling job own this entry? beq 20$ ; ya mov r4 ,r5 ; no, skip it br 10$ ; next.. 20$: mov q$link(r4),q$link(r5) ; unlink from the internal queue tst kmcqe ; any entries in the monitor queue? bne 30$ ; ya, add this at the end mov r4 ,kmcqe ; no, make it the first mov r4 ,kmlqe ; and thus the last as well br 10$ ; next.. 30$: clr q$link(r4) ; last entry must link to 0 mov kmlqe ,r0 ; pointer to last monitor queue entry mov r4 ,q$link(r0) ; link in this new one mov r4 ,kmlqe ; which is now the last one br 10$ ; next.. 40$: mov (sp)+ ,r4 ; back to top of the queue mov r5 ,q$link+2(r4) ; queue now ends here mov (sp)+ ,r4 ; pop the return address rts r4 .sbttl Non-exiting delink per RT-11 V5.5 SSM p. 7-22 dequeue:.mtps #340 ; disable interrupts tst kmcqe-4 ;;; need to wait? bpl 10$ ;;; no.. mov @sp ,-(sp) ;;; ya, push the return address .if eq mmg$t clr 2(sp) ;;; and clear the PSW .iff mov @#psw ,2(sp) ;;; under XM just hose bic #340 ,2(sp) ;;; priority 7.. .iftf .inten km$pri ,pic ;;; goto the device priority .fork fkblk ; wait for system stuff to finish .ift .mtps #340 ; disable interrupts .iff bis #340 ,@#psw ; play it safe under XM .. .endc ; eq mmg$t ; in case the monitor/handler queue 10$: mov kmcqe ,-(sp) ; has an element, stash a copy then mov r4 ,kmcqe ; put the internal queue element mov r4 ,kmlqe ; on the monitor/handler queue clr q$link(r4) ; now delink from internal queue picadr #kmcqe ,r4 ; emulate .drfin except mov @#sysptr,r5 ; come back after the jsr pc ,@qcomp(r5) ; monitor/handler queue releases it mov @sp ,kmcqe ; recover the current element which is mov (sp)+ ,kmlqe ; the first, last (and only) element rts pc fkblk: .word 0 ,0 ,0 ,0 ; fork queue element .drend KM .end