os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/library/ldAout.tcl
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/library/ldAout.tcl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,233 @@
1.4 +# ldAout.tcl --
1.5 +#
1.6 +# This "tclldAout" procedure in this script acts as a replacement
1.7 +# for the "ld" command when linking an object file that will be
1.8 +# loaded dynamically into Tcl or Tk using pseudo-static linking.
1.9 +#
1.10 +# Parameters:
1.11 +# The arguments to the script are the command line options for
1.12 +# an "ld" command.
1.13 +#
1.14 +# Results:
1.15 +# The "ld" command is parsed, and the "-o" option determines the
1.16 +# module name. ".a" and ".o" options are accumulated.
1.17 +# The input archives and object files are examined with the "nm"
1.18 +# command to determine whether the modules initialization
1.19 +# entry and safe initialization entry are present. A trivial
1.20 +# C function that locates the entries is composed, compiled, and
1.21 +# its .o file placed before all others in the command; then
1.22 +# "ld" is executed to bind the objects together.
1.23 +#
1.24 +# RCS: @(#) $Id: ldAout.tcl,v 1.5 2001/09/28 01:21:53 dgp Exp $
1.25 +#
1.26 +# Copyright (c) 1995, by General Electric Company. All rights reserved.
1.27 +#
1.28 +# See the file "license.terms" for information on usage and redistribution
1.29 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.30 +#
1.31 +# This work was supported in part by the ARPA Manufacturing Automation
1.32 +# and Design Engineering (MADE) Initiative through ARPA contract
1.33 +# F33615-94-C-4400.
1.34 +
1.35 +proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
1.36 + global env
1.37 + global argv
1.38 +
1.39 + if {[string equal $cc ""]} {
1.40 + set cc $env(CC)
1.41 + }
1.42 +
1.43 + # if only two parameters are supplied there is assumed that the
1.44 + # only shlib_suffix is missing. This parameter is anyway available
1.45 + # as "info sharedlibextension" too, so there is no need to transfer
1.46 + # 3 parameters to the function tclLdAout. For compatibility, this
1.47 + # function now accepts both 2 and 3 parameters.
1.48 +
1.49 + if {[string equal $shlib_suffix ""]} {
1.50 + set shlib_cflags $env(SHLIB_CFLAGS)
1.51 + } elseif {[string equal $shlib_cflags "none"]} {
1.52 + set shlib_cflags $shlib_suffix
1.53 + }
1.54 +
1.55 + # seenDotO is nonzero if a .o or .a file has been seen
1.56 + set seenDotO 0
1.57 +
1.58 + # minusO is nonzero if the last command line argument was "-o".
1.59 + set minusO 0
1.60 +
1.61 + # head has command line arguments up to but not including the first
1.62 + # .o or .a file. tail has the rest of the arguments.
1.63 + set head {}
1.64 + set tail {}
1.65 +
1.66 + # nmCommand is the "nm" command that lists global symbols from the
1.67 + # object files.
1.68 + set nmCommand {|nm -g}
1.69 +
1.70 + # entryProtos is the table of _Init and _SafeInit prototypes found in the
1.71 + # module.
1.72 + set entryProtos {}
1.73 +
1.74 + # entryPoints is the table of _Init and _SafeInit entries found in the
1.75 + # module.
1.76 + set entryPoints {}
1.77 +
1.78 + # libraries is the list of -L and -l flags to the linker.
1.79 + set libraries {}
1.80 + set libdirs {}
1.81 +
1.82 + # Process command line arguments
1.83 + foreach a $argv {
1.84 + if {!$minusO && [regexp {\.[ao]$} $a]} {
1.85 + set seenDotO 1
1.86 + lappend nmCommand $a
1.87 + }
1.88 + if {$minusO} {
1.89 + set outputFile $a
1.90 + set minusO 0
1.91 + } elseif {![string compare $a -o]} {
1.92 + set minusO 1
1.93 + }
1.94 + if {[regexp {^-[lL]} $a]} {
1.95 + lappend libraries $a
1.96 + if {[regexp {^-L} $a]} {
1.97 + lappend libdirs [string range $a 2 end]
1.98 + }
1.99 + } elseif {$seenDotO} {
1.100 + lappend tail $a
1.101 + } else {
1.102 + lappend head $a
1.103 + }
1.104 + }
1.105 + lappend libdirs /lib /usr/lib
1.106 +
1.107 + # MIPS -- If there are corresponding G0 libraries, replace the
1.108 + # ordinary ones with the G0 ones.
1.109 +
1.110 + set libs {}
1.111 + foreach lib $libraries {
1.112 + if {[regexp {^-l} $lib]} {
1.113 + set lname [string range $lib 2 end]
1.114 + foreach dir $libdirs {
1.115 + if {[file exists [file join $dir lib${lname}_G0.a]]} {
1.116 + set lname ${lname}_G0
1.117 + break
1.118 + }
1.119 + }
1.120 + lappend libs -l$lname
1.121 + } else {
1.122 + lappend libs $lib
1.123 + }
1.124 + }
1.125 + set libraries $libs
1.126 +
1.127 + # Extract the module name from the "-o" option
1.128 +
1.129 + if {![info exists outputFile]} {
1.130 + error "-o option must be supplied to link a Tcl load module"
1.131 + }
1.132 + set m [file tail $outputFile]
1.133 + if {[regexp {\.a$} $outputFile]} {
1.134 + set shlib_suffix .a
1.135 + } else {
1.136 + set shlib_suffix ""
1.137 + }
1.138 + if {[regexp {\..*$} $outputFile match]} {
1.139 + set l [expr {[string length $m] - [string length $match]}]
1.140 + } else {
1.141 + error "Output file does not appear to have a suffix"
1.142 + }
1.143 + set modName [string tolower $m 0 [expr {$l-1}]]
1.144 + if {[regexp {^lib} $modName]} {
1.145 + set modName [string range $modName 3 end]
1.146 + }
1.147 + if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
1.148 + set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
1.149 + }
1.150 + set modName [string totitle $modName]
1.151 +
1.152 + # Catalog initialization entry points found in the module
1.153 +
1.154 + set f [open $nmCommand r]
1.155 + while {[gets $f l] >= 0} {
1.156 + if {[regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
1.157 + if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
1.158 + set s $symbol
1.159 + }
1.160 + append entryProtos {extern int } $symbol { (); } \n
1.161 + append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n
1.162 + }
1.163 + }
1.164 + close $f
1.165 +
1.166 + if {[string equal $entryPoints ""]} {
1.167 + error "No entry point found in objects"
1.168 + }
1.169 +
1.170 + # Compose a C function that resolves the initialization entry points and
1.171 + # embeds the required libraries in the object code.
1.172 +
1.173 + set C {#include <string.h>}
1.174 + append C \n
1.175 + append C {char TclLoadLibraries_} $modName { [] =} \n
1.176 + append C { "@LIBS: } $libraries {";} \n
1.177 + append C $entryProtos
1.178 + append C {static struct } \{ \n
1.179 + append C { char * name;} \n
1.180 + append C { int (*value)();} \n
1.181 + append C \} {dictionary [] = } \{ \n
1.182 + append C $entryPoints
1.183 + append C { 0, 0 } \n \} \; \n
1.184 + append C {typedef struct Tcl_Interp Tcl_Interp;} \n
1.185 + append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
1.186 + append C {Tcl_PackageInitProc *} \n
1.187 + append C TclLoadDictionary_ $modName { (symbol)} \n
1.188 + append C { CONST char * symbol;} \n
1.189 + append C {
1.190 + {
1.191 + int i;
1.192 + for (i = 0; dictionary [i] . name != 0; ++i) {
1.193 + if (!strcmp (symbol, dictionary [i] . name)) {
1.194 + return dictionary [i].value;
1.195 + }
1.196 + }
1.197 + return 0;
1.198 + }
1.199 + }
1.200 + append C \n
1.201 +
1.202 +
1.203 + # Write the C module and compile it
1.204 +
1.205 + set cFile tcl$modName.c
1.206 + set f [open $cFile w]
1.207 + puts -nonewline $f $C
1.208 + close $f
1.209 + set ccCommand "$cc -c $shlib_cflags $cFile"
1.210 + puts stderr $ccCommand
1.211 + eval exec $ccCommand
1.212 +
1.213 + # Now compose and execute the ld command that packages the module
1.214 +
1.215 + if {[string equal $shlib_suffix ".a"]} {
1.216 + set ldCommand "ar cr $outputFile"
1.217 + regsub { -o} $tail {} tail
1.218 + } else {
1.219 + set ldCommand ld
1.220 + foreach item $head {
1.221 + lappend ldCommand $item
1.222 + }
1.223 + }
1.224 + lappend ldCommand tcl$modName.o
1.225 + foreach item $tail {
1.226 + lappend ldCommand $item
1.227 + }
1.228 + puts stderr $ldCommand
1.229 + eval exec $ldCommand
1.230 + if {[string equal $shlib_suffix ".a"]} {
1.231 + exec ranlib $outputFile
1.232 + }
1.233 +
1.234 + # Clean up working files
1.235 + exec /bin/rm $cFile [file rootname $cFile].o
1.236 +}