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.
8 # The arguments to the script are the command line options for
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
32 proc tclLdAout
{{cc
{}} {shlib_suffix
{}} {shlib_cflags none
}} {
36 if {[string equal
$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
55 # minusO is nonzero if the last command line argument was "-o".
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.
63 # nmCommand is the "nm" command that lists global symbols from the
65 set nmCommand
{|nm
-g}
67 # entryProtos is the table of _Init and _SafeInit prototypes found in the
71 # entryPoints is the table of _Init and _SafeInit entries found in the
75 # libraries is the list of -L and -l flags to the linker.
79 # Process command line arguments
81 if {!$minusO && [regexp {\.
[ao
]$} $a]} {
88 } elseif
{![string compare
$a -o]} {
91 if {[regexp {^
-[lL
]} $a]} {
93 if {[regexp {^
-L} $a]} {
94 lappend libdirs
[string range
$a 2 end
]
96 } elseif
{$seenDotO} {
102 lappend libdirs
/lib
/usr
/lib
104 # MIPS -- If there are corresponding G0 libraries, replace the
105 # ordinary ones with the G0 ones.
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
117 lappend libs
-l$lname
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]} {
135 if {[regexp {\..
*$} $outputFile match
]} {
136 set l
[expr {[string length
$m] - [string length
$match]}]
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
]} {
157 append entryProtos
{extern int
} $symbol { (); } \n
158 append entryPoints
{ } \{ { "} $s {", } $symbol { } \} , \n
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>}
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
189 for (i
= 0; dictionary
[i
] . name
!= 0; ++i
) {
190 if (!strcmp
(symbol
, dictionary
[i
] . name
)) {
191 return dictionary
[i
].value
;
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
206 set ccCommand
"$cc -c $shlib_cflags $cFile"
207 puts stderr
$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
218 lappend ldCommand
$item
221 lappend ldCommand tcl
$modName.o
223 lappend ldCommand
$item
225 puts stderr
$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