Merge commit '60d692811c12788ed4468d5ff680633304e8f641' as 'tkimg'

1 files changed, 576 insertions, 0 deletions

diff --git a/tkimg/compat/tclLoadAout.c b/tkimg/compat/tclLoadAout.c
new file mode 100755
index 0000000..6792718
--- /dev/null
+++ b/tkimg/compat/tclLoadAout.c
@@ -0,0 +1,576 @@
+/*

+ * tclLoadAout.c --

+ *

+ *	This procedure provides a version of dlopen() that

+ *	provides pseudo-static linking using version-7 compatible

+ *	a.out files described in either sys/exec.h or sys/a.out.h.

+ *

+ * 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.

+ *

+ * SCCS: @(#) tclLoadAout.c 1.7 96/02/15 11:58:53

+ */

+

+#include "tcl.h"

+#include "compat/dlfcn.h"

+#include <errno.h>

+#include <fcntl.h>

+#include <ctype.h>

+#include <string.h>

+#include <stdlib.h>

+#include <unistd.h>

+#ifdef HAVE_EXEC_AOUT_H

+#   include <sys/exec_aout.h>

+#endif

+

+/*

+ * Some systems describe the a.out header in sys/exec.h, and some in

+ * a.out.h.

+ */

+

+#ifdef USE_SYS_EXEC_H

+#include <sys/exec.h>

+#endif

+#ifdef USE_A_OUT_H

+#include <a.out.h>

+#endif

+#ifdef USE_SYS_EXEC_AOUT_H

+#include <sys/exec_aout.h>

+#define a_magic a_midmag

+#endif

+

+EXTERN char *tclExecutableName;

+

+#define UCHAR(c) ((unsigned char) (c))

+

+/*

+ * TCL_LOADSHIM is the amount by which to shim the break when loading

+ */

+

+#ifndef TCL_LOADSHIM

+#define TCL_LOADSHIM 0x4000L

+#endif

+

+/*

+ * TCL_LOADALIGN must be a power of 2, and is the alignment to which

+ * to force the origin of load modules

+ */

+

+#ifndef TCL_LOADALIGN

+#define TCL_LOADALIGN 0x4000L

+#endif

+

+/*

+ * TCL_LOADMAX is the maximum size of a load module, and is used as

+ * a sanity check when loading

+ */

+

+#ifndef TCL_LOADMAX

+#define TCL_LOADMAX 2000000L

+#endif

+

+/*

+ * Kernel calls that appear to be missing from the system .h files:

+ */

+

+extern char *brk(char *);

+extern char *sbrk(size_t);

+

+/*

+ * The static variable SymbolTableFile contains the file name where the

+ * result of the last link was stored.  The file is kept because doing so

+ * allows one load module to use the symbols defined in another.

+ */

+

+static char * SymbolTableFile = NULL;

+

+/*

+ * Prototypes for procedures referenced only in this file:

+ */

+

+static int FindLibraries(const char *fileName, Tcl_DString *buf);

+static void UnlinkSymbolTable(void);

+static void Seterror(char *message);

+static char *errorMessage = NULL;

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * dlopen --

+ *

+ *	Dynamically loads a binary code file into memory.

+ *

+ * Results:

+ *	A handle which can be used in later calls to dlsym(),

+ *	or NULL when the attempt fails.

+ *

+ * Side effects:

+ *	New code suddenly appears in memory.

+ *

+ *

+ * Bugs:

+ *	This function does not attempt to handle the case where the

+ *	BSS segment is not executable.  It will therefore fail on

+ *	Encore Multimax, Pyramid 90x, and similar machines.  The

+ *	reason is that the mprotect() kernel call, which would

+ *	otherwise be employed to mark the newly-loaded text segment

+ *	executable, results in a system crash on BSD/386.

+ *

+ *	In an effort to make it fast, this function eschews the

+ *	technique of linking the load module once, reading its header

+ *	to determine its size, allocating memory for it, and linking

+ *	it again.  Instead, it `shims out' memory allocation by

+ *	placing the module TCL_LOADSHIM bytes beyond the break,

+ *	and assuming that any malloc() calls required to run the

+ *	linker will not advance the break beyond that point.  If

+ *	the break is advanced beyonnd that point, the load will

+ *	fail with an `inconsistent memory allocation' error.

