home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / unix / tclLoadAout.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  12.9 KB  |  471 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclLoadAout.c --
  3.  *
  4.  *    This procedure provides a version of the TclLoadFile that
  5.  *    provides pseudo-static linking using version-7 compatible
  6.  *    a.out files described in either sys/exec.h or sys/a.out.h.
  7.  *
  8.  * Copyright (c) 1995, by General Electric Company. All rights reserved.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * This work was supported in part by the ARPA Manufacturing Automation
  14.  * and Design Engineering (MADE) Initiative through ARPA contract
  15.  * F33615-94-C-4400.
  16.  *
  17.  * SCCS: @(#) tclLoadAout.c 1.9 97/02/22 14:05:01
  18.  */
  19.  
  20. #include "tclInt.h"
  21. #include <fcntl.h>
  22. #ifdef HAVE_EXEC_AOUT_H
  23. #   include <sys/exec_aout.h>
  24. #endif
  25.  
  26. /*
  27.  * Some systems describe the a.out header in sys/exec.h, and some in
  28.  * a.out.h.
  29.  */
  30.  
  31. #ifdef USE_SYS_EXEC_H
  32. #include <sys/exec.h>
  33. #endif
  34. #ifdef USE_A_OUT_H
  35. #include <a.out.h>
  36. #endif
  37. #ifdef USE_SYS_EXEC_AOUT_H
  38. #include <sys/exec_aout.h>
  39. #define a_magic a_midmag
  40. #endif
  41.  
  42. /*
  43.  * TCL_LOADSHIM is the amount by which to shim the break when loading
  44.  */
  45.  
  46. #ifndef TCL_LOADSHIM
  47. #define TCL_LOADSHIM 0x4000L
  48. #endif
  49.  
  50. /*
  51.  * TCL_LOADALIGN must be a power of 2, and is the alignment to which
  52.  * to force the origin of load modules
  53.  */
  54.  
  55. #ifndef TCL_LOADALIGN
  56. #define TCL_LOADALIGN 0x4000L
  57. #endif
  58.  
  59. /*
  60.  * TCL_LOADMAX is the maximum size of a load module, and is used as
  61.  * a sanity check when loading
  62.  */
  63.  
  64. #ifndef TCL_LOADMAX
  65. #define TCL_LOADMAX 2000000L
  66. #endif
  67.  
  68. /*
  69.  * Kernel calls that appear to be missing from the system .h files:
  70.  */
  71.  
  72. extern char * brk _ANSI_ARGS_((char *));
  73. extern char * sbrk _ANSI_ARGS_((size_t));
  74.  
  75. /*
  76.  * The static variable SymbolTableFile contains the file name where the
  77.  * result of the last link was stored.  The file is kept because doing so
  78.  * allows one load module to use the symbols defined in another.
  79.  */
  80.  
  81. static char * SymbolTableFile = NULL;
  82.  
  83. /*
  84.  * Type of the dictionary function that begins each load module.
  85.  */
  86.  
  87. typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((char * symbol));
  88.  
  89. /*
  90.  * Prototypes for procedures referenced only in this file:
  91.  */
  92.  
  93. static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, char * fileName,
  94.                       Tcl_DString * buf));
  95. static void UnlinkSymbolTable _ANSI_ARGS_((void));
  96.  
  97. /*
  98.  *----------------------------------------------------------------------
  99.  *
  100.  * TclLoadFile --
  101.  *
  102.  *    Dynamically loads a binary code file into memory and returns
  103.  *    the addresses of two procedures within that file, if they
  104.  *    are defined.
  105.  *
  106.  * Results:
  107.  *    A standard Tcl completion code.  If an error occurs, an error
  108.  *    message is left in interp->result.  *proc1Ptr and *proc2Ptr
  109.  *    are filled in with the addresses of the symbols given by
  110.  *    *sym1 and *sym2, or NULL if those symbols can't be found.
  111.  *
  112.  * Side effects:
  113.  *    New code suddenly appears in memory.
  114.  *
  115.  *
  116.  * Bugs:
  117.  *    This function does not attempt to handle the case where the
  118.  *    BSS segment is not executable.  It will therefore fail on
  119.  *    Encore Multimax, Pyramid 90x, and similar machines.  The
  120.  *    reason is that the mprotect() kernel call, which would
  121.  *    otherwise be employed to mark the newly-loaded text segment
  122.  *    executable, results in a system crash on BSD/386.
  123.  *
  124.  *    In an effort to make it fast, this function eschews the
  125.  *    technique of linking the load module once, reading its header
  126.  *    to determine its size, allocating memory for it, and linking
  127.  *    it again.  Instead, it `shims out' memory allocation by
  128.  *    placing the module TCL_LOADSHIM bytes beyond the break,
  129.  *    and assuming that any malloc() calls required to run the
  130.  *    linker will not advance the break beyond that point.  If
  131.  *    the break is advanced beyonnd that point, the load will
  132.  *    fail with an `inconsistent memory allocation' error.
  133.  *    It perhaps ought to retry the link, but the failure has
  134.  *    not been observed in two years of daily use of this function.
  135.  *----------------------------------------------------------------------
  136.  */
  137.  
  138. int
  139. TclLoadFile(interp, fileName, sym1, sym2, proc1Ptr, proc2Ptr)
  140.     Tcl_Interp *interp;        /* Used for error reporting. */
  141.     char *fileName;        /* Name of the file containing the desired
  142.                  * code. */
  143.     char *sym1, *sym2;        /* Names of two procedures to look up in
  144.                  * the file's symbol table. */
  145.     Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
  146.                 /* Where to return the addresses corresponding
  147.                  * to sym1 and sym2. */
  148. {
  149.   char * inputSymbolTable;    /* Name of the file containing the 
  150.                  * symbol table from the last link. */
  151.   Tcl_DString linkCommandBuf;    /* Command to do the run-time relocation
  152.                  * of the module.*/
  153.   char * linkCommand;
  154.   char relocatedFileName [L_tmpnam];
  155.                 /* Name of the file holding the relocated */
  156.                 /* text of the module */
  157.   int relocatedFd;        /* File descriptor of the file holding
  158.                  * relocated text */
  159.   struct exec relocatedHead;    /* Header of the relocated text */
  160.   unsigned long relocatedSize;    /* Size of the relocated text */
  161.   char * startAddress;        /* Starting address of the module */
  162.   DictFn dictionary;        /* Dictionary function in the load module */
  163.   int status;            /* Status return from Tcl_ calls */
  164.   char * p;
  165.  
  166.   /* Find the file that contains the symbols for the run-time link. */
  167.  
  168.   if (SymbolTableFile != NULL) {
  169.     inputSymbolTable = SymbolTableFile;
  170.   } else if (tclExecutableName == NULL) {
  171.     Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC);
  172.     return TCL_ERROR;
  173.   } else {
  174.     inputSymbolTable = tclExecutableName;
  175.   }
  176.  
  177.   /* Construct the `ld' command that builds the relocated module */
  178.  
  179.   tmpnam (relocatedFileName);
  180.   Tcl_DStringInit (&linkCommandBuf);
  181.   Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);
  182.   Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);
  183. #if defined(__mips) || defined(mips)
  184.   Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
  185. #endif
  186.   Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
  187.   TclGuessPackageName(fileName, &linkCommandBuf);
  188.   Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
  189.   Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
  190.   Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
  191.   Tcl_DStringAppend (&linkCommandBuf, fileName, -1);
  192.   Tcl_DStringAppend (&linkCommandBuf, " ", -1);
  193.   if (FindLibraries (interp, fileName, &linkCommandBuf) != TCL_OK) {
  194.     Tcl_DStringFree (&linkCommandBuf);
  195.     return TCL_ERROR;
  196.   }
  197.   linkCommand = Tcl_DStringValue (&linkCommandBuf);
  198.  
  199.   /* Determine the starting address, and plug it into the command */
  200.   
  201.   startAddress = (char *) (((unsigned long) sbrk (0)
  202.                 + TCL_LOADSHIM + TCL_LOADALIGN - 1)
  203.                & (- TCL_LOADALIGN));
  204.   p = strstr (linkCommand, "-T") + 3;
  205.   sprintf (p, "%08lx", (long) startAddress);
  206.   p [8] = ' ';
  207.  
  208.   /* Run the linker */
  209.  
  210.   status = Tcl_Eval (interp, linkCommand);
  211.   Tcl_DStringFree (&linkCommandBuf);
  212.   if (status != 0) {
  213.     return TCL_ERROR;
  214.   }
  215.  
  216.   /* Open the linker's result file and read the header */
  217.  
  218.   relocatedFd = open (relocatedFileName, O_RDONLY);
  219.   if (relocatedFd < 0) {
  220.     goto ioError;
  221.   }
  222.   status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);
  223.   if (status < sizeof relocatedHead) {
  224.     goto ioError;
  225.   }
  226.  
  227.   /* Check the magic number */
  228.  
  229.   if (relocatedHead.a_magic != OMAGIC) {
  230.     Tcl_AppendResult (interp, "bad magic number in intermediate file \"",
  231.               relocatedFileName, "\"", (char *) NULL);
  232.     goto failure;
  233.   }
  234.  
  235.   /* Make sure that memory allocation is still consistent */
  236.  
  237.   if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {
  238.     Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.",
  239.            TCL_STATIC);
  240.     goto failure;
  241.   }
  242.  
  243.   /* Make sure that the relocated module's size is reasonable */
  244.  
  245.   relocatedSize = relocatedHead.a_text + relocatedHead.a_data
  246.     + relocatedHead.a_bss;
  247.   if (relocatedSize > TCL_LOADMAX) {
  248.     Tcl_SetResult (interp, "module too big to load", TCL_STATIC);
  249.     goto failure;
  250.   }
  251.  
  252.   /* Advance the break to protect the loaded module */
  253.  
  254.   (void) brk (startAddress + relocatedSize);
  255.  
  256.   /* Seek to the start of the module's text */
  257.  
  258. #if defined(__mips) || defined(mips)
  259.   status = lseek (relocatedFd,
  260.           N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
  261.           SEEK_SET);
  262. #else
  263.   status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);
  264. #endif
  265.   if (status < 0) {
  266.     goto ioError;
  267.   }
  268.  
  269.   /* Read in the module's text and data */
  270.  
  271.   relocatedSize = relocatedHead.a_text + relocatedHead.a_data;
  272.   if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {
  273.     brk (startAddress);
  274.   ioError:
  275.     Tcl_AppendResult (interp, "error on intermediate file \"",
  276.               relocatedFileName, "\": ", Tcl_PosixError (interp),
  277.               (char *) NULL);
  278.   failure:
  279.     (void) unlink (relocatedFileName);
  280.     return TCL_ERROR;
  281.   }
  282.  
  283.   /* Close the intermediate file. */
  284.  
  285.   (void) close (relocatedFd);
  286.  
  287.   /* Arrange things so that intermediate symbol tables eventually get
  288.    * deleted. */
  289.  
  290.   if (SymbolTableFile != NULL) {
  291.     UnlinkSymbolTable ();
  292.   } else {
  293.     atexit (UnlinkSymbolTable);
  294.   }
  295.   SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
  296.   strcpy (SymbolTableFile, relocatedFileName);
  297.   
  298.   /* Look up the entry points in the load module's dictionary. */
  299.  
  300.   dictionary = (DictFn) startAddress;
  301.   *proc1Ptr = dictionary (sym1);
  302.   *proc2Ptr = dictionary (sym2);
  303.  
  304.   return TCL_OK;
  305. }
  306.  
  307. /*
  308.  *------------------------------------------------------------------------
  309.  *
  310.  * FindLibraries --
  311.  *
  312.  *    Find the libraries needed to link a load module at run time.
  313.  *
  314.  * Results:
  315.  *    A standard Tcl completion code.  If an error occurs,
  316.  *    an error message is left in interp->result.  The -l and -L flags
  317.  *    are concatenated onto the dynamic string `buf'.
  318.  *
  319.  *------------------------------------------------------------------------
  320.  */
  321.  
  322. static int
  323. FindLibraries (interp, fileName, buf)
  324.      Tcl_Interp * interp;    /* Used for error reporting */
  325.      char * fileName;        /* Name of the load module */
  326.      Tcl_DString * buf;        /* Buffer where the -l an -L flags */
  327. {
  328.   FILE * f;            /* The load module */
  329.   int c;            /* Byte from the load module */
  330.   char * p;
  331.  
  332.   /* Open the load module */
  333.  
  334.   if ((f = fopen (fileName, "rb")) == NULL) {
  335.     Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ",
  336.               Tcl_PosixError (interp), (char *) NULL);
  337.     return TCL_ERROR;
  338.   }
  339.  
  340.   /* Search for the library list in the load module */
  341.  
  342.   p = "@LIBS: ";
  343.   while (*p != '\0' && (c = getc (f)) != EOF) {
  344.     if (c == *p) {
  345.       ++p;
  346.     }
  347.     else {
  348.       p = "@LIBS: ";
  349.       if (c == *p) {
  350.     ++p;
  351.       }
  352.     }
  353.   }
  354.  
  355.   /* No library list -- this must be an ill-formed module */
  356.  
  357.   if (c == EOF) {
  358.     Tcl_AppendResult (interp, "File \"", fileName,
  359.               "\" is not a Tcl load module.", (char *) NULL);
  360.     (void) fclose (f);
  361.     return TCL_ERROR;
  362.   }
  363.  
  364.   /* Accumulate the library list */
  365.  
  366.   while ((c = getc (f)) != '\0' && c != EOF) {
  367.     char cc = c;
  368.     Tcl_DStringAppend (buf, &cc, 1);
  369.   }
  370.   (void) fclose (f);
  371.  
  372.   if (c == EOF) {
  373.     Tcl_AppendResult (interp, "Library directory in \"", fileName,
  374.               "\" ends prematurely.", (char *) NULL);
  375.     return TCL_ERROR;
  376.   }
  377.  
  378.   return TCL_OK;
  379. }
  380.  
  381. /*
  382.  *------------------------------------------------------------------------
  383.  *
  384.  * UnlinkSymbolTable --
  385.  *
  386.  *    Remove the symbol table file from the last dynamic link.
  387.  *
  388.  * Results:
  389.  *    None.
  390.  *
  391.  * Side effects:
  392.  *    The symbol table file from the last dynamic link is removed.
  393.  *    This function is called when (a) a new symbol table is present
  394.  *    because another dynamic link is complete, or (b) the process
  395.  *    is exiting.
  396.  *------------------------------------------------------------------------
  397.  */
  398.  
  399. static void
  400. UnlinkSymbolTable ()
  401. {
  402.   (void) unlink (SymbolTableFile);
  403.   ckfree (SymbolTableFile);
  404.   SymbolTableFile = NULL;
  405. }
  406.  
  407. /*
  408.  *----------------------------------------------------------------------
  409.  *
  410.  * TclGuessPackageName --
  411.  *
  412.  *    If the "load" command is invoked without providing a package
  413.  *    name, this procedure is invoked to try to figure it out.
  414.  *
  415.  * Results:
  416.  *    Always returns 0 to indicate that we couldn't figure out a
  417.  *    package name;  generic code will then try to guess the package
  418.  *    from the file name.  A return value of 1 would have meant that
  419.  *    we figured out the package name and put it in bufPtr.
  420.  *
  421.  * Side effects:
  422.  *    None.
  423.  *
  424.  *----------------------------------------------------------------------
  425.  */
  426.  
  427. int
  428. TclGuessPackageName(fileName, bufPtr)
  429.     char *fileName;        /* Name of file containing package (already
  430.                  * translated to local form if needed). */
  431.     Tcl_DString *bufPtr;    /* Initialized empty dstring.  Append
  432.                  * package name to this if possible. */
  433. {
  434.     char *p, *q, *r;
  435.  
  436.     if (q = strrchr(fileName,'/')) {
  437.     q++;
  438.     } else {
  439.     q = fileName;
  440.     }
  441.     if (!strncmp(q,"lib",3)) {
  442.     q+=3;
  443.     }
  444.     p = q;
  445.     while ((*p) && (*p != '.') && ((*p<'0') || (*p>'9'))) {
  446.     p++;
  447.     }
  448.     if ((p>q+2) && !strncmp(p-2,"_G0.",4)) {
  449.     p-=2;
  450.     }
  451.     if (p<q) {
  452.     return 0;
  453.     }
  454.  
  455.     Tcl_DStringAppend(bufPtr,q, p-q);
  456.  
  457.     r = Tcl_DStringValue(bufPtr);
  458.     r += strlen(r) - (p-q);
  459.  
  460.     if (islower(UCHAR(*r))) {
  461.     *r = (char) toupper(UCHAR(*r));
  462.     }
  463.     while (*(++r)) {
  464.     if (isupper(UCHAR(*r))) {
  465.         *r = (char) tolower(UCHAR(*r));
  466.     }
  467.     }
  468.  
  469.     return 1;
  470. }
  471.