summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2001-06-23 15:25:57 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2001-06-23 15:25:57 +0000
commit5843e5c98888a6b90d87a39894f42cd76e2be09c (patch)
tree1e5de3bfcea053f6dc5d5c711dd4c9654c008bf4
parent0c02b4080323cd7e8cf8d34121eeda3498028292 (diff)
downloadguile-5843e5c98888a6b90d87a39894f42cd76e2be09c.tar.gz
* Various minor improvements, for example signedness fixes.
-rw-r--r--libguile/ChangeLog26
-rw-r--r--libguile/backtrace.c26
-rw-r--r--libguile/fluids.c5
-rw-r--r--libguile/numbers.c16
-rw-r--r--libguile/objects.c46
-rw-r--r--libguile/pairs.h2
6 files changed, 73 insertions, 48 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 7e7a47703..a1f2041e1 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,29 @@
+2001-06-23 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ * backtrace.c (display_backtrace_body): Use SCM_VALIDATE_STACK
+ and SCM_VALIDATE_OPOUTPORT instead of SCM_ASSERT. Fix signedness
+ problem.
+
+ * backtrace.c (display_expression, scm_set_print_params_x,
+ display_application, display_frame, scm_backtrace), numbers.c
+ (scm_istring2number), objects.c (scm_class_of,
+ scm_mcache_lookup_cmethod, scm_mcache_compute_cmethod): Prefer
+ explicit type check over SCM_N?IMP, !SCM_<pred> over SCM_N<pred>.
+
+ * fluids.c (scm_fluid_ref, scm_fluid_set_x): Fluid numbers are
+ always positive.
+
+ * numbers.c (scm_i_mkbig): Remove unnecessary casts, remove
+ unnecessary SCM_DEFER_INTS, SCM_ALLOW_INTS.
+
+ * objects.c (scm_class_of): Type fix.
+
+ (scm_mcache_lookup_cmethod): Improved comment, simplified,
+ eliminated goto.
+
+ * pairs.h (scm_error_pair_access): The function can return if
+ called recursively.
+
2001-06-20 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
* init.c (scm_init_guile_1): Removed initialization of tag.c.
diff --git a/libguile/backtrace.c b/libguile/backtrace.c
index 0be2d0226..3ab3a29f4 100644
--- a/libguile/backtrace.c
+++ b/libguile/backtrace.c
@@ -154,7 +154,7 @@ display_expression (SCM frame,SCM pname,SCM source,SCM port)
scm_iprin1 (scm_unmemoize (source), port, pstate);
}
}
- else if (SCM_NIMP (source))
+ else if (SCM_MEMOIZEDP (source))
{
scm_puts ("In expression ", port);
pstate->writingp = 1;
@@ -300,7 +300,7 @@ SCM_DEFINE (scm_set_print_params_x, "set-print-params!", 1, 0, 0,
print_params_t *new_params;
SCM_VALIDATE_NONEMPTYLIST_COPYLEN (2, params, n);
- for (ls = params; SCM_NNULLP (ls); ls = SCM_CDR (ls))
+ for (ls = params; !SCM_NULLP (ls); ls = SCM_CDR (ls))
SCM_ASSERT (scm_ilength (SCM_CAR (params)) == 2
&& SCM_INUMP (SCM_CAAR (ls))
&& SCM_INUM (SCM_CAAR (ls)) >= 0
@@ -380,11 +380,11 @@ static void
display_application (SCM frame,int indentation,SCM sport,SCM port,scm_print_state *pstate)
{
SCM proc = SCM_FRAME_PROC (frame);
- SCM name = (SCM_NFALSEP (scm_procedure_p (proc))
+ SCM name = (!SCM_FALSEP (scm_procedure_p (proc))
? scm_procedure_name (proc)
: SCM_BOOL_F);
display_frame_expr ("[",
- scm_cons (SCM_NFALSEP (name) ? name : proc,
+ scm_cons (!SCM_FALSEP (name) ? name : proc,
SCM_FRAME_ARGS (frame)),
SCM_FRAME_EVAL_ARGS_P (frame) ? " ..." : "]",
indentation,
@@ -532,7 +532,7 @@ display_frame (SCM frame,int nfield,int indentation,SCM sport,SCM port,scm_print
}
/* display file name and line number */
- if (SCM_NFALSEP (SCM_SHOW_FILE_NAME))
+ if (!SCM_FALSEP (SCM_SHOW_FILE_NAME))
display_backtrace_file_and_line (frame, port, pstate);
/* Check size of frame number. */
@@ -590,7 +590,7 @@ struct display_backtrace_args {
};
static SCM
-display_backtrace_body(struct display_backtrace_args *a)
+display_backtrace_body (struct display_backtrace_args *a)
#define FUNC_NAME "display_backtrace_body"
{
int n_frames, beg, end, n, i, j;
@@ -602,14 +602,8 @@ display_backtrace_body(struct display_backtrace_args *a)
a->port = SCM_COERCE_OUTPORT (a->port);
/* Argument checking and extraction. */
- SCM_ASSERT (SCM_STACKP (a->stack),
- a->stack,
- SCM_ARG1,
- s_display_backtrace);
- SCM_ASSERT (SCM_OPOUTPORTP (a->port),
- a->port,
- SCM_ARG2,
- s_display_backtrace);
+ SCM_VALIDATE_STACK (1, a->stack);
+ SCM_VALIDATE_OPOUTPORT (2, a->port);
n_frames = SCM_INUM (scm_stack_length (a->stack));
n = SCM_INUMP (a->depth) ? SCM_INUM (a->depth) : SCM_BACKTRACE_DEPTH;
if (SCM_BACKWARDS_P)
@@ -658,6 +652,8 @@ display_backtrace_body(struct display_backtrace_args *a)
indent_p = 0;
else
{
+ unsigned int j;
+
indent_p = 1;
frame = scm_stack_ref (a->stack, SCM_MAKINUM (beg));
for (i = 0, j = 0; i < n; ++i)
@@ -736,7 +732,7 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0,
{
SCM the_last_stack =
scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
- if (SCM_NFALSEP (the_last_stack))
+ if (!SCM_FALSEP (the_last_stack))
{
scm_newline (scm_cur_outp);
scm_puts ("Backtrace:\n", scm_cur_outp);
diff --git a/libguile/fluids.c b/libguile/fluids.c
index 07e944afc..9aba42bf5 100644
--- a/libguile/fluids.c
+++ b/libguile/fluids.c
@@ -149,10 +149,9 @@ SCM_DEFINE (scm_fluid_ref, "fluid-ref", 1, 0, 0,
"@code{#f}.")
#define FUNC_NAME s_scm_fluid_ref
{
- long n;
+ unsigned long int n;
SCM_VALIDATE_FLUID (1, fluid);
-
n = SCM_FLUID_NUM (fluid);
if (SCM_VECTOR_LENGTH (scm_root->fluids) <= n)
@@ -166,7 +165,7 @@ SCM_DEFINE (scm_fluid_set_x, "fluid-set!", 2, 0, 0,
"Set the value associated with @var{fluid} in the current dynamic root.")
#define FUNC_NAME s_scm_fluid_set_x
{
- long n;
+ unsigned long int n;
SCM_VALIDATE_FLUID (1, fluid);
n = SCM_FLUID_NUM (fluid);
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 0beb8b2f0..59bb0007d 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1383,16 +1383,16 @@ SCM
scm_i_mkbig (size_t nlen, int sign)
{
SCM v;
- /* Cast to long int to avoid signed/unsigned comparison warnings. */
- if ((( ((long int) nlen) << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD)
- != (long int) nlen)
+ SCM_BIGDIG *base;
+
+ if (((nlen << SCM_BIGSIZEFIELD) >> SCM_BIGSIZEFIELD) != nlen)
scm_memory_error (s_bignum);
-
+
+ base = scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum);
+
SCM_NEWCELL (v);
- SCM_DEFER_INTS;
- SCM_SET_BIGNUM_BASE (v, scm_must_malloc (nlen * sizeof (SCM_BIGDIG), s_bignum));
+ SCM_SET_BIGNUM_BASE (v, base);
SCM_SETNUMDIGS (v, nlen, sign);
- SCM_ALLOW_INTS;
return v;
}
@@ -2739,7 +2739,7 @@ scm_istring2number (char *str, long len, long radix)
return scm_istr2int (&str[i], len - i, radix);
case 0:
res = scm_istr2int (&str[i], len - i, radix);
- if (SCM_NFALSEP (res))
+ if (!SCM_FALSEP (res))
return res;
case 2:
return scm_istr2flo (&str[i], len - i, radix);
diff --git a/libguile/objects.c b/libguile/objects.c
index a8ece94a3..66401e194 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -158,7 +158,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_smob:
{
- long type = SCM_TYP16 (x);
+ scm_t_bits type = SCM_TYP16 (x);
if (type != scm_tc16_port_with_ps)
return scm_smob_class[SCM_TC2SMOBNUM (type)];
x = SCM_PORT_WITH_PS_PORT (x);
@@ -187,12 +187,12 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
{
/* ordinary struct */
SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x));
- if (SCM_NFALSEP (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
+ if (!SCM_FALSEP (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle));
else
{
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
- SCM class = scm_make_extended_class (SCM_NFALSEP (name)
+ SCM class = scm_make_extended_class (!SCM_FALSEP (name)
? SCM_SYMBOL_CHARS (name)
: 0);
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
@@ -217,10 +217,15 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
}
#undef FUNC_NAME
-/* (SCM_IM_DISPATCH ARGS N-SPECIALIZED
+/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
+ * formats:
+ *
+ * Format #1:
+ * (SCM_IM_DISPATCH ARGS N-SPECIALIZED
* #((TYPE1 ... ENV FORMALS FORM ...) ...)
* GF)
*
+ * Format #2:
* (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
* #((TYPE1 ... ENV FORMALS FORM ...) ...)
* GF)
@@ -256,16 +261,9 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
n = SCM_INUM (SCM_CAR (z)); /* maximum number of specializers */
methods = SCM_CADR (z);
- if (SCM_NIMP (methods))
- {
- /* Prepare for linear search */
- mask = -1;
- i = 0;
- end = SCM_VECTOR_LENGTH (methods);
- }
- else
+ if (SCM_INUMP (methods))
{
- /* Compute a hash value */
+ /* cache format #2: compute a hash value */
long hashset = SCM_INUM (methods);
long j = n;
z = SCM_CDDR (z);
@@ -273,17 +271,24 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
methods = SCM_CADR (z);
i = 0;
ls = args;
- if (SCM_NIMP (ls))
+ if (!SCM_NULLP (ls))
do
{
i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
[scm_si_hashsets + hashset];
ls = SCM_CDR (ls);
}
- while (j-- && SCM_NIMP (ls));
+ while (j-- && !SCM_NULLP (ls));
i &= mask;
end = i;
}
+ else /* SCM_VECTORP (methods) */
+ {
+ /* cache format #1: prepare for linear search */
+ mask = -1;
+ i = 0;
+ end = SCM_VECTOR_LENGTH (methods);
+ }
/* Search for match */
do
@@ -291,7 +296,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
long j = n;
z = SCM_VELTS (methods)[i];
ls = args; /* list of arguments */
- if (SCM_NIMP (ls))
+ if (!SCM_NULLP (ls))
do
{
/* More arguments than specifiers => CLASS != ENV */
@@ -300,11 +305,10 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
ls = SCM_CDR (ls);
z = SCM_CDR (z);
}
- while (j-- && SCM_NIMP (ls));
+ while (j-- && !SCM_NULLP (ls));
/* Fewer arguments than specifiers => CAR != ENV */
- if (!(SCM_IMP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z))))
- goto next_method;
- return z;
+ if (SCM_NULLP (SCM_CAR (z)) || SCM_CONSP (SCM_CAR (z)))
+ return z;
next_method:
i = (i + 1) & mask;
} while (i != end);
@@ -315,7 +319,7 @@ SCM
scm_mcache_compute_cmethod (SCM cache, SCM args)
{
SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
- if (SCM_IMP (cmethod))
+ if (SCM_FALSEP (cmethod))
/* No match - memoize */
return scm_memoize_method (cache, args);
return cmethod;
diff --git a/libguile/pairs.h b/libguile/pairs.h
index 17aa76cd1..2614cf37e 100644
--- a/libguile/pairs.h
+++ b/libguile/pairs.h
@@ -103,7 +103,7 @@
#if (SCM_DEBUG_PAIR_ACCESSES == 1)
-extern void scm_error_pair_access (SCM) SCM_NORETURN;
+extern void scm_error_pair_access (SCM);
#endif
extern SCM scm_cons (SCM x, SCM y);
extern SCM scm_cons2 (SCM w, SCM x, SCM y);