mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +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

100
libguile/dynl.c
View file

@ -1,6 +1,6 @@
/* dynl.c - dynamic linking /* 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 * 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 * 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; char **argv;
int argc, i; int argc, i;
argc = scm_ilength(args); argc = scm_ilength (args);
argv = (char **) scm_must_malloc ((1L+argc)*sizeof(char *), subr); argv = (char **) scm_must_malloc ((1L + argc) * sizeof (char *), subr);
for(i = 0; SCM_NNULLP (args); args = SCM_CDR (args), i++) { for (i = 0; SCM_NNULLP (args); args = SCM_CDR (args), i++) {
size_t len; size_t len;
char *dst, *src; char *dst, *src;
SCM str = SCM_CAR (args); SCM str = SCM_CAR (args);
SCM_ASSERT (SCM_ROSTRINGP (str), str, argn, subr); SCM_ASSERT (SCM_ROSTRINGP (str), str, argn, subr);
len = 1 + SCM_ROLENGTH (str); 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); src = SCM_ROCHARS (str);
while (len--) while (len--)
dst[len] = src[len]; dst[len] = src[len];
@ -114,8 +114,8 @@ scm_must_free_argv(char **argv)
{ {
char **av = argv; char **av = argv;
while (*av) while (*av)
free(*(av++)); free (*(av++));
free(argv); free (argv);
} }
/* Coerce an arbitrary readonly-string into a zero-terminated string. /* 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? */ /* XXX - should we (and can we) DEFER_INTS here? */
for (md = registered_mods; md; md = md->link) 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; md->init_func = init_func;
return; return;
} }
md = (struct moddata *)malloc (sizeof (struct moddata)); md = (struct moddata *) malloc (sizeof (struct moddata));
if (md == NULL) { if (md == NULL)
{
fprintf (stderr, fprintf (stderr,
"guile: can't register module (%s): not enough memory", "guile: can't register module (%s): not enough memory",
module_name); module_name);
@ -207,7 +209,8 @@ SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
SCM_DEFER_INTS; SCM_DEFER_INTS;
for (md1 = registered_mods; md1; md1 = md2) { for (md1 = registered_mods; md1; md1 = md2)
{
md2 = md1->link; md2 = md1->link;
free (md1); free (md1);
} }
@ -237,11 +240,12 @@ SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
static void * static void *
sysdep_dynl_link (const char *fname, int flags, const char *subr) 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) if (NULL == handle)
{ {
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
scm_misc_error (subr, (char *)lt_dlerror (), SCM_EOL); scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
} }
return (void *) handle; return (void *) handle;
} }
@ -252,7 +256,7 @@ sysdep_dynl_unlink (void *handle, const char *subr)
if (lt_dlclose ((lt_dlhandle) handle)) if (lt_dlclose ((lt_dlhandle) handle))
{ {
SCM_ALLOW_INTS; 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) if (!fptr)
{ {
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
scm_misc_error (subr, (char *)lt_dlerror (), SCM_EOL); scm_misc_error (subr, (char *) lt_dlerror (), SCM_EOL);
} }
return fptr; return fptr;
} }
@ -326,27 +330,23 @@ struct dynl_obj {
void *handle; 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 static SCM
mark_dynl_obj (SCM ptr) mark_dynl_obj (SCM ptr)
{ {
struct dynl_obj *d = (struct dynl_obj *)SCM_CDR (ptr); return DYNL_FILENAME (ptr);
return d->filename;
}
static scm_sizet
free_dynl_obj (SCM ptr)
{
scm_must_free ((char *)SCM_CDR (ptr));
return sizeof (struct dynl_obj);
} }
static int static int
print_dynl_obj (SCM exp,SCM port,scm_print_state *pstate) 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_puts ("#<dynamic-object ", port);
scm_iprin1 (d->filename, port, pstate); scm_iprin1 (DYNL_FILENAME (exp), port, pstate);
if (d->handle == NULL) if (DYNL_HANDLE (exp) == NULL)
scm_puts (" (unlinked)", port); scm_puts (" (unlinked)", port);
scm_putc ('>', port); scm_putc ('>', port);
return 1; 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.") "as the @var{lib} argument to the following functions.")
#define FUNC_NAME s_scm_dynamic_link #define FUNC_NAME s_scm_dynamic_link
{ {
SCM z;
void *handle; void *handle;
struct dynl_obj *d;
int flags = DYNL_GLOBAL; int flags = DYNL_GLOBAL;
SCM_COERCE_ROSTRING (1, fname); 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_cons (kw, SCM_EOL));
} }
SCM_DEFER_INTS;
handle = sysdep_dynl_link (SCM_CHARS (fname), flags, FUNC_NAME); handle = sysdep_dynl_link (SCM_CHARS (fname), flags, FUNC_NAME);
d = (struct dynl_obj *)scm_must_malloc (sizeof (struct dynl_obj), SCM_RETURN_NEWSMOB2 (scm_tc16_dynamic_obj, fname, handle);
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;
} }
#undef FUNC_NAME #undef FUNC_NAME
static struct dynl_obj * 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; struct dynl_obj *d;
SCM_ASSERT (SCM_NIMP (dobj) && SCM_UNPACK_CAR (dobj) == scm_tc16_dynamic_obj, SCM_ASSERT (SCM_NIMP (dobj) && SCM_UNPACK_CAR (dobj) == scm_tc16_dynamic_obj,
dobj, argn, subr); dobj, argn, subr);
d = (struct dynl_obj *)SCM_CDR (dobj); d = DYNL_OBJ (dobj);
SCM_ASSERT (d->handle != NULL, dobj, argn, subr); SCM_ASSERT (d->handle != NULL, dobj, argn, subr);
return d; return d;
} }
@ -427,7 +414,8 @@ SCM_DEFINE (scm_dynamic_object_p, "dynamic-object?", 1, 0, 0,
"otherwise.") "otherwise.")
#define FUNC_NAME s_scm_dynamic_object_p #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 #undef FUNC_NAME
@ -444,6 +432,7 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
"") "")
#define FUNC_NAME s_scm_dynamic_unlink #define FUNC_NAME s_scm_dynamic_unlink
{ {
/*fixme* GC-problem */
struct dynl_obj *d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG1); struct dynl_obj *d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG1);
SCM_DEFER_INTS; SCM_DEFER_INTS;
sysdep_dynl_unlink (d->handle, FUNC_NAME); sysdep_dynl_unlink (d->handle, FUNC_NAME);
@ -474,14 +463,16 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
void (*func) (); void (*func) ();
SCM_COERCE_ROSTRING (1, symb); SCM_COERCE_ROSTRING (1, symb);
/*fixme* GC-problem */
d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG2); d = get_dynl_obj (dobj, FUNC_NAME, SCM_ARG2);
SCM_DEFER_INTS; 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); FUNC_NAME);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return scm_ulong2num ((unsigned long)func); return scm_ulong2num ((unsigned long) func);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -506,11 +497,11 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
"") "")
#define FUNC_NAME s_scm_dynamic_call #define FUNC_NAME s_scm_dynamic_call
{ {
void (*fptr)(); void (*fptr) ();
if (SCM_ROSTRINGP (func)) if (SCM_ROSTRINGP (func))
func = scm_dynamic_func (func, dobj); func = scm_dynamic_func (func, dobj);
fptr = (void (*)()) SCM_NUM2ULONG (1, func); fptr = (void (*) ()) SCM_NUM2ULONG (1, func);
SCM_DEFER_INTS; SCM_DEFER_INTS;
fptr (); fptr ();
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
@ -548,24 +539,23 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call", 3, 0, 0,
if (SCM_ROSTRINGP (func)) if (SCM_ROSTRINGP (func))
func = scm_dynamic_func (func, dobj); 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; SCM_DEFER_INTS;
argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, argv = scm_make_argv_from_stringlist (args, &argc, FUNC_NAME, SCM_ARG3);
SCM_ARG3);
result = (*fptr) (argc, argv); result = (*fptr) (argc, argv);
scm_must_free_argv (argv); scm_must_free_argv (argv);
SCM_ALLOW_INTS; SCM_ALLOW_INTS;
return SCM_MAKINUM(0L+result); return SCM_MAKINUM (0L + result);
} }
#undef FUNC_NAME #undef FUNC_NAME
void void
scm_init_dynamic_linking () scm_init_dynamic_linking ()
{ {
scm_tc16_dynamic_obj = scm_make_smob_type_mfpe ("dynamic-object", sizeof (struct dynl_obj), scm_tc16_dynamic_obj = scm_make_smob_type ("dynamic-object", 0);
mark_dynl_obj, free_dynl_obj, scm_set_smob_mark (scm_tc16_dynamic_obj, mark_dynl_obj);
print_dynl_obj, NULL); scm_set_smob_print (scm_tc16_dynamic_obj, print_dynl_obj);
sysdep_dynl_init (); sysdep_dynl_init ();
#include "dynl.x" #include "dynl.x"
kw_global = scm_make_keyword_from_dash_symbol (sym_global); kw_global = scm_make_keyword_from_dash_symbol (sym_global);