I386LINUX/util/I386LINUX/lib/tcl8.3/ldAout.tcl

   1 # ldAout.tcl --
   2 #
   3 #       This "tclldAout" procedure in this script acts as a replacement
   4 #       for the "ld" command when linking an object file that will be
   5 #       loaded dynamically into Tcl or Tk using pseudo-static linking.
   6 #
   7 # Parameters:
   8 #       The arguments to the script are the command line options for
   9 #       an "ld" command.
  10 #
  11 # Results:
  12 #       The "ld" command is parsed, and the "-o" option determines the
  13 #       module name.  ".a" and ".o" options are accumulated.
  14 #       The input archives and object files are examined with the "nm"
  15 #       command to determine whether the modules initialization
  16 #       entry and safe initialization entry are present.  A trivial
  17 #       C function that locates the entries is composed, compiled, and
  18 #       its .o file placed before all others in the command; then
  19 #       "ld" is executed to bind the objects together.
  20 #
  21 # RCS: @(#) $Id: ldAout.tcl,v 1.4 1999/08/19 02:59:40 hobbs Exp $
  22 #
  23 # Copyright (c) 1995, by General Electric Company. All rights reserved.
  24 #
  25 # See the file "license.terms" for information on usage and redistribution
  26 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  27 #
  28 # This work was supported in part by the ARPA Manufacturing Automation
  29 # and Design Engineering (MADE) Initiative through ARPA contract
  30 # F33615-94-C-4400.
  31
  32 proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
  33     global env
  34     global argv
  35
  36     if {[string equal $cc ""]} {
  37         set cc $env(CC)
  38     }
  39
  40     # if only two parameters are supplied there is assumed that the
  41     # only shlib_suffix is missing. This parameter is anyway available
  42     # as "info sharedlibextension" too, so there is no need to transfer
  43     # 3 parameters to the function tclLdAout. For compatibility, this
  44     # function now accepts both 2 and 3 parameters.
  45
  46     if {[string equal $shlib_suffix ""]} {
  47         set shlib_cflags $env(SHLIB_CFLAGS)
  48     } elseif {[string equal $shlib_cflags "none"]} {
  49         set shlib_cflags $shlib_suffix
  50     }
  51
  52     # seenDotO is nonzero if a .o or .a file has been seen
  53     set seenDotO 0
  54
  55     # minusO is nonzero if the last command line argument was "-o".
  56     set minusO 0
  57
  58     # head has command line arguments up to but not including the first
  59     # .o or .a file. tail has the rest of the arguments.
  60     set head {}
  61     set tail {}
  62
  63     # nmCommand is the "nm" command that lists global symbols from the
  64     # object files.
  65     set nmCommand {|nm -g}
  66
  67     # entryProtos is the table of _Init and _SafeInit prototypes found in the
  68     # module.
  69     set entryProtos {}
  70
  71     # entryPoints is the table of _Init and _SafeInit entries found in the
  72     # module.
  73     set entryPoints {}
  74
  75     # libraries is the list of -L and -l flags to the linker.
  76     set libraries {}
  77     set libdirs {}
  78
  79     # Process command line arguments
  80     foreach a $argv {
  81         if {!$minusO && [regexp {\.[ao]$} $a]} {
  82             set seenDotO 1
  83             lappend nmCommand $a
  84         }
  85         if {$minusO} {
  86             set outputFile $a
  87             set minusO 0
  88         } elseif {![string compare $a -o]} {
  89             set minusO 1
  90         }
  91         if {[regexp {^-[lL]} $a]} {
  92             lappend libraries $a
  93             if {[regexp {^-L} $a]} {
  94                 lappend libdirs [string range $a 2 end]
  95             }
  96         } elseif {$seenDotO} {
  97             lappend tail $a
  98         } else {
  99             lappend head $a
 100         }
 101     }
 102     lappend libdirs /lib /usr/lib
 103
 104     # MIPS -- If there are corresponding G0 libraries, replace the
 105     # ordinary ones with the G0 ones.
 106
 107     set libs {}
 108     foreach lib $libraries {
 109         if {[regexp {^-l} $lib]} {
 110             set lname [string range $lib 2 end]
 111             foreach dir $libdirs {
 112                 if {[file exists [file join $dir lib${lname}_G0.a]]} {
 113                     set lname ${lname}_G0
 114                     break
 115                 }
 116             }
 117             lappend libs -l$lname
 118         } else {
 119             lappend libs $lib
 120         }
 121     }
 122     set libraries $libs
 123
 124     # Extract the module name from the "-o" option
 125
 126     if {![info exists outputFile]} {
 127         error "-o option must be supplied to link a Tcl load module"
 128     }
 129     set m [file tail $outputFile]
 130     if {[regexp {\.a$} $outputFile]} {
 131         set shlib_suffix .a
 132     } else {
 133         set shlib_suffix ""
 134     }
 135     if {[regexp {\..*$} $outputFile match]} {
 136         set l [expr {[string length $m] - [string length $match]}]
 137     } else {
 138         error "Output file does not appear to have a suffix"
 139     }
 140     set modName [string tolower $m 0 [expr {$l-1}]]
 141     if {[regexp {^lib} $modName]} {
 142         set modName [string range $modName 3 end]
 143     }
 144     if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
 145         set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
 146     }
 147     set modName [string totitle $modName]
 148
 149     # Catalog initialization entry points found in the module
 150
 151     set f [open $nmCommand r]
 152     while {[gets $f l] >= 0} {
 153         if {[regexp {T[         ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
 154             if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
 155                 set s $symbol
 156             }
 157             append entryProtos {extern int } $symbol { (); } \n
 158             append entryPoints {  } \{ { "} $s {", } $symbol { } \} , \n
 159         }
 160     }
 161     close $f
 162
 163     if {[string equal $entryPoints ""]} {
 164         error "No entry point found in objects"
 165     }
 166
 167     # Compose a C function that resolves the initialization entry points and
 168     # embeds the required libraries in the object code.
 169
 170     set C {#include <string.h>}
 171     append C \n
 172     append C {char TclLoadLibraries_} $modName { [] =} \n
 173     append C {  "@LIBS: } $libraries {";} \n
 174     append C $entryProtos
 175     append C {static struct } \{ \n
 176     append C {  char * name;} \n
 177     append C {  int (*value)();} \n
 178     append C \} {dictionary [] = } \{ \n
 179     append C $entryPoints
 180     append C {  0, 0 } \n \} \; \n
 181     append C {typedef struct Tcl_Interp Tcl_Interp;} \n
 182     append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
 183     append C {Tcl_PackageInitProc *} \n
 184     append C TclLoadDictionary_ $modName { (symbol)} \n
 185     append C {    char * symbol;} \n
 186     append C {
 187         {
 188             int i;
 189             for (i = 0; dictionary [i] . name != 0; ++i) {
 190                 if (!strcmp (symbol, dictionary [i] . name)) {
 191                     return dictionary [i].value;
 192                 }
 193             }
 194             return 0;
 195         }
 196     }
 197     append C \n
 198
 199
 200     # Write the C module and compile it
 201
 202     set cFile tcl$modName.c
 203     set f [open $cFile w]
 204     puts -nonewline $f $C
 205     close $f
 206     set ccCommand "$cc -c $shlib_cflags $cFile"
 207     puts stderr $ccCommand
 208     eval exec $ccCommand
 209
 210     # Now compose and execute the ld command that packages the module
 211
 212     if {[string equal $shlib_suffix ".a"]} {
 213         set ldCommand "ar cr $outputFile"
 214         regsub { -o} $tail {} tail
 215     } else {
 216         set ldCommand ld
 217         foreach item $head {
 218             lappend ldCommand $item
 219         }
 220     }
 221     lappend ldCommand tcl$modName.o
 222     foreach item $tail {
 223         lappend ldCommand $item
 224     }
 225     puts stderr $ldCommand
 226     eval exec $ldCommand
 227     if {[string equal $shlib_suffix ".a"]} {
 228         exec ranlib $outputFile
 229     }
 230
 231     # Clean up working files
 232     exec /bin/rm $cFile [file rootname $cFile].o
 233 }