1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-04 00:30:30 +02:00

Give structs a "struct scm_struct"

* libguile/modules.h (SCM_MODULE_OBARRAY):
(SCM_MODULE_USES):
(SCM_MODULE_BINDER):
(SCM_MODULE_EVAL_CLOSURE):
(SCM_MODULE_TRANSFORMER):
(SCM_MODULE_DUPLICATE_HANDLERS):
(SCM_MODULE_IMPORT_OBARRAY): Use SCM_STRUCT_SLOT_REF instead of
SCM_STRUCT_SLOTS.
* libguile/struct.h (scm_is_struct):
(scm_to_struct):
(scm_from_struct):
(scm_i_struct_vtable):
(scm_i_struct_ref_scm):
(scm_i_struct_set_scm):
(scm_i_struct_ref_raw):
(scm_i_struct_set_raw): New helpers.
(SCM_STRUCTP):
(SCM_STRUCT_SLOT_REF):
(SCM_STRUCT_SLOT_SET):
(SCM_STRUCT_DATA_REF):
(SCM_STRUCT_DATA_SET): Use new helpers.
(SCM_STRUCT_DATA):
(SCM_STRUCT_SLOTS): Remove.
(SCM_SET_VTABLE_FLAGS): Fix for SCM_STRUCT_SLOT_REF not being lvalue.
This commit is contained in:
Andy Wingo 2025-06-24 13:58:14 +02:00
parent c2f451bf57
commit 1c092eb413
2 changed files with 78 additions and 16 deletions

View file

