.title Disassembler .enabl lc .rem $ Saved image (.SAV) disassembler by John Wilson, June 1984 and August 1985. For RSTS/E V7.0-07 or RT-11 V4.0 (or V3C, I assume). Makes two passes over the binary file, attempting to trace out the possible execution paths of the program, to help differentiate between code and data, and to put labels only on locations which are referenced elsewhere. $ rsts= 0 ;set to 0 for real RT-11 ;non-zero for RSTS/E RT-11 emulator ; .mcall .csigen,.print ; .readw= emt+375 ;SYSMAC forms of these are inefficient... .writw= emt+375 ; true= 1 ;add B to mnemonic if high bit set false= 0 ;for instructions with no byte form op0= 0 ;0-operand instruction ; .macro .instr mask,result,name,bflag,oprnds .word mask,result,name,oprnds!bflag .endm ; .macro .data instr t$'instr': .asciz /'instr'/ .endm ; .macro .out ptr mov #'ptr,r0 call out .endm ; disasm: .print #header ;print prog ID ; .if nz rsts clr r0 ;print system ID emt 364 ;.ERRPRT .print #terpri ;cr/lf .endc ; csi: .csigen #devhnd,#defext,#0,#rbuf ;call CSI, save line mov #rbuf,r1 ;point at string 10$: movb (r1)+,r0 ;get a char beq 20$ ;end of string, null command cmpb r0,#40 ;space or ctrl char? blos 10$ ;yes, loop br 30$ ;no, significant char, cont 20$: tst (sp)+ ;purge stack br disasm ;print ID, call CSI again 30$: clr start ;for now, so PEEK works... mov #177777,end ;(same as above) mov #40,r5 ;get starting addr call peek mov r0,ppc ;point at starting loc mov r0,xfer ;(label='START:') mov #50,r5 ;get high limit call peek mov r0,end ;end at end mov #1000,start ;start at begn mov (sp)+,r5 ;get switch count beq 100$ ;no switches, use defaults 40$: mov (sp)+,r0 ;get a switch bpl 50$ ;no value given mov (sp)+,r1 ;get value 50$: cmpb #'E,r0 ;/E:addr ? beq 60$ ;yes cmpb #'S,r0 ;/S:addr ? beq 70$ ;yes cmpb #'T,r0 ;/T:addr ? beq 80$ ;yes .print #badsw ;no, print message mov #1000,sp ;purge stack br csi ;loop 60$: tst r0 ;value given? bpl 90$ ;no mov r1,end ;set ending addr br 90$ ;skip 70$: tst r0 ;value given? bpl 90$ ;no mov r1,start ;set starting addr br 90$ ;skip 80$: tst r0 ;value given? bpl 90$ ;no mov r1,ppc ;set address to start bitmap at 90$: sob r5,40$ ;loop through all switches 100$: mov #symtab,r0 ;point at symbol table bitmap mov #14000,r1 ;length of SYMTAB+BITMAP+INSBND 110$: clr (r0)+ ;clear a word sob r1,110$ ;loop bic #1,start ;start on an even address bic #1,xfer ;same for transfer address bic #1,ppc ;and pseudo-PC clr wblk ;start at begn of file mov #wbuf,wptr ;point at begn of buffer mov #1000,wcnt ;which is empty ;+ ; ; Okay, that takes care of initialization. What we's a gonna ; do, is: make two passes through the input file; on pass 1, ; do a recursive test disassembly to find out what gets ; executed and what doesn't (so we know what's data and what ; isn't). This will, of course, completely fuck up if the ; program is overlaid (although we will probably get some ; useful information), and if there are any JMPs or JSRs ; through registers or dispatch tables, we aren't going to be ; able to chase them down (well, I suppose we could if we ; actually single-stepped through the entire program, but I'm ; too lazy to do that and besides the program might be doing ; something nasty). Okay, so we'll start disassembling at the ; transfer address (contents of location 40 or value specified ; with /T switch), and each time we come to a conditional ; branch or a subroutine call, we'll try both branches (that's ; how this is recursive). Each time we read a word to ; disassemble with PEEK, a bit gets set in BITMAP to remember ; that this word gets executed. We will stop pursuing a ; branch if we reach either 1. a HALT (!) or EMT 350 ; instruction, [2. any undefined instruction,] 3. an RTS ; instruction, 4. a JMP or JSR which uses something other than ; relative or absolute mode, 5. anything outside of the ; range [START,END], or 6. any place we've been before, ; according to BITMAP (otherwise we'd hang on the first ; loop we came across). On the trace pass, a bit is set ; in INSBND for the first word of each instruction, so ; we know where labels are possible (not between words ; in a multi-word instruction). ; ;- mov xfer,r5 ;point at transfer addr call bitnum ;get corresponding bit bis r0,symtab(r5) ;this gets a symbol (START) mov ppc,r5 ;get starting address movb #377,trash ;no output on first try call trace ;call recursive routine ;BITMAP and SYMTAB are now set up mov start,r5 ;start at begn of range clrb trash ;for real this time mov r5,ppc ;save location counter 120$: call bitnum ;get corresponding bit bit r0,symtab(r5) ;does it get a symbol? beq 150$ ;no, skip mov ppc,r0 ;get addr call prlab ;print label .out colon ;print ":" 150$: .out tab ;print " " mov ppc,r5 ;restore ptr call bitnum ;get bit bit r0,bitmap(r5) ;is it ever executed? bne 155$ ;yes, skip .out t$word ;print ".word" .out tab ;" " mov ppc,r5 ;restore ptr call peek ;read a word call huh ;print its value br 157$ ;skip 155$: mov ppc,r5 ;restore ptr call dis ;do an instruction 157$: mov r5,ppc ;save cmp r5,end ;off end of range? blos 120$ ;no, loop .out t$end ;".end start" mov wcnt,r1 ;get # of bytes free in last block cmp r1,#1000 ;empty block? beq 170$ ;yes, never mind mov wptr,r0 ;get ptr 160$: clrb (r0)+ ;clear a byte sob r1,160$ ;loop mov #warea,r0 ;point at area .writw ;write the block bcc 170$ ;no error, skip .print #werr ;print message 170$: jmp csi ;close files, reprompt ;+ ; ; Tracer. See above. ; ;- trace: mov r5,r4 ;save r5 call bitnum ;get bit pattern bit r0,bitmap(r5) ;have we been here before? bne 20$ ;yes, don't loop bis r0,insbnd(r5) ;start of an instruction mov r4,r5 ;no, restore r5 call peek ;get an opcode bcs 20$ ;error, return tst r0 ;HALT instruction? beq 20$ ;yes, return cmp r0,#emt+350 ;.EXIT (RT-11)? beq 20$ ;yes, return ; This, of course, depends on the RTS (or OS) which ; the file is to run on, but it's a .SAV file, so ; it would be pretty useless anywhere but on RT-11. call dis1 ;disassemble the instruction tstb jmpflg ;is it a branch of some kind? beq trace ;no, get next instruction bmi 10$ ;unconditional, follow only one branch tstb adrflg ;where was it to? beq trace ;dunno, follow only other branch mov r5,-(sp) ;save r5 mov addr,r5 ;get destination call trace ;scope it out (recurse) mov (sp)+,r5 ;restore PC br trace ;loop 10$: mov addr,r5 ;get address to go to tstb adrflg ;is it valid? bne trace ;yes, loop 20$: rts pc ;no, return ; dis: ;disassemble instruction at (r5) call peek ;get opcode dis1: clr jmpflg ;clear ADRFLG and JMPFLG mov r0,-(sp) ;save mov #inslst,r2 ;point at instruction list 10$: mov (sp),r1 ;get opcode back 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 br 10$ ;loop until found ; I can assume that a correct value will always be found because ; there is an entry for ".word" at the bottom of the list, with ; mask=1's and result=0's. 20$: mov (r2)+,r0 ;point at string jsr pc,out ;print string bit #1,(r2) ;byte flag set? beq 30$ ;no byte version of instr, skip tst (sp) ;byte bit set? bpl 30$ ;no, word .out 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 .out tab ;print ' ' 50$: mov (sp)+,r0 ;get opcode back jmp (r2) ;jump to the appropriate routine ; op0.5: ;half operand (one register) cmp r1,#200 ;RTS instruction? bne 10$ ;no comb jmpflg ;yes, unconditional jump, no valid ADDR 10$: jsr pc,prreg ;print the register jmp crlf ;print cr/lf and return op1: ;single operand cmp r1,#100 ;JMP instruction? bne 10$ ;no comb jmpflg ;yes, unconditional jump incb adrflg ;valid address 10$: jsr pc,proper ;print the operand jmp crlf ;print cr/lf and return op1.5: ;1-1/2 operand (reg,operand) cmp r1,#4000 ;JSR? bne 10$ ;no incb jmpflg ;yes, conditional jump (we'll be back later) incb adrflg ;valid address 10$: mov r0,-(sp) ;save opcode ash #-6,r0 ;shift register field to r0<2:0> jsr pc,prreg ;print it .out 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 .out comma ;print "," mov (sp)+,r0 ;get other operand jsr pc,proper ;print it jmp crlf ;print cr/lf and return branch: ;BRanch instruction cmp r1,#400 ;just BR (unconditional)? bne 10$ ;no, skip comb jmpflg ;remember this br 20$ ;skip 10$: incb jmpflg ;conditional branch 20$: bic #177400,r0 ;mask out upper 8 bits movb r0,r0 ;sign extend (SXTB) asl r0 ;multiply by 2 (word) add r5,r0 ;add in current PC (instr addr +2) jsr pc,prlab ;print resulting address incb adrflg ;valid 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 .out comma ;print "," mov (sp)+,r0 ;get opcode back ash #-6,r0 ;shift register into <2:0> jsr pc,prreg ;print destination 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 decbra: ;SOB instruction mov r0,-(sp) ;save r0 ash #-6,r0 ;shift reg to <2:0> jsr pc,prreg ;print it .out comma ;print "," mov (sp)+,r1 ;restore bic #177700,r1 ;mask out all but lower 6 bits asl r1 ;*2 mov r5,r0 ;copy location counter sub r1,r0 ;calculate destination address jsr pc,prlab ;print it incb adrflg ;valid address incb jmpflg ;conditional branch jmp crlf ;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 .out comma ;"," 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 .out 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 .out 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 .out 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,out ;print it (check TRASH) 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 r5,-(sp) ;and r5 clr r3 ;nothing printed yet mov r0,r5 ;copy opcode into r5 10$: ror r5 ;rotate a bit into C bcc 30$ ;clear, continue tst r3 ;comma needed? beq 20$ ;no .out 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,out ;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)+,r5 ;restore r5 mov (sp)+,r3 ;and r3 jmp crlf ;yes, cr/lf, return ; flgnam: .ascii /cvzn/ ;names of flags ; huh: ;??? undefined instruction call prnum ;".word nnnnnn" mov r0,-(sp) ;save value .out cmnt ;" ;" mov (sp),r0 ;get value clr r1 ;no quotes yet call huh1 ;do low byte mov (sp)+,r0 ;get again swab r0 ;byte swap call huh1 ;do high byte clr r2 ;not in quotes anymore call huh2 ;print closing quote jmp crlf ;see you around ; huh1: ;do a char movb r0,r0 ;SXT mov r0,-(sp) ;save cmp r0,#40 ;ctrl char? blo 10$ ;yes cmp r0,#176 ;no, rubout or negative? bhi 10$ ;yes cmp r0,#140 ;backspark? beq 10$ ;yes, MACRO is afraid of them mov #1,r2 ;make sure we're between quotes call huh2 ;(print one if nessa) mov (sp)+,r0 ;restore movb r0,char ;no, put in buffer mov #char,r0 ;point at it jmp out ;print, return 10$: clr r2 ;make sure we aren't twixt quotes call huh2 ;(print a closing one) .out lt ;"<" mov (sp)+,r0 ;restore call prbyte ;print value mov #gt,r0 ;">" jmp out ;print it, return ; huh2: ;print a quote if r1<>r2 cmp r1,r2 ;equal? beq 10$ ;yes .out quote ;no, print a quote mov r2,r1 ;update flag 10$: rts pc ; 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? beq pcoper ;PC gets special treatment 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 out ;and return 30$: cmp r0,#30 ;mode 3? bne 40$ ;no, continue .out at ;print "@" br 25$ ;continue as if mode=2 40$: cmp r0,#40 ;mode 4? bne 50$ ;no, continue 45$: .out minus ;print "-" mov (sp)+,r0 ;get reg number jmp prrgp ;print "(reg)" and return 50$: cmp r0,#50 ;mode 5? bne 60$ ;no, continue .out at ;print "@" br 45$ ;continue as if mode=4 60$: cmp r0,#60 ;mode 6? bne 70$ ;no, must be mode 7 65$: call peek ;get index address jsr pc,prlab ;print it mov (sp)+,r0 ;get reg number jmp prrgp ;print "(reg)" and return 70$: .out 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 .out number ;print "#" call peek ;get operand ;;;;;; jmp prnum ;print number and return jmp prlab ;;;; print label 2$: cmp r0,#30 ;absolute? bne 3$ ;no, continue tst (sp)+ ;clear stack movb r0,adrflg ;set flag in case of JMP or JSR .out at ;print "@#" .out number call peek ;get operand jmp prlab ;print it 3$: cmp r0,#60 ;relative? bne 5$ ;no, continue movb r0,adrflg ;set flag in case of JMP or JSR 4$: tst (sp)+ ;clear stack call peek ;get index add r5,r0 ;add on value of PC jmp prlab ;print resulting address and return 5$: cmp r0,#70 ;relative deferred? bne 6$ ;no, go treat it normally .out 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 .out leftp ;print "(" mov (sp)+,r0 ;get number back jsr pc,prreg ;print reg name .out 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 out ;and return 1$: mov #pctext,r0 ;print "pc" jmp out ;and return 2$: add #'0,r0 ;convert to ASCII movb r0,rtext+1 ;put in buffer mov #rtext,r0 ;print "r#" jmp out ;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 out ;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 ;+ ; ; Print cr/lf. ; ;- crlf: mov #crlf$,r0 ;print cr/lf ;; fall through... ;+ ; ; Write .ASCIZ string at @r0 to the ; output file if TRASH is not zero. ; ;- out: tstb trash ;are we trashing output? bne 30$ ;yes, return mov r1,-(sp) ;save regs mov r2,-(sp) mov wptr,r1 ;get ptr mov wcnt,r2 ;space remaining 10$: movb (r0)+,(r1)+ ;copy beq 20$ ;end of string sob r2,10$ ;stop if buffer full mov r0,-(sp) ;save r0 mov #warea,r0 ;pt at EMT area .writw ;write the block bcs 40$ ;error, crash mov (sp)+,r0 ;restore r0 inc wblk ;move to next block mov #wbuf,r1 ;back up ptr mov #1000,r2 ;# of bytes free br 10$ ;continue 20$: dec r1 ;correct ptr mov r1,wptr ;update mov r2,wcnt mov (sp)+,r2 ;restore regs mov (sp)+,r1 30$: rts pc 40$: .print #werr ;write error mov #1000,sp ;purge stack jmp csi ;re-prompt ; prlab: ;print r0 as a label, if its bit is set in INSBND; ;otherwise print in octal mov r5,-(sp) ;save regs mov r0,-(sp) cmp r0,start ;in range? blo 10$ ;no cmp r0,end ;hm? bhi 10$ ;no mov r0,r5 ;yes, copy call bitnum ;get bit # tstb trash ;pass one? bne 5$ ;yes, set SYMTAB bit bit r0,bitmap(r5) ;is it an instruction? beq 5$ ;no, give it a label bit r0,insbnd(r5) ;yes, is it the begn of one? beq 10$ ;no, print it in octal 5$: bis r0,symtab(r5) ;make mark in table mov (sp)+,r0 ;restore r0 cmp r0,xfer ;START? beq 7$ ;yes, never mind mov #'L,r5 ;use L or M for high bit br prnum2 ;print the number, return 7$: .out strt ;print "START" mov (sp)+,r5 ;restore rts pc 10$: mov (sp)+,r0 ;restore br prnum1 ;print in octal ; prnum: ;print r0 in octal mov r5,-(sp) ;save r5 prnum1: mov #'0,r5 ;octal, not symbolic prnum2: call proct ;print it mov (sp)+,r5 ;restore rts pc ; proct: ;print r0 in octal, using char in r5 ;as char for high bit mov r0,addr ;save in case it's important 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> bis #'0,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 adc r5 ;inc r5 if 1 movb r5,-(r1) ;put in buffer .out 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,out ;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... ; ;+ ; ; Routine to return word at virtual ; address in r5. Result in r0, ; r5 is incremented by 2. ; Returns with C set on error. ; ;- peek: mov r1,-(sp) ;save reg cmp r5,start ;before START? blo 40$ ;yes, error cmp r5,end ;after end? bhi 40$ ;yes, error mov r5,r1 ;copy addr tstb trash ;on pass 2? beq 5$ ;yes, don't set bit call bitnum ;find bit in BITMAP bis r0,bitmap(r5) ;set it mov r1,r5 ;restore r5 5$: ash #-9.,r1 ;shift right 9 bits bic #177600,r1 ;clear high 9 bits in case it was negative cmp r1,rblk ;is this block in memory? beq 10$ ;yes, great mov r1,rblk ;it will be in a second mov #rarea,r0 ;point at EMT arg blk .readw ;read a block bcs 30$ ;error, gack 10$: mov r5,r1 ;copy again bic #^C777,r1 ;clear all but low 9 bits mov rbuf(r1),r0 ;get the word add #2,r5 ;inc ptr clc ;in case r5= was 177776 20$: mov (sp)+,r1 ;restore r1 rts pc 30$: mov #-1,rblk ;don't get any ideas br 20$ ;return, C is already set 40$: sec ;error, out range br 20$ ;return ; rarea: .byte 3,10 ;.READW, channel 3 rblk: .word -1 ;block number .word rbuf ;buffer address .word 400 ;word count .word 0 ;no crtn; .WAIT for it ;+ ; ; Find the bit in either bit map which ; corresponds to the address in r5. ; On return: ; r0 has the proper bit set ; r5 offset into bitmap of word to BIS/BIT ; ;- bitnum: mov r4,-(sp) ;save r4 clc ;no randomness, please ror r5 ;find word address mov r5,r4 ;save it ash #-4,r5 ;find offset into table asl r5 ;clear low bit bic #^C17,r4 ;find bit number to set mov #1,r0 ;a typical bit ash r4,r0 ;rotate to proper posn mov (sp)+,r4 ;restore r4 rts pc ; ;+ ; ; Data area ; ;- warea: .byte 0,11 ;.WRITW, channel 0 wblk: .word ;block number .word wbuf ;buffer address .word 400 ;word count .word 0 ;no crtn; .WAIT for it ; wcnt: .word ;count of bytes free in WBUF wptr: .word ;current ptr into WBUF ; rbuf: .blkw 400 ;read block buffer wbuf: .blkw 400 ;write block buffer ; symtab: .blkw 4000 ;1 bit for each word JMPed, JSRed, or BRed to bitmap: .blkw 4000 ;1 bit for each word executed insbnd: .blkw 4000 ;1 bit for each instruction's first word ; defext: .rad50 /SAVMACSIDGOD/ ;SID is God ; start: .word ;start of range to disassemble end: .word ;end of range to disassemble xfer: .word ;STARTing address ppc: .word ;current program counter ; header: .ascii /DISASM/<9.>/V1.0/ .iif nz rsts, .byte 9.,200 ;tab, end of string terpri: .byte 0 ;must follow header crlf$: .byte 15,12,0 badsw: .asciz /?Bad switch/ werr: .asciz /?File write error/ trash: .byte ;OUT trashes output if this is non-zero ; .even jmpflg: .byte ;non-zero if last instruction transferred ;control somewhere; ;negative if the transfer was unconditional adrflg: .byte ;non-zero if last operand decoded was ;REL or ABS addr: .word ;target address if ADRFLG is set 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,decbra .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$word,false,huh ; .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$word: .asciz /.word/ ;undefined or unexecuted instructions t$end: .asciz <9.>/.end/<9.>/start/<15><12> ;so MACRO will eat the program b: .asciz /b/ ;suffix for byte instructions tab: .asciz / / rtext: .asciz /r / ;register names sptext: .asciz /sp/ pctext: .asciz /pc/ actxt: .asciz /ac / ;FP-11A registers comma: .asciz /,/ leftp: .asciz /(/ rightp: .asciz /)/ at: .asciz /@/ plus: .asciz /+/ minus: .asciz /-/ number: .asciz /#/ numbuf: .asciz /######/ ;buffer for numbers strt: .asciz /start/ colon: .asciz /:/ cmnt: .asciz / ;/ char: .asciz / / quote: .asciz /'/ lt: .asciz // .even devhnd= . ;device handlers go here .end disasm Whee!