mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-30 00:40:20 +02:00
Code Activity

* vectors.h (SCM_VELTS_AS_STACKITEMS): Added this macro to help in

Browse source 
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.
This commit is contained in:
Greg J. Badros 2000-03-09 21:48:25 +00:00
parent 7ac030d6de
commit 41b0806d3e
7 changed files with 25 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/gc.c
View file

@ -755,7 +755,7 @@ gc_mark_nimp:
(ptr) break; (ptr) break;
SCM_SETGC8MARK (ptr); SCM_SETGC8MARK (ptr);
if (SCM_VELTS (ptr)) if (SCM_VELTS (ptr))
scm_mark_locations (SCM_VELTS (ptr), scm_mark_locations (SCM_VELTS_AS_STACKITEMS (ptr),
(scm_sizet) (scm_sizet)
(SCM_LENGTH (ptr) + (SCM_LENGTH (ptr) +
(sizeof (SCM_STACKITEM) + -1 + (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
scm_return_first (SCM elt, ...) scm_return_first (SCM elt, ...)
{ {
return elt; return elt;
} }
int
scm_return_first_int (int i, ...)
{
return i;
}
SCM SCM
scm_permanent_object (SCM obj) scm_permanent_object (SCM obj)

1
libguile/gc.h
View file

@ -107,6 +107,7 @@ extern void scm_done_malloc (long size);
extern void scm_must_free (void *obj); extern void scm_must_free (void *obj);
extern void scm_remember (SCM * ptr); extern void scm_remember (SCM * ptr);
extern SCM scm_return_first (SCM elt, ...); 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_permanent_object (SCM obj);
extern SCM scm_protect_object (SCM obj); extern SCM scm_protect_object (SCM obj);
extern SCM scm_unprotect_object (SCM obj); extern SCM scm_unprotect_object (SCM obj);

6
libguile/options.c
View file

@ -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 // scm_option doesn't know if its a long or an SCM
if (options[i].type == SCM_OPTION_SCM) if (options[i].type == SCM_OPTION_SCM)
SCM_SETCDR (protected_objects, SCM_SETCDR (protected_objects,
scm_cons (flags[i], scm_cons (SCM_ASSCM(flags[i]),
scm_delq1_x (options[i].val, scm_delq1_x (SCM_ASSCM(options[i].val),
SCM_CDR (protected_objects)))); SCM_CDR (protected_objects))));
options[i].val = flags[i]; options[i].val = flags[i];
} }
@ -224,7 +224,7 @@ scm_init_opts (SCM (*func) (SCM), scm_option options[], int n)
(options[i].doc)); (options[i].doc));
if (options[i].type == SCM_OPTION_SCM) if (options[i].type == SCM_OPTION_SCM)
SCM_SETCDR (protected_objects, 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); func (SCM_UNDEFINED);
} }

2
libguile/print.c
View file

@ -123,7 +123,7 @@ char *scm_isymnames[] =
}; };
scm_option scm_print_opts[] = { 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." }, "Hook for printing closures." },
{ SCM_OPTION_BOOLEAN, "source", 0, { SCM_OPTION_BOOLEAN, "source", 0,
"Print closures with source." } "Print closures with source." }

2
libguile/strports.c
View file

@ -83,7 +83,7 @@ stfill_buffer (SCM port)
if (pt->read_pos >= pt->read_end) if (pt->read_pos >= pt->read_end)
return EOF; return EOF;
else 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 /* change the size of a port's string to new_size. this doesn't

7
libguile/unif.c
View file

@ -1920,6 +1920,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
{ {
register long i, vlen, count = 0; register long i, vlen, count = 0;
register unsigned long k; register unsigned long k;
int fObj = 0;
SCM_ASRTGO (SCM_NIMP (v), badarg1); SCM_ASRTGO (SCM_NIMP (v), badarg1);
SCM_ASRTGO (SCM_NIMP (kv), badarg2); 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)) if (0 == SCM_LENGTH (v))
return SCM_INUM0; return SCM_INUM0;
SCM_ASRTGO (SCM_BOOL_T == obj || SCM_BOOL_F == obj, badarg3); 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; 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); k <<= SCM_LONG_BIT - 1 - ((SCM_LENGTH (v) - 1) % SCM_LONG_BIT);
while (1) while (1)
{ {
@ -1974,7 +1975,7 @@ SCM_DEFINE (scm_bit_count_star, "bit-count*", 3, 0, 0,
return SCM_MAKINUM (count); return SCM_MAKINUM (count);
/* urg. repetitive (see above.) */ /* 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); return SCM_MAKINUM (count);

1
libguile/vectors.h
View file

@ -54,6 +54,7 @@
#define SCM_VECTORP(x) (SCM_NIMP(x) && (SCM_TYP7S(x)==scm_tc7_vector)) #define SCM_VECTORP(x) (SCM_NIMP(x) && (SCM_TYP7S(x)==scm_tc7_vector))
#define SCM_NVECTORP(x) (!SCM_VECTORP(x)) #define SCM_NVECTORP(x) (!SCM_VECTORP(x))
#define SCM_VELTS(x) ((SCM *)SCM_CDR(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 #define SCM_SETVELTS SCM_SETCDR