os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/unix/tclLoadNext.c
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib.
     1 /* 
     2  * tclLoadNext.c --
     3  *
     4  *	This procedure provides a version of the TclLoadFile that
     5  *	works with NeXTs rld_* dynamic loading.  This file provided
     6  *	by Pedja Bogdanovich.
     7  *
     8  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
     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  * RCS: @(#) $Id: tclLoadNext.c,v 1.11 2002/10/10 12:25:53 vincentdarley Exp $
    14  */
    15 
    16 #include "tclInt.h"
    17 #include <mach-o/rld.h>
    18 #include <streams/streams.h>
    19 
    20 /*
    21  *----------------------------------------------------------------------
    22  *
    23  * TclpDlopen --
    24  *
    25  *	Dynamically loads a binary code file into memory and returns
    26  *	a handle to the new code.
    27  *
    28  * Results:
    29  *	A standard Tcl completion code.  If an error occurs, an error
    30  *	message is left in the interp's result.
    31  *
    32  * Side effects:
    33  *	New code suddenly appears in memory.
    34  *
    35  *----------------------------------------------------------------------
    36  */
    37 
    38 int
    39 TclpDlopen(interp, pathPtr, loadHandle, unloadProcPtr)
    40     Tcl_Interp *interp;		/* Used for error reporting. */
    41     Tcl_Obj *pathPtr;		/* Name of the file containing the desired
    42 				 * code (UTF-8). */
    43     Tcl_LoadHandle *loadHandle;	/* Filled with token for dynamically loaded
    44 				 * file which will be passed back to 
    45 				 * (*unloadProcPtr)() to unload the file. */
    46     Tcl_FSUnloadFileProc **unloadProcPtr;	
    47 				/* Filled with address of Tcl_FSUnloadFileProc
    48 				 * function which should be used for
    49 				 * this file. */
    50 {
    51     struct mach_header *header;
    52     char *fileName;
    53     char *files[2];
    54     CONST char *native;
    55     int result = 1;
    56     
    57     NXStream *errorStream = NXOpenMemory(0,0,NX_READWRITE);
    58     
    59     fileName = Tcl_GetString(pathPtr);
    60 
    61     /* 
    62      * First try the full path the user gave us.  This is particularly
    63      * important if the cwd is inside a vfs, and we are trying to load
    64      * using a relative path.
    65      */
    66     native = Tcl_FSGetNativePath(pathPtr);
    67     files = {native,NULL};
    68 
    69     result = rld_load(errorStream, &header, files, NULL);
    70     
    71     if (!result) {
    72 	/* 
    73 	 * Let the OS loader examine the binary search path for
    74 	 * whatever string the user gave us which hopefully refers
    75 	 * to a file on the binary path
    76 	 */
    77 	Tcl_DString ds;
    78 	native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
    79 	files = {native,NULL};
    80 	result = rld_load(errorStream, &header, files, NULL);
    81 	Tcl_DStringFree(&ds);
    82     }
    83     
    84     if (!result) {
    85 	char *data;
    86 	int len, maxlen;
    87 	NXGetMemoryBuffer(errorStream,&data,&len,&maxlen);
    88 	Tcl_AppendResult(interp, "couldn't load file \"",
    89 			 fileName, "\": ", data, NULL);
    90 	NXCloseMemory(errorStream, NX_FREEBUFFER);
    91 	return TCL_ERROR;
    92     }
    93     NXCloseMemory(errorStream, NX_FREEBUFFER);
    94     
    95     *loadHandle = (Tcl_LoadHandle)1; /* A dummy non-NULL value */
    96     *unloadProcPtr = &TclpUnloadFile;
    97     
    98     return TCL_OK;
    99 }
   100 
   101 /*
   102  *----------------------------------------------------------------------
   103  *
   104  * TclpFindSymbol --
   105  *
   106  *	Looks up a symbol, by name, through a handle associated with
   107  *	a previously loaded piece of code (shared library).
   108  *
   109  * Results:
   110  *	Returns a pointer to the function associated with 'symbol' if
   111  *	it is found.  Otherwise returns NULL and may leave an error
   112  *	message in the interp's result.
   113  *
   114  *----------------------------------------------------------------------
   115  */
   116 Tcl_PackageInitProc*
   117 TclpFindSymbol(interp, loadHandle, symbol) 
   118     Tcl_Interp *interp;
   119     Tcl_LoadHandle loadHandle;
   120     CONST char *symbol;
   121 {
   122     Tcl_PackageInitProc *proc=NULL;
   123     if(symbol) {
   124 	char sym[strlen(symbol)+2];
   125 	sym[0]='_'; sym[1]=0; strcat(sym,symbol);
   126 	rld_lookup(NULL,sym,(unsigned long *)&proc);
   127     }
   128     return proc;
   129 }
   130 
   131 /*
   132  *----------------------------------------------------------------------
   133  *
   134  * TclpUnloadFile --
   135  *
   136  *	Unloads a dynamically loaded binary code file from memory.
   137  *	Code pointers in the formerly loaded file are no longer valid
   138  *	after calling this function.
   139  *
   140  * Results:
   141  *	None.
   142  *
   143  * Side effects:
   144  *	Does nothing.  Can anything be done?
   145  *
   146  *----------------------------------------------------------------------
   147  */
   148 
   149 void
   150 TclpUnloadFile(loadHandle)
   151     Tcl_LoadHandle loadHandle;	/* loadHandle returned by a previous call
   152 				 * to TclpDlopen().  The loadHandle is 
   153 				 * a token that represents the loaded 
   154 				 * file. */
   155 {
   156 }
   157 
   158 /*
   159  *----------------------------------------------------------------------
   160  *
   161  * TclGuessPackageName --
   162  *
   163  *	If the "load" command is invoked without providing a package
   164  *	name, this procedure is invoked to try to figure it out.
   165  *
   166  * Results:
   167  *	Always returns 0 to indicate that we couldn't figure out a
   168  *	package name;  generic code will then try to guess the package
   169  *	from the file name.  A return value of 1 would have meant that
   170  *	we figured out the package name and put it in bufPtr.
   171  *
   172  * Side effects:
   173  *	None.
   174  *
   175  *----------------------------------------------------------------------
   176  */
   177 
   178 int
   179 TclGuessPackageName(fileName, bufPtr)
   180     CONST char *fileName;	/* Name of file containing package (already
   181 				 * translated to local form if needed). */
   182     Tcl_DString *bufPtr;	/* Initialized empty dstring.  Append
   183 				 * package name to this if possible. */
   184 {
   185     return 0;
   186 }