mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 05:30:21 +02:00
Code Activity

scm_is_eq for SCM vals, not == or !=

Browse source 
* libguile/bytevectors.c (scm_make_bytevector, STRING_TO_UTF)
  (UTF_TO_STRING):
* libguile/continuations.c (scm_i_check_continuation):
* libguile/expand.h (SCM_EXPANDED_P):
* libguile/fluids.c (scm_i_make_with_fluids):
* libguile/generalized-vectors.c (scm_make_generalized_vector):
* libguile/goops.c (SCM_GOOPS_UNBOUNDP, slot_definition_using_name):
  (scm_c_extend_primitive_generic, more_specificp, scm_make)
* libguile/i18n.c (SCM_VALIDATE_OPTIONAL_LOCALE_COPY):
  (scm_locale_string_to_integer)
* libguile/modules.c (resolve_duplicate_binding):
  (scm_module_reverse_lookup)
* libguile/posix.c (scm_to_resource):
* libguile/r6rs-ports.c (scm_put_bytevector):
* libguile/socket.c (scm_connect, scm_bind, scm_sendto
* libguile/stacks.c (find_prompt):
* libguile/variable.c (scm_variable_ref, scm_variable_bound_p):
* libguile/vm-engine.h (ASSERT_BOUND_VARIABLE, ASSERT_BOUND)
* libguile/vm-i-system.c (VARIABLE_BOUNDP, local_bound)
  (long_local_bound, fluid_ref): Use scm_is_eq to compare, not == / !=.
This commit is contained in:
Andy Wingo 2011-05-13 12:42:01 +02:00
parent b2feee6bc0
commit d223c3fcdd
15 changed files with 59 additions and 63 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/bytevectors.c
View file

@ -462,7 +462,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
signed char c_fill = '\0'; signed char c_fill = '\0';
SCM_VALIDATE_UINT_COPY (1, len, c_len); SCM_VALIDATE_UINT_COPY (1, len, c_len);
if (fill != SCM_UNDEFINED) if (!scm_is_eq (fill, SCM_UNDEFINED))
{ {
int value; int value;
@ -473,7 +473,7 @@ SCM_DEFINE (scm_make_bytevector, "make-bytevector", 1, 1, 0,
} }
bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8); bv = make_bytevector (c_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
if (fill != SCM_UNDEFINED) if (!scm_is_eq (fill, SCM_UNDEFINED))
{ {
unsigned i; unsigned i;
signed char *contents; signed char *contents;
@ -1907,7 +1907,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM endianness)
size_t c_strlen, c_utf_len = 0; \ size_t c_strlen, c_utf_len = 0; \
\ \
SCM_VALIDATE_STRING (1, str); \ SCM_VALIDATE_STRING (1, str); \
if (endianness == SCM_UNDEFINED) \ if (scm_is_eq (endianness, SCM_UNDEFINED)) \
endianness = scm_sym_big; \ endianness = scm_sym_big; \
else \ else \
SCM_VALIDATE_SYMBOL (2, endianness); \ SCM_VALIDATE_SYMBOL (2, endianness); \
@ -2020,7 +2020,7 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
size_t c_strlen = 0, c_utf_len = 0; \ size_t c_strlen = 0, c_utf_len = 0; \
\ \
SCM_VALIDATE_BYTEVECTOR (1, utf); \ SCM_VALIDATE_BYTEVECTOR (1, utf); \
if (endianness == SCM_UNDEFINED) \ if (scm_is_eq (endianness, SCM_UNDEFINED)) \
endianness = scm_sym_big; \ endianness = scm_sym_big; \
else \ else \
SCM_VALIDATE_SYMBOL (2, endianness); \ SCM_VALIDATE_SYMBOL (2, endianness); \

2
libguile/continuations.c
View file

@ -410,7 +410,7 @@ scm_i_check_continuation (SCM cont)
scm_i_thread *thread = SCM_I_CURRENT_THREAD; scm_i_thread *thread = SCM_I_CURRENT_THREAD;
scm_t_contregs *continuation = SCM_CONTREGS (cont); scm_t_contregs *continuation = SCM_CONTREGS (cont);
if (continuation->root != thread->continuation_root) if (!scm_is_eq (continuation->root, thread->continuation_root))
scm_misc_error scm_misc_error
("%continuation-call", ("%continuation-call",
"invoking continuation would cross continuation barrier: ~A", "invoking continuation would cross continuation barrier: ~A",

7
libguile/expand.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_EXPAND_H #ifndef SCM_EXPAND_H
#define SCM_EXPAND_H #define SCM_EXPAND_H
/* Copyright (C) 2010 /* Copyright (C) 2010, 2011
* Free Software Foundation, Inc. * Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
@ -73,8 +73,9 @@ enum
SCM_EXPANDED_TYPE_FIELDS, SCM_EXPANDED_TYPE_FIELDS,
}; };
#define SCM_EXPANDED_P(x) \ #define SCM_EXPANDED_P(x) \
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE (SCM_STRUCT_VTABLE (x)) == scm_exp_vtable_vtable)) (SCM_STRUCTP (x) \
&& (scm_is_eq (SCM_STRUCT_VTABLE (SCM_STRUCT_VTABLE (x)), scm_exp_vtable_vtable)))
#define SCM_EXPANDED_REF(x,type,field) \ #define SCM_EXPANDED_REF(x,type,field) \
(scm_struct_ref (x, SCM_I_MAKINUM (SCM_EXPANDED_##type##_##field))) (scm_struct_ref (x, SCM_I_MAKINUM (SCM_EXPANDED_##type##_##field)))
#define SCM_EXPANDED_TYPE(x) \ #define SCM_EXPANDED_TYPE(x) \

4
libguile/fluids.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. /* Copyright (C) 1996,1997,2000,2001, 2004, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -304,7 +304,7 @@ scm_i_make_with_fluids (size_t n, SCM *fluids, SCM *vals)
while (j--) while (j--)
for (i = 0; i < j; i++) for (i = 0; i < j; i++)
if (fluids[i] == fluids[j]) if (scm_is_eq (fluids[i], fluids[j]))
{ {
vals[i] = vals[j]; /* later bindings win */ vals[i] = vals[j]; /* later bindings win */
n--; n--;

4
libguile/generalized-vectors.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -62,7 +62,7 @@ SCM_DEFINE (scm_make_generalized_vector, "make-generalized-vector", 2, 1, 0,
{ {
int i; int i;
for (i = 0; i < num_vector_ctors_registered; i++) for (i = 0; i < num_vector_ctors_registered; i++)
if (vector_ctors[i].tag == type) if (scm_is_eq (vector_ctors[i].tag, type))
return vector_ctors[i].ctor(len, fill); return vector_ctors[i].ctor(len, fill);
scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type"); scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, type, "array type");
} }

21
libguile/goops.c
View file

@ -124,7 +124,7 @@ SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
#define NXT_MTHD_ARGS(m) (SCM_VELTS (m)[2]) #define NXT_MTHD_ARGS(m) (SCM_VELTS (m)[2])
#define SCM_GOOPS_UNBOUND SCM_UNBOUND #define SCM_GOOPS_UNBOUND SCM_UNBOUND
#define SCM_GOOPS_UNBOUNDP(x) ((x) == SCM_GOOPS_UNBOUND) #define SCM_GOOPS_UNBOUNDP(x) (scm_is_eq (x, SCM_GOOPS_UNBOUND))
static int goops_loaded_p = 0; static int goops_loaded_p = 0;
static scm_t_rstate *goops_rstate; static scm_t_rstate *goops_rstate;
@ -1231,7 +1231,7 @@ slot_definition_using_name (SCM class, SCM slot_name)
{ {
register SCM slots = SCM_SLOT (class, scm_si_getters_n_setters); register SCM slots = SCM_SLOT (class, scm_si_getters_n_setters);
for (; !scm_is_null (slots); slots = SCM_CDR (slots)) for (; !scm_is_null (slots); slots = SCM_CDR (slots))
if (SCM_CAAR (slots) == slot_name) if (scm_is_eq (SCM_CAAR (slots), slot_name))
return SCM_CAR (slots); return SCM_CAR (slots);
return SCM_BOOL_F; return SCM_BOOL_F;
} }
@ -1819,7 +1819,7 @@ scm_c_extend_primitive_generic (SCM extended, SCM extension)
* extensions in the extensions list. O(N^2) algorithm, but * extensions in the extensions list. O(N^2) algorithm, but
* extensions of primitive generics are rare. * extensions of primitive generics are rare.
*/ */
while (*loc && extension != (*loc)->extended) while (*loc && !scm_is_eq (extension, (*loc)->extended))
loc = &(*loc)->next; loc = &(*loc)->next;
e->next = *loc; e->next = *loc;
e->extended = extended; e->extended = extended;
@ -1887,13 +1887,13 @@ more_specificp (SCM m1, SCM m2, SCM const *targs)
for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) { for (i=0, s1=SPEC_OF(m1), s2=SPEC_OF(m2); ; i++, s1=SCM_CDR(s1), s2=SCM_CDR(s2)) {
if (scm_is_null(s1)) return 1; if (scm_is_null(s1)) return 1;
if (scm_is_null(s2)) return 0; if (scm_is_null(s2)) return 0;
if (SCM_CAR(s1) != SCM_CAR(s2)) { if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) {
register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2); register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
for (l = SCM_SLOT (targs[i], scm_si_cpl); ; l = SCM_CDR(l)) { for (l = SCM_SLOT (targs[i], scm_si_cpl); ; l = SCM_CDR(l)) {
if (cs1 == SCM_CAR(l)) if (scm_is_eq (cs1, SCM_CAR (l)))
return 1; return 1;
if (cs2 == SCM_CAR(l)) if (scm_is_eq (cs2, SCM_CAR (l)))
return 0; return 0;
} }
return 0;/* should not occur! */ return 0;/* should not occur! */
@ -2110,7 +2110,8 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
class = SCM_CAR(args); class = SCM_CAR(args);
args = SCM_CDR(args); args = SCM_CDR(args);
if (class == scm_class_generic || class == scm_class_accessor) if (scm_is_eq (class, scm_class_generic)
|| scm_is_eq (class, scm_class_accessor))
{ {
z = scm_make_struct (class, SCM_INUM0, z = scm_make_struct (class, SCM_INUM0,
scm_list_4 (SCM_BOOL_F, scm_list_4 (SCM_BOOL_F,
@ -2122,7 +2123,7 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
args, args,
SCM_BOOL_F)); SCM_BOOL_F));
clear_method_cache (z); clear_method_cache (z);
if (class == scm_class_accessor) if (scm_is_eq (class, scm_class_accessor))
{ {
SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F); SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F);
if (scm_is_true (setter)) if (scm_is_true (setter))
@ -2133,8 +2134,8 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
{ {
z = scm_sys_allocate_instance (class, args); z = scm_sys_allocate_instance (class, args);
if (class == scm_class_method if (scm_is_eq (class, scm_class_method)
|| class == scm_class_accessor_method) || scm_is_eq (class, scm_class_accessor_method))
{ {
SCM_SET_SLOT (z, scm_si_generic_function, SCM_SET_SLOT (z, scm_si_generic_function,
scm_i_get_keyword (k_gf, scm_i_get_keyword (k_gf,

4
libguile/i18n.c
View file

@ -234,7 +234,7 @@ SCM_GLOBAL_VARIABLE (scm_global_locale, "%global-locale");
#define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \ #define SCM_VALIDATE_OPTIONAL_LOCALE_COPY(_pos, _arg, _c_locale) \
do \ do \
{ \ { \
if ((_arg) != SCM_UNDEFINED) \ if (!scm_is_eq ((_arg), SCM_UNDEFINED)) \
SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \ SCM_VALIDATE_LOCALE_COPY (_pos, _arg, _c_locale); \
else \ else \
(_c_locale) = NULL; \ (_c_locale) = NULL; \
@ -1378,7 +1378,7 @@ SCM_DEFINE (scm_locale_string_to_integer, "locale-string->integer",
SCM_VALIDATE_STRING (1, str); SCM_VALIDATE_STRING (1, str);
c_str = scm_i_string_chars (str); c_str = scm_i_string_chars (str);
if (base != SCM_UNDEFINED) if (!scm_is_eq (base, SCM_UNDEFINED))
SCM_VALIDATE_INT_COPY (2, base, c_base); SCM_VALIDATE_INT_COPY (2, base, c_base);
else else
c_base = 10; c_base = 10;

6
libguile/modules.c
View file

@ -304,8 +304,8 @@ resolve_duplicate_binding (SCM module, SCM sym,
val1 = SCM_VARIABLE_REF (var1); val1 = SCM_VARIABLE_REF (var1);
val2 = SCM_VARIABLE_REF (var2); val2 = SCM_VARIABLE_REF (var2);
val1 = (val1 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val1; val1 = scm_is_eq (val1, SCM_UNSPECIFIED) ? SCM_BOOL_F : val1;
val2 = (val2 == SCM_UNSPECIFIED) ? SCM_BOOL_F : val2; val2 = scm_is_eq (val2, SCM_UNSPECIFIED) ? SCM_BOOL_F : val2;
handlers = SCM_MODULE_DUPLICATE_HANDLERS (module); handlers = SCM_MODULE_DUPLICATE_HANDLERS (module);
if (scm_is_false (handlers)) if (scm_is_false (handlers))
@ -954,7 +954,7 @@ SCM_DEFINE (scm_module_reverse_lookup, "module-reverse-lookup", 2, 0, 0,
} }
else else
{ {
if (SCM_CDR (handle) == variable) if (scm_is_eq (SCM_CDR (handle), variable))
return SCM_CAR (handle); return SCM_CAR (handle);
} }

30
libguile/posix.c
View file

@ -511,63 +511,63 @@ scm_to_resource (SCM s, const char *func, int pos)
SCM_ASSERT_TYPE (scm_is_symbol (s), s, pos, func, "symbol"); SCM_ASSERT_TYPE (scm_is_symbol (s), s, pos, func, "symbol");
#ifdef RLIMIT_AS #ifdef RLIMIT_AS
if (s == sym_as) if (scm_is_eq (s, sym_as))
return RLIMIT_AS; return RLIMIT_AS;
#endif #endif
#ifdef RLIMIT_CORE #ifdef RLIMIT_CORE
if (s == sym_core) if (scm_is_eq (s, sym_core))
return RLIMIT_CORE; return RLIMIT_CORE;
#endif #endif
#ifdef RLIMIT_CPU #ifdef RLIMIT_CPU
if (s == sym_cpu) if (scm_is_eq (s, sym_cpu))
return RLIMIT_CPU; return RLIMIT_CPU;
#endif #endif
#ifdef RLIMIT_DATA #ifdef RLIMIT_DATA
if (s == sym_data) if (scm_is_eq (s, sym_data))
return RLIMIT_DATA; return RLIMIT_DATA;
#endif #endif
#ifdef RLIMIT_FSIZE #ifdef RLIMIT_FSIZE
if (s == sym_fsize) if (scm_is_eq (s, sym_fsize))
return RLIMIT_FSIZE; return RLIMIT_FSIZE;
#endif #endif
#ifdef RLIMIT_MEMLOCK #ifdef RLIMIT_MEMLOCK
if (s == sym_memlock) if (scm_is_eq (s, sym_memlock))
return RLIMIT_MEMLOCK; return RLIMIT_MEMLOCK;
#endif #endif
#ifdef RLIMIT_MSGQUEUE #ifdef RLIMIT_MSGQUEUE
if (s == sym_msgqueue) if (scm_is_eq (s, sym_msgqueue))
return RLIMIT_MSGQUEUE; return RLIMIT_MSGQUEUE;
#endif #endif
#ifdef RLIMIT_NICE #ifdef RLIMIT_NICE
if (s == sym_nice) if (scm_is_eq (s, sym_nice))
return RLIMIT_NICE; return RLIMIT_NICE;
#endif #endif
#ifdef RLIMIT_NOFILE #ifdef RLIMIT_NOFILE
if (s == sym_nofile) if (scm_is_eq (s, sym_nofile))
return RLIMIT_NOFILE; return RLIMIT_NOFILE;
#endif #endif
#ifdef RLIMIT_NPROC #ifdef RLIMIT_NPROC
if (s == sym_nproc) if (scm_is_eq (s, sym_nproc))
return RLIMIT_NPROC; return RLIMIT_NPROC;
#endif #endif
#ifdef RLIMIT_RSS #ifdef RLIMIT_RSS
if (s == sym_rss) if (scm_is_eq (s, sym_rss))
return RLIMIT_RSS; return RLIMIT_RSS;
#endif #endif
#ifdef RLIMIT_RTPRIO #ifdef RLIMIT_RTPRIO
if (s == sym_rtprio) if (scm_is_eq (s, sym_rtprio))
return RLIMIT_RTPRIO; return RLIMIT_RTPRIO;
#endif #endif
#ifdef RLIMIT_RTPRIO #ifdef RLIMIT_RTPRIO
if (s == sym_rttime) if (scm_is_eq (s, sym_rttime))
return RLIMIT_RTPRIO; return RLIMIT_RTPRIO;
#endif #endif
#ifdef RLIMIT_SIGPENDING #ifdef RLIMIT_SIGPENDING
if (s == sym_sigpending) if (scm_is_eq (s, sym_sigpending))
return RLIMIT_SIGPENDING; return RLIMIT_SIGPENDING;
#endif #endif
#ifdef RLIMIT_STACK #ifdef RLIMIT_STACK
if (s == sym_stack) if (scm_is_eq (s, sym_stack))
return RLIMIT_STACK; return RLIMIT_STACK;
#endif #endif

4
libguile/r6rs-ports.c
View file

@ -724,11 +724,11 @@ SCM_DEFINE (scm_put_bytevector, "put-bytevector", 2, 2, 0,
c_len = SCM_BYTEVECTOR_LENGTH (bv); c_len = SCM_BYTEVECTOR_LENGTH (bv);
c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv); c_bv = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
if (start != SCM_UNDEFINED) if (!scm_is_eq (start, SCM_UNDEFINED))
{ {
c_start = scm_to_uint (start); c_start = scm_to_uint (start);
if (count != SCM_UNDEFINED) if (!scm_is_eq (count, SCM_UNDEFINED))
{ {
c_count = scm_to_uint (count); c_count = scm_to_uint (count);
if (SCM_UNLIKELY (c_start + c_count > c_len)) if (SCM_UNLIKELY (c_start + c_count > c_len))

6
libguile/socket.c
View file

@ -914,7 +914,7 @@ SCM_DEFINE (scm_connect, "connect", 2, 1, 1,
SCM_VALIDATE_OPFPORT (1, sock); SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
if (address == SCM_UNDEFINED) if (scm_is_eq (address, SCM_UNDEFINED))
/* No third argument was passed to FAM_OR_SOCKADDR must actually be a /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
`socket address' object. */ `socket address' object. */
soka = scm_to_sockaddr (fam_or_sockaddr, &size); soka = scm_to_sockaddr (fam_or_sockaddr, &size);
@ -983,7 +983,7 @@ SCM_DEFINE (scm_bind, "bind", 2, 1, 1,
SCM_VALIDATE_OPFPORT (1, sock); SCM_VALIDATE_OPFPORT (1, sock);
fd = SCM_FPORT_FDES (sock); fd = SCM_FPORT_FDES (sock);
if (address == SCM_UNDEFINED) if (scm_is_eq (address, SCM_UNDEFINED))
/* No third argument was passed to FAM_OR_SOCKADDR must actually be a /* No third argument was passed to FAM_OR_SOCKADDR must actually be a
`socket address' object. */ `socket address' object. */
soka = scm_to_sockaddr (fam_or_sockaddr, &size); soka = scm_to_sockaddr (fam_or_sockaddr, &size);
@ -1666,7 +1666,7 @@ SCM_DEFINE (scm_sendto, "sendto", 3, 1, 1,
means that the following arguments, i.e. ADDRESS and those listed in means that the following arguments, i.e. ADDRESS and those listed in
ARGS_AND_FLAGS, are the `MSG_' flags. */ ARGS_AND_FLAGS, are the `MSG_' flags. */
soka = scm_to_sockaddr (fam_or_sockaddr, &size); soka = scm_to_sockaddr (fam_or_sockaddr, &size);
if (address != SCM_UNDEFINED) if (!scm_is_eq (address, SCM_UNDEFINED))
args_and_flags = scm_cons (address, args_and_flags); args_and_flags = scm_cons (address, args_and_flags);
} }
else else

2
libguile/stacks.c
View file

@ -102,7 +102,7 @@ find_prompt (SCM key)
for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = scm_cdr (winds)) for (winds = scm_i_dynwinds (); scm_is_pair (winds); winds = scm_cdr (winds))
{ {
SCM elt = scm_car (winds); SCM elt = scm_car (winds);
if (SCM_PROMPT_P (elt) && SCM_PROMPT_TAG (elt) == key) if (SCM_PROMPT_P (elt) && scm_is_eq (SCM_PROMPT_TAG (elt), key))
return elt; return elt;
} }
scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack", scm_misc_error ("make-stack", "Prompt tag not found while narrowing stack",

6
libguile/variable.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1997,1998,2000,2001, 2006, 2008, 2011 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -92,7 +92,7 @@ SCM_DEFINE (scm_variable_ref, "variable-ref", 1, 0, 0,
SCM val; SCM val;
SCM_VALIDATE_VARIABLE (1, var); SCM_VALIDATE_VARIABLE (1, var);
val = SCM_VARIABLE_REF (var); val = SCM_VARIABLE_REF (var);
if (val == SCM_UNDEFINED) if (scm_is_eq (val, SCM_UNDEFINED))
SCM_MISC_ERROR ("variable is unbound: ~S", scm_list_1 (var)); SCM_MISC_ERROR ("variable is unbound: ~S", scm_list_1 (var));
return val; return val;
} }
@ -130,7 +130,7 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
#define FUNC_NAME s_scm_variable_bound_p #define FUNC_NAME s_scm_variable_bound_p
{ {
SCM_VALIDATE_VARIABLE (1, var); SCM_VALIDATE_VARIABLE (1, var);
return scm_from_bool (SCM_VARIABLE_REF (var) != SCM_UNDEFINED); return scm_from_bool (!scm_is_eq (SCM_VARIABLE_REF (var), SCM_UNDEFINED));
} }
#undef FUNC_NAME #undef FUNC_NAME

4
libguile/vm-engine.h
View file

@ -126,7 +126,7 @@
} while (0) } while (0)
#define ASSERT_BOUND_VARIABLE(x) \ #define ASSERT_BOUND_VARIABLE(x) \
do { ASSERT_VARIABLE (x); \ do { ASSERT_VARIABLE (x); \
if (SCM_VARIABLE_REF (x) == SCM_UNDEFINED) \ if (scm_is_eq (SCM_VARIABLE_REF (x), SCM_UNDEFINED)) \
{ SYNC_REGISTER (); abort(); } \ { SYNC_REGISTER (); abort(); } \
} while (0) } while (0)
@ -136,7 +136,7 @@
#define ASSERT_ALIGNED_PROCEDURE() \ #define ASSERT_ALIGNED_PROCEDURE() \
do { if ((scm_t_bits)bp % 8) abort (); } while (0) do { if ((scm_t_bits)bp % 8) abort (); } while (0)
#define ASSERT_BOUND(x) \ #define ASSERT_BOUND(x) \
do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \ do { if (scm_is_eq ((x), SCM_UNDEFINED)) { SYNC_REGISTER (); abort(); } \
} while (0) } while (0)
#else #else
#define CHECK_IP() #define CHECK_IP()

14
libguile/vm-i-system.c
View file

@ -233,7 +233,7 @@ VM_DEFINE_INSTRUCTION (18, vector, "vector", 2, -1, 1)
nothing more than the corresponding macros. */ nothing more than the corresponding macros. */
#define VARIABLE_REF(v) SCM_VARIABLE_REF (v) #define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o) #define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED) #define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
#define FREE_VARIABLE_REF(i) SCM_PROGRAM_FREE_VARIABLE_REF (program, i) #define FREE_VARIABLE_REF(i) SCM_PROGRAM_FREE_VARIABLE_REF (program, i)
@ -277,10 +277,7 @@ VM_DEFINE_INSTRUCTION (22, long_local_ref, "long-local-ref", 2, 0, 1)
VM_DEFINE_INSTRUCTION (23, local_bound, "local-bound?", 1, 0, 1) VM_DEFINE_INSTRUCTION (23, local_bound, "local-bound?", 1, 0, 1)
{ {
if (LOCAL_REF (FETCH ()) == SCM_UNDEFINED) PUSH (scm_from_bool (!scm_is_eq (LOCAL_REF (FETCH ()), SCM_UNDEFINED)));
PUSH (SCM_BOOL_F);
else
PUSH (SCM_BOOL_T);
NEXT; NEXT;
} }
@ -289,10 +286,7 @@ VM_DEFINE_INSTRUCTION (24, long_local_bound, "long-local-bound?", 2, 0, 1)
unsigned int i = FETCH (); unsigned int i = FETCH ();
i <<= 8; i <<= 8;
i += FETCH (); i += FETCH ();
if (LOCAL_REF (i) == SCM_UNDEFINED) PUSH (scm_from_bool (!scm_is_eq (LOCAL_REF (i), SCM_UNDEFINED)));
PUSH (SCM_BOOL_F);
else
PUSH (SCM_BOOL_T);
NEXT; NEXT;
} }
@ -1666,7 +1660,7 @@ VM_DEFINE_INSTRUCTION (91, fluid_ref, "fluid-ref", 0, 1, 1)
else else
{ {
SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num); SCM val = SCM_SIMPLE_VECTOR_REF (fluids, num);
if (SCM_UNLIKELY (val == SCM_UNDEFINED)) if (SCM_UNLIKELY (scm_is_eq (val, SCM_UNDEFINED)))
{ {
finish_args = *sp; finish_args = *sp;
goto vm_error_unbound_fluid; goto vm_error_unbound_fluid;