diff --git a/libguile/ChangeLog b/libguile/ChangeLog index b52760644..c1686f626 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,16 @@ +2000-05-19 Dirk Herrmann + + * gh_data.c (gh_scm2chars, gh_scm2shorts, gh_scm2longs, + gh_scm2floats, gh_scm2doubles): Change !SCM_NIMP to SCM_IMP. + + * gc.c (scm_cellp): Fixed and simplified. + + * throw.c (JBJMPBUF, SETJBJMPBUF, SCM_JBDFRAME, SCM_SETJBDFRAME, + make_jmpbuf, scm_init_throw): Now using double cells to represent + jump buffers when using debug extensions. + + (freejb): Removed. + 2000-05-18 Dirk Herrmann * gh.h gh_data.c gh_funcs.c (gh_new_procedure*, gh_chars2byvect, diff --git a/libguile/gc.c b/libguile/gc.c index baedf210f..d546516f0 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -1454,71 +1454,38 @@ scm_mark_locations (SCM_STACKITEM x[], scm_sizet n) } -/* The following is a C predicate which determines if an SCM value can be - regarded as a pointer to a cell on the heap. The code is duplicated - from scm_mark_locations. */ - - +/* The function scm_cellp determines whether an SCM value can be regarded as a + * pointer to a cell on the heap. Binary search is used in order to determine + * the heap segment that contains the cell. + */ int scm_cellp (SCM value) { - register int i, j; - register SCM_CELLPTR ptr; + if (SCM_CELLP (value)) { + scm_cell * ptr = SCM2PTR (value); + unsigned int i = 0; + unsigned int j = scm_n_heap_segs - 1; - if (SCM_CELLP (value)) - { - ptr = SCM2PTR (value); - i = 0; - j = scm_n_heap_segs - 1; - if ( SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr) - && SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr)) - { - while (i <= j) - { - int seg_id; - seg_id = -1; - if ( (i == j) - || SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr)) - seg_id = i; - else if (SCM_PTR_LE (scm_heap_table[j].bounds[0], ptr)) - seg_id = j; - else - { - int k; - k = (i + j) / 2; - if (k == i) - break; - if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) - { - j = k; - ++i; - if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)) - continue; - else - break; - } - else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) - { - i = k; - --j; - if (SCM_PTR_GT (scm_heap_table[j].bounds[1], ptr)) - continue; - else - break; - } - } - if (!scm_heap_table[seg_id].valid - || scm_heap_table[seg_id].valid (ptr, - &scm_heap_table[seg_id])) - if (scm_heap_table[seg_id].span == 1 - || SCM_DOUBLE_CELLP (value)) - scm_gc_mark (value); - break; - } - - } + while (i < j) { + int k = (i + j) / 2; + if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) { + j = k; + } else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) { + i = k + 1; + } } - return 0; + + if (SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr) + && SCM_PTR_GT (scm_heap_table[i].bounds[1], ptr) + && (!scm_heap_table[i].valid || scm_heap_table[i].valid (ptr, &scm_heap_table[i])) + && (scm_heap_table[i].span == 1 || SCM_DOUBLE_CELLP (value))) { + return 1; + } else { + return 0; + } + } else { + return 0; + } } diff --git a/libguile/gh_data.c b/libguile/gh_data.c index 893609727..5ba9a42aa 100644 --- a/libguile/gh_data.c +++ b/libguile/gh_data.c @@ -268,7 +268,7 @@ gh_scm2chars (SCM obj, char *m) int i, n; long v; SCM val; - if (!SCM_NIMP (obj)) + if (SCM_IMP (obj)) scm_wrong_type_arg (0, 0, obj); switch (SCM_TYP7 (obj)) { @@ -316,7 +316,7 @@ gh_scm2shorts (SCM obj, short *m) int i, n; long v; SCM val; - if (!SCM_NIMP (obj)) + if (SCM_IMP (obj)) scm_wrong_type_arg (0, 0, obj); switch (SCM_TYP7 (obj)) { @@ -361,7 +361,7 @@ gh_scm2longs (SCM obj, long *m) { int i, n; SCM val; - if (!SCM_NIMP (obj)) + if (SCM_IMP (obj)) scm_wrong_type_arg (0, 0, obj); switch (SCM_TYP7 (obj)) { @@ -404,7 +404,7 @@ gh_scm2floats (SCM obj, float *m) { int i, n; SCM val; - if (!SCM_NIMP (obj)) + if (SCM_IMP (obj)) scm_wrong_type_arg (0, 0, obj); switch (SCM_TYP7 (obj)) { @@ -460,7 +460,7 @@ gh_scm2doubles (SCM obj, double *m) { int i, n; SCM val; - if (!SCM_NIMP (obj)) + if (SCM_IMP (obj)) scm_wrong_type_arg (0, 0, obj); switch (SCM_TYP7 (obj)) { diff --git a/libguile/throw.c b/libguile/throw.c index c63007547..78be35a4e 100644 --- a/libguile/throw.c +++ b/libguile/throw.c @@ -74,21 +74,11 @@ static int scm_tc16_jmpbuffer; #define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L))) #define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L))) -#ifndef DEBUG_EXTENSIONS #define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ)) #define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v))) -#else -#define SCM_JBDFRAME(x) ((scm_debug_frame *) SCM_CELL_WORD_0 (SCM_CDR (x))) -#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (SCM_CDR (OBJ))) -#define SCM_SETJBDFRAME(OBJ,X) (SCM_SET_CELL_WORD_0 (SCM_CDR (OBJ), (X))) -#define SETJBJMPBUF(OBJ,X) (SCM_SET_CELL_WORD_1 (SCM_CDR (OBJ), (X))) - -static scm_sizet -freejb (SCM jbsmob) -{ - scm_must_free ((char *) SCM_CELL_WORD_1 (jbsmob)); - return sizeof (scm_cell); -} +#ifdef DEBUG_EXTENSIONS +#define SCM_JBDFRAME(x) ((scm_debug_frame *) SCM_CELL_WORD_2 (x)) +#define SCM_SETJBDFRAME(x,v) (SCM_SET_CELL_WORD_2 ((x), (v))) #endif static int @@ -110,10 +100,7 @@ make_jmpbuf (void) SCM_REDEFER_INTS; { #ifdef DEBUG_EXTENSIONS - char *mem = scm_must_malloc (sizeof (scm_cell), "jb"); -#endif -#ifdef DEBUG_EXTENSIONS - SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, mem); + SCM_NEWSMOB2 (answer, scm_tc16_jmpbuffer, 0, 0); #else SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, 0); #endif @@ -715,15 +702,9 @@ void scm_init_throw () { scm_tc16_jmpbuffer = scm_make_smob_type_mfpe ("jmpbuffer", -#ifdef DEBUG_EXTENSIONS - sizeof (scm_cell), - NULL, /* mark */ - freejb, -#else 0, NULL, /* mark */ NULL, -#endif printjb, NULL);