Commit | Line | Data |
---|---|---|
920dae64 AT |
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.5 2001/09/28 01:21:53 dgp 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 { CONST 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 | } |