diff --git a/libguile/ChangeLog b/libguile/ChangeLog index d758893df..d5233dc80 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,31 @@ +2001-06-25 Dirk Herrmann + + * 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 H to SCM__H. + + * stacks.c (NEXT_FRAME, narrow_stack): Prefer explicit type check + over SCM_N?IMP, !SCM_ over SCM_N. + + (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 * Makefile.am (MAINTAINERCLEANFILES): be sure to remove diff --git a/libguile/debug.h b/libguile/debug.h index 10a0cf69c..16d09510a 100644 --- a/libguile/debug.h +++ b/libguile/debug.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef DEBUGH -#define DEBUGH -/* Copyright (C) 1995,1996,1998, 1999, 2000 Free Software Foundation +#ifndef SCM_DEBUG_H +#define SCM_DEBUG_H +/* 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_DEBUGOBJ_FRAME(x) SCM_CELL_WORD_1 (x) +#define SCM_DEBUGOBJP(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: diff --git a/libguile/stacks.c b/libguile/stacks.c index 42242f032..3b6387b1f 100644 --- a/libguile/stacks.c +++ b/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)) + if (SCM_MEMOIZEDP (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 - && !((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))))) + while (i > 0) { + 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,27 +437,27 @@ 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 - (from initialization of dframe, above) if obj is #t */ - if (!SCM_EQ_P (obj, SCM_BOOL_T)) + if (SCM_EQ_P (obj, SCM_BOOL_T)) { - SCM_ASSERT (SCM_NIMP (obj), obj, SCM_ARG1, FUNC_NAME); - if (SCM_DEBUGOBJP (obj)) - dframe = (scm_t_debug_frame *) SCM_DEBUGOBJ_FRAME (obj); - else if (SCM_CONTINUATIONP (obj)) - { - offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (obj) + sizeof (scm_t_contregs)) - - SCM_BASE (obj)); + dframe = scm_last_debug_frame; + } + 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)) + - SCM_BASE (obj)); #ifndef STACK_GROWS_UP - offset += SCM_CONTINUATION_LENGTH (obj); + offset += SCM_CONTINUATION_LENGTH (obj); #endif - dframe = RELOC_FRAME (SCM_DFRAME (obj), offset); - } - else - { - SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); - /* not reached */ - } + dframe = RELOC_FRAME (SCM_DFRAME (obj), offset); + } + else + { + SCM_WRONG_TYPE_ARG (SCM_ARG1, obj); + /* not reached */ } /* Count number of frames. Also get stack id tag and check whether @@ -480,7 +486,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1, args = SCM_CDR (args); if (SCM_NULLP (args)) { - outer_cut = SCM_INUM0; + outer_cut = SCM_INUM0; } else { @@ -516,26 +522,31 @@ 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; + { + dframe = scm_last_debug_frame; + } + 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)) + - SCM_BASE (stack)); +#ifndef STACK_GROWS_UP + offset += SCM_CONTINUATION_LENGTH (stack); +#endif + dframe = RELOC_FRAME (SCM_DFRAME (stack), offset); + } + else if (SCM_STACKP (stack)) + { + return SCM_STACK (stack) -> id; + } else { - SCM_VALIDATE_NIM (1,stack); - if (SCM_DEBUGOBJP (stack)) - dframe = (scm_t_debug_frame *) SCM_DEBUGOBJ_FRAME (stack); - else if (SCM_CONTINUATIONP (stack)) - { - offset = ((SCM_STACKITEM *) ((char *) SCM_CONTREGS (stack) + sizeof (scm_t_contregs)) - - SCM_BASE (stack)); -#ifndef STACK_GROWS_UP - offset += SCM_CONTINUATION_LENGTH (stack); -#endif - dframe = RELOC_FRAME (SCM_DFRAME (stack), offset); - } - else if (SCM_STACKP (stack)) - return SCM_STACK (stack) -> id; - else - SCM_WRONG_TYPE_ARG (1, stack); + 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), - "Return the @var{i}'th frame from @var{stack}.") + (SCM stack, SCM index), + "Return the @var{index}'th frame from @var{stack}.") #define FUNC_NAME s_scm_stack_ref { - SCM_VALIDATE_STACK (1,stack); - SCM_VALIDATE_INUM (2,i); - SCM_ASSERT_RANGE (1,i, - SCM_INUM (i) >= 0 && - SCM_INUM (i) < SCM_STACK_LENGTH (stack)); - return scm_cons (stack, i); + unsigned long int c_index; + + SCM_VALIDATE_STACK (1, stack); + SCM_VALIDATE_INUM (2, index); + SCM_ASSERT_RANGE (1, index, SCM_INUM (index) >= 0); + c_index = SCM_INUM (index); + SCM_ASSERT_RANGE (1, index, c_index < SCM_STACK_LENGTH (stack)); + 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,8 +686,8 @@ 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; - SCM_VALIDATE_FRAME (1,frame); + unsigned long int n; + SCM_VALIDATE_FRAME (1, frame); n = SCM_INUM (SCM_CDR (frame)) + 1; if (n >= SCM_STACK_LENGTH (SCM_CAR (frame))) return SCM_BOOL_F; @@ -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; - SCM_VALIDATE_FRAME (1,frame); - n = SCM_INUM (SCM_CDR (frame)) - 1; - if (n < 0) + unsigned long int n; + SCM_VALIDATE_FRAME (1, frame); + n = SCM_INUM (SCM_CDR (frame)); + 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 diff --git a/libguile/stacks.h b/libguile/stacks.h index b034bb368..58b83ff80 100644 --- a/libguile/stacks.h +++ b/libguile/stacks.h @@ -1,8 +1,8 @@ /* classes: h_files */ -#ifndef STACKSH -#define STACKSH -/* Copyright (C) 1995,1996, 2000 Free Software Foundation +#ifndef SCM_STACKS_H +#define SCM_STACKS_H +/* 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) \ - && SCM_STACKP (SCM_CAR (obj)) \ - && SCM_INUMP (SCM_CDR (obj))) \ - +#define SCM_FRAMEP(obj) \ + (SCM_CONSP (obj) && SCM_STACKP (SCM_CAR (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: