mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
b071ce2147
Currently failing some guardian tests. * libguile/tags.h: Refactor tagging so that tc3 bits for a pair live in the SCM value, not in the heap words. Do the same for structs. This more rational tagging strategy will make native code generation easier. Note that this means that to check a heap pointer for its type, you first have to ensure that it has the expected tc3, as not all the type bits are on the heap. (SCM_TYP3): Check the SCM tag type, not the bits in the cell. (SCM_HAS_TYP3): New helper. (SCM_I_CONSP): Redefine to just check the typ3. (scm_tcs_cons_imcar, scm_tcs_cons_nimcar, scm_tcs_struct): Remove, as they are no longer necessary. * libguile/array-handle.c (scm_i_array_implementation_for_obj): Check for heap objects before checking type bits, so we don't check pairs. * libguile/evalext.c (scm_self_evaluating_p): * libguile/gc.c (scm_i_tag_name): * libguile/goops.c (scm_class_of) * libguile/hash.c (scm_hasher): * libguile/print.c (iprin1): Adapt to tagging changes. * libguile/gc.c (scm_storage_prehistory): Register all displacements here. There are the same displacements as before, unfortunately. * libguile/list.c (SCM_I_CONS): * libguile/pairs.c (scm_cons): * libguile/pairs.h (scm_is_pair): * libguile/vm-engine.h (CONS): Tag pairs with scm_tc3_pair. * libguile/modules.c (scm_post_boot_init_modules): * libguile/modules.h (SCM_MODULEP): * libguile/struct.c (struct_finalizer_trampoline, scm_i_alloc_struct): (scm_make_vtable_vtable): * libguile/struct.h (SCM_STRUCTP, SCM_STRUCT_VTABLE_DATA): (SCM_STRUCT_VTABLE_SLOTS): * libguile/vm-i-scheme.c (make-struct): Adapt to struct tagging changes. * libguile/numbers.h (SCM_I_INUMP): * module/rnrs/arithmetic/fixnums.scm (fixnum?, inline-fixnum?): Adapt to the new fixnum tag. * libguile/numbers.h (SCM_INEXACTP): Make sure of the tc3 before looking at the cell type.
120 lines
3 KiB
C
120 lines
3 KiB
C
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
|
||
*
|
||
* This library is free software; you can redistribute it and/or
|
||
* modify it under the terms of the GNU Lesser General Public License
|
||
* as published by the Free Software Foundation; either version 3 of
|
||
* the License, or (at your option) any later version.
|
||
*
|
||
* This library 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
|
||
* Lesser General Public License for more details.
|
||
*
|
||
* You should have received a copy of the GNU Lesser General Public
|
||
* License along with this library; if not, write to the Free Software
|
||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||
* 02110-1301 USA
|
||
*/
|
||
|
||
|
||
|
||
#ifdef HAVE_CONFIG_H
|
||
# include <config.h>
|
||
#endif
|
||
|
||
#include "libguile/_scm.h"
|
||
#include "libguile/eval.h"
|
||
#include "libguile/fluids.h"
|
||
#include "libguile/modules.h"
|
||
|
||
#include "libguile/validate.h"
|
||
#include "libguile/evalext.h"
|
||
|
||
SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
|
||
(SCM sym, SCM module),
|
||
"Return @code{#t} if @var{sym} is defined in the module "
|
||
"@var{module} or the current module when @var{module} is not"
|
||
"specified.")
|
||
#define FUNC_NAME s_scm_defined_p
|
||
{
|
||
SCM var;
|
||
|
||
SCM_VALIDATE_SYMBOL (1, sym);
|
||
|
||
if (SCM_UNBNDP (module))
|
||
module = scm_current_module ();
|
||
else
|
||
SCM_VALIDATE_MODULE (2, module);
|
||
|
||
var = scm_module_variable (module, sym);
|
||
|
||
return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
|
||
? SCM_BOOL_F
|
||
: SCM_BOOL_T);
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
|
||
SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
||
(SCM obj),
|
||
"Return #t for objects which Guile considers self-evaluating")
|
||
#define FUNC_NAME s_scm_self_evaluating_p
|
||
{
|
||
switch (SCM_ITAG3 (obj))
|
||
{
|
||
case scm_tc3_int_1:
|
||
case scm_tc3_int_2:
|
||
/* inum */
|
||
return SCM_BOOL_T;
|
||
case scm_tc3_imm24:
|
||
/* characters, booleans, other immediates */
|
||
return scm_from_bool (!scm_is_null_and_not_nil (obj));
|
||
case scm_tc3_struct:
|
||
return SCM_BOOL_T;
|
||
case scm_tc3_cons:
|
||
return SCM_BOOL_F;
|
||
case scm_tc3_heap:
|
||
switch (SCM_TYP7 (obj))
|
||
{
|
||
case scm_tc7_vector:
|
||
case scm_tc7_wvect:
|
||
case scm_tc7_pointer:
|
||
case scm_tc7_hashtable:
|
||
case scm_tc7_weak_set:
|
||
case scm_tc7_weak_table:
|
||
case scm_tc7_fluid:
|
||
case scm_tc7_dynamic_state:
|
||
case scm_tc7_frame:
|
||
case scm_tc7_objcode:
|
||
case scm_tc7_vm:
|
||
case scm_tc7_vm_cont:
|
||
case scm_tc7_number:
|
||
case scm_tc7_string:
|
||
case scm_tc7_smob:
|
||
case scm_tc7_program:
|
||
case scm_tc7_bytevector:
|
||
case scm_tc7_array:
|
||
case scm_tc7_bitvector:
|
||
return SCM_BOOL_T;
|
||
default:
|
||
return SCM_BOOL_F;
|
||
}
|
||
default:
|
||
SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
|
||
scm_list_1 (obj));
|
||
return SCM_UNSPECIFIED; /* never reached */
|
||
}
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
void
|
||
scm_init_evalext ()
|
||
{
|
||
#include "libguile/evalext.x"
|
||
}
|
||
|
||
/*
|
||
Local Variables:
|
||
c-file-style: "gnu"
|
||
End:
|
||
*/
|