summaryrefslogtreecommitdiffstats
path: root/unif.c
diff options
context:
space:
mode:
Diffstat (limited to 'unif.c')
-rw-r--r--unif.c166
1 files changed, 83 insertions, 83 deletions
diff --git a/unif.c b/unif.c
index ae5c1b7..86ae50a 100644
--- a/unif.c
+++ b/unif.c
@@ -106,7 +106,7 @@ SCM resizuve(vect, len)
# endif
#endif
}
- ASSERT(INUMP(len), len, ARG2, s_resizuve);
+ ASRTER(INUMP(len), len, ARG2, s_resizuve);
if (!l) l = 1L;
siz = l * sz;
if (siz != l * sz) wta(MAKINUM(l * sz), (char *) NALLOC, s_resizuve);
@@ -202,6 +202,7 @@ SCM make_uve(k, prot)
# endif
}
DEFER_INTS;
+ /* Make a potentially HUGE object */
v = must_malloc_cell((i ? i : 1L),
MAKE_LENGTH((k < LENGTH_MAX ? k : LENGTH_MAX), type),
s_vector);
@@ -287,26 +288,27 @@ long aind(ra, args, what)
register sizet k = ARRAY_NDIM(ra);
array_dim *s = ARRAY_DIMS(ra);
if INUMP(args) {
- ASSERT(1==k, UNDEFINED, WNA, what);
+ ASRTER(1==k, UNDEFINED, WNA, what);
j = INUM(args);
- ASSERT(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what);
+ ASRTER(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what);
return pos + (j - s->lbnd)*(s->inc);
}
- ASSERT((IMP(args) ? NULLP(args) : CONSP(args)), args, s_bad_ind, what);
+ ASRTER((IMP(args) ? NULLP(args) : CONSP(args)), args, s_bad_ind, what);
while (k && NIMP(args)) {
ind = CAR(args);
args = CDR(args);
- ASSERT(INUMP(ind), ind, s_bad_ind, what);
+ ASRTER(INUMP(ind), ind, s_bad_ind, what);
j = INUM(ind);
- ASSERT(j >= (s->lbnd) && j <= (s->ubnd), ind, OUTOFRANGE, what);
+ ASRTER(j >= (s->lbnd) && j <= (s->ubnd), ind, OUTOFRANGE, what);
pos += (j - s->lbnd)*(s->inc);
k--;
s++;
}
- ASSERT(0==k && NULLP(args), UNDEFINED, WNA, what);
+ ASRTER(0==k && NULLP(args), UNDEFINED, WNA, what);
return pos;
}
+/* Given rank, allocate cell only. */
SCM make_ra(ndim)
int ndim;
{
@@ -329,32 +331,33 @@ SCM shap2ra(args, what)
array_dim *s;
SCM ra, spec, sp;
int ndim = ilength(args);
- ASSERT(0 <= ndim, args, s_bad_spec, what);
+ ASRTER(0 <= ndim, args, s_bad_spec, what);
ra = make_ra(ndim);
ARRAY_BASE(ra) = 0;
s = ARRAY_DIMS(ra);
for (; NIMP(args); s++, args = CDR(args)) {
spec = CAR(args);
if IMP(spec) {
- ASSERT(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what);
+ ASRTER(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what);
s->lbnd = 0;
s->ubnd = INUM(spec) - 1;
s->inc = 1;
}
else {
- ASSERT(CONSP(spec) && INUMP(CAR(spec)), spec, s_bad_spec, what);
+ ASRTER(CONSP(spec) && INUMP(CAR(spec)), spec, s_bad_spec, what);
s->lbnd = INUM(CAR(spec));
sp = CDR(spec);
- ASSERT(NIMP(sp) && INUMP(CAR(sp)) && NULLP(CDR(sp)),
+ ASRTER(NIMP(sp) && INUMP(CAR(sp)) && NULLP(CDR(sp)),
spec, s_bad_spec, what);
s->ubnd = INUM(CAR(sp));
+ ASRTER(s->ubnd >= s->lbnd, spec, s_bad_spec, what);
s->inc = 1;
}
}
return ra;
}
-static char s_uve_fill[] = "uniform-vector-fill!";
+char s_array_fill[] = "array-fill!";
int rafill(ra, fill, ignore)
SCM ra, fill, ignore;
{
@@ -370,8 +373,8 @@ int rafill(ra, fill, ignore)
else
n = LENGTH(ra);
switch TYP7(ra) {
- badarg2: wta(fill, (char *)ARG2, s_uve_fill);
- default: ASSERT(NFALSEP(arrayp(ra, UNDEFINED)), ra, ARG1, s_uve_fill);
+ badarg2: wta(fill, (char *)ARG2, s_array_fill);
+ default: ASRTER(NFALSEP(arrayp(ra, UNDEFINED)), ra, ARG1, s_array_fill);
for (i = base; n--; i += inc)
aset(ra, fill, MAKINUM(i));
break;
@@ -427,8 +430,8 @@ int rafill(ra, fill, ignore)
{
long *ve = VELTS(ra);
long f = (tc7_uvect==TYP7(ra) ?
- num2ulong(fill, (char *)ARG2, s_uve_fill) :
- num2long(fill, (char *)ARG2, s_uve_fill));
+ num2ulong(fill, (char *)ARG2, s_array_fill) :
+ num2long(fill, (char *)ARG2, s_array_fill));
for (i = base; n--; i += inc)
ve[i] = f;
break;
@@ -436,14 +439,14 @@ int rafill(ra, fill, ignore)
# ifdef FLOATS
case tc7_fvect: {
float *ve = (float *)VELTS(ra);
- float f = num2dbl(fill, (char *)ARG2, s_uve_fill);
+ float f = num2dbl(fill, (char *)ARG2, s_array_fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
}
case tc7_dvect: {
double *ve = (double *)VELTS(ra);
- double f = num2dbl(fill, (char *)ARG2, s_uve_fill);
+ double f = num2dbl(fill, (char *)ARG2, s_array_fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
@@ -456,7 +459,7 @@ int rafill(ra, fill, ignore)
fi = IMAG(fill);
}
else
- fr = num2dbl(fill, (char *)ARG2, s_uve_fill);
+ fr = num2dbl(fill, (char *)ARG2, s_array_fill);
for (i = base; n--; i += inc) {
ve[i][0] = fr;
ve[i][1] = fi;
@@ -467,15 +470,6 @@ int rafill(ra, fill, ignore)
}
return 1;
}
-SCM uve_fill(uve, fill)
- SCM uve, fill;
-{
-
- ASSERT(NIMP(uve) && (!ARRAYP(uve) || 1==ARRAY_NDIM(uve)),
- uve, ARG1, s_uve_fill);
- rafill(uve, fill, EOL);
- return UNSPECIFIED;
-}
static char s_dims2ura[] = "dimensions->uniform-array";
SCM dims2ura(dims, prot, fill)
@@ -485,16 +479,17 @@ SCM dims2ura(dims, prot, fill)
long rlen = 1;
array_dim *s;
SCM ra;
- if INUMP(dims)
+ if INUMP(dims) {
if (INUM(dims) < LENGTH_MAX) {
ra = make_uve(INUM(dims), prot);
if NNULLP(fill)
- rafill(ra, CAR(fill), EOL);
+ rafill(ra, CAR(fill), UNDEFINED);
return ra;
}
else
dims = cons(dims, EOL);
- ASSERT(NULLP(dims) || (NIMP(dims) && CONSP(dims)), dims, ARG1, s_dims2ura);
+ }
+ ASRTER(NULLP(dims) || (NIMP(dims) && CONSP(dims)), dims, ARG1, s_dims2ura);
ra = shap2ra(dims, s_dims2ura);
CAR(ra) |= ARRAY_CONTIGUOUS;
s = ARRAY_DIMS(ra);
@@ -504,8 +499,10 @@ SCM dims2ura(dims, prot, fill)
rlen = (s[k].ubnd - s[k].lbnd + 1)*s[k].inc;
vlen *= (s[k].ubnd - s[k].lbnd + 1);
}
- if (rlen < LENGTH_MAX)
- ARRAY_V(ra) = make_uve((rlen > 0 ? rlen : 0L), prot);
+ if (rlen <= 0)
+ ARRAY_V(ra) = make_uve(0L, prot);
+ else if (rlen < LENGTH_MAX)
+ ARRAY_V(ra) = make_uve(rlen, prot);
else {
sizet bit;
switch TYP7(make_uve(0L, prot)) {
@@ -523,8 +520,8 @@ SCM dims2ura(dims, prot, fill)
*((long *)VELTS(ARRAY_V(ra))) = rlen;
}
if NNULLP(fill) {
- ASSERT(1==ilength(fill), UNDEFINED, WNA, s_dims2ura);
- rafill(ARRAY_V(ra), CAR(fill), EOL);
+ ASRTER(1==ilength(fill), UNDEFINED, WNA, s_dims2ura);
+ rafill(ARRAY_V(ra), CAR(fill), UNDEFINED);
}
if (1==ARRAY_NDIM(ra) && 0==ARRAY_BASE(ra))
if (s->ubnd < s->lbnd || (0==s->lbnd && 1==s->inc)) return ARRAY_V(ra);
@@ -557,8 +554,11 @@ SCM make_sh_array(oldra, mapfunc, dims)
sizet i, k;
long old_min, new_min, old_max, new_max;
array_dim *s;
- ASSERT(BOOL_T==procedurep(mapfunc), mapfunc, ARG2, s_make_sh_array);
- ASSERT(NIMP(oldra) && arrayp(oldra, UNDEFINED), oldra, ARG1, s_make_sh_array);
+ ASRTER(BOOL_T==procedurep(mapfunc), mapfunc, ARG2, s_make_sh_array);
+ ASRTER(NIMP(oldra) && arrayp(oldra, UNDEFINED), oldra, ARG1, s_make_sh_array);
+# ifndef RECKLESS
+ scm_arity_check(mapfunc, ilength(dims), s_make_sh_array);
+# endif
ra = shap2ra(dims, s_make_sh_array);
if (ARRAYP(oldra)) {
ARRAY_V(ra) = ARRAY_V(oldra);
@@ -598,7 +598,7 @@ SCM make_sh_array(oldra, mapfunc, dims)
i = (sizet)aind(oldra, imap, s_make_sh_array);
else {
if NINUMP(imap) {
- ASSERT(1==ilength(imap) && INUMP(CAR(imap)),
+ ASRTER(1==ilength(imap) && INUMP(CAR(imap)),
imap, s_bad_ind, s_make_sh_array);
imap = CAR(imap);
}
@@ -616,7 +616,7 @@ SCM make_sh_array(oldra, mapfunc, dims)
s[k].inc = aind(oldra, imap, s_make_sh_array) - i;
else {
if NINUMP(imap) {
- ASSERT(1==ilength(imap) && INUMP(CAR(imap)),
+ ASRTER(1==ilength(imap) && INUMP(CAR(imap)),
imap, s_bad_ind, s_make_sh_array);
imap = CAR(imap);
}
@@ -631,7 +631,7 @@ SCM make_sh_array(oldra, mapfunc, dims)
else
s[k].inc = new_max - new_min + 1; /* contiguous by default */
}
- ASSERT(old_min <= new_min && old_max >= new_max, UNDEFINED,
+ ASRTER(old_min <= new_min && old_max >= new_max, UNDEFINED,
"mapping out of range", s_make_sh_array);
if (1==ARRAY_NDIM(ra) && 0==ARRAY_BASE(ra)) {
if (1==s->inc && 0==s->lbnd
@@ -650,24 +650,24 @@ SCM trans_array(args)
SCM ra, res, vargs, *ve = &vargs;
array_dim *s, *r;
int ndim, i, k;
- ASSERT(NIMP(args), UNDEFINED, WNA, s_trans_array);
+ ASRTER(NIMP(args), UNDEFINED, WNA, s_trans_array);
ra = CAR(args);
args = CDR(args);
switch TYP7(ra) {
default: badarg: wta(ra, (char *)ARG1, s_trans_array);
case tc7_vector:
case tcs_uves:
- ASSERT(NIMP(args) && NULLP(CDR(args)), UNDEFINED, WNA, s_trans_array);
- ASSERT(INUM0==CAR(args), CAR(args), ARG1, s_trans_array);
+ ASRTER(NIMP(args) && NULLP(CDR(args)), UNDEFINED, WNA, s_trans_array);
+ ASRTER(INUM0==CAR(args), CAR(args), ARG1, s_trans_array);
return ra;
case tc7_smob: ASRTGO(ARRAYP(ra), badarg);
vargs = vector(args);
- ASSERT(LENGTH(vargs)==ARRAY_NDIM(ra), UNDEFINED, WNA, s_trans_array);
+ ASRTER(LENGTH(vargs)==ARRAY_NDIM(ra), UNDEFINED, WNA, s_trans_array);
ve = VELTS(vargs);
ndim = 0;
for (k = 0; k < ARRAY_NDIM(ra); k++) {
i = INUM(ve[k]);
- ASSERT(INUMP(ve[k]) && i >=0 && i < ARRAY_NDIM(ra),
+ ASRTER(INUMP(ve[k]) && i >=0 && i < ARRAY_NDIM(ra),
ve[k], ARG2, s_trans_array);
if (ndim < i) ndim = i;
}
@@ -699,7 +699,7 @@ SCM trans_array(args)
r->inc += s->inc;
}
}
- ASSERT(ndim <= 0, args, "bad argument list", s_trans_array);
+ ASRTER(ndim <= 0, args, "bad argument list", s_trans_array);
ra_set_contp(res);
return res;
}
@@ -713,7 +713,7 @@ SCM encl_array(axes)
SCM axv, ra, res, ra_inr;
array_dim vdim, *s = &vdim;
int ndim, j, k, ninr, noutr;
- ASSERT(NIMP(axes), UNDEFINED, WNA, s_encl_array);
+ ASRTER(NIMP(axes), UNDEFINED, WNA, s_encl_array);
ra = CAR(axes);
axes = CDR(axes);
if NULLP(axes)
@@ -741,13 +741,13 @@ SCM encl_array(axes)
}
noutr = ndim - ninr;
axv = make_string(MAKINUM(ndim), MAKICHR(0));
- ASSERT(0 <= noutr && 0 <= ninr, UNDEFINED, WNA, s_encl_array);
+ ASRTER(0 <= noutr && 0 <= ninr, UNDEFINED, WNA, s_encl_array);
res = make_ra(noutr);
ARRAY_BASE(res) = ARRAY_BASE(ra_inr);
ARRAY_V(res) = ra_inr;
for (k = 0; k < ninr; k++, axes = CDR(axes)) {
j = INUM(CAR(axes));
- ASSERT(INUMP(CAR(axes)) && j<ndim, CAR(axes), "bad axis", s_encl_array);
+ ASRTER(INUMP(CAR(axes)) && j<ndim, CAR(axes), "bad axis", s_encl_array);
ARRAY_DIMS(ra_inr)[k].lbnd = s[j].lbnd;
ARRAY_DIMS(ra_inr)[k].ubnd = s[j].ubnd;
ARRAY_DIMS(ra_inr)[k].inc = s[j].inc;
@@ -787,7 +787,7 @@ SCM array_inbp(args)
while (k && NIMP(args)) {
ind = CAR(args);
args = CDR(args);
- ASSERT(INUMP(ind), ind, s_bad_ind, s_array_inbp);
+ ASRTER(INUMP(ind), ind, s_bad_ind, s_array_inbp);
j = INUM(ind);
if (j < (s->lbnd) || j > (s->ubnd)) ret = BOOL_F;
k--;
@@ -801,7 +801,7 @@ SCM array_inbp(args)
case tcs_uves:
ASRTGO(NIMP(args) && NULLP(CDR(args)), wna);
ind = CAR(args);
- ASSERT(INUMP(ind), ind, s_bad_ind, s_array_inbp);
+ ASRTER(INUMP(ind), ind, s_bad_ind, s_array_inbp);
j = INUM(ind);
return j >= 0 && j < LENGTH(v) ? BOOL_T : BOOL_F;
}
@@ -821,12 +821,12 @@ SCM aref(v, args)
}
else {
if NIMP(args) {
- ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref);
+ ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref);
pos = INUM(CAR(args));
ASRTGO(NULLP(CDR(args)), wna);
}
else {
- ASSERT(INUMP(args), args, ARG2, s_aref);
+ ASRTER(INUMP(args), args, ARG2, s_aref);
pos = INUM(args);
}
ASRTGO(pos >= 0 && pos < LENGTH(v), outrng);
@@ -886,7 +886,7 @@ SCM aref(v, args)
SCM scm_array_ref(args)
SCM args;
{
- ASSERT(NIMP(args), UNDEFINED, WNA, s_aref);
+ ASRTER(NIMP(args), UNDEFINED, WNA, s_aref);
return aref(CAR(args), CDR(args));
}
@@ -994,12 +994,12 @@ SCM aset(v, obj, args)
}
else {
if NIMP(args) {
- ASSERT(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset);
+ ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset);
pos = INUM(CAR(args));
ASRTGO(NULLP(CDR(args)), wna);
}
else {
- ASSERT(INUMP(args), args, ARG2, s_aset);
+ ASRTER(INUMP(args), args, ARG2, s_aset);
pos = INUM(args);
}
ASRTGO(pos >= 0 && pos < LENGTH(v), outrng);
@@ -1099,7 +1099,7 @@ SCM uve_read(v, port)
long sz, len, ans;
long start=0;
if UNBNDP(port) port = cur_inp;
- ASSERT(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd);
+ ASRTER(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd);
ASRTGO(NIMP(v), badarg1);
len = LENGTH(v);
loop:
@@ -1164,7 +1164,7 @@ SCM uve_write(v, port)
long sz, len, ans;
long start=0;
if UNBNDP(port) port = cur_outp;
- ASSERT(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr);
+ ASRTER(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr);
ASRTGO(NIMP(v), badarg1);
len = LENGTH(v);
loop:
@@ -1220,7 +1220,7 @@ SCM lcount(item, seq)
long i, imin, ubnd, lbnd = 0;
int enclosed = 0;
register unsigned long cnt = 0, w;
- ASSERT(NIMP(seq), seq, ARG2, s_count);
+ ASRTER(NIMP(seq), seq, ARG2, s_count);
ubnd = LENGTH(seq) - 1;
tail:
switch TYP7(seq) {
@@ -1251,9 +1251,10 @@ SCM lcount(item, seq)
n = ARRAY_DIMS(seq)->ubnd - ARRAY_DIMS(seq)->lbnd + 1;
if (n<=0) return INUM0;
seq = ARRAY_V(seq);
- if FALSEP(item)
+ if FALSEP(item) {
for (;n--; i+=inc)
if (!((VELTS(seq)[i/LONG_BIT]) & (1L<<(i%LONG_BIT)))) cnt++;
+ }
else
for (;n--; i+=inc)
if ((VELTS(seq)[i/LONG_BIT]) & (1L<<(i%LONG_BIT))) cnt++;
@@ -1279,14 +1280,14 @@ SCM bit_position(item, v, k)
long i, len, lenw, xbits, pos = INUM(k), offset = 0;
int enclosed = 0;
register unsigned long w;
- ASSERT(NIMP(v), v, ARG2, s_uve_pos);
- ASSERT(INUMP(k), k, ARG3, s_uve_pos);
+ ASRTER(NIMP(v), v, ARG2, s_uve_pos);
+ ASRTER(INUMP(k), k, ARG3, s_uve_pos);
len = LENGTH(v);
tail:
switch TYP7(v) {
default: badarg2: wta(v, (char *)ARG2, s_uve_pos);
case tc7_bvect:
- ASSERT((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos);
+ ASRTER((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos);
if (pos==len) return BOOL_F;
if (0==len) return MAKINUM(-1L);
lenw = (len-1)/LONG_BIT; /* watch for part words */
@@ -1315,7 +1316,7 @@ SCM bit_position(item, v, k)
}
return BOOL_F;
case tc7_smob: ASRTGO(ARRAYP(v) && 1==ARRAY_NDIM(v) && !enclosed++, badarg2);
- ASSERT(pos >= ARRAY_DIMS(v)->lbnd, k, OUTOFRANGE, s_uve_pos);
+ ASRTER(pos >= ARRAY_DIMS(v)->lbnd, k, OUTOFRANGE, s_uve_pos);
if (1==ARRAY_DIMS(v)->inc) {
len = ARRAY_DIMS(v)->ubnd - ARRAY_DIMS(v)->lbnd + ARRAY_BASE(v) + 1;
offset = ARRAY_BASE(v) - ARRAY_DIMS(v)->lbnd;
@@ -1357,12 +1358,12 @@ SCM bit_set(v, kv, obj)
vlen = LENGTH(v);
if (BOOL_F==obj) for (i = LENGTH(kv);i;) {
k = VELTS(kv)[--i];
- ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set);
+ ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set);
VELTS(v)[k/LONG_BIT] &= ~(1L<<(k%LONG_BIT));
}
else if (BOOL_T==obj) for (i = LENGTH(kv); i;) {
k = VELTS(kv)[--i];
- ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set);
+ ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_set);
VELTS(v)[k/LONG_BIT] |= (1L<<(k%LONG_BIT));
}
else
@@ -1400,12 +1401,12 @@ SCM bit_count(v, kv, obj)
vlen = LENGTH(v);
if (BOOL_F==obj) for (i = LENGTH(kv);i;) {
k = VELTS(kv)[--i];
- ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count);
+ ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count);
if (!(VELTS(v)[k/LONG_BIT] & (1L<<(k%LONG_BIT)))) count++;
}
else if (BOOL_T==obj) for (i = LENGTH(kv); i;) {
k = VELTS(kv)[--i];
- ASSERT((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count);
+ ASRTER((k < vlen), MAKINUM(k), OUTOFRANGE, s_bit_count);
if (VELTS(v)[k/LONG_BIT] & (1L<<(k%LONG_BIT))) count++;
}
else
@@ -1645,10 +1646,10 @@ SCM list2ura(ndim, prot, lst)
SCM ra;
long n;
sizet k = INUM(ndim);
- ASSERT(INUMP(ndim), ndim, ARG1, s_list2ura);
+ ASRTER(INUMP(ndim), ndim, ARG1, s_list2ura);
for (; k--; NIMP(row) && (row = CAR(row))) {
n = ilength(row);
- ASSERT(n>=0, lst, ARG2, s_list2ura);
+ ASRTER(n>=0, lst, ARG2, s_list2ura);
shp = cons(MAKINUM(n), shp);
}
ra = dims2ura(reverse(shp), prot, EOL);
@@ -1915,26 +1916,26 @@ SCM scm_logaref(args)
{
SCM ra, inds, ibit;
int i, rank = 1;
- ASSERT(NIMP(args), UNDEFINED, WNA, s_logaref);
+ ASRTER(NIMP(args), UNDEFINED, WNA, s_logaref);
ra = CAR(args);
- ASSERT(NIMP(ra), ra, ARG1, s_logaref);
+ ASRTER(NIMP(ra), ra, ARG1, s_logaref);
if ARRAYP(ra) rank = ARRAY_NDIM(ra);
inds = args = CDR(args);
for (i = rank; i; i--) {
- ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref);
+ ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref);
args = CDR(args);
}
if NULLP(args) return aref(ra, inds);
- ASSERT(NIMP(args) && CONSP(args) && NULLP(CDR(args)),
+ ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)),
inds, WNA, s_logaref);
- ASSERT(INUMP(CAR(args)), CAR(args), ARGn, s_logaref);
+ ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaref);
ibit = CAR(args);
if (1==rank)
inds = CAR(inds);
else { /* Destructively modify arglist */
args = inds;
for (i = rank-1; i; i--) {
- ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref);
+ ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref);
args = CDR(args);
}
CDR(args) = EOL;
@@ -1951,29 +1952,29 @@ SCM scm_logaset(ra, obj, args)
{
SCM oval, inds, ibit;
int i, rank = 1;
- ASSERT(NIMP(ra), ra, ARG1, s_logaset);
+ ASRTER(NIMP(ra), ra, ARG1, s_logaset);
if ARRAYP(ra) rank = ARRAY_NDIM(ra);
inds = args;
for (i = rank; i; i--) {
- ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset);
+ ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset);
args = CDR(args);
}
if NNULLP(args) {
- ASSERT(NIMP(args) && CONSP(args) && NULLP(CDR(args)),
+ ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)),
inds, WNA, s_logaset);
- ASSERT(INUMP(CAR(args)), CAR(args), ARGn, s_logaset);
+ ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaset);
ibit = CAR(args);
if (1==rank) inds = CAR(inds);
else { /* Destructively modify arglist */
args = inds;
for (i = rank-1; i; i--) {
- ASSERT(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset);
+ ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset);
args = CDR(args);
}
CDR(args) = EOL;
}
oval = aref(ra, inds);
- ASSERT(INUMP(ibit), ibit, ARGn, s_logaset);
+ ASRTER(INUMP(ibit), ibit, ARGn, s_logaset);
if (BOOL_T==obj)
obj = INUMP(oval) ? MAKINUM(INUM(oval) | (1<<INUM(ibit))) :
scm_logior(oval, MAKINUM(1<<INUM(ibit)));
@@ -1997,7 +1998,6 @@ static iproc subr3s[] = {
static iproc subr2s[] = {
{s_resizuve, resizuve},
{s_count, lcount},
- {s_uve_fill, uve_fill},
{0, 0}};
static iproc subr1s[] = {
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 00:38:38 +0000