riscv-asm/labels.tcl at main · jbroll/riscv-asm · GitHub

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
package require jbr::dict

set ::LINES {}
set ::LABEL { . 0 }
set ::labels {}               ; # Holds a dict of lists of resolve forward refs

proc setlabel { name value } {
    dict set ::LABEL $name [expr { $value }]
}
proc getlabel { name } {
    dict get $::LABEL $name
}
proc incrdot { n } {
    dict incr ::LABEL . $n
}
proc dot { { value {} } } {
    if { $value eq {} } {
        getlabel .
    } else {
        setlabel . $value
    }
}

# Catch unknown commands in the .rva file and treat them as labels if they end in ':'
#
rename ::unknown ::_unknown
proc ::unknown { args } {
    switch -regex -- [lindex $args 0] {
        {[0-9a-zA-Z_]+:} {
            : [string range [lindex $args 0] 0 end-1] {*}[lrange $args 1 end]
        }
        default {
            ::_unknown {*}$args
        }
    }
}

# Introduce a label in the .rva file
#
proc : { name args } {
    set dot [dot]
    setlabel $name $dot

    # The list of forward refs to this label has a dict with the
    # address and immediate type of each ref.  Read the word at
    # the address, evaluate the immediate bits with the now known
    # value of the label and store it back to address
    #
    foreach label [dict get? $::labels $name] {
        dict with label {
            set word [ld_uword $addr]
            set before $word
            set word [expr { $word | [::tcl::mathfunc::$type [expr { $dot - $addr }]] }]
            if { $word & 0x03 } {
                st_word $addr $word
            } else {
                st_half $addr $word
            }
        }
    }
    dict unset ::labels $name

    if { [llength $args] } {
        {*}$args
    }
}

namespace eval ::tcl::mathfunc {

    proc match_label { value } {
        switch -regex -- $value {
            {.*[a-zA-z].*} {
                if { [dict exists $::LABEL $value] } {
                    return [getlabel $value]
                }

                return 0x7FFFFF
            }
        }
        return $value
    }

    # Look up a label while generating an immediate value
    #
    proc label { value type } {
        set dot [dot]

        switch -regex -- $value {
            {[0-9]+b} {                     # A back ref must be know now.

                set value [string range $value 0 end-1]
                if { ![dict exists $::LABEL $value] } {
                    error "unkown back label ref for $value"
                }
            }
            {[0-9]+f} {                     # A forward ref is added to the labels lists and returns 0

                set value [string range $value 0 end-1]
                dict lappend ::labels $value [dict create addr $dot type $type]
                return 0
            }
            {[a-zA-Z_][a-zA-Z_0-9]*} {      #  A normal label might exist of might be a forward ref.
                if { [dict exists $::LABEL $value] } {
                    return [expr { [dict get $::LABEL $value] - $dot }]
                } else {
                    dict lappend ::labels $value [dict create addr $dot type $type]
                    return 0
                }
            }
        }
        return $value
    }
}