1# -*- tcl -*- 2# ### ### ### ######### ######### ######### 3## Overview 4 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. 9# 10# Examples: 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 14# actual cpu. 15# 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). 21# 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 25# result. 26# 27# General 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. 30# 31# Machine specific 32# % arm* -> arm 33# % sun4* -> sparc 34# % intel -> ix86 35# % i*86* -> ix86 36# % Power* -> powerpc 37# % x86_64 + wordSize 4 => x86 code 38# 39# OS specific 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 44# 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. 49 50# ### ### ### ######### ######### ######### 51## Requirements 52 53namespace eval ::platform {} 54 55# ### ### ### ######### ######### ######### 56## Implementation 57 58# -- platform::generic 59# 60# Assembles an identifier for the generic platform. It leaves out 61# details like kernel version, libc version, etc. 62 63proc ::platform::generic {} { 64 global tcl_platform 65 66 set plat [string tolower [lindex $tcl_platform(os) 0]] 67 set cpu $tcl_platform(machine) 68 69 switch -glob -- $cpu { 70 sun4* { 71 set cpu sparc 72 } 73 intel - 74 i*86* { 75 set cpu ix86 76 } 77 x86_64 { 78 if {$tcl_platform(wordSize) == 4} { 79 # See Example <1> at the top of this file. 80 set cpu ix86 81 } 82 } 83 "Power*" { 84 set cpu powerpc 85 } 86 "arm*" { 87 set cpu arm 88 } 89 ia64 { 90 if {$tcl_platform(wordSize) == 4} { 91 append cpu _32 92 } 93 } 94 } 95 96 switch -- $plat { 97 windows { 98 set plat win32 99 if {$cpu eq "amd64"} { 100 # Do not check wordSize, win32-x64 is an IL32P64 platform. 101 set cpu x86_64 102 } 103 } 104 sunos { 105 set plat solaris 106 if {[string match "ix86" $cpu]} { 107 if {$tcl_platform(wordSize) == 8} { 108 set cpu x86_64 109 } 110 } elseif {![string match "ia64*" $cpu]} { 111 # sparc 112 if {$tcl_platform(wordSize) == 8} { 113 append cpu 64 114 } 115 } 116 } 117 darwin { 118 set plat macosx 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} { 123 set cpu x86_64 124 } 125 } 126 } 127 aix { 128 set cpu powerpc 129 if {$tcl_platform(wordSize) == 8} { 130 append cpu 64 131 } 132 } 133 hp-ux { 134 set plat hpux 135 if {![string match "ia64*" $cpu]} { 136 set cpu parisc 137 if {$tcl_platform(wordSize) == 8} { 138 append cpu 64 139 } 140 } 141 } 142 osf1 { 143 set plat tru64 144 } 145 } 146 147 return "${plat}-${cpu}" 148} 149 150# -- platform::identify 151# 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. 156 157proc ::platform::identify {} { 158 global tcl_platform 159 160 set id [generic] 161 regexp {^([^-]+)-([^-]+)$} $id -> plat cpu 162 163 switch -- $plat { 164 solaris { 165 regsub {^5} $tcl_platform(osVersion) 2 text 166 append plat $text 167 return "${plat}-${cpu}" 168 } 169 macosx { 170 set major [lindex [split $tcl_platform(osVersion) .] 0] 171 if {$major > 8} { 172 incr major -4 173 append plat 10.$major 174 return "${plat}-${cpu}" 175 } 176 } 177 linux { 178 # Look for the libc*.so and determine its version 179 # (libc5/6, libc6 further glibc 2.X) 180 181 set v unknown 182 183 # Determine in which directory to look. /lib, or /lib64. 184 # For that we use the tcl_platform(wordSize). 185 # 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 189 # fundamental. 190 # 191 # ix86 <=> (wordSize == 4) <=> 32 bit ==> /lib 192 # x86_64 <=> (wordSize == 8) <=> 64 bit ==> /lib64 193 # 194 # Do not look into /lib64 even if present, if the cpu 195 # doesn't fit. 196 197 switch -exact -- $tcl_platform(wordSize) { 198 4 { 199 set base /lib 200 } 201 8 { 202 set base /lib64 203 } 204 default { 205 return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8" 206 } 207 } 208 209 set libclist [lsort [glob -nocomplain -directory $base libc*]] 210 if {[llength $libclist]} { 211 set libc [lindex $libclist 0] 212 213 # Try executing the library first. This should suceed 214 # for a glibc library, and return the version 215 # information. 216 217 if {![catch { 218 set vdata [lindex [split [exec $libc] \n] 0] 219 }]} { 220 regexp {([0-9]+(\.[0-9]+)*)} $vdata -> v 221 foreach {major minor} [split $v .] break 222 set v glibc${major}.${minor} 223 } else { 224 # We had trouble executing the library. We are now 225 # inspecting its name to determine the version 226 # number. This code by Larry McVoy. 227 228 if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} { 229 set v glibc${major}.${minor} 230 } 231 } 232 } 233 append plat -$v 234 return "${plat}-${cpu}" 235 } 236 } 237 238 return $id 239} 240 241# -- platform::patterns 242# 243# Given an exact platform identifier, i.e. _not_ the generic 244# identifier it assembles a list of exact platform identifier 245# describing platform which should be compatible with the 246# input. 247# 248# I.e. packages for all platforms in the result list should be 249# loadable on the specified platform. 250 251# << Should we add the generic identifier to the list as well ? In 252# general it is not compatible I believe. So better not. In many 253# cases the exact identifier is identical to the generic one 254# anyway. 255# >> 256 257proc ::platform::patterns {id} { 258 set res [list $id] 259 if {$id eq "tcl"} {return $res} 260 261 switch -glob -- $id { 262 solaris*-* { 263 if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} { 264 if {$v eq ""} {return $id} 265 foreach {major minor} [split $v .] break 266 incr minor -1 267 for {set j $minor} {$j >= 6} {incr j -1} { 268 lappend res solaris${major}.${j}-${cpu} 269 } 270 } 271 } 272 linux*-* { 273 if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} { 274 foreach {major minor} [split $v .] break 275 incr minor -1 276 for {set j $minor} {$j >= 0} {incr j -1} { 277 lappend res linux-glibc${major}.${j}-${cpu} 278 } 279 } 280 } 281 macosx*-* { 282 # 10.5+ 283 if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} { 284 285 switch -exact -- $cpu { 286 ix86 - 287 x86_64 { set alt i386-x86_64 } 288 default { set alt {} } 289 } 290 291 if {$v ne ""} { 292 foreach {major minor} [split $v .] break 293 294 # Add 10.5 to 10.minor to patterns. 295 set res {} 296 for {set j $minor} {$j >= 5} {incr j -1} { 297 lappend res macosx${major}.${j}-${cpu} 298 lappend res macosx${major}.${j}-universal 299 if {$alt ne {}} { 300 lappend res macosx${major}.${j}-$alt 301 } 302 } 303 304 # Add unversioned patterns for 10.3/10.4 builds. 305 lappend res macosx-${cpu} 306 lappend res macosx-universal 307 if {$alt ne {}} { 308 lappend res macosx-$alt 309 } 310 } else { 311 lappend res macosx-universal 312 if {$alt ne {}} { 313 lappend res macosx-$alt 314 } 315 } 316 } else { 317 lappend res macosx-universal 318 } 319 } 320 macosx-powerpc { 321 lappend res macosx-universal 322 } 323 macosx-x86_64 - 324 macosx-ix86 { 325 lappend res macosx-universal macosx-i386-x86_64 326 } 327 } 328 lappend res tcl ; # Pure tcl packages are always compatible. 329 return $res 330} 331 332 333# ### ### ### ######### ######### ######### 334## Ready 335 336package provide platform 1.0.9 337 338# ### ### ### ######### ######### ######### 339## Demo application 340 341if {[info exists argv0] && ($argv0 eq [info script])} { 342 puts ==================================== 343 parray tcl_platform 344 puts ==================================== 345 puts Generic\ identification:\ [::platform::generic] 346 puts Exact\ identification:\ \ \ [::platform::identify] 347 puts ==================================== 348 puts Search\ patterns: 349 puts *\ [join [::platform::patterns [::platform::identify]] \n*\ ] 350 puts ==================================== 351 exit 0 352} 353