Script Library: 1249 scripts
 

dbg.r

REBOL [ 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
halt ;; to terminate script if DO'ne from webpage