.title RAID .rem $ * * * * * * * * R A I D * * * * * * * * a Really Awesome Interactive Debugger RSTS/E 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 Street, Concord, MA 01742 (RT-11SJ V3.0 emulator) Spring, 1984. 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, ^C, 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 M number print RSTS/E error [M]essage number 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. Putting 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 ; firqb= 402 ;file request queue block xrb= 442 ;transfer request block cr= 15 lf= 12 ff= 14 esc= 33 true= 1 false= 0 ; RT11 emulator EMTs .exit =emt+350 ;exit to KBM .rctrlo =emt+355 ;cancel ^O or ^C effect .setcc =emt+362 ;set ^C vector ;(RSTS/E only) .errprt =emt+364 ;print error message ;(RSTS/E only) .sfpa =emt+375 ;set floating point error vector .trpset =emt+375 ;set odd address and reserved instr vectors ; op0= 0 ;vector for no-operand instructions (disassembler) ; .enabl lc ; .macro exch op1,op2 ;exchange op1 and op2 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 jsr pc,print .endm ;that one, on the other hand... ; .macro .line string,zero .ascii /'string'/ .byte cr,lf .if nb zero .byte 0 .endc .endm ; .macro .instr mask,result,name,bflag,oprnds .word mask,result,name,oprnds!bflag .endm ; .macro .data instr t$'instr': .asciz /'instr'/ .endm ; ; beginning of main program. ; prints header, starts GETLIN. ; st.dbg:: ;starting address for debugger mov #^R.RA,firqb+10 ;set name to ".RAID." mov #^RID.,firqb+12 ;for SYSTAT emt 377 ;RSTS prefix emt 44 ;.NAME .print header ;print header clr r0 ;error number 0 .errprt ;print sys. ID (RSTS V7.0-07 Digby's Bitpile) jsr pc,crlf ;cr, lf mov #break,14 ;set BPT pseudo-vector clr 16 ;zero flag word mov #ctrlc,r0 ;set ^C vector .setcc mov #vect1,r0 ;set bus error vector .trpset mov #vect2,r0 ;set floating point error vector .sfpa ; getlin: mov #stack,sp ;reset stack .print prompt ;print prompt getl1: mov #80.,xrb ;input buffer is 80. bytes long clr xrb+2 mov #kbbuf,xrb+4 ;put line in KBBUF clr xrb+6 ;KB is channel 0 clr xrb+10 ;read next block mov #-1,xrb+12 ;unlimited wait, command input clr xrb+14 emt 377 ;RSTS/E prefix emt 2 ;.READ line from keyboard tstb firqb ;error? beq 1$ ;no, skip movb firqb,r0 ;get error number .errprt ;print error jsr pc,crlf ;cr/lf br getlin ;get another line ; 1$: mov #kbbuf,r1 ;r1 points into kb buffer 2$: movb (r1)+,r0 ;get char cmpb r0,#cr ;cr? beq getlin ;yes, blank line, ignore cmpb r0,#lf ;lf? beq getlin ;ignore cmpb r0,#ff ;form feed? beq getl1 ;ignore (don't reprompt) (like RT-11 KBM) cmpb r0,#esc ;escape? beq getlin ;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$: mov #155,r0 ;complain (?What?) .errprt jsr pc,crlf 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 cmp r0,#cr ;delimiter? beq 4$ ;yes, exit cmp r0,#lf ;also check for lf, ff, esc beq 4$ cmp r0,#ff beq 4$ cmp r0,#esc beq 4$ 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 at end of number mov #num2,r2 ;point at other buffer br 1$ ;and continue looping ; 4$: clrb (r2) ;put 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 'M ;error [M]essage .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 messag .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 mov #155,r0 ;print "?What?" .errprt ;(or "?I beg your pardon?" on April 1) jsr pc,crlf ;cr/lf 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$: 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 ; messag: ;print error message mov r4,r0 ;get number .errprt ;print message jmp crlf ;cr/lf and return ; 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 ; 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 mov #42,r0 ;reserved instruction trap .errprt ;print it jsr pc,crlf ;cr/lf 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 mov #41,r0 ;odd address trap .errprt ;print message jsr pc,crlf ;cr/lf 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 mov #60,r0 ;floating point error .errprt ;print it jsr pc,crlf ;cr/lf .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 " " jsr pc,print ;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 .print colon ;":" .print space ;" " 20$: .print 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$: .print blank7 ;" " (space to a tab stop) sob r2,30$ ;loop 40$: .print 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 .print 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 .print 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 ash #-6,r0 ;shift register field to r0<2:0> jsr pc,prreg ;print it .print 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 ash #-6,r0 ;move first operand to bits 5:0 jsr pc,proper ;print it .print 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 .print comma ;print "," mov (sp)+,r0 ;get opcode back ash #-6,r0 ;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 .print 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 .print 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 .print 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 jmp crlf ;cr/lf, 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 .print comma ;yes, print it 20$: movb (r1),r0 ;get flag name mov r0,-(sp) ;put on stack mov sp,r0 ;point at it jsr pc,print ;print it tst (sp)+ ;clear stack inc r3 ;set comma flag 30$: inc 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 /cvzn/ ;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)" mov #plus,r0 ;print "+" jmp print ;and return 30$: cmp r0,#30 ;mode 3? bne 40$ ;no, continue .print at ;print "@" br 25$ ;continue as if mode=2 40$: cmp r0,#40 ;mode 4? bne 50$ ;no, continue 45$: .print minus ;print "-" mov (sp)+,r0 ;get reg number jmp prrgp ;print "(reg)" and return 50$: cmp r0,#50 ;mode 5? bne 60$ ;no, continue .print 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$: .print at ;print "@" br 65$ ;print "######(reg)" ; pcoper: ;handle special interpretations of 27, 37, 67, and 77 mov (sp),r0 ;get opcode bic #177707,r0 ;mask out everything except mode cmp r0,#20 ;immediate? bne 2$ ;no, continue 1$: tst (sp)+ ;clear stack .print number ;print "#" mov (r4)+,r0 ;get operand jmp prnum ;print number and return 2$: cmp r0,#30 ;absolute? bne 3$ ;no, continue .print 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 .print 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 .print leftp ;print "(" mov (sp)+,r0 ;get number back jsr pc,prreg ;print reg name .print 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" mov #sptext,r0 ;print "sp" jmp print ;and return 1$: mov #pctext,r0 ;print "pc" jmp print ;and return 2$: add #'0,r0 ;convert to ASCII movb r0,rtext+1 ;put in buffer mov #rtext,r0 ;print "r#" jmp print ;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 mov #actxt,r0 ;print jmp print ;and return ; prac: ;print FP accumulator whose # is in r0 <7:6> ash #-6,r0 ;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: mov #hlptxt,r0 ;print help message jmp print ;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 egative flag .print Z ;" Z=" mov #4,r0 jsr pc,30$ ;ero .print V ;" V=" mov #2,r0 jsr pc,30$ ;oerflow .print C ;" C=" mov #1,r0 jsr pc,30$ ;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 mov #zero,r0 ;no, print "0" jmp print ;and return 40$: mov #one,r0 ;print "1" jmp print ;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??? mov #nonum,r0 ;print message jmp print ;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 ash #-3,r0 ;shift right 3 bits sob r3,1$ ;loop ash #-4,r0 ;shift highest bit into LINK bcs 2$ ;high bit was 1 movb #'0,-(r1) ;high bit was 0, put "0" br 3$ 2$: movb #'1,-(r1) ;put "1" 3$: .print 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 ash #-3,r0 ;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 ash #-3,r0 ;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... ; 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$: mov r0,-(sp) ;save char mov sp,r0 ;pt at it jsr pc,print ;print it tst (sp)+ ;clear stack 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 ;? 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 rts pc ;and return ; crlf: ;print cr, lf mov #fectxt-3,r0 ;point at text ;fall through into PRINT... ; print: tstb (r0) ;null string? beq 3$ ;yes, return ;I don't think I ever need those last two lines... oh, well tstb prnflg ;printing turned off? beq 3$ ;yes, return mov r2,-(sp) ;save r2 mov r0,-(sp) ; and r0 clr r2 ;zero counter 1$: tstb (r0)+ ;end of string? beq 2$ ;yes, print it inc r2 ;no, increment count br 1$ ;and loop 2$: mov r2,@#xrb ;put length mov r2,@#xrb+2 ; again mov (sp)+,r0 ;get pointer back mov r0,@#xrb+4 ;put it in xrb clr @#xrb+6 ;channel #0 clr @#xrb+10 ;clear assorted stuff clr @#xrb+14 emt 377 ;RSTS/E prefix emt 4 ;call to Monitor mov (sp)+,r2 ;restore r2 3$: rts pc ;return to caller ; 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 "

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 / ;header prompt: .asciz /:/ ;prompt numbuf: .=.+6 .byte 0 num1: .=.+7 num2: .=.+7 exhyph: .line ,0 ;error for extra -,=, etc. bignum: .line ,0 ;error if number bigger than 16. bits bptabf: .line ,0 ;out of BPT space brkat: .asciz /break at / ;printed on BPT nonum: .line ,0 hlptxt: .line .line .line .line .line .line .line .line .ascii /M print RSTS/<'/> .line .line

