;; ================================================
;; Script: dbg.r
;; downloaded from: www.REBOL.org
;; on: 25-Jul-2026
;; at: 0:58:44.583077 UTC
;; owner: jlm [script library member who can update
;; this script]
;; ================================================
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