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