diff options
Diffstat (limited to 'library/ldAout.tcl')
| -rw-r--r-- | library/ldAout.tcl | 233 |
1 files changed, 233 insertions, 0 deletions
diff --git a/library/ldAout.tcl b/library/ldAout.tcl new file mode 100644 index 0000000..c32f174 --- /dev/null +++ b/library/ldAout.tcl @@ -0,0 +1,233 @@ +# ldAout.tcl -- +# +# This "tclldAout" procedure in this script acts as a replacement +# for the "ld" command when linking an object file that will be +# loaded dynamically into Tcl or Tk using pseudo-static linking. +# +# Parameters: +# The arguments to the script are the command line options for +# an "ld" command. +# +# Results: +# The "ld" command is parsed, and the "-o" option determines the +# module name. ".a" and ".o" options are accumulated. +# The input archives and object files are examined with the "nm" +# command to determine whether the modules initialization +# entry and safe initialization entry are present. A trivial +# C function that locates the entries is composed, compiled, and +# its .o file placed before all others in the command; then +# "ld" is executed to bind the objects together. +# +# RCS: @(#) $Id: ldAout.tcl,v 1.6 2003/03/19 21:57:42 dgp Exp $ +# +# Copyright (c) 1995, by General Electric Company. All rights reserved. +# +# See the file "license.terms" for information on usage and redistribution +# of this file, and for a DISCLAIMER OF ALL WARRANTIES. +# +# This work was supported in part by the ARPA Manufacturing Automation +# and Design Engineering (MADE) Initiative through ARPA contract +# F33615-94-C-4400. + +proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { + global env + global argv + + if {[string equal $cc ""]} { + set cc $env(CC) + } + + # if only two parameters are supplied there is assumed that the + # only shlib_suffix is missing. This parameter is anyway available + # as "info sharedlibextension" too, so there is no need to transfer + # 3 parameters to the function tclLdAout. For compatibility, this + # function now accepts both 2 and 3 parameters. + + if {[string equal $shlib_suffix ""]} { + set shlib_cflags $env(SHLIB_CFLAGS) + } elseif {[string equal $shlib_cflags "none"]} { + set shlib_cflags $shlib_suffix + } + + # seenDotO is nonzero if a .o or .a file has been seen + set seenDotO 0 + + # minusO is nonzero if the last command line argument was "-o". + set minusO 0 + + # head has command line arguments up to but not including the first + # .o or .a file. tail has the rest of the arguments. + set head {} + set tail {} + + # nmCommand is the "nm" command that lists global symbols from the + # object files. + set nmCommand {|nm -g} + + # entryProtos is the table of _Init and _SafeInit prototypes found in the + # module. + set entryProtos {} + + # entryPoints is the table of _Init and _SafeInit entries found in the + # module. + set entryPoints {} + + # libraries is the list of -L and -l flags to the linker. + set libraries {} + set libdirs {} + + # Process command line arguments + foreach a $argv { + if {!$minusO && [regexp {\.[ao]$} $a]} { + set seenDotO 1 + lappend nmCommand $a + } + if {$minusO} { + set outputFile $a + set minusO 0 + } elseif {![string compare $a -o]} { + set minusO 1 + } + if {[string match -nocase "-l*" $a]} { + lappend libraries $a + if {[string match "-L*" $a]} { + lappend libdirs [string range $a 2 end] + } + } elseif {$seenDotO} { + lappend tail $a + } else { + lappend head $a + } + } + lappend libdirs /lib /usr/lib + + # MIPS -- If there are corresponding G0 libraries, replace the + # ordinary ones with the G0 ones. + + set libs {} + foreach lib $libraries { + if {[string match "-l*" $lib]} { + set lname [string range $lib 2 end] + foreach dir $libdirs { + if {[file exists [file join $dir lib${lname}_G0.a]]} { + set lname ${lname}_G0 + break + } + } + lappend libs -l$lname + } else { + lappend libs $lib + } + } + set libraries $libs + + # Extract the module name from the "-o" option + + if {![info exists outputFile]} { + error "-o option must be supplied to link a Tcl load module" + } + set m [file tail $outputFile] + if {[regexp {\.a$} $outputFile]} { + set shlib_suffix .a + } else { + set shlib_suffix "" + } + if {[regexp {\..*$} $outputFile match]} { + set l [expr {[string length $m] - [string length $match]}] + } else { + error "Output file does not appear to have a suffix" + } + set modName [string tolower $m 0 [expr {$l-1}]] + if {[string match "lib*" $modName]} { + set modName [string range $modName 3 end] + } + if {[regexp {[0-9\.]*(_g0)?$} $modName match]} { + set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]] + } + set modName [string totitle $modName] + + # Catalog initialization entry points found in the module + + set f [open $nmCommand r] + while {[gets $f l] >= 0} { + if {[regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} { + if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} { + set s $symbol + } + append entryProtos {extern int } $symbol { (); } \n + append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n + } + } + close $f + + if {[string equal $entryPoints ""]} { + error "No entry point found in objects" + } + + # Compose a C function that resolves the initialization entry points and + # embeds the required libraries in the object code. + + set C {#include <string.h>} + append C \n + append C {char TclLoadLibraries_} $modName { [] =} \n + append C { "@LIBS: } $libraries {";} \n + append C $entryProtos + append C {static struct } \{ \n + append C { char * name;} \n + append C { int (*value)();} \n + append C \} {dictionary [] = } \{ \n + append C $entryPoints + append C { 0, 0 } \n \} \; \n + append C {typedef struct Tcl_Interp Tcl_Interp;} \n + append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n + append C {Tcl_PackageInitProc *} \n + append C TclLoadDictionary_ $modName { (symbol)} \n + append C { CONST char * symbol;} \n + append C { + { + int i; + for (i = 0; dictionary [i] . name != 0; ++i) { + if (!strcmp (symbol, dictionary [i] . name)) { + return dictionary [i].value; + } + } + return 0; + } + } + append C \n + + + # Write the C module and compile it + + set cFile tcl$modName.c + set f [open $cFile w] + puts -nonewline $f $C + close $f + set ccCommand "$cc -c $shlib_cflags $cFile" + puts stderr $ccCommand + eval exec $ccCommand + + # Now compose and execute the ld command that packages the module + + if {[string equal $shlib_suffix ".a"]} { + set ldCommand "ar cr $outputFile" + regsub { -o} $tail {} tail + } else { + set ldCommand ld + foreach item $head { + lappend ldCommand $item + } + } + lappend ldCommand tcl$modName.o + foreach item $tail { + lappend ldCommand $item + } + puts stderr $ldCommand + eval exec $ldCommand + if {[string equal $shlib_suffix ".a"]} { + exec ranlib $outputFile + } + + # Clean up working files + exec /bin/rm $cFile [file rootname $cFile].o +} |