+ *	It perhaps ought to retry the link, but the failure has

+ *	not been observed in two years of daily use of this function.

+ *----------------------------------------------------------------------

+ */

+

+void *

+dlopen(path, flags)

+    const char *path;

+    int flags;

+{

+  char * inputSymbolTable;	/* Name of the file containing the

+				 * symbol table from the last link. */

+  Tcl_DString linkCommandBuf;	/* Command to do the run-time relocation

+				 * of the module.*/

+  char * linkCommand;

+  char relocatedFileName [L_tmpnam];

+				/* Name of the file holding the relocated */

+				/* text of the module */

+  int relocatedFd = -1;		/* File descriptor of the file holding

+				 * relocated text */

+  struct exec relocatedHead;	/* Header of the relocated text */

+  unsigned long relocatedSize;	/* Size of the relocated text */

+  char * startAddress;		/* Starting address of the module */

+  int status;			/* Status return from Tcl_ calls */

+  char *p, *q;

+  const char *r, *pkgGuess;

+  Tcl_Interp *interp = NULL;

+  Tcl_DString fullPath;

+

+  errno = 0;

+  if (errorMessage) {

+    ckfree(errorMessage);

+    errorMessage = NULL;

+  }

+

+  /* Find the file that contains the symbols for the run-time link. */

+

+  if (SymbolTableFile != NULL) {

+    inputSymbolTable = SymbolTableFile;

+  } else if (tclExecutableName == NULL) {

+    Seterror("can't find the tclsh executable");

+    goto error;

+  } else {

+    inputSymbolTable = tclExecutableName;

+  }

+

+  /* Construct the `ld' command that builds the relocated module */

+

+  interp = Tcl_CreateInterp();

+

+  Tcl_DStringInit (&fullPath);

+  if (Tcl_GetPathType(path) == TCL_PATH_RELATIVE) {

+	p = getenv("LD_LIBRARY_PATH");

+	while (p) {

+	    if ((q = strchr(p,':')) == NULL) {

+		q = p; while(*q) q++;

+	    }

+	    if (p == q) break;

+	    Tcl_DStringAppend(&fullPath, p, q-p);

+	    Tcl_DStringAppend(&fullPath, "/", 1);

+	    Tcl_DStringAppend(&fullPath, path, -1);

+	    if (access(Tcl_DStringValue(&fullPath), F_OK) != -1) {

+		break;

+	    }

+	    Tcl_DStringSetLength(&fullPath, 0);

+	    p = q; if (*p) p++;

+	}

+  }

+  if (*Tcl_DStringValue(&fullPath) == 0) {

+    Tcl_DStringAppend(&fullPath, path, -1);

+  }

+  tmpnam (relocatedFileName);

+  Tcl_DStringInit (&linkCommandBuf);

+  Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);

+  Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);

+#if defined(__mips) || defined(mips)

+  Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);

+#endif

+  Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);

+  if (pkgGuess = strrchr(path,'/')) {

+    pkgGuess++;

+  } else {

+    pkgGuess = path;

+  }

+  if (!strncmp(pkgGuess,"lib",3)) {

+    pkgGuess+=3;

+  }

+  for (r = pkgGuess; (*r) && (*r != '.'); r++) {

+    /* Empty loop body. */

+  }

+  if ((r>pkgGuess+3) && !strncmp(r-3,"_G0.",4)) {

+    r-=3;

+  }

+  while ((r-- > pkgGuess) && isdigit(UCHAR(*r))) {

+    /* Empty loop body. */

+  }

+  r++;

+  Tcl_DStringAppend(&linkCommandBuf,(char *) pkgGuess, r-pkgGuess);

+

+  p = Tcl_DStringValue(&linkCommandBuf);

+  p += strlen(p) - (r-pkgGuess);

+

+  if (islower(UCHAR(*p))) {

+    *p = (char) toupper(UCHAR(*p));

+  }

+  while (*(p++)) {

+    if (isupper(UCHAR(*p))) {

+	*p = (char) tolower(UCHAR(*p));

+    }

+  }

+  Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);

+  Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);

+  Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);

+  Tcl_DStringAppend (&linkCommandBuf, Tcl_DStringValue(&fullPath), -1);

+  p = getenv("LD_LIBRARY_PATH");

