diff options
Diffstat (limited to 'library/ldAout.tcl')
| -rw-r--r-- | library/ldAout.tcl | 231 |
1 files changed, 0 insertions, 231 deletions
diff --git a/library/ldAout.tcl b/library/ldAout.tcl deleted file mode 100644 index bd520a3..0000000 --- a/library/ldAout.tcl +++ /dev/null @@ -1,231 +0,0 @@ -# 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. -# -# 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 {[regexp {^-[lL]} $a]} { - lappend libraries $a - if {[regexp {^-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 {[regexp {^-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 {[regexp {^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 -} |