mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
* dynl.c: made dynamic_obj representation a double cell.
This commit is contained in:
Mikael Djurfeldt
parent
273b7b9490
commit
7cf1a27e9c
1 changed files with 171 additions and 181 deletions
100
libguile/dynl.c
100
libguile/dynl.c
|
|
@ -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
|
||||
|
|
@ -87,16 +87,16 @@ scm_make_argv_from_stringlist (SCM args,int *argcp,const char *subr,int argn)
|
|||
char **argv;
|
||||
int argc, i;
|
||||
|
||||
argc = scm_ilength(args);
|
||||
argv = (char **) scm_must_malloc ((1L+argc)*sizeof(char *), subr);
|
||||
for(i = 0; SCM_NNULLP (args); args = SCM_CDR (args), i++) {
|
||||
argc = scm_ilength (args);
|
||||
argv = (char **) scm_must_malloc ((1L + argc) * sizeof (char *), subr);
|
||||
for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), i++) {
|
||||
size_t len;
|
||||
char *dst, *src;
|
||||
SCM str = SCM_CAR (args);
|
||||
|
||||
SCM_ASSERT (SCM_ROSTRINGP (str), str, argn, subr);
|
||||
len = 1 + SCM_ROLENGTH (str);
|
||||
dst = (char *) scm_must_malloc ((long)len, subr);
|
||||
dst = (char *) scm_must_malloc ((long) len, subr);
|
||||
src = SCM_ROCHARS (str);
|
||||
while (len--)
|
||||
dst[len] = src[len];
|
||||
|
|
@ -114,8 +114,8 @@ scm_must_free_argv(char **argv)
|
|||
{
|
||||
char **av = argv;
|
||||
while (*av)
|
||||
free(*(av++));
|
||||
free(argv);
|
||||
free (*(av++));
|
||||
free (argv);
|
||||
}
|
||||
|
||||
/* Coerce an arbitrary readonly-string into a zero-terminated string.
|
||||
|
|
@ -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) {
|
||||
md = (struct moddata *) malloc (sizeof (struct moddata));
|
||||
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,11 +240,12 @@ 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;
|
||||
scm_misc_error (subr, (char *)lt_dlerror (), SCM_EOL);
|
||||
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
|
||||
}
|
||||
return (void *) handle;
|
||||
}
|
||||
|
|
@ -252,7 +256,7 @@ sysdep_dynl_unlink (void *handle, const char *subr)
|
|||
if (lt_dlclose ((lt_dlhandle) handle))
|
||||
{
|
||||
SCM_ALLOW_INTS;
|
||||
scm_misc_error (subr, (char *)lt_dlerror (), SCM_EOL);
|
||||
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -265,7 +269,7 @@ sysdep_dynl_func (const char *symb, void *handle, const char *subr)
|
|||
if (!fptr)
|
||||
{
|
||||
SCM_ALLOW_INTS;
|
||||
scm_misc_error (subr, (char *)lt_dlerror (), SCM_EOL);
|
||||
scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
|
||||
}
|
||||
return fptr;
|
||||
}
|
||||
|
|
@ -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,30 +391,19 @@ 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
|
||||
|
||||
static struct dynl_obj *
|
||||
get_dynl_obj (SCM dobj,const char *subr,int argn)
|
||||
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,14 +463,16 @@ 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;
|
||||
|
||||
return scm_ulong2num ((unsigned long)func);
|
||||
return scm_ulong2num ((unsigned long) func);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
@ -506,11 +497,11 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
|
|||
"")
|
||||
#define FUNC_NAME s_scm_dynamic_call
|
||||
{
|
||||
void (*fptr)();
|
||||
void (*fptr) ();
|
||||
|
||||
if (SCM_ROSTRINGP (func))
|
||||
func = scm_dynamic_func (func, dobj);
|
||||
fptr = (void (*)()) SCM_NUM2ULONG (1, func);
|
||||
fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
|
||||
SCM_DEFER_INTS;
|
||||
fptr ();
|
||||
SCM_ALLOW_INTS;
|
||||
|
|
@ -548,24 +539,23 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
|
|||
if (SCM_ROSTRINGP (func))
|
||||
func = scm_dynamic_func (func, dobj);
|
||||
|
||||
fptr = (int (*)(int, char **)) SCM_NUM2ULONG (1,func);
|
||||
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;
|
||||
|
||||
return SCM_MAKINUM(0L+result);
|
||||
return SCM_MAKINUM (0L + result);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
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);
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue