| View in color | License | Download script | History | Other scripts by: jlm |
24-Jul 23:45 UTC
[0.078] 42.26k
[0.078] 42.26k
dbg.rREBOL [
File: %dbg.r
Date: 12-Jul-2026
Title: "dbg"
Version: 2
Author: "JLM"
Purpose: {
To debug Rebol code (commands are similar to those of pdb python debugger).
}
library: [
level: 'advanced
platform: none
type: 'tool
domain: [debug testing]
tested-under: none
support: none
license: none
see-also: none
]
Usage: {
-1rst step: load dbg tool
dbg: do %dbg.r
-2nd step: debug <main rebol code to debug>
dbg/debug/run <main rebol code to debug>
-3rd step: type commands of dbg at prompt "DBG>"
help
list main
-end step: Before debugging another Rebol code
dbg/undebug
-Recommended steps for using commands of dbg at prompt "DBG>"
--1-- set breakpoints in main with command b(reak) before using command c((ont)inue)
--2-- for debugging a Rebol function <function>:
-2.1- set a breakpoint in the main where the word <function> is defined
-2.2- use command c((ont)inue) until the breakpoint 2.1
-2.3- use command d(ebug) <function> (when the word <function> is defined)
-2.4- use command b(reak) to set breakpoints in <function>
}
Sample: {
- sample 1 :
------------
.rebol commands :
dbg: do %dbg.r
dbg/debug/run [
a: 10
b: 20
print a + b
]
.commands for prompt "DBG>" :
list main
break main 5
break
cont
rebol probe a
rebol probe b
cont
.rebol command :
dbg/undebug
- sample 2 :
------------
.rebol commands :
dbg: do %dbg.r
code: {
f1: func [series value] [
print ["f1" value]
if (first series) = value [
break/return value
]
print "f1 end"
return false
]
series: [1 2 3 4]
forall series [
print f1 series 3
]
}
dbg/debug/run code
.commands for prompt "DBG>" :
l .
b main 7
b main 9/1
l main
cont
debug f1
l f1
b f1 1
b f1 7/1
b
l f1
l .
cont
! probe series
cont
local value
cont
l .
! probe series
b
disable main 1 2
b
cont
local value
disable f1 1 2
b
cont
.rebol command :
dbg/undebug
- sample 3 :
------------
.rebol commands :
dbg: do %dbg.r
code: {
example: make object! [
var1: 10
var2: var1 + 10
calculate: func [value] [
var1: value
var2: value + 10
]
]
example/calculate 8
print [example/var1 example/var2]
}
dbg/debug/run code
.commands for prompt "DBG>" :
l main
b main 5
l main
cont
debug example/calculate
l example/calculate
b example/calculate 1
cont
local value
! probe example/var1
! probe example/var2
cont
.rebol command :
dbg/undebug
}
]
context [
listdb: [] ;--- list of objects (code and breakpoints) to debug
cmddb: make object! [
bsav: false ;--- true to save commands in fname
fname: none ;--- file where to save commands
bplay: copy [] ;--- commands to play
]
dbbpt: func [
"define a breakpoint in the code to debug"
sname [string!] "main or name of function to debug where is the breakpoint"
npath [string!] "path-index of code in the function for the breakpoint"
enable [logic!] "true to define breakpoint or false to remove the breakpoint"
/local np bl it i bn bnpath bnp bb badd obdbg inb
][
; fonction interne
_deffunct: func [ sname [string!] bc [block!] /local bf i obj oobj] [
;--- to re-define the function (for local context)
unless sname = "main" [
;-- case function in objects
bf: parse/all sname "/"
either (length? bf) = 1 [ ;--- word function
set to-lit-word sname func first get to-lit-word sname bc ; set word function
][
either (length? bf) = 2 [
;--- set in example 'calculate func first :obj second :obj
;--- word function in object
obj: get in get load bf/1 to-lit-word bf/2
set in get load bf/1 to-lit-word bf/2 func first :obj bc
][
;--- word function in object
obj: get in get load bf/1 to-lit-word bf/2
i: 2
while [ all [ i < (length? bf) object? :obj ] ][
i: i + 1
oobj: obj
obj: get in :obj to-lit-word bf/(:i)
]
if function? :obj [
;--- :oobj is object! and :obj is function!
set in :oobj to-lit-word pick bf length? bf func first :obj bc
]
]
]
]
] ;--- end _deffunct
inb: index? find first get in self 'break-do refinement! ;--- 4 words : break-do sname npath 'wloc
obdbg: select head self/listdb sname
if object? obdbg [
bnpath: parse/all npath "/"
bn: array/initial length? bnpath 0
foreach [ np bl it ] obdbg/dbbbpts [
if bl/1 = true [
bnp: parse/all np "/"
either (length? bnp) = 1 [
;--- 1rst level
bn/1: bn/1 + inb ;--- inb is the number of words : (break-do sname npath 'wloc)
][
;--- have the lower levels the same values ?
badd: true
repeat i ((length? bnp) - 1) [
unless (to integer! bnp/:i) = (to integer! bnpath/:i) [
badd: false
break
]
]
if badd = true [
i: length? bnp
bn/:i: bn/:i + inb ;--- inb is the number of words : (break-do sname npath 'wloc)
]
]
]
if np = npath [
unless bl/1 = enable [
; replace find obdbg/dbbbpts npath logic! enable
replace i: find obdbg/dbbbpts npath block! append/only copy [] reduce [enable true]
either enable = true [
;--- set breakpoint -> add index breakpoint
append obdbg/bibpt index? i
print ["Breakpoint" length? obdbg/bibpt "in" sname ":" np "-" it]
][
;--- clear breakpoint index
remove find head obdbg/bibpt index? i
]
bb: head obdbg/dbcode
unless (length? bnpath) = 1 [
repeat i ((length? bnpath) - 1) [
bb: pick bb (bn/:i + to integer! bnpath/:i)
]
]
i: length? bnpath
bb: skip bb ((bn/:i + to integer! bnpath/:i) - 1)
either enable = true [
;--- insert dbcode [break-do npath]
insert bb compose [break-do (sname) (npath) (obdbg/wloc)]
bb: skip bb inb
][
;--- remove dbcode [break-do npath]
; remove/part bb: back back bb inb
remove/part bb: skip bb (0 - inb) inb
]
either (third find obdbg/dbbbpts npath) = mold bb/1 [
_deffunct sname head obdbg/dbcode ;--- to re-define the funct with its new body for local ctx
][
print ["!!** system error! word " bb/1]
]
]
break
]
] ;--- end foreach
] ;--- end if object? obdbg
] ;--- end dbbpt
dbdisbpt: func [
"remove breakpoints"
/only
"only breakpoints of a function"
sname [string!] "main or name of the function to debug where are the breakpoints to remove"
/local obdbg w
][
either only [
obdbg: select head self/listdb sname
if object? obdbg [
w: obdbg/dbbbpts
forskip w 3 [
if (first (second w)) = true [
poke w 2 [false true]
]
]
change/part obdbg/dbcode obdbg/bcod (length? obdbg/dbcode) ;-- replace body of funct with the originate
_deffunct sname head obdbg/dbcode ;--- to re-define the funct with its new body for local ctx
]
][
foreach [ snam obdbg ] self/listdb [
w: obdbg/dbbbpts
forskip w 3 [
if (first (second w)) = true [
poke w 2 [false true]
]
]
change/part obdbg/dbcode obdbg/bcod (length? obdbg/dbcode) ;-- replace body of funct with the originate
_deffunct snam head obdbg/dbcode ;--- to re-define the funct with its new body for local ctx
]
]
] ;--- end dbdisbpt
edbbpt: func [
"enable/disable a defined breakpoint in the code to debug"
sname [string!] "main or name of function to debug where is the breakpoint"
inb [integer!] "breakpoint number (index in bibpt)"
enable [logic!] "true to enable breakpoint or false to disable the breakpoint"
/local obdbg w
][
obdbg: select head self/listdb sname
if object? obdbg [
if inb <= length? obdbg/bibpt [
w: at head obdbg/dbbbpts pick head obdbg/bibpt inb
unless all [(second (second w)) = enable (first (second w)) = false ] [
poke w 2 reduce [true enable]
]
]
]
] ;--- end edbbpt
l_fmt: func [
"list and format code"
sname [string!] "main or name of function"
obdbg [object!]
ilptab [integer!] "format length of tabs before ->"
/bkpt sbpt [string!] "path-index of current breakpoint"
/local w bidt idt idpsv bdpsv it itt idp bdp imin i n bprin ebpt out
][
out: copy ""
w: obdbg/dbbbpts
bidt: copy [] ;--- list of path for indentation
idt: 0
idpsv: length? bdpsv: copy ["1"]
forskip w 3 [
it: third w
itt: load it
idp: length? bdp: parse/all first w "/"
ebpt: second w
unless all [ idp = 1 idp = idpsv ] [
either idp < idpsv [ imin: idp ][ imin: idpsv ]
i: 0
loop imin [
i: i + 1
unless bdpsv/(:i) = bdp/(:i) [ break ]
]
unless i = idpsv [
;--- test ident a supprimer !!
;--- (idpsv - i) "]" to close
n: idpsv - i
loop n [
unless (length? bidt) = 0 [
bidt: back tail bidt
if (length? parse/all bidt/1 "/") >= idpsv [
;--- ] with indentation
unless empty? out [ append out newline ]
insert/dup tail out #" " ilptab
append out " - "
insert/dup tail out #" " 3 * (idt - 2)
remove bidt
idt: idt - 1
]
bidt: head bidt
]
idpsv: idpsv - 1
append out " ]"
] ;--- loop n
;--- fin ident a supprimer !!
]
append out " "
unless i = idp [
insert/dup tail out #"[" (idp - i)
]
idpsv: length? bdpsv: copy bdp
] ; --- unless all [ idp = 1 idp = idpsv ]
bprin: false
if any [ ebpt/1 set-word? itt all [word? itt value? to-lit-word it] ] [
if any [ ebpt/1
set-word? itt
native? get itt
action? get itt
routine? get itt
all [ function? get itt (to-lit-word it) <> 'function ]
] [
bprin: true
unless empty? out [ append out newline ]
append out copy first w
insert/dup tail out #" " (ilptab - (length? first w))
; prin [stab "->"]
either ebpt/1 [
either all [ bkpt (first w) = sbpt ][
append out " B->"
][
either ebpt/2 [
append out " b- " ;--- breakpoint is enable
][
append out " d- " ;--- breakpoint is disable
]
]
][
;--- no enable breakpoint
either all [ bkpt (first w) = sbpt ][
append out " ->"
][
append out " - "
]
]
;--- indent ---
if any [ (length? bidt) = 0
(length? parse/all first w "/") > (length? parse/all last bidt "/")
][
append bidt first w
idt: idt + 1
]
]
]
append out " "
if bprin [
insert/dup tail out #" " 3 * (idt - 1)
]
append out it
] ;--- forskip w 3
unless idpsv = 1 [
either idt = 1 [
;--- no indent
insert/dup tail out #"]" idpsv - 1
][
;--- indent to do
repeat i (idpsv - 1) [
unless (idpsv - i) >= idt [
append out newline
insert/dup tail out #" " ilptab
append out " - "
insert/dup tail out #" " 3 * (idpsv - i - 1)
]
append out " ]"
]
]
clear bidt
]
append out reduce [newline "<END " sname ">" newline]
out
] ;--- end l_fmt
fmt: has [ snam obdbg "local variables" ][
foreach [ snam obdbg ] self/listdb [
print self/l_fmt snam obdbg obdbg/ilpath
]
]
pre-code: func [ "pre-treatment of code to debug"
obdbg [object!] "object defining the code to debug"
/local out
][
obdbg/dbbbpts: copy []
out: copy ""
; fonction récursive interne
recurse: func [b [block!] npath [string!] /local pos tmp] [
if (length? npath) > obdbg/ilpath [ obdbg/ilpath: length? npath]
pos: 1
forall b [
either all [block? first b not empty? first b] [
; bloc imbriqué → descendre
tmp: copy npath
recurse first b append tmp join form pos "/"
][
either (length? npath) = 0 [
tmp: form pos
][
tmp: join npath form pos
]
; append obdbg/dbbbpts reduce [tmp [false true] mold first b]
append obdbg/dbbbpts tmp
append/only obdbg/dbbbpts reduce [false true]
append obdbg/dbbbpts mold first b
append out join tmp " - "
; afficher l'expression
append out mold first b
append out newline
] ;--- end either block? first b
pos: pos + 1
]
]
recurse obdbg/bcod copy ""
unless obdbg/ilpath = 1 [ obdbg/ilpath: obdbg/ilpath + 1]
out
] ;--- end pre-code
lcount: func [ "get number of lines of out and number of spath (from 0)"
out [string!] "list of lines"
/brkpt
spath [string!] "path-index in the code or function"
/local ipath bfin out1 count ][
ipath: 0
bfin: true
if brkpt [
either spath = copy/part out length? spath [
bfin: true
][
bfin: false
]
]
out1: out
count: 0
while [ out1: find/tail out1 newline ] [
count: count + 1
unless bfin [
if spath = copy/part out1 length? spath [
bfin: true
ipath: count
]
]
]
reduce [count ipath]
] ;--- lcount
ldisp: func [ "print list from line l range r"
out [string!] "list of lines"
l [integer!] "1rst line to print (from 0)"
r [integer!] "range of lines to print"
/local tmp sdeb ][
if l < 0 [ l: 0]
tmp: out
loop l [
unless tail? tmp [
tmp: find/tail tmp newline
]
]
sdeb: tmp
loop r [
unless tail? tmp [
tmp: find/tail tmp newline
]
]
print copy/part sdeb back tmp
] ;--- ldisp
break-do: func [ "break in debug code"
sname [string!] "main or name of function"
npath [string!] "path-index in the code or function"
wloc [word! none!] "word for local context access"
/local spacer spaces namalph namfunc sipath nampath strinp rule cmd rcmd nl sn sp shelp
btmp bb i objdbg ctx snam w lic lsn clrg out count icou fcsnam fcsnams][
unless none? wloc [
;probe wloc
ctx: bind? wloc
]
clrg: 12 ;--- list range to print
lic: 0
lsn: copy "main"
objdbg: select head self/listdb sname
either empty? npath [
print rejoin ["[DBG] " sname ]
][
btmp: parse/all npath "/"
bb: head objdbg/bcod
repeat i length? btmp [
bb: pick bb to integer! btmp/:i
]
btmp: find objdbg/dbbbpts npath
unless all [ (first (second btmp)) = true (third btmp) = mold bb ] [
print ["!!** system error! at " index? btmp copy/part btmp 3]
]
if (second (second btmp)) = false [
;--- breakpoint is disable -> exit function
exit
]
; print rejoin ["[DBG] " frame/name " @ " frame/index " → " mold element]
; print rejoin ["[DBG] " npath " → " mold at self/bcod npath]
print rejoin ["[DBG] " sname " @ " npath " → " mold bb]
]
spacer: charset reduce [tab newline #" "]
spaces: [some spacer]
namalph: charset [#"*" - #"z"]
namfunc: [namalph some namalph] ;-- at least 2 characters namalph
sipath: charset ["/" #"0" - #"9"]
nampath: [some sipath]
fcsnam: complement charset "% "
fcsnams: [some fcsnam]
rule: copy [
"local" spaces (cmd: 7) [ copy sn namfunc [ end | spaces copy sp to end ] ] |
"listdebug" (cmd: 12) end | "listd" (cmd: 12) end |
"list" (cmd: 1) spaces ["." (cmd: 1.1) | "-" (cmd: 1.2) | "+" (cmd: 1.3) | copy nl integer! | copy sn namfunc 0 1 [ spaces copy nl integer!]] end |
"l" (cmd: 1) spaces ["." (cmd: 1.1) | "-" (cmd: 1.2) | "+" (cmd: 1.3) | copy nl integer! | copy sn namfunc 0 1 [ spaces copy nl integer!]] end |
"continue" (cmd: 4) end | "cont" (cmd: 4) end | "c" (cmd: 4) end |
"quit" (cmd: 5) end | "q" (cmd: 5) end |
"break" (cmd: 8) [ end | spaces copy sn namfunc spaces copy sp nampath end ] |
"b" (cmd: 8) [ end | spaces copy sn namfunc spaces copy sp nampath end ] |
"clearbreak" (cmd: 9) [ end | spaces copy sn namfunc end | spaces copy sn namfunc spaces copy sp nampath end ] |
"clearb" (cmd: 9) [ end | spaces copy sn namfunc end | spaces copy sn namfunc spaces copy sp nampath end ] |
"enable" (cmd: 15) spaces copy sn namfunc copy nl some [spaces integer!] |
"disable" (cmd: 16) spaces copy sn namfunc copy nl some [spaces integer!] |
"debug" (cmd: 10) spaces copy sn namfunc end | "d" (cmd: 10) spaces copy sn namfunc end |
"undebug" (cmd: 11) [ end | spaces copy sn namfunc end ] | "und" (cmd: 11) [ end | spaces copy sn namfunc end ] |
"recordcmd" (cmd: 13) [ end | spaces "%" copy sn fcsnams [ end | spaces copy sp "overwrite" end ] | spaces copy sp "off" end ] |
"playcmd" (cmd: 14) [ spaces "%" copy sn fcsnams end ] |
"rebol" (cmd: 6) spaces copy rcmd to end |
"r" (cmd: 6) spaces copy rcmd to end |
"!" (cmd: 6) spaces copy rcmd to end
]
shelp: {
h(elp) | ?
^(tab)This help.^(line)
l(ist) . | - | + | <line number> | <main or name of function> | <main or name of function> <line number>
^(tab)list debug code (-> indicate the current code to execute).^(line)
b(reak) [<main or name of function> <path-index>]
^(tab)set/define breakpoint.^(line)
clearb(reak) [<main or name of function> | <main or name of function> <path-index>]
^(tab)clear/unset/undefine breakpoint.^(line)
enable <main or name of function> <path-index> <bpnumber> [<bpnumber> ...]
^(tab)enable breakpoint(s) <bpnumber>.^(line)
disable <main or name of function> <bpnumber> [<bpnumber> ...]
^(tab)disable breakpoint(s) <bpnumber>.^(line)
d(ebug) <main or name of function>
^(tab)debug function.^(line)
und(ebug) [<main or name of function>]
^(tab)undebug function.^(line)
listd(ebug)
^(tab)print names of function to debug.^(line)
local <localword> [<setValue>]
^(tab)print <localword> or set <localword> to <setValue>.^(line)
r(ebol) <Rebol code> | ! <Rebol code>
^(tab)execute <Rebol code>.^(line)
c((ont)inue)
^(tab)continue execution until a breakpoint or until end.^(line)
recordcmd [ off | <%file> [overwrite] ]
^(tab)record the input commands into <%file> (option overwrite) or disable recording (if option is off).^(line)
playcmd <%file>
^(tab)play the recorded commands in <%file>.^(line)
q(uit)
^(tab)quit the debugger.
}
forever [
cmd: 0
rcmd: copy ""
nl: copy ""
sn: copy ""
sp: copy ""
either empty? self/cmddb/bplay [
strinp: ask "DBG> "
if self/cmddb/bsav = true [
write/append/lines self/cmddb/fname append copy [] strinp
]
][
strinp: take self/cmddb/bplay
print ["DBG> [PLAY] " strinp]
]
either parse/all strinp rule [
; print [cmd nl rcmd sn sp]
if none? rcmd [ rcmd: ""]
if none? sn [ sn: ""]
if none? sp [ sp: ""]
if none? nl [ nl: ""]
switch/default cmd [
1 [
;--- list nl sn
; print [nl sn]
unless empty? sn [
lsn: sn
]
either empty? nl [ lic: 0][ lic: (to-integer nl) - 1]
objdbg: select head self/listdb lsn
either lsn = sname [
out: self/l_fmt/bkpt lsn objdbg objdbg/ilpath npath
][
out: self/l_fmt lsn objdbg objdbg/ilpath
]
self/ldisp out lic clrg
] ;-- list nl sn
1.1 [
;--- list .
objdbg: select head self/listdb sname
out: self/l_fmt/bkpt sname objdbg objdbg/ilpath npath
set [ count icou ] self/lcount/brkpt out npath
lic: max icou - to-integer (clrg / 2) 0
lsn: sname
self/ldisp out lic clrg
] ;-- list .
1.2 [
;--- list -
if positive? lic [
lic: lic - clrg
]
objdbg: select head self/listdb lsn
either lsn = sname [
out: self/l_fmt/bkpt lsn objdbg objdbg/ilpath npath
][
out: self/l_fmt lsn objdbg objdbg/ilpath
]
self/ldisp out lic clrg
] ;-- list -
1.3 [
;--- list +
objdbg: select head self/listdb lsn
either lsn = sname [
out: self/l_fmt/bkpt lsn objdbg objdbg/ilpath npath
][
out: self/l_fmt lsn objdbg objdbg/ilpath
]
set [ count icou ] self/lcount out
if (lic + clrg) < count [
lic: lic + clrg
]
self/ldisp out lic clrg
] ;-- list +
4 [ break ] ;--- cont
5 [ quit ] ;--- quit
7 [ ;--- local word to display or to set
attempt [
unless wloc = 'none [
either empty? sp [
prin [sn "(" type? get in ctx to-lit-word sn ") is "] probe get in ctx to-lit-word sn
][
;--- local word to set
set in ctx to-lit-word sn load sp
prin ["set" sn "(" type? get in ctx to-lit-word sn ") to "] probe get in ctx to-lit-word sn
]
]
]
] ;--- local word to display
8 [ ;--- break
; print ["break" sn sp] ;--!!!
either all [ empty? sn empty? sp ][
;--- print enable breakpoints
foreach [ snam objdbg ] self/listdb [
print ["Breakpoints in" snam]
print "Num Enb Where"
btmp: head objdbg/bibpt
forall btmp [
prin [ index? btmp "" ]
if ( 3 - (length? form index? btmp) ) > 0 [
prin copy/part " " ( 3 - (length? form index? btmp) )
]
w: at head objdbg/dbbbpts first btmp
either (second (second w)) = true [
prin "yes "
][
prin "no "
]
print [ (first w) "-" (third w)]
]
] ;--- foreach
][
;--- set breakpoint for sn/sp
self/dbbpt sn sp true
] ;--- either all
]
9 [ ;--- clearbreak
; print ["clearbreak" sn sp] ;--!!!
either all [ empty? sn empty? sp ][
;--- disbreak all
self/dbdisbpt
][
either empty? sp [
self/dbdisbpt/only sn
][
self/dbbpt sn sp false
]
] ;--- either all
] ;--- disbreak
10 [ ;--- debug
if none? attempt [
self/debug/funct sn
] [
;--- error attempt --> remove
self/undebug/only sn
]
]
11 [ ;--- undebug
either empty? sn [
self/dbdisbpt self/undebug
][
self/dbdisbpt/only sn
self/undebug/only sn
]
]
12 [ ;--- list debug function names
print "Debug List:"
foreach [ snam objdbg ] self/listdb [
print [ "-" snam ]
]
]
13 [ ;--- recordcmd
; probe sn probe sp
either all [empty? sn not empty? sp] [
;--- set recordcmd to off
self/cmddb/bsav: false
self/cmddb/fname: none
][
either empty? sn [
;--- status of recordcmd
either self/cmddb/bsav = true [
print ["Command recording is ON in file %" self/cmddb/fname ]
][
print "Command recording is OFF"
]
unless empty? self/cmddb/bplay [
print [ length? self/cmddb/bplay " commands to play."]
]
][
;--- file sn and option "overwrite" sp
unless empty? sp [
;--- overwrite file
write to-file sn ""
]
self/cmddb/bsav: true
self/cmddb/fname: to-file sn
]
]
]
14 [ ;--- playcmd
; probe sn
self/cmddb/bplay: read/lines to-file sn
]
15 [ ;--- enable
; probe sn nl
btmp: parse nl none
foreach i btmp [
unless empty? i [
self/edbbpt sn (to integer! i) true
]
]
]
16 [ ;--- disable
; probe sn nl
btmp: parse nl none
foreach i btmp [
unless empty? i [
self/edbbpt sn (to integer! i) false
]
]
]
][ ;--- begin default
; Rebol command
attempt [
; print mold rcmd
do load mold rcmd
]
] ;--- end default
] [ print shelp]
] ;--- forever
exit
]
debug: func [ "debug code or function"
rsrc [file! url! string! block!] "main code or name of function to debug"
/funct "function to debug"
/run "run debug code"
/dbg "print code possible breakpoints"
/local sname objdbg bf obj i barg][
either all [funct string? rsrc] [
sname: copy rsrc
][
;--- no funct refinement
sname: "main"
]
unless find self/listdb sname [
append self/listdb sname
append self/listdb make object! [
bcod: copy [] ;--- copy of original code to debug
dbcode: copy [] ;--- instrumented code
dbbbpts: copy [] ;--- breakpoints records: npath, [true/false(is breakpoint) true/false(enable)], itemcode
bibpt: copy [] ;--- indexes in dbbbpts of breakpoints
wloc: 'none ;--- no local word to debug (for bind context)
ilpath: 1 ;--- max path length
]
objdbg: select head self/listdb sname
; either any [file? rsrc url? rsrc] [
; objdbg/dbcode: load rsrc
; ][
either funct [
bf: parse/all rsrc "/" ;-- case function in objects
either (length? bf) = 1 [ ;--- word function
obj: get to-lit-word rsrc ;--- word function
; objdbg/dbcode: second get to-lit-word rsrc ;--- body of function
][
;--- word function in object
obj: get in get load bf/1 to-lit-word bf/2
i: 2
while [ all [ i < (length? bf) object? :obj ] ][
i: i + 1
obj: get in :obj to-lit-word bf/(:i)
]
]
if function? :obj [ ;--- word function
objdbg/dbcode: second :obj ;--- body of function
barg: first :obj ;--- args and local vars in function
forall barg [
unless (refinement? first barg) = true [
;--- local word
objdbg/wloc: to-lit-word first barg
break
]
]
]
][ ;--- no refinement funct
objdbg/dbcode: load rsrc
]
; ]
either empty? objdbg/dbcode [
;--- no function? code --> remove debug
remove/part find head self/listdb sname 2 ;--- to remove 2 items: sname and object
][
;--- function? code to debug
objdbg/bcod: copy/deep head objdbg/dbcode ;--- copy of originate code in bcod
either dbg [
print self/pre-code objdbg
][
self/pre-code objdbg
]
if run [
; self/dbbpt sname "1" true
self/break-do "main" "" none
do objdbg/dbcode
print "[DBG] End running"
]
] ;--- end either empty? objdbg/dbcode
] ;--- end unless
true ;--- not none for attempt (parent call)
] ;--- end debug
undebug: func [ "undebug previous debug code"
/only "only specific function or code to undebug"
sname [string!] "main or name of function or code to undebug"
][
either only [
unless none? find head self/listdb sname [
remove/part find head self/listdb sname 2 ;--- to remove 2 items: sname and object
]
][
clear head self/listdb ;--- to remove all
]
] ;--- end undebug
] ;--- end context |