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