[uim-commit] r2628 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Sat Dec 17 01:28:03 PST 2005
Author: kzk
Date: 2005-12-17 01:27:56 -0800 (Sat, 17 Dec 2005)
New Revision: 2628
Modified:
branches/r5rs/sigscheme/storage-compact.h
Log:
* sigscheme/storage-compact.h
- implement 'cons', 'closure', 'imm' accessor
- NEW
- (SCM_GCBIT_MARKED, SCM_GCBIT_UNMARKED,
SCM_IMM_VAL_MASK_INT, SCM_IMM_VAL_MASK_CHAR,
SCM_CELL_SET_CAR, SCM_CELL_SET_CDR,
SCM_TAG_OTHERS_TYPEP, SCM_TAG_IMM_TYPEP,
SCM_CONS_CAR_VAL, SCM_CONS_CDR_VAL,
SCM_CONS_SET_CAR_VAL, SCM_CONS_SET_CDR_VAL,
SCM_CLOSURE_CAR_VAL, SCM_CLOSURE_CDR_VAL,
SCM_CLOSURE_SET_CAR_VAL, SCM_CLOSURE_SET_CDR_VAL,
SCM_IMM_TAGGING, SCM_IMM_VAL, SCM_IMM_SET_VAL,
SCM_SAL_CONS_CAR, SCM_SAL_CONS_CDR,
SCM_SAL_CONS_SET_CAR, SCM_SAL_CONS_SET_CDR,
SCM_SAL_CLOSURE_EXP SCM_SAL_CLOSURE_ENV,
SCM_SAL_CLOSURE_SET_EXP, SCM_SAL_CLOSURE_SET_ENV,
SCM_SAL_INT_VALUE, SCM_SAL_INT_SET_VALUE,
SCM_SAL_CHAR_VALUE, SCM_SAL_CHAR_SET_VALUE): new macro
- MODIFIED
- (SCM_TAG_OTHERSP
SCM_TAG_IMMP): change to only check the tag
- (SCM_SAL_SYMBOLP, SCM_SAL_STRINGP,
SCM_SAL_VECTORP, SCM_SAL_VALUEPACKETP,
SCM_SAL_FUNCP, SCM_SAL_PORTP,
SCM_SAL_CONTINUATIONP, SCM_SAL_C_POINTERP,
SCM_SAL_C_FUNCPOINTERP, SCM_SAL_FREECELLP,
SCM_SAL_INTP, SCM_SAL_CHARP, SCM_SAL_CONSTANTP,
SCM_SAL_ENTYPE_CONS, SCM_SAL_ENTYPE_CLOSURE)
: use *_TYPEP
- (SCM_SAL_IS_MARKED, SCM_SAL_IS_UNMARKED): use SCM_GCBIT_MARKED
- (SCM_SAL_DO_MARK, SCM_SAL_DO_UNMARK): more clear representation
- REMOVED
- (SCM_STRIP_OTHERS_CDR_PRIMARY_TAG
SCM_STRIP_OTHERS_CDR_SUB_TAG
SCM_STRIP_OTHERS_CDR_EXT_TAG
SCM_SET_CELL_CAR
SCM_SET_CELL_CDR
SCM_CAR
SCM_CDR
SCM_CONS_SET_CAR
SCM_CONS_SET_CDR
SCM_CLOSURE_EXP
SCM_CLOSURE_ENV
SCM_CLOSURE_SET_EXP
SCM_CLOSURE_SET_ENV
BITS_PER_BITE
SIZEOF_INT
SIGN_BIT_MASK
SIGN_VALUE_MASK
SIGNED_MARK
SCM_INT_VALUE
SCM_INT_SET_VALUE
SCM_CHAR_VALUE
SCM_CHAR_SET_VALUE): removed
Modified: branches/r5rs/sigscheme/storage-compact.h
===================================================================
--- branches/r5rs/sigscheme/storage-compact.h 2005-12-17 01:38:33 UTC (rev 2627)
+++ branches/r5rs/sigscheme/storage-compact.h 2005-12-17 09:27:56 UTC (rev 2628)
@@ -130,17 +130,17 @@
*/
/*=======================================
- System Include
+ System Include
=======================================*/
#include <stdio.h>
/*=======================================
- Local Include
+ Local Include
=======================================*/
#include "baseport.h"
/*=======================================
- Type Declarations
+ Type Declarations
=======================================*/
typedef struct ScmCell_ ScmCell;
typedef ScmCell *ScmObj;
@@ -149,7 +149,7 @@
typedef ScmObj (*ScmFuncType)();
/*=======================================
- Struct Declarations
+ Struct Declarations
=======================================*/
enum ScmStrMutationType {
SCM_STR_IMMUTABLE = 0,
@@ -166,11 +166,13 @@
Internal Macros
==============================================================================*/
/*=======================================
- Masks Offsets, and Tags
+ Masks Offsets, and Tags
=======================================*/
#define SCM_GCBIT_WIDTH 1
#define SCM_GCBIT_OFFSET 0
#define SCM_GCBIT_MASK (0x1 << SCM_GCBIT_OFFSET)
+#define SCM_GCBIT_MARKED 1
+#define SCM_GCBIT_UNMARKED 0
/* 'IMM' stands for 'Immediate' */
#define SCM_TAG_WIDTH 2
@@ -200,7 +202,7 @@
/* sub tag */
#define SCM_OTHERS_CDR_SUB_TAG_WIDTH 3
-#define SCM_OTHERS_CDR_SUB_TAG_OFFSET \
+#define SCM_OTHERS_CDR_SUB_TAG_OFFSET \
(SCM_OTHERS_CDR_PRIMARY_TAG_OFFSET + SCM_OTHERS_CDR_SUB_TAG_WIDTH)
#define SCM_OTHERS_CDR_SUB_TAG_MASK \
(0x7 << SCM_OTHERS_CDR_SUB_TAG_OFFSET)
@@ -224,7 +226,7 @@
/* extended tag (combines primary tag and sub tag) */
#define SCM_OTHERS_CDR_EXT_TAG_WIDTH \
(SCM_OTHERS_CDR_PRIMARY_TAG_WIDTH + SCM_OTHERS_CDR_SUB_TAG_WIDTH)
-#define SCM_OTHERS_CDR_EXT_TAG_OFFSET \
+#define SCM_OTHERS_CDR_EXT_TAG_OFFSET \
(SCM_OTHERS_CDR_PRIMARY_TAG_OFFSET)
#define SCM_OTHERS_CDR_EXT_TAG_MASK \
(SCM_OTHERS_CDR_PRIMARY_TAG_MASK | SCM_OTHERS_CDR_SUB_TAG_MASK)
@@ -247,7 +249,7 @@
/* pointer tag */
#define SCM_OTHERS_CDR_PTR_TAG_WIDTH 2
-#define SCM_OTHERS_CDR_PTR_TAG_OFFSET \
+#define SCM_OTHERS_CDR_PTR_TAG_OFFSET \
(SCM_OTHERS_CDR_EXT_TAG_OFFSET + SCM_OTHERS_CDR_EXT_TAG_WIDTH)
#define SCM_OTHERS_CDR_PTR_TAG_MASK \
(0x3 << SCM_OTHERS_CDR_PTR_TAG_OFFSET)
@@ -273,9 +275,9 @@
SCM_OTHERS_CDR_PRIMARY_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_SYMBOL \
SCM_OTHERS_CDR_PRIMARY_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_SYMBOL \
+#define SCM_OTHERS_CDR_VAL_OFFSET_SYMBOL \
SCM_OTHERS_CDR_PRIMARY_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_SYMBOL \
+#define SCM_OTHERS_CDR_VAL_MASK_SYMBOL \
(~0U << SCM_OTHERS_CDR_PRIMARY_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_STRING \
@@ -286,9 +288,9 @@
SCM_OTHERS_CDR_PRIMARY_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_STRING \
SCM_OTHERS_CDR_PRIMARY_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_STRING \
+#define SCM_OTHERS_CDR_VAL_OFFSET_STRING \
SCM_OTHERS_CDR_PRIMARY_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_STRING \
+#define SCM_OTHERS_CDR_VAL_MASK_STRING \
(~0U << SCM_OTHERS_CDR_PRIMARY_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_VECTOR \
@@ -299,9 +301,9 @@
SCM_OTHERS_CDR_PRIMARY_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_VECTOR \
SCM_OTHERS_CDR_PRIMARY_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_VECTOR \
+#define SCM_OTHERS_CDR_VAL_OFFSET_VECTOR \
SCM_OTHERS_CDR_PRIMARY_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_VECTOR \
+#define SCM_OTHERS_CDR_VAL_MASK_VECTOR \
(~0U << SCM_OTHERS_CDR_PRIMARY_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_VALUES \
@@ -312,9 +314,9 @@
SCM_OTHERS_CDR_EXT_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_VALUES \
SCM_OTHERS_CDR_EXT_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_VALUES \
+#define SCM_OTHERS_CDR_VAL_OFFSET_VALUES \
SCM_OTHERS_CDR_EXT_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_VALUES \
+#define SCM_OTHERS_CDR_VAL_MASK_VALUES \
(~0U << SCM_OTHERS_CDR_EXT_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_FUNC \
@@ -325,9 +327,9 @@
SCM_OTHERS_CDR_EXT_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_FUNC \
SCM_OTHERS_CDR_EXT_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_FUNC \
+#define SCM_OTHERS_CDR_VAL_OFFSET_FUNC \
SCM_OTHERS_CDR_EXT_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_FUNC \
+#define SCM_OTHERS_CDR_VAL_MASK_FUNC \
(~0U << SCM_OTHERS_CDR_EXT_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_PORT \
@@ -338,9 +340,9 @@
SCM_OTHERS_CDR_EXT_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_PORT \
SCM_OTHERS_CDR_EXT_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_PORT \
+#define SCM_OTHERS_CDR_VAL_OFFSET_PORT \
SCM_OTHERS_CDR_EXT_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_PORT \
+#define SCM_OTHERS_CDR_VAL_MASK_PORT \
(~0U << SCM_OTHERS_CDR_EXT_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_CONTINUATION \
@@ -351,9 +353,9 @@
SCM_OTHERS_CDR_EXT_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_CONTINUATION \
SCM_OTHERS_CDR_EXT_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_CONTINUATION \
+#define SCM_OTHERS_CDR_VAL_OFFSET_CONTINUATION \
SCM_OTHERS_CDR_EXT_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_CONTINUATION \
+#define SCM_OTHERS_CDR_VAL_MASK_CONTINUATION \
(~0U << SCM_OTHERS_CDR_EXT_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_C_POINTER \
@@ -364,9 +366,9 @@
(SCM_OTHERS_CDR_EXT_TAG_WIDTH + SCM_OTHERS_CDR_PTR_TAG_WIDTH)
#define SCM_OTHERS_CDR_TAG_OFFSET_C_POINTER \
SCM_OTHERS_CDR_PTR_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_C_POINTER \
+#define SCM_OTHERS_CDR_VAL_OFFSET_C_POINTER \
SCM_OTHERS_CDR_PTR_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_C_POINTER \
+#define SCM_OTHERS_CDR_VAL_MASK_C_POINTER \
(~0U << SCM_OTHERS_CDR_PTR_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_C_FUNCPOINTER \
@@ -377,9 +379,9 @@
(SCM_OTHERS_CDR_EXT_TAG_WIDTH + SCM_OTHERS_CDR_PTR_TAG_WIDTH)
#define SCM_OTHERS_CDR_TAG_OFFSET_C_FUNCPOINTER \
SCM_OTHERS_CDR_PTR_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_C_FUNCPOINTER \
+#define SCM_OTHERS_CDR_VAL_OFFSET_C_FUNCPOINTER \
SCM_OTHERS_CDR_PTR_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_C_FUNCPOINTER \
+#define SCM_OTHERS_CDR_VAL_MASK_C_FUNCPOINTER \
(~0U << SCM_OTHERS_CDR_PTR_VAL_OFFSET)
#define SCM_OTHERS_CDR_TAG_FREECELL \
@@ -390,9 +392,9 @@
SCM_OTHERS_CDR_EXT_TAG_WIDTH
#define SCM_OTHERS_CDR_TAG_OFFSET_FREECELL \
SCM_OTHERS_CDR_EXT_TAG_OFFSET
-#define SCM_OTHERS_CDR_VAL_OFFSET_FREECELL \
+#define SCM_OTHERS_CDR_VAL_OFFSET_FREECELL \
SCM_OTHERS_CDR_EXT_VAL_OFFSET
-#define SCM_OTHERS_CDR_VAL_MASK_FREECELL \
+#define SCM_OTHERS_CDR_VAL_MASK_FREECELL \
(~0U << SCM_OTHERS_CDR_EXT_VAL_OFFSET)
/*==============================================================================
@@ -415,14 +417,19 @@
#define SCM_IMM_TAG_EOF (SCM_TAG_IMM | (0x3 << 3) | (0x5 << 5))
#define SCM_IMM_TAG_UNDEF (SCM_TAG_IMM | (0x3 << 3) | (0x6 << 5))
-/* offset */
+/* for each type */
+#define SCM_IMM_VAL_MASK_INT (~(SCM_IMM_TAG_MASK_INT | SCM_GCBIT_MASK))
#define SCM_IMM_VAL_OFFSET_INT \
(SCM_GCBIT_OFFSET + SCM_GCBIT_WIDTH + SCM_TAG_WIDTH + 1)
+
+#define SCM_IMM_VAL_MASK_CHAR (~(SCM_IMM_TAG_MASK_CHAR | SCM_GCBIT_MASK))
#define SCM_IMM_VAL_OFFSET_CHAR \
(SCM_GCBIT_OFFSET + SCM_GCBIT_WIDTH + SCM_TAG_WIDTH + 2)
+/* constant mask and offset are no need */
+
/*=======================================
- Casting Macros
+ Casting Macros
=======================================*/
#define SCM_CAST_INT(a) ((int)(a))
#define SCM_CAST_UINT(a) ((unsigned int)(a))
@@ -432,57 +439,53 @@
/*=======================================
Strip Tag Macros
=======================================*/
-/* cell */
#define SCM_STRIP_GCBIT(a) (SCM_CAST_UINT(a) & ~SCM_GCBIT_MASK)
/* FIXME: we need to prepare both SCM_STRIP_TAG and SCM_STRIP_TAG_AND_GCBIT macro? */
#define SCM_STRIP_TAG(a) (SCM_CAST_UINT(a) & ~(SCM_GCBIT_MASK | SCM_TAG_MASK))
-/* others cdr */
-/*
-#define SCM_STRIP_OTHERS_CDR_PRIMARY_TAG(a) \
- (SCM_CAST_UINT(SCM_CELL_CDR(a)) & ~SCM_OTHERS_CDR_PRIMARY_TAG_MASK)
-#define SCM_STRIP_OTHERS_CDR_SUB_TAG(a) \
- (SCM_CAST_UINT(SCM_CELL_CDR(a)) & ~SCM_OTHERS_CDR_SUB_TAG_MASK)
-#define SCM_STRIP_OTHERS_CDR_EXT_TAG(a) \
- (SCM_CAST_UINT(SCM_CELL_CDR(a)) & ~SCM_OTHERS_CDR_EXT_TAG_MASK)
-*/
-
/*=======================================
- GC bit Operator
+ GC bit Operator
=======================================*/
#define SCM_GCBIT_ON(a) ((a) = (ScmObj)(SCM_STRIP_GCBIT(a) | 1))
#define SCM_GCBIT_OFF(a) ((a) = (ScmObj)(SCM_STRIP_GCBIT(a) | 0))
/*=======================================
- Tag Accessor
+ Tag Accessor
=======================================*/
#define SCM_GCBIT(a) (SCM_CAST_UINT(a) & SCM_GCBIT_MASK)
#define SCM_TAG(a) (SCM_CAST_UINT(a) & SCM_TAG_MASK)
/*=======================================
- Getter & Setter
+ Cell CAR & CDR accessor
=======================================*/
#define SCM_CELL_CAR(a) (((ScmObj)(SCM_STRIP_TAG(a)))->car)
#define SCM_CELL_CDR(a) (((ScmObj)(SCM_STRIP_TAG(a)))->cdr)
-#define SCM_SET_CELL_CAR(a, val) (SCM_CELL_CAR(a) = (ScmObj)(val))
-#define SCM_SET_CELL_CDR(a, val) (SCM_CELL_CDR(a) = (ScmObj)(val))
+#define SCM_CELL_SET_CAR(a, val) (SCM_CELL_CAR(a) = (ScmObj)(val))
+#define SCM_CELL_SET_CDR(a, val) (SCM_CELL_CDR(a) = (ScmObj)(val))
/*=======================================
- Type Predicates
+ Type Predicates
=======================================*/
-/* Tag Accessor */
+/* Tag Predicates */
#define SCM_TAG_CONSP(a) \
(SCM_TAG(a) == SCM_TAG_CONS)
#define SCM_TAG_CLOSUREP(a) \
(SCM_TAG(a) == SCM_TAG_CLOSURE)
-#define SCM_TAG_OTHERSP(a, type) \
+#define SCM_TAG_OTHERSP(a) \
+ (SCM_TAG(a) == SCM_TAG_OTHERS)
+#define SCM_TAG_IMMP(a) \
+ (SCM_TAG(a) == SCM_TAG_IMM)
+
+/* Tag Predicates with specifing Type */
+#define SCM_TAG_OTHERS_TYPEP(a, type) \
((SCM_TAG(a) == SCM_TAG_OTHERS) \
&& (SCM_CAST_UINT(SCM_CELL_CDR(a)) & SCM_OTHERS_CDR_TAG_MASK_##type) \
== SCM_OTHERS_CDR_TAG_##type)
-#define SCM_TAG_IMMP(a, type) \
+#define SCM_TAG_IMM_TYPEP(a, type) \
((SCM_TAG(a) == SCM_TAG_IMM) \
&& ((SCM_CAST_UINT(a) & SCM_IMM_TAG_MASK_##type) == SCM_IMM_TAG_##type))
+/* Constant Predicates */
#define SCM_IMM_TAG_NULLP(a) (SCM_EQ((a), SCM_IMM_TAG_NULL))
#define SCM_IMM_TAG_INVALIDP(a) (SCM_EQ((a), SCM_IMM_TAG_INVALID))
#define SCM_IMM_TAG_UNBOUNDP(a) (SCM_EQ((a), SCM_IMM_TAG_UNBOUND))
@@ -491,6 +494,41 @@
#define SCM_IMM_TAG_EOFP(a) (SCM_EQ((a), SCM_IMM_TAG_EOF))
#define SCM_IMM_TAG_UNDEFP(a) (SCM_EQ((a), SCM_IMM_TAG_UNDEF))
+/*=======================================
+ Accessor API
+=======================================*/
+/* for Cons */
+#define SCM_CONS_CAR_VAL(a) ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CAR(a))))
+#define SCM_CONS_CDR_VAL(a) ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CDR(a))))
+#define SCM_CONS_SET_CAR_VAL(a, val) \
+ SCM_CELL_SET_CAR((a), SCM_STRIP_GCBIT(val) | SCM_GCBIT(SCM_CELL_CAR(a)))
+#define SCM_CONS_SET_CDR_VAL(a, val) \
+ SCM_CELL_SET_CDR((a), SCM_STRIP_GCBIT(val) | SCM_GCBIT(SCM_CELL_CDR(a)))
+
+/* for Closure */
+#define SCM_CLOSURE_CAR_VAL(a) ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CAR(a))))
+#define SCM_CLOSURE_CDR_VAL(a) ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CDR(a))))
+#define SCM_CLOSURE_SET_CAR_VAL(a, val) \
+ SCM_CELL_SET_CAR((a), SCM_STRIP_GCBIT(val) | SCM_GCBIT(SCM_CELL_CAR(a)))
+#define SCM_CLOSURE_SET_CDR_VAL(a, val) \
+ SCM_CELL_SET_CDR((a), SCM_STRIP_GCBIT(val) | SCM_GCBIT(SCM_CELL_CDR(a)))
+
+/* for Others */
+
+/* for Immediates */
+#define SCM_IMM_TAGGING(a, type, val) \
+ (SCM_CAST_UINT(val) | SCM_IMM_TAG_##type | SCM_GCBIT(a))
+/* we need to 'signed' bit shifting for integer, so cast to 'int', not
+ * 'unsigned int' */
+#define SCM_IMM_VAL(a, type) \
+ ((int)((SCM_CAST_UINT(a) & SCM_IMM_VAL_MASK_##type)) \
+ >> SCM_IMM_VAL_OFFSET_##type)
+#define SCM_IMM_SET_VAL(a, type, val) \
+ ((a) = (ScmObj)(SCM_IMM_TAGGING((a), \
+ type, \
+ (((int)(val)) \
+ << SCM_IMM_VAL_OFFSET_##type))))
+
/*==============================================================================
SAL Macros
==============================================================================*/
@@ -523,20 +561,20 @@
#define SCM_SAL_CONSP(a) SCM_TAG_CONSP(a)
#define SCM_SAL_CLOSUREP(a) SCM_TAG_CLOSUREP(a)
/* Others */
-#define SCM_SAL_SYMBOLP(a) SCM_TAG_OTHERSP((a), SYMBOL)
-#define SCM_SAL_STRINGP(a) SCM_TAG_OTHERSP((a), STRING)
-#define SCM_SAL_VECTORP(a) SCM_TAG_OTHERSP((a), VECTOR)
-#define SCM_SAL_VALUEPACKETP(a) SCM_TAG_OTHERSP((a), VALUES)
-#define SCM_SAL_FUNCP(a) SCM_TAG_OTHERSP((a), FUNC)
-#define SCM_SAL_PORTP(a) SCM_TAG_OTHERSP((a), PORT)
-#define SCM_SAL_CONTINUATIONP(a) SCM_TAG_OTHERSP((a), CONTINUATION)
-#define SCM_SAL_C_POINTERP(a) SCM_TAG_OTHERSP((a), C_POINTER)
-#define SCM_SAL_C_FUNCPOINTERP(a) SCM_TAG_OTHERSP((a), C_FUNCPOINTER)
-#define SCM_SAL_FREECELLP(a) SCM_TAG_OTHERSP((a), FREECELL)
+#define SCM_SAL_SYMBOLP(a) SCM_TAG_OTHERS_TYPEP((a), SYMBOL)
+#define SCM_SAL_STRINGP(a) SCM_TAG_OTHERS_TYPEP((a), STRING)
+#define SCM_SAL_VECTORP(a) SCM_TAG_OTHERS_TYPEP((a), VECTOR)
+#define SCM_SAL_VALUEPACKETP(a) SCM_TAG_OTHERS_TYPEP((a), VALUES)
+#define SCM_SAL_FUNCP(a) SCM_TAG_OTHERS_TYPEP((a), FUNC)
+#define SCM_SAL_PORTP(a) SCM_TAG_OTHERS_TYPEP((a), PORT)
+#define SCM_SAL_CONTINUATIONP(a) SCM_TAG_OTHERS_TYPEP((a), CONTINUATION)
+#define SCM_SAL_C_POINTERP(a) SCM_TAG_OTHERS_TYPEP((a), C_POINTER)
+#define SCM_SAL_C_FUNCPOINTERP(a) SCM_TAG_OTHERS_TYPEP((a), C_FUNCPOINTER)
+#define SCM_SAL_FREECELLP(a) SCM_TAG_OTHERS_TYPEP((a), FREECELL)
/* Immediates */
-#define SCM_SAL_INTP(a) SCM_TAG_IMMP((a), INT)
-#define SCM_SAL_CHARP(a) SCM_TAG_IMMP((a), CHAR)
-#define SCM_SAL_CONSTANTP(a) SCM_TAG_IMMP((a), CONSTANT)
+#define SCM_SAL_INTP(a) SCM_TAG_IMM_TYPEP((a), INT)
+#define SCM_SAL_CHARP(a) SCM_TAG_IMM_TYPEP((a), CHAR)
+#define SCM_SAL_CONSTANTP(a) SCM_TAG_IMM_TYPEP((a), CONSTANT)
/*=======================================
Entyping Macros
@@ -544,7 +582,7 @@
#define SCM_ENTYPE_TAG(a, tag) \
((a) = (ScmObj)(SCM_CAST_UINT(SCM_STRIP_TAG(a)) | (tag)))
#define SCM_ENTYPE_OTHERS_CDR_TAG(a, tag) \
- SCM_SET_CELL_CDR((a), (tag))
+ SCM_CELL_SET_CDR((a), (tag))
/* for each tag type */
#define SCM_ENTYPE_TAG_CONS(a) \
@@ -572,8 +610,8 @@
((a) = (ScmObj)(SCM_IMM_TAG_##type))
/* for each scheme object type */
-#define SCM_SAL_ENTYPE_CONS(a) SCM_ENTYPE_TAG_CONS
-#define SCM_SAL_ENTYPE_CLOSURE(a) SCM_ENTYPE_TAG_CLOSURE
+#define SCM_SAL_ENTYPE_CONS(a) SCM_ENTYPE_TAG_CONS(a)
+#define SCM_SAL_ENTYPE_CLOSURE(a) SCM_ENTYPE_TAG_CLOSURE(a)
#define SCM_SAL_ENTYPE_SYMBOL(a) SCM_ENTYPE_TAG_OTHERS((a), SYMBOL)
#define SCM_SAL_ENTYPE_STRING(a) SCM_ENTYPE_TAG_OTHERS((a), STRING)
#define SCM_SAL_ENTYPE_VECTOR(a) SCM_ENTYPE_TAG_OTHERS((a), VECTOR)
@@ -588,35 +626,31 @@
#define SCM_SAL_ENTYPE_CHAR(a) SCM_ENTYPE_TAG_IMM((a), CHAR)
/*=======================================
- Accessors For Scheme Objects
+ Accessors For Scheme Objects
=======================================*/
/* ScmObj Global Attribute */
#define SCM_SAL_TYPE(a) Scm_Type(a)
extern enum ScmObjType Scm_Type(ScmObj obj);
-/* Real Accessors : Cons */
-/*
-#define SCM_CAR(a) \
- ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CAR(a))))
-#define SCM_CDR(a) \
- ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CDR(a))))
-#define SCM_CONS_SET_CAR(a, car) \
- SCM_SET_CELL_CAR((a), (SCM_STRIP_GCBIT(car) | SCM_GCBIT(SCM_CELL_CAR(a))))
-#define SCM_CONS_SET_CDR(a, cdr) \
- SCM_SET_CELL_CDR((a), (SCM_STRIP_GCBIT(cdr) | SCM_GCBIT(SCM_CELL_CDR(a))))
-*/
+/*==============================================================================
+ Accessors For Scheme Objects : Cons
+==============================================================================*/
+#define SCM_SAL_CONS_CAR(a) ((ScmObj)(SCM_CONS_CAR_VAL(a)))
+#define SCM_SAL_CONS_CDR(a) ((ScmObj)(SCM_CONS_CDR_VAL(a)))
+#define SCM_SAL_CONS_SET_CAR(a, val) SCM_CONS_SET_CAR_VAL((a), (val))
+#define SCM_SAL_CONS_SET_CDR(a, val) SCM_CONS_SET_CDR_VAL((a), (val))
-/* Real Accessors : Closure */
-/*
-#define SCM_CLOSURE_EXP(a) ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CAR(a))))
-#define SCM_CLOSURE_ENV(a) ((ScmObj)(SCM_STRIP_GCBIT(SCM_CELL_CDR(a))))
+/*==============================================================================
+ Accessors For Scheme Objects : Closure
+==============================================================================*/
+#define SCM_SAL_CLOSURE_EXP(a) ((ScmObj)(SCM_CLOSURE_CAR_VAL(a)))
+#define SCM_SAL_CLOSURE_ENV(a) ((ScmObj)(SCM_CLOSURE_CDR_VAL(a)))
+#define SCM_SAL_CLOSURE_SET_EXP(a, val) SCM_CLOSURE_SET_CAR_VAL((a), (val))
+#define SCM_SAL_CLOSURE_SET_ENV(a, val) SCM_CLOSURE_SET_CDR_VAL((a), (val))
-#define SCM_CLOSURE_SET_EXP(a, exp) \
- SCM_SET_CELL_CAR((a), (SCM_STRIP_GCBIT(exp) | SCM_GCBIT(SCM_CELL_CAR(a))))
-#define SCM_CLOSURE_SET_ENV(a, env) \
- SCM_SET_CELL_CDR((a), (SCM_STRIP_GCBIT(env) | SCM_GCBIT(SCM_CELL_CDR(a))))
-*/
-
+/*==============================================================================
+ Accessors For Scheme Objects : Others
+==============================================================================*/
/* Real Accessors : Symbol */
/*
#define SCM_SYMBOL_VCELL(a) \
@@ -625,10 +659,10 @@
((char*) (SCM_STRIP_OTHERS_CDR_PRIMARY_TAG(a)))
#define SCM_SYMBOL_SET_VCELL(a, vcell) \
- (SCM_SET_CELL_CAR((a), \
+ (SCM_CELL_SET_CAR((a), \
(SCM_STRIP_GCBIT(vcell) | SCM_GCBIT(SCM_CELL_CAR(a)))))
#define SCM_SYMBOL_SET_NAME(a, name) \
- (SCM_SET_CELL_CDR((a), \
+ (SCM_CELL_SET_CDR((a), \
(SCM_CAST_UINT(name) | SCM_OTHERS_CDR_PRIMARY_TAG_SYMBOL)))
*/
@@ -646,9 +680,9 @@
((enum ScmStrMutationType)((SCM_CAST_UINT(SCM_CELL_CAR(a)) & SCM_STRING_MUTATION_TYPE_MASK) \
>> SCM_STRING_MUTATION_TYPE_OFFSET))
#define SCM_STRING_SET_MUTABLE(a) \
- SCM_SET_CELL_CAR((a), (SCM_CAST_UINT(SCM_CELL_CAR(a)) | (SCM_STR_MUTABLE << SCM_STRING_MUTATION_TYPE_OFFSET)))
+ SCM_CELL_SET_CAR((a), (SCM_CAST_UINT(SCM_CELL_CAR(a)) | (SCM_STR_MUTABLE << SCM_STRING_MUTATION_TYPE_OFFSET)))
#define SCM_STRING_SET_IMMUTABLE(a) \
- SCM_SET_CELL_CAR((a), (SCM_CAST_UINT(SCM_CELL_CAR(a)) & ~SCM_STRING_MUTATION_TYPE_MASK))
+ SCM_CELL_SET_CAR((a), (SCM_CAST_UINT(SCM_CELL_CAR(a)) & ~SCM_STRING_MUTATION_TYPE_MASK))
#define SCM_STRING_STR(a) \
((char*)(SCM_CAST_UINT(SCM_CELL_CAR(a)) & SCM_STRING_STR_VALUE_MASK))
@@ -656,10 +690,10 @@
(SCM_CAST_UINT(SCM_CELL_CDR(a)) >> SCM_OTHERS_CDR_TAG_VALUE_OFFSET_STRING)
#define SCM_STRING_SET_STR(a, str) \
- SCM_SET_CELL_CAR((a), (SCM_CAST_UINT(str) \
+ SCM_CELL_SET_CAR((a), (SCM_CAST_UINT(str) \
| (SCM_CAST_UINT(SCM_CELL_CAR(a)) & ~SCM_STRING_STR_VALUE_MASK)))
#define SCM_STRING_SET_LEN(a, len) \
- SCM_SET_CELL_CDR((a), ((SCM_CAST_UINT(SCM_CELL_CDR(a)) & ~SCM_OTHERS_CDR_TAG_VALUE_MASK_STRING)\
+ SCM_CELL_SET_CDR((a), ((SCM_CAST_UINT(SCM_CELL_CDR(a)) & ~SCM_OTHERS_CDR_TAG_VALUE_MASK_STRING)\
| (len << SCM_OTHERS_CDR_TAG_VALUE_OFFSET_STRING)))
*/
/* Real Accessors : Vector */
@@ -699,13 +733,13 @@
/* Real Accessors : Pointer */
/*============================================================================
- Real Accessors : Pointer Handling Types (CFunc, CPointer, CFuncPointer)
+ Real Accessors : Pointer Handling Types (CFunc, CPointer, CFuncPointer)
- GCC4.0 doesn't align the address of function, so we need to store LSB of
- the function address to the cdr part.
+ GCC4.0 doesn't align the address of function, so we need to store LSB of
+ the function address to the cdr part.
- Addr = ((S->car & ~0x01)
- | ((S->cdr >> lsboffset) & 0x1))
+ Addr = ((S->car & ~0x01)
+ | ((S->cdr >> lsboffset) & 0x1))
============================================================================*/
/* General Pointer Accessor */
/*
@@ -715,7 +749,7 @@
#define SCM_PTR_VALUE(a, lsboffset) ((void*)(SCM_PTR_OTHERSBITS(a) | SCM_PTR_LSB((a), (lsboffset))))
#define SCM_SET_PTR_OTHERSBITS(a, val) (SCM_CAR_SET_VALUE_AS_PTR((a), SCM_WORD_CAST(ScmObj, (val))))
-#define SCM_SET_PTR_LSB(a, val, offset) (SCM_SET_CELL_CDR((a), \
+#define SCM_SET_PTR_LSB(a, val, offset) (SCM_CELL_SET_CDR((a), \
(SCM_CDR_CAST_UINT(a) \
| ((SCM_CAST_UINT(val) & 0x1) << (offset)))))
#define SCM_SET_PTR_VALUE(a, val, lsboffset) (SCM_SET_PTR_OTHERSBITS((a), (val)), \
@@ -751,45 +785,16 @@
#define SCM_FREECELL_SET_NEXT(a, obj) (SCM_CAR_SET_VALUE_AS_OBJ((a), (obj)))
*/
-/*============================================================================
- Real Accessors : Int
+/*==============================================================================
+ Accessors For Scheme Objects : Immediates
+==============================================================================*/
- Integer need to preserve 'singed' or 'unsigned', so need special accessor.
- Current pack and unpack algorithm is like this.
+#define SCM_SAL_INT_VALUE(a) ((int)(SCM_IMM_VAL((a), INT)))
+#define SCM_SAL_INT_SET_VALUE(a, val) SCM_IMM_SET_VAL((a), INT, (val))
+#define SCM_SAL_CHAR_VALUE(a) ((int)(SCM_IMM_VAL((a), CHAR)))
+#define SCM_SAL_CHAR_SET_VALUE(a, ch) SCM_IMM_SET_VAL((a), CHAR, (ch))
- int pack(int a) {
- return (a < 0) ? (~a << OFFSET) | SIGNED_MARK
- : (a << OFFSET);
- }
- int unpack(int a) {
- return (a & SIGN_BIT_MASK) ? ~((a & SIGN_VALUE_MASK) >> OFFSET) | SIGNED_MARK
- : (a >> OFFSET);
- }
-============================================================================*/
-/*
-#define BITS_PER_BITE 8
-#define SIZEOF_INT sizeof(int)
-#define SIGN_BIT_MASK (0x1 << (SIZEOF_INT * BITS_PER_BITE - 1))
-#define SIGN_VALUE_MASK ~SIGN_BIT_MASK
-#define SIGNED_MARK (0x1 << (SIZEOF_INT * BITS_PER_BITE - 1))
-
-#define SCM_INT_VALUE(a) ((SCM_CAST_UINT(a) & SIGN_BIT_MASK) \
- ? (int)~((SCM_CAST_UINT(a) & SIGN_VALUE_MASK) >> SCM_IMM_TAG_VALUE_OFFSET_INT) | SIGNED_MARK \
- : (int)(SCM_CAST_UINT(a) >> SCM_IMM_TAG_VALUE_OFFSET_INT))
-
-#define SCM_INT_SET_VALUE(a, val) ((a) = (ScmObj)(SCM_CAST_UINT(((val) >= 0) \
- ? (val) << SCM_IMM_TAG_VALUE_OFFSET_INT | SCM_IMM_TAG_INT \
- : (~(val) << SCM_IMM_TAG_VALUE_OFFSET_INT) | SIGNED_MARK | SCM_IMM_TAG_INT) \
- | SCM_GCBIT(a)))
-*/
-
-/* Real Accessors : Char */
-/*
-#define SCM_CHAR_VALUE(a) (SCM_PRIMARY_GET_VALUE_AS_INT((a), SCM_IMM_TAG_VALUE_OFFSET_CHAR))
-#define SCM_CHAR_SET_VALUE(a, ch) (SCM_PRIMARY_SET_VALUE_AS_INT((a), (ch), SCM_IMM_TAG_VALUE_OFFSET_CHAR, SCM_IMM_TAG_CHAR))
-*/
-
/*============================================================================
GC Related Operations
============================================================================*/
@@ -804,16 +809,27 @@
#define SCM_TAG_SWEEP_PHASE_OTHERSP(a, type) \
((SCM_CAST_UINT(SCM_CELL_CDR(a)) & SCM_OTHERS_CDR_TAG_MASK_##type) \
== SCM_OTHERS_CDR_TAG_##type)
-#define SCM_SWEEP_PHASE_SYMBOLP(a) (SCM_TAG_SWEEP_PHASE_OTHERSP((a), SYMBOL))
-#define SCM_SWEEP_PHASE_STRINGP(a) (SCM_TAG_SWEEP_PHASE_OTHERSP((a), STRING))
-#define SCM_SWEEP_PHASE_VECTORP(a) (SCM_TAG_SWEEP_PHASE_OTHERSP((a), VECTOR))
-#define SCM_SWEEP_PHASE_PORTP(a) (SCM_TAG_SWEEP_PHASE_OTHERSP((a), PORT))
-#define SCM_SWEEP_PHASE_CONTINUATIONP(a) (SCM_TAG_SWEEP_PHASE_OTHERSP((a), CONTINUATION))
+#define SCM_SWEEP_PHASE_SYMBOLP(a) \
+ (SCM_TAG_SWEEP_PHASE_OTHERSP((a), SYMBOL))
+#define SCM_SWEEP_PHASE_STRINGP(a) \
+ (SCM_TAG_SWEEP_PHASE_OTHERSP((a), STRING))
+#define SCM_SWEEP_PHASE_VECTORP(a) \
+ (SCM_TAG_SWEEP_PHASE_OTHERSP((a), VECTOR))
+#define SCM_SWEEP_PHASE_PORTP(a) \
+ (SCM_TAG_SWEEP_PHASE_OTHERSP((a), PORT))
+#define SCM_SWEEP_PHASE_CONTINUATIONP(a) \
+ (SCM_TAG_SWEEP_PHASE_OTHERSP((a), CONTINUATION))
-#define SCM_SAL_IS_MARKED(a) (SCM_GCBIT(SCM_CELL_CAR(a)) == 0x0)
-#define SCM_SAL_IS_UNMARKED(a) (!SCM_IS_MARKED(a))
-#define SCM_SAL_DO_MARK(a) (SCM_GCBIT_ON(SCM_CELL_CAR(a)))
-#define SCM_SAL_DO_UNMARK(a) (SCM_GCBIT_OFF(SCM_CELL_CAR(a)))
+#define SCM_SAL_IS_MARKED(a) \
+ (SCM_GCBIT(SCM_CELL_CAR(a)) == SCM_GCBIT_MARKED)
+#define SCM_SAL_IS_UNMARKED(a) \
+ (!SCM_IS_MARKED(a))
+#define SCM_SAL_DO_MARK(a) \
+ (SCM_CELL_SET_CAR((a), \
+ SCM_STRIP_GCBIT(SCM_CELL_CAR(a)) | SCM_GCBIT_MARKED))
+#define SCM_SAL_DO_UNMARK(a) \
+ (SCM_CELL_SET_CAR((a), \
+ SCM_STRIP_GCBIT(SCM_CELL_CAR(a)) | SCM_GCBIT_UNMARKED))
/*============================================================================
Environment Specifiers
More information about the uim-commit
mailing list