os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclLoadAout.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclLoadAout.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,536 @@
1.4 +/*
1.5 + * tclLoadAout.c --
1.6 + *
1.7 + * This procedure provides a version of the TclLoadFile that
1.8 + * provides pseudo-static linking using version-7 compatible
1.9 + * a.out files described in either sys/exec.h or sys/a.out.h.
1.10 + *
1.11 + * Copyright (c) 1995, by General Electric Company. All rights reserved.
1.12 + *
1.13 + * See the file "license.terms" for information on usage and redistribution
1.14 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.15 + *
1.16 + * This work was supported in part by the ARPA Manufacturing Automation
1.17 + * and Design Engineering (MADE) Initiative through ARPA contract
1.18 + * F33615-94-C-4400.
1.19 + *
1.20 + * RCS: @(#) $Id: tclLoadAout.c,v 1.14 2002/10/10 12:25:53 vincentdarley Exp $
1.21 + */
1.22 +
1.23 +#include "tclInt.h"
1.24 +#include <fcntl.h>
1.25 +#ifdef HAVE_EXEC_AOUT_H
1.26 +# include <sys/exec_aout.h>
1.27 +#endif
1.28 +#ifdef HAVE_UNISTD_H
1.29 +# include <unistd.h>
1.30 +#else
1.31 +# include "../compat/unistd.h"
1.32 +#endif
1.33 +
1.34 +/*
1.35 + * Some systems describe the a.out header in sys/exec.h, and some in
1.36 + * a.out.h.
1.37 + */
1.38 +
1.39 +#ifdef USE_SYS_EXEC_H
1.40 +#include <sys/exec.h>
1.41 +#endif
1.42 +#ifdef USE_A_OUT_H
1.43 +#include <a.out.h>
1.44 +#endif
1.45 +#ifdef USE_SYS_EXEC_AOUT_H
1.46 +#include <sys/exec_aout.h>
1.47 +#define a_magic a_midmag
1.48 +#endif
1.49 +
1.50 +/*
1.51 + * TCL_LOADSHIM is the amount by which to shim the break when loading
1.52 + */
1.53 +
1.54 +#ifndef TCL_LOADSHIM
1.55 +#define TCL_LOADSHIM 0x4000L
1.56 +#endif
1.57 +
1.58 +/*
1.59 + * TCL_LOADALIGN must be a power of 2, and is the alignment to which
1.60 + * to force the origin of load modules
1.61 + */
1.62 +
1.63 +#ifndef TCL_LOADALIGN
1.64 +#define TCL_LOADALIGN 0x4000L
1.65 +#endif
1.66 +
1.67 +/*
1.68 + * TCL_LOADMAX is the maximum size of a load module, and is used as
1.69 + * a sanity check when loading
1.70 + */
1.71 +
1.72 +#ifndef TCL_LOADMAX
1.73 +#define TCL_LOADMAX 2000000L
1.74 +#endif
1.75 +
1.76 +/*
1.77 + * Kernel calls that appear to be missing from the system .h files:
1.78 + */
1.79 +
1.80 +extern char * brk _ANSI_ARGS_((char *));
1.81 +extern char * sbrk _ANSI_ARGS_((size_t));
1.82 +
1.83 +/*
1.84 + * The static variable SymbolTableFile contains the file name where the
1.85 + * result of the last link was stored. The file is kept because doing so
1.86 + * allows one load module to use the symbols defined in another.
1.87 + */
1.88 +
1.89 +static char * SymbolTableFile = NULL;
1.90 +
1.91 +/*
1.92 + * Type of the dictionary function that begins each load module.
1.93 + */
1.94 +
1.95 +typedef Tcl_PackageInitProc * (* DictFn) _ANSI_ARGS_ ((CONST char * symbol));
1.96 +
1.97 +/*
1.98 + * Prototypes for procedures referenced only in this file:
1.99 + */
1.100 +
1.101 +static int FindLibraries _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * pathPtr,
1.102 + Tcl_DString * buf));
1.103 +static void UnlinkSymbolTable _ANSI_ARGS_((void));
1.104 +
1.105 +/*
1.106 + *----------------------------------------------------------------------
1.107 + *
1.108 + * TclpDlopen --
1.109 + *
1.110 + * Dynamically loads a binary code file into memory and returns
1.111 + * a handle to the new code.
1.112 + *
1.113 + * Results:
1.114 + * A standard Tcl completion code. If an error occurs, an error
1.115 + * message is left in the interp's result.
1.116 + *
1.117 + * Side effects:
1.118 + * New code suddenly appears in memory.
1.119 + *
1.120 + *
1.121 + * Bugs:
1.122 + * This function does not attempt to handle the case where the
1.123 + * BSS segment is not executable. It will therefore fail on
1.124 + * Encore Multimax, Pyramid 90x, and similar machines. The
1.125 + * reason is that the mprotect() kernel call, which would
1.126 + * otherwise be employed to mark the newly-loaded text segment
1.127 + * executable, results in a system crash on BSD/386.
1.128 + *
1.129 + * In an effort to make it fast, this function eschews the
1.130 + * technique of linking the load module once, reading its header
1.131 + * to determine its size, allocating memory for it, and linking
1.132 + * it again. Instead, it `shims out' memory allocation by
1.133 + * placing the module TCL_LOADSHIM bytes beyond the break,
1.134 + * and assuming that any malloc() calls required to run the
1.135 + * linker will not advance the break beyond that point. If
1.136 + * the break is advanced beyonnd that point, the load will
1.137 + * fail with an `inconsistent memory allocation' error.
1.138 + * It perhaps ought to retry the link, but the failure has
1.139 + * not been observed in two years of daily use of this function.
1.140 + *----------------------------------------------------------------------
1.141 + */
1.142 +
1.143 +int
1.144 +TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
1.145 + Tcl_Interp *interp; /* Used for error reporting. */
1.146 + Tcl_Obj *pathPtr; /* Name of the file containing the desired
1.147 + * code (UTF-8). */
1.148 + Tcl_LoadHandle *loadHandle; /* Filled with token for dynamically loaded
1.149 + * file which will be passed back to
1.150 + * (*unloadProcPtr)() to unload the file. */
1.151 + Tcl_FSUnloadFileProc **unloadProcPtr;
1.152 + /* Filled with address of Tcl_FSUnloadFileProc
1.153 + * function which should be used for
1.154 + * this file. */
1.155 +{
1.156 + char * inputSymbolTable; /* Name of the file containing the
1.157 + * symbol table from the last link. */
1.158 + Tcl_DString linkCommandBuf; /* Command to do the run-time relocation
1.159 + * of the module.*/
1.160 + char * linkCommand;
1.161 + char relocatedFileName [L_tmpnam];
1.162 + /* Name of the file holding the relocated */
1.163 + /* text of the module */
1.164 + int relocatedFd; /* File descriptor of the file holding
1.165 + * relocated text */
1.166 + struct exec relocatedHead; /* Header of the relocated text */
1.167 + unsigned long relocatedSize;/* Size of the relocated text */
1.168 + char * startAddress; /* Starting address of the module */
1.169 + int status; /* Status return from Tcl_ calls */
1.170 + char * p;
1.171 +
1.172 + /* Find the file that contains the symbols for the run-time link. */
1.173 +
1.174 + if (SymbolTableFile != NULL) {
1.175 + inputSymbolTable = SymbolTableFile;
1.176 + } else if (tclExecutableName == NULL) {
1.177 + Tcl_SetResult (interp, "can't find the tclsh executable", TCL_STATIC);
1.178 + return TCL_ERROR;
1.179 + } else {
1.180 + inputSymbolTable = tclExecutableName;
1.181 + }
1.182 +
1.183 + /* Construct the `ld' command that builds the relocated module */
1.184 +
1.185 + tmpnam (relocatedFileName);
1.186 + Tcl_DStringInit (&linkCommandBuf);
1.187 + Tcl_DStringAppend (&linkCommandBuf, "exec ld -o ", -1);
1.188 + Tcl_DStringAppend (&linkCommandBuf, relocatedFileName, -1);
1.189 +#if defined(__mips) || defined(mips)
1.190 + Tcl_DStringAppend (&linkCommandBuf, " -G 0 ", -1);
1.191 +#endif
1.192 + Tcl_DStringAppend (&linkCommandBuf, " -u TclLoadDictionary_", -1);
1.193 + TclGuessPackageName(Tcl_GetString(pathPtr), &linkCommandBuf);
1.194 + Tcl_DStringAppend (&linkCommandBuf, " -A ", -1);
1.195 + Tcl_DStringAppend (&linkCommandBuf, inputSymbolTable, -1);
1.196 + Tcl_DStringAppend (&linkCommandBuf, " -N -T XXXXXXXX ", -1);
1.197 + Tcl_DStringAppend (&linkCommandBuf, Tcl_GetString(pathPtr), -1);
1.198 + Tcl_DStringAppend (&linkCommandBuf, " ", -1);
1.199 +
1.200 + if (FindLibraries (interp, pathPtr, &linkCommandBuf) != TCL_OK) {
1.201 + Tcl_DStringFree (&linkCommandBuf);
1.202 + return TCL_ERROR;
1.203 + }
1.204 +
1.205 + linkCommand = Tcl_DStringValue (&linkCommandBuf);
1.206 +
1.207 + /* Determine the starting address, and plug it into the command */
1.208 +
1.209 + startAddress = (char *) (((unsigned long) sbrk (0)
1.210 + + TCL_LOADSHIM + TCL_LOADALIGN - 1)
1.211 + & (- TCL_LOADALIGN));
1.212 + p = strstr (linkCommand, "-T") + 3;
1.213 + sprintf (p, "%08lx", (long) startAddress);
1.214 + p [8] = ' ';
1.215 +
1.216 + /* Run the linker */
1.217 +
1.218 + status = Tcl_Eval (interp, linkCommand);
1.219 + Tcl_DStringFree (&linkCommandBuf);
1.220 + if (status != 0) {
1.221 + return TCL_ERROR;
1.222 + }
1.223 +
1.224 + /* Open the linker's result file and read the header */
1.225 +
1.226 + relocatedFd = open (relocatedFileName, O_RDONLY);
1.227 + if (relocatedFd < 0) {
1.228 + goto ioError;
1.229 + }
1.230 + status= read (relocatedFd, (char *) & relocatedHead, sizeof relocatedHead);
1.231 + if (status < sizeof relocatedHead) {
1.232 + goto ioError;
1.233 + }
1.234 +
1.235 + /* Check the magic number */
1.236 +
1.237 + if (relocatedHead.a_magic != OMAGIC) {
1.238 + Tcl_AppendResult (interp, "bad magic number in intermediate file \"",
1.239 + relocatedFileName, "\"", (char *) NULL);
1.240 + goto failure;
1.241 + }
1.242 +
1.243 + /* Make sure that memory allocation is still consistent */
1.244 +
1.245 + if ((unsigned long) sbrk (0) > (unsigned long) startAddress) {
1.246 + Tcl_SetResult (interp, "can't load, memory allocation is inconsistent.",
1.247 + TCL_STATIC);
1.248 + goto failure;
1.249 + }
1.250 +
1.251 + /* Make sure that the relocated module's size is reasonable */
1.252 +
1.253 + relocatedSize = relocatedHead.a_text + relocatedHead.a_data
1.254 + + relocatedHead.a_bss;
1.255 + if (relocatedSize > TCL_LOADMAX) {
1.256 + Tcl_SetResult (interp, "module too big to load", TCL_STATIC);
1.257 + goto failure;
1.258 + }
1.259 +
1.260 + /* Advance the break to protect the loaded module */
1.261 +
1.262 + (void) brk (startAddress + relocatedSize);
1.263 +
1.264 + /*
1.265 + * Seek to the start of the module's text.
1.266 + *
1.267 + * Note that this does not really work with large files (i.e. where
1.268 + * lseek64 exists and is different to lseek), but anyone trying to
1.269 + * dynamically load a binary that is larger than what can fit in
1.270 + * addressable memory is in trouble anyway...
1.271 + */
1.272 +
1.273 +#if defined(__mips) || defined(mips)
1.274 + status = lseek (relocatedFd,
1.275 + (off_t) N_TXTOFF (relocatedHead.ex_f, relocatedHead.ex_o),
1.276 + SEEK_SET);
1.277 +#else
1.278 + status = lseek (relocatedFd, (off_t) N_TXTOFF (relocatedHead), SEEK_SET);
1.279 +#endif
1.280 + if (status < 0) {
1.281 + goto ioError;
1.282 + }
1.283 +
1.284 + /* Read in the module's text and data */
1.285 +
1.286 + relocatedSize = relocatedHead.a_text + relocatedHead.a_data;
1.287 + if (read (relocatedFd, startAddress, relocatedSize) < relocatedSize) {
1.288 + brk (startAddress);
1.289 + ioError:
1.290 + Tcl_AppendResult (interp, "error on intermediate file \"",
1.291 + relocatedFileName, "\": ", Tcl_PosixError (interp),
1.292 + (char *) NULL);
1.293 + failure:
1.294 + (void) unlink (relocatedFileName);
1.295 + return TCL_ERROR;
1.296 + }
1.297 +
1.298 + /* Close the intermediate file. */
1.299 +
1.300 + (void) close (relocatedFd);
1.301 +
1.302 + /* Arrange things so that intermediate symbol tables eventually get
1.303 + * deleted. */
1.304 +
1.305 + if (SymbolTableFile != NULL) {
1.306 + UnlinkSymbolTable ();
1.307 + } else {
1.308 + atexit (UnlinkSymbolTable);
1.309 + }
1.310 + SymbolTableFile = ckalloc (strlen (relocatedFileName) + 1);
1.311 + strcpy (SymbolTableFile, relocatedFileName);
1.312 +
1.313 + *loadHandle = startAddress;
1.314 + return TCL_OK;
1.315 +}
1.316 +
1.317 +/*
1.318 + *----------------------------------------------------------------------
1.319 + *
1.320 + * TclpFindSymbol --
1.321 + *
1.322 + * Looks up a symbol, by name, through a handle associated with
1.323 + * a previously loaded piece of code (shared library).
1.324 + *
1.325 + * Results:
1.326 + * Returns a pointer to the function associated with 'symbol' if
1.327 + * it is found. Otherwise returns NULL and may leave an error
1.328 + * message in the interp's result.
1.329 + *
1.330 + *----------------------------------------------------------------------
1.331 + */
1.332 +Tcl_PackageInitProc*
1.333 +TclpFindSymbol(interp, loadHandle, symbol)
1.334 + Tcl_Interp *interp;
1.335 + Tcl_LoadHandle loadHandle;
1.336 + CONST char *symbol;
1.337 +{
1.338 + /* Look up the entry point in the load module's dictionary. */
1.339 + DictFn dictionary = (DictFn) loadHandle;
1.340 + return (Tcl_PackageInitProc*) dictionary(sym1);
1.341 +}
1.342 +
1.343 +
1.344 +/*
1.345 + *------------------------------------------------------------------------
1.346 + *
1.347 + * FindLibraries --
1.348 + *
1.349 + * Find the libraries needed to link a load module at run time.
1.350 + *
1.351 + * Results:
1.352 + * A standard Tcl completion code. If an error occurs,
1.353 + * an error message is left in the interp's result. The -l and -L
1.354 + * flags are concatenated onto the dynamic string `buf'.
1.355 + *
1.356 + *------------------------------------------------------------------------
1.357 + */
1.358 +
1.359 +static int
1.360 +FindLibraries (interp, pathPtr, buf)
1.361 + Tcl_Interp * interp; /* Used for error reporting */
1.362 + Tcl_Obj * pathPtr; /* Name of the load module */
1.363 + Tcl_DString * buf; /* Buffer where the -l an -L flags */
1.364 +{
1.365 + FILE * f; /* The load module */
1.366 + int c = 0; /* Byte from the load module */
1.367 + char * p;
1.368 + CONST char *native;
1.369 +
1.370 + char *fileName = Tcl_GetString(pathPtr);
1.371 +
1.372 + /* Open the load module */
1.373 +
1.374 + native = Tcl_FSGetNativePath(pathPtr);
1.375 + f = fopen(native, "rb"); /* INTL: Native. */
1.376 +
1.377 + if (f == NULL) {
1.378 + Tcl_AppendResult (interp, "couldn't open \"", fileName, "\": ",
1.379 + Tcl_PosixError (interp), (char *) NULL);
1.380 + return TCL_ERROR;
1.381 + }
1.382 +
1.383 + /* Search for the library list in the load module */
1.384 +
1.385 + p = "@LIBS: ";
1.386 + while (*p != '\0' && (c = getc (f)) != EOF) {
1.387 + if (c == *p) {
1.388 + ++p;
1.389 + }
1.390 + else {
1.391 + p = "@LIBS: ";
1.392 + if (c == *p) {
1.393 + ++p;
1.394 + }
1.395 + }
1.396 + }
1.397 +
1.398 + /* No library list -- this must be an ill-formed module */
1.399 +
1.400 + if (c == EOF) {
1.401 + Tcl_AppendResult (interp, "File \"", fileName,
1.402 + "\" is not a Tcl load module.", (char *) NULL);
1.403 + (void) fclose (f);
1.404 + return TCL_ERROR;
1.405 + }
1.406 +
1.407 + /* Accumulate the library list */
1.408 +
1.409 + while ((c = getc (f)) != '\0' && c != EOF) {
1.410 + char cc = c;
1.411 + Tcl_DStringAppend (buf, &cc, 1);
1.412 + }
1.413 + (void) fclose (f);
1.414 +
1.415 + if (c == EOF) {
1.416 + Tcl_AppendResult (interp, "Library directory in \"", fileName,
1.417 + "\" ends prematurely.", (char *) NULL);
1.418 + return TCL_ERROR;
1.419 + }
1.420 +
1.421 + return TCL_OK;
1.422 +}
1.423 +
1.424 +/*
1.425 + *------------------------------------------------------------------------
1.426 + *
1.427 + * UnlinkSymbolTable --
1.428 + *
1.429 + * Remove the symbol table file from the last dynamic link.
1.430 + *
1.431 + * Results:
1.432 + * None.
1.433 + *
1.434 + * Side effects:
1.435 + * The symbol table file from the last dynamic link is removed.
1.436 + * This function is called when (a) a new symbol table is present
1.437 + * because another dynamic link is complete, or (b) the process
1.438 + * is exiting.
1.439 + *------------------------------------------------------------------------
1.440 + */
1.441 +
1.442 +static void
1.443 +UnlinkSymbolTable ()
1.444 +{
1.445 + (void) unlink (SymbolTableFile);
1.446 + ckfree (SymbolTableFile);
1.447 + SymbolTableFile = NULL;
1.448 +}
1.449 +
1.450 +/*
1.451 + *----------------------------------------------------------------------
1.452 + *
1.453 + * TclpUnloadFile --
1.454 + *
1.455 + * Unloads a dynamically loaded binary code file from memory.
1.456 + * Code pointers in the formerly loaded file are no longer valid
1.457 + * after calling this function.
1.458 + *
1.459 + * Results:
1.460 + * None.
1.461 + *
1.462 + * Side effects:
1.463 + * Does nothing. Can anything be done?
1.464 + *
1.465 + *----------------------------------------------------------------------
1.466 + */
1.467 +
1.468 +void
1.469 +TclpUnloadFile(loadHandle)
1.470 + Tcl_LoadHandle loadHandle; /* loadHandle returned by a previous call
1.471 + * to TclpDlopen(). The loadHandle is
1.472 + * a token that represents the loaded
1.473 + * file. */
1.474 +{
1.475 +}
1.476 +
1.477 +/*
1.478 + *----------------------------------------------------------------------
1.479 + *
1.480 + * TclGuessPackageName --
1.481 + *
1.482 + * If the "load" command is invoked without providing a package
1.483 + * name, this procedure is invoked to try to figure it out.
1.484 + *
1.485 + * Results:
1.486 + * Always returns 0 to indicate that we couldn't figure out a
1.487 + * package name; generic code will then try to guess the package
1.488 + * from the file name. A return value of 1 would have meant that
1.489 + * we figured out the package name and put it in bufPtr.
1.490 + *
1.491 + * Side effects:
1.492 + * None.
1.493 + *
1.494 + *----------------------------------------------------------------------
1.495 + */
1.496 +
1.497 +int
1.498 +TclGuessPackageName(fileName, bufPtr)
1.499 + CONST char *fileName; /* Name of file containing package (already
1.500 + * translated to local form if needed). */
1.501 + Tcl_DString *bufPtr; /* Initialized empty dstring. Append
1.502 + * package name to this if possible. */
1.503 +{
1.504 + CONST char *p, *q;
1.505 + char *r;
1.506 +
1.507 + if ((q = strrchr(fileName,'/'))) {
1.508 + q++;
1.509 + } else {
1.510 + q = fileName;
1.511 + }
1.512 + if (!strncmp(q,"lib",3)) {
1.513 + q+=3;
1.514 + }
1.515 + p = q;
1.516 + while ((*p) && (*p != '.') && ((*p<'0') || (*p>'9'))) {
1.517 + p++;
1.518 + }
1.519 + if ((p>q+2) && !strncmp(p-2,"_G0.",4)) {
1.520 + p-=2;
1.521 + }
1.522 + if (p<q) {
1.523 + return 0;
1.524 + }
1.525 +
1.526 + Tcl_DStringAppend(bufPtr,q, p-q);
1.527 +
1.528 + r = Tcl_DStringValue(bufPtr);
1.529 + r += strlen(r) - (p-q);
1.530 +
1.531 + /*
1.532 + * Capitalize the string and then recompute the length.
1.533 + */
1.534 +
1.535 + Tcl_UtfToTitle(r);
1.536 + Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
1.537 +
1.538 + return 1;
1.539 +}