diff options
Diffstat (limited to 'tkimg/tools/ldAout.tcl')
| -rw-r--r-- | tkimg/tools/ldAout.tcl | 240 |
1 files changed, 0 insertions, 240 deletions
diff --git a/tkimg/tools/ldAout.tcl b/tkimg/tools/ldAout.tcl deleted file mode 100644 index bf57d48..0000000 --- a/tkimg/tools/ldAout.tcl +++ /dev/null @@ -1,240 +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. -# -# SCCS: @(#) ldAout.tcl 1.11 96/09/17 09:02:20 -# -# 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 {$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 {$shlib_suffix==""} { - set shlib_cflags $env(SHLIB_CFLAGS) - } else { - if {$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 prototypes found in the - # module. - - set entryProtos {} - - # entryPoints is the table of 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 [string range $m 0 [expr $l-1]]] - if [regexp {^lib} $modName] { - set modName [string range $modName 3 end] - } - if [regexp {[0-9\.]*$} $modName match] { - set modName [string range $modName 0 [expr [string length $modName]-[string length $match]-1]] - } - set modName "[string toupper [string index $modName 0]][string range $modName 1 end]" - - # Catalog initialization entry points found in the module - - set f [open $nmCommand r] - while {[gets $f l] >= 0} { - if [regexp {[0-9A-Fa-f]+ T[ ]*(((Img_)|(g?z)|(adler32)|((un)?compress)|(crc32)|((in)|(de)flate)|(png_)|(jpeg_)|(_?TIFF)|(TT_))[a-zA-Z0-9_]*)} $l trash symbol] { - append entryProtos {extern int } $symbol { (); } \n - append entryPoints { } \{ { "} $symbol {", } $symbol { } \} , \n - } - } - close $f - - if {$entryPoints==""} { - error "No entry point found in objects" - } - - # Compose a C function that resolves the 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 { 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; -}} \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 {$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 - if [catch "exec $ldCommand" msg] { - puts stderr $msg - } - if {$shlib_suffix == ".a"} { - exec ranlib $outputFile - } - - # Clean up working files - - exec /bin/rm $cFile [file rootname $cFile].o -} |