# $Id: tbench.tcl 510 2013-04-26 16:14:57Z mueller $
|
# $Id: tbench.tcl 510 2013-04-26 16:14:57Z mueller $
|
#
|
#
|
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
#
|
#
|
# This program is free software; you may redistribute and/or modify it under
|
# This program is free software; you may redistribute and/or modify it under
|
# the terms of the GNU General Public License as published by the Free
|
# the terms of the GNU General Public License as published by the Free
|
# Software Foundation, either version 2, or at your option any later version.
|
# Software Foundation, either version 2, or at your option any later version.
|
#
|
#
|
# This program is distributed in the hope that it will be useful, but
|
# This program is distributed in the hope that it will be useful, but
|
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
|
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
|
# for complete details.
|
# for complete details.
|
#
|
#
|
# Revision History:
|
# Revision History:
|
# Date Rev Version Comment
|
# Date Rev Version Comment
|
# 2013-04-26 510 1.0 Initial version (extracted from util.tcl)
|
# 2013-04-26 510 1.0 Initial version (extracted from util.tcl)
|
#
|
#
|
|
|
package provide rw11 1.0
|
package provide rw11 1.0
|
|
|
package require rlink
|
package require rlink
|
package require rwxxtpp
|
package require rwxxtpp
|
|
|
namespace eval rw11 {
|
namespace eval rw11 {
|
|
|
#
|
#
|
# tbench: driver for tbench scripts
|
# tbench: driver for tbench scripts
|
#
|
#
|
proc tbench {fname} {
|
proc tbench {fname} {
|
rlc exec -init 0xff [regbld rlink::INIT anena]
|
rlc exec -init 0xff [regbld rlink::INIT anena]
|
set errcnt [tbench_list $fname]
|
set errcnt [tbench_list $fname]
|
return $errcnt
|
return $errcnt
|
}
|
}
|
|
|
#
|
#
|
# tbench_file: execute list of tbench steps
|
# tbench_file: execute list of tbench steps
|
#
|
#
|
proc tbench_list {lname} {
|
proc tbench_list {lname} {
|
set errcnt 0
|
set errcnt 0
|
if {[string match "@*" $lname]} {
|
if {[string match "@*" $lname]} {
|
set fname [string range $lname 1 end]
|
set fname [string range $lname 1 end]
|
set fh [open "$::env(RETROBASE)/tools/tbench/$fname"]
|
set fh [open "$::env(RETROBASE)/tools/tbench/$fname"]
|
while {[gets $fh line] >= 0} {
|
while {[gets $fh line] >= 0} {
|
if {[string match "#*" $line]} {
|
if {[string match "#*" $line]} {
|
if {[string match "##*" $line]} { puts $line }
|
if {[string match "##*" $line]} { puts $line }
|
} elseif {[string match "@*" $line]} {
|
} elseif {[string match "@*" $line]} {
|
incr errcnt [tbench_list $line]
|
incr errcnt [tbench_list $line]
|
} else {
|
} else {
|
incr errcnt [tbench_step $line]
|
incr errcnt [tbench_step $line]
|
}
|
}
|
}
|
}
|
close $fh
|
close $fh
|
} else {
|
} else {
|
incr errcnt [tbench_step $lname]
|
incr errcnt [tbench_step $lname]
|
}
|
}
|
puts [format "%s: %s" $lname [rutil::errcnt2txt $errcnt]]
|
puts [format "%s: %s" $lname [rutil::errcnt2txt $errcnt]]
|
return $errcnt
|
return $errcnt
|
}
|
}
|
|
|
#
|
#
|
# tbench_step: execute single tbench step
|
# tbench_step: execute single tbench step
|
#
|
#
|
proc tbench_step {fname} {
|
proc tbench_step {fname} {
|
rlc errcnt -clear
|
rlc errcnt -clear
|
set cpu cpu0
|
set cpu cpu0
|
source "$::env(RETROBASE)/tools/tbench/$fname"
|
source "$::env(RETROBASE)/tools/tbench/$fname"
|
set errcnt [rlc errcnt]
|
set errcnt [rlc errcnt]
|
puts [format "%s: %s" $fname [rutil::errcnt2txt $errcnt]]
|
puts [format "%s: %s" $fname [rutil::errcnt2txt $errcnt]]
|
return $errcnt
|
return $errcnt
|
}
|
}
|
|
|
}
|
}
|
|
|
