mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +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;
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)

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_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);

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
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);
}

2
libguile/print.c
View file

@ -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." }

2
libguile/strports.c
View file

@ -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

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 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);

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_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