chiark
/
gitweb
/
~ijackson
/
trains.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
6c3c435
)
more wip speed measurement
branch-hostside-wip-2006-05-06
author
ian
<ian>
Fri, 25 Jan 2008 20:17:25 +0000
(20:17 +0000)
committer
ian
<ian>
Fri, 25 Jan 2008 20:17:25 +0000
(20:17 +0000)
hostside/measure-speeds
patch
|
blob
|
history
diff --git
a/hostside/measure-speeds
b/hostside/measure-speeds
index 682e888049014c1850a95291097019d05ae9a6bc..cf3b43448b3411d5cce1ce4f8d0bf1ac8d385b75 100755
(executable)
--- a/
hostside/measure-speeds
+++ b/
hostside/measure-speeds
@@
-6,7
+6,6
@@
load chiark_tcl_hbytes-1.so
load chiark_tcl_hbytes-1.so
-
proc debug_r {m} { puts -nonewline stderr "$m\r" }
proc debug {m} { puts stderr $m }
proc debug_r {m} { puts -nonewline stderr "$m\r" }
proc debug {m} { puts stderr $m }
@@
-16,7
+15,7
@@
proc send-now {str} {
}
proc startup {} {
}
proc startup {} {
- global port rwy buf last_fast_speed noise
+ global port rwy buf last_fast_speed noise
funcs_msgs loco
set rwy [open $port r+]
fconfigure $rwy -blocking no -buffering none -encoding binary \
-translation binary
set rwy [open $port r+]
fconfigure $rwy -blocking no -buffering none -encoding binary \
-translation binary
@@
-29,6
+28,12
@@
proc startup {} {
set last_fast_speed 0
set noise {}
for {set i 0} {$i < 256} {incr i} { append noise \\x [hbytes random 1] }
set last_fast_speed 0
set noise {}
for {set i 0} {$i < 256} {incr i} { append noise \\x [hbytes random 1] }
+ foreach f {funcs0to4 funcs5to8} {
+ set m [exec ./hostside-old -s/dev/stdout $f $loco 0x1fff]
+ set m [hbytes raw2h $m]
+ lappend funcs_msgs ffff$m {}
+ }
+ lappend funcs_msgs {}
}
proc readable {} {
}
proc readable {} {
@@
-130,8
+135,11
@@
proc bgerror {m} {
}
proc xmit-now {} {
}
proc xmit-now {} {
- global xmit_after xmit_msg
- send-now $xmit_msg
+ global xmit_after xmit_msg funcs_msgs
+ set funcs_msg [lindex $funcs_msgs 0]
+ set funcs_msgs [lreplace $funcs_msgs 0 0]
+ lappend funcs_msgs $funcs_msg
+ send-now $xmit_msg$funcs_msg
set xmit_after [after 10 xmit-now]
}
proc xmit {nmral} {
set xmit_after [after 10 xmit-now]
}
proc xmit {nmral} {
@@
-147,7
+155,8
@@
proc now-ms {} {
clock clicks -milliseconds
}
clock clicks -milliseconds
}
-proc now-ms-click {} {
+proc now-ms-click {{returnthis {}}} {
+ if {[string length $returnthis]} { return $returnthis }
global noise
set now [now-ms]
set f [open |[list sh -c {"$@" >/dev/dsp} x printf $noise]]
global noise
set now [now-ms]
set f [open |[list sh -c {"$@" >/dev/dsp} x printf $noise]]
@@
-155,18
+164,18
@@
proc now-ms-click {} {
return $now
}
return $now
}
-proc record-mm-per-s {speed mm ms} {
- debug "
S
$speed: $mm / $ms"
+proc record-mm-per-s {
how
speed mm ms} {
+ debug "
$how
$speed: $mm / $ms"
set mmpers [expr {$mm*1.0/$ms}]
set mmpers [expr {$mm*1.0/$ms}]
- puts [format "%
3d %g"
$speed $mmpers]
+ puts [format "%
s %3d %g" $how
$speed $mmpers]
}
}
-proc timing-start {} {
+proc timing-start {
{now {}}
} {
global start
global start
- set start [now-ms-click]
+ set start [now-ms-click
$now
]
}
}
-proc timing-finish {} {
+proc timing-finish {
{now {}}
} {
global start
global start
- set finish [now-ms-click]
+ set finish [now-ms-click
$now
]
return [expr {$finish-$start}]
}
return [expr {$finish-$start}]
}
@@
-188,7
+197,7
@@
proc slow-speed-test {speed} {
run-until $speed 9804
timing-start
run-until $speed 980a
run-until $speed 9804
timing-start
run-until $speed 980a
- record-mm-per-s $speed 231 [timing-finish]
+ record-mm-per-s
S
$speed 231 [timing-finish]
instruct-stop-for 100
}
instruct-stop-for 100
}
@@
-210,16
+219,26
@@
proc fast-speed-test {speed} {
}
set last_fast_speed $speed
set ms 0; set mm 0
}
set last_fast_speed $speed
set ms 0; set mm 0
+ set mslaps 0; set mmlaps 0
while {$ms < 2000} {
run-until $speed 9804
while {$ms < 2000} {
run-until $speed 9804
- timing-start
+ set now [now-ms-click]
+ if {$ms} {
+ incr mslaps [timing-finish $now]
+ incr mmlaps 3624
+ debug "++ $mmlaps / $mslaps"
+ }
+ timing-start $now
+
run-until $speed 980a
run-until $speed 980a
+
incr ms [timing-finish]
incr mm 231
incr ms [timing-finish]
incr mm 231
- debug "+ $mm / $ms"
+ debug "+
-
$mm / $ms"
run-until-not $speed 980a 600
}
run-until-not $speed 980a 600
}
- record-mm-per-s $speed $mm $ms
+ record-mm-per-s F $speed $mm $ms
+ if {$mslaps} { record-mm-per-s L $speed $mmlaps $mslaps }
}
proc speed-test {speed} {
}
proc speed-test {speed} {