1 /*=========================================================================== 2 * Filename : storage-fatty.h 3 * About : Storage abstraction (fatty representation) 4 * 5 * Copyright (C) 2005 Kazuki Ohta <mover AT hct.zaq.ne.jp> 6 * Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp> 7 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com> 8 * 9 * All rights reserved. 10 * 11 * Redistribution and use in source and binary forms, with or without 12 * modification, are permitted provided that the following conditions 13 * are met: 14 * 15 * 1. Redistributions of source code must retain the above copyright 16 * notice, this list of conditions and the following disclaimer. 17 * 2. Redistributions in binary form must reproduce the above copyright 18 * notice, this list of conditions and the following disclaimer in the 19 * documentation and/or other materials provided with the distribution. 20 * 3. Neither the name of authors nor the names of its contributors 21 * may be used to endorse or promote products derived from this software 22 * without specific prior written permission. 23 * 24 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS 25 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 26 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 27 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR 28 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 29 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 30 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 31 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 32 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 33 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 34 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 35 ===========================================================================*/ 36 #ifndef __STORAGE_FATTY_H 37 #define __STORAGE_FATTY_H 38 39 /* 40 * Internal representation defined in this file MUST NOT directly touched by 41 * libsscm users. Use abstract public APIs defined in sigscheme.h. 42 */ 43 44 /* 45 * storage-fatty.h: A storage implementation with fatty represenation 46 * 47 * This is the most simple storage implementation for SigScheme. The features 48 * are below. 49 * 50 * - Supports all data models of ILP32, ILP32 with 64-bit long long, LLP64, 51 * LP64 and ILP64 52 * - Consumes larger memory space (twice of storage-compact) 53 * - Can hold full-width integer 54 * - Easy to read and recognize 55 * - Easy to debug upper layer of SigScheme and its clients 56 * - Easy to extend and test experimental features 57 */ 58 59 #include <stddef.h> 60 61 /* Don't include scmport.h. The implementations are internal and should not be 62 * exposed to libsscm users via installation of this file. */ 63 64 #ifdef __cplusplus 65 /* extern "C" { */ 66 #endif 67 68 /*======================================= 69 Type Definitions 70 =======================================*/ 71 /* Since this storage implementation does not have any immediate values, 72 * (sizeof(ScmObj) == sizeof(ScmCell *)) is ensured even if sizeof(scm_int_t) 73 * is larger than sizeof(ScmObj). */ 74 typedef struct ScmCell_ ScmCell; 75 typedef ScmCell *ScmObj; 76 typedef ScmObj *ScmRef; 77 78 #define ALIGNOF_SCMOBJ ALIGNOF_VOID_P 79 #define SIZEOF_SCMOBJ SIZEOF_VOID_P 80 81 typedef ScmObj (*ScmFuncType)(); 82 83 struct ScmCell_ { 84 union { 85 struct { 86 enum ScmObjType type; 87 char gcmark, immutable, pad2, pad3; 88 } v; 89 90 /* to align against 64-bit primitives */ 91 struct { 92 scm_uintobj_t slot0; 93 scm_uintobj_t slot1; 94 } strut; 95 } attr; 96 97 /* 98 * Pointer members should be placed first for efficient alignment when 99 * strict alignment is not forced by the compiler/processor. 100 */ 101 union { 102 struct { 103 scm_int_t value; 104 } integer; 105 106 struct { 107 ScmObj car; 108 ScmObj cdr; 109 } cons; 110 111 struct { 112 char *name; 113 ScmObj value; 114 } symbol; 115 116 struct { 117 scm_ichar_t value; 118 } character; 119 120 struct { 121 char *str; 122 scm_int_t len; /* number of (multibyte) chars */ 123 } string; 124 125 struct { 126 ScmFuncType ptr; 127 enum ScmFuncTypeCode type; 128 } function; 129 130 struct { 131 ScmObj exp; 132 ScmObj env; 133 } closure; 134 135 struct { 136 ScmObj *vec; 137 scm_int_t len; 138 } vector; 139 140 struct { 141 struct ScmCharPort_ *impl; 142 enum ScmPortFlag flag; 143 } port; 144 145 struct { 146 void *opaque; 147 scm_int_t tag; 148 } continuation; 149 150 #if !SCM_USE_VALUECONS 151 struct { 152 ScmObj lst; 153 } value_packet; 154 #endif 155 156 struct { 157 void *value; 158 } c_pointer; 159 160 struct { 161 ScmCFunc value; 162 } c_func_pointer; 163 164 #if SCM_USE_HYGIENIC_MACRO 165 struct { 166 ScmObj rules; 167 ScmPackedEnv env; 168 } hmacro; 169 170 struct { 171 ScmObj sym; 172 ScmPackedEnv env; 173 } farsym; 174 175 struct { 176 ScmObj obj; 177 scm_int_t meta; 178 } subpat; 179 #endif /* SCM_USE_HYGIENIC_MACRO */ 180 181 /* to align against 64-bit primitives */ 182 struct { 183 scm_uintobj_t slot2; 184 scm_uintobj_t slot3; 185 } strut; 186 } obj; 187 }; 188 189 /*======================================= 190 Object Representation Information 191 =======================================*/ 192 #define SCM_SAL_HAS_CHAR 1 193 #define SCM_SAL_HAS_RATIONAL 0 194 #define SCM_SAL_HAS_REAL 0 195 #define SCM_SAL_HAS_COMPLEX 0 196 #define SCM_SAL_HAS_STRING 1 197 #define SCM_SAL_HAS_VECTOR 1 198 199 #define SCM_SAL_HAS_IMMUTABLE_CONS 1 200 #define SCM_SAL_HAS_IMMUTABLE_STRING 1 201 #define SCM_SAL_HAS_IMMUTABLE_VECTOR 1 202 203 /* for optimization */ 204 #define SCM_SAL_HAS_IMMEDIATE_CHAR_ONLY 0 205 #define SCM_SAL_HAS_IMMEDIATE_NUMBER_ONLY 0 206 #define SCM_SAL_HAS_IMMEDIATE_INT_ONLY 0 207 #define SCM_SAL_HAS_IMMEDIATE_RATIONAL_ONLY 0 208 #define SCM_SAL_HAS_IMMEDIATE_REAL_ONLY 0 209 #define SCM_SAL_HAS_IMMEDIATE_COMPLEX_ONLY 0 210 211 #define SCM_SAL_PTR_BITS (sizeof(void *) * CHAR_BIT) 212 213 #define SCM_SAL_CHAR_BITS (sizeof(scm_ichar_t) * CHAR_BIT) 214 #define SCM_SAL_CHAR_MAX SCM_ICHAR_T_MAX 215 216 #define SCM_SAL_INT_BITS (sizeof(scm_int_t) * CHAR_BIT) 217 #define SCM_SAL_INT_MAX SCM_INT_T_MAX 218 #define SCM_SAL_INT_MIN SCM_INT_T_MIN 219 220 /* string length */ 221 #define SCM_SAL_STRLEN_BITS SCM_INT_BITS 222 #define SCM_SAL_STRLEN_MAX SCM_INT_MAX 223 224 /* vector length */ 225 #define SCM_SAL_VECLEN_BITS SCM_INT_BITS 226 #define SCM_SAL_VECLEN_MAX SCM_INT_MAX 227 228 /*======================================= 229 Object Creators 230 =======================================*/ 231 #if SCM_USE_VALUECONS 232 #define SCM_SAL_MAKE_VALUEPACKET(vals) \ 233 (NULLP(vals) ? scm_null_values \ 234 : (SCM_ENTYPE(vals, ScmValuePacket), (vals))) 235 #endif /* SCM_USE_VALUECONS */ 236 237 /*======================================= 238 Accessors For Scheme Objects 239 =======================================*/ 240 /* ScmObj Global Attribute */ 241 #define SCM_SAL_TYPE(o) ((o)->attr.v.type) 242 #define SCM_ENTYPE(o, objtype) ((o)->attr.v.type = (objtype)) 243 #define SCM_MUTABLEP(o) (!(o)->attr.v.immutable) 244 #define SCM_SET_MUTABLE(o) ((o)->attr.v.immutable = scm_false) 245 #define SCM_SET_IMMUTABLE(o) ((o)->attr.v.immutable = scm_true) 246 247 /* Real Accessors */ 248 #define SCM_SAL_NUMBERP(o) SCM_SAL_INTP(o) 249 250 #define SCM_SAL_INTP(o) (SCM_TYPE(o) == ScmInt) 251 #define SCM_SAL_INT_VALUE(o) (SCM_AS_INT(o)->obj.integer.value) 252 #define SCM_SAL_INT_SET_VALUE(o, val) (SCM_INT_VALUE(o) = (val)) 253 #define SCM_ISAL_INT_INIT(o, val) (SCM_ENTYPE((o), ScmInt), \ 254 SCM_INT_SET_VALUE((o), (val))) 255 256 #define SCM_SAL_CONSP(o) (SCM_TYPE(o) == ScmCons) 257 /* don't use as lvalue */ 258 #define SCM_SAL_CONS_CAR(o) (SCM_AS_CONS(o)->obj.cons.car + 0) 259 #define SCM_SAL_CONS_CDR(o) (SCM_AS_CONS(o)->obj.cons.cdr + 0) 260 #define SCM_SAL_CONS_SET_CAR(o, kar) (SCM_AS_CONS(o)->obj.cons.car = (kar)) 261 #define SCM_SAL_CONS_SET_CDR(o, kdr) (SCM_AS_CONS(o)->obj.cons.cdr = (kdr)) 262 #define SCM_SAL_CONS_MUTABLEP(o) (SCM_MUTABLEP(o)) 263 #define SCM_SAL_CONS_SET_MUTABLE(o) (SCM_SET_MUTABLE(o)) 264 #define SCM_SAL_CONS_SET_IMMUTABLE(o) (SCM_SET_IMMUTABLE(o)) 265 #define SCM_ISAL_CONS_INIT(o, kar, kdr) \ 266 (SCM_ENTYPE((o), ScmCons), \ 267 SCM_CONS_SET_CAR((o), (kar)), \ 268 SCM_CONS_SET_CDR((o), (kdr)), \ 269 SCM_CONS_SET_MUTABLE(o)) 270 #define SCM_ISAL_IMMUTABLE_CONS_INIT(o, kar, kdr) \ 271 (SCM_ENTYPE((o), ScmCons), \ 272 SCM_CONS_SET_CAR((o), (kar)), \ 273 SCM_CONS_SET_CDR((o), (kdr)), \ 274 SCM_CONS_SET_IMMUTABLE(o)) 275 276 #define SCM_SAL_SYMBOLP(o) (SCM_TYPE(o) == ScmSymbol) 277 #define SCM_SAL_SYMBOL_NAME(o) (SCM_AS_SYMBOL(o)->obj.symbol.name) 278 #define SCM_SAL_SYMBOL_SET_NAME(o, name) (SCM_SYMBOL_NAME(o) = (name)) 279 #define SCM_SAL_SYMBOL_VCELL(o) (SCM_AS_SYMBOL(o)->obj.symbol.value) 280 #define SCM_SAL_SYMBOL_SET_VCELL(o, val) (SCM_SYMBOL_VCELL(o) = (val)) 281 #define SCM_ISAL_SYMBOL_INIT(o, n, v) (SCM_ENTYPE((o), ScmSymbol), \ 282 SCM_SYMBOL_SET_NAME((o), (n)), \ 283 SCM_SYMBOL_SET_VCELL((o), (v))) 284 285 #define SCM_SAL_CHARP(o) (SCM_TYPE(o) == ScmChar) 286 #define SCM_SAL_CHAR_VALUE(o) (SCM_AS_CHAR(o)->obj.character.value) 287 #define SCM_SAL_CHAR_SET_VALUE(o, val) (SCM_CHAR_VALUE(o) = (val)) 288 #define SCM_ISAL_CHAR_INIT(o, val) (SCM_ENTYPE((o), ScmChar), \ 289 SCM_CHAR_SET_VALUE((o), (val))) 290 291 #define SCM_SAL_STRINGP(o) (SCM_TYPE(o) == ScmString) 292 #define SCM_SAL_STRING_STR(o) (SCM_AS_STRING(o)->obj.string.str) 293 #define SCM_SAL_STRING_SET_STR(o, val) (SCM_STRING_STR(o) = (val)) 294 #define SCM_SAL_STRING_LEN(o) (SCM_AS_STRING(o)->obj.string.len) 295 #define SCM_SAL_STRING_SET_LEN(o, len) (SCM_STRING_LEN(o) = (len)) 296 #define SCM_SAL_STRING_MUTABLEP(o) (SCM_MUTABLEP(o)) 297 #define SCM_SAL_STRING_SET_MUTABLE(o) (SCM_SET_MUTABLE(o)) 298 #define SCM_SAL_STRING_SET_IMMUTABLE(o) (SCM_SET_IMMUTABLE(o)) 299 #define SCM_ISAL_STRING_INIT(o, s, l, mutp) \ 300 (SCM_ENTYPE((o), ScmString), \ 301 SCM_STRING_SET_STR((o), (s)), \ 302 SCM_STRING_SET_LEN((o), (l)), \ 303 mutp ? SCM_STRING_SET_MUTABLE(o) \ 304 : SCM_STRING_SET_IMMUTABLE(o)) 305 #define SCM_ISAL_MUTABLE_STRING_INIT(o, s, l) \ 306 SCM_ISAL_STRING_INIT((o), (s), (l), scm_true) 307 #define SCM_ISAL_IMMUTABLE_STRING_INIT(o, s, l) \ 308 SCM_ISAL_STRING_INIT((o), (s), (l), scm_false) 309 310 #define SCM_SAL_FUNCP(o) (SCM_TYPE(o) == ScmFunc) 311 #define SCM_SAL_FUNC_TYPECODE(o) (SCM_AS_FUNC(o)->obj.function.type) 312 #define SCM_SAL_FUNC_SET_TYPECODE(o, type) (SCM_FUNC_TYPECODE(o) = (type)) 313 #define SCM_SAL_FUNC_CFUNC(o) (SCM_AS_FUNC(o)->obj.function.ptr) 314 #define SCM_SAL_FUNC_SET_CFUNC(o, func) \ 315 (SCM_FUNC_CFUNC(o) = (ScmFuncType)(func)) 316 #define SCM_ISAL_FUNC_INIT(o, t, f) (SCM_ENTYPE((o), ScmFunc), \ 317 SCM_FUNC_SET_TYPECODE((o), (t)), \ 318 SCM_FUNC_SET_CFUNC((o), (f))) \ 319 320 #define SCM_SAL_CLOSUREP(o) (SCM_TYPE(o) == ScmClosure) 321 #define SCM_SAL_CLOSURE_EXP(o) (SCM_AS_CLOSURE(o)->obj.closure.exp) 322 #define SCM_SAL_CLOSURE_SET_EXP(o, exp) (SCM_CLOSURE_EXP(o) = (exp)) 323 #define SCM_SAL_CLOSURE_ENV(o) (SCM_AS_CLOSURE(o)->obj.closure.env) 324 #define SCM_SAL_CLOSURE_SET_ENV(o, env) (SCM_CLOSURE_ENV(o) = (env)) 325 #define SCM_ISAL_CLOSURE_INIT(o, x, e) (SCM_ENTYPE((o), ScmClosure), \ 326 SCM_CLOSURE_SET_EXP((o), (x)), \ 327 SCM_CLOSURE_SET_ENV((o), (e))) 328 329 #define SCM_SAL_VECTORP(o) (SCM_TYPE(o) == ScmVector) 330 #define SCM_SAL_VECTOR_VEC(o) (SCM_AS_VECTOR(o)->obj.vector.vec) 331 #define SCM_SAL_VECTOR_SET_VEC(o, vec) (SCM_VECTOR_VEC(o) = (vec)) 332 #define SCM_SAL_VECTOR_LEN(o) (SCM_AS_VECTOR(o)->obj.vector.len) 333 #define SCM_SAL_VECTOR_SET_LEN(o, len) (SCM_VECTOR_LEN(o) = (len)) 334 #define SCM_SAL_VECTOR_MUTABLEP(o) (SCM_MUTABLEP(o)) 335 #define SCM_SAL_VECTOR_SET_MUTABLE(o) (SCM_SET_MUTABLE(o)) 336 #define SCM_SAL_VECTOR_SET_IMMUTABLE(o) (SCM_SET_IMMUTABLE(o)) 337 #define SCM_ISAL_VECTOR_INIT(o, v, l, mutp) \ 338 (SCM_ENTYPE((o), ScmVector), \ 339 SCM_VECTOR_SET_VEC((o), (v)), \ 340 SCM_VECTOR_SET_LEN((o), (l)), \ 341 mutp ? SCM_VECTOR_SET_MUTABLE(o) \ 342 : SCM_VECTOR_SET_IMMUTABLE(o)) 343 #define SCM_ISAL_MUTABLE_VECTOR_INIT(o, v, l) \ 344 SCM_ISAL_VECTOR_INIT((o), (v), (l), scm_true) 345 #define SCM_ISAL_IMMUTABLE_VECTOR_INIT(o, v, l) \ 346 SCM_ISAL_VECTOR_INIT((o), (v), (l), scm_false) 347 348 #define SCM_SAL_PORTP(o) (SCM_TYPE(o) == ScmPort) 349 #define SCM_SAL_PORT_FLAG(o) (SCM_AS_PORT(o)->obj.port.flag) 350 #define SCM_SAL_PORT_SET_FLAG(o, flag) (SCM_PORT_FLAG(o) = (flag)) 351 #define SCM_SAL_PORT_IMPL(o) (SCM_AS_PORT(o)->obj.port.impl) 352 #define SCM_SAL_PORT_SET_IMPL(o, impl) (SCM_PORT_IMPL(o) = (impl)) 353 #define SCM_ISAL_PORT_INIT(o, i, f) (SCM_ENTYPE((o), ScmPort), \ 354 SCM_PORT_SET_IMPL((o), (i)), \ 355 SCM_PORT_SET_FLAG((o), (f))) 356 357 #define SCM_SAL_CONTINUATIONP(o) (SCM_TYPE(o) == ScmContinuation) 358 #define SCM_SAL_CONTINUATION_OPAQUE(o) \ 359 (SCM_AS_CONTINUATION(o)->obj.continuation.opaque) 360 #define SCM_SAL_CONTINUATION_SET_OPAQUE(o, val) \ 361 (SCM_CONTINUATION_OPAQUE(o) = (val)) 362 #define SCM_SAL_CONTINUATION_TAG(o) \ 363 (SCM_AS_CONTINUATION(o)->obj.continuation.tag) 364 #define SCM_SAL_CONTINUATION_SET_TAG(o, val) \ 365 (SCM_CONTINUATION_TAG(o) = (val)) 366 #define SCM_ISAL_CONTINUATION_INIT(o, v, t) \ 367 (SCM_ENTYPE((o), ScmContinuation), \ 368 SCM_SAL_CONTINUATION_SET_OPAQUE((o), (v)), \ 369 SCM_SAL_CONTINUATION_SET_TAG((o), (t))) 370 371 #if SCM_USE_VALUECONS 372 /* to modify a VALUECONS, rewrite its type to cons by SCM_ENTYPE(vcons, 373 * ScmCons) */ 374 #define SCM_SAL_VALUEPACKETP(o) (SCM_TYPE(o) == ScmValuePacket) 375 #define SCM_SAL_NULLVALUESP(o) (EQ((o), scm_null_values)) 376 #define SCM_SAL_VALUEPACKET_VALUES(o) \ 377 ((SCM_NULLVALUESP(o)) ? SCM_NULL : (SCM_ENTYPE((o), ScmCons), (o))) 378 #define SCM_SAL_VALUECONS_CAR(o) (SCM_AS_VALUEPACKET(o)->obj.cons.car) 379 #define SCM_SAL_VALUECONS_CDR(o) (SCM_AS_VALUEPACKET(o)->obj.cons.cdr) 380 #else /* SCM_USE_VALUECONS */ 381 #define SCM_SAL_VALUEPACKETP(o) (SCM_TYPE(o) == ScmValuePacket) 382 #define SCM_SAL_VALUEPACKET_VALUES(o) \ 383 (SCM_AS_VALUEPACKET(o)->obj.value_packet.lst) 384 #define SCM_SAL_VALUEPACKET_SET_VALUES(o, v) (SCM_VALUEPACKET_VALUES(o) = (v)) 385 #define SCM_ISAL_VALUEPACKET_INIT(o, v) (SCM_ENTYPE((o), ScmValuePacket), \ 386 SCM_VALUEPACKET_SET_VALUES((o), (v))) 387 #endif /* SCM_USE_VALUECONS */ 388 389 #if (SCM_USE_HYGIENIC_MACRO || SCM_USE_UNHYGIENIC_MACRO) 390 #define SCM_SAL_MACROP(o) (SCM_TYPE(o) == ScmMacro) 391 #if (SCM_USE_HYGIENIC_MACRO && SCM_USE_UNHYGIENIC_MACRO) 392 #define SCM_SAL_HMACROP(o) (SCM_SAL_MACROP(o) && /* TODO */) 393 #else /* not SCM_USE_UNHYGIENIC_MACRO */ 394 #define SCM_SAL_HMACROP(o) (SCM_SAL_MACROP(o)) 395 #endif /* not SCM_USE_UNHYGIENIC_MACRO */ 396 #define SCM_SAL_HMACRO_RULES(o) (SCM_AS_HMACRO(o)->obj.hmacro.rules) 397 #define SCM_SAL_HMACRO_SET_RULES(o, r) (SCM_SAL_HMACRO_RULES(o) = (r)) 398 #define SCM_SAL_HMACRO_ENV(o) (SCM_AS_HMACRO(o)->obj.hmacro.env) 399 #define SCM_SAL_HMACRO_SET_ENV(o, e) (SCM_SAL_HMACRO_ENV(o) = (e)) 400 #define SCM_ISAL_HMACRO_INIT(o, r, e) (SCM_ENTYPE((o), ScmMacro), \ 401 SCM_HMACRO_SET_RULES((o), (r)), \ 402 SCM_HMACRO_SET_ENV((o), (e))) 403 404 #define SCM_SAL_FARSYMBOLP(o) (SCM_TYPE(o) == ScmFarsymbol) 405 #define SCM_SAL_FARSYMBOL_SYM(o) (SCM_AS_FARSYMBOL(o)->obj.farsym.sym) 406 #define SCM_SAL_FARSYMBOL_SET_SYM(o, s) (SCM_SAL_FARSYMBOL_SYM(o) = (s)) 407 #define SCM_SAL_FARSYMBOL_ENV(o) (SCM_AS_FARSYMBOL(o)->obj.farsym.env) 408 #define SCM_SAL_FARSYMBOL_SET_ENV(o, e) (SCM_SAL_FARSYMBOL_ENV(o) = (e)) 409 #define SCM_ISAL_FARSYMBOL_INIT(o, s, e) (SCM_ENTYPE((o), ScmFarsymbol), \ 410 SCM_FARSYMBOL_SET_SYM((o), (s)), \ 411 SCM_FARSYMBOL_SET_ENV((o), (e))) 412 413 #define SCM_SAL_SUBPATP(o) (SCM_TYPE(o) == ScmSubpat) 414 #define SCM_SAL_SUBPAT_OBJ(o) (SCM_AS_SUBPAT(o)->obj.subpat.obj) 415 #define SCM_SAL_SUBPAT_META(o) (SCM_AS_SUBPAT(o)->obj.subpat.meta) 416 #define SCM_SAL_SUBPAT_SET_OBJ(o, x) (SCM_SAL_SUBPAT_OBJ(o) = (x)) 417 #define SCM_SAL_SUBPAT_SET_META(o, m) (SCM_SAL_SUBPAT_META(o) = (m)) 418 #define SCM_ISAL_SUBPAT_INIT(o, x, m) (SCM_ENTYPE((o), ScmSubpat), \ 419 SCM_SUBPAT_SET_OBJ((o), (x)), \ 420 SCM_SUBPAT_SET_META((o), (m))) 421 #endif /* SCM_USE_HYGIENIC_MACRO */ 422 423 /*=========================================================================== 424 Special Constants (such as SCM_NULL) 425 ===========================================================================*/ 426 #define SCM_SAL_CONSTANTP(o) (SCM_TYPE(o) == ScmConstant) 427 428 /*=========================================================================== 429 C Pointer Object 430 ===========================================================================*/ 431 #define SCM_SAL_C_POINTERP(o) (SCM_TYPE(o) == ScmCPointer) 432 #define SCM_SAL_C_POINTER_VALUE(o) \ 433 (SCM_AS_C_POINTER(o)->obj.c_pointer.value) 434 #define SCM_SAL_C_POINTER_SET_VALUE(o, ptr) \ 435 (SCM_C_POINTER_VALUE(o) = (ptr)) 436 #define SCM_ISAL_C_POINTER_INIT(o, ptr) \ 437 (SCM_ENTYPE((o), ScmCPointer), \ 438 SCM_C_POINTER_SET_VALUE((o), (ptr))) 439 #define SCM_SAL_C_FUNCPOINTERP(o) (SCM_TYPE(o) == ScmCFuncPointer) 440 #define SCM_SAL_C_FUNCPOINTER_VALUE(o) \ 441 (SCM_AS_C_FUNCPOINTER(o)->obj.c_func_pointer.value) 442 #define SCM_SAL_C_FUNCPOINTER_SET_VALUE(o, ptr) \ 443 (SCM_C_FUNCPOINTER_VALUE(o) = (ptr)) 444 #define SCM_ISAL_C_FUNCPOINTER_INIT(o, ptr) \ 445 (SCM_ENTYPE((o), ScmCFuncPointer), \ 446 SCM_C_FUNCPOINTER_SET_VALUE((o), (ptr))) 447 448 /*=========================================================================== 449 GC Related Operations 450 ===========================================================================*/ 451 #define SCM_SAL_FREECELLP(o) (SCM_TYPE(o) == ScmFreeCell) 452 #define SCM_SAL_AS_FREECELL(o) (SCM_ASSERT_TYPE(SCM_FREECELLP(o), (o))) 453 #define SCM_SAL_FREECELL_NEXT(o) (SCM_AS_FREECELL(o)->obj.cons.car) 454 #define SCM_SAL_FREECELL_FREESLOT(o) (SCM_AS_FREECELL(o)->obj.cons.cdr) 455 #define SCM_SAL_FREECELL_SET_NEXT(o, next) (SCM_FREECELL_NEXT(o) = (next)) 456 #define SCM_SAL_FREECELL_SET_FREESLOT(o, v) (SCM_FREECELL_FREESLOT(o) = (v)) 457 #define SCM_SAL_FREECELL_CLEAR_FREESLOT(o) \ 458 SCM_SAL_FREECELL_SET_FREESLOT((o), SCM_FALSE) 459 460 #define SCM_ISAL_CELL_FREECELLP(c) (SCM_FREECELLP(c)) 461 /* To avoid void-returning macro SCM_CELL_UNMARK(), SCM_ISAL_CELL_UNMARK() is 462 * directly used here. */ 463 #define SCM_ISAL_CELL_RECLAIM_CELL(c, next) \ 464 (SCM_ENTYPE((c), ScmFreeCell), \ 465 SCM_ISAL_CELL_UNMARK(c), \ 466 SCM_FREECELL_SET_NEXT((c), (next)), \ 467 SCM_FREECELL_CLEAR_FREESLOT(c), \ 468 (ScmObj)(c)) 469 470 #define SCM_ISAL_MARKEDP(o) ((o)->attr.v.gcmark) 471 #define SCM_ISAL_MARK(o) ((o)->attr.v.gcmark = scm_true) 472 #define SCM_ISAL_CELL_MARKEDP(c) ((c)->attr.v.gcmark) 473 #define SCM_ISAL_CELL_UNMARK(c) ((c)->attr.v.gcmark = scm_false) 474 475 /*=========================================================================== 476 Abstract ScmObj Reference For Storage-Representation Independent Efficient 477 List Operations 478 ===========================================================================*/ 479 #define SCM_SAL_INVALID_REF (NULL) 480 481 #define SCM_SAL_REF_CAR(kons) (&SCM_AS_CONS(kons)->obj.cons.car) 482 #define SCM_SAL_REF_CDR(kons) (&SCM_AS_CONS(kons)->obj.cons.cdr) 483 #define SCM_SAL_REF_OFF_HEAP(obj) (&(obj)) 484 485 /* SCM_DEREF(ref) is not permitted to be used as lvalue */ 486 #define SCM_SAL_DEREF(ref) (*(ref) + 0) 487 488 /* RFC: Is there a better name? */ 489 #define SCM_SAL_SET(ref, obj) (*(ref) = (obj)) 490 491 /*=========================================================================== 492 Special Constants and Predicates 493 ===========================================================================*/ 494 #define SCM_SAL_INVALID (NULL) 495 #define SCM_SAL_NULL scm_const_null 496 #define SCM_SAL_TRUE scm_const_true 497 #if SCM_COMPAT_SIOD_BUGS 498 #define SCM_SAL_FALSE scm_const_null 499 #else 500 #define SCM_SAL_FALSE scm_const_false 501 #endif /* SCM_COMPAT_SIOD_BUGS */ 502 #define SCM_SAL_EOF scm_const_eof 503 #define SCM_SAL_UNBOUND scm_const_unbound 504 #define SCM_SAL_UNDEF scm_const_undef 505 506 #define SCM_SAL_EQ(a, b) ((a) == (b)) 507 508 /* storage.c */ 509 SCM_GLOBAL_VARS_BEGIN(storage_fatty); 510 ScmObj scm_const_null, scm_const_true, scm_const_false, scm_const_eof; 511 ScmObj scm_const_unbound, scm_const_undef; 512 SCM_GLOBAL_VARS_END(storage_fatty); 513 #define scm_const_null SCM_GLOBAL_VAR(storage_fatty, scm_const_null) 514 #define scm_const_true SCM_GLOBAL_VAR(storage_fatty, scm_const_true) 515 #define scm_const_false SCM_GLOBAL_VAR(storage_fatty, scm_const_false) 516 #define scm_const_eof SCM_GLOBAL_VAR(storage_fatty, scm_const_eof) 517 #define scm_const_unbound SCM_GLOBAL_VAR(storage_fatty, scm_const_unbound) 518 #define scm_const_undef SCM_GLOBAL_VAR(storage_fatty, scm_const_undef) 519 SCM_DECLARE_EXPORTED_VARS(storage_fatty); 520 521 #ifdef __cplusplus 522 /* } */ 523 #endif 524 525 #include "storage-common.h" 526 527 #endif /* __STORAGE_FATTY_H */ 528