home *** CD-ROM | disk | FTP | other *** search
/ PC World 2005 June / PCWorld_2005-06_cd.bin / software / vyzkuste / firewally / firewally.exe / framework-2.3.exe / ldAout.tcl < prev    next >
Text File  |  2003-09-01  |  7KB  |  234 lines
  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. # RCS: @(#) $Id: ldAout.tcl,v 1.5 2001/09/28 01:21:53 dgp Exp $
  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. proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} {
  33.     global env
  34.     global argv
  35.  
  36.     if {[string equal $cc ""]} {
  37.     set cc $env(CC)
  38.     }
  39.  
  40.     # if only two parameters are supplied there is assumed that the
  41.     # only shlib_suffix is missing. This parameter is anyway available
  42.     # as "info sharedlibextension" too, so there is no need to transfer
  43.     # 3 parameters to the function tclLdAout. For compatibility, this
  44.     # function now accepts both 2 and 3 parameters.
  45.  
  46.     if {[string equal $shlib_suffix ""]} {
  47.     set shlib_cflags $env(SHLIB_CFLAGS)
  48.     } elseif {[string equal $shlib_cflags "none"]} {
  49.     set shlib_cflags $shlib_suffix
  50.     }
  51.  
  52.     # seenDotO is nonzero if a .o or .a file has been seen
  53.     set seenDotO 0
  54.  
  55.     # minusO is nonzero if the last command line argument was "-o".
  56.     set minusO 0
  57.  
  58.     # head has command line arguments up to but not including the first
  59.     # .o or .a file. tail has the rest of the arguments.
  60.     set head {}
  61.     set tail {}
  62.  
  63.     # nmCommand is the "nm" command that lists global symbols from the
  64.     # object files.
  65.     set nmCommand {|nm -g}
  66.  
  67.     # entryProtos is the table of _Init and _SafeInit prototypes found in the
  68.     # module.
  69.     set entryProtos {}
  70.  
  71.     # entryPoints is the table of _Init and _SafeInit entries found in the
  72.     # module.
  73.     set entryPoints {}
  74.  
  75.     # libraries is the list of -L and -l flags to the linker.
  76.     set libraries {}
  77.     set libdirs {}
  78.  
  79.     # Process command line arguments
  80.     foreach a $argv {
  81.     if {!$minusO && [regexp {\.[ao]$} $a]} {
  82.         set seenDotO 1
  83.         lappend nmCommand $a
  84.     }
  85.     if {$minusO} {
  86.         set outputFile $a
  87.         set minusO 0
  88.     } elseif {![string compare $a -o]} {
  89.         set minusO 1
  90.     }
  91.     if {[regexp {^-[lL]} $a]} {
  92.         lappend libraries $a
  93.         if {[regexp {^-L} $a]} {
  94.         lappend libdirs [string range $a 2 end]
  95.         }
  96.     } elseif {$seenDotO} {
  97.         lappend tail $a
  98.     } else {
  99.         lappend head $a
  100.     }
  101.     }
  102.     lappend libdirs /lib /usr/lib
  103.  
  104.     # MIPS -- If there are corresponding G0 libraries, replace the
  105.     # ordinary ones with the G0 ones.
  106.  
  107.     set libs {}
  108.     foreach lib $libraries {
  109.     if {[regexp {^-l} $lib]} {
  110.         set lname [string range $lib 2 end]
  111.         foreach dir $libdirs {
  112.         if {[file exists [file join $dir lib${lname}_G0.a]]} {
  113.             set lname ${lname}_G0
  114.             break
  115.         }
  116.         }
  117.         lappend libs -l$lname
  118.     } else {
  119.         lappend libs $lib
  120.     }
  121.     }
  122.     set libraries $libs
  123.  
  124.     # Extract the module name from the "-o" option
  125.  
  126.     if {![info exists outputFile]} {
  127.     error "-o option must be supplied to link a Tcl load module"
  128.     }
  129.     set m [file tail $outputFile]
  130.     if {[regexp {\.a$} $outputFile]} {
  131.     set shlib_suffix .a
  132.     } else {
  133.     set shlib_suffix ""
  134.     }
  135.     if {[regexp {\..*$} $outputFile match]} {
  136.     set l [expr {[string length $m] - [string length $match]}]
  137.     } else {
  138.     error "Output file does not appear to have a suffix"
  139.     }
  140.     set modName [string tolower $m 0 [expr {$l-1}]]
  141.     if {[regexp {^lib} $modName]} {
  142.     set modName [string range $modName 3 end]
  143.     }
  144.     if {[regexp {[0-9\.]*(_g0)?$} $modName match]} {
  145.     set modName [string range $modName 0 [expr {[string length $modName]-[string length $match]-1}]]
  146.     }
  147.     set modName [string totitle $modName]
  148.  
  149.     # Catalog initialization entry points found in the module
  150.  
  151.     set f [open $nmCommand r]
  152.     while {[gets $f l] >= 0} {
  153.     if {[regexp {T[     ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol]} {
  154.         if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} {
  155.         set s $symbol
  156.         }
  157.         append entryProtos {extern int } $symbol { (); } \n
  158.         append entryPoints {  } \{ { "} $s {", } $symbol { } \} , \n
  159.     }
  160.     }
  161.     close $f
  162.  
  163.     if {[string equal $entryPoints ""]} {
  164.     error "No entry point found in objects"
  165.     }
  166.  
  167.     # Compose a C function that resolves the initialization entry points and
  168.     # embeds the required libraries in the object code.
  169.  
  170.     set C {#include <string.h>}
  171.     append C \n
  172.     append C {char TclLoadLibraries_} $modName { [] =} \n
  173.     append C {  "@LIBS: } $libraries {";} \n
  174.     append C $entryProtos
  175.     append C {static struct } \{ \n
  176.     append C {  char * name;} \n
  177.     append C {  int (*value)();} \n
  178.     append C \} {dictionary [] = } \{ \n
  179.     append C $entryPoints
  180.     append C {  0, 0 } \n \} \; \n
  181.     append C {typedef struct Tcl_Interp Tcl_Interp;} \n
  182.     append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
  183.     append C {Tcl_PackageInitProc *} \n
  184.     append C TclLoadDictionary_ $modName { (symbol)} \n
  185.     append C {    CONST char * symbol;} \n
  186.     append C {
  187.     {
  188.         int i;
  189.         for (i = 0; dictionary [i] . name != 0; ++i) {
  190.         if (!strcmp (symbol, dictionary [i] . name)) {
  191.             return dictionary [i].value;
  192.         }
  193.         }
  194.         return 0;
  195.     }
  196.     }
  197.     append C \n
  198.  
  199.  
  200.     # Write the C module and compile it
  201.  
  202.     set cFile tcl$modName.c
  203.     set f [open $cFile w]
  204.     puts -nonewline $f $C
  205.     close $f
  206.     set ccCommand "$cc -c $shlib_cflags $cFile"
  207.     puts stderr $ccCommand
  208.     eval exec $ccCommand
  209.  
  210.     # Now compose and execute the ld command that packages the module
  211.  
  212.     if {[string equal $shlib_suffix ".a"]} {
  213.     set ldCommand "ar cr $outputFile"
  214.     regsub { -o} $tail {} tail
  215.     } else {
  216.     set ldCommand ld
  217.     foreach item $head {
  218.         lappend ldCommand $item
  219.     }
  220.     }
  221.     lappend ldCommand tcl$modName.o
  222.     foreach item $tail {
  223.     lappend ldCommand $item
  224.     }
  225.     puts stderr $ldCommand
  226.     eval exec $ldCommand
  227.     if {[string equal $shlib_suffix ".a"]} {
  228.     exec ranlib $outputFile
  229.     }
  230.  
  231.     # Clean up working files
  232.     exec /bin/rm $cFile [file rootname $cFile].o
  233. }
  234.