summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-05-19 14:03:44 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-05-19 14:03:44 +0000
commit1a548472dd89674ea96590334d866f6bea6e0bcc (patch)
tree09af7197b8478a4e5e80b21b6de7909977d93e8f
parentbcee10ddd203bf8cf1dd0e899a4a04334c1a0bed (diff)
downloadguile-1a548472dd89674ea96590334d866f6bea6e0bcc.tar.gz
* gc.c (scm_cellp): Fixed and simplified.
* Using double cells to represent jump buffers with debug extensions.
-rw-r--r--libguile/ChangeLog13
-rw-r--r--libguile/gc.c87
-rw-r--r--libguile/gh_data.c10
-rw-r--r--libguile/throw.c27
4 files changed, 49 insertions, 88 deletions
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 <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,
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))
- {
- 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;
- }
+ if (SCM_CELLP (value)) {
+ scm_cell * ptr = SCM2PTR (value);
+ unsigned int i = 0;
+ unsigned int j = scm_n_heap_segs - 1;
+
+ 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;
+ }
+ }
- }
+ 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;
}
- 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);