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