mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
* Fix signedness plus some minor improvements.
This commit is contained in:
Dirk Herrmann
parent
5f5dc92966
commit
13dcb66612
4 changed files with 127 additions and 82 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue