# This "tclldAout" procedure in this script acts as a replacement
# for the "ld" command when linking an object file that will be
# loaded dynamically into Tcl or Tk using pseudo-static linking.
# The arguments to the script are the command line options for
# The "ld" command is parsed, and the "-o" option determines the
# module name. ".a" and ".o" options are accumulated.
# The input archives and object files are examined with the "nm"
# command to determine whether the modules initialization
# entry and safe initialization entry are present. A trivial
# C function that locates the entries is composed, compiled, and
# its .o file placed before all others in the command; then
# "ld" is executed to bind the objects together.
# RCS: @(#) $Id: ldAout.tcl,v 1.5 2001/09/28 01:21:53 dgp Exp $
# Copyright (c) 1995, by General Electric Company. All rights reserved.
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# This work was supported in part by the ARPA Manufacturing Automation
# and Design Engineering (MADE) Initiative through ARPA contract
proc tclLdAout
{{cc
{}} {shlib_suffix
{}} {shlib_cflags none
}} {
if {[string equal
$cc ""]} {
# if only two parameters are supplied there is assumed that the
# only shlib_suffix is missing. This parameter is anyway available
# as "info sharedlibextension" too, so there is no need to transfer
# 3 parameters to the function tclLdAout. For compatibility, this
# function now accepts both 2 and 3 parameters.
if {[string equal
$shlib_suffix ""]} {
set shlib_cflags
$env(SHLIB_CFLAGS
)
} elseif
{[string equal
$shlib_cflags "none"]} {
set shlib_cflags
$shlib_suffix
# seenDotO is nonzero if a .o or .a file has been seen
# minusO is nonzero if the last command line argument was "-o".
# head has command line arguments up to but not including the first
# .o or .a file. tail has the rest of the arguments.
# nmCommand is the "nm" command that lists global symbols from the
# entryProtos is the table of _Init and _SafeInit prototypes found in the
# entryPoints is the table of _Init and _SafeInit entries found in the
# libraries is the list of -L and -l flags to the linker.
# Process command line arguments
if {!$minusO && [regexp {\.
[ao
]$} $a]} {
} elseif
{![string compare
$a -o]} {
if {[regexp {^
-[lL
]} $a]} {
lappend libdirs
[string range
$a 2 end
]
lappend libdirs
/lib
/usr
/lib
# MIPS -- If there are corresponding G0 libraries, replace the
# ordinary ones with the G0 ones.
if {[regexp {^
-l} $lib]} {
set lname
[string range
$lib 2 end
]
if {[file exists
[file join $dir lib
${lname
}_G0.a
]]} {
# Extract the module name from the "-o" option
if {![info exists outputFile
]} {
error "-o option must be supplied to link a Tcl load module"
set m
[file tail
$outputFile]
if {[regexp {\.a
$} $outputFile]} {
if {[regexp {\..
*$} $outputFile match
]} {
set l
[expr {[string length
$m] - [string length
$match]}]
error "Output file does not appear to have a suffix"
set modName
[string tolower
$m 0 [expr {$l-1}]]
if {[regexp {^lib
} $modName]} {
set modName
[string range
$modName 3 end
]
if {[regexp {[0-9\.
]*(_g0
)?
$} $modName match
]} {
set modName
[string range
$modName 0 [expr {[string length
$modName]-[string length
$match]-1}]]
set modName
[string totitle
$modName]
# Catalog initialization entry points found in the module
set f
[open $nmCommand r
]
while {[gets $f l
] >= 0} {
if {[regexp {T
[ ]*_?
([A-Z
][a-z0-9_
]*_
(Safe)?Init
(__FP10Tcl_Interp
)?
)$} $l trash symbol
]} {
if {![regexp {_?
([A-Z
][a-z0-9_
]*_
(Safe)?Init
)} $symbol trash s
]} {
append entryProtos
{extern int
} $symbol { (); } \n
append entryPoints
{ } \{ { "} $s {", } $symbol { } \} , \n
if {[string equal
$entryPoints ""]} {
error "No entry point found in objects"
# Compose a C function that resolves the initialization entry points and
# embeds the required libraries in the object code.
set C
{#include <string.h>}
append C
{char TclLoadLibraries_
} $modName { [] =} \n
append C
{ "@LIBS: } $libraries {";} \n
append C
{static struct
} \{ \n
append C
{ char
* name
;} \n
append C
{ int
(*value
)();} \n
append C
\} {dictionary
[] = } \{ \n
append C
{ 0, 0 } \n \} \; \n
append C
{typedef struct Tcl_Interp Tcl_Interp
;} \n
append C
{typedef int Tcl_PackageInitProc
(Tcl_Interp
*);} \n
append C
{Tcl_PackageInitProc
*} \n
append C TclLoadDictionary_
$modName { (symbol
)} \n
append C
{ CONST char
* symbol
;} \n
for (i
= 0; dictionary
[i
] . name
!= 0; ++i
) {
if (!strcmp
(symbol
, dictionary
[i
] . name
)) {
return dictionary
[i
].value
;
# Write the C module and compile it
set ccCommand
"$cc -c $shlib_cflags $cFile"
# Now compose and execute the ld command that packages the module
if {[string equal
$shlib_suffix ".a"]} {
set ldCommand
"ar cr $outputFile"
regsub { -o} $tail {} tail
lappend ldCommand tcl
$modName.o
if {[string equal
$shlib_suffix ".a"]} {
exec /bin
/rm
$cFile [file rootname
$cFile].o