mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

* dynl.c: made dynamic_obj representation a double cell.

Browse source
This commit is contained in:
Mikael Djurfeldt 2000-03-14 06:39:37 +00:00
parent 273b7b9490
commit 7cf1a27e9c
1 changed files with 171 additions and 181 deletions
Download patch file Download diff file Expand all files Collapse all files

68
libguile/dynl.c
View file

@ -1,6 +1,6 @@
/* dynl.c - dynamic linking
*
* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999 Free Software Foundation, Inc.
* Copyright (C) 1990, 91, 92, 93, 94, 95, 96, 97, 98, 99, 2000 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
@ -154,13 +154,15 @@ scm_register_module_xxx (char *module_name, void *init_func)
/* XXX - should we (and can we) DEFER_INTS here? */
for (md = registered_mods; md; md = md->link)
if (!strcmp (md->module_name, module_name)) {
if (!strcmp (md->module_name, module_name))
{
md->init_func = init_func;
return;
}
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);
@ -207,7 +209,8 @@ SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
SCM_DEFER_INTS;
for (md1 = registered_mods; md1; md1 = md2) {
for (md1 = registered_mods; md1; md1 = md2)
{
md2 = md1->link;
free (md1);
}
@ -237,7 +240,8 @@ SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
static void *
sysdep_dynl_link (const char *fname, int flags, const char *subr)
{
lt_dlhandle handle = lt_dlopenext (fname);
lt_dlhandle handle;
handle = lt_dlopenext (fname);
if (NULL == handle)
{
SCM_ALLOW_INTS;
@ -326,27 +330,23 @@ struct dynl_obj {
void *handle;
};
#define DYNL_OBJ(x) ((struct dynl_obj *) &SCM_CDR (x))
#define DYNL_FILENAME(x) (DYNL_OBJ (x)->filename)
#define DYNL_HANDLE(x) (DYNL_OBJ (x)->handle)
static SCM
mark_dynl_obj (SCM ptr)
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (ptr);
return d->filename;
}
static scm_sizet
free_dynl_obj (SCM ptr)
{
scm_must_free ((char *)SCM_CDR (ptr));
return sizeof (struct dynl_obj);
return DYNL_FILENAME (ptr);
}
static int
print_dynl_obj (SCM exp,SCM port,scm_print_state *pstate)
{
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (exp);
scm_puts ("#<dynamic-object ", port);
scm_iprin1 (d->filename, port, pstate);
if (d->handle == NULL)
scm_iprin1 (DYNL_FILENAME (exp), port, pstate);
if (DYNL_HANDLE (exp) == NULL)
scm_puts (" (unlinked)", port);
scm_putc ('>', port);
return 1;
@ -362,9 +362,7 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 1,
"as the @var{lib} argument to the following functions.")
#define FUNC_NAME s_scm_dynamic_link
{
SCM z;
void *handle;
struct dynl_obj *d;
int flags = DYNL_GLOBAL;
SCM_COERCE_ROSTRING (1, fname);
@ -393,20 +391,9 @@ SCM_DEFINE (scm_dynamic_link, "dynamic-link", 1, 0, 1,
scm_cons (kw, SCM_EOL));
}
SCM_DEFER_INTS;
handle = sysdep_dynl_link (SCM_CHARS (fname), flags, FUNC_NAME);
d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj),
FUNC_NAME);
d->filename = fname;
d->handle = handle;
SCM_NEWCELL (z);
SCM_SETCHARS (z, d);
SCM_SETCAR (z, scm_tc16_dynamic_obj);
SCM_ALLOW_INTS;
return z;
SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, fname, handle);
}
#undef FUNC_NAME
@ -416,7 +403,7 @@ get_dynl_obj (SCM dobj,const char *subr,int argn)
struct dynl_obj *d;
SCM_ASSERT (SCM_NIMP (dobj) && SCM_UNPACK_CAR (dobj) == scm_tc16_dynamic_obj,
dobj, argn, subr);
d = (struct dynl_obj *)SCM_CDR (dobj);
d = DYNL_OBJ (dobj);
SCM_ASSERT (d->handle != NULL, dobj, argn, subr);
return d;
}
@ -427,7 +414,8 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
"otherwise.")
#define FUNC_NAME s_scm_dynamic_object_p
{
return SCM_BOOL(SCM_NIMP (obj) && SCM_UNPACK_CAR (obj) == scm_tc16_dynamic_obj);
return SCM_BOOL (SCM_NIMP (obj)
&& SCM_UNPACK_CAR (obj) == scm_tc16_dynamic_obj);
}
#undef FUNC_NAME
@ -444,6 +432,7 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
"")
#define FUNC_NAME s_scm_dynamic_unlink
{
/*fixme* GC-problem */
struct dynl_obj *d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG1);
SCM_DEFER_INTS;
sysdep_dynl_unlink (d->handle, FUNC_NAME);
@ -474,10 +463,12 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
void (*func) ();
SCM_COERCE_ROSTRING (1, symb);
/*fixme* GC-problem */
d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG2);
SCM_DEFER_INTS;
func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb), d->handle,
func = (void (*) ()) sysdep_dynl_func (SCM_CHARS (symb),
d->handle,
FUNC_NAME);
SCM_ALLOW_INTS;
@ -550,8 +541,7 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
fptr = (int (*) (int, char **)) SCM_NUM2ULONG (1, func);
SCM_DEFER_INTS;
argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME,
SCM_ARG3);
argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, SCM_ARG3);
result = (*fptr) (argc, argv);
scm_must_free_argv (argv);
SCM_ALLOW_INTS;
@ -563,9 +553,9 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
void
scm_init_dynamic_linking ()
{
scm_tc16_dynamic_obj = scm_make_smob_type_mfpe ("dynamic-object", sizeof (struct dynl_obj),
mark_dynl_obj, free_dynl_obj,
print_dynl_obj, NULL);
scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0);
scm_set_smob_mark (scm_tc16_dynamic_obj, mark_dynl_obj);
scm_set_smob_print (scm_tc16_dynamic_obj, print_dynl_obj);
sysdep_dynl_init ();
#include "dynl.x"
kw_global = scm_make_keyword_from_dash_symbol (sym_global);