sid/component/tcl/sid-api-trace.tcl

   1 # Copyright (C) 2000 Red Hat
   2 #
   3 # This is a component that forwards almost all sid requests to another
   4 # component.  Further, it interjects proxy pin/bus objects between the
   5 # outside world and the victim.  All traffic may be traced.
   6
   7 global this
   8 set this [sid::component::this]
   9
  10 # A handle to my victim component
  11 global victim
  12 set victim ""
  13
  14 # trace calls?
  15 global victim_trace_p
  16 set victim_trace_p 1
  17
  18 # map proxy-pin<->real-pin
  19 global proxy2real_pin_map
  20 global real2proxy_pin_map
  21
  22 proc real2proxy_pin {pin} {
  23     global proxy2real_pin_map
  24     global real2proxy_pin_map
  25     if [info exists real2proxy_pin_map($pin)] then {
  26         set pin $real2proxy_pin_map($pin)
  27     } else {
  28         set proxy [sid::pin::new]
  29         set proxy2real_pin_map($proxy) $pin
  30         set real2proxy_pin_map($pin) $proxy
  31         set pin $proxy
  32     }
  33     return $pin
  34 }
  35
  36 proc proxy2real_pin {pin} {
  37     global proxy2real_pin_map
  38     if [info exists proxy2real_pin_map($pin)] then {
  39         set pin $proxy2real_pin_map($pin)
  40     } else {
  41         error "Unknown proxy pin $pin"
  42     }
  43     return $pin
  44 }
  45
  46 # map proxy-bus<->real-bus
  47 global proxy2real_bus_map
  48 global real2proxy_bus_map
  49
  50 proc real2proxy_bus {bus} {
  51     global proxy2real_bus_map
  52     global real2proxy_bus_map
  53     if [info exists real2proxy_bus_map($bus)] then {
  54         set bus $real2proxy_bus_map($bus)
  55     } else {
  56         set proxy [sid::bus::new]
  57         set proxy2real_bus_map($proxy) $bus
  58         set real2proxy_bus_map($bus) $proxy
  59         set bus $proxy
  60     }
  61     return $bus
  62 }
  63
  64 proc proxy2real_bus {bus} {
  65     global proxy2real_bus_map
  66     if [info exists proxy2real_bus_map($bus)] then {
  67         set bus $proxy2real_bus_map($bus)
  68     } else {
  69         error "Unknown proxy bus $bus"
  70     }
  71     return $bus
  72 }
  73
  74 proc sidtrace {cmd} {
  75     global victim_trace_p
  76     if {$victim_trace_p != "0"} then {
  77         puts -nonewline "$cmd >"
  78     }
  79     set result [uplevel 1 $cmd]
  80     if {$victim_trace_p != "0"} then {
  81         puts "> $result"
  82     }
  83     return $result
  84 }
  85
  86 proc attribute_names {} {
  87     global victim
  88     return [sidtrace [list sid::component::attribute_names $victim]]
  89 }
  90
  91 proc attribute_names_in_category {cat} {
  92     global victim
  93     # special hack to prevent error message during component instantiation
  94     if {$victim == ""} then { return [list] }
  95     # don't add "victim-trace?" - that would make wrapper more translucent
  96     return [sidtrace [list sid::component::attribute_names_in_category $victim $cat]]
  97 }
  98
  99 proc attribute_value {attr} {
 100     global victim
 101     return [sidtrace [list sid::component::attribute_value $victim $attr]]
 102 }
 103
 104 proc set_attribute_value {attr value} {
 105     global victim
 106     if {$attr == "victim-trace?"} then {
 107         global victim_trace_p
 108         set victim_trace_p $value
 109         return "ok"
 110     } else {
 111         return [sidtrace [list sid::component::set_attribute_value $victim $attr $value]]
 112     }
 113 }
 114
 115 proc pin_names {} {
 116     global victim
 117     return [sidtrace [list sid::component::pin_names $victim]]
 118 }
 119
 120 proc find_pin {name} {
 121     global victim
 122     set pin [sidtrace [list sid::component::find_pin $victim $name]]
 123     if {$pin == ""} then { return "" } else { return [real2proxy_pin $pin] }
 124 }
 125
 126 proc connect_pin {name pin} {
 127     global victim
 128     set proxy [real2proxy_pin $pin]
 129     return [sidtrace [list sid::component::connect_pin $victim $name $proxy]]
 130 }
 131
 132 proc disconnect_pin {name pin} {
 133     global victim
 134     set proxy [real2proxy_pin $pin]
 135     return [sidtrace [list sid::component::disconnect_pin $victim $name $proxy]]
 136 }
 137
 138 proc connected_pins {name} {
 139     global victim
 140     set victimpins [sidtrace [list sid::component::connected_pins $victim $name]]
 141     set realpins [list]
 142     foreach pin $victimpins {
 143         lappend realpins [proxy2real_pin $pin]
 144     }
 145     return $realpins
 146 }
 147
 148 proc bus_names {} {
 149     global victim
 150     return [sidtrace [list sid::component::bus_names $victim]]
 151 }
 152
 153 proc find_bus {name} {
 154     global victim
 155     set bus [sidtrace [list sid::component::find_bus $victim $name]]
 156     if {$bus == ""} then { return "" } else { return [real2proxy_bus $bus] }
 157 }
 158
 159 proc accessor_names {} {
 160     global victim
 161     return [sidtrace [list sid::component::accessor_names $victim]]
 162 }
 163
 164 proc connect_accessor {name bus} {
 165     global victim
 166     set proxy [real2proxy_bus $bus]
 167     return [sidtrace [list sid::component::connect_accessor $victim $name $proxy]]
 168 }
 169
 170 proc disconnect_accessor {name bus} {
 171     global victim
 172     set proxy [real2proxy_bus $bus]
 173     return [sidtrace [list sid::component::disconnect_accessor $victim $name $proxy]]
 174 }
 175
 176 proc connected_bus {name} {
 177     global victim
 178     set bus [sidtrace [list sid::component::connected_bus $victim $name]]
 179     if {$bus == ""} then { return "" } else { return [real2proxy_bus $bus] }
 180 }
 181
 182 proc relationship_names {} {
 183     global victim
 184     # don't add "victim" - that would make wrapper more translucent
 185     return [sidtrace [list sid::component::relationship_names $victim]]
 186 }
 187
 188 proc relate {rel comp} {
 189     global victim
 190     if {$rel == "victim"} then {
 191         set victim $comp
 192         return "ok"
 193     } else {
 194         return [sidtrace [list sid::component::relate $victim $rel $comp]]
 195     }
 196 }
 197
 198 proc unrelate {rel comp} {
 199     global victim
 200     if {$rel == "victim"} then {
 201         set victim ""
 202         return "ok"
 203     } else {
 204         return [sidtrace [list sid::component::unrelate $victim $rel $comp]]
 205     }
 206 }
 207
 208
 209 proc related_components {rel} {
 210     global victim
 211     if {$rel == "victim"} then {
 212         return $victim
 213     } else {
 214         return [sidtrace [list sid::component::related_components $victim $rel]]
 215     }
 216 }
 217
 218
 219 # proxy pin functions
 220 proc driven_h4 {proxy value} {
 221     set pin [proxy2real_pin $proxy]
 222     return [sidtrace [list sid::pin::driven_h4 $pin $value]]
 223 }
 224
 225
 226 # proxy bus functions
 227
 228 proc write_h4_l1 {proxy addr data} {
 229     set bus [proxy2real_bus $proxy]
 230     return [sidtrace [list sid::bus::write_h4_l1 $bus $addr $data]]
 231 }
 232 proc write_h4_l2 {proxy addr data} {
 233     set bus [proxy2real_bus $proxy]
 234     return [sidtrace [list sid::bus::write_h4_l2 $bus $addr $data]]
 235 }
 236 proc write_h4_l4 {proxy addr data} {
 237     set bus [proxy2real_bus $proxy]
 238     return [sidtrace [list sid::bus::write_h4_l4 $bus $addr $data]]
 239 }
 240 proc write_h4_l8 {proxy addr data} {
 241     set bus [proxy2real_bus $proxy]
 242     return [sidtrace [list sid::bus::write_h4_l8 $bus $addr $data]]
 243 }
 244 proc read_h4_l1 {proxy addr} {
 245     set bus [proxy2real_bus $proxy]
 246     return [sidtrace [list sid::bus::read_h4_l1 $bus $addr]]
 247 }
 248 proc read_h4_l2 {proxy addr} {
 249     set bus [proxy2real_bus $proxy]
 250     return [sidtrace [list sid::bus::read_h4_l2 $bus $addr]]
 251 }
 252 proc read_h4_l4 {proxy addr} {
 253     set bus [proxy2real_bus $proxy]
 254     return [sidtrace [list sid::bus::read_h4_l4 $bus $addr]]
 255 }
 256 proc read_h4_l8 {proxy addr} {
 257     set bus [proxy2real_bus $proxy]
 258     return [sidtrace [list sid::bus::read_h4_l8 $bus $addr]]
 259 }
 260
 261
 262 proc write_h4_b1 {proxy addr data} {
 263     set bus [proxy2real_bus $proxy]
 264     return [sidtrace [list sid::bus::write_h4_b1 $bus $addr $data]]
 265 }
 266 proc write_h4_b2 {proxy addr data} {
 267     set bus [proxy2real_bus $proxy]
 268     return [sidtrace [list sid::bus::write_h4_b2 $bus $addr $data]]
 269 }
 270 proc write_h4_b4 {proxy addr data} {
 271     set bus [proxy2real_bus $proxy]
 272     return [sidtrace [list sid::bus::write_h4_b4 $bus $addr $data]]
 273 }
 274 proc write_h4_b8 {proxy addr data} {
 275     set bus [proxy2real_bus $proxy]
 276     return [sidtrace [list sid::bus::write_h4_b8 $bus $addr $data]]
 277 }
 278 proc read_h4_b1 {proxy addr} {
 279     set bus [proxy2real_bus $proxy]
 280     return [sidtrace [list sid::bus::read_h4_b1 $bus $addr]]
 281 }
 282 proc read_h4_b2 {proxy addr} {
 283     set bus [proxy2real_bus $proxy]
 284     return [sidtrace [list sid::bus::read_h4_b2 $bus $addr]]
 285 }
 286 proc read_h4_b4 {proxy addr} {
 287     set bus [proxy2real_bus $proxy]
 288     return [sidtrace [list sid::bus::read_h4_b4 $bus $addr]]
 289 }
 290 proc read_h4_b8 {proxy addr} {
 291     set bus [proxy2real_bus $proxy]
 292     return [sidtrace [list sid::bus::read_h4_b8 $bus $addr]]
 293 }