406 lines
8.6 KiB
Plaintext
406 lines
8.6 KiB
Plaintext
-> EC debugger
|
|
|
|
OBJECT debuginfo
|
|
objs,procs,identhash,dbugval,dbugadr,modinfolist,codelist,memlist,heap,macrohash
|
|
ENDOBJECT
|
|
|
|
PROC main()
|
|
DEF s[10]:STRING,c=1,port,db:PTR TO debuginfo
|
|
WriteF('EC structure debugger\n')
|
|
port:=FindPort('EmoduleCache')
|
|
IF port=NIL
|
|
WriteF('no Cache!\n')
|
|
RETURN 10
|
|
ENDIF
|
|
WHILE c
|
|
WriteF('show which datastructure? (<lf> to quit)\n')
|
|
WriteF('["O"bjects,"P"procs,"I"dents,"V"alue,"A"dr,"M"odInfo,"C"odeRem,\n"K"ookiecheck,"H"eap,mac"R"os]: ')
|
|
ReadStr(stdin,s)
|
|
LowerStr(s)
|
|
lf()
|
|
c:=s[]
|
|
db:=Long(port+42)
|
|
do(c,db)
|
|
lf()
|
|
ENDWHILE
|
|
ENDPROC
|
|
|
|
PROC do(c,db:PTR TO debuginfo) HANDLE
|
|
SELECT c
|
|
CASE "o"; object(Long(db.objs))
|
|
CASE "p"; proc(Long(db.procs))
|
|
CASE "m"; modinfo(Long(db.modinfolist))
|
|
CASE "c"; coderem(Long(db.codelist))
|
|
CASE "k"; cookie(Long(db.memlist))
|
|
CASE "h"; heaps(db.heap)
|
|
CASE "i"; identhash(db.identhash)
|
|
CASE "v"; val(db.dbugval)
|
|
CASE "a"; mem(db.dbugadr)
|
|
CASE "r"; macros(db.macrohash)
|
|
CASE "\0"; WriteF('\ndone.\n')
|
|
DEFAULT; WriteF('Unsupported datastructure\n')
|
|
ENDSELECT
|
|
EXCEPT
|
|
WriteF(IF exception="INV" THEN 'terminated because of invalid address\n' ELSE 'exception!')
|
|
ENDPROC
|
|
|
|
PROC valid(a)
|
|
IF (a<$20000) OR (a>$A00000) -> based on 2meg chip and 8meg fast
|
|
IF a
|
|
WriteF('[INVALID:$\z\h[8]]',a)
|
|
RETURN FALSE
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC TRUE
|
|
|
|
PROC string(s) IS IF valid(s) THEN WriteF(IF s THEN 'str="\s"; ' ELSE 'str=NIL; ',s) ELSE 0
|
|
PROC str(name,s) IS IF valid(s) THEN IF s<>NIL THEN WriteF('\s="\s"; ',name,s) ELSE 0 ELSE 0
|
|
PROC flags(b) IS WriteF('flags=$\h; ',b)
|
|
PROC int(s,i) IS WriteF('\s=\d; ',s,i)
|
|
PROC lf() IS WriteF('\n')
|
|
PROC t() IS WriteF(' ')
|
|
PROC negnext(o) IS Long(o-4)
|
|
|
|
OBJECT objectheader
|
|
->onext:LONG -> -4
|
|
odel:INT -> 0, delegate size
|
|
otype:CHAR -> 2, flags: bit 0=export
|
|
dummy:CHAR -> 3, _empty_spot_
|
|
osize:INT -> 4, sizeof object
|
|
oid:INT -> 6, object ID
|
|
oascii:LONG -> 8
|
|
omemb:LONG -> 12, memberlist
|
|
omethod:LONG -> 16, methodlist
|
|
osuper:LONG -> 20, superclass
|
|
odcode -> 24
|
|
oacc -> 28
|
|
odeloff:INT -> 32
|
|
odestr:INT -> 34
|
|
ENDOBJECT
|
|
|
|
PROC object(a:PTR TO objectheader)
|
|
DEF s:PTR TO objectheader
|
|
IF valid(a)
|
|
IF a
|
|
IF a.otype AND 2 = 0
|
|
string(a.oascii)
|
|
flags(a.otype)
|
|
int('sizeof',a.osize)
|
|
int('id',a.oid)
|
|
int('delsize',a.odel)
|
|
int('deloff',a.odeloff)
|
|
int('destr',a.odestr)
|
|
s:=a.osuper
|
|
IF s THEN s:=s.oascii
|
|
WriteF('superclass:')
|
|
string(s)
|
|
WriteF('\nmemberlist:\n')
|
|
member(a.omemb)
|
|
WriteF('methodlist:\n')
|
|
method(a.omethod)
|
|
lf()
|
|
object(negnext(a))
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
OBJECT member
|
|
-> onext:PTR TO member -> -4
|
|
ooff:INT -> 0, offset
|
|
oflags:CHAR -> 2, SET PRIVATE,HASPTRTYPE
|
|
dummy:CHAR -> 3, _empty_spot_
|
|
osize:INT -> 4, fieldsize [1,2,4,0=array]
|
|
oid:INT -> 6, object ID
|
|
oascii:LONG -> 8, NIL if PRIVATE
|
|
optrtype:LONG -> 12, only if HASPTRTYPE
|
|
ENDOBJECT
|
|
|
|
PROC member(m:PTR TO member)
|
|
IF m
|
|
IF valid(m)
|
|
t(); string(m.oascii)
|
|
int('offset',m.ooff)
|
|
int('size',m.osize)
|
|
int('id',m.oid)
|
|
flags(m.oflags)
|
|
IF m.oflags AND 2
|
|
IF m.optrtype AND $FFFFFFF0 = 0
|
|
int('ptrtype',m.optrtype)
|
|
ELSE
|
|
WriteF('ptrtype=<object>')
|
|
ENDIF
|
|
ENDIF
|
|
lf()
|
|
member(negnext(m))
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
OBJECT proc
|
|
-> next:PTR TO proc -> -4
|
|
nrargs:INT -> 0
|
|
flags:CHAR -> 2, SET COMPILE_RTD,METHOD
|
|
numregvars:CHAR -> 3, 0..3
|
|
nrloc:INT -> 4, -(nrloc*4)
|
|
defargs:LONG -> 6
|
|
of_object:LONG -> 10
|
|
ident:LONG -> 14
|
|
self -> 18
|
|
method -> 22
|
|
regtab:PTR TO LONG -> 26
|
|
ENDOBJECT
|
|
|
|
OBJECT method
|
|
m_next:LONG -> 0
|
|
m_proc:LONG -> 4
|
|
m_type:CHAR -> 8 [0=MT_METHOD, 1=MT_FROZEN, 2=MT_SHARED]
|
|
m_flags:CHAR -> 9 SET INHERITED
|
|
m_off:INT -> 10 delegate offset
|
|
m_name:LONG -> 12
|
|
ENDOBJECT
|
|
|
|
PROC method(m:PTR TO method)
|
|
DEF p:PTR TO proc
|
|
IF m
|
|
IF valid(m)
|
|
t(); string(m.m_name)
|
|
int('type',m.m_type)
|
|
flags(m.m_flags)
|
|
int('deloff',m.m_off)
|
|
WriteF(' -> proc: ')
|
|
p:=m.m_proc
|
|
int('nargs',p.nrargs)
|
|
lf()
|
|
method(m.m_next)
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROC val(x)
|
|
WriteF('value = \d, $\h\n',x,x)
|
|
ENDPROC
|
|
|
|
PROC mem(a:PTR TO LONG)
|
|
DEF b,c
|
|
c:=a
|
|
WriteF('dump ($\h) = ',a)
|
|
IF valid(a)
|
|
FOR b:=1 TO 16 DO WriteF('\z$\h[8] ',a[]++)
|
|
ENDIF
|
|
WriteF('\n"\s"\n',c)
|
|
lf()
|
|
ENDPROC
|
|
|
|
PROC identhash(p:PTR TO LONG)
|
|
DEF x
|
|
IF valid(p)
|
|
IF p
|
|
FOR x:=1 TO 256 DO IF p[] THEN ident(p[]++) ELSE p++
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
OBJECT ident
|
|
|
|
-> flags = SET USED,SYS_VAR,EXPORT(in main var is uit module),REG,REAL|METHOD
|
|
-> etype = PTR TO [1,2,4] | PTR TO <object>
|
|
-> offset = +arg, -localvar
|
|
|
|
->next:LONG -> -4
|
|
etype:LONG -> 0, [type,type,ascii]
|
|
type:CHAR -> 4, [local,global,lab] = [1,2,3]
|
|
flags:CHAR -> 5
|
|
pr:LONG -> 6, [proc,PTR TO globinfo|NIL,proc|NIL if lab]
|
|
info:INT -> 10, [offset/regnum,offset,ID=label]
|
|
heavy:LONG -> VARHEAVY, only for local+reg_alloc
|
|
ENDOBJECT
|
|
|
|
PROC ident(p:PTR TO ident)
|
|
DEF t,n=NIL,pr=NIL,tn,f,fs[100]:STRING,type=NIL
|
|
IF valid(p)
|
|
IF (p.flags AND 2)=0 AND p
|
|
t:=p.type
|
|
f:=p.flags
|
|
IF f AND 4 THEN StrAdd(fs,'EXPORT')
|
|
IF f AND 8 THEN StrAdd(fs,'REG')
|
|
IF f AND 16 THEN StrAdd(fs,'METHOD/REAL')
|
|
IF EstrLen(fs)=0 THEN fs:=NIL
|
|
SELECT t
|
|
CASE 1; tn:='LOCAL'; pr:=Long(Long(p.pr+14))
|
|
CASE 2; tn:='GLOB'
|
|
CASE 3; tn:='PROC'; IF p.pr=NIL THEN tn:='LAB'; n:=p.etype
|
|
DEFAULT; tn:='UNDEF'
|
|
ENDSELECT
|
|
IF (t=1) OR (t=2)
|
|
type:=p.etype
|
|
SELECT type
|
|
CASE 1; type:=NIL
|
|
CASE 2; type:='INT'
|
|
CASE 4; type:='LONG'
|
|
DEFAULT; type:=Long(p.etype+8)
|
|
ENDSELECT
|
|
ENDIF
|
|
WriteF(' ')
|
|
str('proc',pr)
|
|
str('name',n)
|
|
str('sort',tn)
|
|
str('flags',fs)
|
|
str('ptr_to',type)
|
|
WriteF('info=\d; heavy=$\h\n',p.info,p.heavy)
|
|
ident(negnext(p))
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROC proc(p:PTR TO proc)
|
|
DEF i:PTR TO ident, s:PTR TO objectheader, rt:PTR TO LONG
|
|
IF valid(p)
|
|
IF p
|
|
WriteF('at:$\h; ',p)
|
|
int('args',p.nrargs)
|
|
int('locals',p.nrloc)
|
|
int('numregvars',p.numregvars)
|
|
flags(p.flags)
|
|
WriteF('ident:')
|
|
i:=p.ident
|
|
IF i AND valid(i) THEN string(i.etype)
|
|
IF i:=p.self
|
|
IF valid(i)
|
|
WriteF('\n self:')
|
|
IF valid(s:=i.etype) THEN string(s.oascii)
|
|
ENDIF
|
|
ENDIF
|
|
lf()
|
|
IF rt:=p.regtab
|
|
WriteF('\tregalloc:')
|
|
WHILE rt[]
|
|
WriteF(' \d',Shr(Long(rt[]+12),8)-1)
|
|
rt++
|
|
ENDWHILE
|
|
lf()
|
|
ENDIF
|
|
proc(negnext(p))
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
OBJECT modinfo
|
|
next,flags:INT,namelen,mod,list,name
|
|
ENDOBJECT
|
|
|
|
OBJECT procclass
|
|
next,type:INT,info,acc
|
|
ENDOBJECT
|
|
|
|
OBJECT acc
|
|
next,code
|
|
ENDOBJECT
|
|
|
|
PROC modinfo(p:PTR TO modinfo)
|
|
IF valid(p)
|
|
IF p
|
|
str('mod',p.name)
|
|
int('flags',p.flags)
|
|
lf()
|
|
procclass(p.list)
|
|
modinfo(p.next)
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROC procclass(p:PTR TO procclass)
|
|
DEF x=0,l:PTR TO acc
|
|
IF valid(p)
|
|
IF p
|
|
int('type',p.type)
|
|
l:=p.acc
|
|
WHILE l
|
|
x++
|
|
l:=l.next
|
|
ENDWHILE
|
|
IF p.type=2 THEN str('lab',Long(p.info))
|
|
int('numacc',x)
|
|
lf()
|
|
procclass(p.next)
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
OBJECT coderem
|
|
next,type:INT,info1,info2
|
|
ENDOBJECT
|
|
|
|
PROC coderem(p:PTR TO coderem)
|
|
IF valid(p)
|
|
IF p
|
|
int('type',p.type)
|
|
IF (p.type=5) OR (p.type=6) THEN str('ref_name',p.info1)
|
|
lf()
|
|
coderem(p.next)
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
PROC template(p:PTR TO proc)
|
|
IF valid(p)
|
|
IF p
|
|
-> ...
|
|
template(negnext(p))
|
|
ENDIF
|
|
ENDIF
|
|
ENDPROC
|
|
|
|
CONST COOKIE=$BE
|
|
|
|
OBJECT memlist
|
|
next,size
|
|
ENDOBJECT
|
|
|
|
PROC cookie(meml:PTR TO memlist)
|
|
DEF a
|
|
WHILE meml
|
|
IF valid(meml)
|
|
a:=meml+meml.size-1
|
|
IF a[]<>COOKIE
|
|
DisplayBeep(NIL)
|
|
DisplayBeep(NIL)
|
|
DisplayBeep(NIL)
|
|
WriteF('cookie check failed!!!!!!!!!\n')
|
|
RETURN
|
|
ENDIF
|
|
meml:=meml.next
|
|
ELSE
|
|
RETURN
|
|
ENDIF
|
|
ENDWHILE
|
|
ENDPROC
|
|
|
|
PROC heaps(h:PTR TO LONG)
|
|
WHILE CtrlC()=FALSE
|
|
IF (h[2]-100>h[]) OR (h[2]+13000<h[])
|
|
WriteF('!!!!\n')
|
|
DisplayBeep(NIL)
|
|
Delay(10)
|
|
ENDIF
|
|
ENDWHILE
|
|
ENDPROC
|
|
|
|
OBJECT macro
|
|
next:PTR TO macro
|
|
name,body
|
|
nargs:INT
|
|
flags:CHAR
|
|
ENDOBJECT
|
|
|
|
PROC macros(m:PTR TO LONG)
|
|
DEF a,l:PTR TO macro
|
|
FOR a:=0 TO 255
|
|
l:=m[a]
|
|
WHILE l
|
|
WriteF('\s/\d = "\s"\n',l.name,l.nargs,l.body)
|
|
l:=l.next
|
|
ENDWHILE
|
|
ENDFOR
|
|
ENDPROC
|