[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/libguile variable.h variable.c...
|
From: |
Marius Vollmer |
|
Subject: |
guile/guile-core/libguile variable.h variable.c... |
|
Date: |
Wed, 09 May 2001 17:48:29 -0700 |
CVSROOT: /cvs
Module name: guile
Branch: mvo-vcell-cleanup-1-branch
Changes by: Marius Vollmer <address@hidden> 01/05/09 17:48:27
Modified files:
guile-core/libguile: variable.h variable.c throw.c tag.c
symbols.h symbols.c struct.c stime.c
stacks.c srcprop.c socket.c snarf.h
script.c scmsigs.c regex-posix.c read.c
random.c ramap.c procs.c print.c posix.c
ports.c objects.c numbers.c modules.h
modules.c macros.c load.c keywords.c init.c
hooks.c gsubr.c goops.c gh_funcs.c
gh_data.c gdbint.c gc.c fports.c filesys.c
feature.c evalext.c eval.h eval.c dynwind.c
deprecation.c debug.c cpp_cnvt.awk
backtrace.h backtrace.c _scm.h
Log message:
* variable.c, variable.h (SCM_VARVCELL, SCM_UDVARIABLEP,
SCM_DEFVARIABLEP): Removed.
(SCM_VARIABLE_REF, SCM_VARIABLE_SET, SCM_VARIABLE_LOC): New.
(variable_print): Do not print name of variable.
(variable_equalp): Compare values, not vcells.
(anonymous_variable_sym): Removed.
(make_vcell_variable): Removed.
(make_variable): New, as replacement.
(scm_make_variable, scm_make_undefined_variable): Do not take name
hint parameter.
(scm_variable_ref): Check for SCM_UNDEFINED and throw "unbound"
error in that case.
(scm_builtin_variable): Removed.
* symbols.c, symbols.h (scm_sym2vcell, scm_sym2ovcell_soft,
scm_sym2ovcell, scm_intern_obarray_soft, scm_intern_obarray,
scm_intern, scm_intern0, scm_sysintern0_no_module_lookup,
scm_sysintern, scm_sysintern0, scm_symbol_value0,
scm_string_to_obarray_symbol, scm_intern_symbol,
scm_unintern_symbol, scm_symbol_binding, scm_symbol_interned,
scm_symbol_bound_p, scm_symbol_set_x, copy_and_prune_obarray,
scm_builtin_bindings, scm_gentmp, gentmp_counter): Removed.
* snarf.h (SCM_VCELL, SCM_GLOBAL_VCELL, SCM_VCELL_INIT,
SCM_GLOBAL_VCELL_INIT): Removed.
(SCM_VARIABLE, SCM_GLOBAL_VARIABLE, SCM_VARIABLE_INIT,
SCM_GLOBAL_VARIABLE_INIT): New, as replacement. Changed all uses.
* print.c (scm_iprin1): Use scm_module_reverse_lookup instead of
SCM_GLOC_SYM.
* evalext.c, filesys.c, fports.c, gdbint.c, gh_data.c, gsubr.c,
hooks.c, load.c, numbers.c, objects.c, ports.c, posix.c, procs.c,
ramap.c, random.c, read.c, regex-posix.c, scmsigs.c, script.c,
socket.c, srcprop.c, stacks.c, stime.c, struct.c, tag.c, throw.c:
Changed according to the `throughout' comments.
* modules.h, modules.c (scm_module_system_booted_p): Changed type
to `int'.
(scm_module_type): Removed.
(the_root_module): Renamed to the_root_module_var. Now points to
a variable instead of a vcell. Updated all uses.
(scm_the_root_module): Return SCM_BOOL_F when module systems
hasn't been booted yet.
(SCM_VALIDATE_STRUCT_TYPE): Removed.
(scm_post_boot_init_modules): Made static.
(scm_set_current_module): Call scm_post_boot_init_modules on first
call.
(make_modules_in, beautify_user_module_x, resolve_module,
try_module_autoload, module_make_local_var_x): Tacked on "_var"
suffix. Now point to variables instead of vcells. Updated all
uses.
(scm_module_lookup_closure): Deal with the module being SCM_BOOL_F
and return SCM_BOOL_F in that case.
(scm_module_transformer): Likewise.
(sym_module, scm_lookup_closure_module, scm_env_module): New.
(SCM_F_EVAL_CLOSURE_INTERFACE, SCM_EVAL_CLOSURE_INTERFACE_P): New.
(scm_eval_closure_lookup): Do not allow new definitions when
`interface' flag is set.
(scm_standard_interface_eval_closure): New.
(scm_pre_modules_obarray, scm_sym2var, scm_module_lookup,
scm_lookup, scm_module_define, scm_define,
scm_module_reverse_lookup, scm_get_pre_modules_obarray,
scm_modules_prehistory): New.
(scm_post_boot_init_modules): Use scm_define and scm_lookup
instead of scm_intern0.
* macros.c (scm_make_synt): Return SCM_UNSPECIFIED instead of the
symbol.
* keywords.c (s_scm_make_keyword_from_dash_symbol): Use a regular
hashtable operations to maintain the keywords, not obarray ones.
* init.c (scm_load_startup_files): Do not call
scm_post_boot_init_modules. This is done by
scm_set_current_module now.
(scm_init_guile_1): Call scm_modules_prehistory. Call
scm_init_variable early on.
* goops.c (s_scm_sys_goops_loaded): Get
var_compute_applicable_methods from scm_sym2var, not from a direct
invocation of scm_goops_lookup_closure.
* gh_funcs.c (gh_define): Return SCM_UNSPECIFIED instead of vcell.
* gc.c: Added simple debugging hack to mark phase of GC: When
activated, do not tail-call scm_gc_mark. This gives nice
backtraces.
(scm_unhash_name): Removed.
* feature.c (features): Renamed to features_var. Now points to a
variable instead of a vcell. Updated all uses.
* eval.h (SCM_TOP_LEVEL_LOOKUP_CLOSURE): Use
`scm_current_module_lookup_closure' which will do the right thing
when the module system hasn't been booted yet.
(SCM_GLOC_SYM): Removed.
(SCM_GLOC_VAR, SCM_GLOC_SET_VAL): New.
(SCM_GLOC_VAL, SCM_GLOC_LOC): Reimplemented in terms of variables.
* eval.c (scm_lookupcar, scm_lookupcar1): Deal with variables
instead of with vcells. Do not overwrite `var' with the result of
the lookup, use the new `real_var' instead. Remove `var2' in
exchange (which was only used with threads).
(sym_three_question_marks): New.
(scm_unmemocar): Use `scm_module_reverse_lookup' instead of
`SCM_GLOC_SYM'.
(scm_lisp_nil, scm_lisp_t): Directly define as symbols.
(scm_m_atfop): Expect the function definition to be a variable
instead of a vcell.
(scm_macroexp): Do not use `unmemocar', explicitely remember the
symbol instead.
(scm_unmemocopy): Removed thoughts about anti-macro interface.
(scm_eval_args): Use more explicit code in the gloc branch of the
atrocious struct ambiguity test. The optimizer will sort this
out.
(scm_deval_args): Likewise.
(SCM_CEVAL): Likewise. Also, do not use unmemocar, explicitely
remember the symbol instead. Added some comments where
scm_tc3_cons_gloc really exclusively refers to structs.
(scm_init_eval): Use scm_define to initialize "nil" and "t" to
scm_lisp_nil and scm_lisp_t, respectively. Use scm_define instead
of scm_sysintern in general.
* dynwind.c (scm_swap_bindings): Use SCM_GLOC_SET_VAL instead of
explicit magic.
* debug.c (s_scm_make_gloc): Only allow proper variables, no
pairs. Put the variable directly in the gloc.
(s_scm_gloc_p): Use `scm_tc3_cons_gloc' instead of the magic `1'.
(scm_init_debug): Use scm_define instead scm_sysintern.
* cpp_cnvt.awk: Emit "scm_define" instead of "scm_sysintern".
* backtrace.h, backtrace.c (scm_the_last_stack_fluid): Renamed to
scm_the_last_stack_fluid_var. It now points to a variable instead
of a vcell. Updated all uses.
(scm_has_shown_backtrace_hint_p_var): Now points to a variable
instead of a vcell. Updated all uses.
* _scm.h: Include "variables.h" and "modules.h" since almost
everybody needs them now.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/variable.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.17&tr2=1.17.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/variable.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.34&tr2=1.34.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/throw.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.80&tr2=1.80.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/tag.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.24&tr2=1.24.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.51&tr2=1.51.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.85&tr2=1.85.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/struct.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.75&tr2=1.75.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/stime.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.65&tr2=1.65.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/stacks.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.57&tr2=1.57.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/srcprop.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.46&tr2=1.46.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/socket.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.74&tr2=1.74.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/snarf.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.44&tr2=1.44.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/script.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.38&tr2=1.38.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/scmsigs.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.56&tr2=1.56.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/regex-posix.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.50&tr2=1.50.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/read.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.67&tr2=1.67.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/random.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.40&tr2=1.40.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ramap.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.68&tr2=1.68.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/procs.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.53&tr2=1.53.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/print.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.121&tr2=1.121.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/posix.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.88&tr2=1.88.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ports.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.142&tr2=1.142.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/objects.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.56&tr2=1.56.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/numbers.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.127&tr2=1.127.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.13&tr2=1.13.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.22&tr2=1.22.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/macros.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.27&tr2=1.27.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/load.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.57&tr2=1.57.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/keywords.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.38&tr2=1.38.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/init.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.120&tr2=1.120.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/hooks.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.13&tr2=1.13.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gsubr.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.35&tr2=1.35.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/goops.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.28&tr2=1.28.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_funcs.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.8&tr2=1.8.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_data.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.58&tr2=1.58.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gdbint.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.38&tr2=1.38.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gc.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.195&tr2=1.195.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/fports.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.93&tr2=1.93.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/filesys.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.96&tr2=1.96.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/feature.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.45&tr2=1.45.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/evalext.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.32&tr2=1.32.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.52&tr2=1.52.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.218&tr2=1.218.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/dynwind.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.35&tr2=1.35.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/deprecation.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.2&tr2=1.2.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/debug.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.86&tr2=1.86.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/cpp_cnvt.awk.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.1&tr2=1.1.18.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/backtrace.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.13&tr2=1.13.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/backtrace.c.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.62&tr2=1.62.2.1&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/_scm.h.diff?cvsroot=OldCVS&only_with_tag=mvo-vcell-cleanup-1-branch&tr1=1.22&tr2=1.22.2.1&r1=text&r2=text
Patches:
Index: guile/guile-core/libguile/_scm.h
diff -u guile/guile-core/libguile/_scm.h:1.21
guile/guile-core/libguile/_scm.h:1.22
--- guile/guile-core/libguile/_scm.h:1.21 Tue May 16 05:11:08 2000
+++ guile/guile-core/libguile/_scm.h Sat Mar 10 08:56:06 2001
@@ -2,7 +2,7 @@
#ifndef _SCMH
#define _SCMH
-/* Copyright (C) 1995,1996, 2000 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
* it under the terms of the GNU General Public License as published by
@@ -75,11 +75,6 @@
switching at async ticks. */
#endif
#include "libguile/snarf.h" /* Everyone snarfs. */
-
-/* On VMS, GNU C's errno.h contains a special hack to get link attributes
- * for errno correct for linking to the C RTL.
- */
-#include <errno.h>
/* SCM_SYSCALL retries system calls that have been interrupted (EINTR).
However this can be avoided if the operating system can restart
Index: guile/guile-core/libguile/backtrace.c
diff -u guile/guile-core/libguile/backtrace.c:1.61
guile/guile-core/libguile/backtrace.c:1.62
--- guile/guile-core/libguile/backtrace.c:1.61 Fri Mar 9 15:33:37 2001
+++ guile/guile-core/libguile/backtrace.c Sat Mar 31 13:19:50 2001
@@ -604,6 +604,8 @@
display_frame (frame, nfield, indentation, sport, a->port, pstate);
}
+ scm_remember_upto_here_1 (print_state);
+
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/backtrace.h
diff -u guile/guile-core/libguile/backtrace.h:1.12
guile/guile-core/libguile/backtrace.h:1.13
--- guile/guile-core/libguile/backtrace.h:1.12 Mon Jun 12 05:28:23 2000
+++ guile/guile-core/libguile/backtrace.h Wed Jan 24 07:58:46 2001
@@ -52,6 +52,7 @@
extern SCM scm_the_last_stack_fluid;
void scm_display_error_message (SCM message, SCM args, SCM port);
+void scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM
args, SCM rest);
SCM scm_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM args,
SCM rest);
SCM scm_display_application (SCM frame, SCM port, SCM indent);
SCM scm_display_backtrace (SCM stack, SCM port, SCM first, SCM depth);
Index: guile/guile-core/libguile/debug.c
diff -u guile/guile-core/libguile/debug.c:1.85
guile/guile-core/libguile/debug.c:1.86
--- guile/guile-core/libguile/debug.c:1.85 Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/debug.c Thu Apr 19 08:20:27 2001
@@ -426,16 +426,15 @@
switch (SCM_TYP7 (proc)) {
case scm_tcs_closures:
{
- SCM src;
- src = scm_source_property (SCM_CDR (SCM_CODE (proc)), scm_sym_copy);
- if (! SCM_FALSEP (src))
- return scm_cons2 (scm_sym_lambda, SCM_CLOSURE_FORMALS (proc), src);
- src = SCM_CODE (proc);
+ SCM formals = SCM_CLOSURE_FORMALS (proc);
+ SCM src = scm_source_property (SCM_CDR (SCM_CODE (proc)), scm_sym_copy);
+ if (!SCM_FALSEP (src))
+ return scm_cons2 (scm_sym_lambda, formals, src);
return scm_cons (scm_sym_lambda,
- scm_unmemocopy (src,
- SCM_EXTEND_ENV (SCM_CAR (src),
- SCM_EOL,
- SCM_ENV (proc))));
+ scm_unmemocopy (SCM_CODE (proc),
+ SCM_EXTEND_ENV (formals,
+ SCM_EOL,
+ SCM_ENV (proc))));
}
case scm_tcs_subrs:
#ifdef CCLO
Index: guile/guile-core/libguile/deprecation.c
diff -u guile/guile-core/libguile/deprecation.c:1.1
guile/guile-core/libguile/deprecation.c:1.2
--- guile/guile-core/libguile/deprecation.c:1.1 Tue May 1 17:45:45 2001
+++ guile/guile-core/libguile/deprecation.c Wed May 9 09:32:06 2001
@@ -116,8 +116,8 @@
SCM_DEFINE(scm_include_deprecated_features,
"include-deprecated-features", 0, 0, 0,
(),
- "Return @code{#t} iff deprecated features should be included
- in public interfaces.")
+ "Return @code{#t} iff deprecated features should be included\n"
+ "in public interfaces.")
#define FUNC_NAME s_scm_include_deprecated_features
{
#if SCM_DEBUG_DEPRECATED == 0
Index: guile/guile-core/libguile/dynwind.c
diff -u guile/guile-core/libguile/dynwind.c:1.34
guile/guile-core/libguile/dynwind.c:1.35
--- guile/guile-core/libguile/dynwind.c:1.34 Fri Mar 9 15:33:38 2001
+++ guile/guile-core/libguile/dynwind.c Tue Apr 3 06:19:04 2001
@@ -70,60 +70,66 @@
SCM_DEFINE (scm_dynamic_wind, "dynamic-wind", 3, 0, 0,
- (SCM thunk1, SCM thunk2, SCM thunk3),
- "All three arguments must be 0-argument procedures.\n\n"
- "@var{in-guard} is called, then @var{thunk}, then
@var{out-guard}.\n\n"
- "If, any time during the execution of @var{thunk}, the
continuation\n"
- "of the @code{dynamic-wind} expression is escaped non-locally,
@var{out-guard}\n"
- "is called. If the continuation of the dynamic-wind is
re-entered,\n"
- "@var{in-guard} is called. Thus @var{in-guard} and
@var{out-guard} may\n"
- "be called any number of times.\n\n"
- "@example\n"
+ (SCM in_guard, SCM thunk, SCM out_guard),
+ "All three arguments must be 0-argument procedures.\n"
+ "@var{in_guard} is called, then @var{thunk}, then\n"
+ "@var{out_guard}.\n"
+ "\n"
+ "If, any time during the execution of @var{thunk}, the\n"
+ "continuation of the @code{dynamic_wind} expression is escaped\n"
+ "non-locally, @var{out_guard} is called. If the continuation of\n"
+ "the dynamic-wind is re-entered, @var{in_guard} is called. Thus\n"
+ "@var{in_guard} and @var{out_guard} may be called any number of\n"
+ "times.\n"
+ "@lisp\n"
"(define x 'normal-binding)\n"
- "@result{} x\n\n"
+ "@result{} x\n"
"(define a-cont (call-with-current-continuation \n"
" (lambda (escape)\n"
" (let ((old-x x))\n"
" (dynamic-wind\n"
" ;; in-guard:\n"
" ;;\n"
- " (lambda () (set! x 'special-binding))\n\n"
+ " (lambda () (set! x 'special-binding))\n"
+ "\n"
" ;; thunk\n"
" ;;\n"
" (lambda () (display x) (newline)\n"
" (call-with-current-continuation
escape)\n"
" (display x) (newline)\n"
- " x)\n\n"
+ " x)\n"
+ "\n"
" ;; out-guard:\n"
" ;;\n"
- " (lambda () (set! x old-x)))))))\n\n"
+ " (lambda () (set! x old-x)))))))\n"
+ "\n"
";; Prints: \n"
"special-binding\n"
";; Evaluates to:\n"
- "@result{} a-cont\n\n"
+ "@result{} a-cont\n"
"x\n"
- "@result{} normal-binding\n\n"
+ "@result{} normal-binding\n"
"(a-cont #f)\n"
";; Prints:\n"
"special-binding\n"
";; Evaluates to:\n"
- "@result{} a-cont ;; the value of the (define a-cont...)\n\n"
+ "@result{} a-cont ;; the value of the (define a-cont...)\n"
"x\n"
- "@result{} normal-binding\n\n"
+ "@result{} normal-binding\n"
"a-cont\n"
"@result{} special-binding\n"
- "@end example\n")
+ "@end lisp")
#define FUNC_NAME s_scm_dynamic_wind
{
SCM ans;
- SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk3)),
- thunk3,
+ SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (out_guard)),
+ out_guard,
SCM_ARG3, FUNC_NAME);
- scm_apply (thunk1, SCM_EOL, SCM_EOL);
- scm_dynwinds = scm_acons (thunk1, thunk3, scm_dynwinds);
- ans = scm_apply (thunk2, SCM_EOL, SCM_EOL);
+ scm_apply (in_guard, SCM_EOL, SCM_EOL);
+ scm_dynwinds = scm_acons (in_guard, out_guard, scm_dynwinds);
+ ans = scm_apply (thunk, SCM_EOL, SCM_EOL);
scm_dynwinds = SCM_CDR (scm_dynwinds);
- scm_apply (thunk3, SCM_EOL, SCM_EOL);
+ scm_apply (out_guard, SCM_EOL, SCM_EOL);
return ans;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.217
guile/guile-core/libguile/eval.c:1.218
--- guile/guile-core/libguile/eval.c:1.217 Fri May 4 14:54:00 2001
+++ guile/guile-core/libguile/eval.c Wed May 9 13:25:44 2001
@@ -3918,6 +3918,7 @@
SCM
scm_i_eval (SCM exp, SCM env)
{
+ exp = scm_copy_tree (exp);
return SCM_XEVAL (exp, env);
}
Index: guile/guile-core/libguile/eval.h
diff -u guile/guile-core/libguile/eval.h:1.51
guile/guile-core/libguile/eval.h:1.52
--- guile/guile-core/libguile/eval.h:1.51 Fri Mar 30 07:03:22 2001
+++ guile/guile-core/libguile/eval.h Tue Apr 24 16:27:13 2001
@@ -137,9 +137,9 @@
#if SCM_DEBUG_DEPRECATED == 0
extern SCM scm_top_level_lookup_closure_var;
+extern SCM scm_system_transformer;
#endif
-extern SCM scm_system_transformer;
extern const char scm_s_expression[];
Index: guile/guile-core/libguile/evalext.c
diff -u guile/guile-core/libguile/evalext.c:1.31
guile/guile-core/libguile/evalext.c:1.32
--- guile/guile-core/libguile/evalext.c:1.31 Sat May 5 12:03:42 2001
+++ guile/guile-core/libguile/evalext.c Sat May 5 17:02:06 2001
@@ -72,8 +72,8 @@
SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0,
(SCM sym, SCM env),
"Return @code{#t} if @var{sym} is defined in the lexical "
- "address@hidden When @var{env} is not specified, "
- "look in the top-level environment as as defined by the "
+ "environment @var{env}. When @var{env} is not specified, "
+ "look in the top-level environment as defined by the "
"current module.")
#define FUNC_NAME s_scm_definedp
{
Index: guile/guile-core/libguile/feature.c
diff -u guile/guile-core/libguile/feature.c:1.44
guile/guile-core/libguile/feature.c:1.45
--- guile/guile-core/libguile/feature.c:1.44 Fri Dec 8 09:08:34 2000
+++ guile/guile-core/libguile/feature.c Fri Mar 9 15:33:38 2001
@@ -44,7 +44,6 @@
-#include <stdio.h>
#ifdef HAVE_STRING_H
#include <string.h>
#endif
Index: guile/guile-core/libguile/filesys.c
diff -u guile/guile-core/libguile/filesys.c:1.95
guile/guile-core/libguile/filesys.c:1.96
--- guile/guile-core/libguile/filesys.c:1.95 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/filesys.c Tue Apr 10 00:57:05 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 Free Software
Foundation, Inc.
+/* Copyright (C) 1996,1997,1998,1999,2000,2001 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
@@ -243,8 +243,8 @@
SCM_VALIDATE_STRING (1, path);
SCM_STRING_COERCE_0TERMINATION_X (path);
- iflags = SCM_NUM2LONG(2,flags);
- imode = SCM_NUM2LONG_DEF(3,mode,0666);
+ iflags = SCM_NUM2LONG (2, flags);
+ imode = SCM_NUM2LONG_DEF (3, mode, 0666);
SCM_SYSCALL (fd = open (SCM_STRING_CHARS (path), iflags, imode));
if (fd == -1)
SCM_SYSERROR;
@@ -286,7 +286,7 @@
int iflags;
fd = SCM_INUM (scm_open_fdes (path, flags, mode));
- iflags = SCM_NUM2LONG (2,flags);
+ iflags = SCM_NUM2LONG (2, flags);
if (iflags & O_RDWR)
{
if (iflags & O_APPEND)
Index: guile/guile-core/libguile/fports.c
diff -u guile/guile-core/libguile/fports.c:1.92
guile/guile-core/libguile/fports.c:1.93
--- guile/guile-core/libguile/fports.c:1.92 Sat Mar 17 08:59:48 2001
+++ guile/guile-core/libguile/fports.c Tue Apr 3 06:19:04 2001
@@ -243,12 +243,12 @@
* Return the new port.
*/
SCM_DEFINE (scm_open_file, "open-file", 2, 0, 0,
- (SCM filename, SCM modes),
- "Open the file whose name is @var{string}, and return a port\n"
+ (SCM filename, SCM mode),
+ "Open the file whose name is @var{filename}, and return a port\n"
"representing that file. The attributes of the port are\n"
- "determined by the @var{mode} string. The way in \n"
- "which this is interpreted is similar to C stdio:\n\n"
- "The first character must be one of the following:\n\n"
+ "determined by the @var{mode} string. The way in which this is\n"
+ "interpreted is similar to C stdio. The first character must be\n"
+ "one of the following:\n"
"@table @samp\n"
"@item r\n"
"Open an existing file for input.\n"
@@ -256,48 +256,49 @@
"Open a file for output, creating it if it doesn't already exist\n"
"or removing its contents if it does.\n"
"@item a\n"
- "Open a file for output, creating it if it doesn't already exist.\n"
- "All writes to the port will go to the end of the file.\n"
+ "Open a file for output, creating it if it doesn't already\n"
+ "exist. All writes to the port will go to the end of the file.\n"
"The \"append mode\" can be turned off while the port is in use\n"
"@pxref{Ports and File Descriptors, fcntl}\n"
- "@end table\n\n"
- "The following additional characters can be appended:\n\n"
+ "@end table\n"
+ "The following additional characters can be appended:\n"
"@table @samp\n"
"@item +\n"
"Open the port for both input and output. E.g., @code{r+}: open\n"
"an existing file for both input and output.\n"
"@item 0\n"
- "Create an \"unbuffered\" port. In this case input and output
operations\n"
- "are passed directly to the underlying port implementation
without\n"
- "additional buffering. This is likely to slow down I/O
operations.\n"
- "The buffering mode can be changed while a port is in use\n"
- "@pxref{Ports and File Descriptors, setvbuf}\n"
+ "Create an \"unbuffered\" port. In this case input and output\n"
+ "operations are passed directly to the underlying port\n"
+ "implementation without additional buffering. This is likely to\n"
+ "slow down I/O operations. The buffering mode can be changed\n"
+ "while a port is in use @pxref{Ports and File Descriptors,\n"
+ "setvbuf}\n"
"@item l\n"
"Add line-buffering to the port. The port output buffer will be\n"
"automatically flushed whenever a newline character is written.\n"
- "@end table\n\n"
- "In theory we could create read/write ports which were buffered in
one\n"
- "direction only. However this isn't included in the current
interfaces.\n\n"
- "If a file cannot be opened with the access requested,\n"
- "@code{open-file} throws an exception.")
+ "@end table\n"
+ "In theory we could create read/write ports which were buffered\n"
+ "in one direction only. However this isn't included in the\n"
+ "current interfaces. If a file cannot be opened with the access\n"
+ "requested, @code{open-file} throws an exception.")
#define FUNC_NAME s_scm_open_file
{
SCM port;
int fdes;
int flags = 0;
char *file;
- char *mode;
+ char *md;
char *ptr;
SCM_VALIDATE_STRING (1, filename);
- SCM_VALIDATE_STRING (2, modes);
+ SCM_VALIDATE_STRING (2, mode);
SCM_STRING_COERCE_0TERMINATION_X (filename);
- SCM_STRING_COERCE_0TERMINATION_X (modes);
+ SCM_STRING_COERCE_0TERMINATION_X (mode);
file = SCM_STRING_CHARS (filename);
- mode = SCM_STRING_CHARS (modes);
+ md = SCM_STRING_CHARS (mode);
- switch (*mode)
+ switch (*md)
{
case 'r':
flags |= O_RDONLY;
@@ -309,9 +310,9 @@
flags |= O_WRONLY | O_CREAT | O_APPEND;
break;
default:
- scm_out_of_range (FUNC_NAME, modes);
+ scm_out_of_range (FUNC_NAME, mode);
}
- ptr = mode + 1;
+ ptr = md + 1;
while (*ptr != '\0')
{
switch (*ptr)
@@ -328,7 +329,7 @@
case 'l': /* line buffered: handled during output. */
break;
default:
- scm_out_of_range (FUNC_NAME, modes);
+ scm_out_of_range (FUNC_NAME, mode);
}
ptr++;
}
@@ -341,7 +342,7 @@
scm_cons (scm_makfrom0str (strerror (en)),
scm_cons (filename, SCM_EOL)), en);
}
- port = scm_fdes_to_port (fdes, mode, filename);
+ port = scm_fdes_to_port (fdes, md, filename);
return port;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/gc.c
diff -u guile/guile-core/libguile/gc.c:1.194
guile/guile-core/libguile/gc.c:1.195
--- guile/guile-core/libguile/gc.c:1.194 Fri Apr 27 14:09:02 2001
+++ guile/guile-core/libguile/gc.c Tue May 8 03:23:17 2001
@@ -2699,6 +2699,7 @@
scm_tc16_allocated = scm_make_smob_type ("allocated cell", 0);
#endif /* SCM_DEBUG_CELL_ACCESSES == 1 */
+ /* Dirk:FIXME:: scm_create_hook is strange. */
scm_after_gc_hook = scm_create_hook ("after-gc-hook", 0);
after_gc_thunk = scm_make_subr_opt ("%gc-thunk", scm_tc7_subr_0,
gc_async_thunk, 0);
Index: guile/guile-core/libguile/gdbint.c
diff -u guile/guile-core/libguile/gdbint.c:1.37
guile/guile-core/libguile/gdbint.c:1.38
--- guile/guile-core/libguile/gdbint.c:1.37 Fri Mar 9 15:33:39 2001
+++ guile/guile-core/libguile/gdbint.c Thu Mar 22 04:52:02 2001
@@ -1,5 +1,5 @@
/* GDB interface for Guile
- * Copyright (C) 1996, 1997, 1999, 2000 Free Software Foundation
+ * Copyright (C) 1996,1997,1999,2000,2001 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
@@ -329,7 +329,7 @@
s);
gdb_input_port = scm_permanent_object (port);
- tok_buf = scm_permanent_object (scm_makstr (30L, 0));
+ tok_buf = scm_permanent_object (scm_allocate_string (30));
}
/*
Index: guile/guile-core/libguile/gh_data.c
diff -u guile/guile-core/libguile/gh_data.c:1.57
guile/guile-core/libguile/gh_data.c:1.58
--- guile/guile-core/libguile/gh_data.c:1.57 Sat Apr 28 10:23:48 2001
+++ guile/guile-core/libguile/gh_data.c Mon May 7 11:11:20 2001
@@ -700,18 +700,26 @@
SCM
gh_lookup (const char *sname)
{
- return gh_module_lookup (SCM_BOOL_F, sname);
+ return gh_module_lookup (scm_current_module (), sname);
}
+
SCM
-gh_module_lookup (SCM vec, const char *sname)
+gh_module_lookup (SCM module, const char *sname)
+#define FUNC_NAME "gh_module_lookup"
{
- SCM sym = gh_symbol2scm (sname);
- if (SCM_EQ_P (scm_symbol_bound_p (vec, sym), SCM_BOOL_T))
- return scm_symbol_binding (vec, sym);
+ SCM sym, cell;
+
+ SCM_VALIDATE_MODULE (SCM_ARG1, module);
+
+ sym = gh_symbol2scm (sname);
+ cell = scm_sym2vcell (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+ if (cell != SCM_BOOL_F)
+ return SCM_CDR (cell);
else
return SCM_UNDEFINED;
}
+#undef FUNC_NAME
/*
Local Variables:
Index: guile/guile-core/libguile/gh_funcs.c
diff -u guile/guile-core/libguile/gh_funcs.c:1.7
guile/guile-core/libguile/gh_funcs.c:1.8
--- guile/guile-core/libguile/gh_funcs.c:1.7 Mon Jun 12 05:28:23 2000
+++ guile/guile-core/libguile/gh_funcs.c Fri Mar 9 15:33:39 2001
@@ -43,8 +43,6 @@
/* Defining Scheme functions implemented by C functions --- subrs. */
-#include <stdio.h>
-
#include "libguile/gh.h"
/* allows you to define new scheme primitives written in C */
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.27
guile/guile-core/libguile/goops.c:1.28
--- guile/guile-core/libguile/goops.c:1.27 Tue Apr 10 19:09:35 2001
+++ guile/guile-core/libguile/goops.c Thu Apr 19 07:46:01 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001 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
@@ -1065,7 +1065,7 @@
code = SCM_CAR (access);
if (!SCM_CLOSUREP (code))
return SCM_SUBRF (code) (obj);
- env = SCM_EXTEND_ENV (SCM_CAR (SCM_CODE (code)),
+ env = SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (code),
SCM_LIST1 (obj),
SCM_ENV (code));
/* Evaluate the closure body */
@@ -1104,7 +1104,7 @@
SCM_SUBRF (code) (obj, value);
else
{
- env = SCM_EXTEND_ENV (SCM_CAR (SCM_CODE (code)),
+ env = SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (code),
SCM_LIST2 (obj, value),
SCM_ENV (code));
/* Evaluate the closure body */
Index: guile/guile-core/libguile/gsubr.c
diff -u guile/guile-core/libguile/gsubr.c:1.34
guile/guile-core/libguile/gsubr.c:1.35
--- guile/guile-core/libguile/gsubr.c:1.34 Wed Dec 6 08:24:00 2000
+++ guile/guile-core/libguile/gsubr.c Mon Dec 11 06:48:23 2000
@@ -59,7 +59,8 @@
/* #define GSUBR_TEST */
-SCM scm_sym_name;
+SCM_GLOBAL_SYMBOL (scm_sym_name, "name");
+
SCM scm_f_gsubr_apply;
SCM
@@ -207,10 +208,13 @@
scm_init_gsubr()
{
scm_f_gsubr_apply = scm_make_subr_opt("gsubr-apply", scm_tc7_lsubr,
scm_gsubr_apply, 0);
- scm_sym_name = SCM_CAR (scm_sysintern ("name", SCM_UNDEFINED));
- scm_permanent_object (scm_sym_name);
+
#ifdef GSUBR_TEST
scm_make_gsubr("gsubr-2-1-l", 2, 1, 1, gsubr_21l); /* example */
+#endif
+
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/gsubr.x"
#endif
}
Index: guile/guile-core/libguile/hooks.c
diff -u guile/guile-core/libguile/hooks.c:1.12
guile/guile-core/libguile/hooks.c:1.13
--- guile/guile-core/libguile/hooks.c:1.12 Tue May 8 03:23:17 2001
+++ guile/guile-core/libguile/hooks.c Tue May 8 03:30:32 2001
@@ -247,7 +247,7 @@
SCM arity, rest;
int n_args;
SCM_VALIDATE_HOOK (1,hook);
- SCM_ASSERT (SCM_NFALSEP (arity = scm_i_procedure_arity (proc)),
+ SCM_ASSERT (!SCM_FALSEP (arity = scm_i_procedure_arity (proc)),
proc, SCM_ARG2, FUNC_NAME);
n_args = SCM_HOOK_ARITY (hook);
if (SCM_INUM (SCM_CAR (arity)) > n_args
Index: guile/guile-core/libguile/init.c
diff -u guile/guile-core/libguile/init.c:1.119
guile/guile-core/libguile/init.c:1.120
--- guile/guile-core/libguile/init.c:1.119 Tue May 1 17:47:50 2001
+++ guile/guile-core/libguile/init.c Tue May 8 03:23:17 2001
@@ -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
* it under the terms of the GNU General Public License as published by
@@ -508,7 +508,7 @@
scm_init_deprecation (); /* Requires hashtabs */
scm_init_objprop ();
scm_init_properties ();
- scm_init_hooks (); /* Requires objprop until hook names are removed */
+ scm_init_hooks (); /* Requires smob_prehistory */
scm_init_gc (); /* Requires hooks, async */
#ifdef GUILE_ISELECT
scm_init_iselect ();
Index: guile/guile-core/libguile/keywords.c
diff -u guile/guile-core/libguile/keywords.c:1.37
guile/guile-core/libguile/keywords.c:1.38
--- guile/guile-core/libguile/keywords.c:1.37 Fri Mar 30 07:03:22 2001
+++ guile/guile-core/libguile/keywords.c Tue Apr 3 06:19:04 2001
@@ -109,7 +109,8 @@
SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
(SCM obj),
- "Returns @code{#t} if the argument @var{obj} is a keyword, else
@code{#f}.")
+ "Return @code{#t} if the argument @var{obj} is a keyword, else\n"
+ "@code{#f}.")
#define FUNC_NAME s_scm_keyword_p
{
return SCM_BOOL (SCM_KEYWORDP (obj));
Index: guile/guile-core/libguile/load.c
diff -u guile/guile-core/libguile/load.c:1.56
guile/guile-core/libguile/load.c:1.57
--- guile/guile-core/libguile/load.c:1.56 Sun Mar 11 01:44:08 2001
+++ guile/guile-core/libguile/load.c Sun Mar 11 23:08:46 2001
@@ -103,12 +103,13 @@
SCM_DEFINE (scm_primitive_load, "primitive-load", 1, 0, 0,
(SCM filename),
- "Load @var{file} and evaluate its contents in the top-level
environment.\n"
- "The load paths are not searched; @var{file} must either be a
full\n"
- "pathname or be a pathname relative to the current directory. If
the\n"
- "variable @code{%load-hook} is defined, it should be bound to a
procedure\n"
- "that will be called before any code is loaded. See documentation
for\n"
- "@code{%load-hook} later in this section.")
+ "Load the file named @var{filename} and evaluate its contents in\n"
+ "the top-level environment. The load paths are not searched;\n"
+ "@var{filename} must either be a full pathname or be a pathname\n"
+ "relative to the current directory. If the variable\n"
+ "@code{%load-hook} is defined, it should be bound to a procedure\n"
+ "that will be called before any code is loaded. See the\n"
+ "documentation for @code{%load-hook} later in this section.")
#define FUNC_NAME s_scm_primitive_load
{
SCM hook = *scm_loc_load_hook;
@@ -409,13 +410,14 @@
If we find one, return its full filename; otherwise, return #f.
If FILENAME is absolute, return it unchanged. */
SCM_DEFINE (scm_sys_search_load_path, "%search-load-path", 1, 0, 0,
- (SCM filename),
- "Search @var{%load-path} for @var{file}, which must be readable by
the\n"
- "current user. If @var{file} is found in the list of paths to
search or\n"
- "is an absolute pathname, return its full pathname. Otherwise,
return\n"
- "@code{#f}. Filenames may have any of the optional extensions in
the\n"
- "@code{%load-extensions} list; @code{%search-load-path} will try
each\n"
- "extension automatically.")
+ (SCM filename),
+ "Search @var{%load-path} for the file named @var{filename},\n"
+ "which must be readable by the current user. If @var{filename}\n"
+ "is found in the list of paths to search or is an absolute\n"
+ "pathname, return its full pathname. Otherwise, return\n"
+ "@code{#f}. Filenames may have any of the optional extensions\n"
+ "in the @code{%load-extensions} list; @code{%search-load-path}\n"
+ "will try each extension automatically.")
#define FUNC_NAME s_scm_sys_search_load_path
{
SCM path = *scm_loc_load_path;
@@ -432,10 +434,11 @@
SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 1, 0, 0,
- (SCM filename),
- "Search @var{%load-path} for @var{file} and load it into the
top-level\n"
- "environment. If @var{file} is a relative pathname and is not
found in\n"
- "the list of search paths, an error is signalled.")
+ (SCM filename),
+ "Search @var{%load-path} for the file named @var{filename} and\n"
+ "load it into the top-level environment. If @var{filename} is a\n"
+ "relative pathname and is not found in the list of search paths,\n"
+ "an error is signalled.")
#define FUNC_NAME s_scm_primitive_load_path
{
SCM full_filename;
Index: guile/guile-core/libguile/macros.c
diff -u guile/guile-core/libguile/macros.c:1.26
guile/guile-core/libguile/macros.c:1.27
--- guile/guile-core/libguile/macros.c:1.26 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/macros.c Thu Apr 19 07:46:01 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 2000 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
* it under the terms of the GNU General Public License as published by
@@ -45,6 +45,10 @@
#include "libguile/_scm.h"
+#include "libguile/alist.h" /* for SCM_EXTEND_ENV (well...) */
+#include "libguile/eval.h"
+#include "libguile/ports.h"
+#include "libguile/print.h"
#include "libguile/root.h"
#include "libguile/smob.h"
@@ -53,6 +57,47 @@
scm_bits_t scm_tc16_macro;
+
+static int
+macro_print (SCM macro, SCM port, scm_print_state *pstate)
+{
+ SCM code = SCM_MACRO_CODE (macro);
+ if (!SCM_CLOSUREP (code)
+ || SCM_FALSEP (scm_procedure_p (SCM_PRINT_CLOSURE))
+ || SCM_FALSEP (scm_printer_apply (SCM_PRINT_CLOSURE,
+ macro, port, pstate)))
+ {
+ if (!SCM_CLOSUREP (code))
+ scm_puts ("#<primitive-", port);
+ else
+ scm_puts ("#<", port);
+
+ if (SCM_MACRO_TYPE (macro) == 0)
+ scm_puts ("syntax", port);
+ else if (SCM_MACRO_TYPE (macro) == 1)
+ scm_puts ("macro", port);
+ if (SCM_MACRO_TYPE (macro) == 2)
+ scm_puts ("macro!", port);
+ scm_putc (' ', port);
+ scm_iprin1 (scm_macro_name (macro), port, pstate);
+
+ if (SCM_CLOSUREP (code) && SCM_PRINT_SOURCE_P)
+ {
+ SCM formals = SCM_CLOSURE_FORMALS (code);
+ SCM env = SCM_ENV (code);
+ SCM xenv = SCM_EXTEND_ENV (formals, SCM_EOL, env);
+ SCM src = scm_unmemocopy (SCM_CODE (code), xenv);
+ scm_putc (' ', port);
+ scm_iprin1 (src, port, pstate);
+ }
+
+ scm_putc ('>', port);
+ }
+
+ return 1;
+}
+
+
SCM_DEFINE (scm_makacro, "procedure->syntax", 1, 0, 0,
(SCM code),
"Return a @dfn{macro} which, when a symbol defined to this value\n"
@@ -139,7 +184,7 @@
{
if (!SCM_TYP16_PREDICATE (scm_tc16_macro, m))
return SCM_BOOL_F;
- switch (SCM_CELL_WORD_0 (m) >> 16)
+ switch (SCM_MACRO_TYPE (m))
{
case 0: return scm_sym_syntax;
case 1: return scm_sym_macro;
@@ -186,6 +231,7 @@
{
scm_tc16_macro = scm_make_smob_type ("macro", 0);
scm_set_smob_mark (scm_tc16_macro, scm_markcdr);
+ scm_set_smob_print (scm_tc16_macro, macro_print);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/macros.x"
#endif
Index: guile/guile-core/libguile/modules.c
diff -u guile/guile-core/libguile/modules.c:1.21
guile/guile-core/libguile/modules.c:1.22
--- guile/guile-core/libguile/modules.c:1.21 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/modules.c Tue Apr 24 16:40:18 2001
@@ -60,6 +60,7 @@
SCM scm_module_system_booted_p = 0;
SCM scm_module_tag;
+SCM scm_module_type;
static SCM the_root_module;
static SCM root_module_lookup_closure;
@@ -72,26 +73,51 @@
static SCM the_module;
-SCM
-scm_current_module ()
+SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
+ (),
+ "Return the current module.")
+#define FUNC_NAME s_scm_current_module
{
- return scm_fluid_ref (SCM_CDR (the_module));
+ return scm_fluid_ref (the_module);
}
+#undef FUNC_NAME
-static SCM set_current_module;
+#define SCM_VALIDATE_STRUCT_TYPE(pos, v, type) \
+ do { \
+ SCM_ASSERT (SCM_NIMP (v) && SCM_NFALSEP (SCM_STRUCTP (v)) \
+ && SCM_STRUCT_VTABLE (v) == (type), \
+ v, pos, FUNC_NAME); \
+ } while (0)
-/* This is the module selected during loading of code. Currently,
- * this is the same as (interaction-environment), but need not be in
- * the future.
- */
+SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
+ (SCM module),
+ "Set the current module to @var{module} and return"
+ "the previous current module.")
+#define FUNC_NAME s_scm_set_current_module
+{
+ SCM old;
+
+ /* XXX - we can not validate our argument when the module system
+ hasn't been booted yet since we don't know the type. This
+ should be fixed when we have a cleaner way of booting
+ Guile.
+ */
+ if (scm_module_system_booted_p)
+ SCM_VALIDATE_STRUCT_TYPE (SCM_ARG1, module, scm_module_type);
-SCM
-scm_set_current_module (SCM module)
-{
- SCM old = scm_current_module ();
- scm_apply (SCM_CDR (set_current_module), SCM_LIST1 (module), SCM_EOL);
+ old = scm_current_module ();
+ scm_fluid_set_x (the_module, module);
+
+#if SCM_DEBUG_DEPRECATED == 0
+ scm_fluid_set_x (SCM_CDR (scm_top_level_lookup_closure_var),
+ scm_current_module_lookup_closure ());
+ scm_fluid_set_x (SCM_CDR (scm_system_transformer),
+ scm_current_module_transformer ());
+#endif
+
return old;
}
+#undef FUNC_NAME
SCM_DEFINE (scm_interaction_environment, "interaction-environment", 0, 0, 0,
(),
@@ -153,6 +179,21 @@
return SCM_BOOL_F;
}
+SCM
+scm_module_transformer (SCM module)
+{
+ return SCM_MODULE_TRANSFORMER (module);
+}
+
+SCM
+scm_current_module_transformer ()
+{
+ if (scm_module_system_booted_p)
+ return scm_module_transformer (scm_current_module ());
+ else
+ return SCM_BOOL_F;
+}
+
static SCM resolve_module;
SCM
@@ -286,20 +327,21 @@
scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
scm_set_smob_mark (scm_tc16_eval_closure, scm_markcdr);
scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
+
+ the_module = scm_permanent_object (scm_make_fluid ());
}
void
scm_post_boot_init_modules ()
{
- scm_module_tag = (SCM_CELL_WORD_1 (SCM_CDR (scm_intern0 ("module-type")))
- + scm_tc3_cons_gloc);
- the_root_module = scm_intern0 ("the-root-module");
- the_module = scm_intern0 ("the-module");
- set_current_module = scm_intern0 ("set-current-module");
+ scm_module_type =
+ scm_permanent_object (SCM_CDR (scm_intern0 ("module-type")));
+ scm_module_tag = (SCM_CELL_WORD_1 (scm_module_type) + scm_tc3_cons_gloc);
module_prefix = scm_permanent_object (SCM_LIST2 (scm_sym_app,
scm_sym_modules));
make_modules_in = scm_intern0 ("make-modules-in");
beautify_user_module_x = scm_intern0 ("beautify-user-module!");
+ the_root_module = scm_intern0 ("the-root-module");
root_module_lookup_closure = scm_permanent_object
(scm_module_lookup_closure (SCM_CDR (the_root_module)));
resolve_module = scm_intern0 ("resolve-module");
Index: guile/guile-core/libguile/modules.h
diff -u guile/guile-core/libguile/modules.h:1.12
guile/guile-core/libguile/modules.h:1.13
--- guile/guile-core/libguile/modules.h:1.12 Sun Feb 11 10:14:34 2001
+++ guile/guile-core/libguile/modules.h Tue Apr 24 16:40:18 2001
@@ -63,6 +63,7 @@
#define scm_module_index_uses 1
#define scm_module_index_binder 2
#define scm_module_index_eval_closure 3
+#define scm_module_index_transformer 4
#define SCM_MODULE_OBARRAY(module) \
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray])
@@ -72,6 +73,8 @@
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_binder])
#define SCM_MODULE_EVAL_CLOSURE(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure])
+#define SCM_MODULE_TRANSFORMER(module) \
+ SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer])
extern scm_bits_t scm_tc16_eval_closure;
@@ -85,11 +88,13 @@
extern SCM scm_the_root_module (void);
extern SCM scm_current_module (void);
extern SCM scm_current_module_lookup_closure (void);
+extern SCM scm_current_module_transformer (void);
extern SCM scm_interaction_environment (void);
extern SCM scm_set_current_module (SCM module);
extern SCM scm_make_module (SCM name);
extern SCM scm_ensure_user_module (SCM name);
extern SCM scm_module_lookup_closure (SCM module);
+extern SCM scm_module_transformer (SCM module);
extern SCM scm_resolve_module (SCM name);
extern SCM scm_load_scheme_module (SCM name);
extern SCM scm_env_top_level (SCM env);
Index: guile/guile-core/libguile/numbers.c
diff -u guile/guile-core/libguile/numbers.c:1.126
guile/guile-core/libguile/numbers.c:1.127
--- guile/guile-core/libguile/numbers.c:1.126 Sat May 5 18:26:23 2001
+++ guile/guile-core/libguile/numbers.c Tue May 8 03:23:17 2001
@@ -68,15 +68,10 @@
#define SCM_SWAP(x,y) do { SCM __t = x; x = y; y = __t; } while (0)
-/*#if (SCM_DEBUG_DEPRECATED == 1)*/ /* not defined in header yet? */
-#if 1
-
-/* SCM_FLOBUFLEN is the maximum number of characters neccessary for the
+/* FLOBUFLEN is the maximum number of characters neccessary for the
* printed or scm_string representation of an inexact number.
*/
-#define SCM_FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
-
-#endif /* SCM_DEBUG_DEPRECATED == 1 */
+#define FLOBUFLEN (10+2*(sizeof(double)/sizeof(char)*SCM_CHAR_BIT*3+9)/10)
/* IS_INF tests its floating point number for infiniteness
@@ -2307,7 +2302,7 @@
} else if (SCM_BIGP (n)) {
return big2str (n, (unsigned int) base);
} else if (SCM_INEXACTP (n)) {
- char num_buf [SCM_FLOBUFLEN];
+ char num_buf [FLOBUFLEN];
return scm_makfromstr (num_buf, iflo2str (n, num_buf), 0);
} else {
SCM_WRONG_TYPE_ARG (1, n);
@@ -2322,7 +2317,7 @@
int
scm_print_real (SCM sexp, SCM port, scm_print_state *pstate)
{
- char num_buf[SCM_FLOBUFLEN];
+ char num_buf[FLOBUFLEN];
scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port);
return !0;
}
@@ -2330,7 +2325,7 @@
int
scm_print_complex (SCM sexp, SCM port, scm_print_state *pstate)
{
- char num_buf[SCM_FLOBUFLEN];
+ char num_buf[FLOBUFLEN];
scm_lfwrite (num_buf, iflo2str (sexp, num_buf), port);
return !0;
}
Index: guile/guile-core/libguile/objects.c
diff -u guile/guile-core/libguile/objects.c:1.55
guile/guile-core/libguile/objects.c:1.56
--- guile/guile-core/libguile/objects.c:1.55 Fri Feb 16 07:02:35 2001
+++ guile/guile-core/libguile/objects.c Sat May 5 12:05:47 2001
@@ -374,9 +374,35 @@
}
#undef FUNC_NAME
+/* XXX - What code requires the object procedure to be only of certain
+ types? */
+
+SCM_DEFINE (scm_valid_object_procedure_p, "valid-object-procedure?", 1, 0, 0,
+ (SCM proc),
+ "Return @code{#t} iff @var{proc} is a procedure that can be used "
+ "with @code{set-object-procedure}. It is always valid to use "
+ "a closure constructed by @code{lambda}.")
+#define FUNC_NAME s_scm_valid_object_procedure_p
+{
+ if (SCM_IMP (proc))
+ return SCM_BOOL_F;
+ switch (SCM_TYP7 (proc))
+ {
+ default:
+ return SCM_BOOL_F;
+ case scm_tcs_closures:
+ case scm_tc7_subr_1:
+ case scm_tc7_subr_2:
+ case scm_tc7_subr_3:
+ case scm_tc7_lsubr_2:
+ return SCM_BOOL_T;
+ }
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
(SCM obj, SCM proc),
- "Return the object procedure of @var{obj} to @var{proc}.\n"
+ "Set the object procedure of @var{obj} to @var{proc}.\n"
"@var{obj} must be either an entity or an operator.")
#define FUNC_NAME s_scm_set_object_procedure_x
{
@@ -388,7 +414,7 @@
obj,
SCM_ARG1,
FUNC_NAME);
- SCM_VALIDATE_PROC (2,proc);
+ SCM_ASSERT (scm_valid_object_procedure_p (proc), proc, SCM_ARG2, FUNC_NAME);
if (SCM_I_ENTITYP (obj))
SCM_SET_ENTITY_PROCEDURE (obj, proc);
else
Index: guile/guile-core/libguile/ports.c
diff -u guile/guile-core/libguile/ports.c:1.141
guile/guile-core/libguile/ports.c:1.142
--- guile/guile-core/libguile/ports.c:1.141 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/ports.c Wed May 9 09:32:06 2001
@@ -1027,7 +1027,7 @@
while (n_available < size)
{
memcpy (buffer, pt->read_pos, n_available);
- buffer += n_available;
+ buffer = (char *) buffer + n_available;
pt->read_pos += n_available;
n_read += n_available;
Index: guile/guile-core/libguile/posix.c
diff -u guile/guile-core/libguile/posix.c:1.87
guile/guile-core/libguile/posix.c:1.88
--- guile/guile-core/libguile/posix.c:1.87 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/posix.c Tue Apr 10 00:57:05 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 96, 97, 98, 99, 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
* it under the terms of the GNU General Public License as published by
@@ -1095,12 +1095,12 @@
if (SCM_UNBNDP (actime))
SCM_SYSCALL (time (&utm_tmp.actime));
else
- utm_tmp.actime = SCM_NUM2ULONG (2,actime);
+ utm_tmp.actime = SCM_NUM2ULONG (2, actime);
if (SCM_UNBNDP (modtime))
SCM_SYSCALL (time (&utm_tmp.modtime));
else
- utm_tmp.modtime = SCM_NUM2ULONG (3,modtime);
+ utm_tmp.modtime = SCM_NUM2ULONG (3, modtime);
SCM_SYSCALL (rv = utime (SCM_STRING_CHARS (pathname), &utm_tmp));
if (rv != 0)
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.120
guile/guile-core/libguile/print.c:1.121
--- guile/guile-core/libguile/print.c:1.120 Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/print.c Sat Apr 21 14:50:08 2001
@@ -641,15 +641,10 @@
goto punk;
}
case scm_tc7_smob:
- {
- register long i;
- ENTER_NESTED_DATA (pstate, exp, circref);
- i = SCM_SMOBNUM (exp);
- if (i < scm_numsmob && scm_smobs[i].print)
- (scm_smobs[i].print) (exp, port, pstate);
- EXIT_NESTED_DATA (pstate);
- break;
- }
+ ENTER_NESTED_DATA (pstate, exp, circref);
+ SCM_SMOB_DESCRIPTOR (exp).print (exp, port, pstate);
+ EXIT_NESTED_DATA (pstate);
+ break;
default:
punk:
scm_ipruk ("type", exp, port);
Index: guile/guile-core/libguile/procs.c
diff -u guile/guile-core/libguile/procs.c:1.53
guile/guile-core/libguile/procs.c:1.54
--- guile/guile-core/libguile/procs.c:1.53 Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/procs.c Wed May 9 14:50:43 2001
@@ -63,8 +63,11 @@
/* libguile contained approx. 700 primitive procedures on 24 Aug 1999. */
+/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on
+ startup, 786 with guile-readline. 'martin */
+
int scm_subr_table_size = 0;
-int scm_subr_table_room = 750;
+int scm_subr_table_room = 800;
SCM
scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
Index: guile/guile-core/libguile/ramap.c
diff -u guile/guile-core/libguile/ramap.c:1.67
guile/guile-core/libguile/ramap.c:1.68
--- guile/guile-core/libguile/ramap.c:1.67 Sat Apr 21 14:50:08 2001
+++ guile/guile-core/libguile/ramap.c Sun May 6 15:14:09 2001
@@ -1789,7 +1789,7 @@
SCM e0 = SCM_UNDEFINED, e1 = SCM_UNDEFINED;
scm_sizet i0 = 0, i1 = 0;
long inc0 = 1, inc1 = 1;
- scm_sizet n = SCM_INUM (scm_uniform_vector_length (ra0));
+ scm_sizet n;
ra1 = SCM_CAR (ra1);
if (SCM_ARRAYP(ra0))
{
@@ -1798,6 +1798,8 @@
inc0 = SCM_ARRAY_DIMS (ra0)->inc;
ra0 = SCM_ARRAY_V (ra0);
}
+ else
+ n = SCM_INUM (scm_uniform_vector_length (ra0));
if (SCM_ARRAYP (ra1))
{
i1 = SCM_ARRAY_BASE (ra1);
Index: guile/guile-core/libguile/random.c
diff -u guile/guile-core/libguile/random.c:1.39
guile/guile-core/libguile/random.c:1.40
--- guile/guile-core/libguile/random.c:1.39 Mon Mar 5 17:22:37 2001
+++ guile/guile-core/libguile/random.c Tue Apr 3 06:19:04 2001
@@ -415,7 +415,8 @@
SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0,
(SCM state),
- "Returns a uniformly distributed inexact real random number in
[0,1).")
+ "Return a uniformly distributed inexact real random number in\n"
+ "[0,1).")
#define FUNC_NAME s_scm_random_uniform
{
if (SCM_UNBNDP (state))
@@ -427,10 +428,10 @@
SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
(SCM state),
- "Returns an inexact real in a normal distribution.\n"
- "The distribution used has mean 0 and standard deviation 1.\n"
- "For a normal distribution with mean m and standard deviation\n"
- "d use @code{(+ m (* d (random:normal)))}.")
+ "Return an inexact real in a normal distribution. The\n"
+ "distribution used has mean 0 and standard deviation 1. For a\n"
+ "normal distribution with mean m and standard deviation d use\n"
+ "@code{(+ m (* d (random:normal)))}.")
#define FUNC_NAME s_scm_random_normal
{
if (SCM_UNBNDP (state))
@@ -550,8 +551,9 @@
SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
(SCM state),
- "Returns an inexact real in an exponential distribution with mean
1.\n"
- "For an exponential distribution with mean u use (* u
(random:exp)).")
+ "Return an inexact real in an exponential distribution with mean\n"
+ "1. For an exponential distribution with mean u use (* u\n"
+ "(random:exp)).")
#define FUNC_NAME s_scm_random_exp
{
if (SCM_UNBNDP (state))
Index: guile/guile-core/libguile/read.c
diff -u guile/guile-core/libguile/read.c:1.66
guile/guile-core/libguile/read.c:1.67
--- guile/guile-core/libguile/read.c:1.66 Sat Mar 17 05:34:21 2001
+++ guile/guile-core/libguile/read.c Thu Mar 22 04:52:02 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997, 1999, 2000 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001 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
@@ -116,7 +116,7 @@
return SCM_EOF_VAL;
scm_ungetc (c, port);
- tok_buf = scm_makstr (30L, 0);
+ tok_buf = scm_allocate_string (30);
return scm_lreadr (&tok_buf, port, ©);
}
#undef FUNC_NAME
@@ -127,7 +127,7 @@
scm_grow_tok_buf (SCM *tok_buf)
{
unsigned long int oldlen = SCM_STRING_LENGTH (*tok_buf);
- SCM newstr = scm_makstr (2 * oldlen, 0);
+ SCM newstr = scm_allocate_string (2 * oldlen);
unsigned long int i;
for (i = 0; i != oldlen; ++i)
Index: guile/guile-core/libguile/regex-posix.c
diff -u guile/guile-core/libguile/regex-posix.c:1.49
guile/guile-core/libguile/regex-posix.c:1.50
--- guile/guile-core/libguile/regex-posix.c:1.49 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/regex-posix.c Sat May 5 17:39:01 2001
@@ -1,15 +1,15 @@
-/* Copyright (C) 1997, 1998, 1999, 2000 Free Software Foundation, Inc.
- *
+/* Copyright (C) 1997, 1998, 1999, 2000, 2001 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
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
- *
+ *
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
- *
+ *
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
@@ -37,7 +37,7 @@
*
* If you write modifications of your own for GUILE, it is your choice
* 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.
*/
/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
@@ -133,7 +133,7 @@
return SCM_STRING_CHARS (errmsg);
}
-SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
+SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a compiled regular expression,\n"
"or @code{#f} otherwise.")
@@ -143,7 +143,7 @@
}
#undef FUNC_NAME
-SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
+SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
(SCM pat, SCM flags),
"Compile the regular expression described by @var{pat}, and\n"
"return the compiled regexp structure. If @var{pat} does not\n"
@@ -204,7 +204,7 @@
cflags |= SCM_INUM (SCM_CAR (flag));
flag = SCM_CDR (flag);
}
-
+
rx = SCM_MUST_MALLOC_TYPE (regex_t);
status = regcomp (rx, SCM_STRING_CHARS (pat),
/* Make sure they're not passing REG_NOSUB;
@@ -223,13 +223,27 @@
}
#undef FUNC_NAME
-SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
+SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
(SCM rx, SCM str, SCM start, SCM flags),
"Match the compiled regular expression @var{rx} against\n"
"@code{str}. If the optional integer @var{start} argument is\n"
"provided, begin matching from that position in the string.\n"
"Return a match structure describing the results of the match,\n"
- "or @code{#f} if no match could be found.")
+ "or @code{#f} if no match could be found.\n"
+ "\n"
+ "The @var{flags} arguments change the matching behavior.\n"
+ "The following flags may be supplied:\n"
+ "\n"
+ "@table @code\n"
+ "@item regexp/notbol\n"
+ "Operator @samp{^} always fails (unless @code{regexp/newline}\n"
+ "is used). Use this when the beginning of the string should\n"
+ "not be considered the beginning of a line.\n"
+ "@item regexp/noteol\n"
+ "Operator @samp{$} always fails (unless @code{regexp/newline}\n"
+ "is used). Use this when the end of the string should not be\n"
+ "considered the end of a line.\n"
+ "@end table")
#define FUNC_NAME s_scm_regexp_exec
{
int status, nmatches, offset;
Index: guile/guile-core/libguile/scmsigs.c
diff -u guile/guile-core/libguile/scmsigs.c:1.55
guile/guile-core/libguile/scmsigs.c:1.56
--- guile/guile-core/libguile/scmsigs.c:1.55 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/scmsigs.c Fri May 4 14:54:00 2001
@@ -470,7 +470,6 @@
SCM_DEFINE (scm_raise, "raise", 1, 0, 0,
(SCM sig),
- "\n"
"Sends a specified signal @var{sig} to the current process, where\n"
"@var{sig} is as described for the kill procedure.")
#define FUNC_NAME s_scm_raise
Index: guile/guile-core/libguile/script.c
diff -u guile/guile-core/libguile/script.c:1.37
guile/guile-core/libguile/script.c:1.38
--- guile/guile-core/libguile/script.c:1.37 Sat Mar 10 08:56:06 2001
+++ guile/guile-core/libguile/script.c Mon Apr 16 17:43:18 2001
@@ -411,16 +411,7 @@
probably agree. I'd say I didn't feel comfortable doing that in
the present system. You'd say, well, fix the system so you are
comfortable doing that. I'd agree again. *shrug*
-
- We load the ice-9 system from here. It might be nicer if the
- libraries initialized from the inner_main function in guile.c (which
- will be auto-generated eventually) could assume ice-9 were already
- loaded. Then again, it might be nice if ice-9 could assume that
- certain libraries were already loaded. The solution is to break up
- ice-9 into modules which can be frozen and statically linked like any
- other module. Then all the modules can describe their dependencies in
- the usual way, and the auto-generated inner_main will do the right
- thing. */
+ */
static char guile[] = "guile";
Index: guile/guile-core/libguile/snarf.h
diff -u guile/guile-core/libguile/snarf.h:1.43
guile/guile-core/libguile/snarf.h:1.44
--- guile/guile-core/libguile/snarf.h:1.43 Thu Mar 15 21:11:34 2001
+++ guile/guile-core/libguile/snarf.h Sun May 6 14:19:53 2001
@@ -52,7 +52,12 @@
#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
-#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)(...)
+
+/* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem
+ to like it.
+ */
+#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
+
#else
#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
#endif
Index: guile/guile-core/libguile/socket.c
diff -u guile/guile-core/libguile/socket.c:1.73
guile/guile-core/libguile/socket.c:1.74
--- guile/guile-core/libguile/socket.c:1.73 Thu May 3 16:42:31 2001
+++ guile/guile-core/libguile/socket.c Sat May 5 01:31:00 2001
@@ -254,7 +254,7 @@
#undef FUNC_NAME
#endif
-#ifdef AF_INET6
+#ifdef HAVE_IPV6
/* flip a 128 bit IPv6 address between host and network order. */
#ifdef WORDS_BIGENDIAN
@@ -419,7 +419,7 @@
#undef FUNC_NAME
#endif
-#endif /* AF_INET6 */
+#endif /* HAVE_IPV6 */
SCM_SYMBOL (sym_socket, "socket");
@@ -713,7 +713,7 @@
*size = sizeof (struct sockaddr_in);
return (struct sockaddr *) soka;
}
-#ifdef AF_INET6
+#ifdef HAVE_IPV6
case AF_INET6:
{
/* see RFC2553. */
@@ -933,7 +933,7 @@
ve[2] = scm_ulong2num ((unsigned long) ntohs (nad->sin_port));
}
break;
-#ifdef AF_INET6
+#ifdef HAVE_IPV6
case AF_INET6:
{
const struct sockaddr_in6 *nad = (struct sockaddr_in6 *) address;
@@ -982,7 +982,7 @@
#define MAX_SIZE_UN 0
#endif
-#if defined (AF_INET6)
+#if defined (HAVE_IPV6)
#define MAX_SIZE_IN6 sizeof (struct sockaddr_in6)
#else
#define MAX_SIZE_IN6 0
Index: guile/guile-core/libguile/srcprop.c
diff -u guile/guile-core/libguile/srcprop.c:1.45
guile/guile-core/libguile/srcprop.c:1.46
--- guile/guile-core/libguile/srcprop.c:1.45 Sat Mar 10 08:56:07 2001
+++ guile/guile-core/libguile/srcprop.c Tue Apr 17 02:15:39 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001 Free Software
Foundation
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation
*
* 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
@@ -148,6 +148,7 @@
ptr->fname = filename;
ptr->copy = copy;
ptr->plist = plist;
+ SCM_ALLOW_INTS;
SCM_RETURN_NEWSMOB (scm_tc16_srcprops, ptr);
}
Index: guile/guile-core/libguile/stacks.c
diff -u guile/guile-core/libguile/stacks.c:1.56
guile/guile-core/libguile/stacks.c:1.57
--- guile/guile-core/libguile/stacks.c:1.56 Fri Mar 9 15:33:41 2001
+++ guile/guile-core/libguile/stacks.c Sat Apr 28 01:59:48 2001
@@ -417,7 +417,7 @@
"evaluation stack is used for creating the stack frames,\n"
"otherwise the frames are taken from @var{obj} (which must be\n"
"either a debug object or a continuation).\n"
- "@var{args} must be a list if integers and specifies how the\n"
+ "@var{args} must be a list of integers and specifies how the\n"
"resulting stack will be narrowed.")
#define FUNC_NAME s_scm_make_stack
{
Index: guile/guile-core/libguile/stime.c
diff -u guile/guile-core/libguile/stime.c:1.64
guile/guile-core/libguile/stime.c:1.65
--- guile/guile-core/libguile/stime.c:1.64 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/stime.c Tue Apr 10 00:57:05 2001
@@ -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
* it under the terms of the GNU General Public License as published by
@@ -355,7 +355,7 @@
char **oldenv;
int err;
- itime = SCM_NUM2LONG (1,time);
+ itime = SCM_NUM2LONG (1, time);
/* deferring interupts is essential since a) setzone may install a temporary
environment b) localtime uses a static buffer. */
@@ -423,7 +423,7 @@
struct tm *bd_time;
SCM result;
- itime = SCM_NUM2LONG (1,time);
+ itime = SCM_NUM2LONG (1, time);
SCM_DEFER_INTS;
bd_time = gmtime (&itime);
if (bd_time == NULL)
Index: guile/guile-core/libguile/struct.c
diff -u guile/guile-core/libguile/struct.c:1.74
guile/guile-core/libguile/struct.c:1.75
--- guile/guile-core/libguile/struct.c:1.74 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/struct.c Fri Apr 20 00:55:19 2001
@@ -377,7 +377,7 @@
{
/* Mark vtables in GC chain. GC mark set means delay freeing. */
SCM chain = newchain;
- while (SCM_NNULLP (chain))
+ while (!SCM_NULLP (chain))
{
SCM vtable = SCM_STRUCT_VTABLE (chain);
if (SCM_STRUCT_GC_CHAIN (vtable) != 0 && vtable != chain)
@@ -387,7 +387,7 @@
/* Free unmarked structs. */
chain = newchain;
newchain = SCM_EOL;
- while (SCM_NNULLP (chain))
+ while (!SCM_NULLP (chain))
{
SCM obj = chain;
chain = SCM_STRUCT_GC_CHAIN (chain);
@@ -402,7 +402,7 @@
scm_bits_t word0 = SCM_CELL_WORD_0 (obj) - scm_tc3_cons_gloc;
/* access as struct */
scm_bits_t * vtable_data = (scm_bits_t *) word0;
- scm_bits_t * data = (scm_bits_t *) SCM_UNPACK (SCM_CDR (obj));
+ scm_bits_t * data = SCM_STRUCT_DATA (obj);
scm_struct_free_t free_struct_data
= ((scm_struct_free_t) vtable_data[scm_struct_i_free]);
SCM_SET_CELL_TYPE (obj, scm_tc_free_cell);
@@ -410,7 +410,7 @@
}
}
}
- while (SCM_NNULLP (newchain));
+ while (!SCM_NULLP (newchain));
return 0;
}
Index: guile/guile-core/libguile/symbols.c
diff -u guile/guile-core/libguile/symbols.c:1.84
guile/guile-core/libguile/symbols.c:1.85
--- guile/guile-core/libguile/symbols.c:1.84 Tue Apr 3 06:19:05 2001
+++ guile/guile-core/libguile/symbols.c Fri May 4 14:54:00 2001
@@ -430,7 +430,7 @@
(SCM s),
"Return the name of @var{symbol} as a string. If the symbol was\n"
"part of an object returned as the value of a literal expression\n"
- "(section @pxref{Literal expressions,,,r4rs, The Revised^4\n"
+ "(section @pxref{Literal expressions,,,r5rs, The Revised^5\n"
"Report on Scheme}) or by a call to the @code{read} procedure,\n"
"and its name contains alphabetic characters, then the string\n"
"returned will contain characters in the implementation's\n"
Index: guile/guile-core/libguile/symbols.h
diff -u guile/guile-core/libguile/symbols.h:1.50
guile/guile-core/libguile/symbols.h:1.51
--- guile/guile-core/libguile/symbols.h:1.50 Sat Dec 16 10:27:40 2000
+++ guile/guile-core/libguile/symbols.h Wed Mar 7 18:46:38 2001
@@ -2,7 +2,7 @@
#ifndef SYMBOLSH
#define SYMBOLSH
-/* Copyright (C) 1995,1996,1997,1998, 2000 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
* it under the terms of the GNU General Public License as published by
@@ -71,6 +71,9 @@
+#ifdef GUILE_DEBUG
+extern SCM scm_sys_symbols (void);
+#endif
extern SCM scm_mem2symbol (const char*, scm_sizet);
extern SCM scm_str2symbol (const char*);
Index: guile/guile-core/libguile/tag.c
diff -u guile/guile-core/libguile/tag.c:1.23
guile/guile-core/libguile/tag.c:1.24
--- guile/guile-core/libguile/tag.c:1.23 Thu Mar 15 21:11:34 2001
+++ guile/guile-core/libguile/tag.c Sat Apr 28 10:29:31 2001
@@ -90,132 +90,7 @@
CONST_INUM (scm_utag_flag_base, "utag_flag_base", 254);
CONST_INUM (scm_utag_struct_base, "utag_struct_base", 255);
-
-#if (SCM_DEBUG_DEPRECATED == 0)
-
-SCM_DEFINE (scm_tag, "tag", 1, 0, 0,
- (SCM x),
- "Return an integer corresponding to the type of X. Deprecated.")
-#define FUNC_NAME s_scm_tag
-{
- switch (SCM_ITAG3 (x))
- {
- case scm_tc3_int_1:
- case scm_tc3_int_2:
- return SCM_CDR (scm_utag_immediate_integer) ;
-
- case scm_tc3_imm24:
- if (SCM_CHARP (x))
- return SCM_CDR (scm_utag_immediate_char) ;
- else
- {
- SCM tag = SCM_MAKINUM ((SCM_UNPACK (x) >> 8) & 0xff);
- return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_flag_base) ) |
(SCM_UNPACK (tag) << 8));
- }
-
- case scm_tc3_cons:
- switch (SCM_TYP7 (x))
- {
- case scm_tcs_cons_nimcar:
- return SCM_CDR (scm_utag_pair) ;
- case scm_tcs_closures:
- return SCM_CDR (scm_utag_closure) ;
- case scm_tc7_symbol:
- return SCM_CDR (scm_utag_symbol) ;
- case scm_tc7_vector:
- return SCM_CDR (scm_utag_vector) ;
- case scm_tc7_wvect:
- return SCM_CDR (scm_utag_wvect) ;
-
-#ifdef HAVE_ARRAYS
- case scm_tc7_bvect:
- return SCM_CDR (scm_utag_bvect) ;
- case scm_tc7_byvect:
- return SCM_CDR (scm_utag_byvect) ;
- case scm_tc7_svect:
- return SCM_CDR (scm_utag_svect) ;
- case scm_tc7_ivect:
- return SCM_CDR (scm_utag_ivect) ;
- case scm_tc7_uvect:
- return SCM_CDR (scm_utag_uvect) ;
- case scm_tc7_fvect:
- return SCM_CDR (scm_utag_fvect) ;
- case scm_tc7_dvect:
- return SCM_CDR (scm_utag_dvect) ;
- case scm_tc7_cvect:
- return SCM_CDR (scm_utag_cvect) ;
-#endif
-
- case scm_tc7_string:
- return SCM_CDR (scm_utag_string) ;
- case scm_tc7_substring:
- return SCM_CDR (scm_utag_substring) ;
- case scm_tc7_asubr:
- return SCM_CDR (scm_utag_asubr) ;
- case scm_tc7_subr_0:
- return SCM_CDR (scm_utag_subr_0) ;
- case scm_tc7_subr_1:
- return SCM_CDR (scm_utag_subr_1) ;
- case scm_tc7_cxr:
- return SCM_CDR (scm_utag_cxr) ;
- case scm_tc7_subr_3:
- return SCM_CDR (scm_utag_subr_3) ;
- case scm_tc7_subr_2:
- return SCM_CDR (scm_utag_subr_2) ;
- case scm_tc7_rpsubr:
- return SCM_CDR (scm_utag_rpsubr) ;
- case scm_tc7_subr_1o:
- return SCM_CDR (scm_utag_subr_1o) ;
- case scm_tc7_subr_2o:
- return SCM_CDR (scm_utag_subr_2o) ;
- case scm_tc7_lsubr_2:
- return SCM_CDR (scm_utag_lsubr_2) ;
- case scm_tc7_lsubr:
- return SCM_CDR (scm_utag_lsubr) ;
-
- case scm_tc7_port:
- {
- int tag;
- tag = (SCM_TYP16 (x) >> 8) & 0xff;
- return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_port_base)) | (tag
<< 8));
- }
- case scm_tc7_smob:
- {
- int tag;
- tag = (SCM_TYP16 (x) >> 8) & 0xff;
- return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_smob_base))
- | (tag << 8));
- }
- case scm_tcs_cons_gloc:
- /* must be a struct */
- {
- int tag = (int) SCM_STRUCT_VTABLE_DATA (x) >> 3;
- return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_struct_base))
- | (tag << 8));
- }
-
- default:
- if (SCM_CONSP (x))
- return SCM_CDR (scm_utag_pair);
- else
- return SCM_MAKINUM (-1);
- }
-
- case scm_tc3_cons_gloc:
- case scm_tc3_tc7_1:
- case scm_tc3_tc7_2:
- case scm_tc3_closure:
- /* Never reached */
- break;
- }
- return SCM_MAKINUM (-1);
-}
-#undef FUNC_NAME
-
-#endif /* SCM_DEBUG_DEPRECATED == 0 */
-
-
void
scm_init_tag ()
Index: guile/guile-core/libguile/throw.c
diff -u guile/guile-core/libguile/throw.c:1.79
guile/guile-core/libguile/throw.c:1.80
--- guile/guile-core/libguile/throw.c:1.79 Sun Apr 22 15:16:07 2001
+++ guile/guile-core/libguile/throw.c Fri May 4 14:54:00 2001
@@ -591,7 +591,7 @@
"Invoke the catch form matching @var{key}, passing @var{args} to
the\n"
"@var{handler}. \n\n"
"@var{key} is a symbol. It will match catches of the same symbol
or of\n"
- "#t.\n\n"
+ "@code{#t}.\n\n"
"If there is no handler at all, Guile prints an error and then
exits.")
#define FUNC_NAME s_scm_throw
{
Index: guile/guile-core/libguile/variable.c
diff -u guile/guile-core/libguile/variable.c:1.33
guile/guile-core/libguile/variable.c:1.34
--- guile/guile-core/libguile/variable.c:1.33 Fri Mar 9 15:33:41 2001
+++ guile/guile-core/libguile/variable.c Fri Mar 30 07:03:23 2001
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 2000 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
* it under the terms of the GNU General Public License as published by
@@ -59,17 +59,16 @@
variable_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<variable ", port);
- scm_intprint(SCM_UNPACK (exp), 16, port);
+ scm_intprint (SCM_UNPACK (exp), 16, port);
{
- SCM val_cell;
- val_cell = SCM_CDR(exp);
- if (!SCM_UNBNDP (SCM_CAR (val_cell)))
+ SCM vcell = SCM_VARVCELL (exp);
+ if (!SCM_UNBNDP (SCM_CAR (vcell)))
{
scm_puts (" name: ", port);
- scm_iprin1 (SCM_CAR (val_cell), port, pstate);
+ scm_iprin1 (SCM_CAR (vcell), port, pstate);
}
scm_puts (" binding: ", port);
- scm_iprin1 (SCM_CDR (val_cell), port, pstate);
+ scm_iprin1 (SCM_CDR (vcell), port, pstate);
}
scm_putc('>', port);
return 1;
@@ -78,7 +77,7 @@
static SCM
variable_equalp (SCM var1, SCM var2)
{
- return scm_equal_p (SCM_CDR (var1), SCM_CDR (var2));
+ return scm_equal_p (SCM_VARVCELL (var1), SCM_VARVCELL (var2));
}
@@ -100,17 +99,13 @@
"variable may exist, so @var{name-hint} is just that---a hint.\n")
#define FUNC_NAME s_scm_make_variable
{
- SCM val_cell;
+ SCM vcell;
if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym;
- SCM_NEWCELL(val_cell);
- SCM_DEFER_INTS;
- SCM_SETCAR (val_cell, name_hint);
- SCM_SETCDR (val_cell, init);
- SCM_ALLOW_INTS;
- return make_vcell_variable (val_cell);
+ vcell = scm_cons (name_hint, init);
+ return make_vcell_variable (vcell);
}
#undef FUNC_NAME
@@ -129,11 +124,7 @@
if (SCM_UNBNDP (name_hint))
name_hint = anonymous_variable_sym;
- SCM_NEWCELL (vcell);
- SCM_DEFER_INTS;
- SCM_SETCAR (vcell, name_hint);
- SCM_SETCDR (vcell, SCM_UNDEFINED);
- SCM_ALLOW_INTS;
+ vcell = scm_cons (name_hint, SCM_UNDEFINED);
return make_vcell_variable (vcell);
}
#undef FUNC_NAME
@@ -158,7 +149,7 @@
#define FUNC_NAME s_scm_variable_ref
{
SCM_VALIDATE_VARIABLE (1, var);
- return SCM_CDR (SCM_CDR (var));
+ return SCM_CDR (SCM_VARVCELL (var));
}
#undef FUNC_NAME
@@ -171,8 +162,8 @@
"value. Return an unspecified value.\n")
#define FUNC_NAME s_scm_variable_set_x
{
- SCM_VALIDATE_VARIABLE (1,var);
- SCM_SETCDR (SCM_CDR (var), val);
+ SCM_VALIDATE_VARIABLE (1, var);
+ SCM_SETCDR (SCM_VARVCELL (var), val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -213,8 +204,8 @@
"Throws an error if @var{var} is not a variable object.\n")
#define FUNC_NAME s_scm_variable_bound_p
{
- SCM_VALIDATE_VARIABLE (1,var);
- return SCM_NEGATE_BOOL(SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
+ SCM_VALIDATE_VARIABLE (1, var);
+ return SCM_BOOL (!SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/variable.h
diff -u guile/guile-core/libguile/variable.h:1.16
guile/guile-core/libguile/variable.h:1.17
--- guile/guile-core/libguile/variable.h:1.16 Fri Dec 8 09:32:56 2000
+++ guile/guile-core/libguile/variable.h Fri Mar 30 07:03:23 2001
@@ -1,8 +1,8 @@
/* classes: h_files */
-#ifndef VARIABLEH
-#define VARIABLEH
-/* Copyright (C) 1995,1996, 2000 Free Software Foundation, Inc.
+#ifndef SCM_VARIABLE_H
+#define SCM_VARIABLE_H
+/* Copyright (C) 1995,1996,2000,2001 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
@@ -55,7 +55,7 @@
*/
extern scm_bits_t scm_tc16_variable;
-#define SCM_VARVCELL(V) SCM_CDR(V)
+#define SCM_VARVCELL(V) SCM_CELL_OBJECT_1 (V)
#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_CELL_TYPE (X) ==
scm_tc16_variable)
#define SCM_UDVARIABLEP(X) (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR
(SCM_VARVCELL (X))))
#define SCM_DEFVARIABLEP(X) (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR
(SCM_VARVCELL (X))))
@@ -71,7 +71,7 @@
extern SCM scm_variable_bound_p (SCM var);
extern void scm_init_variable (void);
-#endif /* VARIABLEH */
+#endif /* SCM_VARIABLE_H */
/*
Local Variables:
- guile/guile-core/libguile variable.h variable.c...,
Marius Vollmer <=