.line .line .line ,0 fectxt: .asciz /FEC=/ featxt: .asciz / FEA=/ colon: .asciz /:/ blank7: .asciz / / space: .asciz / / tab2: .ascii / / tab: .asciz / / rtext: .asciz /r / sptext: .asciz /sp/ pctext: .asciz /pc/ actxt: .asciz /ac / comma: .asciz /,/ leftp: .asciz /(/ rightp: .asciz /)/ at: .asciz /@/ plus: .asciz /+/ minus: .asciz /-/ number: .asciz /#/ space7: .asciz / / bar: .byte 174,0 ;.asciz /|/ doesn't work equals: .asciz /=/ N: .asciz / N=/ ;names for flags in PRREGS Z: .asciz / Z=/ V: .asciz / V=/ C: .asciz / C=/ one: .asciz /1/ zero: .asciz /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 .data .data .data .data t$rst: .asciz /reset/ .data .data .data .data .data .data .data .data .data .data .data
.data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data

.data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data .data t$stci: .asciz /stcfi/ t$stcd: .asciz /stcfd/ .data .data .data t$what: .asciz /???/ b: .asciz /b/ cmdchr: .byte kbbuf: .=.+80. ;keyboard buffer .byte cr ;so a long line won't crash ;(because the first 80. bytes won't end in a delimiter) .even .=.+40 ;RAID internal stack stack= . .end that's all, folks! SK DE KC1P