mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* Removed deprecated stuff.

Browse source 
* Some more renamings to SCM_<filename>_H.
This commit is contained in:
Dirk Herrmann 2001-08-31 12:13:50 +00:00
parent b29058ffee
commit dee01b012c
27 changed files with 132 additions and 728 deletions
Download patch file Download diff file Expand all files Collapse all files

46
libguile/ChangeLog
View file

@ -1,3 +1,49 @@
2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de>
* Makefile.am: Remove references to symbols-deprecated.c.
* symbols.c (scm_init_symbols): Don't initialize deprecated
symbol functions.
* symbols-deprecated.c: Removed.
* fluids.[ch] (scm_internal_with_fluids), gsubr.[ch]
(scm_make_gsubr, scm_make_gsubr_with_generic), hooks.[ch]
(scm_create_hook), list.c (list*), list.h (SCM_LIST[0-9],
scm_listify), list.[ch] (scm_sloppy_memq, scm_sloppy_memv,
scm_sloppy_member), load.c (scm_end_of_file_key), load.[ch]
(scm_read_and_eval_x), numbers.[ch] (scm_mkbig, scm_big2inum,
scm_adjbig, scm_normbig, scm_copybig, scm_2ulong2big, scm_dbl2big,
scm_big2dbl), numbers.h (SCM_FIXNUM_BIT), procs.h
(scm_subr_entry, SCM_SUBR_DOC), procs.[ch] (scm_make_subr_opt,
scm_make_subr, scm_make_subr_with_generic), root.c (setjmp_type,
setjmp_type), root.[ch] (scm_call_catching_errors), smob.[ch]
(scm_make_smob_type_mfpe, scm_set_smob_mfpe), strports.[ch]
(scm_strprint_obj, scm_read_0str, scm_eval_0str), symbols.h
(SCM_CHARS, SCM_UCHARS, SCM_SETCHARS, SCM_SLOPPY_SUBSTRP,
SCM_SUBSTR_STR, SCM_SUBSTR_OFFSET, SCM_LENGTH_MAX, SCM_LENGTH,
SCM_SETLENGTH, SCM_ROSTRINGP, SCM_ROLENGTH, SCM_ROCHARS,
SCM_ROUCHARS, SCM_SUBSTRP, SCM_COERCE_SUBSTR, scm_strhash,
scm_sym2vcell, scm_sym2ovcell_soft, scm_sym2ovcell,
scm_intern_obarray_soft, scm_intern_obarray, scm_intern,
scm_intern0, scm_sysintern, scm_sysintern0,
scm_sysintern0_no_module_lookup, scm_symbol_value0,
scm_string_to_obarray_symbol, scm_intern_symbol,
scm_unintern_symbol, scm_symbol_binding, scm_symbol_interned_p,
scm_symbol_bound_p, scm_symbol_set_x, scm_gentemp,
scm_init_symbols_deprecated), vectors.c (s_vector_set_length_x),
vectors.[ch] (scm_vector_set_length_x): Removed.
* fluids.h (FLUIDSH, SCM_FLUIDS_H), gsubr.c (GSUBRH, SCM_GSUBR_H),
list.h (LISTH, SCM_LIST_H), load.h (LOADH, SCM_LOAD_H), root.h
(ROOTH, SCM_ROOT_H), strports.h (STRPORTSH, SCM_STRPORTS_H):
Renamed the macros that are defined to inhibit double inclusion of
the same headers to the SCM_<filename>_H format.
* procs.h (SCM_CLOSUREP, SCM_PROCEDURE_WITH_SETTER_P), symbols.h
(SCM_SYMBOLP), vectors.h (SCM_VECTORP): Prefer !SCM_<foo> over
SCM_N<foo>.
2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de> 2001-08-31 Dirk Herrmann <D.Herrmann@tu-bs.de>
* continuations.h (scm_contregs), debug.h (scm_debug_info, * continuations.h (scm_contregs), debug.h (scm_debug_info,

7
libguile/Makefile.am
View file

@ -52,7 +52,7 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c \
random.c rdelim.c read.c root.c rw.c scmsigs.c script.c simpos.c smob.c \ random.c rdelim.c read.c root.c rw.c scmsigs.c script.c simpos.c smob.c \
sort.c srcprop.c stackchk.c stacks.c stime.c strings.c strop.c \ sort.c srcprop.c stackchk.c stacks.c stime.c strings.c strop.c \
strorder.c strports.c struct.c symbols.c throw.c values.c \ strorder.c strports.c struct.c symbols.c throw.c values.c \
variable.c vectors.c version.c vports.c weaks.c symbols-deprecated.c variable.c vectors.c version.c vports.c weaks.c
DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \
continuations.x debug.x deprecation.x dynl.x dynwind.x \ continuations.x debug.x deprecation.x dynl.x dynwind.x \
@ -66,7 +66,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \
scmsigs.x script.x simpos.x smob.x sort.x srcprop.x \ scmsigs.x script.x simpos.x smob.x sort.x srcprop.x \
stackchk.x stacks.x stime.x strings.x strop.x strorder.x strports.x \ stackchk.x stacks.x stime.x strings.x strop.x strorder.x strports.x \
struct.x symbols.x throw.x values.x variable.x vectors.x \ struct.x symbols.x throw.x values.x variable.x vectors.x \
version.x vports.x weaks.x symbols-deprecated.x version.x vports.x weaks.x
EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@ EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
@ -83,8 +83,7 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
scmsigs.doc script.doc simpos.doc smob.doc sort.doc \ scmsigs.doc script.doc simpos.doc smob.doc sort.doc \
srcprop.doc stackchk.doc stacks.doc stime.doc strings.doc strop.doc \ srcprop.doc stackchk.doc stacks.doc stime.doc strings.doc strop.doc \
strorder.doc strports.doc struct.doc symbols.doc throw.doc \ strorder.doc strports.doc struct.doc symbols.doc throw.doc \
values.doc variable.doc vectors.doc version.doc vports.doc weaks.doc \ values.doc variable.doc vectors.doc version.doc vports.doc weaks.doc
symbols-deprecated.doc
EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@ EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@

13
libguile/fluids.c
View file

@ -266,19 +266,6 @@ scm_init_fluids ()
#endif #endif
} }
#if SCM_DEBUG_DEPRECATED == 0
SCM
scm_internal_with_fluids (SCM fluids, SCM values, SCM (*cproc) (), void *cdata)
{
scm_c_issue_deprecation_warning ("`scm_internal_with_fluids' is deprecated. "
"Use `scm_c_with_fluids' instead.");
return scm_c_with_fluids (fluids, values, cproc, cdata);
}
#endif
/* /*
Local Variables: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"

17
libguile/fluids.h
View file

@ -1,9 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef FLUIDSH #ifndef SCM_FLUIDS_H
#define FLUIDSH #define SCM_FLUIDS_H
/* Copyright (C) 1996, 2000, 2001 Free Software Foundation, Inc. /* Copyright (C) 1996,2000,2001 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
@ -44,6 +44,7 @@
* whether to permit this exception to apply to your modifications. * 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. */
#include "libguile/__scm.h" #include "libguile/__scm.h"
#include "libguile/root.h" #include "libguile/root.h"
@ -106,15 +107,7 @@ void scm_swap_fluids_reverse (SCM fluids, SCM vals);
void scm_init_fluids (void); void scm_init_fluids (void);
#if SCM_DEBUG_DEPRECATED == 0 #endif /* SCM_FLUIDS_H */
/* Use scm_c_with_fluids instead. */
SCM scm_internal_with_fluids (SCM fluids, SCM vals,
SCM (*cproc)(void *), void *cdata);
#endif
#endif /* !FLUIDSH */
/* /*
Local Variables: Local Variables:

30
libguile/gsubr.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998, 1999, 2000, 2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 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
@ -39,7 +39,6 @@
* whether to permit this exception to apply to your modifications. * 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. */
#include <stdio.h> #include <stdio.h>
@ -278,7 +277,6 @@ gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst)
#endif #endif
void void
scm_init_gsubr() scm_init_gsubr()
{ {
@ -293,32 +291,6 @@ scm_init_gsubr()
#endif #endif
} }
#if SCM_DEBUG_DEPRECATED == 0
SCM
scm_make_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
{
scm_c_issue_deprecation_warning
("`scm_make_gsubr' is deprecated. Use `scm_c_define_gsubr' instead.");
return scm_c_define_gsubr (name, req, opt, rst, fcn);
}
SCM
scm_make_gsubr_with_generic (const char *name,
int req, int opt, int rst,
SCM (*fcn)(), SCM *gf)
{
scm_c_issue_deprecation_warning
("`scm_make_gsubr_with_generic' is deprecated. "
"Use `scm_c_define_gsubr_with_generic' instead.");
return scm_c_define_gsubr_with_generic (name, req, opt, rst, fcn, gf);
}
#endif /* !SCM_DEBUG_DEPRECATED */
/* /*
Local Variables: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"

23
libguile/gsubr.h
View file

@ -1,8 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef GSUBRH #ifndef SCM_GSUBR_H
#define GSUBRH #define SCM_GSUBR_H
/* Copyright (C) 1995,1996,1998, 2000, 2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001 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
@ -42,6 +43,7 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * 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. */
#include "libguile/__scm.h" #include "libguile/__scm.h"
@ -75,20 +77,7 @@ extern SCM scm_c_define_gsubr_with_generic (const char *name,
extern SCM scm_gsubr_apply (SCM args); extern SCM scm_gsubr_apply (SCM args);
extern void scm_init_gsubr (void); extern void scm_init_gsubr (void);
#if SCM_DEBUG_DEPRECATED == 0 #endif /* SCM_GSUBR_H */
extern SCM scm_make_gsubr (const char *name, int req, int opt, int rst,
SCM (*fcn)());
extern SCM scm_make_gsubr_with_generic (const char *name,
int req,
int opt,
int rst,
SCM (*fcn)(),
SCM *gf);
#endif
#endif /* GSUBRH */
/* /*
Local Variables: Local Variables:

11
libguile/hooks.c
View file

@ -171,17 +171,6 @@ hook_print (SCM hook, SCM port, scm_print_state *pstate)
return 1; return 1;
} }
#if (SCM_DEBUG_DEPRECATED == 0)
SCM
scm_create_hook (const char *name, int n_args)
{
SCM hook = scm_make_hook (SCM_MAKINUM (n_args));
scm_c_define (name, hook);
return scm_permanent_object (hook);
}
#endif
SCM_DEFINE (scm_make_hook, "make-hook", 0, 1, 0, SCM_DEFINE (scm_make_hook, "make-hook", 0, 1, 0,
(SCM n_args), (SCM n_args),

5
libguile/hooks.h
View file

@ -2,6 +2,7 @@
#ifndef SCM_HOOKS_H #ifndef SCM_HOOKS_H
#define SCM_HOOKS_H #define SCM_HOOKS_H
/* Copyright (C) 1995,1996,1999,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1999,2000,2001 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
@ -112,10 +113,6 @@ extern void scm_c_run_hook (SCM hook, SCM args);
extern SCM scm_hook_to_list (SCM hook); extern SCM scm_hook_to_list (SCM hook);
extern void scm_init_hooks (void); extern void scm_init_hooks (void);
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_create_hook (const char* name, int n_args);
#endif
#endif /* SCM_HOOKS_H */ #endif /* SCM_HOOKS_H */
/* /*

62
libguile/list.c
View file

@ -133,12 +133,6 @@ SCM_DEFINE (scm_list, "list", 0, 0, 1,
#undef FUNC_NAME #undef FUNC_NAME
#if (SCM_DEBUG_DEPRECATED == 0)
SCM_REGISTER_PROC (s_list_star, "list*", 1, 0, 1, scm_cons_star);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1, SCM_DEFINE (scm_cons_star, "cons*", 1, 0, 1,
(SCM arg, SCM rest), (SCM arg, SCM rest),
"Like @code{list}, but the last arg provides the tail of the\n" "Like @code{list}, but the last arg provides the tail of the\n"
@ -553,60 +547,6 @@ SCM_DEFINE (scm_list_copy, "list-copy", 1, 0, 0,
/* membership tests (memq, memv, etc.) */ /* membership tests (memq, memv, etc.) */
#if SCM_DEBUG_DEPRECATED == 0
SCM_DEFINE (scm_sloppy_memq, "sloppy-memq", 2, 0, 0,
(SCM x, SCM lst),
"This procedure behaves like @code{memq}, but does no type or error checking.\n"
"Its use is recommended only in writing Guile internals,\n"
"not for high-level Scheme programs.")
#define FUNC_NAME s_scm_sloppy_memq
{
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{
if (SCM_EQ_P (SCM_CAR (lst), x))
return lst;
}
return lst;
}
#undef FUNC_NAME
SCM_DEFINE (scm_sloppy_memv, "sloppy-memv", 2, 0, 0,
(SCM x, SCM lst),
"This procedure behaves like @code{memv}, but does no type or error checking.\n"
"Its use is recommended only in writing Guile internals,\n"
"not for high-level Scheme programs.")
#define FUNC_NAME s_scm_sloppy_memv
{
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{
if (! SCM_FALSEP (scm_eqv_p (SCM_CAR (lst), x)))
return lst;
}
return lst;
}
#undef FUNC_NAME
SCM_DEFINE (scm_sloppy_member, "sloppy-member", 2, 0, 0,
(SCM x, SCM lst),
"This procedure behaves like @code{member}, but does no type or error checking.\n"
"Its use is recommended only in writing Guile internals,\n"
"not for high-level Scheme programs.")
#define FUNC_NAME s_scm_sloppy_member
{
for(; SCM_CONSP (lst); lst = SCM_CDR(lst))
{
if (! SCM_FALSEP (scm_equal_p (SCM_CAR (lst), x)))
return lst;
}
return lst;
}
#undef FUNC_NAME
#endif /* DEPRECATED */
/* The function scm_c_memq returns the first sublist of list whose car is /* The function scm_c_memq returns the first sublist of list whose car is
* 'eq?' obj, where the sublists of list are the non-empty lists returned by * 'eq?' obj, where the sublists of list are the non-empty lists returned by
* (list-tail list k) for k less than the length of list. If obj does not * (list-tail list k) for k less than the length of list. If obj does not
@ -642,7 +582,6 @@ SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_memv, "memv", 2, 0, 0, SCM_DEFINE (scm_memv, "memv", 2, 0, 0,
(SCM x, SCM lst), (SCM x, SCM lst),
"Return the first sublist of @var{lst} whose car is @code{eqv?}\n" "Return the first sublist of @var{lst} whose car is @code{eqv?}\n"
@ -684,7 +623,6 @@ SCM_DEFINE (scm_member, "member", 2, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
/* deleting elements from a list (delq, etc.) */ /* deleting elements from a list (delq, etc.) */

40
libguile/list.h
View file

@ -1,8 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef LISTH #ifndef SCM_LIST_H
#define LISTH #define SCM_LIST_H
/* Copyright (C) 1995,1996,1997, 2000, 2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1997,2000,2001 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
@ -42,6 +43,7 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * 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. */
#include "libguile/__scm.h" #include "libguile/__scm.h"
@ -86,37 +88,7 @@ extern SCM scm_delv1_x (SCM item, SCM lst);
extern SCM scm_delete1_x (SCM item, SCM lst); extern SCM scm_delete1_x (SCM item, SCM lst);
extern void scm_init_list (void); extern void scm_init_list (void);
#endif /* SCM_LIST_H */
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_LIST0 SCM_EOL
#define SCM_LIST1(e0) scm_cons ((e0), SCM_EOL)
#define SCM_LIST2(e0, e1) scm_cons2 ((e0), (e1), SCM_EOL)
#define SCM_LIST3(e0, e1, e2) scm_cons ((e0), SCM_LIST2 ((e1), (e2)))
#define SCM_LIST4(e0, e1, e2, e3)\
scm_cons2 ((e0), (e1), SCM_LIST2 ((e2), (e3)))
#define SCM_LIST5(e0, e1, e2, e3, e4)\
scm_cons ((e0), SCM_LIST4 ((e1), (e2), (e3), (e4)))
#define SCM_LIST6(e0, e1, e2, e3, e4, e5)\
scm_cons2 ((e0), (e1), SCM_LIST4 ((e2), (e3), (e4), (e5)))
#define SCM_LIST7(e0, e1, e2, e3, e4, e5, e6)\
scm_cons ((e0), SCM_LIST6 ((e1), (e2), (e3), (e4), (e5), (e6)))
#define SCM_LIST8(e0, e1, e2, e3, e4, e5, e6, e7)\
scm_cons2 ((e0), (e1), SCM_LIST6 ((e2), (e3), (e4), (e5), (e6), (e7)))
#define SCM_LIST9(e0, e1, e2, e3, e4, e5, e6, e7, e8)\
scm_cons ((e0),\
SCM_LIST8 ((e1), (e2), (e3), (e4), (e5), (e6), (e7), (e8)))
#define scm_listify scm_list_n
extern SCM scm_sloppy_memq (SCM x, SCM lst);
extern SCM scm_sloppy_memv (SCM x, SCM lst);
extern SCM scm_sloppy_member (SCM x, SCM lst);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* LISTH */
/* /*
Local Variables: Local Variables:

24
libguile/load.c
View file

@ -470,30 +470,6 @@ scm_c_primitive_load_path (const char *filename)
return scm_primitive_load_path (scm_makfrom0str (filename)); return scm_primitive_load_path (scm_makfrom0str (filename));
} }
#if SCM_DEBUG_DEPRECATED == 0
/* Eval now copies source properties, so this function is no longer required.
*/
SCM_SYMBOL (scm_end_of_file_key, "end-of-file");
SCM_DEFINE (scm_read_and_eval_x, "read-and-eval!", 0, 1, 0,
(SCM port),
"Read a form from @var{port} (standard input by default), and evaluate it\n"
"(memoizing it in the process) in the top-level environment. If no data\n"
"is left to be read from @var{port}, an @code{end-of-file} error is\n"
"signalled.")
#define FUNC_NAME s_scm_read_and_eval_x
{
SCM form = scm_read (port);
if (SCM_EOF_OBJECT_P (form))
scm_ithrow (scm_end_of_file_key, SCM_EOL, 1);
return scm_eval_x (form, scm_current_module ());
}
#undef FUNC_NAME
#endif
/* Information about the build environment. */ /* Information about the build environment. */

12
libguile/load.h
View file

@ -1,8 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef LOADH #ifndef SCM_LOAD_H
#define LOADH #define SCM_LOAD_H
/* Copyright (C) 1995,1996,1998, 2000, 2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,1998,2000,2001 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
@ -42,7 +43,9 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * 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. */
#include "libguile/__scm.h" #include "libguile/__scm.h"
@ -58,10 +61,9 @@ extern SCM scm_search_path (SCM path, SCM filename, SCM exts);
extern SCM scm_sys_search_load_path (SCM filename); extern SCM scm_sys_search_load_path (SCM filename);
extern SCM scm_primitive_load_path (SCM filename); extern SCM scm_primitive_load_path (SCM filename);
extern SCM scm_c_primitive_load_path (const char *filename); extern SCM scm_c_primitive_load_path (const char *filename);
extern SCM scm_read_and_eval_x (SCM port);
extern void scm_init_load (void); extern void scm_init_load (void);
#endif /* LOADH */ #endif /* SCM_LOAD_H */
/* /*
Local Variables: Local Variables:

88
libguile/numbers.c
View file

@ -4454,94 +4454,6 @@ scm_init_numbers ()
#endif #endif
} }
#if (SCM_DEBUG_DEPRECATED == 0)
SCM
scm_mkbig (size_t len, int sign)
{
scm_c_issue_deprecation_warning ("`scm_mkbig' is deprecated. "
"Use `scm_i_mkbig' instead.");
return scm_i_mkbig (len, sign);
}
SCM
scm_big2inum (SCM b, size_t l)
{
scm_c_issue_deprecation_warning ("`scm_big2inum' is deprecated. "
"Use `scm_i_big2num' instead.");
return scm_i_big2inum (b, l);
}
SCM
scm_adjbig (SCM b, size_t nlen)
{
scm_c_issue_deprecation_warning ("`scm_adjbig' is deprecated. "
"Use `scm_i_adjbig' instead.");
return scm_i_adjbig (b, nlen);
}
SCM
scm_normbig (SCM b)
{
scm_c_issue_deprecation_warning ("`scm_normbig' is deprecated. "
"Use `scm_i_normbig' instead.");
return scm_i_normbig (b);
}
SCM
scm_copybig (SCM b, int sign)
{
scm_c_issue_deprecation_warning ("`scm_copybig' is deprecated. "
"Use `scm_i_copybig' instead.");
return scm_i_copybig (b, sign);
}
SCM
scm_2ulong2big (unsigned long *np)
{
unsigned long n;
size_t i;
SCM_BIGDIG *digits;
SCM ans;
ans = scm_i_mkbig (2 * SCM_DIGSPERLONG, 0);
digits = SCM_BDIGITS (ans);
n = np[0];
for (i = 0; i < SCM_DIGSPERLONG; ++i)
{
digits[i] = SCM_BIGLO (n);
n = SCM_BIGDN ((unsigned long) n);
}
n = np[1];
for (i = 0; i < SCM_DIGSPERLONG; ++i)
{
digits[i + SCM_DIGSPERLONG] = SCM_BIGLO (n);
n = SCM_BIGDN ((unsigned long) n);
}
return ans;
}
SCM
scm_dbl2big (double d)
{
scm_c_issue_deprecation_warning ("`scm_dbl2big' is deprecated. "
"Use `scm_dbl2num' instead,"
"or `scm_i_dbl2big'.");
return scm_i_dbl2big (d);
}
double
scm_big2dbl (SCM b)
{
scm_c_issue_deprecation_warning ("`scm_big2dbl' is deprecated. "
"Use `scm_num2dbl' instead,"
"or `scm_i_big2dbl'.");
return scm_i_big2dbl (b);
}
#endif
/* /*
Local Variables: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"

25
libguile/numbers.h
View file

@ -2,6 +2,7 @@
#ifndef SCM_NUMBERS_H #ifndef SCM_NUMBERS_H
#define SCM_NUMBERS_H #define SCM_NUMBERS_H
/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1998,2000,2001 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
@ -233,26 +234,11 @@ extern SCM scm_i_ulong2big (unsigned long n);
extern SCM scm_i_size2big (size_t n); extern SCM scm_i_size2big (size_t n);
extern SCM scm_i_ptrdiff2big (ptrdiff_t n); extern SCM scm_i_ptrdiff2big (ptrdiff_t n);
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_big2inum (SCM b, size_t l);
extern SCM scm_mkbig (size_t nlen, int sign);
extern SCM scm_adjbig (SCM b, size_t len);
extern SCM scm_normbig (SCM b);
extern SCM scm_copybig (SCM b, int sign);
#define SCM_FIXNUM_BIT SCM_I_FIXNUM_BIT
#endif
#ifdef HAVE_LONG_LONGS #ifdef HAVE_LONG_LONGS
extern SCM scm_i_long_long2big (long long n); extern SCM scm_i_long_long2big (long long n);
extern SCM scm_i_ulong_long2big (unsigned long long n); extern SCM scm_i_ulong_long2big (unsigned long long n);
#endif #endif
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_2ulong2big (unsigned long * np);
#endif
extern int scm_bigcomp (SCM x, SCM y); extern int scm_bigcomp (SCM x, SCM y);
extern long scm_pseudolong (long x); extern long scm_pseudolong (long x);
extern void scm_longdigs (long x, SCM_BIGDIG digs[]); extern void scm_longdigs (long x, SCM_BIGDIG digs[]);
@ -307,17 +293,8 @@ extern SCM scm_exact_to_inexact (SCM z);
extern SCM scm_inexact_to_exact (SCM z); extern SCM scm_inexact_to_exact (SCM z);
extern SCM scm_trunc (SCM x); extern SCM scm_trunc (SCM x);
extern SCM scm_i_dbl2big (double d); extern SCM scm_i_dbl2big (double d);
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_dbl2big (double d);
#endif
extern double scm_i_big2dbl (SCM b); extern double scm_i_big2dbl (SCM b);
#if (SCM_DEBUG_DEPRECATED == 0)
extern double scm_big2dbl (SCM b);
#endif
extern SCM scm_short2num (short n); extern SCM scm_short2num (short n);
extern SCM scm_ushort2num (unsigned short n); extern SCM scm_ushort2num (unsigned short n);
extern SCM scm_int2num (int n); extern SCM scm_int2num (int n);

36
libguile/procs.c
View file

@ -401,42 +401,6 @@ scm_init_procs ()
#endif #endif
} }
#if SCM_DEBUG_DEPRECATED == 0
SCM
scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
{
scm_c_issue_deprecation_warning
("`scm_make_subr_opt' is deprecated. Use `scm_c_make_subr' or "
"`scm_c_define_subr' instead.");
if (set)
return scm_c_define_subr (name, type, fcn);
else
return scm_c_make_subr (name, type, fcn);
}
SCM
scm_make_subr (const char *name, int type, SCM (*fcn) ())
{
scm_c_issue_deprecation_warning
("`scm_make_subr' is deprecated. Use `scm_c_define_subr' instead.");
return scm_c_define_subr (name, type, fcn);
}
SCM
scm_make_subr_with_generic (const char *name, int type, SCM (*fcn) (), SCM *gf)
{
scm_c_issue_deprecation_warning
("`scm_make_subr_with_generic' is deprecated. Use "
"`scm_c_define_subr_with_generic' instead.");
return scm_c_define_subr_with_generic (name, type, fcn, gf);
}
#endif /* !SCM_DEBUG_DEPRECATION */
/* /*
Local Variables: Local Variables:
c-file-style: "gnu" c-file-style: "gnu"

27
libguile/procs.h
View file

@ -2,6 +2,7 @@
#ifndef SCM_PROCS_H #ifndef SCM_PROCS_H
#define SCM_PROCS_H #define SCM_PROCS_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1998,1999,2000,2001 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
@ -63,10 +64,6 @@ typedef struct
SCM properties; /* procedure properties */ SCM properties; /* procedure properties */
} scm_t_subr_entry; } scm_t_subr_entry;
#if (SCM_DEBUG_DEPRECATED == 0)
# define scm_subr_entry scm_t_subr_entry
#endif
#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8) #define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8)
#define SCM_SET_SUBRNUM(subr, num) \ #define SCM_SET_SUBRNUM(subr, num) \
SCM_SET_CELL_WORD_0 (subr, (num << 8) + SCM_TYP7 (subr)) SCM_SET_CELL_WORD_0 (subr, (num << 8) + SCM_TYP7 (subr))
@ -92,7 +89,7 @@ typedef struct
/* Closures /* Closures
*/ */
#define SCM_CLOSUREP(x) (SCM_NIMP(x) && (SCM_TYP3 (x) == scm_tc3_closure)) #define SCM_CLOSUREP(x) (!SCM_IMP(x) && (SCM_TYP3 (x) == scm_tc3_closure))
#define SCM_CLOSCAR(x) SCM_PACK (SCM_CELL_WORD_0 (x) - scm_tc3_closure) #define SCM_CLOSCAR(x) SCM_PACK (SCM_CELL_WORD_0 (x) - scm_tc3_closure)
#define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x)) #define SCM_CODE(x) SCM_CAR (SCM_CLOSCAR (x))
#define SCM_CLOSURE_FORMALS(x) SCM_CAR (SCM_CODE (x)) #define SCM_CLOSURE_FORMALS(x) SCM_CAR (SCM_CODE (x))
@ -151,7 +148,7 @@ typedef struct
GETTER and SETTER slots can live directly on the heap, using the GETTER and SETTER slots can live directly on the heap, using the
new four-word cells. */ new four-word cells. */
#define SCM_PROCEDURE_WITH_SETTER_P(obj) (SCM_NIMP(obj) && (SCM_TYP7 (obj) == scm_tc7_pws)) #define SCM_PROCEDURE_WITH_SETTER_P(obj) (!SCM_IMP(obj) && (SCM_TYP7 (obj) == scm_tc7_pws))
#define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj) #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj)
#define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj) #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj)
@ -186,24 +183,6 @@ extern void scm_init_procs (void);
extern SCM scm_make_cclo (SCM proc, SCM len); extern SCM scm_make_cclo (SCM proc, SCM len);
#endif /*GUILE_DEBUG*/ #endif /*GUILE_DEBUG*/
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_SUBR_DOC(x) SCM_BOOL_F
extern SCM scm_make_subr (const char *name, int type, SCM (*fcn) ());
extern SCM scm_make_subr_with_generic (const char *name,
int type,
SCM (*fcn) (),
SCM *gf);
extern SCM scm_make_subr_opt (const char *name,
int type,
SCM (*fcn) (),
int set);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* SCM_PROCS_H */ #endif /* SCM_PROCS_H */
/* /*

40
libguile/root.c
View file

@ -382,46 +382,6 @@ scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler)
#if (SCM_DEBUG_DEPRECATED == 0)
/* Call thunk(closure) underneath a top-level error handler.
* If an error occurs, pass the exitval through err_filter and return it.
* If no error occurs, return the value of thunk.
*/
#ifdef _UNICOS
typedef int setjmp_type;
#else
typedef long setjmp_type;
#endif
SCM
scm_call_catching_errors (SCM (*thunk)(), SCM (*err_filter)(), void *closure)
{
SCM answer;
setjmp_type i;
#ifdef DEBUG_EXTENSIONS
SCM_DFRAME (scm_rootcont) = scm_last_debug_frame;
#endif
i = setjmp (SCM_JMPBUF (scm_rootcont));
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
if (!i)
{
scm_gc_heap_lock = 0;
answer = thunk (closure);
}
else
{
scm_gc_heap_lock = 1;
answer = err_filter (scm_exitval, closure);
}
return answer;
}
#endif /* SCM_DEBUG_DEPRECATED == 0 */
void void
scm_init_root () scm_init_root ()
{ {

19
libguile/root.h
View file

@ -1,9 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef ROOTH #ifndef SCM_ROOT_H
#define ROOTH #define SCM_ROOT_H
/* Copyright (C) 1996,1998, 2000, 2001 Free Software Foundation, Inc. /* Copyright (C) 1996,1998,2000,2001 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
@ -46,8 +46,6 @@
#include "libguile/__scm.h" #include "libguile/__scm.h"
#include "libguile/debug.h" #include "libguile/debug.h"
#include "libguile/throw.h" #include "libguile/throw.h"
@ -157,16 +155,7 @@ extern SCM scm_dynamic_root (void);
extern SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler); extern SCM scm_apply_with_dynamic_root (SCM proc, SCM a1, SCM args, SCM handler);
extern void scm_init_root (void); extern void scm_init_root (void);
#endif /* SCM_ROOT_H */
#if (SCM_DEBUG_DEPRECATED == 0)
/* Use the catch functions from throw.[ch] instead of: */
extern SCM scm_call_catching_errors (SCM (*thunk)(), SCM (*err_filter)(), void * closure);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* ROOTH */
/* /*
Local Variables: Local Variables:

33
libguile/smob.c
View file

@ -475,39 +475,6 @@ scm_make_smob (scm_t_bits tc)
return z; return z;
} }
/* {Deprecated stuff}
*/
#if (SCM_DEBUG_DEPRECATED == 0)
long
scm_make_smob_type_mfpe (char *name, size_t size,
SCM (*mark) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state *),
SCM (*equalp) (SCM, SCM))
{
long answer = scm_make_smob_type (name, size);
scm_set_smob_mfpe (answer, mark, free, print, equalp);
return answer;
}
void
scm_set_smob_mfpe (long tc,
SCM (*mark) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state *),
SCM (*equalp) (SCM, SCM))
{
if (mark) scm_set_smob_mark (tc, mark);
if (free) scm_set_smob_free (tc, free);
if (print) scm_set_smob_print (tc, print);
if (equalp) scm_set_smob_equalp (tc, equalp);
}
#endif /* SCM_DEBUG_DEPRECATED == 0 */
/* {Initialization for i/o types, float, bignum, the type of free cells} /* {Initialization for i/o types, float, bignum, the type of free cells}
*/ */

21
libguile/smob.h
View file

@ -2,6 +2,7 @@
#ifndef SCM_SMOB_H #ifndef SCM_SMOB_H
#define SCM_SMOB_H #define SCM_SMOB_H
/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1998,1999,2000,2001 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
@ -42,7 +43,9 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * 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. */
#include "libguile/__scm.h" #include "libguile/__scm.h"
#include "libguile/print.h" #include "libguile/print.h"
@ -161,24 +164,6 @@ extern void scm_set_smob_apply (scm_t_bits tc,
extern SCM scm_make_smob (scm_t_bits tc); extern SCM scm_make_smob (scm_t_bits tc);
extern void scm_smob_prehistory (void); extern void scm_smob_prehistory (void);
#if (SCM_DEBUG_DEPRECATED == 0)
extern long scm_make_smob_type_mfpe (char *name, size_t size,
SCM (*mark) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state*),
SCM (*equalp) (SCM, SCM));
extern void scm_set_smob_mfpe (long tc,
SCM (*mark) (SCM),
size_t (*free) (SCM),
int (*print) (SCM, SCM, scm_print_state*),
SCM (*equalp) (SCM, SCM));
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* SCM_SMOB_H */ #endif /* SCM_SMOB_H */
/* /*

32
libguile/strports.c
View file

@ -338,16 +338,6 @@ SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
#if (SCM_DEBUG_DEPRECATED == 0)
SCM
scm_strprint_obj (SCM obj)
{
return scm_object_to_string (obj, SCM_UNDEFINED);
}
#endif /* (SCM_DEBUG_DEPRECATED == 0) */
SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0, SCM_DEFINE (scm_call_with_output_string, "call-with-output-string", 1, 0, 0,
(SCM proc), (SCM proc),
"Calls the one-argument procedure @var{proc} with a newly created output\n" "Calls the one-argument procedure @var{proc} with a newly created output\n"
@ -450,28 +440,6 @@ scm_c_eval_string (const char *expr)
return scm_eval_string (scm_makfrom0str (expr)); return scm_eval_string (scm_makfrom0str (expr));
} }
#if SCM_DEBUG_DEPRECATED == 0
SCM
scm_read_0str (char *expr)
{
scm_c_issue_deprecation_warning
("scm_read_0str is deprecated. Use scm_c_read_string instead.");
return scm_c_read_string (expr);
}
SCM
scm_eval_0str (const char *expr)
{
scm_c_issue_deprecation_warning
("scm_eval_0str is deprecated. Use scm_c_eval_string instead.");
return scm_c_eval_string (expr);
}
#endif
static SCM static SCM
inner_eval_string (void *data) inner_eval_string (void *data)
{ {

18
libguile/strports.h
View file

@ -1,8 +1,9 @@
/* classes: h_files */ /* classes: h_files */
#ifndef STRPORTSH #ifndef SCM_STRPORTS_H
#define STRPORTSH #define SCM_STRPORTS_H
/* Copyright (C) 1995,1996, 2000, 2001 Free Software Foundation, Inc.
/* Copyright (C) 1995,1996,2000,2001 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
@ -42,6 +43,7 @@
* If you write modifications of your own for GUILE, it is your choice * If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications. * 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. */
#include "libguile/__scm.h" #include "libguile/__scm.h"
@ -77,15 +79,7 @@ extern SCM scm_c_eval_string (const char *expr);
extern SCM scm_eval_string (SCM string); extern SCM scm_eval_string (SCM string);
extern void scm_init_strports (void); extern void scm_init_strports (void);
#if (SCM_DEBUG_DEPRECATED == 0) #endif /* SCM_STRPORTS_H */
extern SCM scm_strprint_obj (SCM obj);
extern SCM scm_read_0str (char *expr);
extern SCM scm_eval_0str (const char *expr);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* STRPORTSH */
/* /*
Local Variables: Local Variables:

0
libguile/symbols-deprecated.c
View file

3
libguile/symbols.c
View file

@ -333,9 +333,6 @@ scm_init_symbols ()
#ifndef SCM_MAGIC_SNARFER #ifndef SCM_MAGIC_SNARFER
#include "libguile/symbols.x" #include "libguile/symbols.x"
#endif #endif
#if SCM_ENABLE_VCELLS
scm_init_symbols_deprecated ();
#endif
} }
/* /*

63
libguile/symbols.h
View file

@ -2,6 +2,7 @@
#ifndef SCM_SYMBOLS_H #ifndef SCM_SYMBOLS_H
#define SCM_SYMBOLS_H #define SCM_SYMBOLS_H
/* Copyright (C) 1995,1996,1997,1998,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,2000,2001 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
@ -52,7 +53,7 @@
* SCM_SYMBOL_CHARS(SYM) is the address of the first character of SYM's name. * SCM_SYMBOL_CHARS(SYM) is the address of the first character of SYM's name.
*/ */
#define SCM_SYMBOLP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol)) #define SCM_SYMBOLP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_symbol))
#define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_SYMBOL_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SET_SYMBOL_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_symbol)) #define SCM_SET_SYMBOL_LENGTH(s, l) (SCM_SET_CELL_WORD_0 ((s), ((l) << 8) + scm_tc7_symbol))
#define SCM_SYMBOL_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x))) #define SCM_SYMBOL_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
@ -90,66 +91,6 @@ extern SCM scm_gensym (SCM prefix);
extern void scm_symbols_prehistory (void); extern void scm_symbols_prehistory (void);
extern void scm_init_symbols (void); extern void scm_init_symbols (void);
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_CHARS(x) ((char *) (SCM_CELL_WORD_1 (x)))
#define SCM_UCHARS(x) ((unsigned char *) (SCM_CELL_WORD_1 (x)))
#define SCM_SETCHARS(x, v) (SCM_SET_CELL_WORD_1 ((x), (scm_t_bits) (v)))
#define SCM_SLOPPY_SUBSTRP(x) (SCM_SUBSTRP (x))
#define SCM_SUBSTR_STR(x) (SCM_CDDR (x))
#define SCM_SUBSTR_OFFSET(x) (SCM_CADR (x))
#define SCM_LENGTH_MAX (0xffffffL)
#define SCM_LENGTH(x) (((unsigned long) SCM_CELL_WORD_0 (x)) >> 8)
#define SCM_SETLENGTH(x, v, t) (SCM_SET_CELL_WORD_0 ((x), ((v) << 8) + (t)))
#define SCM_ROSTRINGP(x) (SCM_NIMP(x) && ((SCM_TYP7S(x)==scm_tc7_string) \
|| (SCM_TYP7(x) == scm_tc7_symbol)))
#define SCM_ROLENGTH(x) SCM_LENGTH (x)
#define SCM_ROCHARS(x) ((SCM_TYP7 (x) == scm_tc7_substring) \
? (SCM_INUM (SCM_CADR (x)) + SCM_STRING_CHARS (SCM_CDDR (x))) \
: ((SCM_TYP7 (x) == scm_tc7_string) \
? SCM_STRING_CHARS (x) \
: SCM_SYMBOL_CHARS (x)))
#define SCM_ROUCHARS(x) ((SCM_TYP7 (x) == scm_tc7_substring) \
? (SCM_INUM (SCM_CADR (x)) + SCM_STRING_UCHARS (SCM_CDDR (x))) \
: ((SCM_TYP7 (x) == scm_tc7_string) \
? SCM_STRING_UCHARS (x) \
: (unsigned char *) SCM_SYMBOL_CHARS (x)))
#define SCM_SUBSTRP(x) (SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_substring))
#define SCM_COERCE_SUBSTR(x) SCM_STRING_COERCE_0TERMINATION_X (x)
#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n))
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#if SCM_ENABLE_VCELLS
extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep);
extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
extern SCM scm_sym2ovcell (SCM sym, SCM obarray);
extern SCM scm_intern_obarray_soft (const char *name, size_t len, SCM obarray, unsigned int softness);
extern SCM scm_intern_obarray (const char *name, size_t len, SCM obarray);
extern SCM scm_intern (const char *name, size_t len);
extern SCM scm_intern0 (const char *name);
extern SCM scm_sysintern (const char *name, SCM val);
extern SCM scm_sysintern0 (const char *name);
extern SCM scm_sysintern0_no_module_lookup (const char *name);
extern SCM scm_symbol_value0 (const char *name);
extern SCM scm_string_to_obarray_symbol (SCM o, SCM s, SCM softp);
extern SCM scm_intern_symbol (SCM o, SCM s);
extern SCM scm_unintern_symbol (SCM o, SCM s);
extern SCM scm_symbol_binding (SCM o, SCM s);
extern SCM scm_symbol_interned_p (SCM o, SCM s);
extern SCM scm_symbol_bound_p (SCM o, SCM s);
extern SCM scm_symbol_set_x (SCM o, SCM s, SCM v);
extern SCM scm_gentemp (SCM prefix, SCM obarray);
extern void scm_init_symbols_deprecated (void);
#endif /* SCM_ENABLE_VCELLS */
#endif /* SCM_SYMBOLS_H */ #endif /* SCM_SYMBOLS_H */
/* /*

82
libguile/vectors.c
View file

@ -52,88 +52,6 @@
#include "libguile/unif.h" #include "libguile/unif.h"
#if (SCM_DEBUG_DEPRECATED == 0)
/* The function scm_vector_set_length_x will disappear in the next release of
* guile.
*/
/*
* This complicates things too much if allowed on any array.
* C code can safely call it on arrays known to be used in a single
* threaded manner.
*
* SCM_REGISTER_PROC(s_vector_set_length_x, "vector-set-length!", 2, 0, 0, scm_vector_set_length_x);
*/
static char s_vector_set_length_x[] = "vector-set-length!";
SCM
scm_vector_set_length_x (SCM vect, SCM len)
{
long l;
size_t siz;
size_t sz;
char *base;
l = SCM_INUM (len);
SCM_ASRTGO (SCM_NIMP (vect), badarg1);
#ifdef HAVE_ARRAYS
if (SCM_TYP7 (vect) == scm_tc7_bvect)
{
l = (l + SCM_LONG_BIT - 1) / SCM_LONG_BIT;
}
sz = scm_uniform_element_size (vect);
if (sz != 0)
base = SCM_UVECTOR_BASE (vect);
else
#endif
switch (SCM_TYP7 (vect))
{
default:
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
case scm_tc7_string:
SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullstr), badarg1);
sz = sizeof (char);
base = SCM_STRING_CHARS (vect);
l++;
break;
case scm_tc7_vector:
case scm_tc7_wvect:
SCM_ASRTGO (!SCM_EQ_P (vect, scm_nullvect), badarg1);
sz = sizeof (SCM);
base = (char *) SCM_VECTOR_BASE (vect);
break;
}
SCM_ASSERT (SCM_INUMP (len), len, SCM_ARG2, s_vector_set_length_x);
if (!l)
l = 1L;
siz = l * sz;
if (siz != l * sz)
scm_memory_error (s_vector_set_length_x);
SCM_REDEFER_INTS;
SCM_SETCHARS (vect,
((char *)
scm_must_realloc (base,
(size_t) SCM_LENGTH (vect) * sz,
(size_t) siz,
s_vector_set_length_x)));
if (SCM_VECTORP (vect))
{
sz = SCM_LENGTH (vect);
while (l > sz)
SCM_VELTS (vect)[--l] = SCM_UNSPECIFIED;
}
else if (SCM_STRINGP (vect))
SCM_STRING_CHARS (vect)[l - 1] = 0;
SCM_SETLENGTH (vect, SCM_INUM (len), SCM_TYP7 (vect));
SCM_REALLOW_INTS;
return vect;
}
#endif /* (SCM_DEBUG_DEPRECATED == 0) */
SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
(SCM obj), (SCM obj),
"Return @code{#t} if @var{obj} is a vector, otherwise return\n" "Return @code{#t} if @var{obj} is a vector, otherwise return\n"

11
libguile/vectors.h
View file

@ -2,6 +2,7 @@
#ifndef SCM_VECTORS_H #ifndef SCM_VECTORS_H
#define SCM_VECTORS_H #define SCM_VECTORS_H
/* Copyright (C) 1995,1996,1998,2000,2001 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1998,2000,2001 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
@ -49,7 +50,7 @@
#define SCM_VECTORP(x) (SCM_NIMP (x) && (SCM_TYP7S (x) == scm_tc7_vector)) #define SCM_VECTORP(x) (!SCM_IMP (x) && (SCM_TYP7S (x) == scm_tc7_vector))
#define SCM_VECTOR_BASE(x) ((scm_t_bits *) SCM_CELL_WORD_1 (x)) #define SCM_VECTOR_BASE(x) ((scm_t_bits *) SCM_CELL_WORD_1 (x))
#define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b))) #define SCM_SET_VECTOR_BASE(v, b) (SCM_SET_CELL_WORD_1 ((v), (b)))
#define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1) #define SCM_VECTOR_MAX_LENGTH ((1L << 24) - 1)
@ -89,14 +90,6 @@ extern SCM scm_vector_move_right_x (SCM vec1, SCM start1, SCM end1,
SCM vec2, SCM start2); SCM vec2, SCM start2);
extern void scm_init_vectors (void); extern void scm_init_vectors (void);
#if (SCM_DEBUG_DEPRECATED == 0)
extern SCM scm_vector_set_length_x (SCM vect, SCM len);
#endif /* SCM_DEBUG_DEPRECATED == 0 */
#endif /* SCM_VECTORS_H */ #endif /* SCM_VECTORS_H */
/* /*