1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
|
# hal_procs_lib.tcl
package require Hal ;# provides hal commands
proc pin_exists {name} {
# return 1 if pin exists
if { [lindex [hal list pin "$name"] 0] == "$name"} {return 1}
return 0
} ;# pin_exists
proc connection_info {result_name pinname } {
# return 0 if pinname not found, else 1
# result_name is associative array with details
# owner type direction value separator signame
upvar $result_name ay
set ans [hal show pin $pinname]
set lines [split $ans \n]
set sig ""
set sep ""
set ct [scan [lindex $lines 2] "%s %s %s %s %s %s %s" \
owner type dir val name sep sig]
if {$ct <0} {
return 0
}
set ay(owner) $owner
set ay(type) $type
set ay(direction) $dir
set ay(value) $val
set ay(separator) $sep
set ay(signame) $sig
return 1
} ;# connection_info
proc is_connected {pinname {signame {} } } {
# return is_input or is_output or is_io or not_connected
# set signame to signal name if connected
upvar $signame thesig
set ans [hal show pin $pinname]
set lines [split $ans \n]
set thesig ""
set sep ""
set ct [scan [lindex $lines 2] "%s %s %s %s %s %s %s" \
owner type dir val name sep thesig]
if {$ct <0} {return not_connected}
if {"$sep" == "<=="} {return is_input}
if {"$sep" == "==>"} {return is_output}
if {"$sep" == "<=>"} {return is_io}
return "not_connected"
} ;# is_connected
proc thread_info {ay_name} {
# return details about threads in associative array ay_name
# items for each $threadname:
# ($threadname,$componentname) $threadname index for $componentname
# ($threadname,fp) $threadname uses floatingpoint
# ($threadname,period) $threadname period
# ($threadname,index,last) $threadname last index used
#
# motion specific items:
# (motion-command-handler,threadname) threadname
# (motion-command-handler,index) index
# (motion-controller,threadname) threadname
# (motion-controller,index) index
# other:
# (threadnames) list of all threanames
#
# return string is $ay(motion-controller,threadname)
upvar $ay_name ay
set ans [hal show thread]
set lines [split $ans \n]
set header_len 2
set lines [lreplace $lines 0 [expr $header_len -1]]
set lines [lreplace $lines end end]
set remainder ""
set ct 0
foreach line $lines {
catch {unset f1 f2 f3 f4}
scan [lindex $lines $ct] \
"%s %s %s %s" \
f1 f2 f3 f4
if ![info exists f3] {
set index $f1; set compname $f2
set ay($threadname,$compname) $index
set ay($threadname,index,last) $index
if {"$compname" == "motion-command-handler"} {
set ay(motion-command-handler,threadname) $threadname
set ay(motion-command-handler,index) $index
}
if {"$compname" == "motion-controller"} {
set ay(motion-controller,threadname) $threadname
set ay(motion-controller,index) $index
}
} else {
set period $f1; set fp $f2; set threadname $f3
lappend ay(threadnames) $threadname
set ay($threadname,fp) $fp
set ay($threadname,period) $period
}
incr ct
}
if [info exists ay(motion-controller,threadname)] {
if [info exists ay(motion-command-handler,threadname)] {
if { "$ay(motion-controller,threadname)" \
!= "$ay(motion-command-handler,threadname)" \
} {
return -code error "thread_info: mot funcs on separate threads"
if { $ay(motion-command-handler,index) \
> $ay(motion-controller,index) \
} {
return -code error "thread_info: mot funcs OUT-OF-SEQUENCE"
}
}
return $ay(motion-controller,threadname)
} else {
return -code error "thread_info: motion-controller not found"
}
}
} ;# thread_info
proc get_netlist {inpins_name outpin_name iopins_name signame} {
# input: signame
# outputs:
# inpins_name list of input pins for signame or ""
# iopins_name list of io pins for signame or ""
# outpin_name output pin for signame or ""
upvar $inpins_name inpins
upvar $iopins_name iopins
upvar $outpin_name outpin
set inpins ""
set iopins ""
set outpin ""
set header_len 2
set lines [split [hal show signal $signame] \n]
set lines [lreplace $lines 0 [expr $header_len -1]]
set lines [lreplace $lines end end]
set ct 0
foreach line $lines {set l($ct) [string trim $line];incr ct}
set ct_max $ct
set ct 0
for {set ct 0} {$ct < $ct_max} {incr ct} {
set v0 [lindex $l($ct) 0]
set v1 [lindex $l($ct) 1]
set v2 [lindex $l($ct) 2]
switch $v0 {
float -
bit -
u32 -
s32 {set sname $v2} ;# set on 1st non-header line
"==>" {}
"<==" {}
"<=>" {}
* {return -code error "get_netlist: Unexpected <$line">}
}
if {"$signame"=="$sname"} {
switch $v0 {
"==>" {lappend inpins $v1}
"<==" {lappend outpin $v1}
"<=>" {lappend iopins $v1}
}
}
}
} ;# get_netlist
proc find_file_in_hallib_path {filename {inifile .}} {
# find halfile using path HALLIB_PATH=.:HALLIB_DIR (see scripts/linuxcnc.in)
set libtag LIB: ;# special prefix for explicit use of hallib file
set halname [lindex $filename end]
if {[string first "$libtag" $halname] == 0} {
# explicit $libtag used
set halname [string range $halname [string len $libtag] end]
set usehalname [file join $::env(HALLIB_DIR) $halname]
} else {
if {[file pathtype $filename] == "absolute"} {
set usehalname $filename
} else {
# relative file specifier (relative to INI file directory)
set usehalname [file join [file dirname $inifile] $halname]
if ![file readable $usehalname] {
# use ::env(HALLIB_DIR)
set usehalname [file join $::env(HALLIB_DIR) $halname]
}
}
}
if [file readable $usehalname] {
return $usehalname
}
return -code error "find_file_in_hallib_path: cannot find: <$filename>"
} ;# find_file_in_hallib_path
|
