sid/component/testsuite/sidcomp.mapper/busif.exp

   1
   2 proc build-config { file target } {
   3     set f [open $file "w"]
   4     puts $f "load [sid_find_file libtclapi.la] tcl_bridge_library"
   5     puts $f "load [sid_find_file libmapper.la] mapper_component_library"
   6     puts $f "load [sid_find_file lib${target}.la] ${target}_component_library"
   7     puts $f "new bridge-tcl tester"
   8     puts $f "new hw-mapper-basic mapper"
   9     puts $f "new ${target}-big-1 big-1-bus"
  10     puts $f "new ${target}-big-2 big-2-bus"
  11     puts $f "new ${target}-big-4 big-4-bus"
  12     puts $f "new ${target}-big-8 big-8-bus"
  13     puts $f "set tester load! [sid_find_file tester.tcl]"
  14     puts $f "set tester hexify? yes-please-and-thanks"
  15     puts $f "relate tester victim mapper"
  16     puts $f "connect-pin main perform-activity -> tester command-io!"
  17     puts $f "connect-pin main perform-activity -> tester !event"
  18     puts $f "connect-bus mapper \[0x80000-0x800ff,4,1\] big-1-bus bus"
  19     puts $f "connect-bus mapper \[0x80100-0x801ff,8,2\] big-2-bus bus"
  20     puts $f "connect-bus mapper \[0x80200-0x802ff\] big-4-bus bus"
  21     puts $f "connect-bus mapper \[0x80300-0x803ff\] big-8-bus bus"
  22     verbose "Created sid configuration file $file"
  23     close $f
  24 }
  25
  26 proc sid_read_write { cmd } {
  27     global spawn_id
  28     global expect_out
  29     global test
  30
  31     if [catch { exp_pid }] then {
  32         unresolved "$test - spawned sid process already gone"
  33         return
  34     }
  35
  36     # wait for prompt
  37     global timeout
  38     set last_timeout $timeout
  39     set timeout 3
  40     set ok 1
  41     expect {
  42         timeout { unresolved "$test - timeout before [prettyprint $cmd]"; set ok 0 }
  43         eof { unresolved "$test - eof before [prettyprint $cmd]"; set ok 0 }
  44         "command>"
  45     }
  46     set timeout $last_timeout
  47     if {! $ok} then { return "" }
  48
  49     # encode string
  50     binary scan $cmd H* encoded
  51
  52     set iterations [expr [string length $encoded] / 64]
  53     for {set i 0} {$i < $iterations} {incr i} {
  54         set first [expr $i * 64]
  55         set last [expr $first + 63]
  56         send "[string range $encoded $first $last]+\n"
  57     }
  58     set first [expr $i * 64]
  59     set read_write ""
  60     send "[string range $encoded $first end]\n"
  61
  62     expect {
  63         timeout { fail "$test - timeout after [prettyprint $cmd]" ; return "" }
  64         eof { fail "$test - eof after [prettyprint $cmd]"; return "" }
  65         -re "(ERROR:\[^\n\]*)" {
  66             fail "$test - [prettyprint $expect_out(1,string)] after [prettyprint $cmd]"
  67             return ""
  68         }
  69         -re "write>>(.*)<<write.*result>>(\[0-9a-f\]*)<<result" {
  70            set read_write $expect_out(1,string)
  71            set result $expect_out(2,string)
  72         }
  73         -re "read>>(.*)<<read.*result>>(\[0-9a-f\]*)<<result" {
  74            set read_write $expect_out(1,string)
  75            set result $expect_out(2,string)
  76         }
  77         -re "result>>(\[0-9a-f\]*)<<result" {
  78             set result $expect_out(1,string)
  79         }
  80         -re "split>>(\[0-9a-f\]*)<<split" {
  81             set result $expect_out(1,string)
  82             while {1} {
  83                 expect {
  84                     timeout { fail "$test - timeout3" ; return "" }
  85                     eof { fail "$test - eof3" ; return "" }
  86                     -re "split>>(\[0-9a-f\]*)<<split" {
  87                         append result $expect_out(1,string)
  88                     }
  89                     -re "split-end" { break }
  90                 }
  91             }
  92         }
  93     }
  94     # undo encoding in tester.tcl
  95     set decoded [binary format H* $result]
  96     verbose "result $decoded"
  97     if { [string match "*ok*" $decoded] == 0 } then {
  98         fail "$test - bus failure: $decoded"
  99         return ""
 100     }
 101
 102     verbose "read_write $read_write" 3
 103     return [append read_write " " $decoded]
 104 }
 105
 106 global test
 107 global bus
 108
 109 proc write_test { result laddr mask } {
 110     global test
 111
 112     # already noted as failure
 113     if { $result == "" } then { return }
 114
 115     if { [lindex $result 1] == $laddr } then {
 116         pass "$test - laddr check"
 117     } else {
 118         fail "$test - address [lindex $result 1] != $laddr"
 119     }
 120     if { [lindex $result 3] == $mask } then {
 121         pass "$test - mask check"
 122     } else {
 123         fail "$test - mask [lindex $result 3] != $mask"
 124     }
 125 }
 126
 127 proc read_test { result laddr mask val } {
 128     global test
 129
 130     # already noted as failure
 131     if { $result == "" } then { return }
 132
 133     if { [lindex $result 1] == $laddr } then {
 134         pass "$test - laddr check"
 135     } else {
 136         fail "$test - address [lindex $result 1] != $laddr"
 137     }
 138     if { [lindex $result 3] == $mask } then {
 139         pass "$test - mask check"
 140     } else {
 141         fail "$test - mask [lindex $result 3] != $mask"
 142     }
 143
 144     set num [lindex $result 7]
 145     if { $num == $val } then {
 146         pass "$test - val check"
 147     } else {
 148         verbose "read_test: $result"
 149         # possibly different formats, like hex?
 150         if { [ string match "*0x*" $num ] == 0 } then {
 151             set num [format "0x%x" $num]
 152             verbose "formatted num $num"
 153         }
 154         if { $num == $val } then {
 155             pass "$test - val check"
 156         } else {
 157             fail "$test - value $num != $val"
 158         }
 159     }
 160 }
 161
 162 set test "building conf file"
 163 build-config "busif.conf" "busif"
 164
 165 set test "sid startup"
 166 if {[sid_start "busif.conf"]} { pass $test } else { fail $test; return }
 167
 168 set test "acquire mapper bus handle"
 169 set bus [sid_cmd "sid::component::find_bus $victim access-port"]
 170 if { $bus != "" } { pass $test } else { fail $test }
 171
 172 set test "byte write to byte device - stride 4"
 173 set result [sid_read_write "sid::bus::write_h4_b1 $bus 0x80000 1"]
 174 write_test $result 0 0x0ff
 175
 176 set test "byte read from byte device - stride 4"
 177 set result [sid_read_write "sid::bus::read_h4_b1 $bus 0x80000"]
 178 read_test $result 0 0x0ff 1
 179
 180 set test "short write to byte device - stride 4"
 181 set result [sid_read_write "sid::bus::write_h4_b2 $bus 0x80004 0x0200"]
 182 write_test $result 1 0x0ff
 183
 184 set test "short read from byte device - stride 4"
 185 set result [sid_read_write "sid::bus::read_h4_b2 $bus 0x80004"]
 186 read_test $result 1 0x0ff 0x0200
 187
 188 set test "word write to byte device - stride 4"
 189 set result [sid_read_write "sid::bus::write_h4_b4 $bus 0x80008 0x03000000"]
 190 write_test $result 2 0x0ff
 191
 192 set test "word read from byte device - stride 4"
 193 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80008"]
 194 read_test $result 2 0x0ff 0x03000000
 195
 196 # The following operations would evoke a bus::misaligned, since the
 197 # accesses span two stride units.
 198
 199 #set test "long write to byte device - stride 4"
 200 #set result [sid_read_write "sid::bus::write_h4_b8 $bus 0x80010 0x400000005"]
 201 #write_test $result 4 0x0ff
 202
 203 #set test "long read from byte device - stride 4"
 204 #set result [sid_read_write "sid::bus::read_h4_b8 $bus 0x80010"]
 205 # read_test $result 4 0x0ff 4
 206
 207 set test "short write to short device - stride 8"
 208 set result [sid_read_write "sid::bus::write_h4_b2 $bus 0x80100 0x0102"]
 209 write_test $result 0 0x0ffff
 210
 211 set test "short read from short device - stride 8"
 212 set result [sid_read_write "sid::bus::read_h4_b2 $bus 0x80100"]
 213 read_test $result 0 0x0ffff 0x0102
 214
 215 set test "word write to short device - stride 8"
 216 set result [sid_read_write "sid::bus::write_h4_b4 $bus 0x80108 0x03040000"]
 217 write_test $result 2 0x0ffff
 218
 219 set test "word read from short device - stride 8"
 220 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80108"]
 221 read_test $result 2 0x0ffff 0x03040000
 222
 223 set test "long write to short device - stride 8"
 224 set result [sid_read_write "sid::bus::write_h4_b8 $bus 0x80110 0x0506000000000000"]
 225 write_test $result 4 0x0ffff
 226
 227 set test "long read from short device - stride 8"
 228 set result [sid_read_write "sid::bus::read_h4_b8 $bus 0x80110"]
 229 # read_test $result 4 0x0ffff 0x0506
 230
 231 for {set i 0} {$i < 4} {incr i} {
 232     set test "byte write to word device, offset $i"
 233     set result [sid_read_write "sid::bus::write_h4_b1 $bus [expr 0x80200 + $i] [expr 1 + $i]"]
 234     set mask [format "0x%08x" [expr 0x0ff << (24 - ($i*8))]]
 235     write_test $result 0 $mask
 236 }
 237
 238 for {set i 0} {$i < 4} {incr i} {
 239     set test "byte read from word device, offset $i"
 240     set result [sid_read_write "sid::bus::read_h4_b1 $bus [expr 0x80200 + $i]"]
 241     set mask [format "0x%08x" [expr 0x0ff << (24 - ($i*8))]]
 242     read_test $result 0 $mask [expr 1 + $i]
 243 }
 244
 245 set test "short write to word device"
 246 set result [sid_read_write "sid::bus::write_h4_b2 $bus 0x80204 0x0506"]
 247 write_test $result 4 0xffff0000
 248
 249 set test "short write to word device, offset 2"
 250 set result [sid_read_write "sid::bus::write_h4_b2 $bus 0x80206 0x0708"]
 251 write_test $result 4 0x0ffff
 252
 253 set test "short read from word device"
 254 set result [sid_read_write "sid::bus::read_h4_b2 $bus 0x80204"]
 255 read_test $result 4 0xffff0000 0x0506
 256
 257 set test "short read from word device, offset 2"
 258 set result [sid_read_write "sid::bus::read_h4_b2 $bus 0x80206"]
 259 read_test $result 4 0x0ffff 0x0708
 260
 261 set test "word write to word device"
 262 set result [sid_read_write "sid::bus::write_h4_b4 $bus 0x80208 0x090a0b0c"]
 263 write_test $result 8 0xffffffff
 264
 265 set test "word read from word device"
 266 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80208"]
 267 read_test $result 8 0xffffffff 0x090a0b0c
 268
 269 set test "long write to word device"
 270 set result [sid_read_write "sid::bus::write_h4_b8 $bus 0x80210 0x1112131415161718"]
 271 write_test $result 16 0xffffffff
 272
 273 set test "long read from word device"
 274 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80210"]
 275 # read_test $result 16 0xffffffff 0x11121314
 276
 277 for {set i 0} {$i < 8} {incr i} {
 278     set test "byte write to long device, offset $i"
 279     set result [sid_read_write "sid::bus::write_h4_b1 $bus [expr 0x80300 + $i] [expr 1 + $i]"]
 280     # I don't know how to get expr to handle 64-bit numbers :-(
 281     if { $i < 4 } then {
 282         set mask [format "0x%08x00000000" [expr 0x0ff << (24 - ($i*8))]]
 283     } else {
 284         set mask [format "0x00000000%08x" [expr 0x0ff << (24 - (($i-4)*8))]]
 285     }
 286     write_test $result 0 $mask
 287 }
 288
 289 for {set i 0} {$i < 8} {incr i} {
 290     set test "byte read from long device, offset $i"
 291     set result [sid_read_write "sid::bus::read_h4_b1 $bus [expr 0x80300 + $i]"]
 292     # I don't know how to get expr to handle 64-bit numbers :-(
 293     if { $i < 4 } then {
 294         set mask [format "0x%08x00000000" [expr 0x0ff << (24 - ($i*8))]]
 295     } else {
 296         set mask [format "0x00000000%08x" [expr 0x0ff << (24 - (($i-4)*8))]]
 297     }
 298     read_test $result 0 $mask [expr $i + 1]
 299 }
 300
 301 for {set i 0} {$i < 7} {incr i} {
 302     set test "short write to long device, offset $i"
 303     set result [sid_read_write "sid::bus::write_h4_b2 $bus [expr 0x80308 + $i] [expr ((9 + $i) << 8) | (10 + $i)]"]
 304     # I don't know how to get expr to handle 64-bit numbers :-(
 305     if { $i < 3 } then {
 306         set mask [format "0x%08x00000000" [expr 0x0ffff << (16 - ($i*8))]]
 307     } elseif { $i > 5 } {
 308         set mask [format "0x00000000%08x" [expr 0x0ffff << (16 - (($i-4)*8))]]
 309     } else {
 310         continue
 311     }
 312     write_test $result 8 $mask
 313 }
 314
 315 for {set i 0} {$i < 7} {incr i} {
 316     set test "short read from long device, offset $i"
 317     set result [sid_read_write "sid::bus::read_h4_b2 $bus [expr 0x80308 + $i]"]
 318     # I don't know how to get expr to handle 64-bit numbers :-(
 319     if { $i < 3 } then {
 320         set mask [format "0x%08x00000000" [expr 0x0ffff << (16 - ($i*8))]]
 321     } elseif { $i > 5 } {
 322         set mask [format "0x00000000%08x" [expr 0x0ffff << (16 - (($i-4)*8))]]
 323     } else {
 324         continue
 325     }
 326     set val [format "0x%x" [expr ((9 + $i) << 8) | (10 + $i)]]
 327     read_test $result 8 $mask $val
 328 }
 329
 330 set test "word write to long device"
 331 set result [sid_read_write "sid::bus::write_h4_b4 $bus 0x80310 0x11121314"]
 332 write_test $result 16 0xffffffff00000000
 333
 334 set test "word write to long device, offset 2"
 335 set result [sid_read_write "sid::bus::write_h4_b4 $bus 0x80312 0x13141516"]
 336 write_test $result 16 0x0000ffffffff0000
 337
 338 set test "word write to long device, offset 4"
 339 set result [sid_read_write "sid::bus::write_h4_b4 $bus 0x80314 0x15161718"]
 340 write_test $result 16 0x00000000ffffffff
 341
 342 set test "word read from long device"
 343 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80310"]
 344 read_test $result 16 0xffffffff00000000 0x11121314
 345
 346 set test "word read from long device, offset 2"
 347 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80312"]
 348 read_test $result 16 0x0000ffffffff0000 0x13141516
 349
 350 set test "word read from long device, offset 4"
 351 set result [sid_read_write "sid::bus::read_h4_b4 $bus 0x80314"]
 352 read_test $result 16 0x00000000ffffffff 0x15161718
 353
 354 set test "long write to long device"
 355 set val 0x191a1b1c1d1e1f20
 356 set result [sid_read_write "sid::bus::write_h4_b8 $bus 0x80318 $val"]
 357 write_test $result 0x18 0xffffffffffffffff
 358
 359 set test "long read from long device"
 360 set result [sid_read_write "sid::bus::read_h4_b8 $bus 0x80318"]
 361 # read_test $result 0x18 0xffffffffffffffff $val
 362
 363 set test "sid stop"
 364 if {[sid_stop]} { pass $test } else { fail $test; return }
 365
 366 # zap conf file if tests were successful
 367 global exit_status
 368 if {$exit_status == "0"} { file delete "busif.conf" }