| # 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.5 2001/09/28 01:21:53 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 {[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 |
| } |