From e4677de2d865acca6c1c9da35577075aa6a70d52 Mon Sep 17 00:00:00 2001 From: ian Date: Sat, 31 Dec 2005 17:55:55 +0000 Subject: [PATCH] before copy with shorting crossover --- hostside/stopgap-controller | 159 +++++++++++++++++++++--------------- 1 file changed, 95 insertions(+), 64 deletions(-) diff --git a/hostside/stopgap-controller b/hostside/stopgap-controller index fe475d8..e6e5eb6 100755 --- a/hostside/stopgap-controller +++ b/hostside/stopgap-controller @@ -1,6 +1,7 @@ -#!/usr/bin/tclsh8.4 +#!/usr/bin/tclsh8.2 -set testonly 1 +set testonly 0 +#set testonly 1 set port /dev/ttya0 set ch(funcsevery) 10 @@ -9,13 +10,18 @@ set ch(scale) 1 set ch(minint) 5000 # unset always +set always 0 +set nmrawhich 0 -set m xx -set segs xx set polarity 908000 +set pname l +set m {} +set segs {xx yy} +set segsasgot {xx yy} set pq {} ;# unset: cdu charged and waiting -set speeddirn {} -set funcs {} +set speeddirn ff7f +set speeddirn_fixed {speed126 2 60 0} +set funcs ff7f # unset pointpos($point) # unset segdetect($seg) ;# unset: shown D0; {}: shown D1; or: after id, D1->0 @@ -29,7 +35,7 @@ proc gui_init {} { gui "M A5 0 J" gui "M A6 0 J" if {[info exists watchdog]} { gui "P 1" } - if {![regexp {^90} $polarity]} { gui_polarity } + gui_polarity 0x$polarity foreach seg [array names segdetect] { gui "D1 $seg" } @@ -74,39 +80,32 @@ proc fail {m} { global watchdog p catch { after cancel $watchdog; unset watchdog } puts "failing $m" - tellpic a001 ;# 16ms + tellpic 9801 ;# 16ms after 2000 fail_now fileevent $p readable {} } -proc gui_polarity {} { - foreach seg { - X8 - X9 - X10 - X1 - X2 - X3 - X4 - X5 - X6 - X7 - } { +proc gui_polarity {diff} { + set l {} + if {$diff & 0x06} { lappend l X10 X9 } + if {$diff & 0x09} { lappend l X8 X1 X2 X3 X4 X5 X6 X7 } + foreach seg $l { gui "R $seg" } } -proc polarity {m} { - global polarity +proc polarity {newpname m} { + global pname polarity debug "polarising $m" + if {![string compare $m $polarity]} return tellpic $m - if {[string compare $m $polarity]} { - gui_polarity - } + set pname $newpname + gui_polarity [expr "0x$m ^ 0x$polarity"] set polarity $m } -proc polarity_l {} { polarity 908000 } -proc polarity_x {} { polarity 97ff7f } +proc polarity_l {} { polarity l 908000 } +proc polarity_p {} { polarity p 97ff79 } +proc polarity_x {} { polarity x 97ff7f } proc pt_now {how point pos xtra} { set msg a0[lindex $point $pos] @@ -147,7 +146,7 @@ proc randbyte {} { return $x } -proc pt_maybe {point} { +proc pt_maybe {point oneisright} { global always if {[info exists always]} { set pos $always @@ -213,35 +212,55 @@ proc pm_maydetect {d seg} { } proc pm_detect {seg} { - global segs - switch -exact $seg { - 07 - 06 { polarity_l } - 16 - 1c - 1a - 10 - 03 - 05 - 08 - 0b { polarity_x } + global segs pname segsasgot + if {[string compare $seg [lindex $segsasgot 1]]} { + set segsasgot [list [lindex $segsasgot 1] $seg] + } + if {[lsearch -exact $segs $seg] < 0} { + set segs $segsasgot + } + debug "pm_detect $seg ($segsasgot) ($segs) $pname$seg" + switch -exact $pname$seg { + p07 - p06 { polarity_l } + p02 - p09 { polarity_x } + l16 - l1c - l10 - l1a { polarity_p } + l03 - l05 - l08 - l0b { polarity_x } + x07 - x06 { polarity_l } + x14 - x16 - x1c - x20 - x1c - x10 { polarity_p } } switch -exact $seg { - 14 - 20 { pt_must "02 03 A5" 1; pt_must "42 43 A6" 1 } 04 - 0a { pt_must "00 01 X7" 1; pt_must "40 41 X8" 1 } 03 - 05 { pt_must "00 01 X7" 0 } 08 - 0b { pt_must "40 41 X8" 0 } 16 - 1c { pt_must "02 03 A5" 0 } 1a - 10 { pt_must "42 43 A6" 0 } } - if {[lsearch -exact $segs $seg] < 0} { - set segs [list [lindex $segs end] $seg] + switch -exact [join $segs -] { + 14-20 { pt_must "42 43 A6" 1 } + 20-14 { pt_must "02 03 A5" 1 } } switch -exact [join $segs -] { - 07-02 { pt_maybe "00 01 X7" } - 02-07 { pt_maybe "02 03 A5" } - 06-09 { pt_maybe "40 41 X8" } - 09-06 { pt_maybe "42 43 A6" } + 07-02 { pt_maybe "00 01 X7" 0 } + 02-07 { pt_maybe "02 03 A5" 1 } + 06-09 { pt_maybe "40 41 X8" 1 } + 09-06 { pt_maybe "42 43 A6" 0 } + } +} + +proc tellnmra {m} { + global nmrawhich speeddirn funcs + set m 0x$m + for {set i 0} {$i < $m} {incr i} { + tellpic_q [lindex [list $speeddirn $funcs] $nmrawhich] + set nmrawhich [expr {!$nmrawhich}] } } proc watchdog {} { - global watchdog testonly speeddirn funcs + global watchdog testonly catch { after cancel $watchdog } set watchdog [after 50 watchdog] - tellpic_q 9808$speeddirn$funcs ;# 128ms + tellpic_q 9808 ;# 128ms } proc pm_hello {} { @@ -249,17 +268,24 @@ proc pm_hello {} { tellpic 21 gui "P 1" watchdog + changewhat + tellnmra 01 } -proc frompic {m} { +proc fp {m} { debug "<< $m" +} + +proc frompic {m} { switch -glob [lindex $m 0] { - 09 { pm_hello } - 28 { pm_charged } - 9[0-7] { pm_maydetect 0 [lindex $m 1] } - 9? { pm_detect [lindex $m 1]; pm_maydetect 1 [lindex $m 1] } + 01 - 02 { tellnmra $m } + 09 { fp $m; pm_hello } + 07 { puts "short circuit"; exit 1 } + 28 { fp $m; pm_charged } + 9[0-7] { fp $m; pm_maydetect 0 [lindex $m 1] } + 9? { fp $m; pm_detect [lindex $m 1]; pm_maydetect 1 [lindex $m 1] } 0a - [234567]? { puts "pic debug $m" } - * { fail "pic unknown $m" } + * { fp $m; fail "pic unknown $m" } } } @@ -272,13 +298,13 @@ proc onreadp {} { global p m while 1 { set c [read $p 1] - if {![string llength $c]} { + if {![string length $c]} { if {[eof $p]} { error "eof on device" } return } binary scan $c H* x lappend m $x - if {[regexp {^[89a-f]} $x]} { + if {[regexp {^[0-7]} $x]} { if {![regexp {^x} $m]} { frompic $m } @@ -305,31 +331,38 @@ proc newfuncs {} { proc maybechange {thing} { global $thing ch - set rb 0x[randbyte][randbyte] - if { - $rb / 65536.0 > - 1.0 / (($ch(${thing}every) - $ch(minint)*0.001) * $ch(scale)) - } { - debug "maybechange $thing rb=$rb no" - return 0 + upvar #0 ${thing}_fixed fixed + if {![info exists fixed]} { + set rb 0x[randbyte][randbyte] + if { + $rb / 65536.0 > + 1.0 / (($ch(${thing}every) - $ch(minint)*0.001) * $ch(scale)) + } { + debug "maybechange $thing rb=$rb no" + return 0 + } + debug "maybechange $thing rb=$rb yes ..." + set l [new$thing] + } else { + debug "fixed $thing $fixed" + set l $fixed } - debug "maybechange $thing rb=$rb yes ..." - set l [new$thing] set bin [eval exec ./hostside-old -s/dev/stdout $l] binary scan $bin H* x debug "changed $thing=$x" - set $thing $x + set $thing ff$x return 1 } proc changewhat {} { - global ch + global ch chwa + catch { after cancel $chwa } if {[maybechange speeddirn] || [maybechange funcs]} { set interval $ch(minint) } else { set interval 1000 } - after $interval changewhat + set chwa [after $interval changewhat] } proc setup {} { @@ -355,8 +388,6 @@ proc setup {} { set rand [open /dev/urandom {RDONLY} 0] fconfigure $rand -encoding binary -translation binary - - changewhat } setup -- 2.30.2