Changeset View
Changeset View
Standalone View
Standalone View
b/tests/gpgscm/scheme.c
Context not available. | |||||
␌ | ␌ | ||||
/* Support for immediate values. | /* All types have the LSB set. The garbage collector takes advantage | ||||
* | * of that to identify types. */ | ||||
* Immediate values are tagged with IMMEDIATE_TAG, which is neither | |||||
* used in types, nor in pointer values. | |||||
* | |||||
* XXX: Currently, we only use this to tag pointers in vectors. */ | |||||
#define IMMEDIATE_TAG 1 | |||||
#define is_immediate(p) ((pointer) ((uintptr_t) (p) & IMMEDIATE_TAG)) | |||||
#define set_immediate(p) ((pointer) ((uintptr_t) (p) | IMMEDIATE_TAG)) | |||||
#define clr_immediate(p) ((pointer) ((uintptr_t) (p) & ~IMMEDIATE_TAG)) | |||||
␌ | |||||
enum scheme_types { | enum scheme_types { | ||||
T_STRING=1 << 1, /* Do not use the lsb, it is used for | T_STRING = 1 << 1 | 1, | ||||
* immediate values. */ | T_NUMBER = 2 << 1 | 1, | ||||
T_NUMBER=2 << 1, | T_SYMBOL = 3 << 1 | 1, | ||||
T_SYMBOL=3 << 1, | T_PROC = 4 << 1 | 1, | ||||
T_PROC=4 << 1, | T_PAIR = 5 << 1 | 1, | ||||
T_PAIR=5 << 1, | T_CLOSURE = 6 << 1 | 1, | ||||
T_CLOSURE=6 << 1, | T_CONTINUATION = 7 << 1 | 1, | ||||
T_CONTINUATION=7 << 1, | T_FOREIGN = 8 << 1 | 1, | ||||
T_FOREIGN=8 << 1, | T_CHARACTER = 9 << 1 | 1, | ||||
T_CHARACTER=9 << 1, | T_PORT = 10 << 1 | 1, | ||||
T_PORT=10 << 1, | T_VECTOR = 11 << 1 | 1, | ||||
T_VECTOR=11 << 1, | T_MACRO = 12 << 1 | 1, | ||||
T_MACRO=12 << 1, | T_PROMISE = 13 << 1 | 1, | ||||
T_PROMISE=13 << 1, | T_ENVIRONMENT = 14 << 1 | 1, | ||||
T_ENVIRONMENT=14 << 1, | T_FOREIGN_OBJECT = 15 << 1 | 1, | ||||
T_FOREIGN_OBJECT=15 << 1, | T_BOOLEAN = 16 << 1 | 1, | ||||
T_BOOLEAN=16 << 1, | T_NIL = 17 << 1 | 1, | ||||
T_NIL=17 << 1, | T_EOF_OBJ = 18 << 1 | 1, | ||||
T_EOF_OBJ=18 << 1, | T_SINK = 19 << 1 | 1, | ||||
T_SINK=19 << 1, | T_LAST_SYSTEM_TYPE = 19 << 1 | 1 | ||||
T_LAST_SYSTEM_TYPE=19 << 1 | |||||
}; | }; | ||||
static const char * | static const char * | ||||
Context not available. | |||||
size_t i; | size_t i; | ||||
assert (is_vector (vec)); | assert (is_vector (vec)); | ||||
for(i = 0; i < vector_length(vec); i++) { | for(i = 0; i < vector_length(vec); i++) { | ||||
vec->_object._vector._elements[i] = set_immediate(obj); | vec->_object._vector._elements[i] = obj; | ||||
} | } | ||||
} | } | ||||
INTERFACE static pointer vector_elem(pointer vec, int ielem) { | INTERFACE static pointer vector_elem(pointer vec, int ielem) { | ||||
assert (is_vector (vec)); | assert (is_vector (vec)); | ||||
assert (ielem < vector_length(vec)); | assert (ielem < vector_length(vec)); | ||||
return clr_immediate(vec->_object._vector._elements[ielem]); | return vec->_object._vector._elements[ielem]; | ||||
} | } | ||||
INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a) { | INTERFACE static pointer set_vector_elem(pointer vec, int ielem, pointer a) { | ||||
assert (is_vector (vec)); | assert (is_vector (vec)); | ||||
assert (ielem < vector_length(vec)); | assert (ielem < vector_length(vec)); | ||||
vec->_object._vector._elements[ielem] = set_immediate(a); | vec->_object._vector._elements[ielem] = a; | ||||
return a; | return a; | ||||
} | } | ||||
Context not available. | |||||
if(is_vector(p)) { | if(is_vector(p)) { | ||||
int i; | int i; | ||||
for (i = 0; i < vector_length(p); i++) { | for (i = 0; i < vector_length(p); i++) { | ||||
mark(clr_immediate(p->_object._vector._elements[i])); | mark(p->_object._vector._elements[i]); | ||||
} | } | ||||
} | } | ||||
#if SHOW_ERROR_LINE | #if SHOW_ERROR_LINE | ||||
Context not available. | |||||
for (i = sc->last_cell_seg; i >= 0; i--) { | for (i = sc->last_cell_seg; i >= 0; i--) { | ||||
p = sc->cell_seg[i] + CELL_SEGSIZE; | p = sc->cell_seg[i] + CELL_SEGSIZE; | ||||
while (--p >= sc->cell_seg[i]) { | while (--p >= sc->cell_seg[i]) { | ||||
if (typeflag(p) & IMMEDIATE_TAG) | if ((typeflag(p) & 1) == 0) | ||||
continue; | /* All types have the LSB set. This is not a typeflag. */ | ||||
continue; | |||||
if (is_mark(p)) { | if (is_mark(p)) { | ||||
clrmark(p); | clrmark(p); | ||||
} else { | } else { | ||||
Context not available. |