# ldAout.tcl --

 #

 #	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.

 #

 # Parameters:

 #	The arguments to the script are the command line options for

 #	an "ld" command.

 #

 # Results:

 #	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

 # F33615-94-C-4400.

 proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {

     global env

     global argv

     if {[string equal $cc ""]} {

 	set cc $env(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

     set seenDotO 0

     # minusO is nonzero if the last command line argument was "-o".

     set minusO 0

     # head has command line arguments up to but not including the first

     # .o or .a file. tail has the rest of the arguments.

     set head {}

     set tail {}

     # nmCommand is the "nm" command that lists global symbols from the

     # object files.

     set nmCommand {|nm -g}

     # entryProtos is the table of _Init and _SafeInit prototypes found in the

     # module.

     set entryProtos {}

     # entryPoints is the table of _Init and _SafeInit entries found in the

     # module.

     set entryPoints {}

     # libraries is the list of -L and -l flags to the linker.

     set libraries {}

     set libdirs {}

     # Process command line arguments

     foreach a $argv {

 	if {!$minusO && [regexp {\.[ao]$} $a]} {

 	    set seenDotO 1

 	    lappend nmCommand $a

 	}

 	if {$minusO} {

 	    set outputFile $a

 	    set minusO 0

 	} elseif {![string compare $a -o]} {

 	    set minusO 1

 	}

 	if {[regexp {^-[lL]} $a]} {

 	    lappend libraries $a

 	    if {[regexp {^-L} $a]} {

 		lappend libdirs [string range $a 2 end]

 	    }

 	} elseif {$seenDotO} {

 	    lappend tail $a

 	} else {

 	    lappend head $a

 	}

     }

     lappend libdirs /lib /usr/lib

     # MIPS -- If there are corresponding G0 libraries, replace the

     # ordinary ones with the G0 ones.

     set libs {}

     foreach lib $libraries {

 	if {[regexp {^-l} $lib]} {

 	    set lname [string range $lib 2 end]

 	    foreach dir $libdirs {

 		if {[file exists [file join $dir lib${lname}_G0.a]]} {

 		    set lname ${lname}_G0

 		    break

 		}

 	    }

 	    lappend libs -l$lname

 	} else {

 	    lappend libs $lib

 	}

     }

     set libraries $libs

     # 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]} {

 	set shlib_suffix .a

     } else {

 	set shlib_suffix ""

     }

     if {[regexp {\..*$} $outputFile match]} {

 	set l [expr {[string length $m] - [string length $match]}]

     } else {

 	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]} {

 		set s $symbol

 	    }

 	    append entryProtos {extern int } $symbol { (); } \n

 	    append entryPoints {  } \{ { "} $s {", } $symbol { } \} , \n

 	}

     }

     close $f

     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 \n

     append C {char TclLoadLibraries_} $modName { [] =} \n

     append C {  "@LIBS: } $libraries {";} \n

     append C $entryProtos

     append C {static struct } \{ \n

     append C {  char * name;} \n

     append C {  int (*value)();} \n

     append C \} {dictionary [] = } \{ \n

     append C $entryPoints

     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

     append C {

 	{

 	    int i;

 	    for (i = 0; dictionary [i] . name != 0; ++i) {

 		if (!strcmp (symbol, dictionary [i] . name)) {

 		    return dictionary [i].value;

 		}

 	    }

 	    return 0;

 	}

     }

     append C \n

     # Write the C module and compile it

     set cFile tcl$modName.c

     set f [open $cFile w]

     puts -nonewline $f $C

     close $f

     set ccCommand "$cc -c $shlib_cflags $cFile"

     puts stderr $ccCommand

     eval exec $ccCommand

     # 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

     } else {

 	set ldCommand ld

 	foreach item $head {

 	    lappend ldCommand $item

 	}

     }

     lappend ldCommand tcl$modName.o

     foreach item $tail {

 	lappend ldCommand $item

     }

     puts stderr $ldCommand

     eval exec $ldCommand

     if {[string equal $shlib_suffix ".a"]} {

 	exec ranlib $outputFile

     }

     # Clean up working files

     exec /bin/rm $cFile [file rootname $cFile].o

 }