2
# ### ### ### ######### ######### #########
5
# Heuristics to assemble a platform identifier from publicly available
6
# information. The identifier describes the platform of the currently
7
# running tcl shell. This is a mixture of the runtime environment and
8
# of build-time properties of the executable itself.
11
# <1> A tcl shell executing on a x86_64 processor, but having a
12
# wordsize of 4 was compiled for the x86 environment, i.e. 32
13
# bit, and loaded packages have to match that, and not the
16
# <2> The hp/solaris 32/64 bit builds of the core cannot be
17
# distinguished by looking at tcl_platform. As packages have to
18
# match the 32/64 information we have to look in more places. In
19
# this case we inspect the executable itself (magic numbers,
20
# i.e. fileutil::magic::filetype).
22
# The basic information used comes out of the 'os' and 'machine'
23
# entries of the 'tcl_platform' array. A number of general and
24
# os/machine specific transformation are applied to get a canonical
28
# Only the first element of 'os' is used - we don't care whether we
29
# are on "Windows NT" or "Windows XP" or whatever.
37
# % x86_64 + wordSize 4 => x86 code
40
# % AIX are always powerpc machines
41
# % HP-UX 9000/800 etc means parisc
42
# % linux has to take glibc version into account
43
# % sunos -> solaris, and keep version number
45
# NOTE: A platform like linux glibc 2.3, which can use glibc 2.2 stuff
46
# has to provide all possible allowed platform identifiers when
47
# searching search. Ditto a solaris 2.8 platform can use solaris 2.6
48
# packages. Etc. This is handled by the other procedure, see below.
50
# ### ### ### ######### ######### #########
53
namespace eval ::platform {}
55
# ### ### ### ######### ######### #########
58
# -- platform::generic
60
# Assembles an identifier for the generic platform. It leaves out
61
# details like kernel version, libc version, etc.
63
proc ::platform::generic {} {
66
set plat [string tolower [lindex $tcl_platform(os) 0]]
67
set cpu $tcl_platform(machine)
69
switch -glob -- $cpu {
78
if {$tcl_platform(wordSize) == 4} {
79
# See Example <1> at the top of this file.
90
if {$tcl_platform(wordSize) == 4} {
99
if {$cpu eq "amd64"} {
100
# Do not check wordSize, win32-x64 is an IL32P64 platform.
106
if {[string match "ix86" $cpu]} {
107
if {$tcl_platform(wordSize) == 8} {
110
} elseif {![string match "ia64*" $cpu]} {
112
if {$tcl_platform(wordSize) == 8} {
119
# Correctly identify the cpu when running as a 64bit
120
# process on a machine with a 32bit kernel
121
if {$cpu eq "ix86"} {
122
if {$tcl_platform(wordSize) == 8} {
129
if {$tcl_platform(wordSize) == 8} {
135
if {![string match "ia64*" $cpu]} {
137
if {$tcl_platform(wordSize) == 8} {
147
return "${plat}-${cpu}"
150
# -- platform::identify
152
# Assembles an identifier for the exact platform, by extending the
153
# generic identifier. I.e. it adds in details like kernel version,
154
# libc version, etc., if they are relevant for the loading of
155
# packages on the platform.
157
proc ::platform::identify {} {
161
regexp {^([^-]+)-([^-]+)$} $id -> plat cpu
165
regsub {^5} $tcl_platform(osVersion) 2 text
167
return "${plat}-${cpu}"
170
set major [lindex [split $tcl_platform(osVersion) .] 0]
173
append plat 10.$major
174
return "${plat}-${cpu}"
178
# Look for the libc*.so and determine its version
179
# (libc5/6, libc6 further glibc 2.X)
183
# Determine in which directory to look. /lib, or /lib64.
184
# For that we use the tcl_platform(wordSize).
186
# We could use the 'cpu' info, per the equivalence below,
187
# that however would be restricted to intel. And this may
188
# be a arm, mips, etc. system. The wordsize is more
191
# ix86 <=> (wordSize == 4) <=> 32 bit ==> /lib
192
# x86_64 <=> (wordSize == 8) <=> 64 bit ==> /lib64
194
# Do not look into /lib64 even if present, if the cpu
197
# TODO: Determine the prefixes (i386, x86_64, ...) for
198
# other cpus. The path after the generic one is utterly
199
# specific to intel right now. Ok, on Ubuntu, possibly
200
# other Debian systems we may apparently be able to query
201
# the necessary CPU code. If we can't we simply use the
202
# hardwired fallback.
204
switch -exact -- $tcl_platform(wordSize) {
208
exec dpkg-architecture -qDEB_HOST_MULTIARCH
210
lappend bases /lib/i386-linux-gnu
212
# dpkg-arch returns the full tripled, not just cpu.
213
lappend bases /lib/$res
219
exec dpkg-architecture -qDEB_HOST_MULTIARCH
221
lappend bases /lib/x86_64-linux-gnu
223
# dpkg-arch returns the full tripled, not just cpu.
224
lappend bases /lib/$res
228
return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8"
232
foreach base $bases {
233
if {[LibcVersion $base -> v]} break
237
return "${plat}-${cpu}"
244
proc ::platform::LibcVersion {base _->_ vv} {
246
set libclist [lsort [glob -nocomplain -directory $base libc*]]
248
if {![llength $libclist]} { return 0 }
250
set libc [lindex $libclist 0]
252
# Try executing the library first. This should suceed
253
# for a glibc library, and return the version
257
set vdata [lindex [split [exec $libc] \n] 0]
259
regexp {version ([0-9]+(\.[0-9]+)*), by} $vdata -> v
260
foreach {major minor} [split $v .] break
261
set v glibc${major}.${minor}
264
# We had trouble executing the library. We are now
265
# inspecting its name to determine the version
266
# number. This code by Larry McVoy.
268
if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
269
set v glibc${major}.${minor}
276
# -- platform::patterns
278
# Given an exact platform identifier, i.e. _not_ the generic
279
# identifier it assembles a list of exact platform identifier
280
# describing platform which should be compatible with the
283
# I.e. packages for all platforms in the result list should be
284
# loadable on the specified platform.
286
# << Should we add the generic identifier to the list as well ? In
287
# general it is not compatible I believe. So better not. In many
288
# cases the exact identifier is identical to the generic one
292
proc ::platform::patterns {id} {
294
if {$id eq "tcl"} {return $res}
296
switch -glob -- $id {
298
if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} {
299
if {$v eq ""} {return $id}
300
foreach {major minor} [split $v .] break
302
for {set j $minor} {$j >= 6} {incr j -1} {
303
lappend res solaris${major}.${j}-${cpu}
308
if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} {
309
foreach {major minor} [split $v .] break
311
for {set j $minor} {$j >= 0} {incr j -1} {
312
lappend res linux-glibc${major}.${j}-${cpu}
318
if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {
320
switch -exact -- $cpu {
322
x86_64 { set alt i386-x86_64 }
323
default { set alt {} }
327
foreach {major minor} [split $v .] break
329
# Add 10.5 to 10.minor to patterns.
331
for {set j $minor} {$j >= 5} {incr j -1} {
332
lappend res macosx${major}.${j}-${cpu}
333
lappend res macosx${major}.${j}-universal
335
lappend res macosx${major}.${j}-$alt
339
# Add unversioned patterns for 10.3/10.4 builds.
340
lappend res macosx-${cpu}
341
lappend res macosx-universal
343
lappend res macosx-$alt
346
lappend res macosx-universal
348
lappend res macosx-$alt
352
lappend res macosx-universal
356
lappend res macosx-universal
360
lappend res macosx-universal macosx-i386-x86_64
363
lappend res tcl ; # Pure tcl packages are always compatible.
368
# ### ### ### ######### ######### #########
371
package provide critcl::platform 1.0.11
373
# ### ### ### ######### ######### #########
376
if {[info exists argv0] && ($argv0 eq [info script])} {
377
puts ====================================
379
puts ====================================
380
puts Generic\ identification:\ [::platform::generic]
381
puts Exact\ identification:\ \ \ [::platform::identify]
382
puts ====================================
383
puts Search\ patterns:
384
puts *\ [join [::platform::patterns [::platform::identify]] \n*\ ]
385
puts ====================================
added
removed
lib/critcl-platform/platform.tcl
