From: Guillermo J. Rozas <edu/mit/csail/zurich/gjr>
Date: Wed, 27 Oct 1993 22:12:16 +0000 (+0000)
Subject: Make it work under SunOS (and perhaps Alpha OSF).
X-Git-Tag: 20090517-FFI~7671
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=17f517973ede310ef646253699ac632c91bf5a2c;p=mit-scheme.git

Make it work under SunOS (and perhaps Alpha OSF).
---

diff --git a/v7/src/microcode/pruxdld.c b/v7/src/microcode/pruxdld.c
index 78954725a..95f0757be 100644
--- a/v7/src/microcode/pruxdld.c
+++ b/v7/src/microcode/pruxdld.c
@@ -1,6 +1,6 @@
 /* -*-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
 
@@ -32,50 +32,111 @@ Technology nor of any adaptation thereof in any advertising,
 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"
+
+#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 */
 
 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))
@@ -86,23 +147,22 @@ DEFINE_PRIMITIVE ("OBJECT-LOOKUP-SYMBOL", Prim_object_lookup_symbol, 3, 3,
       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,