1 /*=========================================================================== 2 * Filename : storage-compact.h 3 * About : Storage abstraction (compact representation) 4 * 5 * Copyright (C) 2005-2006 Kazuki Ohta <mover AT hct.zaq.ne.jp> 6 * Copyright (C) 2006 Jun Inoue <jun.lambda AT gmail.com> 7 * Copyright (C) 2005-2006 YAMAMOTO Kengo <yamaken AT bp.iij4u.or.jp> 8 * Copyright (c) 2007-2008 SigScheme Project <uim-en AT googlegroups.com> 9 * 10 * All rights reserved. 11 * 12 * Redistribution and use in source and binary forms, with or without 13 * modification, are permitted provided that the following conditions 14 * are met: 15 * 16 * 1. Redistributions of source code must retain the above copyright 17 * notice, this list of conditions and the following disclaimer. 18 * 2. Redistributions in binary form must reproduce the above copyright 19 * notice, this list of conditions and the following disclaimer in the 20 * documentation and/or other materials provided with the distribution. 21 * 3. Neither the name of authors nor the names of its contributors 22 * may be used to endorse or promote products derived from this software 23 * without specific prior written permission. 24 * 25 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS 26 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 27 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 28 * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR 29 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, 30 * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, 31 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 32 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 33 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR 34 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF 35 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 36 ===========================================================================*/ 37 #ifndef __STORAGE_COMPACT_H 38 #define __STORAGE_COMPACT_H 39 40 /* 41 * Internal representation defined in this file MUST NOT directly touched by 42 * libsscm users. Use abstract public APIs defined in sigscheme.h. 43 */ 44 45 /* 46 * Object Representation 47 * 48 * In following descriptions, we represent that ScmObj "S" points to a ScmCell 49 * on the heap which contains two ScmObj field "X" and "Y" (suppose S = &{ X, Y 50 * }). 51 * 52 * (0) LSB of "S" is called G-bit. And bit 1..2 of S is called 'primary tag', 53 * which roughly distinguishes the type of the object as follows. 54 * 55 * S | Type | content of remainder bits 56 * -------------+------------------+--------------------------- 57 * .......|00|G : cons cell (pair) : pointer to the cell 58 * .......|01|G : closure : pointer to the cell 59 * .......|10|G : 'misc' object : pointer to the cell 60 * .......|11|G : immediate : value 61 * 62 * (1) If S == "...00G", S points to a cons cell (pair). G-bit of S->X is used 63 * as the GC mark bit. And G bit of S->Y is always set to 0, to help 64 * determining its own type without the pointer S on the object 65 * finalization. 66 * 67 * S->X | Type | content of S->X 68 * --------------+--------------+------------------------------------------ 69 * ...........|G : cons cell : car (ScmObj) 70 * 71 * S->Y | Type | content of S->Y 72 * --------------+--------------+------------------------------------------ 73 * ...........|0 : cons cell : cdr (ScmObj) 74 * 75 * (2) If S == "...01G", S points to a closure. G-bit of S->X is used as the GC 76 * mark bit. And G bit of S->Y is always set to 0, to help determining its 77 * own type without the pointer S on the object finalization. 78 * 79 * S->X | Type | content of S->X 80 * --------------+--------------+------------------------------------------ 81 * ...........|G : closure : exp (ScmObj) 82 * 83 * S->Y | Type | content of S->Y 84 * --------------+--------------+------------------------------------------ 85 * ...........|0 : closure : env (ScmObj) 86 * 87 * (3) If S == "...10G", S points to a 'miscellaneous' object. Its particular 88 * type is determined by the value of some lower bits of S->Y. G-bit of 89 * S->X is used as the GC mark bit. And G bit of S->Y is always set to 1, 90 * to help determining its own type without the pointer S on the object 91 * finalization. 92 * 93 * S->X | Type | content of S->X 94 * --------------+--------------+------------------------------------------ 95 * ...........|G : symbol : symbol value (ScmObj) 96 * ...........|G : string : C string (char *) 97 * ...........|G : vector : vector objects (ScmObj *) 98 * ...........|G : valuepacket : values list (ScmObj) 99 * ...........|G : func : function pointer (LSB is stored in S->Y) 100 * ...........|G : port : char port instance (ScmCharPort *) 101 * ...........|G : continuation : opaque (void *) 102 * ...........|G : pointer 103 * ...........|G : - C ptr : pointer (void *) 104 * ...........|G : - C funcptr : function pointer (ScmCFunc) 105 * ...........|G : wrapper : abstract obj (ScmObj) 106 * ...........|G : - subpat : object (ScmObj) 107 * ...........|G : - far symbol: symbol (ScmObj) 108 * ...........|G : - macro : rules (ScmObj) 109 * ...........|G : freecell : next cell (ScmObj) 110 * 111 * S->Y | Type | content of S->Y 112 * --------------+--------------+------------------------------------------ 113 * ........|00|1 : symbol : symbol name (char *) 114 * .......M|01|1 : string : string length, 'mutable' bit M 115 * .......M|10|1 : vector : vector length, 'mutable' bit M 116 * ....|000|11|1 : valuepacket : unused (all 0 for efficiency) 117 * ...P|001|11|1 : func : type code, LSB P of the pointer (S->X) 118 * ....|010|11|1 : port : flags (enum ScmPortFlag) 119 * ....|011|11|1 : continuation : tag (scm_int_t) 120 * ....|100|11|1 : pointer 121 * P|00|100|11|1 : - C ptr : LSB P of the pointer (S->X) 122 * P|01|100|11|1 : - C funcptr : LSB P of the pointer (S->X) 123 * .|10|100|11|1 : - (reserved): 124 * .|11|100|11|1 : - (reserved): 125 * ....|101|11|1 : wrapper : inaccessible 126 * .|00|101|11|1 : - subpat : metainformation about the wrapped object 127 * .|01|101|11|1 : - far symbol: [#if !SCM_USE_UNHYGIENIC_MACRO] env depth 128 * .|10|101|11|1 : - macro : [#if !SCM_USE_UNHYGIENIC_MACRO] env depth 129 * .|11|101|11|1 : - (reserved): 130 * ....|110|11|1 : (reserved) : 131 * ....|111|11|1 : freecell : unused (all 0) 132 * 133 * Misc. types' tags come in several levels, including the GC bit: 134 * 135 * .|..|...|ZZ|Z : level 1 136 * .|..|ZZZ|ZZ|Z : level 2 137 * .|ZZ|ZZZ|ZZ|Z : level 3 138 * 139 * Required data aligments: 140 * 141 * symbol 142 * name (char *) : 8 byte (S->Y) 143 * string 144 * str (char *) : 2 byte (S->X) 145 * vector 146 * vec (ScmObj *) : 2 byte (S->X) 147 * port 148 * impl (ScmCharPort *) : 2 byte (S->X) 149 * continuation 150 * opaque (void *) : 2 byte (S->X) 151 * func 152 * ptr (ScmFuncType) : 1 byte (S->X) 153 * C ptr 154 * value (void *) : 1 byte (S->X) 155 * C funcptr 156 * value (ScmCFunc) : 1 byte (S->X) 157 * 158 * (4) If S == "...11G", S is an immediate value. Immediate values are 159 * separated into these subtypes by the value of bit 3..7 of S. 160 * 161 * S | Type 162 * -------------+------------ 163 * ......0|11|G : integer 164 * .....01|11|G : char 165 * .....11|11|G : constant 166 * .000|11|11|G : - () 167 * .001|11|11|G : - INVALID 168 * .010|11|11|G : - UNBOUND 169 * .011|11|11|G : - #f 170 * .100|11|11|G : - #t 171 * .101|11|11|G : - EOF 172 * .110|11|11|G : - UNDEF 173 * 174 */ 175 176 #include <limits.h> 177 #include <stddef.h> 178 #include <stdlib.h> 179 180 /* Don't include scmport.h. The implementations are internal and should not be 181 * exposed to libsscm users via installation of this file. */ 182 183 #ifdef __cplusplus 184 /* extern "C" { */ 185 #endif 186 187 188 /* Aux. */ 189 #define SCM_MAKE_MASK(offset, width) \ 190 (((scm_uintobj_t)1 << ((offset) + (width))) \ 191 - ((scm_uintobj_t)1 << (offset))) 192 193 #define SCM_SIGNED_TYPEP(t) ((t)(-1) < (t)0) 194 #define SCM_SIGN_BIT(x) ((x) \ 195 & ((scm_uintobj_t)1 << (sizeof(x) * CHAR_BIT - 1))) 196 197 #if HAVE_ARITHMETIC_RSHIFT 198 #define SCM_ARSHIFT(x, n) ((scm_uintobj_t)((scm_intobj_t)(x) >> (n))) 199 #else /* not HAVE_ARITHMETIC_RSHIFT */ 200 /* Emulate a right arithmetic shift. */ 201 #define SCM_ARSHIFT(x, n) \ 202 (((scm_uintobj_t)(x) >> (n)) | -(SCM_SIGN_BIT(x) >> (n))) 203 #endif /* not HAVE_ARITHMETIC_RSHIFT */ 204 205 206 /* ------------------------------------------------------------ 207 * Crude representation. 208 */ 209 210 typedef struct ScmCell_ ScmCell; 211 212 /* Note that this is unsigned. Signed operations are desirable only 213 * in a few, specific cases. */ 214 typedef scm_uintobj_t ScmObj; 215 #define ALIGNOF_SCMOBJ ALIGNOF_SCM_INTOBJ_T 216 #define SIZEOF_SCMOBJ SIZEOF_SCM_INTOBJ_T 217 218 struct ScmCell_ { 219 /* The field names have some redundancy to avoid conflict with 220 * macros' formal arguments and stuff. */ 221 ScmObj obj_x; 222 ScmObj obj_y; 223 }; 224 225 typedef ScmObj (*ScmFuncType)(); 226 227 /* ScmObj = .....|PP|G 228 * G = GC bit 229 * P = Primary tag (ptag) 230 */ 231 232 #define SCM_GCBIT_OFFSET 0 /* More or less hardcoded. */ 233 #define SCM_GCBIT_WIDTH 1 234 #define SCM_GCBIT_MASK SCM_MAKE_MASK(SCM_GCBIT_OFFSET, SCM_GCBIT_WIDTH) 235 #define SCM_GCBIT(o) ((o) & SCM_GCBIT_MASK) 236 #define SCM_GCBIT_MARKED 1 /* More or less hardcoded. */ 237 #define SCM_GCBIT_UNMARKED 0 /* Ditto. */ 238 239 #define SCM_PTAG_OFFSET (SCM_GCBIT_WIDTH + SCM_GCBIT_OFFSET) 240 #define SCM_PTAG_WIDTH 2 241 #define SCM_PTAG_MASK SCM_MAKE_MASK(SCM_PTAG_OFFSET, SCM_PTAG_WIDTH) 242 #define SCM_MAKE_PTAG(id) ((scm_uintobj_t)(id) << SCM_PTAG_OFFSET) 243 #define SCM_PTAG(o) ((o) & SCM_PTAG_MASK) 244 #define SCM_PTAG_SET(o, tag) ((o) = ((o) & ~SCM_PTAG_MASK) | (tag)) 245 246 #define SCM_DROP_PTAG(o) ((o) & ~SCM_PTAG_MASK) 247 #define SCM_DROP_GCBIT(o) ((o) & ~SCM_GCBIT_MASK) 248 #define SCM_DROP_TAG(o) ((o) & ~(SCM_GCBIT_MASK | SCM_PTAG_MASK)) 249 250 #define SCM_UNTAGGEDP(o) (!((o) & (SCM_GCBIT_MASK | SCM_PTAG_MASK))) 251 252 #define SCM_UNTAG_PTR(o) (SCM_PTR(SCM_DROP_TAG(o))) 253 254 /* Raw accessors. */ 255 #define SCM_PTR(o) (SCM_ASSERT(!((scm_uintobj_t)(o) % sizeof(ScmCell))), \ 256 (ScmCell *)(o)) 257 #define SCM_X(o) (SCM_PTR(o)->obj_x) 258 #define SCM_Y(o) (SCM_PTR(o)->obj_y) 259 #define SCM_SET_X(o, x) (SCM_X(o) = (x)) 260 #define SCM_SET_Y(o, y) (SCM_Y(o) = (y)) 261 #define SCM_INIT(o, x, y, ptag) \ 262 (SCM_SET_X(SCM_DROP_TAG(o), (x)), \ 263 SCM_SET_Y(SCM_DROP_TAG(o), (y)), \ 264 (o) = SCM_DROP_TAG(o) | (ptag)) 265 266 #define SCM_SAL_EQ(a, b) ((a) == (b)) 267 268 /* ------------------------------------------------------------ 269 * Garbage collection 270 */ 271 272 #define SCM_ISAL_MARKEDP(o) (SCM_GCBIT(SCM_X(SCM_DROP_TAG(o))) \ 273 == SCM_GCBIT_MARKED) 274 #define SCM_ISAL_MARK(o) \ 275 SCM_SET_X(SCM_DROP_TAG(o), \ 276 SCM_DROP_GCBIT(SCM_X(SCM_DROP_TAG(o))) | SCM_GCBIT_MARKED) 277 278 #define SCM_ISAL_CELL_MARKEDP(c) (SCM_GCBIT(SCM_X(c)) == SCM_GCBIT_MARKED) 279 /* O is always untagged, so no need to strip it. */ 280 #define SCM_ISAL_CELL_UNMARK(c) \ 281 SCM_SET_X((c), SCM_DROP_GCBIT(SCM_X(c)) | SCM_GCBIT_UNMARKED) 282 283 /* See if O's tag and the content of the cell C it references are 284 * consistent. O must be a tagged ScmObj and SCM_DROP_TAG(O) == &C. */ 285 #define SCM_TAG_CONSISTENTP(o, c) (!!SCM_SYMMETRICP(o) \ 286 != !!SCM_CELL_MISCP(c)) 287 288 /* ------------------------------------------------------------ 289 * Symmetric types (both obj_x and obj_y point to some other ScmCell). 290 * Pairs and closures are chosen for their prevalence. 291 */ 292 293 /* SCM_TAG_CONSISTENTP() needs this. The PTAG mask value '2' depends on the 294 * hardcoded value of SCM_PTAG_{CONS,CLOSURE}. */ 295 #define SCM_SYMMETRICP(o) (!(SCM_PTAG(o) & SCM_MAKE_PTAG(2))) 296 297 /* Pairs. Immutable pairs are not supported. */ 298 #define SCM_PTAG_CONS SCM_MAKE_PTAG(0) /* hardcoded */ 299 /* Bypass ptag stripping. */ 300 #define SCM_CONS_PTR(o) SCM_PTR(SCM_AS_CONS(o)) 301 302 #define SCM_SAL_CONSP(o) (SCM_PTAG(o) == SCM_PTAG_CONS) 303 #define SCM_SAL_CONS_CAR(o) SCM_X(SCM_CONS_PTR(o)) 304 #define SCM_SAL_CONS_CDR(o) SCM_Y(SCM_CONS_PTR(o)) 305 #define SCM_SAL_CONS_SET_CAR(o, kar) SCM_SET_X(SCM_CONS_PTR(o), (kar)) 306 #define SCM_SAL_CONS_SET_CDR(o, kdr) SCM_SET_Y(SCM_CONS_PTR(o), (kdr)) 307 #define SCM_ISAL_CONS_INIT(o, ar, dr) SCM_INIT((o), (ar), (dr), SCM_PTAG_CONS) 308 #define SCM_SAL_CONS_MUTABLEP(o) scm_true 309 #define SCM_SAL_CONS_SET_MUTABLE(o) SCM_EMPTY_EXPR 310 #define SCM_SAL_CONS_SET_IMMUTABLE(o) SCM_EMPTY_EXPR 311 312 /* Closures. */ 313 #define SCM_PTAG_CLOSURE SCM_MAKE_PTAG(1) /* hardcoded */ 314 #define SCM_CLOSURE_PTR(o) SCM_UNTAG_PTR(SCM_AS_CLOSURE(o)) 315 316 #define SCM_SAL_CLOSUREP(o) (SCM_PTAG(o) == SCM_PTAG_CLOSURE) 317 #define SCM_SAL_CLOSURE_EXP(o) SCM_X(SCM_CLOSURE_PTR(o)) 318 #define SCM_SAL_CLOSURE_ENV(o) SCM_Y(SCM_CLOSURE_PTR(o)) 319 #define SCM_SAL_CLOSURE_SET_EXP(o, c) SCM_SET_X(SCM_CLOSURE_PTR(o), (c)) 320 #define SCM_SAL_CLOSURE_SET_ENV(o, e) SCM_SET_Y(SCM_CLOSURE_PTR(o), (e)) 321 #define SCM_ISAL_CLOSURE_INIT(o, c, e) SCM_INIT((o), (c), (e), \ 322 SCM_PTAG_CLOSURE) 323 /* ------------------------------------------------------------ 324 * Immediate types (ones that fit on the pointer including type tags). 325 */ 326 327 /* Immediate ScmObj = VVVVIIPPG 328 * V = Numerical value of the object. 329 * I = Immediate type ID; further distinguishes types. Only 1 bit 330 * wide for integers, 2 bits for others. 331 * P = 3 (signature for immediates) 332 */ 333 #define SCM_PTAG_IMM SCM_MAKE_PTAG(3) 334 #define SCM_IMMP(o) (SCM_PTAG(o) == SCM_PTAG_IMM) 335 #define SCM_IMMID_OFFSET (SCM_PTAG_OFFSET + SCM_PTAG_WIDTH) 336 #define SCM_MAKE_IMMID(val) ((scm_uintobj_t)(val) << SCM_IMMID_OFFSET) 337 #define SCM_MAKE_ITAG(id) ((id) | SCM_PTAG_IMM) 338 #define SCM_MAKE_ITAG_MASK(id_w) SCM_MAKE_MASK(SCM_PTAG_OFFSET, \ 339 (id_w) + SCM_PTAG_WIDTH) 340 #define SCM_MAKE_VAL_OFFSET(id_w) (SCM_IMMID_OFFSET + (id_w)) 341 342 /* Integers. */ 343 #define SCM_IMMID_INT SCM_MAKE_IMMID(0) 344 #define SCM_IMMID_WIDTH_INT 1 345 #define SCM_ITAG_INT SCM_MAKE_ITAG(SCM_IMMID_INT) 346 #define SCM_ITAG_MASK_INT SCM_MAKE_ITAG_MASK(SCM_IMMID_WIDTH_INT) 347 #define SCM_INT_VAL_OFFSET (SCM_IMMID_OFFSET + SCM_IMMID_WIDTH_INT) 348 #define SCM_SAL_INTP(o) (((o) & SCM_ITAG_MASK_INT) == SCM_ITAG_INT) 349 #define SCM_SAL_MAKE_INT(i) \ 350 ((ScmObj)(((scm_uintobj_t)(scm_int_t)(i) << SCM_INT_VAL_OFFSET) \ 351 | SCM_ITAG_INT)) 352 #define SCM_SAL_INT_VALUE(o) \ 353 ((scm_int_t)SCM_ARSHIFT(SCM_AS_INT(o), SCM_INT_VAL_OFFSET)) 354 355 #define SCM_SAL_NUMBERP SCM_SAL_INTP 356 357 /* Characters. */ 358 #define SCM_IMMID_CHAR SCM_MAKE_IMMID(1) 359 #define SCM_IMMID_WIDTH_CHAR 2 360 #define SCM_ITAG_CHAR SCM_MAKE_ITAG(SCM_IMMID_CHAR) 361 #define SCM_ITAG_MASK_CHAR SCM_MAKE_ITAG_MASK(SCM_IMMID_WIDTH_CHAR) 362 #define SCM_CHAR_VAL_OFFSET (SCM_IMMID_OFFSET + SCM_IMMID_WIDTH_CHAR) 363 #define SCM_SAL_CHARP(o) (((o) & SCM_ITAG_MASK_CHAR) == SCM_ITAG_CHAR) 364 #define SCM_SAL_MAKE_CHAR(c) \ 365 ((ScmObj)(((scm_uintobj_t)(scm_ichar_t)(c) << SCM_CHAR_VAL_OFFSET) \ 366 | SCM_ITAG_CHAR)) 367 #define SCM_SAL_CHAR_VALUE(o) \ 368 ((scm_ichar_t)(SCM_AS_CHAR(o) >> SCM_CHAR_VAL_OFFSET)) 369 370 /* Singleton constants. */ 371 #define SCM_IMMID_CONST SCM_MAKE_IMMID(3) 372 #define SCM_IMMID_WIDTH_CONST 2 373 #define SCM_ITAG_CONST SCM_MAKE_ITAG(SCM_IMMID_CONST) 374 #define SCM_ITAG_MASK_CONST SCM_MAKE_ITAG_MASK(SCM_IMMID_WIDTH_CONST) 375 #define SCM_CONST_VAL_OFFSET SCM_MAKE_VAL_OFFSET(SCM_IMMID_WIDTH_CONST) 376 #define SCM_MAKE_CONST(i) \ 377 ((ScmObj)(((scm_uintobj_t)(i) << SCM_CONST_VAL_OFFSET) \ 378 | SCM_ITAG_CONST)) 379 #define SCM_SAL_CONSTANTP(o) (((o) & SCM_ITAG_MASK_CONST) == SCM_ITAG_CONST) 380 381 #define SCM_SAL_NULL SCM_MAKE_CONST(0) 382 #define SCM_SAL_INVALID SCM_MAKE_CONST(1) 383 #define SCM_SAL_UNBOUND SCM_MAKE_CONST(2) 384 #if SCM_COMPAT_SIOD_BUGS 385 #define SCM_SAL_FALSE SCM_SAL_NULL 386 #else 387 #define SCM_SAL_FALSE SCM_MAKE_CONST(3) 388 #endif 389 #define SCM_SAL_TRUE SCM_MAKE_CONST(4) 390 #define SCM_SAL_EOF SCM_MAKE_CONST(5) 391 #define SCM_SAL_UNDEF SCM_MAKE_CONST(6) 392 393 394 /* ------------------------------------------------------------ 395 * Miscellaneous types; most refer to one ScmCell or less, or 396 * otherwise uncommon enough to warrant the use of a pair to hold the 397 * two (perhaps more) ScmObj references. 398 */ 399 #define SCM_PTAG_MISC SCM_MAKE_PTAG(2) 400 #define SCM_MISCP(o) (SCM_PTAG(o) == SCM_PTAG_MISC) 401 #define SCM_MISC_Y_GCBIT SCM_GCBIT_MARKED 402 #define SCM_CELL_MISCP(c) (SCM_GCBIT(SCM_Y(&c)) == SCM_MISC_Y_GCBIT) 403 404 /* scmobj_y = ...CC|BBB|AA|G 405 * G = GC bit 406 * A,G = L1 Misc tag bits 407 * A,B,G = L2 Misc tag bits 408 * A,B,C,G = L3 Misc tag bits 409 * Note that misc tags include the GC bit (which is always 1). 410 */ 411 #define SCM_MTAG_OFFSET SCM_GCBIT_OFFSET 412 #define SCM_MTAG_L1_WIDTH (SCM_GCBIT_WIDTH + 2) 413 #define SCM_MTAG_L2_WIDTH (SCM_MTAG_L1_WIDTH + 3) 414 #define SCM_MTAG_L3_WIDTH (SCM_MTAG_L2_WIDTH + 2) 415 #define SCM_MTAG_WIDTH(lv) (((lv) == 1) ? SCM_MTAG_L1_WIDTH : \ 416 ((lv) == 2) ? SCM_MTAG_L2_WIDTH : \ 417 SCM_MTAG_L3_WIDTH) 418 #define SCM_MTAG_L1_MASK SCM_MAKE_MASK(SCM_MTAG_OFFSET, SCM_MTAG_L1_WIDTH) 419 #define SCM_MTAG_L2_MASK SCM_MAKE_MASK(SCM_MTAG_OFFSET, SCM_MTAG_L2_WIDTH) 420 #define SCM_MTAG_L3_MASK SCM_MAKE_MASK(SCM_MTAG_OFFSET, SCM_MTAG_L3_WIDTH) 421 #define SCM_MTAG_MASK(lv) (((lv) == 1) ? SCM_MTAG_L1_MASK : \ 422 ((lv) == 2) ? SCM_MTAG_L2_MASK : \ 423 SCM_MTAG_L3_MASK) 424 425 #define SCM_MTAG(o, lv) (SCM_Y(o) & SCM_MTAG_MASK(lv)) 426 #define SCM_MTAG_SET(o, lv, t) SCM_SET_Y((o), \ 427 (SCM_Y(o) & ~SCM_MTAG_MASK(lv)) | (t)) 428 429 #define SCM_MAKE_MTAG_L1(t) \ 430 (((scm_uintobj_t)(t) << (SCM_MTAG_OFFSET + SCM_GCBIT_WIDTH)) \ 431 | SCM_MISC_Y_GCBIT) 432 #define SCM_MAKE_MTAG_L2(t2, t1) \ 433 (((scm_uintobj_t)(t2) << (SCM_MTAG_OFFSET + SCM_MTAG_L1_WIDTH)) \ 434 | SCM_MAKE_MTAG_L1(t1)) 435 #define SCM_MAKE_MTAG_L3(t3, t2, t1) \ 436 (((scm_uintobj_t)(t3) << (SCM_MTAG_OFFSET + SCM_MTAG_L2_WIDTH)) \ 437 | SCM_MAKE_MTAG_L2((t2), (t1))) 438 439 440 /* Split X at B bits from LSB, store the upper half in obj_x, and 441 * multiplex the remainder with obj_y. */ 442 /* result must properly be cast to the original type of x by caller */ 443 #define SCM_MISC_X_SPLITX(o, lv, b) \ 444 (SCM_X(o) \ 445 | ((SCM_Y(o) >> SCM_MTAG_WIDTH(lv)) \ 446 & SCM_MAKE_MASK(0, (b)))) 447 448 /* x must properly be extended to sizeof(ScmObj) before this invocation. */ 449 #define SCM_MISC_SET_X_SPLITX(o, x, lv, b) \ 450 (SCM_SET_X((o), (x) & ~SCM_MAKE_MASK(0, (b))), \ 451 SCM_SET_Y((o), \ 452 (SCM_Y(o) & ~SCM_MAKE_MASK(SCM_MTAG_WIDTH(lv), (b))) \ 453 | (((x) & SCM_MAKE_MASK(0, (b))) << SCM_MTAG_WIDTH(lv)))) 454 455 /* result must properly be cast to the original type of y by caller */ 456 #define SCM_MISC_Y_SPLITX(o, ytyp, lv, b) \ 457 SCM_MISC_RSHIFT_Y(SCM_Y(o), ytyp, (SCM_MTAG_WIDTH(lv) + (b))) 458 459 /* y must properly be extended to sizeof(ScmObj) before this invocation. */ 460 #define SCM_MISC_SET_Y_SPLITX(o, y, lv, b) \ 461 SCM_SET_Y((o), \ 462 (SCM_Y(o) \ 463 & (SCM_MTAG_MASK(lv) \ 464 | SCM_MAKE_MASK(SCM_MTAG_WIDTH(lv), (b)))) \ 465 | (y) << (SCM_MTAG_WIDTH(lv) + (b))) 466 467 /* x and y must properly be extended to sizeof(ScmObj) before this 468 * invocation. */ 469 #define SCM_MISC_INIT_SPLITX(o, x, y, lv, tag, b) \ 470 SCM_INIT((o), \ 471 (x) & ~SCM_MAKE_MASK(0, (b)), \ 472 ((((y) << (b)) | ((x) & SCM_MAKE_MASK(0, (b)))) \ 473 << SCM_MTAG_WIDTH(lv)) \ 474 | (tag), SCM_PTAG_MISC) 475 476 477 /* A convenient declarator for misc. subtypes. This macro covertly 478 * defines parameters for the macros defined below. 479 * 480 * name - Name of the type in uppercase. STRING, SYMBOL, etc. 481 * 482 * lv - The level "invoked" with tag values. L2(1, 3) for example. 483 * 484 * xtype - The type to be stored in obj_x. void *, ScmFuncType, etc. 485 * 486 * xalign - Base-2 logarithm of the minimum alignment guaranteed for 487 * values stored in x. 0 means not aligned (or 1-byte aligned), 2 488 * means 4-byte aligned, and so on. 489 * 490 * ytype - The type to be stored in obj_y. 491 */ 492 #define SCM_MISC_DECLARE_TYPE(name, lv, xtype, xalign, ytype) \ 493 enum SCM_MISC_##name##_PARAMS { \ 494 SCM_MISC_##name##_LV = SCM_MISC_LEVEL_##lv, \ 495 SCM_MISC_##name##_X_UNUSED_BITS \ 496 = (SIZEOF_SCM_INTOBJ_T - sizeof(xtype)) * CHAR_BIT, \ 497 SCM_MISC_##name##_XALIGN = (xalign), \ 498 SCM_MISC_##name##_XSPILL = (SCM_GCBIT_WIDTH - (xalign) < 0) \ 499 ? 0 \ 500 : SCM_GCBIT_WIDTH - (xalign), \ 501 SCM_MTAG_##name = SCM_MAKE_MTAG_##lv, \ 502 SCM_MISC_##name##_XDIRECTP = (SCM_MISC_##name##_XSPILL <= 0), \ 503 SCM_MISC_##name##_XSHIFTP = (!SCM_MISC_##name##_XDIRECTP \ 504 && (SCM_MISC_##name##_XSPILL \ 505 < SCM_MISC_##name##_X_UNUSED_BITS)), \ 506 SCM_MISC_##name##_XSPLITP = !(SCM_MISC_##name##_XDIRECTP \ 507 || SCM_MISC_##name##_XSHIFTP) \ 508 }; \ 509 typedef xtype SCM_MISC_##name##_XTYPE; \ 510 typedef ytype SCM_MISC_##name##_YTYPE /* No semicolon here. */ 511 512 #define SCM_MISC_LEVEL_L1(t1) 1 513 #define SCM_MISC_LEVEL_L2(t2, t1) 2 514 #define SCM_MISC_LEVEL_L3(t3, t2, t1) 3 515 516 /* Dummies to make the declaration more verbose. */ 517 #define SCM_MISC_XTYPE(t) t 518 #define SCM_MISC_YTYPE(t) t 519 #define SCM_MISC_Y_UNUSED SCM_MISC_YTYPE(scm_int_t) /* Dummy. */ 520 #define SCM_MISC_XALIGN(n) n 521 #define SCM_MISC_XALIGN_SCMOBJ SCM_GCBIT_WIDTH /* If storing ScmObj. */ 522 523 #define SCM_MISC_INIT(o, x, y, typ) \ 524 do { \ 525 if (SCM_MISC_##typ##_XDIRECTP) \ 526 SCM_INIT((o), \ 527 SCM_MISC_CAST_X((x), typ), \ 528 SCM_MISC_ENCODE_Y((y), typ), \ 529 SCM_PTAG_MISC); \ 530 else if (SCM_MISC_##typ##_XSHIFTP) \ 531 SCM_INIT((o), \ 532 SCM_MISC_CAST_X((x), typ) << SCM_MISC_##typ##_XSPILL, \ 533 SCM_MISC_ENCODE_Y((y), typ), \ 534 SCM_PTAG_MISC); \ 535 else \ 536 SCM_MISC_INIT_SPLITX((o), \ 537 SCM_MISC_CAST_X((x), typ), \ 538 SCM_MISC_CAST_Y((y), typ), \ 539 SCM_MISC_##typ##_LV, \ 540 SCM_MTAG_##typ, \ 541 SCM_MISC_##typ##_XSPILL); \ 542 } while (0) 543 544 545 /* Cast shorter integer types such as char to ScmObj with proper sign extension 546 * and 64-bit safety. Especially on LP64 env, casting user-written integer 547 * constant by simple (ScmObj)-1 causes information loss. It must be written as 548 * -1L by user, or cast by receiver side by (ScmObj)(scmint_t)-1. This macro 549 * applies latter method safely. Invoke this macro for any X and Y input for 550 * misc object. -- YamaKen 2006-12-11 */ 551 #define SCM_MISC_CAST_X(x, typ) ((ScmObj)(SCM_MISC_##typ##_XTYPE)(x)) 552 #define SCM_MISC_CAST_Y(y, typ) ((ScmObj)(SCM_MISC_##typ##_YTYPE)(y)) 553 554 #define SCM_MISC_ENCODE_Y(y, typ) \ 555 ((SCM_MISC_CAST_Y((y), typ) << SCM_MTAG_WIDTH(SCM_MISC_##typ##_LV)) \ 556 | SCM_MTAG_##typ) 557 558 /* Does (y) >> (n), paying attention to y's signedness. */ 559 #define SCM_MISC_RSHIFT_Y(y, typ, n) \ 560 ((SCM_SIGNED_TYPEP(SCM_MISC_##typ##_YTYPE)) \ 561 ? SCM_ARSHIFT((y), (n)) : (y) >> (n)) 562 563 /* The NASSERT macros skip access assertions and tag removal. This is 564 * needed for GC where we don't have ptags on the pointers. */ 565 566 /* Signedness doesn't matter for XSHIFTP, as the top bits get truncated. */ 567 #define SCM_MISC_X_NASSERT(o, typ) \ 568 ((SCM_MISC_##typ##_XTYPE) \ 569 (SCM_MISC_##typ##_XDIRECTP \ 570 ? SCM_X(o) \ 571 : SCM_MISC_##typ##_XSHIFTP \ 572 ? (SCM_X(o) >> SCM_MISC_##typ##_XSPILL) \ 573 : SCM_MISC_X_SPLITX((o), \ 574 SCM_MISC_##typ##_LV, \ 575 SCM_MISC_##typ##_XSPILL))) 576 577 #define SCM_MISC_SET_X_NASSERT(o, x, typ) \ 578 (SCM_MISC_##typ##_XDIRECTP \ 579 ? SCM_SET_X((o), SCM_MISC_CAST_X((x), typ)) \ 580 : SCM_MISC_##typ##_XSHIFTP \ 581 ? SCM_SET_X((o), SCM_MISC_CAST_X((x), typ) << SCM_MISC_##typ##_XSPILL) \ 582 : SCM_MISC_SET_X_SPLITX((o), SCM_MISC_CAST_X((x), typ), \ 583 SCM_MISC_##typ##_LV, \ 584 SCM_MISC_##typ##_XSPILL)) 585 586 #define SCM_MISC_Y_NASSERT(o, typ) \ 587 ((SCM_MISC_##typ##_YTYPE) \ 588 (SCM_MISC_##typ##_XSPLITP \ 589 ? SCM_MISC_Y_SPLITX((o), typ, \ 590 SCM_MISC_##typ##_LV, SCM_MISC_##typ##_XSPILL) \ 591 : SCM_MISC_RSHIFT_Y(SCM_Y(o), typ, \ 592 SCM_MTAG_WIDTH(SCM_MISC_##typ##_LV)))) 593 594 #define SCM_MISC_SET_Y_NASSERT(o, y, typ) \ 595 (SCM_MISC_##typ##_XSPLITP \ 596 ? SCM_MISC_SET_Y_SPLITX((o), SCM_MISC_CAST_Y((y), typ), \ 597 SCM_MISC_##typ##_LV, \ 598 SCM_MISC_##typ##_XSPILL) \ 599 : SCM_SET_Y((o), \ 600 (SCM_MISC_CAST_Y((y), typ) \ 601 << SCM_MTAG_WIDTH(SCM_MISC_##typ##_LV)) \ 602 | SCM_MTAG_##typ)) 603 604 #define SCM_MISC_X(o, typ) SCM_MISC_X_NASSERT(SCM_##typ##_PTR(o), typ) 605 #define SCM_MISC_SET_X(o, x, typ) SCM_MISC_SET_X_NASSERT(SCM_##typ##_PTR(o), \ 606 (x), typ) 607 #define SCM_MISC_Y(o, typ) SCM_MISC_Y_NASSERT(SCM_##typ##_PTR(o), typ) 608 #define SCM_MISC_SET_Y(o, y, typ) SCM_MISC_SET_Y_NASSERT(SCM_##typ##_PTR(o), \ 609 (y), typ) 610 611 #define SCM_MISC_PTR(o, typ) SCM_UNTAG_PTR(SCM_AS_##typ(o)) 612 #define SCM_MISC_CELL_TYPEP(c, typ) \ 613 (SCM_MTAG((&(c)), SCM_MISC_##typ##_LV) == SCM_MTAG_##typ) 614 #define SCM_MISC_TYPEP(o, typ) \ 615 (SCM_MISCP(o) && SCM_MISC_CELL_TYPEP(*SCM_UNTAG_PTR(o), typ)) 616 617 618 /* ------------------------------ 619 * And finally, the types.... 620 */ 621 /* Symbols. */ 622 SCM_MISC_DECLARE_TYPE(SYMBOL, L1(0), 623 SCM_MISC_XTYPE(ScmObj), SCM_MISC_XALIGN_SCMOBJ, 624 SCM_MISC_YTYPE(char *)); 625 626 #define SCM_SYMBOL_PTR(o) SCM_MISC_PTR((o), SYMBOL) 627 #define SCM_SYMBOL_NAME_ALIGN SCM_MTAG_WIDTH(SCM_MISC_SYMBOL_LV) 628 #define SCM_SAL_SYMBOLP(o) SCM_MISC_TYPEP((o), SYMBOL) 629 #define SCM_SAL_SYMBOL_VCELL(o) SCM_MISC_X((o), SYMBOL) 630 #define SCM_SAL_SYMBOL_SET_VCELL(o, c) SCM_MISC_SET_X((o), (c), SYMBOL) 631 632 /* Symbols is the only misc type that has a pointer on Y, which 633 * doesn't fit well in the data model of other types. Hence we treat 634 * it rather ad-hocly. */ 635 #define SCM_ALIGNED_SYMBOL_NAME(n) \ 636 (!((uintptr_t)(n) & SCM_MAKE_MASK(0, SCM_SYMBOL_NAME_ALIGN))) 637 #define SCM_SAL_SYMBOL_NAME(o) \ 638 ((char *)(SCM_Y(SCM_SYMBOL_PTR(o)) & ~SCM_MTAG_SYMBOL)) 639 #define SCM_SAL_SYMBOL_SET_NAME(o, n) \ 640 (SCM_ASSERT(SCM_ALIGNED_SYMBOL_NAME(n)), \ 641 SCM_SET_Y(SCM_SYMBOL_PTR(o), (scm_uintobj_t)(n) | SCM_MTAG_SYMBOL)) 642 #define SCM_ISAL_SYMBOL_INIT(o, n, c) \ 643 do { \ 644 char *_s = scm_align_str(n); \ 645 SCM_ASSERT(SCM_ALIGNED_SYMBOL_NAME(_s)); \ 646 SCM_INIT((o), \ 647 (c), \ 648 (scm_uintobj_t)(_s) | SCM_MTAG_SYMBOL, \ 649 SCM_PTAG_MISC); \ 650 } while (0) 651 #define SCM_CELL_SYMBOLP(c) SCM_MISC_CELL_TYPEP((c), SYMBOL) 652 #define SCM_CELL_SYMBOL_FIN(c) \ 653 do { \ 654 char *_s = (char *)(SCM_Y(&(c)) & ~SCM_MTAG_SYMBOL); \ 655 free(_s); \ 656 } while (0) 657 658 /* Strings. */ 659 SCM_MISC_DECLARE_TYPE(STRING, L1(1), 660 SCM_MISC_XTYPE(char *), SCM_MISC_XALIGN(1), 661 SCM_MISC_YTYPE(scm_int_t)); 662 663 #define SCM_STRING_PTR(o) SCM_MISC_PTR((o), STRING) 664 #define SCM_SAL_STRINGP(o) SCM_MISC_TYPEP((o), STRING) 665 #define SCM_STRING_MUTABLE_BIT ((scm_int_t)1) 666 #define SCM_STRING_MUTABLE_BIT_WIDTH 1 667 #define SCM_STRING_MUTABILITY(o) \ 668 (SCM_MISC_Y((o), STRING) & SCM_STRING_MUTABLE_BIT) 669 #define SCM_SAL_STRING_MUTABLEP(o) SCM_STRING_MUTABILITY(o) 670 #define SCM_SAL_STRING_SET_MUTABLE(o) \ 671 SCM_MISC_SET_Y((o), SCM_MISC_Y((o), STRING) | SCM_STRING_MUTABLE_BIT, \ 672 STRING) 673 #define SCM_SAL_STRING_SET_IMMUTABLE(o) \ 674 SCM_MISC_SET_Y((o), SCM_MISC_Y((o), STRING) & ~SCM_STRING_MUTABLE_BIT, \ 675 STRING) 676 #define SCM_SAL_STRING_STR(o) SCM_MISC_X((o), STRING) 677 #define SCM_SAL_STRING_LEN(o) (SCM_MISC_Y((o), STRING) \ 678 >> SCM_STRING_MUTABLE_BIT_WIDTH) 679 #define SCM_SAL_STRING_SET_STR(o, s) SCM_MISC_SET_X((o), (s), STRING) 680 #define SCM_SAL_STRING_SET_LEN(o, l) \ 681 SCM_MISC_SET_Y((o), \ 682 (((scm_int_t)(l) << SCM_STRING_MUTABLE_BIT_WIDTH) \ 683 | SCM_STRING_MUTABILITY(o)), \ 684 STRING) 685 #define SCM_ISAL_STRING_INIT(o, s, l, mut) \ 686 SCM_MISC_INIT((o), (s), \ 687 ((scm_int_t)(l) << SCM_STRING_MUTABLE_BIT_WIDTH) \ 688 | ((mut) ? SCM_STRING_MUTABLE_BIT : 0), \ 689 STRING) 690 #define SCM_ISAL_MUTABLE_STRING_INIT(o, s, l) \ 691 SCM_ISAL_STRING_INIT((o), (s), (l), scm_true) 692 #define SCM_ISAL_IMMUTABLE_STRING_INIT(o, s, l) \ 693 SCM_ISAL_STRING_INIT((o), (s), (l), scm_false) 694 #define SCM_CELL_STRINGP(c) SCM_MISC_CELL_TYPEP((c), STRING) 695 #define SCM_CELL_STRING_FIN(c) \ 696 do { \ 697 char *_s = SCM_MISC_X_NASSERT(&(c), STRING); \ 698 free(_s); \ 699 } while (0) 700 701 702 /* Vectors. */ 703 SCM_MISC_DECLARE_TYPE(VECTOR, L1(2), 704 SCM_MISC_XTYPE(ScmObj *), SCM_MISC_XALIGN(1), 705 SCM_MISC_YTYPE(scm_int_t)); 706 707 #define SCM_VECTOR_PTR(o) SCM_MISC_PTR((o), VECTOR) 708 #define SCM_SAL_VECTORP(o) SCM_MISC_TYPEP((o), VECTOR) 709 #define SCM_VECTOR_MUTABLE_BIT ((scm_int_t)1) 710 #define SCM_VECTOR_MUTABLE_BIT_WIDTH 1 711 #define SCM_VECTOR_MUTABILITY(o) \ 712 (SCM_MISC_Y((o), VECTOR) & SCM_VECTOR_MUTABLE_BIT) 713 #define SCM_SAL_VECTOR_MUTABLEP(o) SCM_VECTOR_MUTABILITY(o) 714 #define SCM_SAL_VECTOR_SET_MUTABLE(o) \ 715 SCM_MISC_SET_Y((o), SCM_MISC_Y((o), VECTOR) | SCM_VECTOR_MUTABLE_BIT, \ 716 VECTOR) 717 #define SCM_SAL_VECTOR_SET_IMMUTABLE(o) \ 718 SCM_MISC_SET_Y((o), SCM_MISC_Y((o), VECTOR) & ~SCM_VECTOR_MUTABLE_BIT, \ 719 VECTOR) 720 #define SCM_SAL_VECTOR_VEC(o) SCM_MISC_X((o), VECTOR) 721 #define SCM_SAL_VECTOR_LEN(o) (SCM_MISC_Y((o), VECTOR) \ 722 >> SCM_VECTOR_MUTABLE_BIT_WIDTH) 723 #define SCM_SAL_VECTOR_SET_VEC(o, v) SCM_MISC_SET_X((o), (v), VECTOR) 724 #define SCM_SAL_VECTOR_SET_LEN(o, l) \ 725 SCM_MISC_SET_Y((o), \ 726 (((scm_int_t)(l) << SCM_VECTOR_MUTABLE_BIT_WIDTH) \ 727 | SCM_VECTOR_MUTABILITY(o)), \ 728 VECTOR) 729 #define SCM_ISAL_VECTOR_INIT(o, v, l, mut) \ 730 SCM_MISC_INIT((o), (v), \ 731 (((scm_int_t)(l) << SCM_VECTOR_MUTABLE_BIT_WIDTH) \ 732 | ((mut) ? SCM_VECTOR_MUTABLE_BIT : 0)), \ 733 VECTOR) 734 #define SCM_ISAL_MUTABLE_VECTOR_INIT(o, v, l) \ 735 SCM_ISAL_VECTOR_INIT((o), (v), (l), scm_true) 736 #define SCM_ISAL_IMMUTABLE_VECTOR_INIT(o, v, l) \ 737 SCM_ISAL_VECTOR_INIT((o), (v), (l), scm_false) 738 #define SCM_CELL_VECTORP(c) SCM_MISC_CELL_TYPEP((c), VECTOR) 739 #define SCM_CELL_VECTOR_FIN(c) \ 740 do { \ 741 ScmObj *_vec = SCM_MISC_X_NASSERT(&(c), VECTOR); \ 742 free(_vec); \ 743 } while (0) 744 745 /* Multiple Values. */ 746 SCM_MISC_DECLARE_TYPE(VALUEPACKET, L2(0, 3), 747 SCM_MISC_XTYPE(ScmObj), SCM_MISC_XALIGN_SCMOBJ, 748 SCM_MISC_Y_UNUSED); 749 #if SCM_USE_VALUECONS 750 #error "SCM_USE_VALUECONS is not supported by storage-compact." 751 #endif 752 753 #define SCM_VALUEPACKET_PTR(o) SCM_MISC_PTR((o), VALUEPACKET) 754 #define SCM_SAL_VALUEPACKETP(o) SCM_MISC_TYPEP((o), VALUEPACKET) 755 #define SCM_SAL_VALUEPACKET_VALUES(o) SCM_MISC_X((o), VALUEPACKET) 756 #define SCM_SAL_VALUEPACKET_SET_VALUES(o, v) \ 757 SCM_MISC_SET_X((o), (v), VALUEPACKET) 758 #define SCM_ISAL_VALUEPACKET_INIT(o, v) SCM_MISC_INIT((o), (v), 0, VALUEPACKET) 759 760 /* Builtin functions. */ 761 SCM_MISC_DECLARE_TYPE(FUNC, L2(1, 3), 762 SCM_MISC_XTYPE(ScmFuncType), SCM_MISC_XALIGN(0), 763 SCM_MISC_YTYPE(enum ScmFuncTypeCode)); 764 765 #define SCM_FUNC_PTR(o) SCM_MISC_PTR((o), FUNC) 766 #define SCM_SAL_FUNCP(o) SCM_MISC_TYPEP((o), FUNC) 767 #define SCM_SAL_FUNC_CFUNC(o) SCM_MISC_X((o), FUNC) 768 #define SCM_SAL_FUNC_TYPECODE(o) SCM_MISC_Y((o), FUNC) 769 #define SCM_SAL_FUNC_SET_CFUNC(o, f) SCM_MISC_SET_X((o), (f), FUNC) 770 #define SCM_SAL_FUNC_SET_TYPECODE(o, t) SCM_MISC_SET_Y((o), (t), FUNC) 771 #define SCM_ISAL_FUNC_INIT(o, t, f) SCM_MISC_INIT((o), (f), (t), FUNC) 772 773 /* Ports. */ 774 struct ScmCharPort_; 775 776 SCM_MISC_DECLARE_TYPE(PORT, L2(2, 3), 777 SCM_MISC_XTYPE(struct ScmCharPort_ *), SCM_MISC_XALIGN(1), 778 SCM_MISC_YTYPE(enum ScmPortFlag)); 779 780 #define SCM_PORT_PTR(o) SCM_MISC_PTR((o), PORT) 781 #define SCM_SAL_PORTP(o) SCM_MISC_TYPEP((o), PORT) 782 #define SCM_SAL_PORT_IMPL(o) SCM_MISC_X((o), PORT) 783 #define SCM_SAL_PORT_FLAG(o) SCM_MISC_Y((o), PORT) 784 #define SCM_SAL_PORT_SET_IMPL(o, i) SCM_MISC_SET_X((o), (i), PORT) 785 #define SCM_SAL_PORT_SET_FLAG(o, f) SCM_MISC_SET_Y((o), (f), PORT) 786 #define SCM_ISAL_PORT_INIT(o, i, f) SCM_MISC_INIT((o), (i), (f), PORT) 787 #define SCM_CELL_PORTP(c) SCM_MISC_CELL_TYPEP((c), PORT) 788 #define SCM_CELL_PORT_FIN(c) \ 789 do { \ 790 struct ScmCharPort_ *impl; \ 791 impl = SCM_MISC_X_NASSERT(&(c), PORT); \ 792 if (impl) \ 793 SCM_CHARPORT_CLOSE(impl); \ 794 } while (0) 795 796 797 /* Continuation. */ 798 SCM_MISC_DECLARE_TYPE(CONTINUATION, L2(3, 3), 799 SCM_MISC_XTYPE(void *), SCM_MISC_XALIGN(1), 800 SCM_MISC_YTYPE(scm_int_t)); 801 802 #define SCM_CONTINUATION_PTR(o) SCM_MISC_PTR((o), CONTINUATION) 803 #define SCM_SAL_CONTINUATIONP(o) SCM_MISC_TYPEP((o), CONTINUATION) 804 #define SCM_SAL_CONTINUATION_OPAQUE(o) SCM_MISC_X((o), CONTINUATION) 805 #define SCM_SAL_CONTINUATION_TAG(o) SCM_MISC_Y((o), CONTINUATION) 806 #define SCM_SAL_CONTINUATION_SET_OPAQUE(o, a) \ 807 SCM_MISC_SET_X((o), (a), CONTINUATION) 808 #define SCM_SAL_CONTINUATION_SET_TAG(o, t) \ 809 SCM_MISC_SET_Y((o), (t), CONTINUATION) 810 #define SCM_ISAL_CONTINUATION_INIT(o, a, t) \ 811 SCM_MISC_INIT((o), (a), (t), CONTINUATION) 812 #define SCM_CELL_CONTINUATIONP(c) \ 813 SCM_MISC_CELL_TYPEP((c), CONTINUATION) 814 /* 815 * Since continuations aren't so common, the cost of function call for 816 * destroying one is acceptable. In turn, it eases continuation 817 * module substitution without requiring module-specific destructors. 818 */ 819 #define SCM_CELL_CONTINUATION_FIN(c) \ 820 scm_destruct_continuation((ScmObj)&(c) | SCM_PTAG_MISC) 821 822 823 #if SCM_USE_SSCM_EXTENSIONS 824 825 /* C datum pointer */ 826 SCM_MISC_DECLARE_TYPE(C_POINTER, L3(0, 4, 3), 827 SCM_MISC_XTYPE(void *), SCM_MISC_XALIGN(0), 828 SCM_MISC_Y_UNUSED); 829 830 #define SCM_C_POINTER_PTR(o) SCM_MISC_PTR((o), C_POINTER) 831 #define SCM_SAL_C_POINTERP(o) SCM_MISC_TYPEP((o), C_POINTER) 832 #define SCM_SAL_C_POINTER_VALUE(o) SCM_MISC_X((o), C_POINTER) 833 #define SCM_SAL_C_POINTER_SET_VALUE(o, p) SCM_MISC_SET_X((o), (p), C_POINTER) 834 #define SCM_ISAL_C_POINTER_INIT(o, p) SCM_MISC_INIT((o), (p), 0, C_POINTER) 835 836 /* C function pointer */ 837 SCM_MISC_DECLARE_TYPE(C_FUNCPOINTER, L3(1, 4, 3), 838 SCM_MISC_XTYPE(ScmCFunc), SCM_MISC_XALIGN(0), 839 SCM_MISC_Y_UNUSED); 840 841 #define SCM_C_FUNCPOINTER_PTR(o) SCM_MISC_PTR((o), C_FUNCPOINTER) 842 #define SCM_SAL_C_FUNCPOINTERP(o) SCM_MISC_TYPEP((o), C_FUNCPOINTER) 843 #define SCM_SAL_C_FUNCPOINTER_VALUE(o) SCM_MISC_X((o), C_FUNCPOINTER) 844 #define SCM_SAL_C_FUNCPOINTER_SET_VALUE(o, f) \ 845 SCM_MISC_SET_X((o), (f), C_FUNCPOINTER) 846 #define SCM_ISAL_C_FUNCPOINTER_INIT(o, f) \ 847 SCM_MISC_INIT((o), (f), 0, C_FUNCPOINTER) 848 849 #endif /* SCM_USE_SSCM_EXTENSIONS */ 850 851 852 #if SCM_USE_HYGIENIC_MACRO 853 854 #if SCM_USE_UNHYGIENIC_MACRO 855 #error "Not implemented (you need to change the representations of hmacro and farsymbol)." 856 #endif 857 858 /* Wrapper is an abstract supertype of the macro-related types whose 859 * definitions follow. Wrapper itself is provided for GC and 860 * shouldn't be utilized in user code. */ 861 SCM_MISC_DECLARE_TYPE(WRAPPER, L2(5, 3), 862 SCM_MISC_XTYPE(ScmObj), SCM_MISC_XALIGN_SCMOBJ, 863 SCM_MISC_YTYPE(scm_int_t)); 864 865 #define SCM_WRAPPERP(o) SCM_MISC_TYPEP((o), WRAPPER) 866 #define SCM_WRAPPER_PTR(o) SCM_UNTAG_PTR(o) 867 #define SCM_WRAPPER_OBJ(o) SCM_MISC_X((o), WRAPPER) 868 869 /* Compiled repeatable subpattern or subtemplate. */ 870 SCM_MISC_DECLARE_TYPE(SUBPAT, L3(0, 5, 3), 871 SCM_MISC_XTYPE(ScmObj), SCM_MISC_XALIGN_SCMOBJ, 872 SCM_MISC_YTYPE(scm_int_t)); 873 874 #define SCM_SUBPAT_PTR(o) SCM_MISC_PTR((o), SUBPAT) 875 #define SCM_SAL_SUBPATP(o) SCM_MISC_TYPEP((o), SUBPAT) 876 #define SCM_SAL_SUBPAT_OBJ(o) SCM_MISC_X((o), SUBPAT) 877 #define SCM_SAL_SUBPAT_META(o) SCM_MISC_Y((o), SUBPAT) 878 #define SCM_SAL_SUBPAT_SET_OBJ(o, p) SCM_MISC_SET_X((o), (p), SUBPAT) 879 #define SCM_SAL_SUBPAT_SET_META(o, m) SCM_MISC_SET_Y((o), (m), SUBPAT) 880 #define SCM_ISAL_SUBPAT_INIT(o, p, m) SCM_MISC_INIT((o), (p), (m), SUBPAT) 881 882 /* Compiled macro. */ 883 SCM_MISC_DECLARE_TYPE(HMACRO, L3(1, 5, 3), 884 SCM_MISC_XTYPE(ScmObj), SCM_MISC_XALIGN_SCMOBJ, 885 SCM_MISC_YTYPE(ScmPackedEnv)); 886 887 #define SCM_HMACRO_PTR(o) SCM_MISC_PTR((o), HMACRO) 888 #define SCM_SAL_HMACROP(o) SCM_MISC_TYPEP((o), HMACRO) 889 #define SCM_SAL_HMACRO_RULES(o) SCM_MISC_X((o), HMACRO) 890 #define SCM_SAL_HMACRO_ENV(o) SCM_MISC_Y((o), HMACRO) 891 #define SCM_SAL_HMACRO_SET_RULES(o, r) SCM_MISC_SET_X((o), (r), HMACRO) 892 #define SCM_SAL_HMACRO_SET_ENV(o, e) SCM_MISC_SET_Y((o), (e), HMACRO) 893 #define SCM_ISAL_HMACRO_INIT(o, r, e) SCM_MISC_INIT((o), (r), (e), HMACRO) 894 895 /* Far symbol. */ 896 SCM_MISC_DECLARE_TYPE(FARSYMBOL, L3(2, 5, 3), 897 SCM_MISC_XTYPE(ScmObj), SCM_MISC_XALIGN_SCMOBJ, 898 SCM_MISC_YTYPE(ScmPackedEnv)); 899 900 #define SCM_FARSYMBOL_PTR(o) SCM_MISC_PTR((o), FARSYMBOL) 901 #define SCM_SAL_FARSYMBOLP(o) SCM_MISC_TYPEP((o), FARSYMBOL) 902 #define SCM_SAL_FARSYMBOL_SYM(o) SCM_MISC_X((o), FARSYMBOL) 903 #define SCM_SAL_FARSYMBOL_ENV(o) SCM_MISC_Y((o), FARSYMBOL) 904 #define SCM_SAL_FARSYMBOL_SET_SYM(o, s) SCM_MISC_SET_X((o), (s), FARSYMBOL) 905 #define SCM_SAL_FARSYMBOL_SET_ENV(o, e) SCM_MISC_SET_Y((o), (e), FARSYMBOL) 906 #define SCM_ISAL_FARSYMBOL_INIT(o, s, e) SCM_MISC_INIT((o), (s), (e), FARSYMBOL) 907 908 #endif /* SCM_USE_HYGIENIC_MACRO */ 909 910 911 /* TODO: If we assume that the GC never marks a free cell (GC takes place until 912 * all freecells are used up), we can leave obj_y untouched. That 913 * optimization, however, has to be coordinated with storage-gc.c. */ 914 #define SCM_MTAG_FREECELL SCM_MAKE_MTAG_L2(7, 3) 915 #define SCM_SAL_FREECELL_NEXT(o) (SCM_X(SCM_DROP_TAG(o))) 916 #define SCM_SAL_FREECELLP(o) \ 917 (!SCM_IMMP(o) && SCM_Y(SCM_DROP_TAG(o)) == SCM_MTAG_FREECELL) 918 919 #define SCM_ISAL_CELL_FREECELLP(c) \ 920 (SCM_Y(c) == SCM_MTAG_FREECELL) 921 #define SCM_ISAL_CELL_RECLAIM_CELL(c, next) \ 922 (SCM_SET_X((c), (next)), \ 923 SCM_SET_Y((c), SCM_MTAG_FREECELL), \ 924 ((ScmObj)(c) | SCM_PTAG_MISC)) 925 926 /* Typecode determination (slow but universally applicable). */ 927 SCM_EXPORT enum ScmObjType scm_type(ScmObj obj); 928 #define SCM_SAL_TYPE scm_type 929 930 931 /*======================================= 932 Object Representation Information 933 =======================================*/ 934 #define SCM_SAL_HAS_CHAR 1 935 #define SCM_SAL_HAS_RATIONAL 0 936 #define SCM_SAL_HAS_REAL 0 937 #define SCM_SAL_HAS_COMPLEX 0 938 #define SCM_SAL_HAS_STRING 1 939 #define SCM_SAL_HAS_VECTOR 1 940 941 #define SCM_SAL_HAS_IMMUTABLE_CONS 0 942 #define SCM_SAL_HAS_IMMUTABLE_STRING 1 943 #define SCM_SAL_HAS_IMMUTABLE_VECTOR 1 944 945 /* for optimization */ 946 #define SCM_SAL_HAS_IMMEDIATE_CHAR_ONLY 1 947 #define SCM_SAL_HAS_IMMEDIATE_NUMBER_ONLY 1 948 #define SCM_SAL_HAS_IMMEDIATE_INT_ONLY 1 949 #define SCM_SAL_HAS_IMMEDIATE_RATIONAL_ONLY 0 950 #define SCM_SAL_HAS_IMMEDIATE_REAL_ONLY 0 951 #define SCM_SAL_HAS_IMMEDIATE_COMPLEX_ONLY 0 952 953 #define SCM_SAL_OBJ_BITS (sizeof(ScmObj) * CHAR_BIT) 954 #define SCM_SAL_PTR_BITS (sizeof(void *) * CHAR_BIT) 955 956 #define SCM_SAL_CHAR_BITS SCM_MIN((SCM_SAL_OBJ_BITS - SCM_CHAR_VAL_OFFSET), \ 957 (sizeof(scm_ichar_t) * CHAR_BIT)) 958 #define SCM_SAL_CHAR_MAX SCM_MIN((scm_ichar_t) \ 959 SCM_MAKE_MASK(0, SCM_SAL_CHAR_BITS), \ 960 SCM_ICHAR_T_MAX) 961 962 #define SCM_SAL_INT_BITS SCM_MIN((SCM_SAL_OBJ_BITS - SCM_INT_VAL_OFFSET), \ 963 (sizeof(scm_int_t) * CHAR_BIT)) 964 #define SCM_SAL_INT_MAX SCM_MIN((scm_int_t) \ 965 (SCM_INT_T_MAX >> SCM_INT_VAL_OFFSET), \ 966 SCM_INT_T_MAX) 967 #define SCM_SAL_INT_MIN SCM_MAX((scm_int_t) \ 968 SCM_ARSHIFT(SCM_INT_T_MIN, \ 969 SCM_INT_VAL_OFFSET), \ 970 SCM_INT_T_MIN) 971 972 /* string length */ 973 #define SCM_SAL_STRLEN_BITS SCM_INT_BITS 974 #define SCM_SAL_STRLEN_MAX SCM_INT_MAX 975 976 /* vector length */ 977 #define SCM_SAL_VECLEN_BITS SCM_INT_BITS 978 #define SCM_SAL_VECLEN_MAX SCM_INT_MAX 979 980 /*=========================================================================== 981 Abstract ScmObj Reference For Storage-Representation Independent Efficient 982 List Operations 983 ===========================================================================*/ 984 typedef ScmObj *ScmRef; 985 #define SCM_SAL_INVALID_REF NULL 986 987 #define SCM_SAL_REF_CAR(cons) (&SCM_X(cons)) 988 #define SCM_SAL_REF_CDR(cons) (&SCM_Y(cons)) 989 #define SCM_SAL_REF_OFF_HEAP(obj) (&(obj)) 990 991 /* SCM_DEREF(ref) is not permitted to be used as lvalue */ 992 #define SCM_SAL_DEREF(ref) (*(ref) + 0) 993 994 /* RFC: Is there a better name? */ 995 #define SCM_SAL_SET(ref, obj) (*(ref) = (ScmObj)(obj)) 996 997 #ifdef __cplusplus 998 /* } */ 999 #endif 1000 1001 #include "storage-common.h" 1002 1003 #endif /* __STORAGE_COMPACT_H */ 1004