Viewing file: ldAout.tcl (6.64 KB) -rw-r--r-- Select action/file-type: (+) | (+) | (+) | Code (+) | Session (+) | (+) | SDB (+) | (+) | (+) | (+) | (+) | (+) |
# 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 }
|