GitMe: inline 7z's install script
[msysgit.git] / mingw / lib / tcl8.4 / ldAout.tcl
blob243c6d4e4475fbd5de4aebd277a33a5f57f631b5
1 # ldAout.tcl --
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.
7 # Parameters:
8 # The arguments to the script are the command line options for
9 # an "ld" command.
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.
21 # RCS: @(#) $Id: ldAout.tcl,v 1.5 2001/09/28 01:21:53 dgp Exp $
23 # Copyright (c) 1995, by General Electric Company. All rights reserved.
25 # See the file "license.terms" for information on usage and redistribution
26 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
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.
32 proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
33 global env
34 global argv
36 if {[string equal $cc ""]} {
37 set cc $env(CC)
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.
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
52 # seenDotO is nonzero if a .o or .a file has been seen
53 set seenDotO 0
55 # minusO is nonzero if the last command line argument was "-o".
56 set minusO 0
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 {}
63 # nmCommand is the "nm" command that lists global symbols from the
64 # object files.
65 set nmCommand {|nm -g}
67 # entryProtos is the table of _Init and _SafeInit prototypes found in the
68 # module.
69 set entryProtos {}
71 # entryPoints is the table of _Init and _SafeInit entries found in the
72 # module.
73 set entryPoints {}
75 # libraries is the list of -L and -l flags to the linker.
76 set libraries {}
77 set libdirs {}
79 # Process command line arguments
80 foreach a $argv {
81 if {!$minusO && [regexp {\.[ao]$} $a]} {
82 set seenDotO 1
83 lappend nmCommand $a
85 if {$minusO} {
86 set outputFile $a
87 set minusO 0
88 } elseif {![string compare $a -o]} {
89 set minusO 1
91 if {[regexp {^-[lL]} $a]} {
92 lappend libraries $a
93 if {[regexp {^-L} $a]} {
94 lappend libdirs [string range $a 2 end]
96 } elseif {$seenDotO} {
97 lappend tail $a
98 } else {
99 lappend head $a
102 lappend libdirs /lib /usr/lib
104 # MIPS -- If there are corresponding G0 libraries, replace the
105 # ordinary ones with the G0 ones.
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
117 lappend libs -l$lname
118 } else {
119 lappend libs $lib
122 set libraries $libs
124 # Extract the module name from the "-o" option
126 if {![info exists outputFile]} {
127 error "-o option must be supplied to link a Tcl load module"
129 set m [file tail $outputFile]
130 if {[regexp {\.a$} $outputFile]} {
131 set shlib_suffix .a
132 } else {
133 set shlib_suffix ""
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"
140 set modName [string tolower $m 0 [expr {$l-1}]]
141 if {[regexp {^lib} $modName]} {
142 set modName [string range $modName 3 end]
144 if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
145 set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
147 set modName [string totitle $modName]
149 # Catalog initialization entry points found in the module
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
157 append entryProtos {extern int } $symbol { (); } \n
158 append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n
161 close $f
163 if {[string equal $entryPoints ""]} {
164 error "No entry point found in objects"
167 # Compose a C function that resolves the initialization entry points and
168 # embeds the required libraries in the object code.
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 { CONST char * symbol;} \n
186 append C {
188 int i;
189 for (i = 0; dictionary [i] . name != 0; ++i) {
190 if (!strcmp (symbol, dictionary [i] . name)) {
191 return dictionary [i].value;
194 return 0;
197 append C \n
200 # Write the C module and compile it
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
210 # Now compose and execute the ld command that packages the module
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
221 lappend ldCommand tcl$modName.o
222 foreach item $tail {
223 lappend ldCommand $item
225 puts stderr $ldCommand
226 eval exec $ldCommand
227 if {[string equal $shlib_suffix ".a"]} {
228 exec ranlib $outputFile
231 # Clean up working files
232 exec /bin/rm $cFile [file rootname $cFile].o