"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tcl8/8.4/platform-1.0.14.tm" (17 Mar 2020, 10012 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    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 
   53 namespace 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 
   63 proc ::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 -glob -- $plat {
   97 	cygwin* {
   98 	    set plat cygwin
   99 	}
  100 	windows {
  101 	    if {$tcl_platform(platform) == "unix"} {
  102 		set plat cygwin
  103 	    } else {
  104 		set plat win32
  105 	    }
  106 	    if {$cpu eq "amd64"} {
  107 		# Do not check wordSize, win32-x64 is an IL32P64 platform.
  108 		set cpu x86_64
  109 	    }
  110 	}
  111 	sunos {
  112 	    set plat solaris
  113 	    if {[string match "ix86" $cpu]} {
  114 		if {$tcl_platform(wordSize) == 8} {
  115 		    set cpu x86_64
  116 		}
  117 	    } elseif {![string match "ia64*" $cpu]} {
  118 		# sparc
  119 		if {$tcl_platform(wordSize) == 8} {
  120 		    append cpu 64
  121 		}
  122 	    }
  123 	}
  124 	darwin {
  125 	    set plat macosx
  126 	    # Correctly identify the cpu when running as a 64bit
  127 	    # process on a machine with a 32bit kernel
  128 	    if {$cpu eq "ix86"} {
  129 		if {$tcl_platform(wordSize) == 8} {
  130 		    set cpu x86_64
  131 		}
  132 	    }
  133 	}
  134 	aix {
  135 	    set cpu powerpc
  136 	    if {$tcl_platform(wordSize) == 8} {
  137 		append cpu 64
  138 	    }
  139 	}
  140 	hp-ux {
  141 	    set plat hpux
  142 	    if {![string match "ia64*" $cpu]} {
  143 		set cpu parisc
  144 		if {$tcl_platform(wordSize) == 8} {
  145 		    append cpu 64
  146 		}
  147 	    }
  148 	}
  149 	osf1 {
  150 	    set plat tru64
  151 	}
  152     }
  153 
  154     return "${plat}-${cpu}"
  155 }
  156 
  157 # -- platform::identify
  158 #
  159 # Assembles an identifier for the exact platform, by extending the
  160 # generic identifier. I.e. it adds in details like kernel version,
  161 # libc version, etc., if they are relevant for the loading of
  162 # packages on the platform.
  163 
  164 proc ::platform::identify {} {
  165     global tcl_platform
  166 
  167     set id [generic]
  168     regexp {^([^-]+)-([^-]+)$} $id -> plat cpu
  169 
  170     switch -- $plat {
  171 	solaris {
  172 	    regsub {^5} $tcl_platform(osVersion) 2 text
  173 	    append plat $text
  174 	    return "${plat}-${cpu}"
  175 	}
  176 	macosx {
  177 	    set major [lindex [split $tcl_platform(osVersion) .] 0]
  178 	    if {$major > 8} {
  179 		incr major -4
  180 		append plat 10.$major
  181 		return "${plat}-${cpu}"
  182 	    }
  183 	}
  184 	linux {
  185 	    # Look for the libc*.so and determine its version
  186 	    # (libc5/6, libc6 further glibc 2.X)
  187 
  188 	    set v unknown
  189 
  190 	    # Determine in which directory to look. /lib, or /lib64.
  191 	    # For that we use the tcl_platform(wordSize).
  192 	    #
  193 	    # We could use the 'cpu' info, per the equivalence below,
  194 	    # that however would be restricted to intel. And this may
  195 	    # be a arm, mips, etc. system. The wordsize is more
  196 	    # fundamental.
  197 	    #
  198 	    # ix86   <=> (wordSize == 4) <=> 32 bit ==> /lib
  199 	    # x86_64 <=> (wordSize == 8) <=> 64 bit ==> /lib64
  200 	    #
  201 	    # Do not look into /lib64 even if present, if the cpu
  202 	    # doesn't fit.
  203 
  204 	    # TODO: Determine the prefixes (i386, x86_64, ...) for
  205 	    # other cpus.  The path after the generic one is utterly
  206 	    # specific to intel right now.  Ok, on Ubuntu, possibly
  207 	    # other Debian systems we may apparently be able to query
  208 	    # the necessary CPU code. If we can't we simply use the
  209 	    # hardwired fallback.
  210 
  211 	    switch -exact -- $tcl_platform(wordSize) {
  212 		4 {
  213 		    lappend bases /lib
  214 		    if {[catch {
  215 			exec dpkg-architecture -qDEB_HOST_MULTIARCH
  216 		    } res]} {
  217 			lappend bases /lib/i386-linux-gnu
  218 		    } else {
  219 			# dpkg-arch returns the full tripled, not just cpu.
  220 			lappend bases /lib/$res
  221 		    }
  222 		}
  223 		8 {
  224 		    lappend bases /lib64
  225 		    if {[catch {
  226 			exec dpkg-architecture -qDEB_HOST_MULTIARCH
  227 		    } res]} {
  228 			lappend bases /lib/x86_64-linux-gnu
  229 		    } else {
  230 			# dpkg-arch returns the full tripled, not just cpu.
  231 			lappend bases /lib/$res
  232 		    }
  233 		}
  234 		default {
  235 		    return -code error "Bad wordSize $tcl_platform(wordSize), expected 4 or 8"
  236 		}
  237 	    }
  238 
  239 	    foreach base $bases {
  240 		if {[LibcVersion $base -> v]} break
  241 	    }
  242 
  243 	    append plat -$v
  244 	    return "${plat}-${cpu}"
  245 	}
  246     }
  247 
  248     return $id
  249 }
  250 
  251 proc ::platform::LibcVersion {base _->_ vv} {
  252     upvar 1 $vv v
  253     set libclist [lsort [glob -nocomplain -directory $base libc*]]
  254 
  255     if {![llength $libclist]} { return 0 }
  256 
  257     set libc [lindex $libclist 0]
  258 
  259     # Try executing the library first. This should suceed
  260     # for a glibc library, and return the version
  261     # information.
  262 
  263     if {![catch {
  264 	set vdata [lindex [split [exec $libc] \n] 0]
  265     }]} {
  266 	regexp {version ([0-9]+(\.[0-9]+)*)} $vdata -> v
  267 	foreach {major minor} [split $v .] break
  268 	set v glibc${major}.${minor}
  269 	return 1
  270     } else {
  271 	# We had trouble executing the library. We are now
  272 	# inspecting its name to determine the version
  273 	# number. This code by Larry McVoy.
  274 
  275 	if {[regexp -- {libc-([0-9]+)\.([0-9]+)} $libc -> major minor]} {
  276 	    set v glibc${major}.${minor}
  277 	    return 1
  278 	}
  279     }
  280     return 0
  281 }
  282 
  283 # -- platform::patterns
  284 #
  285 # Given an exact platform identifier, i.e. _not_ the generic
  286 # identifier it assembles a list of exact platform identifier
  287 # describing platform which should be compatible with the
  288 # input.
  289 #
  290 # I.e. packages for all platforms in the result list should be
  291 # loadable on the specified platform.
  292 
  293 # << Should we add the generic identifier to the list as well ? In
  294 #    general it is not compatible I believe. So better not. In many
  295 #    cases the exact identifier is identical to the generic one
  296 #    anyway.
  297 # >>
  298 
  299 proc ::platform::patterns {id} {
  300     set res [list $id]
  301     if {$id eq "tcl"} {return $res}
  302 
  303     switch -glob --  $id {
  304 	solaris*-* {
  305 	    if {[regexp {solaris([^-]*)-(.*)} $id -> v cpu]} {
  306 		if {$v eq ""} {return $id}
  307 		foreach {major minor} [split $v .] break
  308 		incr minor -1
  309 		for {set j $minor} {$j >= 6} {incr j -1} {
  310 		    lappend res solaris${major}.${j}-${cpu}
  311 		}
  312 	    }
  313 	}
  314 	linux*-* {
  315 	    if {[regexp {linux-glibc([^-]*)-(.*)} $id -> v cpu]} {
  316 		foreach {major minor} [split $v .] break
  317 		incr minor -1
  318 		for {set j $minor} {$j >= 0} {incr j -1} {
  319 		    lappend res linux-glibc${major}.${j}-${cpu}
  320 		}
  321 	    }
  322 	}
  323 	macosx-powerpc {
  324 	    lappend res macosx-universal
  325 	}
  326 	macosx-x86_64 {
  327 	    lappend res macosx-i386-x86_64
  328 	}
  329 	macosx-ix86 {
  330 	    lappend res macosx-universal macosx-i386-x86_64
  331 	}
  332 	macosx*-*    {
  333 	    # 10.5+
  334 	    if {[regexp {macosx([^-]*)-(.*)} $id -> v cpu]} {
  335 
  336 		switch -exact -- $cpu {
  337 		    ix86    {
  338 			lappend alt i386-x86_64
  339 			lappend alt universal
  340 		    }
  341 		    x86_64  { lappend alt i386-x86_64 }
  342 		    default { set alt {} }
  343 		}
  344 
  345 		if {$v ne ""} {
  346 		    foreach {major minor} [split $v .] break
  347 
  348 		    # Add 10.5 to 10.minor to patterns.
  349 		    set res {}
  350 		    for {set j $minor} {$j >= 5} {incr j -1} {
  351 			lappend res macosx${major}.${j}-${cpu}
  352 			foreach a $alt {
  353 			    lappend res macosx${major}.${j}-$a
  354 			}
  355 		    }
  356 
  357 		    # Add unversioned patterns for 10.3/10.4 builds.
  358 		    lappend res macosx-${cpu}
  359 		    foreach a $alt {
  360 			lappend res macosx-$a
  361 		    }
  362 		} else {
  363 		    # No version, just do unversioned patterns.
  364 		    foreach a $alt {
  365 			lappend res macosx-$a
  366 		    }
  367 		}
  368 	    } else {
  369 		# no v, no cpu ... nothing
  370 	    }
  371 	}
  372     }
  373     lappend res tcl ; # Pure tcl packages are always compatible.
  374     return $res
  375 }
  376 
  377 
  378 # ### ### ### ######### ######### #########
  379 ## Ready
  380 
  381 package provide platform 1.0.14
  382 
  383 # ### ### ### ######### ######### #########
  384 ## Demo application
  385 
  386 if {[info exists argv0] && ($argv0 eq [info script])} {
  387     puts ====================================
  388     parray tcl_platform
  389     puts ====================================
  390     puts Generic\ identification:\ [::platform::generic]
  391     puts Exact\ identification:\ \ \ [::platform::identify]
  392     puts ====================================
  393     puts Search\ patterns:
  394     puts *\ [join [::platform::patterns [::platform::identify]] \n*\ ]
  395     puts ====================================
  396     exit 0
  397 }