.title	RAID
	.rem	$

	* * * * * * *
	*  R A I D  *
	* * * * * * *

a Really Awesome Interactive Debugger

RT-11 version

By John Wilson, Concord Academy class
of '124 ('84. decimal).

Developed on
RSTS/E V7.0-07 Digby's Bitpile
running on the PDP-11/34 at Concord Academy,
194 Main St., Concord, MA 01742
(RT-11SJ V3.0 emulator)

Spring, 1984.

Modified for real RT-11 on a
PDT-11/150 running RT-11FB V04.00G,
12-Aug-84.

This program should be LINKed with the
program to be debugged, as follows:

.LINK
*OUTFILE=OBJFILE1[,OBJFILE2,...],RAID/T
Transfer symbol? ST.DBG

This will load OBJFILE1 at 1000 (octal).

Commands:
B addr		set [B]reakpoint - all breakpoints are removed
		 on any halt (processor error, breakpoint)
D addr/value	[D]eposit value in core
E addr1[-addr2]	[E]xamine core from addr1 to addr2
F addr1[-addr2]	same as E, but byte, with ASCII
G addr		[G]o to addr
H or ?		[H]elp
L addr1[-addr2]	[L]ist - disassemble from addr1 to addr2
P		[P]roceed from BPT, T-bit, or ^C trap
Q		[Q]uit RAID
R[#=val]	[change and] display [R]egisters
S		single [S]tep

Separators between arguments may be -, /, :, or =
register numbers used when changing registers with
the R command are:
0-5	R0-R5
6	SP
7	PC
10	C (carry flag)
11	V (overflow flag)
12	Z (zero flag)
13	N (negative flag)

Any 16-bit value may be put into 0-7.  puting 0 into a
flag clears it, any other value sets it.

Examples:

G 1000		starts at location 1000
L 700-776	disassembles from 7000 to 776
R3=42		sets R3 to 42 and shows all registers and flags
R12=1		sets Z flag and shows all reg's and flags
B 700		sets a breakpoint at 700
Q		exits
D 31/42		puts 42 in loc. 30 (address is forced even)

Any extra arguments are ignored.  If two arguments represent
a range (as for L), the two values are put in ascending order
before use.  If either one is left out, but a separator is used,
then the defaults are 0 for the left value, 177777 for the
right value.  All numbers are expressed in octal.

$
;
	.radix	8
;
jsw=	44	;RT-11 job status word
cr=	15
lf=	12
ff=	14
esc=	33
true=	1
false=	0
; RT11 EMTs
.ttyout	=emt+341	;print a char on KB:
.exit	=emt+350	;exit to KBM
.rctrlo	=emt+355	;cancel ^O or ^C effect
.sfpa	=emt+375	;set floating point error vector
.trpset	=emt+375	;set odd address and reserved instr vectors
;
op0=	0	;vector for instructions with no operands (disasm)
;
	.enabl	lc
;
	.macro	$sob	reg,lab	;fake sob instr on LSI-11
	dec	reg
	bne	lab
	.endm
;	
	.macro	exch	op1,op2	;exchange op1 and op2
	mov	op1,-(sp)
	mov	op2,op1
	mov	(sp)+,op2
;no XOR instruction on the PDT-11/150, but
;if you have a newer PDP-11, the following
;expansion will work faster:
;	xor	op1,op2
;	xor	op2,op1
;	xor	op1,op2
	.endm
;this macro may not see a lot of use
;
	.macro	.print	addr
	mov	#'addr,r0
	emt	351
	.endm
;that one, on the other hand...
;
	.macro	.type	addr
	mov	#'addr,r0
	jsr	pc,print	;checks for PRNFLG
	.endm
;
	.macro	.line	string,zero
	.ascii	/'string'/
	.if nb zero
	.byte	0
	.iff
	.byte	cr,lf
	.endc
	.endm
;
	.macro	.asci2	string
	.ascii	/'string'/<200>
	.endm
;
	.macro	.instr	mask,result,name,bflag,oprnds
	.word	mask,result,name,oprnds!bflag
	.endm
;
	.macro	.data	instr
t$'instr':	.ascii	/'instr'/<200>
	.endm
;
	.mcall	.gtlin
;
; beginning of main program.
; prints header, starts GETLIN.
;
st.dbg::	;starting address for debugger
	.print	header		;print header
	mov	#break,14	;set BPT pseudo-vector
	clr	16		;zero flag word
	mov	#vect1,r0	;set bus error vector
	.trpset
	mov	#vect2,r0	;set floating point error vector
	.sfpa
	bisb	#100,@#jsw+1	;enable lower case input
;
getlin:	mov	#stack,sp	;reset stack
	.gtlin	#kbbuf,#prompt	;print ":", get a line
;that sure is easier than RSTS/E .READ!
;
	mov	#kbbuf,r1	;r1 points into kb buffer
2$:	movb	(r1)+,r0	;get char
	beq	getlin		;blank line, ignore
	cmpb	r0,#40		;space or ctrl char?
	ble	2$		;yes, get next char
	jsr	pc,upcase	;cvt to upper case
;
lookup:	;(just to reset local variables, no one ever JMPs here)
;look up r0 on command table...
	clr	r2		;point at command table
1$:	tstb	cmdtbl(r2)	;end of table?
	beq	3$		;yes, complain
	cmpb	cmdtbl(r2),r0	;check char
	bne	2$		;not same, skip
	mov	#getlin,-(sp)	;put return addr on stack
	asl	r2		;point at word
	mov	loctbl(r2),-(sp);save address on stack
	br	parse		;go parse the line
2$:	inc	r2		;point at next entry
	br	1$		;loop
3$:	.print	what		;complain (?What?)
	br	getlin		;try again
;
parse:	;reset local labels, again
	clrb	num2		;clear 1st byte of second buffer
	mov	#num1,r2	;r2 points at first buffer
	clr	r3		;clear separator flag
1$:	movb	(r1)+,r0	;get byte
	beq	4$		;end of line, exit
	cmp	r0,#'-		;separators: [-,=,:,/]
	beq	2$
	cmp	r0,#'=
	beq	2$
	cmp	r0,#':
	beq	2$
	cmp	r0,#'/
	beq	2$
	jsr	pc,chknum	;then it must be a digit
	bcc	1$		;ignore ctrl chars
	movb	r0,(r2)+	;put in current number buffer
	br	1$		;loop
;
2$:	tst	r3		;separator flag set?
	beq	3$		;no, set it
	.print	exhyph		;extra hyphen (or whatever), gack
	br	getlin		;ignore line
3$:	dec	r3		;set separator flag
	clrb	(r2)		;put <nul> at end of number
	mov	#num2,r2	;point at other buffer
	br	1$		;and continue looping
;
4$:	clrb	(r2)		;put <nul> at end of number
	mov	#num1,r0	;point at first buffer
	tstb	(r0)		;empty field?
	bne	5$		;no, convert to binary
	clr	r4		;default is 0
	br	6$		;skip to check field 2
5$:	jsr	pc,rdnum	;get number into r0
	mov	r0,r4		;put it in r4
6$:	mov	#num2,r0	;point at second number
	tstb	(r0)		;empty field?
	bne	7$		;no, cvt to bin
	mov	#177777,r5	;default is 65535.
	.rem	!
the point of this is that now you can type something
like "L 1000-" and it will assume "L 1000-177777"
(to increase this program's already extreme cuspiness)
!
	br	8$		;skip to reorder
7$:	jsr	pc,rdnum	;cvt to bin
	mov	r0,r5		;put in r5
8$:	movb	cmdchr,r0	;get char back
	tst	r3		;how many numbers?
	beq	9$		;just one, don't reorder
	mov	r4,r1		;save paramaters in the
	mov	r5,r2		;order they were typed
	cmp	r4,r5		;in the right order?
	blos	9$		;yes, don't swap
	exch	r4,r5		;no, swap them
9$:	rts	pc		;jump to value on top of stack
;
	.rem	!
command line now parsed as follows:
first (non-blank) char in r0 (I can't remember why)
number (if any) before separator (if any) in r1 and r4
number (if any) after sep. (if any) in r2 and r5
if there were two numbers, the smaller one is in r4 and
the larger one is in r5. r1 and r2 contain the numbers
in the order typed (for D, R cmds).
r3=ascii value of separator (0 if none)
(r3.ne.0 if there was a separator (2 terms))
!
cmdtbl:	.byte	'B	;[B]reakpoint
	.byte	'D	;[D]eposit
	.byte	'E	;[E]xamine
	.byte	'F	;byte examine
	.byte	'G	;[G]o
	.byte	'H	;[H]elp
	.byte	'?	;help
	.byte	'L	;[L]ist
	.byte	'P	;[P]roceed from BPT, T-bit, or ^C trap
	.byte	'Q	;[Q]uit
	.byte	'R	;[R]egisters
	.byte	'S	;single [S]tep
	.byte	0	;(end of table)
	.even
loctbl:	.word	setbpt
	.word	depos
	.word	dump
	.word	bdump
	.word	go
	.word	help
	.word	help
	.word	list
	.word	prceed
	.word	exit
	.word	regist
	.word	sngstp
;
toomny:	;an argument was too big to be converted to 16.-bit binary
	.print	bignum		;complain
	jmp	getlin		;and loop
;
chknum:	;see if char in r0 is legal octal digit
	cmp	r0,#40		;ctrl char or space?
	blos	1$		;yes, tell caller to ignore
	cmp	r0,#'0		;below '0'?
	blo	invald		;yes, error
	cmp	r0,#'7		;above '7'?
	bhi	invald		;yes, error
	sec			;char was valid
	rts	pc		;return
1$:	clc			;ignore char
	rts	pc		;return
;
invald:	;invalid line, print error, clear stack, and get a line
	.print	what		;print "?What?"
	jmp	getlin		;get a new line
;
go:	;go (execute)
	tstb	num1		;number specified?
	beq	1$		;no, use default
	mov	r4,regs+16	;set pc
	jmp	prceed		;get regs and rtt
1$:	mov	#1000,regs+16	;default is begn of prog
	jmp	prceed		;get regs and rtt
;
setbpt:	;set breakpoint at addr
	bic	#1,r4		;make sure addr's even
	mov	numbpt,r1	;get number of entries
	cmp	r1,#20		;table full?
	blo	10$		;no
	.print	bptabf		;yes, print error
	rts	pc		;return
10$:	inc	numbpt		;inc number of entries
	clc			;clear carry
	rol	r1		;r1=r1*2, unsigned (word offset)
	mov	r4,bptadr(r1)	;put address
	mov	(r4),bptdat(r1)	;put data
	mov	#bpt,(r4)	;poke BPT in @r4
	rts	pc
;
regist:	;[change and] display registers
	tst	r3		;were there two operands?
	beq	99$		;no, just print registers
	cmp	r1,#13		;legal value?
	bhi	99$		;no, ignore
	cmp	r1,#7		;g.p. register?
	bgt	10$		;no, flag
	asl	r1		;convert to ptr
	mov	r2,regs(r1)	;poke register
	br	99$		;print regs
10$:	mov	#1,r0		;bit to rotate
	sub	#10,r1		;convert to [0,3]
	beq	17$		;nothing to rotate
15$:	rol	r0		;rotate one bit
	dec	r1		;done yet?
	bne	15$		;no, loop
17$:
;
;or, if you have EIS: (I don't)
;10$:	sub	#10,r1		;convert to [0,3]
;	mov	#1,r0		;bit to rotate
;	ash	r1,r0		;rotate bit to appropriate flag
;
	tst	r2		;was it zero?
	bne	20$		;no
	bic	r0,flags	;yes, clear the bit
	br	99$		;print regs
20$:	bis	r0,flags	;non-zero, set the bit
99$:	jmp	prregs		;print registers and return
;
sngstp:	;perform a single step
	jsr	pc,rstreg	;restore regs
	mov	(r0)+,sp	;get SP
	mov	2(r0),-(sp)	;get PSW
	mov	(r0),-(sp)	;get PC
	mov	regs,r0		;get R0
	bis	#20,2(sp)	;set T-bit (trace)
	decb	run		;set run flag
	rtt			;return, don't trap until next instr
;
prceed:	;proceed from BPT, T-bit, or ^C
	jsr	pc,rstreg	;restore regs
	mov	(r0)+,sp	;get SP
	mov	2(r0),-(sp)	;get PSW
	mov	(r0),-(sp)	;get PC
	mov	regs,r0		;get R0
	decb	run		;set run flag
	rti			;return
;
rstreg:	;restore General Purpose regs
	mov	#regs+2,r0	;point at regs
	mov	(r0)+,r1	;restore them
	mov	(r0)+,r2
	mov	(r0)+,r3
	mov	(r0)+,r4
	mov	(r0)+,r5
	.rem	!
the following must be done by the calling routine
to keep the stack clean:
	mov	(r0)+,sp	;get SP
	mov	2(r0),-(sp)	;get PSW
	mov	(r0),-(sp)	;get PC
	mov	regs,r0		;get R0
!
	rts	pc
;
	.rem	!
(no .SETCC directive in real RT-11 - RSTS/E only)

ctrlc:	;jumps here on ^C AST
	tstb	run		;check RUN flag
	beq	10$		;not running, don't dump regs
	mov	(sp)+,regs+16	;save PC
	mov	(sp)+,flags	;save PSW
	mov	sp,regs+14	;save SP
	mov	#stack,sp	;restore RAID stack
	jsr	pc,stop		;save regs, remove BPTs
	.rctrlo			;reenable output
	jsr	pc,prregs	;print regs
10$:	mov	#ctrlc,r0	;point at this routine
	.setcc			;reset vector
	.rctrlo			;reenable output (again, if we were running)
	jmp	getlin		;return
;
!
buserr:	;jumps here on trap to @#4 or @#10
	bcc	oddadr		;deal with odd address
	mov	(sp)+,regs+16	;save PC
	mov	(sp)+,flags	;save PSW
	mov	sp,regs+14	;save SP
	mov	#stack,sp	;restore RAID stack
	jsr	pc,stop		;save regs, remove BPTs
	.print	resins		;"%Reserved instruction trap"
	jsr	pc,prregs	;dump regs
	mov	#vect1,r0	;reset vector
	.trpset
	jmp	getlin		;get command
;
oddadr:	mov	(sp)+,regs+16	;save PC
	mov	(sp)+,flags	;save PSW
	mov	sp,regs+14	;save SP
	mov	#stack,sp	;restore RAID stack
	jsr	pc,stop		;save regs, remove BPTs
	.print	odaddr		;"%Odd address trap"
	jsr	pc,prregs	;print regs
	mov	#vect1,r0	;reset trap vector
	.trpset
	jmp	getlin		;get command
;
vect1:	.byte	0,3		;argument block for .TRPSET
	.word	buserr
;
fperr:	;jumps here on FP exception
	mov	(sp)+,fec	;get floating exception code
	mov	(sp)+,fea	;get floating error address
	mov	(sp)+,regs+16	;save PC
	mov	(sp)+,flags	;save PSW
	mov	sp,regs+14	;save SP
	mov	#stack,sp	;restore RAID stack
	jsr	pc,stop		;save regs, remove BPTs
	.print	flpter		;"%Floating point error"
	.print	fectxt		;print "FEC="
	mov	fec,r0		;get FEC
	jsr	pc,prnum	;print it
	.print	featxt		;print " FEA="
	mov	fea,r0		;get fea
	jsr	pc,prnum	;print it
	jsr	pc,crlf		;cr/lf
	jsr	pc,prregs	;dump regs
	mov	#vect2,r0	;reset vector
	.sfpa
	jmp	getlin		;get command
;
vect2:	.byte	0,30		;argument block for .SFPA
	.word	fperr
;
fec:	.word
fea:	.word
;
break:	;jumps here on BPT or T-bit SST
	mov	(sp)+,regs+16	;save PC
	mov	(sp)+,flags	;save PSW
	mov	sp,regs+14	;save SP
	mov	#stack,sp	;restore RAID stack
	jsr	pc,stop		;save regs, remove BPTs
20$:	bit	#16.,flags	;T-bit trap?
	bne	30$		;yes, don't change PC
	.print	brkat		;"break at "
	sub	#2,regs+16	;go back to where BPT started
	mov	regs+16,r0	;get PC
	jsr	pc,prnum	;print it
	jsr	pc,crlf		;cr/lf
30$:	bic	#16.,flags	;clear T-bit if set
	jsr	pc,prregs	;print regs
	jmp	getlin		;get next line
;
stop:	;deal with any stop (save regs, remove BPTs)
	clrb	run		;clear run flag
	mov	r5,regs+12	;save R5
	mov	#regs+12,r5	;point at reg table
	mov	r4,-(r5)	;save other regs
	mov	r3,-(r5)
	mov	r2,-(r5)
	mov	r1,-(r5)
	mov	r0,-(r5)
;now remove all breakpoints
	mov	numbpt,r0	;get number of BPTs
	beq	20$		;blow it off if none
	clr	r1		;clear subscript
10$:	mov	bptdat(r1),@bptadr(r1)	;replace word with old value
	tst	(r1)+		;r1+=2;, as C would say
	$sob	r0,10$		;continue until finished
20$:	rts	pc		;return
;
depos:	;deposit value in core
	bic	#1,r1		;make sure address is even
	mov	r2,(r1)		;deposit value
	rts	pc		;return
;
dump:	;dump (examine) core
	jsr	pc,even		;make sure r4 and r5 are even
	tst	r3		;was there a second number?
	bne	1$		;yes, continue
	mov	r4,r5		;no, use the first number
1$:	mov	r4,r0		;get current address
	jsr	pc,prnum	;print it
	.print	colon		;print ':'
	mov	#10,r1		;load ctr (8 columns)
2$:	.print	space		;print ' '
	mov	(r4)+,r0	;get number
	jsr	pc,prnum	;print it
	cmp	r4,r5		;yo' done yit?
	bhi	3$		;yes, go return
	$sob	r1,2$		;no, print another number
	jsr	pc,crlf		;print cr/lf
	br	1$		;start a new line
3$:	jmp	crlf		;print cr/lf and return
;
bdump:	;byte examine (with ASCII)
	tst	r3		;was there a second number?
	bne	1$		;yes, skip
	mov	r4,r5		;no, use the first number
1$:	mov	r4,r0		;get address
	jsr	pc,prnum	;print it
	.print	colon		;print ":"
2$:	mov	r4,-(sp)	;save ptr
	mov	#10,r1		;print 8 columns
3$:	.print	space		;print ' '
	movb	(r4)+,r0	;get contents
	jsr	pc,prbyte	;print it
	cmp	r4,r5		;finished yet?
	bhi	4$		;yes, go print ASCII
	$sob	r1,3$		;no, print another number
4$:	.print	space		;print " "
	.print	space		;twice
	.print	bar		;print "|"
	mov	(sp)+,r4	;get original ptr
	mov	#10,r1		;loop 8 times
5$:	movb	(r4)+,r0	;get a char
	jsr	pc,prchar	;print it
	cmp	r4,r5		;done yet?
	bhi	6$		;yes, return
	$sob	r1,5$		;loop 8 times
	.print	bar		;print "|"
	jsr	pc,crlf		;print cr/lf
	br	1$		;print a new line
6$:	.print	bar		;print "|"
	jmp	crlf		;print cr/lf and return
;
list:	;disassemble range
	jsr	pc,even		;make sure r4 and r5 are even
	tst	r3		;was there a second number
	bne	10$		;yes, continue
	mov	r4,r5		;no, use the first number
10$:	mov	r4,-(sp)	;save address
	clrb	prnflg		;dump output to ~ Ye Olde Bitte Buckette ~
	jsr	pc,disasm	;find number of words
; This is an EXTREME hack (but it works!).  Each instruction is disassembled
; twice. The first time, prnflg is cleared first and nothing is printed;
; the second time, prnflg is set, and the whole beef gets printed.
; The reason for this is that you can't tell how many words an instruction
; contains until after you've disassembled it, to find out how many and what
; modes of operands it has.  On the first pass, the disassembler is just
; finding out how many words to print in octal to print to the left
; of the disassembly.
	incb	prnflg		;reenable output
	mov	r4,r3		;get this address
	mov	(sp),r4		;restore starting address
	sub	r4,r3		;find difference (at least two)
	asr	r3		;divide by two (was word addr difference)
	mov	#3,r2		;number of fields needed
	sub	r3,r2		;number of blank data fields
; (to make columns line up)
	mov	r4,r0		;get starting address
	jsr	pc,prnum	;print it
	.type	colon		;":"
	.type	space		;" "
20$:	.type	space		;" "
	mov	(r4)+,r0	;get value
	jsr	pc,prnum	;print it
	$sob	r3,20$		;loop
	tst	r2		;number of unused fields=0?
	beq	40$		;yes, skip
30$:	.type	blank7		;"       " (space to a tab stop)
	$sob	r2,30$		;loop
40$:	.type	tab2		;2 tabs
	mov	(sp)+,r4	;get starting address
	jsr	pc,disasm	;disassemble a line
	cmp	r4,r5		;has r4 passed r5 yet?
	blos	10$		;no, loop
	rts	pc		;return to getlin
;
disasm:	;disassemble instruction at (r4)
	mov	(r4)+,r1	;get contents
	mov	r1,-(sp)	;save
	mov	#inslst,r2	;point at instruction list
10$:	bic	(r2)+,r1	;clear operand bits
	cmp	r1,(r2)+	;compare to expected result
	beq	20$		;this is it - go print
	add	#4,r2		;point at next entry
	mov	(sp),r1		;get opcode back
	br	10$		;loop until found
;I can assume that a correct value will always be found because
;there is an entry for "???" at the bottom of the list, with
;mask=1's and result=0's.
20$:	mov	(r2)+,r0	;point at string
	jsr	pc,print	;print string
	bit	#1,(r2)		;byte flag set?
	beq	30$		;no byte version of instr, skip
	bit	#100000,(sp)	;check high bit of opcode
	beq	30$		;high bit was clear, word
	.type	b		;print 'b'
	bic	#100000,(sp)	;chop off high bit
30$:	mov	(r2),r2		;get operand types (addr of routine)
	bic	#1,r2		;clear low bit
	bne	40$		;go print them
	tst	(sp)+		;no operands, clear stack
	jmp	crlf		;print cr/lf and return
40$:	cmp	r2,#chgflg	;SEx or CLx?
	beq	50$		;yes, don't print tab
	.type	tab		;print '	'
50$:	mov	(sp)+,r0	;get opcode back
	jmp	(r2)		;jump to the appropriate routine
;
op0.5:	;half operand (one register)
	jsr	pc,prreg	;print the register
	jmp	crlf		;print cr/lf and return
op1:	;single operand
	jsr	pc,proper	;print the operand
	jmp	crlf		;print cr/lf and return
op1.5:	;1-1/2 operand (reg,operand)
	mov	r0,-(sp)	;save opcode
	jsr	pc,right6	;shift register field to r0<2:0>
	jsr	pc,prreg	;print it
	.type	comma		;print ","
	mov	(sp)+,r0	;get opcode back
	jsr	pc,proper	;print the operand
	jmp	crlf		;print cr/lf and return
op2:	;two operand
	mov	r0,-(sp)	;save opcode
	jsr	pc,right6	;move first operand to bits 5:0
	jsr	pc,proper	;print it
	.type	comma		;print ","
	mov	(sp)+,r0	;get other operand
	jsr	pc,proper	;print it
	jmp	crlf		;print cr/lf and return
branch:	;BRanch instruction
	bic	#177400,r0	;mask out upper 8 bits
	movb	r0,r0		;sign extend (sxtb doesn't exist)
	asl	r0		;multiply by 2 (word)
	add	r4,r0		;add in current PC (instr addr +2)
	jsr	pc,prnum	;print resulting address
	jmp	crlf		;print cr/lf and return
muldiv:	;multiply or divide (or ash[c])
	mov	r0,-(sp)	;save opcode
	jsr	pc,proper	;print source
	.type	comma		;print ","
	mov	(sp)+,r0	;get opcode back
	jsr	pc,right6	;shift register into <2:0>
	jsr	pc,prreg	;print destination (count if ash[c])
	jmp	crlf		;print cr/lf and return
trpemt:	;trap or emt
	bic	#177400,r0	;mask out upper 8 bits
	jsr	pc,prbyte	;print the low byte
	jmp	crlf		;print cr/lf and return
fop1:	;fdst
	jsr	pc,pfoper	;print the operand
	jmp	crlf		;cr/lf and return
fop2a:	;fsrc,AC
	mov	r0,-(sp)	;save
	jsr	pc,pfoper	;print source
	mov	(sp)+,r0	;restore
	jsr	pc,prac		;print AC
	jmp	crlf		;cr/lf, return
fop2b:	;AC,fdst
	mov	r0,-(sp)	;save
	jsr	pc,prac		;print AC
	.type	comma		;","
	mov	(sp)+,r0	;restore
	jsr	pc,pfoper	;fdst
	jmp	crlf		;cr/lf, return
fop2c:	;src,AC
	mov	r0,-(sp)	;save
	jsr	pc,proper	;src
	.type	comma		;","
	mov	(sp)+,r0	;restore
	jsr	pc,prac		;AC
	jmp	crlf		;cr/lf, return
fop2d:	;AC,dst
	mov	r0,-(sp)	;save
	jsr	pc,prac		;AC
	.type	comma		;","
	mov	(sp)+,r0	;restore
	jsr	pc,proper	;dst
	jmp	crlf		;cr/lf, return
setpri:	;SPL instruction (which Digby doesn't have). oh well.
	bic	#177770,r0	;clear high bits
	add	#'0,r0		;convert to ASCII
	mov	r0,-(sp)	;save on stack - hack hack hack!
	mov	sp,r0		;pt at it
	jsr	pc,print	;print it (check prnflg)
	tst	(sp)+		;clear stack
	rts	pc		;return
chgflg:	;SEx, CLx
	mov	#flgnam,r1	;point at flags' names
	mov	#4,r2		;number of flags
	mov	r3,-(sp)	;save r3
	mov	r4,-(sp)	;and r4
	clr	r3		;nothing printed yet
	mov	r0,r4		;copy opcode into r4
10$:	ror	r4		;rotate a bit into C
	bcc	30$		;clear, continue
	tst	r3		;comma needed?
	beq	20$		;no
	.type	comma		;yes, print it
20$:	mov	(r1),-(sp)	;get flag name
	mov	sp,r0		;point at it
	jsr	pc,print	;print it
	tst	(sp)+		;clear stack
	inc	r3		;set comma flag
30$:	add	#2,r1		;inc ptr
	dec	r2		;checked all flags?
	bne	10$		;no
	mov	(sp)+,r4	;restore r4
	mov	(sp)+,r3	;and r3
	jmp	crlf		;yes, cr/lf, return
;
flgnam:	.ascii	/c/<200>/v/<200>/z/<200>/n/<200> ;names of flags
;
proper:	;print operand in r0 <5:0>
	bic	#177700,r0	;mask out upper 10. bits
	mov	r0,-(sp)	;save r0
	bic	#70,r0		;mask out <5:3>
	cmp	r0,#7		;reg=PC?
	bne	1$		;no, deal with it normally
	jmp	pcoper		;PC gets special treatment
1$:	mov	(sp),r0		;get back operand
	bic	#7,r0		;mask out register
prop1:	tst	r0		;mode 0?
	bne	10$		;no, continue
	mov	(sp)+,r0	;get register number
	jmp	prreg		;print register and return
10$:	cmp	r0,#10		;mode 1?
	bne	20$		;no, continue
	mov	(sp)+,r0	;get reg number
	jmp	prrgp		;print "(reg)"
20$:	cmp	r0,#20		;mode 2?
	bne	30$		;no, continue
25$:	mov	(sp)+,r0	;get reg number
	jsr	pc,prrgp	;print "(reg)"
	.type	plus		;print "+"
	rts	pc		;and return
30$:	cmp	r0,#30		;mode 3?
	bne	40$		;no, continue
	.type	at		;print "@"
	br	25$		;continue as if mode=2
40$:	cmp	r0,#40		;mode 4?
	bne	50$		;no, continue
45$:	.type	minus		;print "-"
	mov	(sp)+,r0	;get reg number
	jmp	prrgp		;print "(reg)" and return
50$:	cmp	r0,#50		;mode 5?
	bne	60$		;no, continue
	.type	at		;print "@"
	br	45$		;continue as if mode=4
60$:	cmp	r0,#60		;mode 6?
	bne	70$		;no, must be mode 7
65$:	mov	(r4)+,r0	;get index address
	jsr	pc,prnum	;print it
	mov	(sp)+,r0	;get reg number
	jmp	prrgp		;print "(reg)" and return
70$:	.type	at		;print "@"
	br	65$		;print "######(reg)"
;
pcoper:	;handle special interpretations of 27, 37, 67, and 77
	mov	(sp),r0		;clear stack, get opcode
	bic	#177707,r0	;mask out everything except mode
	cmp	r0,#20		;immediate?
	bne	2$		;no, continue
1$:	tst	(sp)+		;clear stack
	.type	number		;print "#"
	mov	(r4)+,r0	;get operand
	jmp	prnum		;print number and return
2$:	cmp	r0,#30		;absolute?
	bne	3$		;no, continue
	.type	at		;print "@"
	br	1$		;print "#"; r4
3$:	cmp	r0,#60		;relative?
	bne	5$		;no, continue
4$:	tst	(sp)+		;clear stack
	mov	(r4)+,r0	;get index
	add	r4,r0		;add on value of PC
	jmp	prnum		;print resulting address and return
5$:	cmp	r0,#70		;relative deferred?
	bne	6$		;no, go treat it normally
	.type	at		;print "@"
	br	4$		;print index
6$:	jmp	prop1		;go treat it like a normal register
;
pfoper:	;print FP operand in r0 <5:0>
	bic	#177700,r0	;clear out high 12. bits
	bit	#70,r0		;mode 0?
	beq	prfpac		;yes, print "ACn"
	jmp	proper		;no, print normal operand
;
prrgp:	;print reg in r0 with parenthesis around it
	mov	r0,-(sp)	;save r0
	.type	leftp		;print "("
	mov	(sp)+,r0	;get number back
	jsr	pc,prreg	;print reg name
	.type	rightp		;print ")"
	rts	pc		;return
;
prreg:	;print reg whose number is in r0
	bic	#177770,r0	;clear high 13. bits
	cmp	r0,#6		;pc or sp?
	blo	2$		;no, go print "r#"
	bne	1$		;go print "pc"
	.type	sptext		;print "sp"
	rts	pc		;and return
1$:	.type	pctext		;print "pc"
	rts	pc		;and return
2$:	add	#'0,r0		;convert to ASCII
	movb	r0,rtext+1	;put in buffer
	.type	rtext		;print "R#"
	rts	pc		;and return
;
prfpac:	;print FP accumulator whose # is in r0 <2:0>
	bic	#177770,r0	;clear other bits
prac1:	add	#'0,r0		;cvt to ascii
	movb	r0,actxt+2	;put in buffer
	.type	actxt		;print
	rts	pc		;and return
;
prac:	;print FP accumulator whose # is in r0 <7:6>
	jsr	pc,right6	;shift into <1:0>
	bic	#177774,r0	;clear high bits
	br	prac1		;jump into prfpac
;
exit:	clr	r0		;don't do anything weird
;this may have been what set off the nasty bug in the
;RSTS/E V7.0-07 RT-11SJ emulator - prints memory management
;error messages, forever, ^C and ^^C don't work.  hasn't
;happened since I added the "clr r0."
	.exit			;anyway, hit the road, Jack
;
help:	.print	hlptxt		;print help message
	rts	pc		;and return
;
prregs:	;print values of registers and flags
	mov	#regs,r1	;point at regs
	mov	#4,r2		;print 4 regs per line
	mov	#2,r3		;print 2 lines
	clr	r4		;start with r0
	br	20$		;don't print leading space before "r0"
10$:	.print	space		;print " "
20$:	mov	r4,r0		;get reg number
	jsr	pc,prreg	;print reg name
	inc	r4		;next register
	.print	equals		;"="
	mov	(r1)+,r0	;get value for next register
	jsr	pc,prnum	;print it
	$sob	r2,10$		;do this for all GP regs
	jsr	pc,crlf		;print cr/lf
	mov	#4,r2		;4 regs in next line, if not done
	$sob	r3,20$		;do all this twice
	.print	N		;" N="
	mov	#10,r0		;flag number
	jsr	pc,30$		;print <N>egative flag
	.print	Z		;" Z="
	mov	#4,r0
	jsr	pc,30$		;<Z>ero
	.print	V		;" V="
	mov	#2,r0
	jsr	pc,30$		;o<V>erflow
	.print	C		;" C="
	mov	#1,r0
	jsr	pc,30$		;<C>arry
	jsr	pc,crlf		;cr/lf
	mov	regs+16,r4	;get pc
	mov	r4,r5		;duplicate
	jmp	list		;disassemble next instr and return
;
30$:	bit	flags,r0	;is flag in r0 set?
	bne	40$		;yes
	.print	zero		;no, print "0"
	rts	pc		;and return
40$:	.print	one		;print "1"
	rts	pc		;and return
;
even:	;force r4 and r5 to be even
	bic	#1,r4		;clear bit 0
	bic	#1,r5		;in r4 and r5
	rts	pc		;return
;
wntnum:	;complain about lack of parameters
;what is this doing way down here???
	.print	nonum		;print message
	rts	pc		;and return
;
prnum:	;print r0 in octal
	mov	r0,-(sp)	;save regs
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	#numbuf+6,r1	;point at end of buffer
	mov	#5,r3		;loop counter
1$:	mov	r0,r2		;put # in r2
	bic	#177770,r2	;mask out all but <2:0>
	add	#60,r2		;convert to ASCII
	movb	r2,-(r1)	;put in buffer
	jsr	pc,right3	;shift right 3 bits
	$sob	r3,1$		;loop
	asr	r0		;shift highest bit into LINK
	jsr	pc,right3
	bcs	2$		;high bit was 1
	movb	#'0,-(r1)	;high bit was 0, put "0"
	br	3$
2$:	movb	#'1,-(r1)	;put "1"
3$:	.type	numbuf		;print number
	mov	(sp)+,r3	;restore regs
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	rts	pc		;return
;
prbyte:	;print lower byte of r0 in octal
	mov	r0,-(sp)	;save regs
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	#numbuf+6,r1	;point at end of buffer
	mov	r0,r2		;get 3 bits
	bic	#177770,r2	;mask out all but <2:0>
	jsr	pc,99$		;put in buffer
	jsr	pc,right3	;shift right 3 bits
	mov	r0,r2		;get 3 bits
	bic	#177770,r2	;mask out all but <2:0>
	jsr	pc,99$		;put in buffer
	jsr	pc,right3	;shift right 3 bits
	mov	r0,r2		;get 3 bits
	bic	#177774,r2	;mask out all but <1:0>
	jsr	pc,99$		;put in buffer
	mov	r1,r0		;point at number
	jsr	pc,print	;print it
	mov	(sp)+,r2	;restore regs
	mov	(sp)+,r1
	mov	(sp)+,r0
	rts	pc		;return
99$:	add	#60,r2		;convert to ASCII
	movb	r2,-(r1)	;put char in buff
	rts	pc		;return
;somehow, I think I could have done better with that routine...
;
right3:	;rotate r0 right 3 bits
	asr	r0
	asr	r0
	asr	r0
	rts	pc
;
right6:	;rotate r0 right 6 bits
	jsr	pc,right3	;right 3 bits
	jmp	right3		;right 3 bits, return
;
prchar:	;print char in r0<6:0>, print "." if ctrl char or rubout
	bic	#177600,r0	;clear high 9. bits
	cmp	r0,#177		;rubout?
	beq	1$		;yes, change to "." (rubout doesn't print)
	cmp	r0,#37		;ctrl char?
	bhi	2$		;no
1$:	movb	#'.,r0		;replace non-printing char with "."
2$:	.ttyout			;print the char
	rts	pc		;return
;
rdnum:	;return value of octal number at (r0) in r0
	mov	r1,-(sp)	;save regs
	mov	r2,-(sp)
	mov	r0,r1		;r1 points at buffer
	clr	r0		;init r0
1$:	movb	(r1)+,r2	;get char
	tst	r2		;<nul>?
	beq	2$		;yes, end of buffer, go return
	sub	#60,r2		;convert to binary
	asl	r0		;shift left 3 times, checking for carry
	bcs	3$
	asl	r0
	bcs	3$
	asl	r0
	bcs	3$
	bis	r2,r0		;OR in new digit
	br	1$		;loop until end of number or overflow
2$:	mov	(sp)+,r2	;restore
	mov	(sp)+,r1
	rts	pc		;and return
3$:	.print	bignum		;print error message
	jmp	getlin		;and return
;
crlf:	;print cr, lf
	mov	#fectxt-1,r0	;point at <0>
print:	;if(prnflg.ne.0) .print - used only by LIST
	tstb	prnflg		;trash output?
	beq	1$		;yes
	emt	351		;no, .PRINT
1$:	rts	pc		;return
;
upcase:	;routine to convert r0 to upper case
	cmpb	r0,#'a		;less than "a"?
	blo	1$		;yes, skip
	cmpb	r0,#'z		;greater than "z"?
	bhi	1$		;yes, skip
	sub	#32.,r0		;convert to upper case
1$:	rts	pc		;return
;
save1:	.word			;temp buffers for param's
save2:	.word
regs:	.word	0,0,0,0,0,0,1000,1000 ;save registers here
;default starting address for "<P>roceed" is 1000
flags:	.word	0		;save PSW here
numbpt:	.word	0		;number of BPTs set
bptadr:	.blkw	20		;table of addresses
bptdat:	.blkw	20		;  "   "    values  (before BPT was set)
prnflg:	.byte	1		;PRINT trashes output if zero
run:	.byte	0		;prog running if not 0, else RAID running
header:	.asciz	/RAID  v1.0  by John Wilson  RT-11 V04/ ;header
what:	.asciz	/?What?/
resins:	.asciz	/%Reserved instruction trap/ ;processor error messages
odaddr:	.asciz	/%Odd address trap/
flpter:	.asciz	/%Floating point error/
numbuf:	.=.+6
	.byte	200
num1:	.=.+7
num2:	.=.+7
exhyph:	.line	<too many separators>,0	;error for extra -,=, etc.
bignum:	.line	<number too large>,0	;error if number bigger than 16. bits
bptabf:	.line	<breakpoint table full>,0 ;out of BPT space
brkat:	.asci2	<break at >		;printed on BPT
nonum:	.line	<hey, buddy, let's have some parameters!>,0
hlptxt:	.line	<RAID commands:>
	.line	<B	set breakpoint>
	.line	<D	deposit memory>
	.line	<E	examine memory>
	.line	<F	byte examine>
	.line	<G	go to address>
	.line	<H or ?	print this message>
	.line	<L	disassemble ([L]ist)>
	.line	<P	proceed [from breakpoint]>
	.line	<Q	quit RAID>
	.line	<R	print registers>
	.line	<S	single step>,0
fectxt:	.asci2	<FEC=>
featxt:	.asci2	< FEA=>
prompt:
colon:	.asci2	<:>
blank7:	.asci2	<       >
space:	.asci2	< >
tab2:	.ascii	/	/
tab:	.asci2	<	>
rtext:	.asci2	<r >
sptext:	.asci2	<sp>
pctext:	.asci2	<pc>
actxt:	.asci2	<ac >
comma:	.asci2	<,>
leftp:	.asci2	<(>
rightp:	.asci2	<)>
at:	.asci2	<@>
plus:	.asci2	<+>
minus:	.asci2	<->
number:	.asci2	<#>
bar:	.byte	174,200		;.asci2 <|> doesn't work
equals:	.asci2	<=>
N:	.asci2	< N=>		;names for flags in PRREGS
Z:	.asci2	< Z=>
V:	.asci2	< V=>
C:	.asci2	< C=>
one:	.asci2	<1>
zero:	.asci2	<0>
	.even
inslst:	;instruction list
	.instr	0,0,t$halt,false,op0
	.instr	0,1,t$wait,false,op0
	.instr	0,2,t$rti,false,op0
	.instr	0,3,t$bpt,false,op0
	.instr	0,4,t$iot,false,op0
	.instr	0,5,t$rst,false,op0
	.instr	0,6,t$rtt,false,op0
	.instr	77,100,t$jmp,false,op1
	.instr	7,200,t$rts,false,op0.5
	.instr	7,230,t$spl,false,setpri
	.instr	0,240,t$nop,false,op0
	.instr	0,257,t$ccc,false,op0
	.instr	17,240,t$cl,false,chgflg
	.instr	0,277,t$scc,false,op0
	.instr	17,260,t$se,false,chgflg
	.instr	77,300,t$swab,false,op1
	.instr	377,400,t$br,false,branch
	.instr	377,1000,t$bne,false,branch
	.instr	377,1400,t$beq,false,branch
	.instr	377,2000,t$bge,false,branch
	.instr	377,2400,t$blt,false,branch
	.instr	377,3000,t$bgt,false,branch
	.instr	377,3400,t$ble,false,branch
	.instr	777,4000,t$jsr,false,op1.5
	.instr	100077,5000,t$clr,true,op1
	.instr	100077,5100,t$com,true,op1
	.instr	100077,5200,t$inc,true,op1
	.instr	100077,5300,t$dec,true,op1
	.instr	100077,5400,t$neg,true,op1
	.instr	100077,5500,t$adc,true,op1
	.instr	100077,5600,t$sbc,true,op1
	.instr	100077,5700,t$tst,true,op1
	.instr	100077,6000,t$ror,true,op1
	.instr	100077,6100,t$rol,true,op1
	.instr	100077,6200,t$asr,true,op1
	.instr	100077,6300,t$asl,true,op1
	.instr	77,6400,t$mark,false,op1
	.instr	77,6500,t$mfpi,false,op1
	.instr	77,6600,t$mtpi,false,op1
	.instr	77,6700,t$sxt,false,op1
	.instr	107777,10000,t$mov,true,op2
	.instr	107777,20000,t$cmp,true,op2
	.instr	107777,30000,t$bit,true,op2
	.instr	107777,40000,t$bic,true,op2
	.instr	107777,50000,t$bis,true,op2
	.instr	7777,60000,t$add,false,op2
	.instr	777,70000,t$mul,false,muldiv
	.instr	777,71000,t$div,false,muldiv
	.instr	777,72000,t$ash,false,muldiv
	.instr	777,73000,t$ashc,false,muldiv
	.instr	777,74000,t$xor,false,op1.5
;the following 4 instructions are from the
;old LSI-11 FIS instruction set, which we
;don't have (because we're better), but I
;want to be nice and generalized...
;
	.instr	7,75000,t$fadd,false,op0.5
	.instr	7,75010,t$fsub,false,op0.5
	.instr	7,75020,t$fmul,false,op0.5
	.instr	7,75030,t$fdiv,false,op0.5
	.instr	777,77000,t$sob,false,op1.5
	.instr	377,100000,t$bpl,false,branch
	.instr	377,100400,t$bmi,false,branch
	.instr	377,101000,t$bhi,false,branch
	.instr	377,101400,t$blos,false,branch
	.instr	377,102000,t$bvc,false,branch
	.instr	377,102400,t$bvs,false,branch
	.instr	377,103000,t$bcc,false,branch
	.instr	377,103400,t$bcs,false,branch
	.instr	377,104000,t$emt,false,trpemt
	.instr	377,104400,t$trap,false,trpemt
	.instr	77,106500,t$mfpd,false,op1
	.instr	77,106600,t$mtpd,false,op1
	.instr	7777,160000,t$sub,false,op2
;floating point:
	.instr	0,170000,t$cfcc,false,op0
	.instr	0,170001,t$setf,false,op0
	.instr	0,170002,t$seti,false,op0
	.instr	0,170011,t$setd,false,op0
	.instr	0,170012,t$setl,false,op0
	.instr	77,170100,t$ldfps,false,op1
	.instr	77,170200,t$stfps,false,op1
	.instr	77,170300,t$stst,false,op1
	.instr	77,170400,t$clrf,false,fop1
	.instr	77,170500,t$tstf,false,fop1
	.instr	77,170600,t$absf,false,fop1
	.instr	77,170700,t$negf,false,fop1
	.instr	377,171000,t$mulf,false,fop2a
	.instr	377,171400,t$modf,false,fop2a
	.instr	377,172000,t$addf,false,fop2a
	.instr	377,172400,t$ldf,false,fop2a
	.instr	377,173000,t$subf,false,fop2a
	.instr	377,173400,t$cmpf,false,fop2a
	.instr	377,174000,t$stf,false,fop2b
	.instr	377,174400,t$divf,false,fop2a
	.instr	377,175000,t$stexp,false,fop2d
	.instr	377,175400,t$stci,false,fop2d
	.instr	377,176000,t$stcd,false,fop2b
	.instr	377,176400,t$ldexp,false,fop2c
	.instr	377,177000,t$ldcif,false,fop2c
	.instr	377,177400,t$ldcdf,false,fop2a
	.instr	177777,0,t$what,false,op0
;
	.data	<halt>
	.data	<wait>
	.data	<rti>
	.data	<bpt>
	.data	<iot>
t$rst:	.asci2	<reset>
	.data	<rtt>
	.data	<jmp>
	.data	<rts>
	.data	<spl>
	.data	<nop>
	.data	<ccc>
	.data	<cl>
	.data	<scc>
	.data	<se>
	.data	<swab>
	.data	<br>
	.data	<bne>
	.data	<beq>
	.data	<bge>
	.data	<blt>
	.data	<bgt>
	.data	<ble>
	.data	<jsr>
	.data	<clr>
	.data	<com>
	.data	<inc>
	.data	<dec>
	.data	<neg>
	.data	<adc>
	.data	<sbc>
	.data	<tst>
	.data	<ror>
	.data	<rol>
	.data	<asr>
	.data	<asl>
	.data	<mark>
	.data	<mfpi>
	.data	<mtpi>
	.data	<sxt>
	.data	<mov>
	.data	<cmp>
	.data	<bit>
	.data	<bic>
	.data	<bis>
	.data	<add>
	.data	<mul>
	.data	<div>
	.data	<ash>
	.data	<ashc>
	.data	<xor>
	.data	<fadd>
	.data	<fsub>
	.data	<fmul>
	.data	<fdiv>
	.data	<sob>
	.data	<bpl>
	.data	<bmi>
	.data	<bhi>
	.data	<blos>
	.data	<bvc>
	.data	<bvs>
	.data	<bcc>
	.data	<bcs>
	.data	<emt>
	.data	<trap>
	.data	<mfpd>
	.data	<mtpd>
	.data	<sub>
	.data	<cfcc>
	.data	<setf>
	.data	<seti>
	.data	<setd>
	.data	<setl>
	.data	<ldfps>
	.data	<stfps>
	.data	<stst>
	.data	<clrf>
	.data	<tstf>
	.data	<absf>
	.data	<negf>
	.data	<mulf>
	.data	<modf>
	.data	<addf>
	.data	<ldf>
	.data	<subf>
	.data	<cmpf>
	.data	<stf>
	.data	<divf>
	.data	<stexp>
t$stci:	.asci2	<stcfi>
t$stcd:	.asci2	<stcfd>
	.data	<ldexp>
	.data	<ldcif>
	.data	<ldcdf>
t$what:	.asci2	<???>
b:	.asci2	<b>
cmdchr:	.byte
kbbuf:	.=.+81.			;keyboard buffer
	.even
	.=.+40			;RAID internal stack
stack=	.
	.end

that's all, folks!

SK DE KC1P