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