# 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

}