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# SCCS: @(#) ldAout.tcl 1.11 96/09/17 09:02:20 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# modified 12/19/1996 by Andreas Kupries (a.kupries@westend.com) /aku/ 33# to allow usage for arbitrary libraries 34 35 36proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { 37 global env 38 global argv 39 40 if {$cc==""} { 41 set cc $env(CC) 42 } 43 44 # if only two parameters are supplied there is assumed that the 45 # only shlib_suffix is missing. This parameter is anyway available 46 # as "info sharedlibextension" too, so there is no need to transfer 47 # 3 parameters to the function tclLdAout. For compatibility, this 48 # function now accepts both 2 and 3 parameters. 49 50 if {$shlib_suffix==""} { 51 set shlib_cflags $env(SHLIB_CFLAGS) 52 } else { 53 if {$shlib_cflags=="none"} { 54 set shlib_cflags $shlib_suffix 55 } 56 } 57 58 # seenDotO is nonzero if a .o or .a file has been seen 59 60 set seenDotO 0 61 62 # minusO is nonzero if the last command line argument was "-o". 63 64 set minusO 0 65 66 # head has command line arguments up to but not including the first 67 # .o or .a file. tail has the rest of the arguments. 68 69 set head {} 70 set tail {} 71 72 # nmCommand is the "nm" command that lists global symbols from the 73 # object files. 74 75 set nmCommand {|nm -g} 76 77 # entryProtos is the table of prototypes found in the 78 # module. 79 80 set entryProtos {} 81 82 # entryPoints is the table of entries found in the 83 # module. 84 85 set entryPoints {} 86 87 # libraries is the list of -L and -l flags to the linker. 88 89 set libraries {} 90 set libdirs {} 91 92 # Process command line arguments 93 94 foreach a $argv { 95 if {!$minusO && [regexp {\.[ao]$} $a]} { 96 set seenDotO 1 97 lappend nmCommand $a 98 } 99 if {$minusO} { 100 set outputFile $a 101 set minusO 0 102 } elseif {![string compare $a -o]} { 103 set minusO 1 104 } 105 if [regexp {^-[lL]} $a] { 106 lappend libraries $a 107 if [regexp {^-L} $a] { 108 lappend libdirs [string range $a 2 end] 109 } 110 } elseif {$seenDotO} { 111 lappend tail $a 112 } else { 113 lappend head $a 114 } 115 } 116 lappend libdirs /lib /usr/lib 117 118 # MIPS -- If there are corresponding G0 libraries, replace the 119 # ordinary ones with the G0 ones. 120 121 set libs {} 122 foreach lib $libraries { 123 if [regexp {^-l} $lib] { 124 set lname [string range $lib 2 end] 125 foreach dir $libdirs { 126 if [file exists [file join $dir lib${lname}_G0.a]] { 127 set lname ${lname}_G0 128 break 129 } 130 } 131 lappend libs -l$lname 132 } else { 133 lappend libs $lib 134 } 135 } 136 set libraries $libs 137 138 # Extract the module name from the "-o" option 139 140 if {![info exists outputFile]} { 141 error "-o option must be supplied to link a Tcl load module" 142 } 143 set m [file tail $outputFile] 144 if [regexp {\.a$} $outputFile] { 145 set shlib_suffix .a 146 } else { 147 set shlib_suffix "" 148 } 149 if [regexp {\..*$} $outputFile match] { 150 set l [expr {[string length $m] - [string length $match]}] 151 } else { 152 error "Output file does not appear to have a suffix" 153 } 154 set modName [string tolower [string range $m 0 [expr {$l-1}]]] 155 if [regexp {^lib} $modName] { 156 set modName [string range $modName 3 end] 157 } 158 if [regexp {[0-9\.]*(_g0)?$} $modName match] { 159 set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]] 160 } 161 set modName "[string toupper [string index $modName 0]][string range $modName 1 end]" 162 163 # Catalog initialization entry points found in the module 164 # /aku/ use ALL globals, not only XX_(Safe)?Init 165 166 set f [open $nmCommand r] 167 while {[gets $f l] >= 0} { 168 if [regexp {[0-9A-Fa-f]+ T[ ]*([a-zA-Z0-9_]*)} $l trash symbol] { 169 append entryProtos {extern int } $symbol { (); } \n 170 append entryPoints { } \{ { "} $symbol {", } $symbol { } \} , \n 171 } 172 } 173 close $f 174 175 if {$entryPoints==""} { 176 error "No entry point found in objects" 177 } 178 179 # Compose a C function that resolves the entry points and 180 # embeds the required libraries in the object code. 181 182 set C {#include <string.h>} 183 append C \n 184 append C {char TclLoadLibraries_} $modName { [] =} \n 185 append C { "@LIBS: } $libraries {";} \n 186 append C $entryProtos 187 append C {static struct } \{ \n 188 append C { char * name;} \n 189 append C { int (*value)();} \n 190 append C \} {dictionary [] = } \{ \n 191 append C $entryPoints 192 append C \{ 0, 0 \} \n \} \; \n 193 append C {typedef struct Tcl_Interp Tcl_Interp;} \n 194 append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n 195 append C {Tcl_PackageInitProc *} \n 196 append C TclLoadDictionary_ $modName { (symbol)} \n 197 append C { char * symbol;} \n 198 append C {{ 199 int i; 200 for (i = 0; dictionary [i] . name != 0; ++i) { 201 if (!strcmp (symbol, dictionary [i] . name)) { 202 return dictionary [i].value; 203 } 204 } 205 return 0; 206}} \n 207 208 # Write the C module and compile it 209 210 set cFile tcl$modName.c 211 set f [open $cFile w] 212 puts -nonewline $f $C 213 close $f 214 set ccCommand "$cc -c $shlib_cflags $cFile" 215 puts stderr $ccCommand 216 eval exec $ccCommand 217 218 # Now compose and execute the ld command that packages the module 219 220 if {$shlib_suffix == ".a"} { 221 set ldCommand "ar cr $outputFile" 222 regsub { -o} $tail {} tail 223 } else { 224 set ldCommand ld 225 foreach item $head { 226 lappend ldCommand $item 227 } 228 } 229 lappend ldCommand tcl$modName.o 230 foreach item $tail { 231 lappend ldCommand $item 232 } 233 puts stderr $ldCommand 234 if [catch "exec $ldCommand" msg] { 235 puts stderr $msg 236 } 237 if {$shlib_suffix == ".a"} { 238 exec ranlib $outputFile 239 } 240 241 # Clean up working files 242 243 exec /bin/rm $cFile [file rootname $cFile].o 244} 245