diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-06-23 15:25:57 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2001-06-23 15:25:57 +0000 |
commit | 5843e5c98888a6b90d87a39894f42cd76e2be09c (patch) | |
tree | 1e5de3bfcea053f6dc5d5c711dd4c9654c008bf4 | |
parent | 0c02b4080323cd7e8cf8d34121eeda3498028292 (diff) | |
download | guile-5843e5c98888a6b90d87a39894f42cd76e2be09c.tar.gz |
* Various minor improvements, for example signedness fixes.
-rw-r--r-- | libguile/ChangeLog | 26 | ||||
-rw-r--r-- | libguile/backtrace.c | 26 | ||||
-rw-r--r-- | libguile/fluids.c | 5 | ||||
-rw-r--r-- | libguile/numbers.c | 16 | ||||
-rw-r--r-- | libguile/objects.c | 46 | ||||
-rw-r--r-- | libguile/pairs.h | 2 |
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); |