mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
More deprecated stuff.
This commit is contained in:
Marius Vollmer
parent
bd40d4201d
commit
55d30fac0a
2 changed files with 162 additions and 29 deletions
|
|
@ -45,17 +45,163 @@
|
|||
|
||||
#include "libguile/_scm.h"
|
||||
#include "libguile/deprecated.h"
|
||||
#include "libguile/deprecation.h"
|
||||
#include "libguile/snarf.h"
|
||||
#include "libguile/validate.h"
|
||||
#include "libguile/strings.h"
|
||||
#include "libguile/strop.h"
|
||||
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#if (SCM_ENABLE_DEPRECATED == 1)
|
||||
|
||||
SCM_REGISTER_PROC(s_substring_move_left_x, "substring-move-left!", 5, 0, 0, scm_substring_move_x);
|
||||
|
||||
SCM_REGISTER_PROC(s_substring_move_right_x, "substring-move-right!", 5, 0, 0, scm_substring_move_x);
|
||||
|
||||
SCM
|
||||
scm_wta (SCM arg, const char *pos, const char *s_subr)
|
||||
{
|
||||
if (!s_subr || !*s_subr)
|
||||
s_subr = NULL;
|
||||
if ((~0x1fL) & (long) pos)
|
||||
{
|
||||
/* error string supplied. */
|
||||
scm_misc_error (s_subr, pos, scm_list_1 (arg));
|
||||
}
|
||||
else
|
||||
{
|
||||
/* numerical error code. */
|
||||
scm_t_bits error = (scm_t_bits) pos;
|
||||
|
||||
switch (error)
|
||||
{
|
||||
case SCM_ARGn:
|
||||
scm_wrong_type_arg (s_subr, 0, arg);
|
||||
case SCM_ARG1:
|
||||
scm_wrong_type_arg (s_subr, 1, arg);
|
||||
case SCM_ARG2:
|
||||
scm_wrong_type_arg (s_subr, 2, arg);
|
||||
case SCM_ARG3:
|
||||
scm_wrong_type_arg (s_subr, 3, arg);
|
||||
case SCM_ARG4:
|
||||
scm_wrong_type_arg (s_subr, 4, arg);
|
||||
case SCM_ARG5:
|
||||
scm_wrong_type_arg (s_subr, 5, arg);
|
||||
case SCM_ARG6:
|
||||
scm_wrong_type_arg (s_subr, 6, arg);
|
||||
case SCM_ARG7:
|
||||
scm_wrong_type_arg (s_subr, 7, arg);
|
||||
case SCM_WNA:
|
||||
scm_wrong_num_args (arg);
|
||||
case SCM_OUTOFRANGE:
|
||||
scm_out_of_range (s_subr, arg);
|
||||
case SCM_NALLOC:
|
||||
scm_memory_error (s_subr);
|
||||
default:
|
||||
/* this shouldn't happen. */
|
||||
scm_misc_error (s_subr, "Unknown error", SCM_EOL);
|
||||
}
|
||||
}
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
|
||||
/* Module registry
|
||||
*/
|
||||
|
||||
/* We can't use SCM objects here. One should be able to call
|
||||
SCM_REGISTER_MODULE from a C++ constructor for a static
|
||||
object. This happens before main and thus before libguile is
|
||||
initialized. */
|
||||
|
||||
struct moddata {
|
||||
struct moddata *link;
|
||||
char *module_name;
|
||||
void *init_func;
|
||||
};
|
||||
|
||||
static struct moddata *registered_mods = NULL;
|
||||
|
||||
void
|
||||
scm_register_module_xxx (char *module_name, void *init_func)
|
||||
{
|
||||
struct moddata *md;
|
||||
|
||||
scm_c_issue_deprecation_warning
|
||||
("`scm_register_module_xxx' is deprecated. Use extensions instead.");
|
||||
|
||||
/* XXX - should we (and can we) DEFER_INTS here? */
|
||||
|
||||
for (md = registered_mods; md; md = md->link)
|
||||
if (!strcmp (md->module_name, module_name))
|
||||
{
|
||||
md->init_func = init_func;
|
||||
return;
|
||||
}
|
||||
|
||||
md = (struct moddata *) malloc (sizeof (struct moddata));
|
||||
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;
|
||||
md->link = registered_mods;
|
||||
registered_mods = md;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_registered_modules, "c-registered-modules", 0, 0, 0,
|
||||
(),
|
||||
"Return a list of the object code modules that have been imported into\n"
|
||||
"the current Guile process. Each element of the list is a pair whose\n"
|
||||
"car is the name of the module, and whose cdr is the function handle\n"
|
||||
"for that module's initializer function. The name is the string that\n"
|
||||
"has been passed to scm_register_module_xxx.")
|
||||
#define FUNC_NAME s_scm_registered_modules
|
||||
{
|
||||
SCM res;
|
||||
struct moddata *md;
|
||||
|
||||
res = SCM_EOL;
|
||||
for (md = registered_mods; md; md = md->link)
|
||||
res = scm_cons (scm_cons (scm_makfrom0str (md->module_name),
|
||||
scm_ulong2num ((unsigned long) md->init_func)),
|
||||
res);
|
||||
return res;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_clear_registered_modules, "c-clear-registered-modules", 0, 0, 0,
|
||||
(),
|
||||
"Destroy the list of modules registered with the current Guile process.\n"
|
||||
"The return value is unspecified. @strong{Warning:} this function does\n"
|
||||
"not actually unlink or deallocate these modules, but only destroys the\n"
|
||||
"records of which modules have been loaded. It should therefore be used\n"
|
||||
"only by module bookkeeping operations.")
|
||||
#define FUNC_NAME s_scm_clear_registered_modules
|
||||
{
|
||||
struct moddata *md1, *md2;
|
||||
|
||||
SCM_DEFER_INTS;
|
||||
|
||||
for (md1 = registered_mods; md1; md1 = md2)
|
||||
{
|
||||
md2 = md1->link;
|
||||
free (md1);
|
||||
}
|
||||
registered_mods = NULL;
|
||||
|
||||
SCM_ALLOW_INTS;
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
void
|
||||
scm_i_init_deprecated ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -47,14 +47,28 @@
|
|||
* If you do not wish that, delete this exception notice. */
|
||||
|
||||
#include "libguile/__scm.h"
|
||||
#include "libguile/strings.h"
|
||||
|
||||
#if (SCM_ENABLE_DEPRECATED == 1)
|
||||
|
||||
#include "libguile/strings.h"
|
||||
|
||||
#define scm_substring_move_left_x scm_substring_move_x
|
||||
#define scm_substring_move_right_x scm_substring_move_x
|
||||
|
||||
typedef long long long_long;
|
||||
typedef unsigned long long ulong_long;
|
||||
|
||||
#define scm_sizet size_t
|
||||
|
||||
SCM_API SCM scm_wta (SCM arg, const char *pos, const char *s_subr);
|
||||
|
||||
#define SCM_WNA 8
|
||||
#define SCM_OUTOFRANGE 10
|
||||
#define SCM_NALLOC 11
|
||||
|
||||
SCM_API void scm_register_module_xxx (char *module_name, void *init_func);
|
||||
SCM_API SCM scm_registered_modules (void);
|
||||
SCM_API SCM scm_clear_registered_modules (void);
|
||||
|
||||
void scm_i_init_deprecated (void);
|
||||
|
||||
#endif
|
||||
|
|
@ -64,33 +78,6 @@ void scm_i_init_deprecated (void);
|
|||
#if 0
|
||||
/* TODO */
|
||||
|
||||
long_long
|
||||
ulong_long
|
||||
scm_sizet
|
||||
SCM_WNA
|
||||
SCM_OUTOFRANGE
|
||||
SCM_NALLOC
|
||||
|
||||
SCM_HUP_SIGNAL
|
||||
SCM_INT_SIGNAL
|
||||
SCM_FPE_SIGNAL
|
||||
SCM_BUS_SIGNAL
|
||||
|
||||
SCM_SEGV_SIGNAL
|
||||
SCM_ALRM_SIGNAL
|
||||
SCM_GC_SIGNAL
|
||||
SCM_TICK_SIGNAL
|
||||
|
||||
SCM_SIG_ORD
|
||||
SCM_ORD_SIG
|
||||
SCM_NUM_SIGS
|
||||
|
||||
scm_register_module_xxx
|
||||
scm_registered_modules
|
||||
|
||||
scm_clear_registered_modules
|
||||
scm_wta
|
||||
|
||||
scm_eval_3
|
||||
scm_eval2
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue