.enabl	lc
	.title	DUTEST
;+
;
; MSCP test program.
;
; By John Wilson, D Bit.
;
; Copyright (C) 1997, 1998 by Digby's Bitpile, Inc.  All rights reserved.
;
; 09/05/97	JMBW	Created (from DUBOOT.MAC).
;
;-
du$csr=	172150			;base address of MSCP port (DUA:)
du$cid=	0			;MSCP connection ID
;
mu$csr=	174500			;base address of TMSCP port (MUA:)
mu$cid=	1			;TMSCP connection ID
;
lk$csr=	177546			;KW11L CSR
tt$csr=	177560			;console DL11 base CSR
;
kbcsr=	tt$csr+0		;keyboard CSR
kbbuf=	tt$csr+2		;keyboard buffer
ttcsr=	tt$csr+4		;TTY CSR
ttbuf=	tt$csr+6		;TTY buffer
;
	.asect
.=0
p.crf:	.blkw	2		;(00) command reference number
p.unit:	.blkw			;(04) unit number
	.blkw			;(06) (reserved)
p.opcd:	.blkb			;(10) opcode
p.flgs:	.blkb			;(11) end message flags (reserved in cmd msg)
p.mod:				;(12) modifiers
p.sts:	.blkw			;(12) status (in end msgs)
p.bcnt:	.blkw			;(14) byte count (or record/object count)
p.unfl:	.blkw			;(16) unit flags
p.tcnt:				;(20) tape mark count
p.buff:	.blkw	6		;(20) buffer descriptor
p.medi:				;(34) medium ID, 4 bytes
p.lbn:	.blkw	2		;(34) logical block number
p.shun:	.blkw			;(40) shadow unit
	.blkw
p.unsz:				;(44) unit size
p.trck:	.blkw			;(44) track size
p.grp:	.blkw			;(46) group size
p.cyl:	.blkw			;(50) cyl size
	.blkw			;(52) (reserved)
p.rcts:	.blkw			;(54) RCT size
p.rbns:	.blkb			;(56) RBNs/track
p.rctc:	.blkb			;(57) # RCT copies
;
; Parameter codes for SHWPKT:
;
.=1	; (must be non-zero, 0 marks end of list)
xunit:	.blkb			;unit # from P.UNIT
xsts:	.blkb			;status from P.STS
xmod:	.blkb			;modifiers from P.MOD
xunfl:	.blkb			;unit flags from P.UNFL
xbcnt:	.blkb			;byte count from P.BCNT
xbuff:	.blkb			;buf addr from P.BUFF
xmedi:	.blkb			;medium ID from P.MEDI
xlbn:	.blkb			;logical block # from P.LBN
xunsz:	.blkb			;unit size from P.UNSZ
xgus:	.blkb			;GET UNIT STATUS parms from all over
xrecs:	.blkb			;record/object count from P.BCNT
xfils:	.blkb			;file count from P.TCNT
xact:	.blkb			;actual TMSCP record length
;
	.psect
;
; MSCP opcodes:
;
; "immediate" category
op.abo=	001			;ABORT
op.gcs=	002			;GET COMMAND STATUS
op.gus=	003			;GET UNIT STATUS
op.scc=	004			;SET CONTROLLER CHARACTERISTICS
;op.???=005			;WRITE NON-VOLATILE MEMORY (which does what?)
op.sex=	007			;serious exception (used in responses only,
;				;although I've never seen it in real life)
; "sequential" category (cmds must be executed in the order sent)
op.avl=	010			;AVAILABLE
op.onl=	011			;ONLINE
op.suc=	012			;SET UNIT CHARACTERISTICS
op.dap=	013			;DETERMINE ACCESS PATHS
; "non-sequential" category (controller may reorder these)
op.acc=	020			;ACCESS
op.ccd=	021			;COMPARE CONTROLLER DATA
op.ers=	022			;ERASE
op.flu=	023			;FLUSH
op.rpl=	024			;REPLACE
; (why does the sequence skip 3 opcodes here?)
op.fmt=	030			;FORMAT
;
op.cmp=	040			;COMPARE HOST DATA (page 6-11 is missing!!!)
op.rd=	041			;READ
op.wr=	042			;WRITE
; skips 043
op.wtm=	044			;WRITE TAPE MARK(S) (TMSCP only)
op.rep=	045			;REPOSITION (TMSCP only)
;
;op.???=057			;used by RT, RSX when formatting RX33s on
;				;RQDX3 (RQZX1 uses OP.FMT)
;				;UDADF$ calls it "OP.SP8"
;
op.ava=	100			;AVAILABLE attn msg
op.dup=	101			;DUPLICATE UNIT NUMER attn msg
op.acp=	102			;ACCES PATH attn msg
;
op.end=	200	;end message flag (added to cmd opcode in reply)
;
; Status values (low 5 bits of status word at P.STS in response packets)
st.suc=	000			;success
st.cmd=	001			;invalid command
st.abo=	002			;command aborted
st.ofl=	003			;unit-offline
st.avl=	004			;unit-available
st.mfe=	005			;media format error
st.wpr=	006			;write protected
st.cmp=	007			;compare error
st.dat=	010			;data error
st.hst=	011			;host buffer access error
st.cnt=	012			;controller error
st.drv=	013			;drive error
st.dia=	037			;message from an internal diagnostic
;
bs=	10			;backspace
lf=	12			;line feed
cr=	15			;carriage return
;
; Macro to define an entry in a keyword table.  The keyword text must contain
; exactly one hyphen (-), indicating the minimum acceptable abbreviation.
;
; The following is stored for each keyword:
;	.byte	length to match
;	.byte	total length
;	.ascii	/keyword/
;	.even
;	.word	call address
;
	.macro	kw	text,addr
$$kh=	0
$$ki=	0
	.irpc	$$kc,<text>
$$ki=	$$ki+1
.iif idn <$$kc>,<->, $$kh=$$ki
	.endm ; .IRPC
.if eq $$kh
	.error	; No hyphen in string:  text
	.mexit
.endc ; .IF EQ $$KH
	.byte	$$kh-1,$$ki-1	;len to match, total len
	.irpc	$$kc,<text>	;keyword text, omit the '-'
.iif dif <$$kc>,<->, .byte ''$$kc
	.endm ; .IRPC
	.even
	.word	addr		;call address
	.endm
;
; Cram in-line text into line buffer at (R5)
;
	.macro	cram	text
	jsr	r0,cram$
	.asciz	\text\
	.even
	.endm
;
; Call and return:
;
	.macro	callr	addr
	jmp	addr
	.endm
;
; Main entry point:
;
start:	reset			;kill RT-11 (or whatever got us here)
	; if we're in RT11XM then that didn't work (RESET = nop in user mode)
	; (nothing we can do if we're run by VBGEXE but we'll try anyway, a
	; regular XM background program still has access to the I/O page and
	; vector area so switching to kernel mode is easy)
	mov	#4+8.,r0	;point past vectors 4/10
	mov	#340,-(r0)
	mov	#10$,-(r0)
	mov	#340,-(r0)
	mov	#10$,-(r0)
	jmp	r0		;traps to one or the other on all CPUs
10$:	reset			;NOW we're in kernel mode!
	mov	#4,r0		;point at vectors
	mov	#t4,(r0)+	;fill in vectors for 4/10
	mov	#340,(r0)+
	mov	#t10,(r0)+
	mov	#340,(r0)
	mov	#banner,r0	;pt at msg
	call	print		;print it
mloop:	mov	#start,sp	;init stack
	mov	#rxbuf,rring	;init rx ring to prevent spurious display
	mov	#100000,rring+2
	mov	#60.,rxbuf-4	;init envelope header
	clr	rxbuf-2		;(set connection ID to 1 for TMSCP?)
				;(doesn't seem to be necessary)
10$:	tst	rring+2		;received a message?
	bpl	30$		;yes
	mov	#prompt,r0	;prompt
	mov	#lbuf,r1	;input line buffer
	call	gtlin
	mov	#lbuf,r5	;point at command line
	mov	r0,r4		;copy length
	call	getw		;get first word
	bcs	10$		;none, ignore and re-prompt
	mov	#cmds,r0	;point at list
	call	tbluk		;look it up
	bcs	20$		;undefined
	call	(r0)		;call command routine
	br	10$		;around for more
20$:	mov	#invkey,r0	;invalid keyword
	call	print
	br	10$
30$:	; received a message
	mov	rxbuf-2,r0	;get message credits
	bic	#^C17,r0	;isolate
	add	r0,cred		;add to message credit account
	mov	#rxbuf-4,r0	;init source ptr
	mov	#rxbuf1-4,r1	;dest
	mov	(r0),r2		;length
	add	#4,r2		;including envelope
40$:	movb	(r0)+,(r1)+	;copy
	sob	r2,40$		;loop
	mov	#rcvd,r0	;header
	call	print
	mov	#rxbuf1,r5	;point at packet
	call	shwpkt		;show contents
	mov	#rxbuf,rring	;reinit
	mov	#100000,rring+2
	mov	#60.,rxbuf-4	;reinit envelope header
	clr	rxbuf-2		;(set connection ID to 1 for TMSCP?)
	mov	#crdits,r0	;point at string
	call	print
	mov	#lbuf,r5	;point at buf
	mov	cred,r0		;load credit account
	clr	r1		;zero-extend
	call	prdec		;convert to decimal
	clrb	(r5)		;mark end
	mov	#lbuf,r0	;point at it
	call	print		;print
	br	10$		;loop
;
cmds:	; command list
	kw	<AD-DRESS>,addr	;print addrs of bufs
	kw	<BA->,ba	;specify buf addr (octal)
	kw	<BC-NT>,bcnt	;specify byte count (decimal)
	kw	<BL-OCK>,block	;specify block # (decimal)
	kw	<CLS->,cls	;clear screen
	kw	<F-LAGS>,flags	;unit/controller flags
	kw	<G-O>,go	;go (send and poll)
	kw	<INI-TIALIZE>,init ;init controller
	kw	<MO-DIFIERS>,mod ;set modifier bits
	kw	<MS-CP>,smscp	;set MSCP protocol and CSR addr
	kw	<OP-CODE>,opcode ;init packet, set opcode
	kw	<OS-HOW>,oshow	;show packet in octal
	kw	<P-OLL>,poll	;tell port to poll
	kw	<Q-UIT>,quit	;quit (well, halt anyway)
	kw	<RES-ET>,reset$	;execute RESET instruction (hard reset ctrlr)
	kw	<SE-ND>,send	;send command packet
	kw	<SH-OW>,show	;show packet contents
	kw	<T-MSCP>,stmscp	;set TMSCP protocol and CSR addr
	kw	<U-NIT>,unit	;set unit #
	.byte	0		;end of list
	.even
;+
;
; Print addrs of bufs.
;
;-
addr:	mov	#lbuf,r5	;point at line
	cram	<SEND=>
	mov	#txbuf,r0	;print value
	call	proct6
	cram	< RCV=>
	mov	#rxbuf,r0	;print value
	call	proct6
	cram	< I/O BUF=>
	mov	#buf,r0
	call	proct6
	callr	flush		;flush, return
;+
;
; Get buf address.
;
;-
ba:	mov	#txbuf+p.buff+4,r0 ;clear out final 8 bytes
	clr	(r0)+		;(reserved in PDP-11 ports)
	clr	(r0)+
	clr	(r0)+
	clr	(r0)
	call	getoct		;get #
	bcs	10$
	mov	r0,txbuf+p.buff	;save
	mov	r1,txbuf+p.buff+2
	rts	pc
10$:	mov	#buf,txbuf+p.buff ;use default
	clr	txbuf+p.buff+2
	rts	pc
;+
;
; Get byte count.
;
;-
bcnt:	call	getdec		;get #
	bcs	10$
	mov	r0,txbuf+p.bcnt	;save
	mov	r1,txbuf+p.bcnt+2
	rts	pc
10$:	mov	#msgprm,r0	;error
	callr	print		;print msg and return
;+
;
; Get block #.
;
;-
block:	call	getdec		;get #
	bcs	10$
	mov	r0,txbuf+p.lbn	;save
	mov	r1,txbuf+p.lbn+2
	rts	pc
10$:	mov	#msgprm,r0	;error
	callr	print		;print msg and return
;+
;
; Clear screen.
;
;-
cls:	mov	#clrscr,r0	;point at string
	callr	print		;print it, return
;+
;
; Get flags.
;
;-
flags:	call	getoct		;get #
	bcs	10$
	mov	r0,txbuf+p.unfl	;save
	rts	pc
10$:	mov	#msgprm,r0	;error
	callr	print		;print msg and return
;+
;
; Go (execute command).
;
;-
go:	call	send		;send the packet (put in ring)
	callr	poll		;tell port to poll ring
;+
;
; Initialize MSCP controller.
;
;-
init:	; go through 4-step init process
	mov	#60.,rxbuf-4	;init envelope header
	clr	rxbuf-2		;(set connection ID to 1 for TMSCP?)
	mov	#rring,r1	;point at descriptor rings
	mov	#rxbuf,(r1)+	;reinit descriptors
	mov	#100000,(r1)+	;OWN=1, FLAG=0
	mov	#txbuf,(r1)+
	clr	(r1)		;OWN=0, FLAG=0
	clr	@udip		;write IP, start init process
	mov	#4000,r0	;step 1 flag
	mov	#steps,r5	;point at table
	mov	#stepv,r4	;point at table for values at each step
10$:	mov	@udsa,r2	;get flag from UDSA
	bmi	30$		;error, die
	bit	r0,r2		;is our step on yet?
	bne	40$		;got it
	; Dilog controllers get stuck if you poll too often
	mov	#1000.,r3	;delay count, somewhat CPU-specific
20$:	tst	@#ttcsr		;touch a known port, less CPU-specific
	dec	r3
	bne	20$
	br	10$		;go poll again
30$:	mov	#inierr,r0	;print error msg
	callr	print		;and return
40$:	mov	@udsa,(r4)+	;fetch value
	mov	(r5)+,@udsa	;store next word
	asl	r0		;shift to next step
	bpl	10$		;loop unless ran into bit 15
	clr	cred		;clear credit account
	; display interesting values returned by controller
	mov	#lbuf,r5	;init ptr into line buffer
	cram	<Returned values: >
	bit	#2000,stepv	;NV set?
	beq	50$
	cram	< NV>		;yes
50$:	bit	#1000,stepv	;QB?
	beq	60$
	cram	< QB>		;yes
60$:	bit	#400,stepv	;DI
	beq	70$
	cram	< DI>		;yes
70$:	cram	< Step 1 bits 7:0=>
	mov	stepv,r0
	call	proct3
	cram	< (documented as 000)>
	call	flush
	cram	<Port type = >
	movb	stepv+3,r0	;get port type
	bic	#^C7,r0		;isolate
	mov	#1,r2		;# digits
	call	proct		;print it
	cram	<, reserved step 3 bits 10:8 = >
	movb	stepv+5,r0	;get them
	bic	#^C7,r0		;isolate
	mov	#1,r2		;# digits
	call	proct		;print it
	cram	<, model = >
	mov	stepv+6,r0	;get value
	asr	r0		;right 4 bits
	asr	r0
	asr	r0
	asr	r0
	bic	#^C177,r0	;isolate
	call	proct3		;print it
	cram	<, FW version = >
	mov	stepv+6,r0	;get value
	bic	#^C17,r0	;isolate
	mov	#2,r2		;# digits
	call	proct		;print it
	callr	flush		;flush line, return

;	; resync per page 4-17 of MSCP Basic Disk Functions Manual
;	jsr	r5,inipkt	;init packet
;	 .word	op.scc		;set controller characteristics
;	call	cmd		;accept all defaults
;	jsr	r5,inipkt	;init packet
;	 .word	op.onl		;unit online
;	call	cmd
;;; the user must do that by hand (OP SCC, GO, OP ONL, GO)

;+
;
; Get modifiers.
;
;-
mod:	call	getoct		;get #
	bcs	10$
	mov	r0,txbuf+p.mod	;save
	rts	pc
10$:	mov	#msgprm,r0	;error
	callr	print		;print msg and return
;+
;
; Set MSCP controller.
;
;-
smscp:	mov	#du$csr+0,udip	;set addrs
	mov	#du$csr+2,udsa
	movb	#du$cid,cid
	rts	pc
;+
;
; OPCODE <xxx>
;
; Initialize cmd packet with specified opcode.
;
;-
opcode:	call	getoct		;try it as an octal number first
	bcc	10$
	call	getw		;get keyword
	bcs	30$		;none
	mov	#opcods,r0	;point at opcode list
	call	tbluk		;look it up
	bcs	40$		;not found
10$:	mov	#txbuf,r1	;point at packet
	mov	#<endpkt-txbuf>/2,r2 ;length in words
20$:	clr	(r1)+		;clear a word
	dec	r2		;loop
	bne	20$
	movb	r0,txbuf+p.opcd	;set opcode
	rts	pc
30$:	mov	#msgprm,r0	;missing parameter
	br	50$
40$:	mov	#invkey,r0	;invalid keyword
50$:	callr	print		;print msg, return
;
opcods:	; opcode values
	kw	<ABO->,op.abo
	kw	<GCS->,op.gcs
	kw	<GUS->,op.gus
	kw	<SCC->,op.scc
	kw	<AVL->,op.avl
	kw	<ONL->,op.onl
	kw	<SUC->,op.suc
	kw	<DAP->,op.dap
	kw	<ACC->,op.acc
	kw	<CCD->,op.ccd
	kw	<ERS->,op.ers
	kw	<FLU->,op.flu
	kw	<RPL->,op.rpl
	kw	<FMT->,op.fmt
	kw	<CMP->,op.cmp
	kw	<RD->,op.rd
	kw	<WR->,op.wr
	kw	<WTM->,op.wtm
	kw	<REP->,op.rep
	.byte	0
	.even
;+
;
; OSHOW [RESPONSE]
;
; Show raw octal packet contents.
;
; RESPONSE means show last response packet, otherwise command packet is used.
;
;-
oshow:	call	getw		;get keyword
	bcs	10$		;or not
	mov	#rspns,r0	;point at table
	call	tbluk
	bcs	20$
	mov	#rxbuf1,r5	;point at response
	callr	oshpkt		;show it, return
10$:	mov	#txbuf,r5	;point at cmd
	callr	oshpkt		;show it, return
20$:	mov	#invkey,r0	;point at msg
	callr	print		;print, return
;
rspns:	kw	<R-ESPONSE>,0	;the only valid keyword
	.byte	0
	.even
;+
;
; Show contents of a packet in octal.
;
; r5	pointer to packet
;
;-
oshpkt:	mov	r5,r4		;copy out of the way
	mov	-4(r4),r3	;get length
10$:	mov	#lbuf,r5	;point at line
	mov	(r4)+,r1	;save first word
	mov	(r4)+,r0	;get second
	mov	r3,-(sp)	;save
	mov	r4,-(sp)
	mov	r1,-(sp)
	call	proct6		;print +2 word
	cram	<,,>
	mov	(sp)+,r0	;restore +0 word
	call	proct6
	call	flush		;flush line
	mov	(sp)+,r4	;restore
	mov	(sp)+,r3
	sub	#4,r3		;count off the longword
	bhi	10$		;loop unless hit 0
	rts	pc
;+
;
; Tell port to poll.
;
;-
poll:	tst	@udip		;poll
.if ne 0
	mov	#2,r0		;count 2 clock edges
	tst	@#lk$csr	;flush existing clock pulse
10$:	tstb	@#lk$csr	;clock?
	bpl	10$		;no
	clr	@#lk$csr	;clear it (if writable)
20$:	tstb	@#lk$csr	;in any event wait for it to clear
	bmi	20$
	dec	r0		;count the edge
	bne	10$		;loop if more to do
.endc
	rts	pc
;+
;
; QUIT
;
;-
quit:	mov	#10$,@#4	;in case no M9312
	jmp	@#165020	;jump to M9312 console emulator
				;(machine-specific!!!)
10$:	halt			;OK whatever
	br	10$
;+
;
; RESET
;
; Issue RESET instruction.
;
;-
reset$:	reset			;reset devices
	rts	pc
;+
;
; Send the command packet we've been working on.
;
;-
send:	movb	cid,txbuf-1	;patch in connection ID
	mov	#txbuf,cring	;init ptr
	mov	#100000,cring+2	;set OWN=1 FLAG=0
	dec	cred		;count it off our credit total
	rts	pc
;+
;
; SHOW [RESPONSE]
;
; Show packet contents.
;
; RESPONSE means show last response packet, otherwise command packet is used.
;
;-
show:	call	getw		;get keyword
	bcs	10$		;or not
	mov	#rspns,r0	;point at table
	call	tbluk
	bcs	20$
	mov	#rxbuf1,r5	;point at response
	callr	shwpkt		;show it, return
10$:	mov	#txbuf,r5	;point at cmd
	callr	shwpkt		;show it, return
20$:	mov	#invkey,r0	;point at msg
	callr	print		;print, return
;+
;
; Show contents of a packet.
;
; r5	pointer to packet
;
;-
shwpkt:	mov	#pktyps,r0	;point at table
10$:	cmpb	p.opcd(r5),(r0)+ ;match?
	beq	40$		;yes
20$:	tstb	(r0)+		;skip to end of string
	bne	20$
30$:	tstb	(r0)+		;skip to end of parameters
	bne	30$
	cmp	r0,#epktyp	;end of table?
	blo	10$		;loop if not
	br	90$		;skip
40$:	mov	r0,r1		;copy out of the way
	call	print		;print name
50$:	tstb	(r1)+		;skip to end of string
	bne	50$
60$:	; handle next parm
	movb	(r1)+,r0	;get it
	beq	80$		;end of list
	mov	#parms,r2	;point at table
70$:	mov	(r2)+,r3	;get parm token
	mov	(r2)+,r4	;get routine to handle it
	cmp	r0,r3		;is this it?
	bne	70$		;loop if not (will always find it)
	mov	r1,-(sp)	;save
	mov	r5,-(sp)
	call	(r4)		;handle it (R5=packet addr)
	mov	(sp)+,r5	;restore
	mov	(sp)+,r1
	br	60$		;get next parm
80$:	rts	pc
90$:	movb	p.opcd(r5),r0	;get opcode
	mov	#lbuf,r5	;point at buffer
	cram	<UNKNOWN OPCODE >
	call	proct3		;print it
	callr	flush		;flush, return
;
pktyps:	.asciz	<op.abo>/ABORT/
	 .byte	0
	.asciz	<op.gcs>/GET COMMAND STATUS/
	 .byte	0
	.asciz	<op.gus>/GET UNIT STATUS/
	 .byte	0
	.asciz	<op.end+op.gus>/GUS END/
	 .byte	xunit,xsts,xunfl,xmedi,xgus,0
	.asciz	<op.scc>/SET CONTROLLER CHARACTERISTICS/
	 .byte	xunfl,0
	.asciz	<op.end+op.scc>/SCC END/
	 .byte	xunfl,0
	.asciz	<op.sex>/SERIOUS EXCEPTION/
	 .byte	0
	.asciz	<op.avl>/AVAILABLE/
	 .byte	0
	.asciz	<op.onl>/ONLINE/
	 .byte	xunit,0
	.asciz	<op.end+op.onl>/ONLINE END/
	 .byte	xunit,xunsz,0
	.asciz	<op.suc>/SET UNIT CHARACTERISTICS/
	 .byte	0
	.asciz	<op.dap>/DETERMINE ACCESS PATHS/
	 .byte	0
	.asciz	<op.acc>/ACCESS/
	 .byte	0
	.asciz	<op.ccd>/COMPARE CONTROLLER DATA/
	 .byte	0
	.asciz	<op.ers>/ERASE/
	 .byte	0
	.asciz	<op.flu>/FLUSH/
	 .byte	0
	.asciz	<op.rpl>/REPLACE/
	 .byte	0
	.asciz	<op.fmt>/FORMAT/
	 .byte	0
	.asciz	<op.cmp>/COMPARE HOST DATA/
	 .byte	0
	.asciz	<op.rd>/READ/
	 .byte	xunit,xlbn,xbuff,xbcnt,0
	.asciz	<op.end+op.rd>/READ END/
	 .byte	xsts,xunit,xlbn,xbuff,xbcnt,xact,0
	.asciz	<op.wr>/WRITE/
	 .byte	xunit,xlbn,xbuff,xbcnt,0
	.asciz	<op.end+op.wr>/WRITE END/
	 .byte	xsts,xunit,xlbn,xbuff,xbcnt,0
	.asciz	<op.wtm>/WRITE TAPE MARK(S)/
	 .byte	0
	.asciz	<op.rep>/REPOSITION/
	 .byte	xunit,xmod,xrecs,xfils,0
	.asciz	<op.end+op.rep>/REPOSITION END/
	 .byte	xsts,xunit,xlbn,xrecs,xfils,0
	.asciz	<op.ava>/AVAILABLE ATTN/
	 .byte	xunit,0
	.asciz	<op.dup>/DUPLICATE UNIT NUMBER ATTN/
	 .byte	xunit,0
	.asciz	<op.acp>/ACCESS PATH ATTN/
	 .byte	xunit,0
epktyp:
	.even
;
; Lookup table to find routine to display data for each "Xxxx" token:
;
parms:	.word	xunit,punit
	.word	xsts,psts
	.word	xmod,pmod
	.word	xunfl,punfl
	.word	xbcnt,pbcnt
	.word	xbuff,pbuff
	.word	xmedi,pmedi
	.word	xlbn,plbn
	.word	xunsz,punsz
	.word	xgus,pgus
	.word	xrecs,precs
	.word	xfils,pfils
	.word	xact,pact
;
punit:	; print unit #
	mov	p.unit(r5),r0	;fetch it
	clr	r1		;high order=0
	mov	#lbuf,r5	;point at line
	cram	<UNIT=>
	call	prdec		;print value
	callr	flush		;flush, return
;
psts:	; print status
	mov	p.sts(r5),r0	;fetch it
	mov	#lbuf,r5	;point at line
	cram	<STATUS=>
	call	proct6		;print value
	callr	flush		;flush, return
;
pmod:	; print modifiers
	mov	p.mod(r5),r0	;fetch it
	mov	#lbuf,r5	;point at line
	cram	<MODIFIERS=>
	call	proct6		;print value
	callr	flush		;flush, return
;
punfl:	; print unit (or controller) flags
	mov	p.unfl(r5),r0	;fetch it
	mov	#lbuf,r5	;point at line
	cram	<FLAGS=>
	call	proct6		;print value
	callr	flush		;flush, return
;
pbcnt:	; print byte count
	mov	p.bcnt(r5),r0	;fetch it
	mov	p.bcnt+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<BYTE COUNT=>
	call	prdec		;print value
	callr	flush		;flush, return
;
pbuff:	; print bus address
	mov	p.buff(r5),r0	;fetch it
	mov	p.buff+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<BUS ADDR=>
	bic	#^C77,r1	;isolate high order
	mov	#8.,r2		;# digits
	call	proct		;print value
	callr	flush		;flush, return
;
pmedi:	; print medium ID
	mov	p.medi(r5),r0	;fetch it
	mov	p.medi+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<PREFERRED NAME=>
	mov	r1,r2		;copy
	mov	#11.,r3		;shift count to right-justify
	call	10$		;print
	mov	r1,r2		;copy again
	mov	#6,r3		;get next letter down
	call	10$
	cram	<:, VOLUME=>
	mov	r1,r2		;copy letter #1
	mov	#1,r3		;shift count
	call	10$
	mov	r0,r2		;copy letter #2 (minus high bit)
	asr	r1		;get LSB
	ror	r2		;now in high 5 bits
	mov	#11.,r3		;shift count (accounting for above)
	call	10$		;print
	mov	r0,r2		;copy letter #3
	mov	#7,r3		;shift count
	call	10$
	bic	#^C177,r0	;isolate low 7 bits
	clr	r1		;zero-extend
	add	#100.,r0	;guarantee 3 digits
	call	prdec
	movb	-2(r5),-3(r5)	;make that 2 digits
	movb	-(r5),-1(r5)
	callr	flush		;flush, return
10$:	; save char in R2, 1-26.=A-Z, 0=null, R3=# right shifts (>0)
	asr	r2		;right a bit
	dec	r3		;done all shifts?
	bne	10$		;loop if not
	bic	#^C37,r2	;isolate
	beq	20$
	add	#'A-1,r2	;convert to ASCII
	movb	r2,(r5)+	;save
20$:	rts	pc
;
plbn:	; print LBN #
	mov	p.lbn(r5),r0	;fetch it
	mov	p.lbn+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<LBN=>
	call	prdec		;print value
	callr	flush		;flush, return
;
punsz:	; print unit size
	mov	p.unsz(r5),r0	;fetch it
	mov	p.unsz+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<UNIT SIZE=>
	call	prdec		;print value
	callr	flush		;flush, return
;
pgus:	; print OP.GUS information
	mov	r5,r4		;copy
	mov	#lbuf,r5	;point at line
	cram	<SHADOW UNIT=>
	mov	p.shun(r4),r0	;get shadow unit
	clr	r1		;zero-extend
	call	prdec		;print value
	call	flush
	cram	<TRACK SIZE=>
	mov	p.trck(r4),r0	;get track size
	clr	r1		;as above
	call	prdec
	cram	<, GROUP SIZE=>	;group size
	mov	p.grp(r4),r0
	clr	r1
	call	prdec
	cram	<, CYL SIZE=>	;cyl size
	mov	p.cyl(r4),r0
	clr	r1
	call	prdec
	call	flush		;flush line
	cram	<RCT SIZE=>
	mov	p.rcts(r4),r0
	clr	r1
	call	prdec
	cram	<, REPL BLKS/TRACK=> ;RBNs/track
	clr	r0		;(unsigned byte)
	bisb	p.rbns(r4),r0
	clr	r1
	call	prdec
	cram	<, # RCT COPIES=> ;# of RCTs
	clr	r0
	bisb	p.rctc(r4),r0
	clr	r1
	call	prdec
	callr	flush		;flush, return
;
precs:	; print record/object count
	mov	p.bcnt(r5),r0	;fetch it
	mov	p.bcnt+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<RECORD/OBJECT COUNT=>
	call	prdec		;print value
	callr	flush		;flush, return
;
pfils:	; print file count
	mov	p.tcnt(r5),r0	;fetch it
	mov	p.tcnt+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<TAPE MARK COUNT=>
	call	prdec		;print value
	callr	flush		;flush, return
;
pact:	; print actual rec length
	tstb	cid		;TMSCP?
	beq	10$		;no
	mov	40(r5),r0	;fetch it
	mov	40+2(r5),r1
	mov	#lbuf,r5	;point at line
	cram	<ACTUAL REC LEN=>
	call	prdec		;print value
	callr	flush		;flush, return
10$:	rts	pc
;+
;
; Set TMSCP controller.
;
;-
stmscp:	mov	#mu$csr+0,udip	;set addrs
	mov	#mu$csr+2,udsa
	movb	#mu$cid,cid
	rts	pc
;+
;
; Get unit number.
;
;-
unit:	call	getdec		;get #
	bcs	10$
	mov	r0,txbuf+p.unit	;save
	rts	pc
10$:	mov	#msgprm,r0	;error
	callr	print		;print msg and return
;+
;
; UDA50 bootstrap read driver.
;
; r5	memory addr
; r4	block count
; r3	starting block
;
;-
read:	jsr	r5,inipkt	;init packet
	 .word	op.rd		;func=read
	mov	r3,txbuf+p.lbn	;set block #
	swab	r4		;word count
	asl	r4		;byte count
	mov	r4,txbuf+p.bcnt
	mov	r5,txbuf+p.buff	;bus addr
	;br	cmd		;do it, return
;
cmd:	; do command
	mov	#rring,r1	;point at descriptors
	mov	#rxbuf,(r1)+	;reinit descriptors
	mov	#100000,(r1)+	;OWN=1, FLAG=0
	mov	#txbuf,(r1)+	;(RQDX3 appears to clear out whole entry)
	mov	#100000,(r1)
	tst	@udip		;tell UDA50 to poll
10$:	tst	rring+2		;wait until UDA gives back msg buf
	bmi	10$
20$:	tst	cring+2		;and cmd buf
	bmi	20$
	bitb	#37,rxbuf+p.sts	;error completion?
	bne	30$		;yes
	rts	pc
30$:	bpt
;+
;
; Init command packet.
;
; Called through r5 with in-line opcode word.
;
; r3-5	preserved
;
;-
inipkt:	mov	#txbuf,r1	;point at it
	mov	#<endpkt-txbuf>/2,r2 ;length in words
10$:	clr	(r1)+		;clear a word
	dec	r2		;loop
	bne	10$
	mov	(r5)+,txbuf+p.opcd ;set opcode
;;;	mov	bunit,txbuf+p.unit ;and unit #
	rts	r5
;+
;
; Handle traps to 4/10.
;
;-
t4:	mov	#trap4,r0	;point at message
	br	t10a
t10:	mov	#trap10,r0
t10a:	call	print		;print it
	jmp	mloop		;restart
;+
;
; Cram in-line text into output buffer.
;
; r5	buf ptr
; r0	link register for JSR
;
;-
cram$:	movb	(r0)+,(r5)+	;copy a byte
	bne	cram$		;loop until 0
	dec	r5		;un-put final 0
	inc	r0		;.EVEN
	bic	#1,r0
	rts	r0		;return
;+
;
; Flush output buffer.
;
; r5	output line buffer, reinitted to beginning of line on return
;
; All others preserved.
;
;-
flush:	clrb	(r5)		;mark end
	mov	#lbuf,r5	;reinit
	mov	r0,-(sp)	;save
	mov	r5,r0		;copy
	call	print
	mov	(sp)+,r0	;restore
	rts	pc
;+
;
; Print octal number.
;
; r1:r0	number
; r2	# digits (PROCT only)
; r5	output line ptr (updated on return)
;
;-
proct3:	bic	#^C377,r0	;isolate low byte
	mov	#3,r2		;print 3-digit number
	br	proct		;go print
proct6:	clr	r1		;isolate low word
	mov	#6,r2		;print 6-digit number
proct:	; print # digits in R2
	add	r2,r5		;update ptr
	mov	r5,r3		;copy
10$:	mov	r0,r4		;copy low 3 bits of #
	bic	#^C7,r4		;isolate digit
	bis	#'0,r4		;convert to ASCII (C=0)
	movb	r4,-(r3)	;[save]
	ror	r1		;right 1 bit (C=0 from above
	ror	r0
	asr	r1		;right 2 more bits (b31=0)
	ror	r0
	asr	r1
	ror	r0
	dec	r2		;count the digit
	bne	10$		;loop until all done
	rts	pc
;+
;
; Print variable-width decimal number.
;
; r1:r0	number (MSW in R1)
; r5	output line ptr (updated on return)
;
;-
prdec:	clr	r2		;init remainder
	mov	#32.,r3		;init loop counter
10$:	asl	r0		;shift a bit left
	rol	r1		;through R1
	rol	r2		;into R2
	cmp	r2,#10.		;will 10. fit in?
	blo	20$		;no
	sub	#10.,r2		;yes, subtract it out
	inc	r0		;and count it in quotient
20$:	dec	r3		;loop through all bits of dividend
	bne	10$
	mov	r0,r3		;copy
	bis	r1,r3		;quotient =0?
	beq	30$		;yes
	mov	r2,-(sp)	;there are more digits, save this one
	call	prdec		;recurse for other digits
	mov	(sp)+,r2
30$:	add	#'0,r2		;convert digit to ASCII
	movb	r2,(r5)+	;save
	rts	pc
;+
;
; Parse a word from the command line.
;
; r5	current position
; r4	# chars left
;
; On return:
; r5	points at posn after last char of word
; r4	updated
; r3	points at begn of word if C=0
; r2	length of word
;
; C=1 if no word available.
;
;-
getw:	tst	r4		;anything?
	beq	20$		;no
10$:	; look for beginning of word
	mov	r5,r3		;in case word starts here
	movb	(r5)+,r0	;get a char
	cmp	r0,#<' >	;blank or ctrl?
	bhi	40$		;no
	dec	r4		;loop
	bne	10$
20$:	sec			;no luck
	rts	pc
30$:	; look for end of word
	movb	(r5)+,r0	;get a char
40$:	cmp	r0,#<' >	;blank or ctrl?
	blos	60$		;yes, end of word
	cmp	r0,#'a		;lower case?
	blo	50$
	cmp	r0,#'z		;hm?
	bhi	50$
	bic	#40,r0		;yes, convert
	movb	r0,-1(r5)	;put back
50$:	sob	r4,30$		;loop
	inc	r5		;compensate for next inst
60$:	dec	r5		;unget
	mov	r5,r2		;calc length
	sub	r3,r2		;C=0
	rts	pc
;+
;
; Parse an octal number from the command line.
;
; r5	cmd line ptr
; r4	# chars left (both updated on return)
; r1:r0	returns number
;
;-
getoct:	clr	r0		;init number
	clr	r1
	tst	r4		;anything?
	beq	20$		;no
10$:	; skip white space
	mov	r5,r3		;in case number starts here
	movb	(r5)+,r2	;get a char
	cmp	r2,#<' >	;blank or ctrl?
	bhi	40$		;no
	dec	r4		;loop
	bne	10$
20$:	sec			;no luck
	rts	pc
30$:	movb	(r5)+,r2	;get a char
40$:	sub	#'0,r2		;convert to binary
	cmp	r2,#7		;legal digit?
	bhi	50$		;no
	asl	r0		;make space
	rol	r1
	asl	r0
	rol	r1
	asl	r0
	rol	r1
	bis	r2,r0		;insert new character
	dec	r4		;count char
	bne	30$		;loop
	inc	r5		;compensate for next inst
50$:	dec	r5		;un-get char
	cmp	r5,r3		;any chars?  (C=0 if so)
	bhi	60$
	 sec			;C=1
60$:	rts	pc
;+
;
; Parse a decimal number from the command line.
;
; r5	cmd line ptr
; r4	# chars left (both updated on return)
; r1:r0	returns number
;
;-
getdec:	clr	r0		;init number
	clr	r1
	tst	r4		;anything?
	beq	20$		;no
10$:	; skip white space
	mov	r5,r3		;in case number starts here
	movb	(r5)+,r2	;get a char
	cmp	r2,#<' >	;blank or ctrl?
	bhi	40$		;no
	dec	r4		;loop
	bne	10$
20$:	sec			;no luck
	rts	pc
30$:	movb	(r5)+,r2	;get a char
40$:	sub	#'0,r2		;convert to binary
	cmp	r2,#9.		;legal digit?
	bhi	50$		;no
	asl	r0		;old # *2
	rol	r1
	mov	r1,-(sp)	;(save)
	mov	r0,-(sp)
	asl	r0		;*4
	rol	r1
	asl	r0		;*8
	rol	r1
	add	(sp)+,r0	;add in *2
	adc	r1
	add	(sp)+,r1	;to get *10. total
	add	r2,r0		;insert new character
	adc	r1
	dec	r4		;count char
	bne	30$		;loop
	inc	r5		;compensate for next inst
50$:	dec	r5		;un-get char
	cmp	r5,r3		;any chars?  (C=0 if so)
	bhi	60$
	 sec			;C=1
60$:	rts	pc
;+
;
; Look up a keyword in a table.
;
; r3	keyword } from GETW
; r2	length  }
; r0	table
;
; Returns C=1 if not found, otherwise r0=number or call addr from table.
;
; r5,r4	preserved either way.
;
;-
tbluk:	mov	r5,-(sp)	;save
	mov	r4,-(sp)
10$:	movb	(r0)+,r4	;get length to match
	beq	50$		;end of table
	movb	(r0)+,r1	;get total length
	cmp	r2,r4		;is ours long enough?
	blo	40$		;no
	cmp	r2,r1		;too long?
	bhi	40$
	sub	r2,r1		;find # to go after abbreviation
	mov	r3,r5		;copy ptr
	mov	r2,r4		;and ctr
20$:	cmpb	(r0)+,(r5)+	;match?
	bne	30$		;no
	dec	r4		;loop
	bne	20$
	; got it
	add	r1,r0		;skip to end of string (C=0)
	inc	r0		;.EVEN
	bic	#1,r0
	mov	(r0),r0		;get value
	mov	(sp)+,r4	;restore
	mov	(sp)+,r5
	rts	pc		;C=0 from ADD above
30$:	dec	r0		;unget failed char
	add	r4,r0		;skip to end of abbreviation
40$:	add	r1,r0		;skip from there to end of string
	inc	r0		;.EVEN
	bic	#1,r0
	tst	(r0)+		;skip arg
	br	10$		;around for more
50$:	mov	(sp)+,r4	;restore
	mov	(sp)+,r5
	sec			;error return
	rts	pc
;+
;
; Get a line from the TTY (not quite like RT-11 .GTLIN).
;
; r0	prompt string
; r1	addr of 81.-byte buffer (81st byte is for NUL that marks end)
;
; r0	returns actual length of line (not including NUL), others preserved
;
;-
gtlin:	mov	r2,-(sp)	;save
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
10$:	mov	r0,-(sp)	;save prompt
	call	print		;print prompt
	mov	r1,r5		;working copy of ptr
20$:	tstb	@#kbcsr		;wait for a character
	bpl	20$		;loop
	mov	@#kbbuf,r0	;get char
	bic	#^C177,r0	;trim to 7 bits
	cmp	r0,#cr		;end of line?
	beq	70$
	cmp	r0,#'U&77	;^U?
	beq	60$
	cmp	r0,#177		;rubout?
	beq	40$
	mov	r5,r4		;copy ptr
	sub	r1,r4		;find length
	cmp	r4,#80.		;buf full?
	beq	20$		;yes, ignore character
	movb	r0,(r5)+	;save the char
	bit	#^C37,r0	;ctrl char?
	bne	30$		;no, easy
	mov	r0,r4		;save char
	mov	#'^,r0		;^ first
	call	ttyout
	mov	r4,r0		;copy
	bis	#100,r0		;convert to letters etc.
30$:	call	ttyout		;echo
	br	20$		;around for more
40$:	; rubout
	cmp	r5,r1		;at BOL?
	beq	20$		;yes, ignore
	mov	#bsbbsb,r0	;assume ctrl char
	bitb	#^C37,-(r5)	;is it?
	beq	50$
	 mov	#bsb,r0		;no, just one column
50$:	call	print		;delete it
	br	20$		;around for more
60$:	; ^U
	mov	#ctrlu,r0	;point at string
	call	print		;echo it
	mov	(sp)+,r0	;restore prompt addr
	br	10$		;start over
70$:	; CR
	clrb	(r5)		;mark end
	mov	#crlf,r0	;pt at string
	call	print		;echo the CR
	mov	r5,r0		;copy
	sub	r1,r0		;compute length
	tst	(sp)+		;flush prompt string address
	mov	(sp)+,r5	;restore
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	rts	pc		;(R1 was never touched)
;+
;
; Print a string (like RT-11 .PRINT).
;
; r0	addr of string, ended with 0 (implicit CRLF) or 200 (no CRLF)
;
; R0 trashed, others preserved.
;
;-
print:	bitb	#177,(r0)	;done?
	beq	20$		;yes, skip
10$:	tstb	@#ttcsr		;ready?
	bpl	10$		;no
	movb	(r0)+,@#ttbuf	;print it
	br	print
20$:	tstb	(r0)		;0 or 200?
	bmi	30$		;200, skip
	mov	#crlf,r0	;add CR, LF
	br	10$
30$:	rts	pc
;+
;
; Send a char to the TTY (like RT-11 .TTYOUT).
;
; r0	char to send
; other regs preserved (actually R0 too)
;
;-
ttyout:	tstb	@#ttcsr		;ready?
	bpl	ttyout		;no
	mov	r0,@#ttbuf	;print it
	rts	pc
;
banner:	.ascii	/DUTEST  by John Wilson  <wilson@dbit.com>/<cr><lf>
	.ascii	/Copyright (C) 1997, 1998 by Digby's Bitpile, Inc.  /
	.asciz	/All rights reserved./
bsbbsb:	.byte	bs,' ,bs	;two sets of backspace/space/backspace
bsb:	.byte	bs,' ,bs,200	;backspace/space/backspace, MUST FOLLOW BSBBSB
clrscr:	.ascii	<33>/</<33>/[H/<33>/[J/<200> ;assume ANSI terminal
crdits:	.ascii	/Message credits:  /<200>
crlf:	.byte	cr,lf,200
ctrlu:	.asciz	/^U/		;^U echo (cancels line and re-prompts)
prompt:	.byte	'=,200
;
inierr:	.asciz	/?Init error/
invkey:	.asciz	/?Invalid keyword/
msgprm:	.asciz	/?Missing parameter/
rcvd:	.asciz	/Received packet:/
trap10:	.asciz	/?Trap to 10/
trap4:	.asciz	/?Trap to 4/
;
cid:	.byte	du$cid		;connection ID, 0=MSCP, 1=TMSCP
	.even
;
udip:	.word	du$csr+0	;addr of init/polling register
udsa:	.word	du$csr+2	;addr of status/addr, purge register
;
; MSCP packet buffer
;
.iif gt <<.-start>&777>-774, .=.+4
.=.+<774-<<.-start>&777>>
	.word	endpkt-txbuf	;length of packet
	.word	0		;virtual circuit ID
txbuf:	; actual start of packet
	.blkb	60.
endpkt:
;
.iif gt <<.-start>&777>-774, .=.+4
.=.+<774-<<.-start>&777>>
	.blkw	2
rxbuf:	.blkb	60.		;receive buffer
;
	.blkw	2
rxbuf1:	.blkb	60.		;copy of receive buffer
;
	.blkw	2
	; prev 2 words get overwritten with int info by port
rring:	.blkw	2		;response ring base
cring:	.blkw	2		;command ring base
;
steps:	.word	100000		;STEP bit, no interrupts, rings=1 entry each
	.word	rring		;LSW of ring pointer base
	.word	0		;MSW=0
	.word	1		;burst=default, last fail=no, go
;
stepv:	.blkw	4		;SA values during each init step 1-4
;
cred:	.blkw			;command buffer credit account
;
lbuf:	.blkb	81.		;line buffer
;
	.even
.=.+<1000-<<.-start>&777>>
buf:	.blkb	512.*16.	;space for 16 blocks
;
	.end	start