/usr/share/tcltk/critcl-app3.1.8/runtime.tcl is in critcl 3.1.9-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | #
# Critcl - build C extensions on-the-fly
#
# Copyright (c) 2001-2007 Jean-Claude Wippler
# Copyright (c) 2002-2007 Steve Landers
#
# See http://wiki.tcl.tk/critcl
#
# This is the Critcl runtime that loads the appropriate
# shared library when a package is requested
#
namespace eval ::critcl::runtime {}
proc ::critcl::runtime::loadlib {dir package version libname initfun tsrc mapping args} {
# XXX At least parts of this can be done by the package generator,
# XXX like listing the Tcl files to source. The glob here allows
# XXX code-injection after-the-fact, by simply adding a .tcl in
# XXX the proper place.
set path [file join $dir [MapPlatform $mapping]]
set ext [info sharedlibextension]
set lib [file join $path $libname$ext]
set provide [list]
# Now the runtime equivalent of a series of 'preFetch' commands.
if {[llength $args]} {
set preload [file join $path preload$ext]
foreach p $args {
set prelib [file join $path $p$ext]
if {[file readable $preload] && [file readable $prelib]} {
lappend provide [list load $preload];# XXX Move this out of the loop, do only once.
lappend provide [list ::critcl::runtime::preload $prelib]
}
}
}
lappend provide [list load $lib $initfun]
foreach t $tsrc {
lappend loadcmd "::critcl::runtime::Fetch \$dir [list $t]"
}
lappend provide "package provide $package $version"
package ifneeded $package $version [join $provide "\n"]
return
}
proc ::critcl::runtime::preFetch {path ext dll} {
set preload [file join $path preload$ext]
if {![file readable $preload]} return
set prelib [file join $path $dll$ext]
if {![file readable $prelib]} return
load $preload ; # Defines next command.
::critcl::runtime::preload $prelib
return
}
proc ::critcl::runtime::Fetch {dir t} {
# The 'Ignore' disables compile & run functionality.
# Background: If the regular critcl package is already loaded, and
# this prebuilt package uses its defining .tcl file also as a
# 'tsources' then critcl might try to collect data and build it
# because of the calls to its API, despite the necessary binaries
# already being present, just not in the critcl cache. That is
# redundant in the best case, and fails in the worst case (no
# compiler), preventing the use o a perfectly fine package. The
# 'ignore' call now tells critcl that it should ignore any calls
# made to it by the sourced files, and thus avoids that trouble.
# The other case, the regular critcl package getting loaded after
# this prebuilt package is irrelevant. At that point the tsources
# were already run, and used the dummy procedures defined in the
# critcl-rt.tcl, which ignore the calls by definition.
set t [file join $dir tcl $t]
::critcl::Ignore $t
uplevel #0 [list source $t]
return
}
proc ::critcl::runtime::precopy {dll} {
# This command is only used on Windows when preloading out of a
# VFS that doesn't support direct loading (usually, a Starkit)
# - we preserve the dll name so that dependencies are satisfied
# - The critcl::runtime::preload command is defined in the supporting
# "preload" package, implemented in "critcl/lib/critcl/critcl_c/preload.c"
global env
if {[info exists env(TEMP)]} {
set dir $env(TEMP)
} elseif {[info exists env(TMP)]} {
set dir $env(TMP)
} elseif {[info exists ~]} {
set dir ~
} else {
set dir .
}
set dir [file join $dir TCL[pid]]
set i 0
while {[file exists $dir]} {
append dir [incr i]
}
set new [file join $dir [file tail $dll]]
file mkdir $dir
file copy $dll $new
return $new
}
proc ::critcl::runtime::MapPlatform {{mapping {}}} {
# A sibling of critcl::platform that applies the platform mapping
set platform [::platform::generic]
set version $::tcl_platform(osVersion)
if {[string match "macosx-*" $platform]} {
# "normalize" the osVersion to match OSX release numbers
set v [split $version .]
set v1 [lindex $v 0]
set v2 [lindex $v 1]
incr v1 -4
set version 10.$v1.$v2
} else {
# Strip trailing non-version info
regsub -- {-.*$} $version {} version
}
foreach {config map} $mapping {
if {![string match $config $platform]} continue
set minver [lindex $map 1]
if {[package vcompare $version $minver] < 0} continue
set platform [lindex $map 0]
break
}
return $platform
}
|