#!/usr/bin/tclsh8.4
# -*- tcl -*-
+set expected_devs 3
+
proc debug {m} { puts "DEBUG $m" }
proc log {m} { puts "LOG $m" }
}
proc find-devices {} {
- global errorCode errorInfo devices
+ global errorCode errorInfo devices expected_devs
set base /sys/class/tty
foreach candidate [glob -nocomplain -directory $base -tails ttyACM*] {
debug "candidate $candidate"
foreach dev [lsort -index 0 -integer $devs([lindex [array names devs] 0])] {
lappend devices [lindex $dev 1]
}
+ if {[llength $devices] != $expected_devs} {
+ experror "wrong # devices ($devices), expected $expected"
+ }
+}
+
+proc create-dev-nodes {} {
+ global devices expected_devs
+ set ourdevs /dev/atmux
+ set ttyat ttyAT
+ for {set i 0} {$i < $expected_devs-1} {incr i} {
+ set new $ttyAT$i
+ file link -symbolic ../$device $ourdevs/.new.$new
+ file rename -force $ourdevs/.new.$new $ourdevs/$new
+ set wanted($new) 1
+ }
+ foreach candidate [glob -nocomplain -directory $ourdevs -tails ttyAT*] {
+ if {![info exists wanted($candidate)]} {
+ file remove $ourdevs/$candidate
+ }
+ }
}
proc reopen-our-device {} {
global devices dchan
- find-devices
set dchan [open /dev/[lindex $devices 1] r+]
fconfigure $dchan -blocking no -buffering line -translation {crlf cr}
read $dchan; # flush input
after 250
set result [read $dchan]
if {![regexp -line {^OK$} $result]} { experror "got [logquote $result]" }
- fileevent $dchan readable dchan-readable
+ fileevent $dchan readable chan-readable $dchan dchan "modem device"
}
-proc devfailure {emsg} {
- global errorCode errorInfo dchan
- switch -glob $errorCode {
- {POSIX *} - EXPECTED {
- log "device failure: $emsg"
- }
- default {
- log "unexpected device failure: $emsg"
- foreach l [split $errorInfo "\n"] {
- log " $l"
- }
- }
- }
+proc devices {} {
+ find-devices
+ create-dev-nodes
+ reopen-our-device
+}
+
+proc dchan-failure {dummy} {
+ global dchan
if {[info exists dchan]} {
catch { close $dchan }
catch { unset dchan }
sendout-async *TTYATMUX "*TTYATMUXOPEN"
}
-proc dchan-readable {args} {
- global dchan
+proc trap-log {what body var} {
+ global errorCode errorInfo
+ upvar 1 $var result
+ set rc [catch {
+ uplevel 1 $body
+ } result]
+ switch -exact $rc {
+ 1 {
+ switch -glob $errorCode {
+ {POSIX *} - EXPECTED { log "$what: $result" }
+ default {
+ log "unexpected: $what: $result"
+ foreach l [split $errorInfo "\n"] { log " $l" }
+ }
+ }
+ return 1
+ }
+ 0 {
+ return 0
+ }
+ default {
+ return -code $rc -errorinfo $errorInfo \
+ -errorcode $errorCode $result
+ }
+ }
+}
+
+proc chan-readable {chan how what args} {
while 1 {
- if {[catch {
- gets $dchan l
+ if {[trap-log "$what failure" {
+ gets $chan l
} r]} {
- devfailure $r
+ $how-failure $chan
return
}
if {$r<0} {
- if {![eof $dchan]} return
- set errorCode EXPECTED
- devfailure "eof"
+ if {![eof $chan]} return
+ log "device eof"
+ $how-failure $chan
return
}
- dchan-line $l
+ trap-log "error processing $what data" {
+ $how-line $l
+ } dummy
}
}
-proc async-notif-or-resp-varies {async_values asid l} {
- set ll [llength [split $l ,]]
- if {$ll == $async_values} {
- async-notif $asid $l
- } elseif {$ll == $async_values+1} {
- sync-reply $l
- } else {
- bad-data $l "async-notif-or-resp-varies $ll"
- }
-}
+proc async-notif fixme this has wrong arguments
proc async-notif-or-resp-fixed {asid l} {
global current_command_asid
proc async-control-core {c l allows ubody_init ubody_perclient ubody_finish} {
global clients
uplevel 1 cmd cmd
- if {[regexp {^(AT[^=?])\?$} dummy cmd]} {
- sync-subcommand $c $cmd async-massage-result-subs $c $cmd
- } elseif {[regexp {^(AT[^=?])=\?$} dummy cmd]} {
- sync-subcommand $c $cmd async-massage-result-support $c $cmd $allows
- } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} dummy cmd values]} {
+ if {[regexp {^(AT[^=?])\?$} $l dummy cmd]} {
+ sync-subcommand $c $l async-massage-result-subs $c $cmd
+ } elseif {[regexp {^(AT[^=?])=\?$} $l dummy cmd]} {
+ sync-subcommand $c $l async-massage-result-support $c $cmd $allows
+ } elseif {[regexp {^(AT[^=?])=([0-9,]+)$} $l dummy cmd values]} {
set values [split $values ,]
if {[llength $values] > [llength $allows]} {
bad-command "too many values"
client-command-complete $c OK
}
+proc simple-command {c l} {
+ sync-subcommand $c $l simple-command-complete
+}
+
+proc client-command-complete
+
proc process-client-command {c nl} {
switch -regexp $l {
{^AT\+CREG\b} { async-control-max0 $c $l {{0 1 2}} }
{^AT\+CMER\b} { async-control-cmer $c $l {{0 3} 0 0 {0 1} 0} }
{^ATE0$} { set-client-echo $c 0 }
{^ATE1$} { set-client-echo $c 1 }
-
+ {^AT\+CFUN\b} { simple-command $c $l }
+ default { bad-command "unknown command" }
+ }
+}
proc dchan-line {l} {
global cclient
switch -regexp $l {
- {\+CREG:} { async-notif-creg +CREG $l }
- {\+CGREG:} { async-notif-creg +CGREG $l }
- {\*ERINFO:} { async-notif-or-resp-fixed *ERINFO $l }
+ {\+CREG:} { async-notif-creg +CREG $l }
+ {\+CGREG:} { async-notif-creg +CGREG $l }
+ {\*ERINFO:} { async-notif-or-resp-fixed *ERINFO $l }
{\+CGEV:} { async-notif +CGEREP $l }
+ {\+CIEV:} { async-notif +CMER $l }
+ default { syync-reply $l }
+ }
+}
+
+proc cchan-line {c l} {
+ lappend queue [list $c $l]
+ check-busy
+}
+
+proc sync-subcommand {c l args} {
+ global busy dchan
+ if {[info exists busy]} { error "already busy $busy; want $c $l $args" }
+ if {[trap-log "write device" { puts $dchan $l } dummy]} {
+
+
+proc sync-reply {l} {
+ global busy
+ if {![info exists busy]} {
+ bad-data $l "unexpected sync reply"
+ return
+ }
+ eval $
+
+proc check-busy {} {
+ global busy queue
+ while {![info exists busy] && [llength $queue]} {
+ manyset [lindex $queue 0] c l
+ set queue [lrange $queue 1 end]
+ if {[trap-log "process for $c [logquote $l]"] {
+ process-client-command $c $l
+ } dummy]} {
+ client-command-complete $c ERROR
+ }
+ }
+}
- {\+CIEV:} { async-notif +CIEV $l }
+proc client-command-complete {c l} {
+ if {[trap-log "write to $c" { puts $c $l } dummy]} {
+ client-failure $c
}
+}
- if {[info exists cclient
+proc cchan-readable {
proc sendout-async
proc logquote
~ian / chiark-tcl-applet.git / blobdiff