summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-04-18 14:12:07 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2000-04-18 14:12:07 +0000
commitfee7ef83a31a2c83711e726c8a346d554864352d (patch)
treebfd63dca4e2058418939226901506101dd5896aa
parent9d0633a8a6a9e92fe0635cd3648b063b6ef2b996 (diff)
downloadguile-fee7ef83a31a2c83711e726c8a346d554864352d.tar.gz
Fixed some SCM/scm_bits_t mixups.
-rw-r--r--libguile/ChangeLog28
-rw-r--r--libguile/options.c4
-rw-r--r--libguile/print.c2
-rw-r--r--libguile/print.h2
-rw-r--r--libguile/ramap.c37
-rw-r--r--libguile/read.c6
-rw-r--r--libguile/stacks.c4
-rw-r--r--libguile/strings.c11
-rw-r--r--libguile/struct.h2
-rw-r--r--libguile/unif.c27
10 files changed, 83 insertions, 40 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 19f2ca09f..b20111198 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -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
diff --git a/libguile/options.c b/libguile/options.c
index bb63cb24c..c59f18759 100644
--- a/libguile/options.c
+++ b/libguile/options.c
@@ -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)
diff --git a/libguile/print.c b/libguile/print.c
index e92cd7835..8e5480602 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -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)
diff --git a/libguile/print.h b/libguile/print.h
index 1f2702be0..f72c62832 100644
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -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
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 8c2f7bae2..853af5be1 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -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), "");
}
diff --git a/libguile/read.c b/libguile/read.c
index 051e75511..15924b44f 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -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);
diff --git a/libguile/stacks.c b/libguile/stacks.c
index 8f3ab9b1d..85c13a624 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -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;
diff --git a/libguile/strings.c b/libguile/strings.c
index 783bfd4f9..c9c7af4dc 100644
--- a/libguile/strings.c
+++ b/libguile/strings.c
@@ -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);
diff --git a/libguile/struct.h b/libguile/struct.h
index a2c3edbfb..c7abfc577 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -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 */
diff --git a/libguile/unif.c b/libguile/unif.c
index f61f4e3b1..8e2761227 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -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);