load internals refactoring

1 files changed, 43 insertions, 1 deletions

diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 5b82f7e..c875292 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclIOUtil.c,v 1.55 2002/07/15 14:16:43 vincentdarley Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.56 2002/07/17 20:00:44 vincentdarley Exp $
  */
 
 #include "tclInt.h"
@@ -2626,6 +2626,48 @@ Tcl_FSLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr,
     Tcl_SetErrno(ENOENT);
     return -1;
 }
+/* 
+ * This function used to be in the platform specific directories, but it
+ * has now been made to work cross-platform
+ */
+int
+TclpLoadFile(interp, pathPtr, sym1, sym2, proc1Ptr, proc2Ptr, 
+	     clientDataPtr, unloadProcPtr)
+    Tcl_Interp *interp;		/* Used for error reporting. */
+    Tcl_Obj *pathPtr;		/* Name of the file containing the desired
+				 * code (UTF-8). */
+    CONST char *sym1, *sym2;	/* Names of two procedures to look up in
+				 * the file's symbol table. */
+    Tcl_PackageInitProc **proc1Ptr, **proc2Ptr;
+				/* Where to return the addresses corresponding
+				 * to sym1 and sym2. */
+    ClientData *clientDataPtr;	/* Filled with token for dynamically loaded
+				 * file which will be passed back to 
+				 * (*unloadProcPtr)() to unload the file. */
+    Tcl_FSUnloadFileProc **unloadProcPtr;	
+				/* Filled with address of Tcl_FSUnloadFileProc
+				 * function which should be used for
+				 * this file. */
+{
+    TclLoadHandle handle = NULL;
+    int res;
+    
+    res = TclpDlopen(interp, pathPtr, &handle, unloadProcPtr);
+    
+    if (res != TCL_OK) {
+        return res;
+    }
+
+    if (handle == NULL) {
+	return TCL_ERROR;
+    }
+    
+    *clientDataPtr = (ClientData)handle;
+    
+    *proc1Ptr = TclpFindSymbol(interp, handle, sym1);
+    *proc2Ptr = TclpFindSymbol(interp, handle, sym2);
+    return TCL_OK;
+}
 
 /*
  *---------------------------------------------------------------------------