File: sdcdb.tcl

package info (click to toggle)
openmsx 21.0%2Bdfsg-3
  • links: PTS
  • area: main
  • in suites: sid
  • size: 28,132 kB
  • sloc: cpp: 244,928; xml: 54,344; tcl: 15,603; python: 5,335; perl: 281; sh: 78; makefile: 57
file content (861 lines) | stat: -rw-r--r-- 29,782 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
# SDCDB Debugger in Tcl - Version 0.8
#
# Copyright 2025 Pedro de Medeiros all rights reserved
#
# A debugger written in Tcl that uses `SDCC --debug` parameter to create breakpoints and much more.
#
# The main difference between SDCC Debugger's breakpoints and the built-in OpenMSX breakpoints is the
# C code integration:
# [*] allow users to create breakpoints on C code:
#     > sdcdb break main.c:55
# [*] list C source code at line 100:
#     > sdcdb list main.c:100
# [*] step through the source code
#     > sdcdb step
# [*] and more things to come (WIP).
#
# All commands that the SDCDB Debugger recognizes directly. You may call them with sdcdb [COMMAND] [ARGS...]:
#
# open ?-recursive? <directories> [<pathToCDBFile>]
#       - Start debugging session, reading source files and a CDB file specified by parameters.
#         -recursive enables recursive searching in subdirectories.
# break <file>:<line>
#       - creates breakpoint in <file>:<line>
# list ?<line>?
#       - list source code at <file>:<line>[-<line>]
# info ?-break?
#       - Display information on source code under the program counter. The -break parameter
#         parameter stops execution.
# step ?<n>?
#       - Executes next n lines of C code step by step, proceeding through subroutine calls.
#         n defaults to 1.
# next ?<n>?
#       - The 'sdcdb next' is like 'sdcdb step' but will not proceed through subroutine calls.
#         You may specify how many n times 'sdcdb next' should execute (defaults to 1).
# whereis <fileName>
#       - Checks if a C/assembly source file was included in a scan from `sdcdb open` and
#         returns the path to the file.
# map <file>:<line>
#       - Returns memory address of <file>:<line>, accepting same parameters of 'sdcdb break',
#         but without creating breakpoints.
# laddr <address>
#       - Returns the C/assembly source code associated with a memory address.
#
# Known limitations:
# [*] don't create C files with same name in different folders (in projects with multiple
#     folders), since CDB files don't keep track of directories, just file names. SDCDB
#     will get lost and report the wrong position because of missing files during break or
#     step.
# [*] don't create projects with assembly and C files with the same name, since SDCC
#     already creates an .asm file for every .c file in your project. SDCDB will get lost
#     and report the wrong position because of missing files during break or step.
#
# For more information about the CDB file format: https://sourceforge.net/p/sdcc/wiki/Home/

namespace eval sdcdb {

variable initialized    0
variable c_files_count                  ;# C files reference
variable a_files_count                  ;# ASM files reference
array set c_files       {}              ;# pool of c source files
array set a_files       {}              ;# pool of a source files
array set addr2file     {}              ;# array that maps to source from address
array set g_func2addr   {}              ;# array that maps to address from source (global)
# array set c_<filename>2addr           ;# same, but dinamically created array for each SDCC module (C file)
# array set a_<filename>2addr           ;# same, but dinamically created array for each SDCC module (ASM file)
# array set <filename>_func2addr        ;# array that maps function to source (static)
variable current_file   {}              ;# debugger file
variable current_line   {}              ;# debugger line
variable cond           {}              ;# breakpoint check condition
variable old_PC         {}
variable times_left     0
variable out_of_scope   0               ;# running without debug info?
proc ASM {} { return ".asm" }

set_help_proc sdcdb [namespace code sdcdb_help]
proc sdcdb_help {args} {
    if {[llength $args] == 1} {
        return {The SDCDB debugger in Tcl connects OpenMSX to the CDB file created by SDCC.

Recognized commands: open, break, list, step, next, info, whereis, laddr, map

Type 'help sdcdb <command>' for more information about each command.
}
    }
    switch -- [lindex $args 1] {
        "open" { return {Opens a project directory and start debugging session

'sdcdb open' will scan directories for source files and also search for a single CDB file in them, or you may specify the path to a CDB file directly (a single file probably named <projectName>.cdb) in addition to the source files.

Syntax: sdcdb open <directories> [<.cdbFile>]
}}
        "break" { return {Creates a breakpoint

Create a OpenMSX breakpoint, but using the C source files as reference. 'sdcdb info -break' replaces 'debug break' for extra details about C code execution.

Syntax: sdcdb break <file>:<line>
        sdcdb break <file>:<functionName>
        sdcdb break <functionName>
}}
        "list" { return {Lists contents of a C source file

Without parameters, 'sdcdb list' returns the C/assembly source code under the PC register. Obs.: assembly function names are not recognized.

Syntax: sdcdb list
        sdcdb list <file>:<line>
        sdcdb list <file>:<functionName>
        sdcdb list <functionName>
}}
        "laddr" { return {Lists contents of C/assembly source code in a specified memory address

Syntax: sdcdb laddr mem
}}
        "step" { return {Steps through next n lines of C code

The 'sdcdb step' command will proceed through subroutine calls. You may specify how many times 'sdcdb step' should execute (defaults to 1).

Syntax: sdcdb step ?n?
}}
        "next" { return {Executes next n lines of C code

The 'sdcdb next' command will not proceed through subroutine calls. You may specify how many times 'sdcdb next' should execute (defaults to 1).

Syntax: sdcdb next ?n?
}}
        "info" { return {Displays information about current line of source code

A '-break' parameter stops execution after displaying the information.

Syntax: sdcdb info ?-break?
}}
        "whereis" { return {Displays if source file was found in the database

Syntax: sdcdb whereis <sourceFileName>
}}
        "map" { return {Returns memory address from a C/assembly file line

Basically a dry-run version of 'sdcdb break'. If a functionName is used, it returns the beginning and ending address of the function.

Syntax: sdcdb map <file>:<line>
        sdcdb map <file>:<functionName>
        sdcdb map <functionName>
}}
    }
}

proc debug_out {args} {
    variable debug
    if {$debug} {
        set chan stderr
        set msg [string map {"\n" "\\n"} [join $args " "]]
        puts $chan $msg
        flush $chan
    }
}

proc sdcdb {args} {
    if {[catch {set result [dispatcher {*}$args]} msg]} {
        debug_out stderr $::errorInfo
        error $msg
    }
    return $result
}

proc dispatcher {args} {
    set params "[lrange $args 1 end]"
    set cmd [lindex $args 0]
    switch -- $cmd {
        open    { return [sdcdb_open       {*}$params] }
    }
    # remaining commands need initialization
    variable initialized
    if {!$initialized} {
        error "You need a CDB file to use this command. Use the 'sdcdb open' command first"
    }
    switch -- $cmd {
        break   { return [sdcdb_break      {*}$params] }
        list    { return [sdcdb_list       {*}$params] }
        info    { return [sdcdb_info       {*}$params] }
        step    { return [sdcdb_step       {*}$params] }
        next    { return [sdcdb_next       {*}$params] }
        whereis { return [sdcdb_whereis    {*}$params] }
        laddr   { return [sdcdb_laddr      {*}$params] }
        map     { return [sdcdb_map        {*}$params] }
        default { error "Unknown command \"[lindex $args 0]\"." }
    }
}

proc sdcdb_open {param args} {
    free
    set function normal_glob
    if {$param eq "-recursive"} {
        set function recursive_glob
    } else {
        set args [linsert $args 0 $param]
    }
    set cdb_file {}
    foreach path $args {
        if {![file exists $path]} {
            error "file '$path' not found"
        }
        if {[file isdirectory $path]} {
            set new_files [$function $path *.c]
            debug_out "adding files: [join $new_files {, }]"
            add_files_to_database c_files $new_files
            set new_files [$function $path *[ASM]]
            debug_out "adding files: [join $new_files {, }]"
            add_files_to_database a_files $new_files
            set cdb_files [$function $path *.cdb]
        } elseif {[file isfile $path] && [file extension $path] eq ".cdb"} {
            set cdb_file $path
        }
    }
    if {$cdb_file eq {}} {
        if {[llength $cdb_files] > 1} {
            error "multiple CDB files found, you may specify one as a parameter to 'scdb open'"
        } elseif {[llength $cdb_files] == 0} {
            error "CDB file not found"
        }
        set cdb_file $cdb_files
    }
    variable initialized
    set initialized 1
    set result [read_cdb $cdb_file]
    process_data
    return $result
}

proc complete {arrayname name list} {
    variable $arrayname
    if {![info exists ${arrayname}($name)]} {
        debug_out "$arrayname\($name\) ignored"; return 0
    }
    set ${arrayname}($name) [concat {*}[set ${arrayname}($name)] {*}$list]
    return 1
}

proc read_cdb {fname} {
    variable c_files_count
    variable addr2file
    set fh [open $fname "r"]
    # function pattern: search for "F:G$function_name$..." lines
    set func_pat {^F:(G|F([^$]+)|L([^$]+))\$([^$]+)\$.*}
    # ASM line number pattern: search for "L:A$filename$line:address" lines
    set aline_pat {^L:A\$([^$]+)\$([^$]+):([^$]+)$}
    # C line number pattern: search for "L:C$filename$line$level$block:address" lines
    set cline_pat {^L:C\$([^$]+)\$([^$]+)\$([^$]+)\$([^$]+):(\S+)$}
    # function begin pattern: search for "L:(G|F<name>|L<name>)$function$level$block:address" lines
    set func_bn_pat {^L:(G|F([^$]+)|L([^$]+))\$([^$]+)\$([^$]+)\$([^$]+):(\S+)$}
    # function end pattern: search for "L:X(G|F<name>|L<name>)$function$level$block:address" lines
    set func_ed_pat {^L:X(G|F([^$]+)|L([^$]+))\$([^$]+)\$([^$]+)\$([^$]+):(\S+)$}
    set c_count 0  ;# lines of C code
    set a_count 0  ;# lines of asm code
    set gf_count 0 ;# global functions
    set sf_count 0 ;# static functions
    while {[gets $fh line] != -1} {
        set match [regexp -inline $func_pat $line]
        if {[llength $match] == 5} {
            lassign $match {} context {} {} funcname
            switch -- [string index $context 0] {
                G {
                    variable g_func2addr
                    set g_func2addr($funcname) {}
                    debug_out "g_func2addr\($funcname\) created"
                }
                F {
                    set arrayname [string range $context 1 [string length $context]]_func2addr
                    variable $arrayname
                    set ${arrayname}($funcname) {}
                    debug_out "${arrayname}\($funcname\) created"
                }
                L {}
            }
            continue
        }
        set match [regexp -inline $cline_pat $line]
        if {[llength $match] == 6} {
            lassign $match {} filename linenum {} {} address
            set address [expr {"0x$address"}]
            # Put line -> address mapping of array with dynamic name
            set arrayname c_[file rootname $filename]2addr
            incr c_files_count($filename)
            if {$c_files_count($filename) eq 1} {
                debug_out "Created new dynamic array $arrayname"
            }
            variable $arrayname
            # <file>2addr: linenum to address
            set ${arrayname}($linenum) $address
            # address to file:linenum
            set record [lindex [array get addr2file $address] 1]
            if {$record ne {}} {
                lassign $record old_file {}
                # Stop C code from overwriting used address.
                if {$filename eq $old_file} {
                    debug_out "not mapping [h $address] to C source: address already taken by '$old_file'"
                    continue
                }
            }
            set addr2file($address) [list $filename $linenum]
            debug_out "mapping C source ${arrayname}\($linenum\): [set ${arrayname}($linenum)] ($line)"
            incr c_count
            continue
        }
        set match [regexp -inline $aline_pat $line]
        if {[llength $match] == 4} {
            lassign $match {} filename linenum address
            set address [expr {"0x$address"}]
            # Put line -> address mapping of array with dynamic name
            set arrayname a_${filename}2addr
            set filename $filename[ASM]
            incr a_files_count($filename)  ;# SDCC removes the file extension for some reason
            if {$a_files_count($filename) eq 1} {
                debug_out "Created new dynamic array $arrayname"
            }
            variable $arrayname
            # <file>2addr: linenum to address
            set ${arrayname}($linenum) $address
            set addr2file($address) [list $filename $linenum]
            debug_out "mapping asm source ${arrayname}\($linenum\): [set ${arrayname}($linenum)]"
            incr a_count
            continue
        }
        set match [regexp -inline $func_bn_pat $line]
        if {[llength $match] == 8} {
            lassign $match {} context {} {} funcname {} {} address
            set address [expr {"0x$address"}]
            # Put function begin record in array with dynamic name
            switch -- [string index $context 0] {
                G {
                    variable g_func2addr
                    # g_func2addr: funcname -> start address (global)
                    if {[complete g_func2addr $funcname [list $address]]} {
                        debug_out "mapping function g_func2addr\($funcname\): [set g_func2addr($funcname)]"
                        incr gf_count
                    }
                }
                F {
                    # <file>_func2addr: funcname -> start address (static)
                    set arrayname [string range $context 1 [string length $context]]_func2addr
                    variable $arrayname
                    if {[complete $arrayname $funcname [list $address]]} {
                        debug_out "mapping function ${arrayname}\($funcname\): [set ${arrayname}($funcname)]"
                        incr sf_count
                    }
                }
                L {}
            }
            continue
        }
        set match [regexp -inline $func_ed_pat $line]
        if {[llength $match] == 8} {
            lassign $match {} context {} {} funcname {} {} address
            set address [expr {"0x$address"}]
            # Put function end record in array with dynamic name
            switch -- [string index $context 0] {
                G {
                    # g_func2addr: funcname -> end address (global)
                    variable g_func2addr
                    if {[complete g_func2addr $funcname [list $address]]} {
                        debug_out "mapping function g_func2addr\($funcname\): [set g_func2addr($funcname)]"
                    }
                }
                F {
                    # <file>_func2addr: funcname -> end address (static)
                    set arrayname [string range $context 1 [string length $context]]_func2addr
                    variable $arrayname
                    if {[complete $arrayname $funcname [list $address]]} {
                        debug_out "mapping function ${arrayname}\($funcname\): [set ${arrayname}($funcname)]"
                    }
                }
                L {
                }
            }
            continue
        }
        debug_out "Ignored '$line'"
    }
    close $fh
    variable c_files
    variable a_files
    set result ""
    append result "[array size c_files] C files added\n"
    append result "[array size a_files] assembly files added\n"
    append result "[array size c_files_count] C files references added\n"
    append result "[array size a_files_count] assembly files references added\n"
    append result "$c_count C source lines found\n"
    append result "$a_count assembly source lines found\n"
    append result "$gf_count global function(s) registered\n"
    append result "$sf_count static function(s) registered\n"
    return $result
}

proc fix_blank_spaces {arrayname} {
    variable $arrayname 
    set old_key {}
    foreach key [lsort -integer [array names $arrayname]] {
        if {$old_key ne {} && [expr {$key - 1}] != $old_key} {
            for {set i [expr {$old_key + 1}]} {$i < $key} {incr i} {
                #debug "Setting $arrayname\($i\) to ${arrayname}\($old_key\) = [set ${arrayname}($old_key)]"
                set ${arrayname}($i) [set ${arrayname}($old_key)]
            }
        }
        set old_key $key
    }
}

proc fix_last_address {arrayname} {
    variable $arrayname
    set old_key {}
    set sorted [lsort -integer [array names $arrayname]]
    foreach key $sorted {
        if {$old_key ne {} && [set ${arrayname}($old_key)] ne [set ${arrayname}($key)]} {
            set ${arrayname}($old_key) [list [set ${arrayname}($old_key)] [expr {[set ${arrayname}($key)] - 1}]]
        } elseif {$old_key ne {}} {
            set ${arrayname}($old_key) [list [set ${arrayname}($old_key)] [set ${arrayname}($old_key)]]
        }
        set old_key $key
    }
    if {[llength $sorted] > 0} {
        # change last value
        set last [lindex $sorted end]
        set ${arrayname}($last) [list [set ${arrayname}($last)] [set ${arrayname}($last)]]
    }
}

proc process_data {} {
    variable c_files
    foreach filename [array names c_files] {
        set arrayname c_[file rootname $filename]2addr
        variable $arrayname
        fix_last_address $arrayname
        fix_blank_spaces $arrayname
    }
    variable a_files
    foreach filename [array names a_files] {
        set arrayname a_[file rootname $filename]2addr
        variable $arrayname
        fix_last_address $arrayname
        fix_blank_spaces $arrayname
    }
    fix_blank_spaces addr2file
}

proc normal_glob {dir pattern} {
    glob -nocomplain -type f -directory $dir $pattern
}

proc recursive_glob {dir pattern} {
    set result [list]
    foreach file [glob -nocomplain -directory $dir $pattern] {
        lappend result $file
    }
    foreach subdir [glob -nocomplain -directory $dir *] {
        if {[file isdirectory $subdir]} {
            lappend result {*}[recursive_glob $subdir $pattern]
        }
    }
    return $result
}

proc add_files_to_database {arrayname files} {
    variable $arrayname
    foreach path $files {
        set filename [file tail $path]
        if {[array get $arrayname $filename] ne {}} {
            debug_out "file '$filename' already registered in $arrayname, new entry ignored."
        }
        set ${arrayname}($filename) $path
    }
}

proc sdcdb_list {args} {
    # parameter pattern 1: file:beginLine-endLine
    set pattern1 {([^:]+):(\d+)(-(\d+))?}
    # parameter pattern 2: file:functionName
    set pattern2 {([^:]+):(\S+)}
    # parameter pattern 3: functionName
    set pattern3 {(\S+)}
    set arg [lindex $args 0]
    set match [regexp -inline $pattern1 $arg]
    if {[llength $match] == 5} {
        lassign $match {} file start {} end
        return [list_file $file $start $end 0 1]
    }
    set match [regexp -inline $pattern2 $arg]
    if {[llength $match] == 3} {
        lassign $match {} file funcname
        return [list_func $file $funcname]
    }
    set match [regexp -inline $pattern3 $arg]
    if {[llength $match] == 2} {
        lassign $match {} funcname
        return [list_func {} $funcname]
    }
    list_pc
}

proc list_file {file begin {end {}} {focus 0} {showerror 0}} {
    if {[file extension $file] eq ".c"} {
        set files c_files
    } elseif {[file extension $file] eq [ASM]} {
        set files a_files
    } else {
        error "Unknown or unspecified file extension"
    }
    variable $files
    set record [array get $files $file]
    if {$record eq {}} {
        if {$showerror} {
            error "file '$file' not found in database, add a directory that contains such file with 'sdcdb add <dir>'"
        }
        return "$file: not found"
    }
    debug_out "opening file [lindex $record 1]..."
    set fh [open [lindex $record 1] r]
    set pos 0
    # 10 lines by default
    if {$end eq {}} { set end [expr {$begin + 9}] }
    set result ""
    while {[gets $fh line] >= 0} {
        incr pos
        if {$pos >= $begin} {
            append result "[format %-5d $pos][expr {$pos == $focus ? "*" : ":"}]    $line\n"
        }
        if {$pos >= $end} { break }
    }
    close $fh
    return $result
}

proc list_pc {{x0 -1} {x1 9}} {
    list_address [reg PC] $x0 $x1 1
}

proc list_addr2file {arrayname address} {
    variable $arrayname
    set address [expr {$address}]
    return [lindex [array get $arrayname $address] 1]
}

proc list_address {address {x0 -1} {x1 9} {showerror 0}} {
    set address [expr {$address}]
    variable addr2file
    set record [list_addr2file addr2file $address]
    if {$record eq {}} {
        set msg "database address not found for 0x[h $address]"
        if {$showerror} { error $msg }
        return $msg
    }
    lassign $record file begin
    list_file $file [expr {$begin + $x0}] [expr {$begin + $x1}] $begin
}

proc sdcdb_laddr {address} {
    list_address $address
}

proc list_func {filename funcname} {
    set results {}
    variable addr2file
    foreach region [search_func $filename $funcname] {
        lassign [lindex $region 0] begin end
        set record [lindex [array get addr2file $begin] 1]
        lassign $record filename lbegin
        lassign [lindex [array get addr2file $end] 1] {} lend
        append results "$filename:$funcname\n"
        append results [list_file $filename $lbegin $lend 0 1]
    }
    if {$results eq {}} {
        error "database function '$funcname' not found"
    }
    return $results
}

proc search_static_func {funcname {filename {}}} {
    set results [list]
    if {$filename ne {}} {
        set arrayname [file rootname $filename]_func2addr
        variable $arrayname
        set result [lindex [array get $arrayname $funcname] 1]
        if {$result ne {}} {
            lappend results [lindex [array get $arrayname $funcname] 1]
        }
        return $results
    }
    variable c_files
    foreach filename [array names c_files] {
        set arrayname [file rootname $filename]_func2addr
        variable $arrayname
        set result [lindex [array get $arrayname $funcname] 1]
        if {$result ne {}} {
            lappend results $result
        }
    }
    return $results
}

proc search_global_func {funcname {filename {}}} {
    set results [list]
    variable g_func2addr
    set result [lindex [array get g_func2addr $funcname] 1]
    if {$result eq {}} {
        return $results
    }
    # No filename specified? Return first entry
    if {$filename eq {} && $result ne {}} {
        return [lappend results $result]
    }
    lassign $result begin end
    variable addr2file
    lassign [lindex [array get addr2file $begin] 1] tmp {}
    if {$tmp ne {} && $tmp ne $filename} {
        return $results
    }
    return [lappend results $result]
}

# scan static file database then global database for function by name
proc search_func {filename funcname} {
    set results [list]
    set tmp1 [search_global_func $funcname $filename]
    if {$tmp1 ne {}} { lappend results $tmp1 }
    set tmp2 [search_static_func $funcname $filename]
    if {$tmp2 ne {}} { lappend results $tmp2 }
    if {$results eq {}} {
        error "'$funcname' not found"
    }
    return $results
}

proc search_file {file line} {
    set tmp [file rootname $file]
    if {[file extension $file] eq ".c"} {
        set arrayname c_${tmp}2addr
        variable c_${tmp}2addr
    } else {
        set arrayname a_${tmp}2addr
        variable a_${tmp}2addr
    }
    if {![info exists $arrayname]} {
        error "'$file': source file not found ($arrayname)"
    }
    set result [array get $arrayname $line]
    if {$result eq {}} {
        error "line $line not found in file '$file'"
    }
    lindex $result 1
}

# recurring pattern
proc map_source_params {pos fun1 fun2 fun3 args} {
    # parameter pattern 1: file:beginLine
    set pattern1 {([^:]+):(\d+)}
    # parameter pattern 2: file:functionName
    set pattern2 {([^:]+):(\S+)}
    # parameter pattern 3: functionName
    set pattern3 {(\S+)}
    set match [regexp -inline $pattern1 $pos]
    if {[llength $match] == 3} {
        return [$fun1 {*}[lrange $match 1 end] {*}$args]
    }
    set match [regexp -inline $pattern2 $pos]
    if {[llength $match] == 3} {
        return [$fun2 {*}[lrange $match 1 end] {*}$args]
    }
    set match [regexp -inline $pattern3 $pos]
    if {[llength $match] == 2} {
        return [$fun3 {*}[lrange $match 1 end] {*}$args]
    }
    # ignore the rest
}

proc sdcdb_map {pos} {
    map_source_params $pos map_fline map_ffunc map_func
}

proc map_fline {filename linenum} {
    search_file $filename $linenum
}

proc map_ffunc {filename funcname} {
    search_func $filename $funcname
}

proc map_func {funcname} {
    search_func {} $funcname
}

proc sdcdb_break {pos {cond {}} {cmd {sdcdb info -break}}} {
    map_source_params $pos break_fline break_ffunc break_func $cond $cmd
}

proc break_fline {filename linenum cond cmd} {
    set record [search_file $filename $linenum]
    if {$record eq {}} {
        error "address not found"
    } else {
        debug breakpoint create -address [lindex $record 1] -condition $cond -command $cmd
    }
}

proc break_ffunc {filename funcname cond cmd} {
    set count 0
    foreach region [search_func $filename $funcname] {
        lassign [lindex $region 0] begin {}
        debug breakpoint create -address $begin -condition $cond -command $cmd
        incr count
    }
    if {$count eq 0} {
        error "function not found"
    }
}

proc break_func {funcname cond cmd} {
    set count 0
    foreach region [search_func {} $funcname] {
        lassign [lindex $region 0] begin {}
        debug breakpoint create -address $begin -condition $cond -command $cmd
        incr count
    }
    if {$count eq 0} {
        error "function not found"
    }
}

proc check_status {file line} {
    return "file: $file:$line, position: 0x[h [reg PC]]\n[list_pc -1 1]"
}

proc update_step {{type {step}}} {
    variable out_of_scope
    variable current_file
    variable current_line
    variable times_left
    # different file position?
    set record [find_source [reg PC]]
    if {$record ne {} && $record ne [list $current_file $current_line]} {
        lassign $record current_file current_line
        incr times_left -1
        set out_of_scope 0
    }
    # still looping under these conditions
    if {$out_of_scope || $times_left > 0} {
        after break "sdcdb::update_step $type"
        $type  ;# call "step" or "step_over"
    } else {
        puts -nonewline [check_status $current_file $current_line]
    }
}

proc find_source {address} {
    variable addr2file
    # get current source file
    set record [lindex [array get addr2file [reg PC]] 1]
    return $record
}

proc prepare_step {{n 1}} {
    debug break  ;# just to be sure
    variable times_left $n
    # get current position in source code
    set record [find_source [reg PC]]
    lassign $record file line
    lassign [search_file $file $line] begin end
    debug_out "search_file: $file, $line -> [search_file $file $line]"
    if {$begin ne {} && $end ne {}} {
        variable current_file $file
        variable current_line $line
    } else {
        variable out_of_scope 1
        return "Possibly out of scope, skipping till we get back."
    }
}

proc sdcdb_step {{n 1}} {
    after break "sdcdb::update_step"
    debug step
    prepare_step $n
}

proc sdcdb_next {{n 1}} {
    after break "sdcdb::update_step step_over"
    prepare_step $n
    step_over
}

proc check_info {} {
    variable addr2file
    if {[array get addr2file [reg PC]] eq {}} {
        error "line mapping not found for 0x[h [reg PC]]"
    }
    lassign $addr2file([reg PC]) file line
    if {$file eq {}} {
        error "address [h [reg PC]] not found in database."
    }
    puts -nonewline [check_status $file $line]
}

proc sdcdb_info {{param {}}} {
    if {$param eq "-break"} {
        debug break
    }
    set result {}
    if {[catch {set result [check_info]} msg]} {
        debug_out stderr $::errorInfo
        error $msg
    }
    puts -nonewline $result
}

proc sdcdb_whereis {file} {
    foreach files {c_files a_files} {
        variable $files
        if {[info exists ${files}($file)]} {
            return "'$file' found in database (as '[set ${files}($file)]')"
        }
    }
    return "'$file' not found in database"
}

proc free {} {
    variable initialized
    if {!$initialized} {
        return
    }
    variable c_files
    foreach filename [array names c_files] {
        set arrayname c_[file rootname $filename]2addr
        variable $arrayname
        catch {unset $arrayname}
        set arrayname [file rootname $filename]_func2addr
        variable $arrayname
        catch {unset $arrayname}
    }
    variable a_files
    foreach filename [array names a_files] {
        set arrayname a_[file rootname $filename]2addr
        variable $arrayname
        catch {unset $arrayname}
    }
    catch {unset c_files}
    variable c_files_count
    catch {unset c_files_count}
    variable addr2file
    catch {unset addr2file}
    variable g_func2addr
    catch {unset g_func2addr}
    set initialized 0
}

proc h {address} {
    return [format %04X $address]
}

namespace export sdcdb

}

# Import sdcdb exported functions
namespace import sdcdb::*

set sdcdb::debug false