* Fix signedness plus some minor improvements.

libguile/ChangeLog

@@ -1,3 +1,31 @@
+2001-06-25  Dirk Herrmann  <D.Herrmann@tu-bs.de>
+
+	* debug.h (SCM_DEBUGOBJ_FRAME):  Deliver result as a
+	scm_t_debug_frame*.
+
+	* debug.h (DEBUGH, SCM_DEBUG_H), stacks.h (STACKSH, SCM_STACKSH):
+	Rename <foo>H to SCM_<foo>_H.
+
+	* stacks.c (NEXT_FRAME, narrow_stack):  Prefer explicit type check
+	over SCM_N?IMP, !SCM_<pred> over SCM_N<pred>.
+
+	(narrow_stack):  Make i unsigned.  Don't use side-effecting
+	operations in conditions.
+
+	(narrow_stack, scm_make_stack, scm_stack_id,
+	scm_last_stack_frame):  Get rid of redundant SCM_N?IMP checks.
+
+	(scm_make_stack, scm_stack_id, scm_last_stack_frame):  Clean up
+	type dispatch.  No need to cast result of SCM_DEBUGOBJ_FRAME any
+	more.
+
+	(scm_stack_ref, scm_frame_previous, scm_frame_next):  Fix
+	signedness.
+
+	(scm_last_stack_frame):  Remove bogus `;´.
+
+	* stacks.h (SCM_FRAMEP):  Fix type check.
+
 2001-06-25  Michael Livshin  <mlivshin@bigfoot.com>
 
 	* Makefile.am (MAINTAINERCLEANFILES): be sure to remove

libguile/debug.h

@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef DEBUGH
+#ifndef SCM_DEBUG_H
-#define DEBUGH
+#define SCM_DEBUG_H
-/*	Copyright (C) 1995,1996,1998, 1999, 2000 Free Software Foundation
+/* Copyright (C) 1995,1996,1998,1999,2000,2001 Free Software Foundation
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -172,8 +172,10 @@ extern scm_t_debug_frame *scm_last_debug_frame;
 
 extern scm_t_bits scm_tc16_debugobj;
 
-#define SCM_DEBUGOBJP(x)              SCM_TYP16_PREDICATE (scm_tc16_debugobj, x)
+#define SCM_DEBUGOBJP(x) \
-#define SCM_DEBUGOBJ_FRAME(x)         SCM_CELL_WORD_1 (x)
+  SCM_TYP16_PREDICATE (scm_tc16_debugobj, x)
+#define SCM_DEBUGOBJ_FRAME(x) \
+  ((scm_t_debug_frame *) SCM_CELL_WORD_1 (x))
 #define SCM_SET_DEBUGOBJ_FRAME(x, f)  SCM_SET_CELL_WORD_1 (x, f)
 
 /* {Memoized Source}
@@ -217,7 +219,7 @@ extern SCM scm_proc_to_mem (SCM obj);
 extern SCM scm_debug_hang (SCM obj);
 #endif /*GUILE_DEBUG*/
 
-#endif /* DEBUGH */
+#endif /* SCM_DEBUG_H */
 
 /*
   Local Variables:

libguile/stacks.c

@@ -1,5 +1,5 @@
 /* Representation of stack frame debug information
- * Copyright (C) 1996,1997, 2000 Free Software Foundation
+ * Copyright (C) 1996,1997,2000,2001 Free Software Foundation
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -230,7 +230,7 @@ get_applybody ()
 
 #define NEXT_FRAME(iframe, n, quit) \
 do { \
-  if (SCM_NIMP (iframe->source) \
+  if (SCM_MEMOIZEDP (iframe->source) \
       && SCM_EQ_P (SCM_MEMOIZED_EXP (iframe->source), applybody)) \
     { \
       iframe->source = SCM_BOOL_F; \
@@ -280,7 +280,8 @@ read_frames (scm_t_debug_frame *dframe,long offset,long n,scm_t_info_frame *ifra
 	  if ((info - dframe->vect) & 1)
 	    --info;
 	  /* Data in the apply part of an eval info frame comes from
-	     previous stack frame if the scm_t_debug_info vector is overflowed. */
+	     previous stack frame if the scm_t_debug_info vector is
+	     overflowed. */
 	  else if (SCM_OVERFLOWP (*dframe)
 		   && !SCM_UNBNDP (info[1].a.proc))
 	    {
@@ -348,28 +349,33 @@ static void
 narrow_stack (SCM stack,long inner,SCM inner_key,long outer,SCM outer_key)
 {
   scm_t_stack *s = SCM_STACK (stack);
-  long i;
+  unsigned long int i;
   long n = s->length;
   
   /* Cut inner part. */
   if (SCM_EQ_P (inner_key, SCM_BOOL_T))
-    /* Cut all frames up to user module code */
     {
+      /* Cut all frames up to user module code */
       for (i = 0; inner; ++i, --inner)
 	{
 	  SCM m = s->frames[i].source;
 	  if (SCM_MEMOIZEDP (m)
-	      && SCM_NIMP (SCM_MEMOIZED_ENV (m))
+	      && !SCM_IMP (SCM_MEMOIZED_ENV (m))
 	      && SCM_FALSEP (scm_system_module_env_p (SCM_MEMOIZED_ENV (m))))
 	    {
 	      /* Back up in order to include any non-source frames */
-	      while (i > 0
+	      while (i > 0)
-		     && !((m = s->frames[i - 1].source, SCM_MEMOIZEDP (m))
-			  || (SCM_NIMP (m = s->frames[i - 1].proc)
-			      && SCM_NFALSEP (scm_procedure_p (m))
-			      && SCM_NFALSEP (scm_procedure_property
-					      (m, scm_sym_system_procedure)))))
 		{
+		  m = s->frames[i - 1].source;
+		  if (SCM_MEMOIZEDP (m))
+		    break;
+
+		  m = s->frames[i - 1].proc;
+		  if (!SCM_FALSEP (scm_procedure_p (m))
+		      && !SCM_FALSEP (scm_procedure_property
+				      (m, scm_sym_system_procedure)))
+		    break;
+
 		  --i;
 		  ++inner;
 		}
@@ -423,7 +429,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
 {
   long n, size;
   int maxp;
-  scm_t_debug_frame *dframe = scm_last_debug_frame;
+  scm_t_debug_frame *dframe;
   scm_t_info_frame *iframe;
   long offset = 0;
   SCM stack, id;
@@ -431,13 +437,14 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
 
   /* Extract a pointer to the innermost frame of whatever object
      scm_make_stack was given.  */
-  /* just use dframe == scm_last_debug_frame 
+  if (SCM_EQ_P (obj, SCM_BOOL_T))
-     (from initialization of dframe, above) if obj is #t */
-  if (!SCM_EQ_P (obj, SCM_BOOL_T))
     {
-      SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME);
+      dframe = scm_last_debug_frame;
-      if (SCM_DEBUGOBJP (obj))
+    }
-	dframe = (scm_t_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
+  else if (SCM_DEBUGOBJP (obj))
+    {
+      dframe = SCM_DEBUGOBJ_FRAME (obj);
+    }
   else if (SCM_CONTINUATIONP (obj))
     {
       offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs))
@@ -452,7 +459,6 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
       SCM_WRONG_TYPE_ARG (SCM_ARG1, obj);
       /* not reached */
     }
-    }
 
   /* Count number of frames.  Also get stack id tag and check whether
      there are more stackframes than we want to record
@@ -516,12 +522,13 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
   scm_t_debug_frame *dframe;
   long offset = 0;
   if (SCM_EQ_P (stack, SCM_BOOL_T))
-    dframe = scm_last_debug_frame;
-  else
     {
-      SCM_VALIDATE_NIM (1,stack);
+      dframe = scm_last_debug_frame;
-      if (SCM_DEBUGOBJP (stack))
+    }
-	dframe = (scm_t_debug_frame *) SCM_DEBUGOBJ_FRAME (stack);
+  else if (SCM_DEBUGOBJP (stack))
+    {
+      dframe = SCM_DEBUGOBJ_FRAME (stack);
+    }
   else if (SCM_CONTINUATIONP (stack))
     {
       offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_t_contregs))
@@ -532,10 +539,14 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
       dframe = RELOC_FRAME (SCM_DFRAME (stack), offset);
     }
   else if (SCM_STACKP (stack))
+    {
       return SCM_STACK (stack) -> id;
+    }
   else
+    {
       SCM_WRONG_TYPE_ARG (1, stack);
     }
+
   while (dframe && !SCM_VOIDFRAMEP (*dframe))
     dframe = RELOC_FRAME (dframe->prev, offset);
   if (dframe && SCM_VOIDFRAMEP (*dframe))
@@ -545,16 +556,18 @@ SCM_DEFINE (scm_stack_id, "stack-id", 1, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_stack_ref, "stack-ref", 2, 0, 0,
-            (SCM stack, SCM i),
+            (SCM stack, SCM index),
-	    "Return the @var{i}'th frame from @var{stack}.")
+	    "Return the @var{index}'th frame from @var{stack}.")
 #define FUNC_NAME s_scm_stack_ref
 {
+  unsigned long int c_index;
+
   SCM_VALIDATE_STACK (1, stack);
-  SCM_VALIDATE_INUM (2,i);
+  SCM_VALIDATE_INUM (2, index);
-  SCM_ASSERT_RANGE (1,i,
+  SCM_ASSERT_RANGE (1, index, SCM_INUM (index) >= 0);
-                    SCM_INUM (i) >= 0 && 
+  c_index = SCM_INUM (index);
-                    SCM_INUM (i) < SCM_STACK_LENGTH (stack));
+  SCM_ASSERT_RANGE (1, index, c_index < SCM_STACK_LENGTH (stack));
-  return scm_cons (stack, i);
+  return scm_cons (stack, index);
 }
 #undef FUNC_NAME
 
@@ -591,9 +604,10 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
   long offset = 0;
   SCM stack;
   
-  SCM_VALIDATE_NIM (1,obj);
   if (SCM_DEBUGOBJP (obj))
-    dframe = (scm_t_debug_frame *) SCM_DEBUGOBJ_FRAME (obj);
+    {
+      dframe = SCM_DEBUGOBJ_FRAME (obj);
+    }
   else if (SCM_CONTINUATIONP (obj))
     {
       offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs))
@@ -619,7 +633,7 @@ SCM_DEFINE (scm_last_stack_frame, "last-stack-frame", 1, 0, 0,
   read_frame (dframe, offset,
 	      (scm_t_info_frame *) &SCM_STACK (stack) -> frames[0]);
   
-  return scm_cons (stack, SCM_INUM0);;
+  return scm_cons (stack, SCM_INUM0);
 }
 #undef FUNC_NAME
 
@@ -672,7 +686,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
 	    "@var{frame} is the first frame in its stack.")
 #define FUNC_NAME s_scm_frame_previous
 {
-  long n;
+  unsigned long int n;
   SCM_VALIDATE_FRAME (1, frame);
   n = SCM_INUM (SCM_CDR (frame)) + 1;
   if (n >= SCM_STACK_LENGTH (SCM_CAR (frame)))
@@ -688,13 +702,13 @@ SCM_DEFINE (scm_frame_next, "frame-next", 1, 0, 0,
 	    "@var{frame} is the last frame in its stack.")
 #define FUNC_NAME s_scm_frame_next
 {
-  long n;
+  unsigned long int n;
   SCM_VALIDATE_FRAME (1, frame);
-  n = SCM_INUM (SCM_CDR (frame)) - 1;
+  n = SCM_INUM (SCM_CDR (frame));
-  if (n < 0)
+  if (n == 0)
     return SCM_BOOL_F;
   else
-    return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n));
+    return scm_cons (SCM_CAR (frame), SCM_MAKINUM (n - 1));
 }
 #undef FUNC_NAME
 

libguile/stacks.h

@@ -1,8 +1,8 @@
 /* classes: h_files */
 
-#ifndef STACKSH
+#ifndef SCM_STACKS_H
-#define STACKSH
+#define SCM_STACKS_H
-/*	Copyright (C) 1995,1996, 2000 Free Software Foundation
+/* Copyright (C) 1995,1996,2000,2001 Free Software Foundation
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -84,10 +84,11 @@ extern SCM scm_t_stackype;
 #define SCM_STACKP(obj) (SCM_STRUCTP (obj) && SCM_EQ_P (SCM_STRUCT_VTABLE (obj), scm_t_stackype))
 #define SCM_STACK_LENGTH(stack) (SCM_STACK (stack) -> length)
 
-#define SCM_FRAMEP(obj) (SCM_CONSP (obj) \
+#define SCM_FRAMEP(obj) \
-			 && SCM_STACKP (SCM_CAR (obj)) \
+  (SCM_CONSP (obj) && SCM_STACKP (SCM_CAR (obj)) \
-			 && SCM_INUMP (SCM_CDR (obj))) \
+   && SCM_INUMP (SCM_CDR (obj)) && SCM_INUM (SCM_CDR (obj)) >= 0 \
-
+   && ((unsigned long int) SCM_INUM (SCM_CDR (obj)) \
+       < SCM_STACK_LENGTH (SCM_CAR (obj))))
 
 #define SCM_FRAME_REF(frame, slot) \
 (SCM_STACK (SCM_CAR (frame)) -> frames[SCM_INUM (SCM_CDR (frame))].slot) \
@@ -142,7 +143,7 @@ SCM scm_frame_overflow_p (SCM frame);
 
 void scm_init_stacks (void);
 
-#endif /* STACKSH */
+#endif /* SCM_STACKS_H */
 
 /*
   Local Variables: