diff options
author | Greg J. Badros <gjb@cs.washington.edu> | 2000-03-09 21:48:25 +0000 |
---|---|---|
committer | Greg J. Badros <gjb@cs.washington.edu> | 2000-03-09 21:48:25 +0000 |
commit | 41b0806d3ed1c6e11fcae8e09b161f320137a73b (patch) | |
tree | 0f3438113efe9db300637708cfb679657c3ce836 | |
parent | 7ac030d6de0e8fad668851f5c42f9869cc2b1b3f (diff) | |
download | guile-41b0806d3ed1c6e11fcae8e09b161f320137a73b.tar.gz |
* vectors.h (SCM_VELTS_AS_STACKITEMS): Added this macro to help in
eliminating some warnings.
* unif.c, strports.c, print.c, options.c: Fix some warnings on
mis-use of SCM/long
* gc.c, gc.h: Added scm_return_first_int(), and added comment re:
what the scm_return_first* functions do.
-rw-r--r-- | libguile/gc.c | 17 | ||||
-rw-r--r-- | libguile/gc.h | 1 | ||||
-rw-r--r-- | libguile/options.c | 6 | ||||
-rw-r--r-- | libguile/print.c | 2 | ||||
-rw-r--r-- | libguile/strports.c | 2 | ||||
-rw-r--r-- | libguile/unif.c | 7 | ||||
-rw-r--r-- | libguile/vectors.h | 1 |
7 files changed, 25 insertions, 11 deletions
diff --git a/libguile/gc.c b/libguile/gc.c index 5d3fc5bd9..38f8bc6d0 100644 --- a/libguile/gc.c +++ b/libguile/gc.c @@ -755,7 +755,7 @@ gc_mark_nimp: (ptr) break; SCM_SETGC8MARK (ptr); if (SCM_VELTS (ptr)) - scm_mark_locations (SCM_VELTS (ptr), + scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr), (scm_sizet) (SCM_LENGTH (ptr) + (sizeof (SCM_STACKITEM) + -1 + @@ -1809,14 +1809,25 @@ scm_remember (SCM *ptr) /* - What the heck is this? --hwn - */ + These crazy functions prevent garbage collection + of arguments after the first argument by + ensuring they remain live throughout the + function because they are used in the last + line of the code block. + It'd be better to have a nice compiler hint to + aid the conservative stack-scanning GC. --03/09/00 gjb */ SCM scm_return_first (SCM elt, ...) { return elt; } +int +scm_return_first_int (int i, ...) +{ + return i; +} + SCM scm_permanent_object (SCM obj) diff --git a/libguile/gc.h b/libguile/gc.h index d971caa89..40f95166c 100644 --- a/libguile/gc.h +++ b/libguile/gc.h @@ -107,6 +107,7 @@ extern void scm_done_malloc (long size); extern void scm_must_free (void *obj); extern void scm_remember (SCM * ptr); extern SCM scm_return_first (SCM elt, ...); +extern int scm_return_first_int (int x, ...); extern SCM scm_permanent_object (SCM obj); extern SCM scm_protect_object (SCM obj); extern SCM scm_unprotect_object (SCM obj); diff --git a/libguile/options.c b/libguile/options.c index ed6ab3c9c..f051c1db9 100644 --- a/libguile/options.c +++ b/libguile/options.c @@ -201,8 +201,8 @@ scm_options (SCM arg, scm_option options[], int n, const char *s) // scm_option doesn't know if its a long or an SCM if (options[i].type == SCM_OPTION_SCM) SCM_SETCDR (protected_objects, - scm_cons (flags[i], - scm_delq1_x (options[i].val, + scm_cons (SCM_ASSCM(flags[i]), + scm_delq1_x (SCM_ASSCM(options[i].val), SCM_CDR (protected_objects)))); options[i].val = flags[i]; } @@ -224,7 +224,7 @@ scm_init_opts (SCM (*func) (SCM), scm_option options[], int n) (options[i].doc)); if (options[i].type == SCM_OPTION_SCM) SCM_SETCDR (protected_objects, - scm_cons (options[i].val, SCM_CDR (protected_objects))); + scm_cons (SCM_ASSCM(options[i].val), SCM_CDR (protected_objects))); } func (SCM_UNDEFINED); } diff --git a/libguile/print.c b/libguile/print.c index 7329c0276..ad88546c5 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -123,7 +123,7 @@ char *scm_isymnames[] = }; scm_option scm_print_opts[] = { - { SCM_OPTION_SCM, "closure-hook", SCM_BOOL_F, + { SCM_OPTION_SCM, "closure-hook", SCM_ASWORD(SCM_BOOL_F), "Hook for printing closures." }, { SCM_OPTION_BOOLEAN, "source", 0, "Print closures with source." } diff --git a/libguile/strports.c b/libguile/strports.c index 8c814c8bb..41335f978 100644 --- a/libguile/strports.c +++ b/libguile/strports.c @@ -83,7 +83,7 @@ stfill_buffer (SCM port) if (pt->read_pos >= pt->read_end) return EOF; else - return scm_return_first (*pt->read_pos, port); /* huh? -- hwn*/ + return scm_return_first_int (*pt->read_pos, port); } /* change the size of a port's string to new_size. this doesn't diff --git a/libguile/unif.c b/libguile/unif.c index 8af679e95..de32a8112 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -1920,6 +1920,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, { register long i, vlen, count = 0; register unsigned long k; + int fObj = 0; SCM_ASRTGO (SCM_NIMP (v), badarg1); SCM_ASRTGO (SCM_NIMP (kv), badarg2); @@ -1962,9 +1963,9 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, if (0 == SCM_LENGTH (v)) return SCM_INUM0; SCM_ASRTGO (SCM_BOOL_T == obj || SCM_BOOL_F == obj, badarg3); - obj = (SCM_BOOL_T == obj); /* ugh. */ + fObj = (SCM_BOOL_T == obj); i = (SCM_LENGTH (v) - 1) / SCM_LONG_BIT; - k = SCM_ASWORD (SCM_VELTS (kv)[i]) & (obj ? SCM_ASWORD (SCM_VELTS (v)[i]) : ~ SCM_ASWORD (SCM_VELTS (v)[i])); + k = SCM_ASWORD (SCM_VELTS (kv)[i]) & (fObj ? SCM_ASWORD (SCM_VELTS (v)[i]) : ~ SCM_ASWORD (SCM_VELTS (v)[i])); k <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT); while (1) { @@ -1974,7 +1975,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0, return SCM_MAKINUM (count); /* urg. repetitive (see above.) */ - k = SCM_ASWORD (SCM_VELTS (kv)[i]) & (obj ? SCM_ASWORD(SCM_VELTS (v)[i]) : ~SCM_ASWORD (SCM_VELTS (v)[i])); + k = SCM_ASWORD (SCM_VELTS (kv)[i]) & (fObj ? SCM_ASWORD(SCM_VELTS (v)[i]) : ~SCM_ASWORD (SCM_VELTS (v)[i])); } } return SCM_MAKINUM (count); diff --git a/libguile/vectors.h b/libguile/vectors.h index 4692a6574..fa1577f44 100644 --- a/libguile/vectors.h +++ b/libguile/vectors.h @@ -54,6 +54,7 @@ #define SCM_VECTORP(x) (SCM_NIMP(x) && (SCM_TYP7S(x)==scm_tc7_vector)) #define SCM_NVECTORP(x) (!SCM_VECTORP(x)) #define SCM_VELTS(x) ((SCM *)SCM_CDR(x)) +#define SCM_VELTS_AS_STACKITEMS(x) ((SCM_STACKITEM *)SCM_CDR(x)) #define SCM_SETVELTS SCM_SETCDR |