mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* gc.c (scm_cellp): Fixed and simplified.

Browse source 
* Using double cells to represent jump buffers with debug extensions.
This commit is contained in:
Dirk Herrmann 2000-05-19 14:03:44 +00:00
parent bcee10ddd2
commit 1a548472dd
4 changed files with 49 additions and 88 deletions
Download patch file Download diff file Expand all files Collapse all files

13
libguile/ChangeLog
View file

@ -1,3 +1,16 @@
2000-05-19 Dirk Herrmann <D.Herrmann@tu-bs.de>
* 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 <D.Herrmann@tu-bs.de>
* gh.h gh_data.c gh_funcs.c (gh_new_procedure*, gh_chars2byvect,

87
libguile/gc.c
View file

@ -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;
}
}

10
libguile/gh_data.c
View file

@ -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))
{

27
libguile/throw.c
View file

@ -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);