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

* Using double cells to represent jump buffers with debug extensions.

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,

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
+/* The function scm_cellp determines whether an SCM value can be regarded as a
-   regarded as a pointer to a cell on the heap.  The code is duplicated
+ * pointer to a cell on the heap.  Binary search is used in order to determine
-   from scm_mark_locations.  */
+ * the heap segment that contains the cell.
-
+ */
-
 int
 scm_cellp (SCM value)
 {
-  register int i, j;
+  if (SCM_CELLP (value)) {
-  register SCM_CELLPTR ptr;
+    scm_cell * ptr = SCM2PTR (value);
+    unsigned int i = 0;
+    unsigned int j = scm_n_heap_segs - 1;
 
-  if (SCM_CELLP (value))
+    while (i < j) {
-    {
+      int k = (i + j) / 2;
-      ptr = SCM2PTR (value);
+      if (SCM_PTR_GT (scm_heap_table[k].bounds[1], ptr)) {
-      i = 0;
+	j = k;
-      j = scm_n_heap_segs - 1;
+      } else if (SCM_PTR_LE (scm_heap_table[k].bounds[0], ptr)) {
-      if (   SCM_PTR_LE (scm_heap_table[i].bounds[0], ptr)
+	i = k + 1;
-	     && 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;
-	    }
-
-	}
     }
-  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;
+  }
 }
 
 

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

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
+#ifdef DEBUG_EXTENSIONS
-#define SCM_JBDFRAME(x)         ((scm_debug_frame *) SCM_CELL_WORD_0 (SCM_CDR (x)))
+#define SCM_JBDFRAME(x)         ((scm_debug_frame *) SCM_CELL_WORD_2 (x))
-#define JBJMPBUF(OBJ)           ((jmp_buf *) SCM_CELL_WORD_1 (SCM_CDR (OBJ)))
+#define SCM_SETJBDFRAME(x,v)    (SCM_SET_CELL_WORD_2 ((x), (v)))
-#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);
-}
 #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");
+    SCM_NEWSMOB2 (answer, scm_tc16_jmpbuffer, 0, 0);
-#endif
-#ifdef DEBUG_EXTENSIONS
-    SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, mem);
 #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);