mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

Fixed some SCM/scm_bits_t mixups.

Browse source
This commit is contained in:
Dirk Herrmann 2000-04-18 14:12:07 +00:00
parent 9d0633a8a6
commit fee7ef83a3
10 changed files with 83 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

28
libguile/ChangeLog
View file

@ -1,3 +1,31 @@
2000-04-18 Dirk Herrmann <D.Herrmann@tu-bs.de>
* options.c (scm_options), read.c (recsexpr): Remove redundant
SCM_IMP test.
* print.c (scm_iprin1): Made the access of the struct vcell
element explicit.
* print.h (SCM_PRINT_CLOSURE): Added call to SCM_PACK.
* ramap.c (scm_ra_eqp, ra_compare), unif.c
(scm_uniform_vector_ref, scm_cvref, rapr1): Separated accesses to
unsigned long and signed long arrays and clarified the way the
access is performed.
* ramap.c (scm_array_map_x, raeql), read.c (scm_lreadr), stacks.c
(narrow_stack), unif.c (scm_cvref, scm_uniform_array_read_x,
scm_raprin1): Use SCM_EQ_P to compare SCM values.
* strings.c (scm_makstr): Treat the msymbol slots as a field of
scm_bits_t values.
* struct.h (SCM_SET_VTABLE_DESTRUCTOR): Treat the struct data as
a field of scm_bits_t values.
* unif.c (l2ra): Don't test result of scm_array_set_x against
zero: It is always SCM_UNSPECIFIED.
2000-04-18 Mikael Djurfeldt <mdj@mdj.nada.kth.se>
* script.c (scm_compile_shell_switches): Also enable

4
libguile/options.c
View file

@ -124,9 +124,7 @@ static SCM protected_objects;
SCM
scm_options (SCM arg, scm_option options[], int n, const char *s)
{
int i, docp = (!SCM_UNBNDP (arg)
&& !SCM_NULLP (arg)
&& (SCM_IMP (arg) || SCM_NCONSP (arg)));
int i, docp = (!SCM_UNBNDP (arg) && !SCM_NULLP (arg) && !SCM_CONSP (arg));
/* Let `arg' GC protect the arguments */
SCM new_mode = arg, ans = SCM_EOL, ls;
for (i = 0; i < n; ++i)

2
libguile/print.c
View file

@ -349,7 +349,7 @@ taloop:
{
case scm_tcs_cons_gloc:
if (SCM_CDR ((SCM) SCM_STRUCT_VTABLE_DATA (exp)) == (SCM) 0)
if (SCM_STRUCT_VTABLE_DATA (exp) [scm_vtable_index_vcell] == 0)
{
ENTER_NESTED_DATA (pstate, exp, circref);
if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)

2
libguile/print.h
View file

@ -53,7 +53,7 @@
extern scm_option scm_print_opts[];
#define SCM_PRINT_CLOSURE ((SCM) scm_print_opts[0].val)
#define SCM_PRINT_CLOSURE (SCM_PACK (scm_print_opts[0].val))
#define SCM_PRINT_SOURCE_P ((int) scm_print_opts[1].val)
#define SCM_N_PRINT_OPTIONS 2

37
libguile/ramap.c
View file

@ -848,10 +848,15 @@ scm_ra_eqp (SCM ra0, SCM ras)
break;
}
case scm_tc7_uvect:
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (SCM_BITVEC_REF (ra0, i0))
if (((unsigned long *) SCM_VELTS (ra1))[i1] != ((unsigned long *) SCM_VELTS (ra2))[i2])
SCM_BITVEC_CLR (ra0, i0);
break;
case scm_tc7_ivect:
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (SCM_BITVEC_REF (ra0, i0))
if (SCM_VELTS (ra1)[i1] != SCM_VELTS (ra2)[i2])
if (((signed long *) SCM_VELTS (ra1))[i1] != ((signed long *) SCM_VELTS (ra2))[i2])
SCM_BITVEC_CLR (ra0, i0);
break;
case scm_tc7_fvect:
@ -904,13 +909,22 @@ ra_compare (SCM ra0,SCM ra1,SCM ra2,int opt)
break;
}
case scm_tc7_uvect:
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
{
if (SCM_BITVEC_REF (ra0, i0))
if (opt ?
((unsigned long *) SCM_VELTS (ra1))[i1] < ((unsigned long *) SCM_VELTS (ra2))[i2] :
((unsigned long *) SCM_VELTS (ra1))[i1] >= ((unsigned long *) SCM_VELTS (ra2))[i2])
SCM_BITVEC_CLR (ra0, i0);
}
break;
case scm_tc7_ivect:
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
{
if (SCM_BITVEC_REF (ra0, i0))
if (opt ?
SCM_VELTS (ra1)[i1] < SCM_VELTS (ra2)[i2] :
SCM_VELTS (ra1)[i1] >= SCM_VELTS (ra2)[i2])
((signed long *) SCM_VELTS (ra1))[i1] < ((signed long *) SCM_VELTS (ra2))[i2] :
((signed long *) SCM_VELTS (ra1))[i1] >= ((signed long *) SCM_VELTS (ra2))[i2])
SCM_BITVEC_CLR (ra0, i0);
}
break;
@ -1511,7 +1525,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
goto gencase;
scm_array_fill_x (ra0, SCM_BOOL_T);
for (p = ra_rpsubrs; p->name; p++)
if (proc == p->sproc)
if (SCM_EQ_P (proc, p->sproc))
{
while (SCM_NNULLP (lra) && SCM_NNULLP (SCM_CDR (lra)))
{
@ -1548,19 +1562,22 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
/* Check to see if order might matter.
This might be an argument for a separate
SERIAL-ARRAY-MAP! */
if (v0 == ra1 || (SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1)))
if (ra0 != ra1 || (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0)))
if (SCM_EQ_P (v0, ra1)
|| (SCM_ARRAYP (ra1) && SCM_EQ_P (v0, SCM_ARRAY_V (ra1))))
if (!SCM_EQ_P (ra0, ra1)
|| (SCM_ARRAYP(ra0) && !SCM_ARRAY_CONTP(ra0)))
goto gencase;
for (tail = SCM_CDR (lra); SCM_NNULLP (tail); tail = SCM_CDR (tail))
{
ra1 = SCM_CAR (tail);
if (v0 == ra1 || (SCM_ARRAYP (ra1) && v0 == SCM_ARRAY_V (ra1)))
if (SCM_EQ_P (v0, ra1)
|| (SCM_ARRAYP (ra1) && SCM_EQ_P (v0, SCM_ARRAY_V (ra1))))
goto gencase;
}
for (p = ra_asubrs; p->name; p++)
if (proc == p->sproc)
if (SCM_EQ_P (proc, p->sproc))
{
if (ra0 != SCM_CAR (lra))
if (!SCM_EQ_P (ra0, SCM_CAR (lra)))
scm_ramapc (scm_array_identity, SCM_UNDEFINED, ra0, scm_cons (SCM_CAR (lra), SCM_EOL), FUNC_NAME);
lra = SCM_CDR (lra);
while (1)
@ -1906,7 +1923,7 @@ raeql (SCM ra0,SCM as_equal,SCM ra1)
vlen *= s0[k].ubnd - s1[k].lbnd + 1;
}
}
if (unroll && bas0 == bas1 && v0 == v1)
if (unroll && bas0 == bas1 && SCM_EQ_P (v0, v1))
return 1;
return scm_ramapc (raeql_1, as_equal, ra0, scm_cons (ra1, SCM_EOL), "");
}

6
libguile/read.c
View file

@ -187,9 +187,9 @@ scm_casei_streq (char *s1, char *s2)
static SCM
recsexpr (SCM obj,int line,int column,SCM filename)
{
if (SCM_IMP (obj) || SCM_NCONSP(obj))
if (!SCM_CONSP(obj)) {
return obj;
{
} else {
SCM tmp = obj, copy;
/* If this sexpr is visible in the read:sharp source, we want to
keep that information, so only record non-constant cons cells
@ -492,7 +492,7 @@ tryagain_no_flush_ws:
goto tok;
case ':':
if (SCM_PACK (SCM_KEYWORD_STYLE) == scm_keyword_prefix)
if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
{
j = scm_read_token ('-', tok_buf, port, 0);
p = scm_intern (SCM_CHARS (*tok_buf), j);

4
libguile/stacks.c
View file

@ -389,7 +389,7 @@ narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
/* Use standard cutting procedure. */
{
for (i = 0; inner; --inner)
if (s->frames[i++].proc == inner_key)
if (SCM_EQ_P (s->frames[i++].proc, inner_key))
break;
}
s->frames = &s->frames[i];
@ -397,7 +397,7 @@ narrow_stack (SCM stack,int inner,SCM inner_key,int outer,SCM outer_key)
/* Cut outer part. */
for (; n && outer; --outer)
if (s->frames[--n].proc == outer_key)
if (SCM_EQ_P (s->frames[--n].proc, outer_key))
break;
s->length = n;

11
libguile/strings.c
View file

@ -117,18 +117,19 @@ SCM
scm_makstr (long len, int slots)
{
SCM s;
SCM * mem;
scm_bits_t * mem;
SCM_NEWCELL (s);
--slots;
SCM_REDEFER_INTS;
mem = (SCM *)scm_must_malloc (sizeof (SCM) * (slots + 1) + len + 1,
"scm_makstr");
mem = (scm_bits_t *) scm_must_malloc (sizeof (scm_bits_t) * (slots + 1)
+ len + 1, "scm_makstr");
if (slots >= 0)
{
int x;
mem[slots] = (SCM)mem;
mem[slots] = (scm_bits_t) mem;
for (x = 0; x < slots; ++x)
mem[x] = SCM_BOOL_F;
mem[x] = SCM_UNPACK (SCM_BOOL_F);
}
SCM_SETCHARS (s, (char *) (mem + slots + 1));
SCM_SETLENGTH (s, len, scm_tc7_string);

2
libguile/struct.h
View file

@ -87,7 +87,7 @@ typedef scm_sizet (*scm_struct_free_t) (scm_bits_t * vtable, scm_bits_t * data);
#define SCM_STRUCT_VTABLE(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_vtable]))
#define SCM_STRUCT_PRINTER(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_printer]))
#define SCM_SET_VTABLE_DESTRUCTOR(X, D) (SCM_STRUCT_DATA(X)[scm_struct_i_free] = (SCM) D)
#define SCM_SET_VTABLE_DESTRUCTOR(X, D) (SCM_STRUCT_DATA (X) [scm_struct_i_free] = (scm_bits_t) (D))
/* Efficiency is important in the following macro, since it's used in GC */
#define SCM_LAYOUT_TAILP(X) (((X) & 32) == 0) /* R, W or O */

27
libguile/unif.c
View file

@ -1149,9 +1149,9 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
case scm_tc7_byvect:
return SCM_MAKINUM (((char *)SCM_CHARS (v))[pos]);
case scm_tc7_uvect:
return scm_ulong2num((unsigned long ) SCM_VELTS(v)[pos]);
return scm_ulong2num (((unsigned long *) SCM_VELTS (v))[pos]);
case scm_tc7_ivect:
return scm_long2num((long) SCM_VELTS(v)[pos]);
return scm_long2num(((signed long *) SCM_VELTS (v))[pos]);
case scm_tc7_svect:
return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]);
@ -1194,9 +1194,9 @@ scm_cvref (SCM v, scm_sizet pos, SCM last)
case scm_tc7_byvect:
return SCM_MAKINUM (((char *)SCM_CHARS (v))[pos]);
case scm_tc7_uvect:
return scm_ulong2num((unsigned long) SCM_VELTS(v)[pos]);
return scm_ulong2num(((unsigned long *) SCM_VELTS (v))[pos]);
case scm_tc7_ivect:
return scm_long2num((long) SCM_VELTS(v)[pos]);
return scm_long2num(((signed long *) SCM_VELTS (v))[pos]);
case scm_tc7_svect:
return SCM_MAKINUM (((short *) SCM_CELL_WORD_1 (v))[pos]);
#ifdef HAVE_LONG_LONGS
@ -1204,14 +1204,14 @@ scm_cvref (SCM v, scm_sizet pos, SCM last)
return scm_long_long2num (((long_long *) SCM_CELL_WORD_1 (v))[pos]);
#endif
case scm_tc7_fvect:
if (SCM_NIMP (last) && last != scm_flo0 && SCM_SLOPPY_REALP (last))
if (SCM_NIMP (last) && !SCM_EQ_P (last, scm_flo0) && SCM_SLOPPY_REALP (last))
{
SCM_REAL_VALUE (last) = ((float *) SCM_CELL_WORD_1 (v))[pos];
return last;
}
return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_dvect:
if (SCM_NIMP (last) && last != scm_flo0 && SCM_SLOPPY_REALP (last))
if (SCM_NIMP (last) && !SCM_EQ_P (last, scm_flo0) && SCM_SLOPPY_REALP (last))
{
SCM_REAL_VALUE (last) = ((double *) SCM_CELL_WORD_1 (v))[pos];
return last;
@ -1599,7 +1599,7 @@ loop:
if (SCM_TYP7 (v) == scm_tc7_bvect)
ans *= SCM_LONG_BIT;
if (v != ra && cra != ra)
if (!SCM_EQ_P (v, ra) && !SCM_EQ_P (cra, ra))
scm_array_copy_x (cra, ra);
return SCM_MAKINUM (ans);
@ -2210,12 +2210,11 @@ l2ra (SCM lst, SCM ra, scm_sizet base, scm_sizet k)
{
if (SCM_IMP (lst) || SCM_NCONSP (lst))
return 0;
ok = ok && scm_array_set_x (SCM_ARRAY_V (ra), SCM_CAR (lst), SCM_MAKINUM (base));
base += inc;
lst = SCM_CDR (lst);
}
if (SCM_NNULLP (lst))
return 0;
return 0;
}
return ok;
}
@ -2313,23 +2312,23 @@ tail:
if (n-- > 0)
{
/* intprint can't handle >= 2^31. */
sprintf (str, "%lu", (unsigned long) SCM_VELTS (ra)[j]);
sprintf (str, "%lu", ((unsigned long *) SCM_VELTS (ra))[j]);
scm_puts (str, port);
}
for (j += inc; n-- > 0; j += inc)
{
scm_putc (' ', port);
sprintf (str, "%lu", (unsigned long) SCM_VELTS (ra)[j]);
sprintf (str, "%lu", ((unsigned long *) SCM_VELTS (ra))[j]);
scm_puts (str, port);
}
}
case scm_tc7_ivect:
if (n-- > 0)
scm_intprint ((int)SCM_VELTS (ra)[j], 10, port);
scm_intprint (((signed long *) SCM_VELTS (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
scm_putc (' ', port);
scm_intprint ((int)SCM_VELTS (ra)[j], 10, port);
scm_intprint (((signed long *) SCM_VELTS (ra))[j], 10, port);
}
break;
@ -2425,7 +2424,7 @@ tail:
}
}
case scm_tc7_bvect:
if (exp == v)
if (SCM_EQ_P (exp, v))
{ /* a uve, not an scm_array */
register long i, j, w;
scm_putc ('*', port);