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