+  while (p) {

+    if ((q = strchr(p,':')) == NULL) {

+	q = p; while(*q) q++;

+    }

+    if (p == q) break;

+    Tcl_DStringAppend(&linkCommandBuf, " -L", 3);

+    Tcl_DStringAppend(&linkCommandBuf, p, q-p);

+    p = q; if (*p) p++;

+  }

+  Tcl_DStringAppend (&linkCommandBuf, " ", -1);

+  if (FindLibraries (Tcl_DStringValue(&fullPath), &linkCommandBuf) != TCL_OK) {

+    Tcl_DStringFree (&linkCommandBuf);

+    Tcl_DStringFree (&fullPath);

+    goto error;

+  }

+  Tcl_DStringFree (&fullPath);

+  linkCommand = Tcl_DStringValue (&linkCommandBuf);

+

+  /* Determine the starting address, and plug it into the command */

+

+  startAddress = (char *) (((unsigned long) sbrk (0)

+			    + TCL_LOADSHIM + TCL_LOADALIGN - 1)

+			   & (- TCL_LOADALIGN));

+  p = strstr(linkCommand, "-T") + 3;

+  sprintf(p, "%08lx", (long) startAddress);

+  p [8] = ' ';

+

+  /* Run the linker */

+

+  status = Tcl_Eval (interp, linkCommand);

+  Tcl_DStringFree (&linkCommandBuf);

+  if (status != 0) {

+    Seterror(interp->result);

+    errno = 0;

+    goto error;

+  }

+

+  /* Open the linker's result file and read the header */

+

+  relocatedFd = open(relocatedFileName, O_RDONLY);

+  if (relocatedFd < 0) {

+    goto ioError;

+  }

+  status= read(relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);

+  if (status < sizeof relocatedHead) {

+    goto ioError;

+  }

+

+  /* Check the magic number */

+

+  if (relocatedHead.a_magic != OMAGIC) {

+    Seterror("bad magic number in intermediate file");

+    goto failure;

+  }

+

+  /* Make sure that memory allocation is still consistent */

+

+  if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {

+    Seterror("can't load, memory allocation is inconsistent");

+    goto failure;

+  }

+

+  /* Make sure that the relocated module's size is reasonable */

+

+  relocatedSize = relocatedHead.a_text + relocatedHead.a_data

+    + relocatedHead.a_bss;

+  if (relocatedSize > TCL_LOADMAX) {

+    Seterror("module too big to load");

+    goto failure;

+  }

+

+  /* Advance the break to protect the loaded module */

+

+  (void) brk (startAddress + relocatedSize);

+

+  /* Seek to the start of the module's text */

+

+#if defined(__mips) || defined(mips)

+  status = lseek (relocatedFd,

+		  N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),

+		  SEEK_SET);

+#else

+  status = lseek (relocatedFd, N_TXTOFF (relocatedHead), SEEK_SET);

+#endif

+  if (status < 0) {

+    goto ioError;

+  }

+

+  /* Read in the module's text and data */

+

+  relocatedSize = relocatedHead.a_text + relocatedHead.a_data;

+  if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {

+    brk (startAddress);

+  ioError:

+    Seterror("error on intermediate file: ");

+  failure:

+    (void) unlink (relocatedFileName);

+    goto error;

+  }

+

+  /* Close the intermediate file. */

+

+  (void) close (relocatedFd);

+

+  /* Arrange things so that intermediate symbol tables eventually get

+   * deleted. If the flag RTLD_GLOBAL is not set, just keep the

+   * old file. */

+

+  if (flags & RTLD_GLOBAL) {

+    if (SymbolTableFile != NULL) {

+      UnlinkSymbolTable ();

+    } else {

+      atexit (UnlinkSymbolTable);

+    }

+    SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);

+    strcpy (SymbolTableFile, relocatedFileName);

+  } else {

+    (void) unlink (relocatedFileName);

+  }

+  return (void *) startAddress;

+

+error:

+  if (relocatedFd>=0) {

+	close (relocatedFd);

+  }

+  if (interp) {

+    Tcl_DeleteInterp(interp);

+  }

+  return NULL;

+}

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * dlsym --

+ *

+ *	This function returns the address of a

+ *	symbol, give the handle returned by dlopen().

+ *

+ * Results:

+ *	Returns the address of the symbol in the dll.

+ *

+ * Side effects:

+ *	None.

+ *

+ *----------------------------------------------------------------------

+ */

+

+void *dlsym(handle, symbol)

+    void *handle;

+    const char *symbol;

+{

+    if ((handle != NULL) && (symbol != NULL)) {

+	return ((void * (*) (const char *)) handle) (symbol);

+    } else {

+	return (void *) NULL;

+    }

+}

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * dlerror --

+ *

+ *	This function returns a string describing the error which

+ *	occurred in dlopen().

+ *

+ * Results:

+ *	Returns an error message.

+ *

+ * Side effects:

+ *	None.

+ *

+ *----------------------------------------------------------------------

+ */

+

+char *

+dlerror()

+{

+    const char *err;

+    char *msg;

+

+    if (errorMessage && errno) {

+	err = Tcl_ErrnoMsg(errno);

+	msg = ckalloc(strlen(errorMessage)+strlen(err)+1);

+	strcpy(msg, errorMessage);

+	strcat(msg, err);

+	ckfree(errorMessage);

+	errorMessage = msg;

+    }

+    return errorMessage;

+}

+

+

+/*

+ *----------------------------------------------------------------------

+ *

+ * dlclose --

+ *

+ *	Just a dummy function, only for compatibility. There is no

+ *	way to remove dll's from memory.

+ *

+ * Results:

+ *	Always returns 0 (= O.K.)

+ *

+ * Side effects:

+ *	None

+ *

+ *----------------------------------------------------------------------

+ */

+

+int

+dlclose(handle)

+    void *handle;

+{

+    return 0;

+}

+

+static void

+Seterror(message)

+    char *message;

+{

+    if (errorMessage) {

+	ckfree(errorMessage);

+    }

+    errorMessage = ckalloc(strlen(message)+1);

+    strcpy(errorMessage, message);

+    return;

+}

+

+

+/*

+ *------------------------------------------------------------------------

+ *

+ * FindLibraries --

+ *

+ *	Find the libraries needed to link a load module at run time.

+ *

+ * Results:

+ *	A standard Tcl completion code.  If an error occurs,

+ *	an error message is left in interp->result.  The -l and -L flags

+ *	are concatenated onto the dynamic string `buf'.

+ *

+ *------------------------------------------------------------------------

+ */

+

+static int

+FindLibraries (fileName, buf)

+     const char * fileName;	/* Name of the load module */

+     Tcl_DString * buf;		/* Buffer where the -l an -L flags */

+{

+  FILE * f;			/* The load module */

+  int c = EOF;			/* Byte from the load module */

+  char * p;

+

+  /* Open the load module */

+

+  if ((f = fopen (fileName, "rb")) == NULL) {

+    Seterror("");

+    return TCL_ERROR;

+  }

+

+  /* Search for the library list in the load module */

+

+  p = "@LIBS: ";

+  while (*p != '\0' && (c = getc (f)) != EOF) {

+    if (c == *p) {

+      ++p;

+    }

+    else {

+      p = "@LIBS: ";

+      if (c == *p) {

+	++p;

+      }

+    }

+  }

+

+  /* No library list -- assume no dependancies */

+

+  if (c == EOF) {

+    (void) fclose (f);

+    return TCL_OK;

+  }

+

+  /* Accumulate the library list */

+

+  while ((c = getc (f)) != '\0' && c != EOF) {

+    char cc = c;

+    Tcl_DStringAppend (buf, &cc, 1);

+  }

+  (void) fclose (f);

+

+  if (c == EOF) {

+    Seterror("Library directory ends prematurely");

+    return TCL_ERROR;

+  }

+

+  return TCL_OK;

+}

+

+/*

+ *------------------------------------------------------------------------

+ *

+ * UnlinkSymbolTable --

+ *

+ *	Remove the symbol table file from the last dynamic link.

+ *

+ * Results:

+ *	None.

+ *

+ * Side effects:

+ *	The symbol table file from the last dynamic link is removed.

+ *	This function is called when (a) a new symbol table is present

+ *	because another dynamic link is complete, or (b) the process

+ *	is exiting.

+ *------------------------------------------------------------------------

+ */

+

+static void

+UnlinkSymbolTable ()

+{

+  (void) unlink (SymbolTableFile);

+  ckfree (SymbolTableFile);

+  SymbolTableFile = NULL;

+}