@ -1,7 +1,7 @@
#ifndef SCM_MODULES_H #ifndef SCM_MODULES_H
#define SCM_MODULES_H #define SCM_MODULES_H
/* Copyright 1998,2000-2003,2006-2008,2011-2012,2018 /* Copyright 1998,2000-2003,2006-2008,2011-2012,2018,2025
Free Software Foundation, Inc. Free Software Foundation, Inc.
This file is part of Guile. This file is part of Guile.
@ -23,6 +23,7 @@
#include "libguile/gc.h" #include "libguile/gc.h"
#include "libguile/struct.h"
@ -48,19 +49,19 @@ SCM_API scm_t_bits scm_module_tag;
#define scm_module_index_import_obarray 8 #define scm_module_index_import_obarray 8
#define SCM_MODULE_OBARRAY(module) \ #define SCM_MODULE_OBARRAY(module) \
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_obarray]) SCM_STRUCT_SLOT_REF (module, scm_module_index_obarray)
#define SCM_MODULE_USES(module) \ #define SCM_MODULE_USES(module) \
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_uses]) SCM_STRUCT_SLOT_REF (module, scm_module_index_uses)
#define SCM_MODULE_BINDER(module) \ #define SCM_MODULE_BINDER(module) \
SCM_PACK (SCM_STRUCT_DATA (module) [scm_module_index_binder]) SCM_STRUCT_SLOT_REF (module, scm_module_index_binder)
#define SCM_MODULE_EVAL_CLOSURE(module) \ #define SCM_MODULE_EVAL_CLOSURE(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_eval_closure]) SCM_STRUCT_SLOT_REF (module, scm_module_index_eval_closure)
#define SCM_MODULE_TRANSFORMER(module) \ #define SCM_MODULE_TRANSFORMER(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_transformer]) SCM_STRUCT_SLOT_REF (module, scm_module_index_transformer)
#define SCM_MODULE_DUPLICATE_HANDLERS(module) \ #define SCM_MODULE_DUPLICATE_HANDLERS(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_duplicate_handlers]) SCM_STRUCT_SLOT_REF (module, scm_module_index_duplicate_handlers)
#define SCM_MODULE_IMPORT_OBARRAY(module) \ #define SCM_MODULE_IMPORT_OBARRAY(module) \
SCM_PACK (SCM_STRUCT_DATA (module)[scm_module_index_import_obarray]) SCM_STRUCT_SLOT_REF (module, scm_module_index_import_obarray)

View file

@ -109,13 +109,73 @@
typedef void (*scm_t_struct_finalize) (SCM obj); typedef void (*scm_t_struct_finalize) (SCM obj);
#define SCM_STRUCTP(X) (!SCM_IMP(X) && (SCM_TYP3(X) == scm_tc3_struct)) union scm_struct_slot
#define SCM_STRUCT_SLOTS(X) (SCM_CELL_OBJECT_LOC(X, 1)) {
#define SCM_STRUCT_SLOT_REF(X,I) (SCM_STRUCT_SLOTS (X)[(I)]) SCM scm;
#define SCM_STRUCT_SLOT_SET(X,I,V) SCM_STRUCT_SLOTS (X)[(I)]=(V) scm_t_bits raw;
#define SCM_STRUCT_DATA(X) ((scm_t_bits*)SCM_STRUCT_SLOTS (X)) };
#define SCM_STRUCT_DATA_REF(X,I) (SCM_STRUCT_DATA (X)[(I)])
#define SCM_STRUCT_DATA_SET(X,I,V) SCM_STRUCT_DATA (X)[(I)]=(V) struct scm_struct
{
scm_t_bits tagged_vtable;
union scm_struct_slot slots[];
};
static inline int
scm_is_struct (SCM x)
{
return SCM_NIMP (x) && (SCM_TYP3 (x) == scm_tc3_struct);
}
static inline struct scm_struct *
scm_to_struct (SCM x)
{
if (!scm_is_struct (x))
abort ();
return (struct scm_struct *) SCM_UNPACK_POINTER (x);
}
static inline SCM
scm_from_struct (struct scm_struct *x)
{
return SCM_PACK_POINTER (x);
}
static inline struct scm_struct *
scm_i_struct_vtable (struct scm_struct *x)
{
return (struct scm_struct *) (x->tagged_vtable - scm_tc3_struct);
}
static inline SCM
scm_i_struct_ref_scm (struct scm_struct *x, size_t idx)
{
return x->slots[idx].scm;
}
static inline void
scm_i_struct_set_scm (struct scm_struct *x, size_t idx, SCM val)
{
x->slots[idx].scm = val;
}
static inline scm_t_bits
scm_i_struct_ref_raw (struct scm_struct *x, size_t idx)
{
return x->slots[idx].raw;
}
static inline void
scm_i_struct_set_raw (struct scm_struct *x, size_t idx, scm_t_bits val)
{
x->slots[idx].raw = val;
}
#define SCM_STRUCTP(x) (scm_is_struct (x))
#define SCM_STRUCT_SLOT_REF(x,i) (scm_i_struct_ref_scm (scm_to_struct (x), i))
#define SCM_STRUCT_SLOT_SET(x,i,v) (scm_i_struct_set_scm (scm_to_struct (x), i, v))
#define SCM_STRUCT_DATA_REF(x,i) (scm_i_struct_ref_raw (scm_to_struct (x), i))
#define SCM_STRUCT_DATA_SET(x,i,v) (scm_i_struct_set_raw (scm_to_struct (x), i, v))
#define SCM_VALIDATE_STRUCT(pos, v) \ #define SCM_VALIDATE_STRUCT(pos, v) \
SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct") SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct")
@ -129,7 +189,8 @@ typedef void (*scm_t_struct_finalize) (SCM obj);
#define SCM_VTABLE_LAYOUT(X) (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout)) #define SCM_VTABLE_LAYOUT(X) (SCM_STRUCT_SLOT_REF ((X), scm_vtable_index_layout))
#define SCM_SET_VTABLE_LAYOUT(X,L) (SCM_STRUCT_SLOT_SET ((X), scm_vtable_index_layout, L)) #define SCM_SET_VTABLE_LAYOUT(X,L) (SCM_STRUCT_SLOT_SET ((X), scm_vtable_index_layout, L))
#define SCM_VTABLE_FLAGS(X) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags)) #define SCM_VTABLE_FLAGS(X) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags))
#define SCM_SET_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) |= (F)) #define SCM_SET_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_SET (X, scm_vtable_index_flags, \
SCM_VTABLE_FLAGS (X) | (F)))
#define SCM_CLEAR_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) &= (~(F))) #define SCM_CLEAR_VTABLE_FLAGS(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) &= (~(F)))
#define SCM_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) & (F)) #define SCM_VTABLE_FLAG_IS_SET(X,F) (SCM_STRUCT_DATA_REF (X, scm_vtable_index_flags) & (F))
#define SCM_VTABLE_INSTANCE_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_DATA_REF (X, scm_vtable_index_instance_finalize)) #define SCM_VTABLE_INSTANCE_FINALIZER(X) ((scm_t_struct_finalize)SCM_STRUCT_DATA_REF (X, scm_vtable_index_instance_finalize))