home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 September / WIN95_09962.iso / vrml / cp2b2x.exe / DATA.Z / ldaout.tcl < prev    next >
Text File  |  1996-04-23  |  5KB  |  169 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. # @(#) ldAout.tcl 1.2 95/09/05 15:58:22
  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 {} {
  33.   global env
  34.   global argv
  35.   
  36.   # seenDotO is nonzero if a .o or .a file has been seen
  37.  
  38.   set seenDotO 0
  39.  
  40.   # minusO is nonzero if the last command line argument was "-o".
  41.  
  42.   set minusO 0
  43.  
  44.   # head has command line arguments up to but not including the first
  45.   # .o or .a file. tail has the rest of the arguments.
  46.  
  47.   set head {}
  48.   set tail {}
  49.  
  50.   # nmCommand is the "nm" command that lists global symbols from the
  51.   # object files.
  52.  
  53.   set nmCommand {|nm -g}
  54.  
  55.   # entryPoints is the list of _Init and _SafeInit entries found in the
  56.   # module
  57.  
  58.   set entryPoints {}
  59.  
  60.   # libraries is the list of -L and -l flags to the linker.
  61.  
  62.   set libraries {}
  63.  
  64.   # Process command line arguments
  65.  
  66.   foreach a $argv {
  67.     if {!$minusO && [regexp {\.[ao]$} $a]} {
  68.       set seenDotO 1
  69.       lappend nmCommand $a
  70.     }
  71.     if {$minusO} {
  72.       set outputFile $a
  73.       set minusO 0
  74.     } elseif {![string compare $a -o]} {
  75.       set minusO 1
  76.     }
  77.     if {[regexp {^-[lL]} $a]} {
  78.       lappend libraries $a
  79.     } elseif {$seenDotO} {
  80.       lappend tail $a
  81.     } else {
  82.       lappend head $a
  83.     }
  84.   }
  85.  
  86.   # Extract the module name from the "-o" option
  87.  
  88.   if {![info exists outputFile]} {
  89.     error "-o option must be supplied to link a Tcl load module"
  90.   }
  91.   set m [file tail $outputFile]
  92.   set l [expr [string length $m] - [string length $env(SHLIB_SUFFIX)]]
  93.   if {[string compare [string range $m $l end] $env(SHLIB_SUFFIX)]} {
  94.     error "Output file does not appear to have a $env(SHLIB_SUFFIX) suffix"
  95.   }
  96.   set modName [string toupper [string index $m 0]]
  97.   append modName [string tolower [string range $m 1 [expr $l-1]]]
  98.   
  99.   # Catalog initialization entry points found in the module
  100.  
  101.   set f [open $nmCommand r]
  102.   while {[gets $f l] >= 0} {
  103.     if {[regexp { _?([A-Z][a-z0-9_]*_(Safe)?Init)$} $l trash symbol]} {
  104.       lappend entryPoints $symbol
  105.     }
  106.   }
  107.   close $f
  108.  
  109.   # Compose a C function that resolves the initialization entry points and
  110.   # embeds the required libraries in the object code.
  111.  
  112.   set C {#include <string.h>}
  113.   append C \n
  114.   append C {char TclLoadLibraries_} $modName { [] =} \n
  115.   append C {  "@LIBS: } $libraries {";} \n
  116.   foreach symbol $entryPoints {
  117.     append C {extern int } $symbol { (); } \n
  118.   }
  119.   append C {static struct } \{ \n
  120.   append C {  char * name;} \n
  121.   append C {  int (*value)();} \n
  122.   append C \} {dictionary [] = } \{ \n
  123.   foreach symbol $entryPoints {
  124.     append C {  } \{ { "} $symbol {", } $symbol { } \} , \n
  125.   }
  126.   append C {  0, 0 } \n \} \; \n
  127.   append C {typedef struct Tcl_Interp Tcl_Interp;} \n
  128.   append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n
  129.   append C {Tcl_PackageInitProc *} \n
  130.   append C TclLoadDictionary_ $modName { (symbol)} \n
  131.   append C {    char * symbol;} \n
  132.   append C {{
  133.     int i;
  134.     for (i = 0; dictionary [i] . name != 0; ++i) {
  135.       if (!strcmp (symbol, dictionary [i] . name)) {
  136.     return dictionary [i].value;
  137.       }
  138.     }
  139.     return 0;
  140. }} \n
  141.  
  142.   # Write the C module and compile it
  143.  
  144.   set cFile tcl$modName.c
  145.   set f [open $cFile w]
  146.   puts -nonewline $f $C
  147.   close $f
  148.   set ccCommand "$env(CC) -c $env(SHLIB_CFLAGS) $cFile"
  149.   puts stderr $ccCommand
  150.   eval exec $ccCommand
  151.  
  152.   # Now compose and execute the ld command that packages the module
  153.  
  154.   set ldCommand ld
  155.   foreach item $head {
  156.     lappend ldCommand $item
  157.   }
  158.   lappend ldCommand tcl$modName.o
  159.   foreach item $tail {
  160.     lappend ldCommand $item
  161.   }
  162.   puts stderr $ldCommand
  163.   eval exec $ldCommand
  164.  
  165.   # Clean up working files
  166.  
  167.   exec /bin/rm $cFile [file rootname $cFile].o
  168. }
  169.