external string (255)fn cliparam
string (255) s
integer strad
*SWI_16
*STR_0,strad
s = ""
cycle
if BYTE(strad)<=31 or LENGTH(s)=255 then exit
s = s.BYTE(strad)
strad = strad+1
repeat
result = "" unless s -> (" ").s
result = s {Command name stripped off}
end
const integer blocked=0, avail=1
external string (255) fn ItoH(integer i, pl)
constbytearray HexByte(0:15) = '0', '1', '2', '3',
'4', '5', '6', '7',
'8', '9', 'a', 'b',
'c', 'd', 'e', 'f'
integer shift
string (255) s = ""
for shift = 0, 4, pl*4-4 cycle
s = HexByte((i>>shift)&15).s
repeat
result = s
end
const integer -
Def Inst = 1, { Instruction }
Def Byte = 2, { = byte }
Def Char = 4, { = "chars" }
Def Word = 8, { EQUD word }
Def Labelled = 16, {DATA ... }
Def Branch Dest = 32, {LAB ... }
Def Call Dest = 64, {PROC ... }
Def Access = 128 { B somewhere }
externalstring (255) fn Instr Decode(integer Pc, N)
integer CC, Type, Op, Rn, Rd, Shf, Shift, Imm, Offset, Operand
integer X, Y, Z, Printed = 0
string (1) Sign
switch F(0:7), Fm(0:31)
conststring (3)array Fn(0:15) = "AND", "EOR", "SUB", "RSB",
"ADD", "ADC", "SBC", "RSC",
"TST", "TEQ", "CMP", "CMN",
"ORR", "MOV", "BIC", "MVN"
conststring (2)array Cond(0:15) = "EQ", "NE", "CS", "CC",
"MI", "PL", "VS", "VC",
"HI", "LS", "GE", "LT",
"GT", "LE", "", "NV"
string (255) result string = ""
routine Print string(string (255) s)
result string = result string.s
end
routine space
result string = result string." "
end
routine spaces(integer n)
result string = result string." " for n = 1,1,n
end
routine print hex(integer i, pl)
result string = result string.itoh(i, pl)
end
routine print symbol(integer i)
result string = result string.i
end
routine Write(integer i, pl)
result string = result string.itos(i, pl)
end
routine Register(integer N)
if N = 15 start
Printstring("PC")
else
Printsymbol('R')
Write(N, 0)
finish
end
routine F Register(integer N)
Printsymbol('F')
Write(N, 0)
end
routine Put(string (255) S)
Printstring(S)
Printed = Printed+Length(S)
end
routine Show Label(integer N)
Printstring("L")
Print Hex(N, 8)
end
routine Show Hex(integer N, P)
Printstring("&")
Print Hex(N, P)
end
routine Show Shift(integer Shift, Reg)
integer X, Y, Rs
string (3) S
switch Sh(0:7)
Register(Reg)
return if Shift = 0
Y = Shift>>3
X = Shift&7
Space
->Sh(X)
Sh(1): S = "LSL"; ->Sh2
Sh(3): S = "LSR"; ->Sh2
Sh(5): S = "ASR"; ->Sh2
Sh(7): S = "ROR"; ->Sh2
Sh2: Rs = Shift>>4
Printstring(S); Space; Register(Rs); return
Sh(0): S = "LSL"; ->Sh1
Sh(2): S = "LSR"; ->Sh1
Sh(4): S = "ASR"; ->Sh1
Sh(6): S = "ROR"; S = "" if Y = 0
Sh1: if S = "" start
Printstring("RRX")
else
Printstring(S); Printstring(" #"); Write(Y, 0)
finish
end
routine Show Constreg(integer N)
integer X
X = N&7
if N&8 = 0 start
F Register(X)
else
if X <= 5 start
Write(X, 0); Printstring(".0")
else if X = 6
Printstring("0.5")
else
Printstring("10.0")
finish
finish
end
Printed = 0
CC = N>>28
Type = N>>25&7
Rd = (N>>12)&15
Rn = (N>>16)&15
->F(Type)
F(2_000):
F(2_001): Op = (N>>21)&15
Shf = (N>>8)&15
Shift = (N>>4)&255
Put(Fn(Op)); Put(Cond(CC))
Put("S") if N&2_0000 000 0000 1 0000 0000 000000000000 # 0
Put("P") if Rd = 15 and 8 <= Op <= 11
Spaces(8-Printed)
Register(Rd) and Printstring(", ") unless 8 <= Op <= 11
Register(Rn) and Printstring(", ") if Op # 13 and Op # 15
if N&16_0200 0000 # 0 start {Shf Imm}
X = 2*Shf
Imm = N&255
if X > 8 start
X = X-8
Y = (Imm<<24)>>X
else
Y = (Imm<<(32-X)) ! (Imm>>X)
finish
Printstring("#")
if -16_FFFF <= Y <= 16_FFFF start
if ' ' <= Y <= 126 start
Write(Y, 0)
Printstring("; '")
Printsymbol(Y)
Printsymbol('''')
else
Write(Y, 0)
finish
else
Show Hex(Y, 8)
finish
else {Shift Rm}
Show Shift(Shift, N&15)
finish
->Done
F(2_010):
F(2_011): Type = N>>24&15
if N&16_0010 0000 = 0 then Put("STR") else Put("LDR")
Put(Cond(CC))
Put("B") if N&16_0040 0000 # 0
Put("T") if N&16_0020 0000 # 0 and Type&1 = 0
Spaces(8-Printed)
Register(Rd)
Printstring(", ")
Offset = N&4095
Sign = ""; Sign = "-" if N&16_0080 0000 = 0
Printsymbol('['); Register(Rn)
if Type = 2_0100 start
Printsymbol(']')
if Offset # 0 start
Printstring(", #"); Printstring(Sign); Show Hex(Offset, 3)
finish
else if Type = 2_0101
if Offset # 0 start
Printstring(", #"); Printstring(Sign); Show Hex(Offset, 3)
finish
Printsymbol(']')
Printsymbol('!') if N&16_0020 0000 # 0
else if Type = 2_0110
Printstring("]")
if Offset # 0 start
Printstring(", ")
Printstring(Sign)
Show Shift(Offset>>4, N&15)
finish
else {%if Type = 2_0111}
Printsymbol(',')
Printstring(Sign)
Show Shift(Offset>>4, N&15)
Printsymbol(']')
Printsymbol('!') if N&16_0020 0000 # 0 and Offset # 0
finish
->Done
F(2_100): if N&16_0010 0000 = 0 then Put("STM") else Put("LDM")
Put(Cond(CC))
X = N>>23&3
if X&1 # 0 then Put("I") else Put("D")
if X&2 # 0 then Put("B") else Put("A")
Spaces(8-Printed)
Register(Rn)
Printsymbol('!') if N&16_0020 0000 # 0
Y = 1
Z = 1
Printstring(", {")
for X = 0, 1, 15 cycle
if N&Y # 0 start
Printsymbol(',') if Z = 0
Register(X)
Z = 0
finish
Y = Y<<1
repeat
Printsymbol('}')
Printsymbol('^') if N&16_0040 0000 # 0
->Done
F(2_101): Put("B"); Put("L") if N&16_0100 0000 # 0
Put(Cond(CC))
Spaces(8-Printed)
X = N&16_00FF FFFF
X = X!16_FF00 0000 if X&16_0080 0000 # 0
Show Label(Pc+(2+X)*4)
->Done
F(2_110): if N&16_0010 0000 = 0 then Put("STF") else Put("LDF")
Put(Cond(CC))
if N&16_0040 0000 = 0 start
if N&16_0000 8000 = 0 then Put("S") else Put("D")
else
if N&16_0000 8000 = 0 then Put("E") else Put("P")
finish
Spaces(8-Printed)
F Register(N>>12&7)
Printstring(", [")
Register(N>>16&15)
X = (N&255)<<2
if N&16_0100 0000 = 0 start
Printstring("]")
if X # 0 start
Printstring(", #")
Printsymbol('-') if N&16_0080 0000 = 0
Show Hex(X, 3)
finish
else
if X # 0 start
Printstring(", #")
Printsymbol('-') if N&16_0080 0000 = 0
Show Hex(X, 3)
finish
Printstring("]")
finish
Printsymbol('!') if N&16_0020 0000 # 0
->Done
F(2_111): if N&16_0100 0000 # 0 start
Put("SWI"); Put(Cond(CC)); Spaces(8-Printed)
Show Hex(N&16_00FF FFFF, 6)
->Done
finish
unless N>>8&15 = 1 start
Print string("EQUD "); Show Hex(N,8)
-> Done
finish
{this leaves the floating point stuff}
if N&16_0000 0010 = 0 start {CPDO}
X = (N>>19)&2_11110 ! (N>>15)&1
->Fm(X)
Fm(2_00000): Put("ADF"); ->FnOP
Fm(2_00010): Put("MUF"); ->FnOP
Fm(2_00100): Put("SUF"); ->FnOP
Fm(2_00110): Put("RSF"); ->FnOP
Fm(2_01000): Put("DVF"); ->FnOP
Fm(2_01010): Put("RDF"); ->FnOP
Fm(2_01100): Put("POW"); ->FnOP
Fm(2_01110): Put("RPW"); ->FnOP
Fm(2_10000): Put("RMF"); ->FnOP
Fm(2_10010): Put("FML"); ->FnOP
Fm(2_10100): Put("FDV"); ->FnOP
Fm(2_10110): Put("FRD"); ->FnOP
Fm(2_11000): Put("POL"); ->FnOP
FnOP: Put(Cond(CC))
if N&16_0008 0000 = 0 start
if N&16_0000 0080 = 0 then Put("S") else Put("D")
else
if N&16_0000 0080 = 0 then Put("E") else Put("?")
finish
X = N>>5&3
if X # 0 start
if X = 2_01 then Put("P") else -
if X = 2_10 then Put("M") else Put("Z")
finish
Spaces(8-Printed)
F Register(N>>12&7)
Printstring(", ")
F Register(N>>16&7)
Op Rest: Printstring(", ")
Show ConstReg(N&15)
->Done
Fm(2_00001): Put("MVF"); ->FnOP1
Fm(2_00011): Put("MNF"); ->FnOP1
Fm(2_00101): Put("ABS"); ->FnOP1
Fm(2_00111): Put("RND"); ->FnOP1
Fm(2_01001): Put("SQT"); ->FnOP1
Fm(2_01011): Put("LOG"); ->FnOP1
Fm(2_01101): Put("LGN"); ->FnOP1
Fm(2_01111): Put("EXP"); ->FnOP1
Fm(2_10001): Put("SIN"); ->FnOP1
Fm(2_10011): Put("COS"); ->FnOP1
Fm(2_10101): Put("TAN"); ->FnOP1
Fm(2_10111): Put("ASN"); ->FnOP1
Fm(2_11001): Put("ACS"); ->FnOP1
Fm(2_11011): Put("ATN"); ->FnOP1
Fm(*): Put("???")
FnOP1: Put(Cond(CC))
if N&16_0008 0000 = 0 start
if N&16_0000 0080 = 0 then Put("S") else Put("D")
else
if N&16_0000 0080 = 0 then Put("E") else Put("?")
finish
X = N>>5&3
if X # 0 start
if X = 2_01 then Put("P") else -
if X = 2_10 then Put("M") else Put("Z")
finish
Spaces(8-Printed)
F Register(N>>12&7)
->Op Rest
else if N&16_0010F000 = 16_0010F000 {CPST}
X = N>>21&7
if X = 2_100 start
Put("CMF")
else if X = 2_101
Put("CNF")
else if X = 2_110
Put("CMFE")
else if X = 2_111
Put("CNFE")
else
Put("???")
finish
Put(Cond(CC))
Spaces(8-Printed)
F Register(N>>16&7)
->Op Rest
else {CPRT}
X = N>>20&15
if X = 0 start
Put("FLT")
else if X = 1
Put("FIX")
else if X = 2
Put("WFS")
else if X = 3
Put("RFS")
else if X = 4
Put("WFC")
else if X = 5
Put("RFC")
else
Put("???")
finish
Put(Cond(CC))
if N&16_0008 0000 = 0 start
if N&16_0000 0080 = 0 then Put("S") else Put("D")
else
if N&16_0000 0080 = 0 then Put("E") else Put("?")
finish
Y = N>>5&3
if Y # 0 start
if Y = 2_01 then Put("P") else -
if Y = 2_10 then Put("M") else Put("Z")
finish
Spaces(8-Printed)
if X = 0 start {FLT}
F Register(N>>16&7)
Printstring(", ")
Register(N>>12&15)
else if X = 1 {FIX}
Register(N>>12&15)
Printstring(", ")
Show Constreg(N&15)
else
Register(N>>12&15)
finish
finish
Done:
result = Result string
end
!###########################################################################
const integer Data = 0, Instr = 1, B = 2, BL = 4, Swi = 8
externalintegerfn Get Simple Type(integer Pc, N, integer name Dest, Access)
const integer Always = 14, AddOp=4, MovOp = 1, pcreg = 15
integer CC, Type, Op, Rn, Rd, Rs, Shf, Shift, Imm, Offset, Operand
integer X, Y, Z
switch F(0:7), Fm(0:31)
Access = Avail
CC = N>>28
Type = N>>25&7
Rd = (N>>12)&15
Rn = (N>>16)&15
->F(Type)
F(2_000): F(2_001):
!%begin
Op = (N>>21)&15
if (Op=AddOp or Op=MovOp) and Rd=pc reg and cc=always start
Access = blocked
finish
if op#13 and op#15 and c
Rd=pc reg and Rn#pc reg and cc=always then access=blocked
if N&16_0200 0000 = 0 start
Shift = (N>>4)&255
Rs = Shift >> 4
result =Data if Rs=pc reg and Shift&1 # 0
finish
result = Instr
!%end
F(2_010): F(2_011):
!%begin
result =Instr
!%end
F(2_100):
!%begin
if N&16_0000 ffff = 0 then result =Data ;! LDM Rn!,{} for instance
if N&16_0010 0000 = 0 then result =Instr
if N&(1<<15)#0 and cc=always then Access=blocked
result = Instr
!%end
F(2_101):
!%begin
Type = B; Type = BL if N&16_0100 0000 # 0
X = N&16_00FF FFFF
X = X!16_FF00 0000 if X&16_0080 0000 # 0
Dest = Pc+(2+X)*4
if type=B and CC=Always then Access=Blocked
result = Type
!%end
F(2_110):
!%begin
result = Instr
!%end
F(2_111):
!%begin
if N&16_0100 0000 # 0 start
Dest = N&16_00FF FFFF
result = SWI
finish
result = Data if N>>8&15 # 1
{this leaves the floating point stuff}
if N&16_0000 0010 = 0 start {CPDO}
-> Fm((N>>19)&2_11110 ! (N>>15)&1)
Fm(2_00000): Fm(2_00010): Fm(2_00100): Fm(2_00110):
Fm(2_01000): Fm(2_01010): Fm(2_01100): Fm(2_01110):
Fm(2_10000): Fm(2_10010): Fm(2_10100): Fm(2_10110):
Fm(2_11000):
Fm(2_00001): Fm(2_00011): Fm(2_00101): Fm(2_00111):
Fm(2_01001): Fm(2_01011): Fm(2_01101): Fm(2_01111):
Fm(2_10001): Fm(2_10011): Fm(2_10101): Fm(2_10111):
Fm(2_11001): Fm(2_11011):
if N&16_0008 0000 # 0 and c
N&16_0000 0080 # 0 then result =Data
result = Instr
Fm(*):
result =Data
else if N&16_0010F000 = 16_0010F000 {CPST}
X = N>>21&7
result = Data unless 2_100 <= X <= 2_111
result = Instr
else {CPRT}
X = N>>20&15
result = Data unless 0 <= X <= 5
if N&16_0008 0000 # 0 and c
N&16_0000 0080 # 0 then result = Data
result = Instr
finish
!%end
end
!###########################################################################
external predicate Valid Instr(integer PC)
integer Type, Dest, Access
Type = Get Simple type(PC, INTEGER(PC), Dest, Access)
if Type#Data then true else false
end
begin
routine Decode(integer from, to, start, end)
byte array tag(from:to)
routine Text(string (255) S)
print string(S)
newline
end
string (4) fn sanitised(integer is)
string (4) s = ""
integer i
i = (is)&255
i = '.' unless ' '<=i<='~'; s = s.i
i = (is >> 8)&255
i = '.' unless ' '<=i<='~'; s = s.i
i = (is >> 16)&255
i = '.' unless ' '<=i<='~'; s = s.i
i = (is >> 24)&255
i = '.' unless ' '<=i<='~'; s = s.i
result =s
end
routine Print Decode(integer from, to)
predicate pr(integer a)
true if ' '<=BYTE(a)<='~'
false
end
string (255) fn CharStr(integer a)
string (255) guts
if tag(a)&Def char#0 and pr(a) start
guts = """".BYTE(a).""""
else
guts = itos(BYTE(a), 0)
guts = " ".guts while LENGTH(guts)<3
finish
result = guts
end
string (10) Lab
string (255) Guts
const integer max guts = 50
integer a = from, type, dest, access
cycle
if tag(a)&Def labelled#0 start
if tag(a)&Def Call Dest#0 then lab = "P" -
else if tag(a)&Def Branch Dest#0 then Lab = "L" -
else lab = "D"
Lab = Lab.Itoh(a, 8)." "
else
Lab = " "
finish
if tag(a)&Def Inst#0 start
guts = Instr decode(a, INTEGER(a))
Type = Get Simple type(a, INTEGER(a), Dest, Access)
if Type&(B!BL)#0 start
unless from <= dest <= to start
guts = guts." ; Outside module???"
finish
finish
guts <- guts." "
elseif tag(a)&Def Word#0
guts = "EQUD &".itoh(INTEGER(a),8)." ".
" "
elseif tag(a)&(Def Byte!Def Char)#0
guts = "= "
if pr(a) and pr(a+1) and pr(a+2) and pr(a+3) start
guts = "= """.BYTE(a).BYTE(a+1).BYTE(a+2).BYTE(a+3).""""
else
guts = guts.CharStr(a).", "
guts = guts.CharStr(a+1).", "
guts = guts.CharStr(a+2).", "
guts = guts.CharStr(a+3)
finish
guts = guts." "
LENGTH(guts) = 20
else
! Unknown - could be data or instr...
if Valid Instr(a) start
guts = Instr decode(a, INTEGER(a))
guts <- guts." "
else
guts = "EQUD &".itoh(INTEGER(a),8)." ".
" "
finish
LENGTH(guts) = Max guts-6
guts = guts."; ".sanitised(INTEGER(a))
finish
LENGTH(guts) = max guts
text(Lab.guts."; ".itoh(a,7).": ".itoh(INTEGER(a),8))
a = a+4
return if a >= to
repeat
end
string (255) fn StringAt(integer Str addr)
string (255) Title
Title = ""
cycle
if BYTE(Str addr)=0 then result =Title
Title = Title.BYTE(Str addr)
Str addr = Str addr+1
repeat
end
routine Mark string(integer str start)
return if BYTE(str start)=0
tag(str start) = tag(str start)!Def labelled
cycle
tag(str start) = tag(str start)!Def Char
if BYTE(str start) = 0 then tag(Str start)=tag(Str start)! c
Def byte and return
str start=str start+1
repeat
end
routine Mark word(integer ad)
tag(ad) = tag(ad)!Def word
tag(ad+1) = Def word
tag(ad+2) = Def word
tag(ad+3) = Def word
end
routine Mark Byte(integer ad)
tag(ad) = tag(ad)!Def Byte
end
routine Mark Jump(integer ad)
tag(ad) = tag(ad)!Def Inst!Def Labelled!Def Branch dest
end
routine Mark Proc(integer ad)
tag(ad) = tag(ad)!Def Inst!Def Labelled!Def Call dest
end
routine spec Decode Branch Search(integer Entry, From, To)
routine spec Decode Proc Search(integer Entry, From, To)
routine Decode Search(integer Entry, from, to)
integer Type, Dest, Access=avail
return unless From <= Entry < To and Entry&3=0
return if tag(Entry)&Def Inst#0 {Already searched}
cycle
exit if tag(Entry)&(Def Char!Def Byte!Def Inst)#0 or Entry >= To
Type = Get Simple type(Entry, INTEGER(Entry), Dest, Access)
if Type=Data then start
! Somehow missed end of instr seq.
! Backtrack and undo?
return
finish
tag(Entry) = tag(Entry)!Def Inst
if Type&B # 0 start
unless from <= dest < To start
!!! tag(Entry) = tag(Entry)&(\Def Inst)
!!! %return
finish
Decode Branch Search(dest, from, to)
tag(entry)=tag(Entry)!Def access and return if Access=blocked
Entry = Entry+4
else if Type&BL # 0
unless from <= dest < To start
!! tag(Entry) = tag(Entry)&(\Def Inst)
!! %return
finish
Decode Proc Search(dest, from, to)
Entry = Entry+4
else if Type&SWI # 0
if Dest&(\16_20000)=1 start
! Skip in-line string
tag(Entry)=tag(Entry)!Def access
Entry=Entry+4
Mark String(Entry)
while BYTE(Entry)#0 cycle
Entry = Entry+1
repeat
Entry = (Entry+4)&(\3)
else
Entry = Entry + 4
finish
else
tag(entry)=tag(Entry)!Def access and return if Access=blocked
Entry = Entry+4
finish
repeat
end
routine Decode Branch Search(integer Entry, From, To)
return unless From <= Entry <= To and Entry&3=0
tag(Entry) = tag(Entry)!Def labelled!Def branch dest
Decode Search(Entry, From, To)
end
routine Decode Proc Search(integer Entry, From, To)
return unless From <= Entry <= To and Entry&3=0
tag(Entry) = tag(Entry)!Def labelled!Def call dest
Decode Search(Entry, From, To)
end
predicate Decode Title String(integer Str addr, string (*) name Title)
Title = ""
cycle
if BYTE(Str addr)=0 then true
unless '!' <= BYTE(Str addr) <= '~' then false
Title = Title.BYTE(Str addr)
Str addr = Str addr+1
repeat
end
predicate Decode Help String(integer Str addr, integer name Help length)
Help length = 0
cycle
if BYTE(Str addr) = 0 then true
if BYTE(Str addr) >= 127 then false
str addr = Str addr+1; Help length = Help length+1
repeat
end
routine Decode Help Table(integer Start)
record format Help info fm(integer code,
byte min params, flags0, max params, flags 1,
integer syntax, text)
string (255) fn Params(integer Low, High)
result = "" if low=High=0
result = " (".itos(High,0)." param)" if low=high=1
result = " (".itos(High,0)." params)" if low=high
result = " (".itos(low,0)."-".itos(high,0)." params)"
end
record (Help info fm) name Help info
string (255) Help param
cycle
Help param = StringAt(Start)
Mark string(start)
return if Help param = ""
Start = (Start + LENGTH(Help param) + 1 + 3) & (\3)
Help info == RECORD(Start)
Mark Word(start)
Mark Byte(start+4); Mark Byte(start+5)
Mark Byte(start+6); Mark Byte(start+7)
Mark word(start+8); Mark word(start+12)
if Help info_code = 0 start
Text("Help on: ".help param.
Params(Help info_min params,
Help info_max params))
else
Decode proc search(from+Help info_code, from, to)
Text("Entry: ".help param.
Params(Help info_min params,
Help info_max params))
finish
Mark string(from+Help info_syntax)
Mark string(from+Help info_text)
start = start+16
repeat
end
routine Decode SWI Table(integer Start)
cycle
cycle
exit if BYTE(Start)=0
tag(Start)=Def char
Start=Start+1
repeat
tag(Start)=tag(start)!Def char
Start=Start+1
repeat until BYTE(start)=0
tag(start)=tag(start)!Def char
end
routine Scan branches(integer from, to)
integer address, Type, Dest, Access
for address = From, 4, To-4 cycle
if tag(address)!tag(address+1)!tag(address+2)!tag(address+3)=0 start
Type = Get Simple type(address, INTEGER(address), Dest, Access)
if Type&(B!BL)#0 start
if from < dest <= to and Access=Blocked start
tag(address)=tag(address)!Def Inst
Decode branch search(Dest, from, to)
else
! Leave undecided... tag(address)=tag(address)!Def word
finish
finish
finish
repeat
end
predicate stringch(integer i)
i = BYTE(i)
true if i=0 or i=10 or i=13 or ' '<=i<='~'
false
end
routine Scan strings(integer from, to)
integer a, Type, Dest, Access
for a = From, 4, To-4 cycle
if tag(a)!tag(a+1)!tag(a+2)!tag(a+3)=0 start
if stringch(a-4) and stringch(a-3) c
and stringch(a-2) and stringch(a-1) c
and stringch(a) and stringch(a+1) c
and stringch(a+2) and stringch(a+3) c
and stringch(a+4) and stringch(a+4) c
and stringch(a+6) and stringch(a+7) c
start
if INTEGER(a)=0 then tag(a)=tag(a)!Def Word else start
tag(a)=tag(a)!Def Char;tag(a+1)=tag(a+1)!def char
tag(a+2)=tag(a+2)!Def Char;tag(a+3)=tag(a+3)!def Char
finish
if BYTE(a+2)=BYTE(a+3)=0 then tag(a)=tag(a)!Def Word
finish
finish
repeat
end
routine Scan data(integer from, to)
integer a
for a = From, 4, To-4 cycle
if tag(a)!tag(a+1)!tag(a+2)!tag(a+3)=0 start
if 16_ffff0000 <= INTEGER(a) <= 16_0000ffff start
tag(a) = Def Word
finish
finish
repeat
end
routine Confirm(integer first, last, from, to)
! if all the words between first and last can take the
! same type as them, set them to that...
end
routine Patch up alternatives(integer from, to)
integer a, start
for a = From, 4, To-4 cycle
if tag(a)!tag(a+1)!tag(a+2)!tag(a+3)=0 start
start=a+4
while tag(start)!tag(start+1)!tag(start+2)!tag(start+3)=0 cycle
start=start+4
repeat
Confirm(a-4, start, from, to)
finish
repeat
end
predicate printable(integer ad)
true if ' ' <= BYTE(ad) <= '~'
false
end
predicate all printable(integer ad)
if printable(ad) and printable(ad+1) c
and printable(ad+2) and printable(ad+3) then true
false
end
routine Undo wrong instructions(integer From, to)
integer Dest, Access, Type, a
for a = to-4, -4, from+4 cycle
if tag(a)&Def Char#0 and tag(a-4)=0 start
Type = Get Simple type(a-4, INTEGER(a-4), Dest, Access)
if Type&(Instr!BL)#0 and access#blocked start
tag(a-4) = Def Char
finish
continue
elseif tag(a)&def char#0 and tag(a-4)&Def word#0
tag(a-4) = tag(a-4)&(\Def Word)!Def char if all printable(a-4)
elseif tag(a)&Def Word#0 and tag(a-4)=0
Type = Get Simple type(a-4, INTEGER(a-4), Dest, Access)
if Type&(Instr!BL!SWI)#0 and access#blocked start
if all printable(a-4) start
tag(a-4) = Def Char
else
tag(a-4) = Def Word
finish
finish
continue
finish
if (tag(a)&Def Inst=0 or (tag(a)=0 and not valid instr(a))) c
and (tag(a-4)=0 or c
(tag(a-4)&Def Inst#0 {%and Dubious branch})) start
! if a-4 can drop through then it is not an instr...
! Give it DATA?
Type = Get Simple type(a-4, INTEGER(a-4), Dest, Access)
if Type&Data=0 c
and Access#blocked and tag(a-4)&Def Labelled#0 start
tag(a)=Def Word if tag(a)=0
tag(a-4)=tag(a-4)&(\Def Inst)!(tag(a)&(Def char!Def Word!Def Byte))
finish
finish
repeat
end
routine Grab more strings(integer from, to)
integer a
for a = from, 4, to-4 cycle
if tag(a) & Def char # 0 and tag(a+4) & Def word # 0 start
if all printable(a+4) start
tag(a+4) = tag(a+4) & (\def word) ! def char
finish
finish
repeat
end
routine Set any illegal instrs to DATA(integer from, to)
integer a
for a = from, 4, to cycle
if tag(a)=0 and tag(a+1)=0 and tag(a+2)=0 and tag(a+3)=0 start
if not valid instr(a) then tag(a)=Def Word
finish
repeat
end
integer i
tag(i) = 0 for i = from, 1, to
! Determine type - module or file: Follow entry points as appropriate.
record format Module Header Fm( c
integer Start Code, Init Code, Final Code, Service Handler,
Title String, Help String, Help table, SWI Chunk,
SWI Handler, SWI Table, SWI Decode)
record (Module Header Fm) name Module Header
integer Code extent = to - from
Module Header == RECORD(from)
if 0 <= Module Header_Init Code < Code extent c
and 0 <= Module Header_Final Code < Code extent c
and 0 <= Module Header_Service Handler < Code extent c
and 0 <= Module Header_Title String < Code extent c
and 0 <= Module Header_Help String < Code extent c
and 0 <= Module Header_Help Table < Code extent c
then start
! Good chance of it being a module.
string (255) Title
if Decode Title String(from+Module Header_Title String, Title) start
Mark string(from+Module Header_title string)
Text("*** Decoding relocatable module '".Title."' ***")
else
Text("*** This appears to be a module but the title string is invalid")
finish
Mark Word(i) for i = from, 4, from+16_18
integer Help Length
if Decode Help String(from+Module Header_Help String, Help Length) start
Mark string(from+Module Header_Help String)
! Help text marked. Possibly also print here too...
finish
if Module Header_Help Table#0 start
Decode Help Table(from+Module Header_Help Table)
! Table entries marked appropriately; entry points recursively decoded
finish
if Module Header_SWI Handler < Code extent start
if Module Header_SWI Handler#0 c
and Module Header_SWI Handler&2_11111100 00000000 00000000 00000011=0 c
then start
Mark Word(ADDR(Module Header_SWI Handler))
Decode Proc Search(from+Module header_SWI Handler, from, to)
finish
! Only list SWI no's if SWIs valid.
if Module Header_SWI Chunk&2_11111111 00000000 00000000 00011111=0 c
then start
Mark Word(ADDR(Module Header_SWI Chunk))
Text("Module handles SWIs from ".
itoh(Module Header_SWI Chunk,6)." to ".
itoh(Module Header_SWI Chunk+64-1,6))
finish
if Module Header_SWI Table < Code extent start
if Module Header_SWI Table#0 c
and Module Header_SWI Table&2_11111100 00000000 00000000 00000011=0 c
then start
Mark Word(ADDR(Module Header_SWI Table))
Decode SWI Table(from+Module Header_SWI Table)
finish
if Module Header_SWI Decode < Code extent start
if Module Header_SWI Decode#0 c
and Module Header_SWI decode&2_11111100 00000000 00000000 00000011=0 c
then start
Mark Word(ADDR(Module Header_SWI Decode))
Decode Proc Search(from+Module header_SWI Decode, from, to)
finish
finish ;finish ;finish
! do main entry last as it is special...
if 0 < Module Header_Start Code < Code extent start
Text("Entry point is offset.")
Decode Proc Search(from+Module header_Start Code, from, to)
elseif Module header_start code = 0
! No language entry
else
if Valid Instr(from) start
Decode Proc Search(from, from, to)
! First word is an instruction, not an offset
else
Text("*** First word not valid instruction ***")
finish
finish
Decode Proc Search(from+Module header_Init Code, from, to) c
unless Module header_Init Code=0
Decode Proc Search(from+Module header_Final Code, from, to) c
unless Module header_Final Code=0
Decode Proc Search(from+Module header_Service Handler, from, to) c
unless Module header_Service Handler=0
else
! Probably not a module - treat as a file
Decode Proc Search(from, from, to)
finish
Scan branches(From, to)
Scan strings(From, to)
Scan data(from, to)
Undo wrong instructions(from, to) {Inst (not jump) followed by Data}
Grab more strings(from, to)
Set any illegal instrs to DATA(from, to)
Undo wrong instructions(from, to) {Iterative process!}
Patch up alternatives(from, to) {If DATA, data!inst, DATA then DATA}
Undo wrong instructions(from, to) {Iterative process!}
Print decode(start, end)
end
! Decode (Module/code start, Module/code end, decode start, decode end)
! decode(16_8000, 16_DA50, 16_8000, 16_DA50)
string (255) s = cli param
if s = "MOS" start
decode(16_3800000, 16_380837C, 16_3800000, 16_380837C)
elseif s = "NFS"
decode(16_18B2A64, 16_18C9304, 16_18B2A64, 16_18C9304)
elseif s = "UtilityModule"
decode(16_3806428, 16_38195E8, 16_3806428, 16_38195E8)
elseif s = "FileSwitch"
decode(16_38195E8, 16_381EC34, 16_38195E8, 16_381EC34)
elseif s = "BASIC"
decode(16_381EC34, 16_382A5C4, 16_381EC34, 16_382A5C4)
elseif s = "ADFS"
decode(16_382A5C4, 16_38325A4, 16_382A5C4, 16_38325A4)
elseif s = "Econet"
decode(16_38325A4, 16_3834184, 16_38325A4, 16_3834184)
elseif s = "NetFS"
decode(16_3834184, 16_3837F60, 16_3834184, 16_3837F60)
elseif s = "WindowManager"
decode(16_3837F60, 16_383C558, 16_3837F60, 16_383C558)
elseif s = "SpriteUtils"
decode(16_383C558, 16_383CE30, 16_383C558, 16_383CE30)
elseif s = "SoundDMA"
decode(16_383CE30, 16_383D8A8, 16_383CE30, 16_383D8A8)
elseif s = "SoundChannels"
decode(16_383D8A8, 16_383ED58, 16_383D8A8, 16_383ED58)
elseif s = "SoundScheduler"
decode(16_383ED58, 16_383F588, 16_383ED58, 16_383F588)
else
if s # "" and s#"-help" then print string("Error: a") else print string("A")
print string(c
"llowed parameters are:
NFS
MOS UtilityModule FileSwitch ADFS Econet NetFS
WindowManager SpriteUtils SoundDMA SoundChannels SoundScheduler
")
finish
endofprogram