summaryrefslogtreecommitdiffstats
path: root/library/ldAout.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'library/ldAout.tcl')
-rw-r--r--library/ldAout.tcl231
1 files changed, 0 insertions, 231 deletions
diff --git a/library/ldAout.tcl b/library/ldAout.tcl
deleted file mode 100644
index bd520a3..0000000
--- a/library/ldAout.tcl
+++ /dev/null
@@ -1,231 +0,0 @@
-# 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.
-#
-# 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
-}