!Utility to analyse a file whatever it is and print out something sensible.
!Various bits hacked from ANAL, NANAL, NLINES, DUMP, I:ANAL20, MOBANAL, MEXANAL
!etc courtesy of RWT, RMM, HMD etc.
!J.Butler Oct 29 84
!Modded JHB 18/2/87: -c option counts less likely to run into each other
begin
option "-nocheck-nodiag"
include "inc:util.imp"
include "inc:wildmat.imp"
ownstring (255)s="", outfile="",eventmess=""
string (80) array Files (1 : 110)
integer Number of Files
constinteger vbrief = 0
constinteger brief = 1
constinteger normal = 2
constinteger full = 3
constinteger dump = 4
constinteger count = 5
ownbyte options = full
string (255) File, File 1, defext
integer I, cc, lc, start, filelen, sym, hpos=1
integer File Number = 0, Wild Lines = 0, Wild Chars = 0
! -- Dump stuff from DUMP
routine countfile(integer from, size)
integer p,q,r,max
constbytearray hex(0:15) = c
'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'
integerarray tot(0:255), wid(0:15)
for p=0,1,255 cycle ; tot(p)=0; repeat
for q=from,1,from+size-1 cycle
tot(byteinteger(q)) = tot(byteinteger(q))+1
repeat
max=0
for q=0,1,15 cycle ; wid(q)=0; repeat
for p=0,1,15 cycle
for q=0,1,15 cycle ; wid(q)=tot(p*16+q) if tot(p*16+q)>wid(q); repeat
repeat
for q=0,1,15 cycle
p=0; r=1
p=p+1 and r=r*10 while r-1<wid(q)
if p>2 then wid(q)=p else wid(q)=2
repeat
newline; spaces(3)
for p=0,1,15 cycle ; spaces(wid(p)-1); printsymbol('-'); printsymbol(hex(p)); repeat
newlines(2)
for p=0,1,15 cycle
printsymbol(hex(p)); printsymbol('-'); space
for q=0,1,15 cycle ; write(tot(p*16+q), -(wid(q)+1)); repeat
newline
repeat
end
routine dumpfile(integer from,size)
integer p,q
constinteger max=16
p = from
newline
cycle
phex(p-from); spaces(2)
for q=p,1,p+max-1 cycle
sym = byteinteger(q); sym = '_' unless ' '<=sym&16_7f<='~'
if q >= from+size then space else printsymbol(sym&16_7f)
repeat
space
for q = p,1,p+max-1 cycle
space
if q >= from+size then newline and return else phex2(byteinteger(q))
repeat
p = p + max
newline
repeat
end
routine Do one File (string (255) File)
record (finfof) r
integer limit,integer i,j, p
string (255) s, dir, f, ext
routine count lines and junk(integername lines, realname junkfract, c
integername maxline)
integer junk, ok, p, q
lines = 0; junk = 0; ok = 0; maxline = 0; q=start
for p = start, 1, limit-1 cycle
if byteinteger(p) = nl start
lines = lines + 1
if p-q>maxline then maxline=p-q; q=p+1
elseif byteinteger(p) = 9 or byteinteger(p) = 12 or c
byteinteger(p) = 13 or ' ' <= byteinteger(p) <= 126
ok = ok + 1
else
junk = junk + 1
finish
repeat
if junk+ok = 0 then junkfract = 0 else junkfract = junk/(junk+ok)
Wild Lines = Wild Lines + lines
end
routine genanal(string (63) text)
integer lc,maxline
real jfract
printstring("File is a")
count lines and junk(lc, jfract, maxline); write(lc, 1)
print string ("-line "); printstring(text)
if jfract*100 < 1 start
printstring(" (longest = "); write(maxline, -1)
printstring(" characters)")
else
printstring(" ("); print(jfract*100, 0, 0)
printstring("% unprintable)")
finish
newline
end
routine mexanal
constinteger current flavour = 16_02
recordformat hf(byte mark, version,short checks,export,import,
integer codesize,
short reset,main,integer ownsize,stacksize,spare1,spare2)
record (hf)name header
integer i, offset
routine show entry(integername i)
integer k
phex(integer(i)); phex(integer(i+4))
space; phex(integer(i+8)+offset)
space; printstring(string(i+12))
newline
i = (i+byteinteger(i+12)+14)&¬1
end
routine SHOW CHECKS(integer bits)
!Courtesy HMD
integer PROBE=16_8000, I=1
const string TEXT = c
"-ARR-LOOP-CAP-OVER-ASS-STRASS-SASS-BASS-LINE-DIAG-TRACE-STACK-"
printstring("Checks set at end:")
if bits = 0 start
printstring("none")
else
cycle
cycle
printsymbol(charno(text,i)) if bits&probe # 0
i = i+1
repeat until charno(text,i) = '-'
probe = probe>>1
repeat until probe = 16_0008
finish
newline
end
header == record(start)
printstring("File is a Version"); write(header_version, 1)
printstring(" (current)") if header_version = current flavour
printstring(" object module")
newlines(2)
i = sizeof(header)+header_export+header_import+header_codesize
unless i=filelen start
printstring("File is ")
write(filelen-i,0); printstring(" bytes too long"); newline
finish
show checks(header_checks)
printstring("Code size "); phex(header_codesize)
printstring(" Data size "); phex(header_ownsize); newline
printstring("Stack size ") and phex(header_stacksize) and c
newline unless header_stacksize=0
printstring("Entries:"); newline
offset = sizeof(header)+header_export+header_import
spaces(17); phex(header_reset<<1+offset); printstring(" {reset}"); newline
spaces(17); phex(header_main<<1+offset); printstring(" {main}"); newline
i = start+sizeof(header); j = i+header_export
show entry(i) while i<j and integer(i)<0
printstring("References:"); newline
i = j; j = i+header_import
show entry(i) while i<j and integer(i)<0
end
routine mobanal
integer n, p, q, refs
printstring("File is a Version 0 object module"); newlines(2)
p = start+2
printstring("Entries: "); n = 1; refs = 0
while 0<byteinteger(p)<12 cycle
space unless n=0; n = n+1; refs = refs + 1
{} phex(integer(p+12)); space
printstring(string(p))
if n=3{6} then newline and n = 0 else spaces(11-byteinteger(p))
p = p+20
repeat
p = p+2
printstring(" none") if refs = 0
newline unless n=0
printstring("Code size: ");
q = limit-2+shortinteger(limit-2)+40
q = q-4 if shortinteger(q-8)=16_6100
phex(q-40-p)
printstring(" Data size: ");phex(limit-4-q); newline
printstring("References: "); n = 1; refs = 0
while 0<byteinteger(q)<12 cycle
space unless n=0; n = n+1; refs = refs + 1
{} phex(integer(q+12)); space
printstring(string(q))
if n=3{6} then newline and n = 0 else spaces(11-byteinteger(q))
q = q+20
repeat
q = q+2
printstring(" none") if refs = 0
newline unless n=0
end
routine cmobanal
constinteger entptoffset = 28
integer p
routine showval(integername p, string (63) text)
printstring(text); space; phex(integer(p))
if p-start # entptoffset start ;!Not meaningful for entry point
if integer(p) # 0 start
printstring(" ("); write(integer(p), 0); printstring(")")
finish
printstring(" bytes")
finish
newline
p = p + 4
end
printstring("File is a 'C' object module"); newlines(2)
p = start + 4
showval(p, "text size: ")
showval(p, "data size: ")
showval(p, "blank data size: ")
showval(p, "symbol table size: ")
showval(p, "text relocation directory size:")
showval(p, "data relocation directory size:")
showval(p, "entry point: ")
end
integer check
routine rhex1(integername p, val)
eventmess = "Unterminated" and signal 15 if p >= start+filelen
val = byteinteger(p); p = p + 1
val = val - '0'; val = val - 7 if val > 9
end
routine rhex2(integername p, val)
integer a
rhex1(p, val); rhex1(p, a)
val = val<<4 + a
check = check + val
end
routine rhex4(integername p, val)
integer a
rhex2(p, val); rhex2(p, a)
val = val<<8 + a
end
predicate looks like an m68 file(integername p)
integer c, i, lgth, q
p = start
p = p + 1 while byteinteger(p) = 13 or byteinteger(p) = nl
false unless byteinteger(p) = 'S' and byteinteger(p+1) = '0'
q = p+2; check = 0
rhex2(q, lgth)
for i = 1,1,lgth cycle ; rhex2(q, c); repeat
check = check + 1
false unless check & 255 = 0
true
end
routine m68mobanal(integer p)
integer i, s, type, offset, add, lgth
integerarray buffer(0:255)
routine fail(string (63) text)
eventmess = text
signal 15
end
on event 15 start ; -> abort; finish
printstring("File is a Motorola M6800")
if p = start then printsymbol('0')
printstring(" OMF file"); newlines(2)
add = -1
cycle
s = byteinteger(p); p = p + 1; fail("'S' Missing") if s # 'S'
type = byteinteger(p); p = p + 1 ; fail("Funny Type value") c
unless '0' <= type <= '9'
check = 0
rhex2(p, lgth); rhex4(p, offset)
for i = 0, 1, lgth-3 cycle
rhex2(p, buffer(i))
repeat
check = check + 1
fail("Checksum failure") if check&255 # 0
if type = '0' start
printstring("Module Name: ")
for i = 0, 1, lgth-4 cycle ; printsymbol(buffer(i)); repeat
newline
elseif type = '1'
if offset # add start
if add = -1 start
printstring("Areas loaded:")
else
phex4(add-1)
finish
newline
phex4(offset); printstring(" - ")
add = offset
finish
add = add + lgth - 3
elseif type = '9'
exit
finish
p = p + 1 while byteinteger(p) < ' ' and p < start+filelen
fail("Unterminated") if p >= start + filelen
repeat
phex4(add-1); newline
return
abort:
printstring("(Corrupt: ".eventmess.")"); newline
end
on event 3,9 start
printstring("Analyse ";file;" fails: ";event_message); newline
return
finish
File Number = File Number + 1
newline if file number > 1
if options = vbrief then to lower(file) and printstring(file) elsestart
ext = "" unless file -> s.(".").ext
i = 0 while ext -> s.(".").ext
to upper(ext)
if file -> dir.("$:").f then s = "" else s = ninfo(file)
if options = brief then printstring(s) elsestart
unpack finfo(s, r)
printstring("File: ".file); spaces(2)
if s # "" start
printstring(" Last altered: "); printstring(r_date)
spaces(2); printstring(r_time); spaces(4)
newline
printstring("Permissions: Self: "); printsymbol(charno(r_perms, 1))
printstring(" Others: "); printsymbol(charno(r_perms, 2))
printstring(" Archive: "); printsymbol(charno(r_perms, 3))
finishelse printstring("is a pseudo-file")
newline
filelen = filesize(file)
printstring("Size: "); phex(filelen)
printstring(" ("); write(filelen, 0); printstring(") bytes")
if s # "" start
printstring(" in ")
write(r_blocks, 0); printstring(" block")
if r_blocks > 1 then printstring("s, ") else printstring(", ")
write(r_extents, 0); printstring(" extent")
printsymbol('s') if r_extents > 1
finish
newline
Wild Chars = Wild Chars + filelen
if filelen # 0 start
if options > normal start
connectfile(file,0,start,filelen); limit = filelen+start
if options = dump start
dumpfile(start, filelen)
elseif options = count
countfile(start, filelen)
else
if {ext = "MOB" %or ext = "MEX") %and}c
byteinteger(start) = 16_fe start ;!Object module
if byteinteger(start+1) = 1 or byteinteger(start+1) = 2 start
!New format object module - various flavours
mexanal
elseif byteinteger(start+1) = 0
mobanal
elseif byteinteger(start+1) = 16_cc ;!C object module
cmobanal
elseif byteinteger(start+1) = 16_bc
printstring("File is an M68000 assembler object module"); newline
elseif byteinteger(start+1) = 16_fe
printstring("File is an S-Algol object module"); newline
else
genanal("character file or object module of unknown type")
finish
elseif (ext = "MOB" and byteinteger(start) = '{') or ext = "COM"
genanal("command file")
elseif ext = "MOB" and byteinteger(start) = 'S'
m68mobanal(start)
elseif ext = "OBJ" and looks like an M68 file(p)
m68mobanal(p)
else
genanal("character file")
finish
heapput(start)
finish
finish
else
printstring("File is empty"); newline
finish
finish
finish
end
routine Do Wild Files (string (80) Wild File)
string (127) Line, A, B, Directory
integer Flag = 0, Index
on 3,9 start
if Flag = 0 start
Event_Message = "No message" if Event_Message = ""
Print String ("Analyse ".wildfile." fails: ".Event_Message)
New Line
return
finish
-> End Load
finish
Directory = ""
if Wild File -> Directory .(":"). Wild File start ; finish
Directory = Directory . ":" if Directory # ""
Open Input (3, Directory."Directory")
Select Input (3)
Flag = 1
Index = 1
Number of Files = 0
cycle
Read Line (Line)
if Matches (Line, Wild File) start
if Wild File = "*" start
continue if Line -> A .("."). B
finish
Number of Files = Number of Files + 1
Files (Number of Files) = Directory.Line
finish
Index = Index + 1
repeat
End Load:
Close Input
Select Input (0)
Index = 1
while Index <= Number of Files cycle
Do One File (Files (Index))
Index = Index + 1
repeat
end
on event 9, 15 start
-> abend
finish
file = ""; defext = ""
define param("FILE", file, pam major)
define param("EXTension",defext,0)
define param("OUT", outfile, pam new group)
define enum param("VBrief,Brief,Normal,Full,Dump,Count", options, 0)
process parameters(cli param)
open output(1, outfile) if outfile # ""
prompt("File(s):")
readline(file) while file = ""
while File -> File 1 .(","). File cycle
file 1 = file 1.".".defext unless defext = "" or file 1 -> s.(".")
if Wildness (File 1) # 0 then Do Wild Files (File 1) c
else Do One File (File 1)
repeat
if File # "" start
file = file.".".defext unless defext = "" or file -> s.(".")
if Wildness (File) # 0 then Do Wild Files (File) c
else Do One File (File)
finish
if File Number > 1 and options >= normal start
newline
Print String ("Total of ")
Write (Wild Chars, 0)
Print String (" character")
Print Symbol ('s') if Wild Chars # 1
if options = full start
Print String (" on ")
Write (Wild Lines, 0)
Print String (" line")
Print Symbol ('s') if Wild Lines # 1
finish
Print Symbol ('.')
finish
abend:
New Line
endofprogram