/* dynl.c - dynamic linking
*
- * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
+ * Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.
- */
+ * If you do not wish that, delete this exception notice. */
/* "dynl.c" dynamically link&load object files.
Author: Aubrey Jaffer
Modified for libguile by Marius Vollmer */
+#if 0 /* Disabled until we know for sure that it isn't needed */
/* XXX - This is only here to drag in a definition of __eprintf. This
is needed for proper operation of dynamic linking. The real
solution would probably be a shared libgcc. */
{
assert (!maybe_drag_in_eprintf);
}
+#endif
+#include <stdio.h>
#include "_scm.h"
#include "dynl.h"
#include "genio.h"
#include "smob.h"
-#ifdef DYNAMIC_LINKING
-
/* Converting a list of SCM strings into a argv-style array. You must
have ints disabled for the whole lifetime of the created argv (from
before MAKE_ARGV_FROM_STRINGLIST until after
This code probably belongs into strings.c */
static char **scm_make_argv_from_stringlist SCM_P ((SCM args, int *argcp,
- char *subr, int argn));
+ const char *subr, int argn));
static char **
scm_make_argv_from_stringlist (args, argcp, subr, argn)
SCM args;
int *argcp;
- char *subr;
+ const char *subr;
int argn;
{
char **argv;
char **argv;
{
char **av = argv;
- while(!(*av))
- free(*(av++));
+ while (*av)
+ free(*(av++));
free(argv);
}
/* Coerce an arbitrary readonly-string into a zero-terminated string.
*/
-static SCM scm_coerce_rostring SCM_P ((SCM rostr, char *subr, int argn));
+static SCM scm_coerce_rostring SCM_P ((SCM rostr, const char *subr, int argn));
static SCM
scm_coerce_rostring (rostr, subr, argn)
SCM rostr;
- char *subr;
+ const char *subr;
int argn;
{
SCM_ASSERT (SCM_NIMP (rostr) && SCM_ROSTRINGP (rostr), rostr, argn, subr);
}
md = (struct moddata *)malloc (sizeof (struct moddata));
- if (md == NULL)
+ if (md == NULL) {
+ fprintf (stderr,
+ "guile: can't register module (%s): not enough memory",
+ module_name);
return;
+ }
md->module_name = module_name;
md->init_func = init_func;
/* Dispatch to the system dependent files
*
- * They define these static functions:
+ * They define some static functions. These functions are called with
+ * deferred interrupts. When they want to throw errors, they are
+ * expected to insert a SCM_ALLOW_INTS before doing the throw. It
+ * might work to throw an error while interrupts are deferred (because
+ * they will be unconditionally allowed the next time a SCM_ALLOW_INTS
+ * is executed, SCM_DEFER_INTS and SCM_ALLOW_INTS do not nest).
*/
static void sysdep_dynl_init SCM_P ((void));
-static void *sysdep_dynl_link SCM_P ((char *filename, char *subr));
-static void sysdep_dynl_unlink SCM_P ((void *handle, char *subr));
-static void *sysdep_dynl_func SCM_P ((char *symbol, void *handle, char *subr));
+static void *sysdep_dynl_link SCM_P ((const char *filename, const char *subr));
+static void sysdep_dynl_unlink SCM_P ((void *handle, const char *subr));
+static void *sysdep_dynl_func SCM_P ((const char *symbol, void *handle,
+ const char *subr));
-#ifdef HAVE_LIBDL
+#ifdef HAVE_DLOPEN
#include "dynl-dl.c"
#else
#ifdef HAVE_SHL_LOAD
#include "dynl-shl.c"
#else
-#ifdef HAVE_DLD
+#ifdef HAVE_LIBDLD
#include "dynl-dld.c"
-#else /* no dynamic linking available */
-/* configure should not have defined DYNAMIC_LINKING in this case */
-#error Dynamic linking not implemented for your system.
+#else
+
+/* no dynamic linking available, throw errors. */
+
+static void
+sysdep_dynl_init ()
+{
+}
+
+static void
+no_dynl_error (subr)
+ char *subr;
+{
+ SCM_ALLOW_INTS;
+ scm_misc_error (subr, "dynamic linking not available", SCM_EOL);
+}
+
+static void *
+sysdep_dynl_link (filename, subr)
+ const char *filename;
+ const char *subr;
+{
+ no_dynl_error (subr);
+ return NULL;
+}
+
+static void
+sysdep_dynl_unlink (handle, subr)
+ void *handle;
+ char *subr;
+{
+ no_dynl_error (subr);
+}
+
+static void *
+sysdep_dynl_func (symbol, handle, subr)
+ char *symbol;
+ void *handle;
+ char *subr;
+{
+ no_dynl_error (subr);
+ return NULL;
+}
+
#endif
#endif
#endif
SCM ptr;
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (ptr);
- SCM_SETGC8MARK (ptr);
return d->filename;
}
+static scm_sizet free_dynl_obj SCM_P ((SCM ptr));
+static scm_sizet
+free_dynl_obj (ptr)
+ SCM ptr;
+{
+ scm_must_free ((char *)SCM_CDR (ptr));
+ return sizeof (struct dynl_obj);
+}
+
static int print_dynl_obj SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
static int
print_dynl_obj (exp, port, pstate)
scm_print_state *pstate;
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (exp);
- scm_gen_puts (scm_regular_string, "#<dynamic-object ", port);
+ scm_puts ("#<dynamic-object ", port);
scm_iprin1 (d->filename, port, pstate);
- scm_gen_putc ('>', port);
+ if (d->handle == NULL)
+ scm_puts (" (unlinked)", port);
+ scm_putc ('>', port);
return 1;
}
static scm_smobfuns dynl_obj_smob = {
mark_dynl_obj,
- scm_free0,
+ free_dynl_obj,
print_dynl_obj
};
SCM fname;
{
SCM z;
+ void *handle;
struct dynl_obj *d;
fname = scm_coerce_rostring (fname, s_dynamic_link, SCM_ARG1);
+
+ SCM_DEFER_INTS;
+ handle = sysdep_dynl_link (SCM_CHARS (fname), s_dynamic_link);
+
d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj),
s_dynamic_link);
d->filename = fname;
+ d->handle = handle;
- SCM_DEFER_INTS;
- d->handle = sysdep_dynl_link (SCM_CHARS (fname), s_dynamic_link);
SCM_NEWCELL (z);
SCM_SETCHARS (z, d);
SCM_SETCAR (z, scm_tc16_dynamic_obj);
return z;
}
-static struct dynl_obj *get_dynl_obj SCM_P ((SCM obj, char *subr, int argn));
+static struct dynl_obj *get_dynl_obj SCM_P ((SCM obj, const char *subr, int argn));
static struct dynl_obj *
get_dynl_obj (dobj, subr, argn)
SCM dobj;
- char *subr;
+ const char *subr;
int argn;
{
struct dynl_obj *d;
SCM dobj;
{
struct dynl_obj *d = get_dynl_obj (dobj, s_dynamic_unlink, SCM_ARG1);
+ SCM_DEFER_INTS;
sysdep_dynl_unlink (d->handle, s_dynamic_unlink);
d->handle = NULL;
- return SCM_BOOL_T;
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
}
SCM_PROC (s_dynamic_func, "dynamic-func", 2, 0, 0, scm_dynamic_func);
symb = scm_coerce_rostring (symb, s_dynamic_func, SCM_ARG1);
d = get_dynl_obj (dobj, s_dynamic_func, SCM_ARG2);
- func = sysdep_dynl_func (d->handle, SCM_CHARS (symb), s_dynamic_func);
+ SCM_DEFER_INTS;
+ func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb), d->handle,
+ s_dynamic_func);
+ SCM_ALLOW_INTS;
+
return scm_ulong2num ((unsigned long)func);
}
if (SCM_NIMP (func) && SCM_ROSTRINGP (func))
func = scm_dynamic_func (func, dobj);
fptr = (void (*)()) scm_num2ulong (func, (char *)SCM_ARG1, s_dynamic_call);
+ SCM_DEFER_INTS;
fptr ();
- return SCM_BOOL_T;
+ SCM_ALLOW_INTS;
+ return SCM_UNSPECIFIED;
}
SCM_PROC (s_dynamic_args_call, "dynamic-args-call", 3, 0, 0, scm_dynamic_args_call);
fptr = (int (*)(int, char **)) scm_num2ulong (func, (char *)SCM_ARG1,
s_dynamic_args_call);
+ SCM_DEFER_INTS;
argv = scm_make_argv_from_stringlist (args, &argc, s_dynamic_args_call,
SCM_ARG3);
-
result = (*fptr) (argc, argv);
-
scm_must_free_argv (argv);
+ SCM_ALLOW_INTS;
+
return SCM_MAKINUM(0L+result);
}
sysdep_dynl_init ();
#include "dynl.x"
}
-
-#else /* not DYNAMIC_LINKING */
-
-void
-scm_init_dynamic_linking ()
-{
-#include "dynl.x"
-}
-
-#endif /* not DYNAMIC_LINKING */
HCoop / bpt / guile.git / blobdiff