summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGreg J. Badros <gjb@cs.washington.edu>2000-03-09 21:48:25 +0000
committerGreg J. Badros <gjb@cs.washington.edu>2000-03-09 21:48:25 +0000
commit41b0806d3ed1c6e11fcae8e09b161f320137a73b (patch)
tree0f3438113efe9db300637708cfb679657c3ce836
parent7ac030d6de0e8fad668851f5c42f9869cc2b1b3f (diff)
downloadguile-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.c17
-rw-r--r--libguile/gc.h1
-rw-r--r--libguile/options.c6
-rw-r--r--libguile/print.c2
-rw-r--r--libguile/strports.c2
-rw-r--r--libguile/unif.c7
-rw-r--r--libguile/vectors.h1
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