mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-09 23:40:29 +02:00
add SCM_HEAP_OBJECT_P
* libguile/tags.h (SCM_HEAP_OBJECT_P): New macro, an alias for SCM_NIMP. * libguile/arrays.c: * libguile/debug.c: * libguile/foreign.c: * libguile/gdbint.c: * libguile/guardians.c: * libguile/list.c: * libguile/modules.c: * libguile/options.c: * libguile/smob.c: * libguile/validate.h: * libguile/weak-set.c: * libguile/weak-table.c: * libguile/weak-vector.c: Use it instead of SCM_NIMP or !SCM_IMP.
This commit is contained in:
parent
fdecb44f32
commit
8c5bb72920
14 changed files with 26 additions and 32 deletions
|
@ -472,7 +472,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
|
||||||
int ndim, i, k;
|
int ndim, i, k;
|
||||||
|
|
||||||
SCM_VALIDATE_REST_ARGUMENT (args);
|
SCM_VALIDATE_REST_ARGUMENT (args);
|
||||||
SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
|
SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
|
||||||
|
|
||||||
if (scm_is_generalized_vector (ra))
|
if (scm_is_generalized_vector (ra))
|
||||||
{
|
{
|
||||||
|
|
|
@ -144,16 +144,9 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0,
|
||||||
if (scm_is_true (src))
|
if (scm_is_true (src))
|
||||||
return src;
|
return src;
|
||||||
|
|
||||||
switch (SCM_TYP7 (proc)) {
|
if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc)
|
||||||
case scm_tcs_struct:
|
&& SCM_HEAP_OBJECT_P ((proc = SCM_STRUCT_PROCEDURE (proc))))
|
||||||
if (!SCM_STRUCT_APPLICABLE_P (proc)
|
|
||||||
|| SCM_IMP (SCM_STRUCT_PROCEDURE (proc)))
|
|
||||||
break;
|
|
||||||
proc = SCM_STRUCT_PROCEDURE (proc);
|
|
||||||
continue;
|
continue;
|
||||||
default:
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
while (0);
|
while (0);
|
||||||
|
|
||||||
|
|
|
@ -195,7 +195,7 @@ SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0,
|
||||||
SCM ret;
|
SCM ret;
|
||||||
|
|
||||||
ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL);
|
ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL);
|
||||||
if (SCM_NIMP (ret))
|
if (SCM_HEAP_OBJECT_P (ret))
|
||||||
register_weak_reference (ret, scm);
|
register_weak_reference (ret, scm);
|
||||||
|
|
||||||
return ret;
|
return ret;
|
||||||
|
|
|
@ -158,7 +158,7 @@ gdb_read (char *str)
|
||||||
ans = scm_read (gdb_input_port);
|
ans = scm_read (gdb_input_port);
|
||||||
if (SCM_GC_P)
|
if (SCM_GC_P)
|
||||||
{
|
{
|
||||||
if (SCM_NIMP (ans))
|
if (SCM_HEAP_OBJECT_P (ans))
|
||||||
{
|
{
|
||||||
SEND_STRING ("Non-immediate created during gc. Memory may be trashed.");
|
SEND_STRING ("Non-immediate created during gc. Memory may be trashed.");
|
||||||
status = -1;
|
status = -1;
|
||||||
|
@ -167,7 +167,7 @@ gdb_read (char *str)
|
||||||
}
|
}
|
||||||
gdb_result = ans;
|
gdb_result = ans;
|
||||||
/* Protect answer from future GC (FIXME: still needed with BDW-GC?) */
|
/* Protect answer from future GC (FIXME: still needed with BDW-GC?) */
|
||||||
if (SCM_NIMP (ans))
|
if (SCM_HEAP_OBJECT_P (ans))
|
||||||
scm_permanent_object (ans);
|
scm_permanent_object (ans);
|
||||||
exit:
|
exit:
|
||||||
remark_port (gdb_input_port);
|
remark_port (gdb_input_port);
|
||||||
|
|
|
@ -193,7 +193,7 @@ scm_i_guard (SCM guardian, SCM obj)
|
||||||
{
|
{
|
||||||
t_guardian *g = GUARDIAN_DATA (guardian);
|
t_guardian *g = GUARDIAN_DATA (guardian);
|
||||||
|
|
||||||
if (SCM_NIMP (obj))
|
if (SCM_HEAP_OBJECT_P (obj))
|
||||||
{
|
{
|
||||||
/* Register a finalizer and pass a pair as the ``client data''
|
/* Register a finalizer and pass a pair as the ``client data''
|
||||||
argument. The pair contains in its car `#f' or a pair describing a
|
argument. The pair contains in its car `#f' or a pair describing a
|
||||||
|
|
|
@ -90,7 +90,7 @@ scm_list_n (SCM elt, ...)
|
||||||
while (! SCM_UNBNDP (elt))
|
while (! SCM_UNBNDP (elt))
|
||||||
{
|
{
|
||||||
#if (SCM_DEBUG_CELL_ACCESSES == 1)
|
#if (SCM_DEBUG_CELL_ACCESSES == 1)
|
||||||
if (SCM_NIMP (elt))
|
if (SCM_HEAP_OBJECT_P (elt))
|
||||||
SCM_VALIDATE_CELL(elt, 0);
|
SCM_VALIDATE_CELL(elt, 0);
|
||||||
#endif
|
#endif
|
||||||
*pos = scm_cons (elt, SCM_EOL);
|
*pos = scm_cons (elt, SCM_EOL);
|
||||||
|
|
|
@ -695,7 +695,7 @@ scm_sym2var (SCM sym, SCM proc, SCM definep)
|
||||||
{
|
{
|
||||||
SCM var;
|
SCM var;
|
||||||
|
|
||||||
if (SCM_NIMP (proc))
|
if (SCM_HEAP_OBJECT_P (proc))
|
||||||
{
|
{
|
||||||
if (SCM_EVAL_CLOSURE_P (proc))
|
if (SCM_EVAL_CLOSURE_P (proc))
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010 Free Software Foundation
|
/* Copyright (C) 1995,1996,1998,2000,2001, 2006, 2008, 2009, 2010, 2011 Free Software Foundation
|
||||||
*
|
*
|
||||||
* 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
|
||||||
|
@ -231,9 +231,9 @@ change_option_setting (SCM args, scm_t_option options[], const char *s,
|
||||||
{
|
{
|
||||||
SCM old = SCM_PACK (options[i].val);
|
SCM old = SCM_PACK (options[i].val);
|
||||||
SCM new = SCM_PACK (flags[i]);
|
SCM new = SCM_PACK (flags[i]);
|
||||||
if (!SCM_IMP (old))
|
if (SCM_HEAP_OBJECT_P (old))
|
||||||
protected_objects = scm_delq1_x (old, protected_objects);
|
protected_objects = scm_delq1_x (old, protected_objects);
|
||||||
if (!SCM_IMP (new))
|
if (SCM_HEAP_OBJECT_P (new))
|
||||||
protected_objects = scm_cons (new, protected_objects);
|
protected_objects = scm_cons (new, protected_objects);
|
||||||
}
|
}
|
||||||
options[i].val = flags[i];
|
options[i].val = flags[i];
|
||||||
|
|
|
@ -516,7 +516,7 @@ smob_mark (GC_word *addr, struct GC_ms_entry *mark_stack_ptr,
|
||||||
|
|
||||||
mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
|
mark_stack_ptr = SCM_I_CURRENT_THREAD->current_mark_stack_ptr;
|
||||||
|
|
||||||
if (SCM_NIMP (obj))
|
if (SCM_HEAP_OBJECT_P (obj))
|
||||||
/* Mark the returned object. */
|
/* Mark the returned object. */
|
||||||
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
|
mark_stack_ptr = GC_MARK_AND_PUSH (SCM2PTR (obj),
|
||||||
mark_stack_ptr,
|
mark_stack_ptr,
|
||||||
|
@ -541,7 +541,7 @@ scm_gc_mark (SCM o)
|
||||||
#define CURRENT_MARK_LIMIT \
|
#define CURRENT_MARK_LIMIT \
|
||||||
((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
|
((struct GC_ms_entry *)(SCM_I_CURRENT_THREAD->current_mark_stack_limit))
|
||||||
|
|
||||||
if (SCM_NIMP (o))
|
if (SCM_HEAP_OBJECT_P (o))
|
||||||
{
|
{
|
||||||
/* At this point, the `current_mark_*' fields of the current thread
|
/* At this point, the `current_mark_*' fields of the current thread
|
||||||
must be defined (they are set in `smob_mark ()'). */
|
must be defined (they are set in `smob_mark ()'). */
|
||||||
|
|
|
@ -355,6 +355,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
|
||||||
* since for a SCM variable it is known that tc1==0. */
|
* since for a SCM variable it is known that tc1==0. */
|
||||||
#define SCM_IMP(x) (6 & SCM_UNPACK (x))
|
#define SCM_IMP(x) (6 & SCM_UNPACK (x))
|
||||||
#define SCM_NIMP(x) (!SCM_IMP (x))
|
#define SCM_NIMP(x) (!SCM_IMP (x))
|
||||||
|
#define SCM_HEAP_OBJECT_P(x) (SCM_NIMP (x))
|
||||||
|
|
||||||
/* Checking if a SCM variable holds an immediate integer: See numbers.h for
|
/* Checking if a SCM variable holds an immediate integer: See numbers.h for
|
||||||
* the definition of the following macros: SCM_I_FIXNUM_BIT,
|
* the definition of the following macros: SCM_I_FIXNUM_BIT,
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
#ifndef SCM_VALIDATE_H
|
#ifndef SCM_VALIDATE_H
|
||||||
#define SCM_VALIDATE_H
|
#define SCM_VALIDATE_H
|
||||||
|
|
||||||
/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009 Free Software Foundation, Inc.
|
/* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009, 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
|
||||||
|
@ -354,7 +354,7 @@
|
||||||
|
|
||||||
#define SCM_VALIDATE_ARRAY(pos, v) \
|
#define SCM_VALIDATE_ARRAY(pos, v) \
|
||||||
do { \
|
do { \
|
||||||
SCM_ASSERT (!SCM_IMP (v) \
|
SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \
|
||||||
&& scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
|
&& scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \
|
||||||
v, pos, FUNC_NAME); \
|
v, pos, FUNC_NAME); \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
|
@ -171,7 +171,7 @@ move_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry *to)
|
||||||
to->hash = copy.hash;
|
to->hash = copy.hash;
|
||||||
to->key = copy.key;
|
to->key = copy.key;
|
||||||
|
|
||||||
if (copy.key && SCM_NIMP (SCM_PACK (copy.key)))
|
if (copy.key && SCM_HEAP_OBJECT_P (SCM_PACK (copy.key)))
|
||||||
{
|
{
|
||||||
GC_unregister_disappearing_link ((GC_PTR) &from->key);
|
GC_unregister_disappearing_link ((GC_PTR) &from->key);
|
||||||
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &to->key,
|
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &to->key,
|
||||||
|
@ -358,7 +358,7 @@ resize_set (scm_t_weak_set *set)
|
||||||
new_entries[new_k].hash = copy.hash;
|
new_entries[new_k].hash = copy.hash;
|
||||||
new_entries[new_k].key = copy.key;
|
new_entries[new_k].key = copy.key;
|
||||||
|
|
||||||
if (SCM_NIMP (SCM_PACK (copy.key)))
|
if (SCM_HEAP_OBJECT_P (SCM_PACK (copy.key)))
|
||||||
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &new_entries[new_k].key,
|
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &new_entries[new_k].key,
|
||||||
(GC_PTR) new_entries[new_k].key);
|
(GC_PTR) new_entries[new_k].key);
|
||||||
}
|
}
|
||||||
|
@ -519,7 +519,7 @@ weak_set_add_x (scm_t_weak_set *set, unsigned long hash,
|
||||||
entries[k].hash = hash;
|
entries[k].hash = hash;
|
||||||
entries[k].key = SCM_UNPACK (obj);
|
entries[k].key = SCM_UNPACK (obj);
|
||||||
|
|
||||||
if (SCM_NIMP (obj))
|
if (SCM_HEAP_OBJECT_P (obj))
|
||||||
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entries[k].key,
|
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entries[k].key,
|
||||||
(GC_PTR) SCM2PTR (obj));
|
(GC_PTR) SCM2PTR (obj));
|
||||||
|
|
||||||
|
@ -571,7 +571,7 @@ weak_set_remove_x (scm_t_weak_set *set, unsigned long hash,
|
||||||
entries[k].hash = 0;
|
entries[k].hash = 0;
|
||||||
entries[k].key = 0;
|
entries[k].key = 0;
|
||||||
|
|
||||||
if (SCM_NIMP (SCM_PACK (copy.key)))
|
if (SCM_HEAP_OBJECT_P (SCM_PACK (copy.key)))
|
||||||
GC_unregister_disappearing_link ((GC_PTR) &entries[k].key);
|
GC_unregister_disappearing_link ((GC_PTR) &entries[k].key);
|
||||||
|
|
||||||
if (--set->n_items < set->lower)
|
if (--set->n_items < set->lower)
|
||||||
|
|
|
@ -127,13 +127,13 @@ register_disappearing_links (scm_t_weak_entry *entry,
|
||||||
SCM k, SCM v,
|
SCM k, SCM v,
|
||||||
scm_t_weak_table_kind kind)
|
scm_t_weak_table_kind kind)
|
||||||
{
|
{
|
||||||
if (SCM_UNPACK (k) && SCM_NIMP (k)
|
if (SCM_UNPACK (k) && SCM_HEAP_OBJECT_P (k)
|
||||||
&& (kind == SCM_WEAK_TABLE_KIND_KEY
|
&& (kind == SCM_WEAK_TABLE_KIND_KEY
|
||||||
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
|
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
|
||||||
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->key,
|
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->key,
|
||||||
(GC_PTR) SCM2PTR (k));
|
(GC_PTR) SCM2PTR (k));
|
||||||
|
|
||||||
if (SCM_UNPACK (v) && SCM_NIMP (v)
|
if (SCM_UNPACK (v) && SCM_HEAP_OBJECT_P (v)
|
||||||
&& (kind == SCM_WEAK_TABLE_KIND_VALUE
|
&& (kind == SCM_WEAK_TABLE_KIND_VALUE
|
||||||
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
|
|| kind == SCM_WEAK_TABLE_KIND_BOTH))
|
||||||
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->value,
|
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &entry->value,
|
||||||
|
|
|
@ -53,7 +53,7 @@ make_weak_vector (size_t len, SCM fill)
|
||||||
|
|
||||||
SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect);
|
SCM_SET_CELL_WORD_0 (wv, (len << 8) | scm_tc7_wvect);
|
||||||
|
|
||||||
if (SCM_NIMP (fill))
|
if (SCM_HEAP_OBJECT_P (fill))
|
||||||
{
|
{
|
||||||
memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM));
|
memset (SCM_I_VECTOR_WELTS (wv), 0, len * sizeof (SCM));
|
||||||
for (j = 0; j < len; j++)
|
for (j = 0; j < len; j++)
|
||||||
|
@ -170,12 +170,12 @@ scm_c_weak_vector_set_x (SCM wv, size_t k, SCM x)
|
||||||
|
|
||||||
elts = SCM_I_VECTOR_WELTS (wv);
|
elts = SCM_I_VECTOR_WELTS (wv);
|
||||||
|
|
||||||
if (prev && SCM_NIMP (PTR2SCM (prev)))
|
if (prev && SCM_HEAP_OBJECT_P (SCM_PACK_POINTER (prev)))
|
||||||
GC_unregister_disappearing_link ((GC_PTR) &elts[k]);
|
GC_unregister_disappearing_link ((GC_PTR) &elts[k]);
|
||||||
|
|
||||||
elts[k] = x;
|
elts[k] = x;
|
||||||
|
|
||||||
if (SCM_NIMP (x))
|
if (SCM_HEAP_OBJECT_P (x))
|
||||||
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &elts[k],
|
SCM_I_REGISTER_DISAPPEARING_LINK ((GC_PTR) &elts[k],
|
||||||
(GC_PTR) SCM2PTR (x));
|
(GC_PTR) SCM2PTR (x));
|
||||||
}
|
}
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue