/* -*-C-*-
-$Id: pruxdld.c,v 1.1 1993/08/28 05:41:26 gjr Exp $
+$Id: pruxdld.c,v 1.2 1993/10/27 22:12:16 gjr Exp $
Copyright (c) 1993 Massachusetts Institute of Technology
promotional, or sales literature without prior written consent from
MIT in each case. */
-/* This file contains the interface to the HP-UX (SunOS-style)
- dynamic loader.
- It has only been tried under HP-UX.
+/* This file contains the interface to a unix dynamic loader.
+ It has been tried under HP-UX, SunOS (4.1.?), and Alpha OSF 1.
*/
-#include <dl.h>
#include "scheme.h"
#include "prims.h"
#include "usrdef.h"
#include "syscall.h"
+#include "os.h"
+\f
+#if defined(_HPUX)
+
+#include <dl.h>
#ifndef DYNAMIC_PATH
# define DYNAMIC_PATH 0
#endif
-static short shl_findsym_types [] =
+typedef shl_t dyn_load_handle_t;
+
+static dyn_load_handle_t
+DEFUN (dyn_load, (path), char * path)
{
- TYPE_PROCEDURE,
- TYPE_DATA,
- TYPE_UNDEFINED
-};
+ return (shl_load (path,
+ (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH),
+ 0));
+}
+
+static int
+DEFUN (dyn_lookup, (handle, symbol, type, result),
+ dyn_load_handle_t * handle
+ AND char * symbol
+ AND int type
+ AND PTR * result)
+{
+ return (shl_findsym (handle, symbol, type, result));
+}
+
+#else /* not _HPUX */
+
+#include <dlfcn.h>
+
+#define TYPE_PROCEDURE 0
+#define TYPE_DATA 1
+#define TYPE_UNDEFINED 2
+
+typedef void * dyn_load_handle_t;
+
+#define PROG_HANDLE ((dyn_load_handle_t) NULL)
+
+static dyn_load_handle_t
+DEFUN (dyn_load, (path), char * path)
+{
+ dyn_load_handle_t result = (dlopen (path, RTLD_LAZY));
+
+#if 0
+ if (result == ((dyn_load_handle_t) NULL))
+ fprintf (stderr, "\ndlopen: %s.\n", (dlerror ()));
+#endif
+
+ return (result);
+}
+
+static int
+DEFUN (dyn_lookup, (handle, symbol, type, result),
+ dyn_load_handle_t * handle
+ AND char * symbol
+ AND int type
+ AND PTR * result)
+{
+ * result = (dlsym ((* handle), symbol));
+ return (((* result) == ((PTR) NULL))
+ ? -1
+ : 0);
+}
+
+#endif /* _HPUX */
\f
DEFINE_PRIMITIVE ("LOAD-OBJECT-FILE", Prim_load_object_file, 1, 1,
"(load-object-file lib-file)")
{
extern int errno;
- shl_t prim_lib_handle;
+ dyn_load_handle_t prim_lib_handle;
PRIMITIVE_HEADER (1);
- prim_lib_handle = (shl_load ((STRING_ARG (1)),
- (BIND_IMMEDIATE | BIND_NONFATAL | DYNAMIC_PATH),
- 0));
- if (prim_lib_handle == NULL)
+ prim_lib_handle = (dyn_load (STRING_ARG (1)));
+ if (prim_lib_handle == ((dyn_load_handle_t) NULL))
error_system_call (errno, syscall_dld);
PRIMITIVE_RETURN (long_to_integer ((long) prim_lib_handle));
}
+static short dyn_load_types [] =
+{
+ TYPE_PROCEDURE,
+ TYPE_DATA,
+ TYPE_UNDEFINED
+};
+
DEFINE_PRIMITIVE ("OBJECT-LOOKUP-SYMBOL", Prim_object_lookup_symbol, 3, 3,
"(object-lookup-symbol handle sym type)")
{
char * sym;
short type;
- unsigned long result;
- shl_t prim_lib_handle, * arg_handle;
+ PTR result;
+ dyn_load_handle_t prim_lib_handle, arg_handle;
PRIMITIVE_HEADER (3);
switch (ARG_REF (1))
break;
case SHARP_T:
- arg_handle = ((shl_t *) NULL);
+ arg_handle = ((dyn_load_handle_t *) NULL);
break;
default:
- prim_lib_handle = ((shl_t) (arg_integer (1)));
+ prim_lib_handle = ((dyn_load_handle_t) (arg_integer (1)));
arg_handle = & prim_lib_handle;
break;
}
sym = (STRING_ARG (2));
- type = shl_findsym_types [arg_index_integer (3, ((sizeof (shl_findsym_types))
- / (sizeof (short))))];
+ type = dyn_load_types [arg_index_integer (3, ((sizeof (dyn_load_types))
+ / (sizeof (short))))];
- if ((shl_findsym (arg_handle, sym, type, ((void *) & result)))
- == -1)
+ if ((dyn_lookup (arg_handle, sym, type, & result)) == -1)
PRIMITIVE_RETURN (SHARP_F);
- PRIMITIVE_RETURN (long_to_integer (result));
+ PRIMITIVE_RETURN (long_to_integer ((long) result));
}
DEFINE_PRIMITIVE ("INVOKE-C-THUNK", Prim_invoke_C_thunk, 1, 1,