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 32proc 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} 234