summaryrefslogtreecommitdiffstats
path: root/subr.c
diff options
context:
space:
mode:
Diffstat (limited to 'subr.c')
-rw-r--r--subr.c294
1 files changed, 149 insertions, 145 deletions
diff --git a/subr.c b/subr.c
index e8b5176..f486932 100644
--- a/subr.c
+++ b/subr.c
@@ -114,14 +114,14 @@ SCM consp(x)
SCM setcar(pair, value)
SCM pair, value;
{
- ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcar);
+ ASRTER(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcar);
CAR(pair) = value;
return UNSPECIFIED;
}
SCM setcdr(pair, value)
SCM pair, value;
{
- ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcdr);
+ ASRTER(NIMP(pair) && CONSP(pair), pair, ARG1, s_setcdr);
CDR(pair) = value;
return UNSPECIFIED;
}
@@ -164,7 +164,7 @@ SCM length(x)
SCM x;
{
SCM i = MAKINUM(ilength(x));
- ASSERT(i >= INUM0, x, ARG1, s_length);
+ ASRTER(i >= INUM0, x, ARG1, s_length);
return i;
}
SCM append(args)
@@ -173,25 +173,25 @@ SCM append(args)
SCM res = EOL;
SCM *lloc = &res, arg;
if IMP(args) {
- ASSERT(NULLP(args), args, ARGn, s_append);
+ ASRTER(NULLP(args), args, ARGn, s_append);
return res;
}
- ASSERT(CONSP(args), args, ARGn, s_append);
+ ASRTER(CONSP(args), args, ARGn, s_append);
while (1) {
arg = CAR(args);
args = CDR(args);
if IMP(args) {
*lloc = arg;
- ASSERT(NULLP(args), args, ARGn, s_append);
+ ASRTER(NULLP(args), args, ARGn, s_append);
return res;
}
- ASSERT(CONSP(args), args, ARGn, s_append);
+ ASRTER(CONSP(args), args, ARGn, s_append);
for(;NIMP(arg);arg = CDR(arg)) {
- ASSERT(CONSP(arg), arg, ARGn, s_append);
+ ASRTER(CONSP(arg), arg, ARGn, s_append);
*lloc = cons(CAR(arg), EOL);
lloc = &CDR(*lloc);
}
- ASSERT(NULLP(arg), arg, ARGn, s_append);
+ ASRTER(NULLP(arg), arg, ARGn, s_append);
}
}
SCM reverse(lst)
@@ -200,24 +200,24 @@ SCM reverse(lst)
SCM res = EOL;
SCM p = lst;
for(;NIMP(p);p = CDR(p)) {
- ASSERT(CONSP(p), lst, ARG1, s_reverse);
+ ASRTER(CONSP(p), lst, ARG1, s_reverse);
res = cons(CAR(p), res);
}
- ASSERT(NULLP(p), lst, ARG1, s_reverse);
+ ASRTER(NULLP(p), lst, ARG1, s_reverse);
return res;
}
SCM list_ref(lst, k)
SCM lst, k;
{
register long i;
- ASSERT(INUMP(k), k, ARG2, s_list_ref);
+ ASRTER(INUMP(k), k, ARG2, s_list_ref);
i = INUM(k);
- ASSERT(i >= 0, k, ARG2, s_list_ref);
+ ASRTER(i >= 0, k, ARG2, s_list_ref);
while (i-- > 0) {
ASRTGO(NIMP(lst) && CONSP(lst), erout);
lst = CDR(lst);
}
-erout: ASSERT(NIMP(lst) && CONSP(lst),
+erout: ASRTER(NIMP(lst) && CONSP(lst),
NULLP(lst)?k:lst, NULLP(lst)?OUTOFRANGE:ARG1, s_list_ref);
return CAR(lst);
}
@@ -225,20 +225,20 @@ SCM memq(x, lst)
SCM x, lst;
{
for(;NIMP(lst);lst = CDR(lst)) {
- ASSERT(CONSP(lst), lst, ARG2, s_memq);
+ ASRTER(CONSP(lst), lst, ARG2, s_memq);
if (CAR(lst)==x) return lst;
}
- ASSERT(NULLP(lst), lst, ARG2, s_memq);
+ ASRTER(NULLP(lst), lst, ARG2, s_memq);
return BOOL_F;
}
SCM member(x, lst)
SCM x, lst;
{
for(;NIMP(lst);lst = CDR(lst)) {
- ASSERT(CONSP(lst), lst, ARG2, s_member);
+ ASRTER(CONSP(lst), lst, ARG2, s_member);
if NFALSEP(equal(CAR(lst), x)) return lst;
}
- ASSERT(NULLP(lst), lst, ARG2, s_member);
+ ASRTER(NULLP(lst), lst, ARG2, s_member);
return BOOL_F;
}
SCM assq(x, alist)
@@ -246,12 +246,12 @@ SCM assq(x, alist)
{
SCM tmp;
for(;NIMP(alist);alist = CDR(alist)) {
- ASSERT(CONSP(alist), alist, ARG2, s_assq);
+ ASRTER(CONSP(alist), alist, ARG2, s_assq);
tmp = CAR(alist);
- ASSERT(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assq);
+ ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assq);
if (CAR(tmp)==x) return tmp;
}
- ASSERT(NULLP(alist), alist, ARG2, s_assq);
+ ASRTER(NULLP(alist), alist, ARG2, s_assq);
return BOOL_F;
}
SCM assoc(x, alist)
@@ -259,12 +259,12 @@ SCM assoc(x, alist)
{
SCM tmp;
for(;NIMP(alist);alist = CDR(alist)) {
- ASSERT(CONSP(alist), alist, ARG2, s_assoc);
+ ASRTER(CONSP(alist), alist, ARG2, s_assoc);
tmp = CAR(alist);
- ASSERT(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc);
+ ASRTER(NIMP(tmp) && CONSP(tmp), alist, ARG2, s_assoc);
if NFALSEP(equal(CAR(tmp), x)) return tmp;
}
- ASSERT(NULLP(alist), alist, ARG2, s_assoc);
+ ASRTER(NULLP(alist), alist, ARG2, s_assoc);
return BOOL_F;
}
@@ -284,13 +284,13 @@ SCM symbolp(x)
SCM symbol2string(s)
SCM s;
{
- ASSERT(NIMP(s) && SYMBOLP(s), s, ARG1, s_symbol2string);
+ ASRTER(NIMP(s) && SYMBOLP(s), s, ARG1, s_symbol2string);
return makfromstr(CHARS(s), (sizet)LENGTH(s));
}
SCM string2symbol(s)
SCM s;
{
- ASSERT(NIMP(s) && STRINGP(s), s, ARG1, s_str2symbol);
+ ASRTER(NIMP(s) && STRINGP(s), s, ARG1, s_str2symbol);
s = intern(CHARS(s), (sizet)LENGTH(s));
return CAR(s);
}
@@ -309,11 +309,11 @@ SCM oddp(n)
{
#ifdef BIGDIG
if NINUMP(n) {
- ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_oddp);
+ ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_oddp);
return (1 & BDIGITS(n)[0]) ? BOOL_T : BOOL_F;
}
#else
- ASSERT(INUMP(n), n, ARG1, s_oddp);
+ ASRTER(INUMP(n), n, ARG1, s_oddp);
#endif
return (4 & (int)n) ? BOOL_T : BOOL_F;
}
@@ -322,11 +322,11 @@ SCM evenp(n)
{
#ifdef BIGDIG
if NINUMP(n) {
- ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_evenp);
+ ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_evenp);
return (1 & BDIGITS(n)[0]) ? BOOL_F : BOOL_T;
}
#else
- ASSERT(INUMP(n), n, ARG1, s_evenp);
+ ASRTER(INUMP(n), n, ARG1, s_evenp);
#endif
return (4 & (int)n) ? BOOL_F : BOOL_T;
}
@@ -335,12 +335,12 @@ SCM absval(x)
{
#ifdef BIGDIG
if NINUMP(x) {
- ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_abs);
+ ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_abs);
if (TYP16(x)==tc16_bigpos) return x;
return copybig(x, 0);
}
#else
- ASSERT(INUMP(x), x, ARG1, s_abs);
+ ASRTER(INUMP(x), x, ARG1, s_abs);
#endif
if (INUM(x) >= 0) return x;
x = -INUM(x);
@@ -359,7 +359,7 @@ SCM lquotient(x, y)
#ifdef BIGDIG
if NINUMP(x) {
long w;
- ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_quotient);
+ ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_quotient);
if NINUMP(y) {
ASRTGO(NIMP(y) && BIGP(y), bady);
return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
@@ -394,8 +394,8 @@ SCM lquotient(x, y)
return INUM0;
}
#else
- ASSERT(INUMP(x), x, ARG1, s_quotient);
- ASSERT(INUMP(y), y, ARG2, s_quotient);
+ ASRTER(INUMP(x), x, ARG1, s_quotient);
+ ASRTER(INUMP(y), y, ARG2, s_quotient);
#endif
if ((z = INUM(y))==0)
ov: wta(y, (char *)OVFLOW, s_quotient);
@@ -428,7 +428,7 @@ SCM lremainder(x, y)
register long z;
#ifdef BIGDIG
if NINUMP(x) {
- ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_remainder);
+ ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_remainder);
if NINUMP(y) {
ASRTGO(NIMP(y) && BIGP(y), bady);
return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
@@ -445,8 +445,8 @@ SCM lremainder(x, y)
return x;
}
#else
- ASSERT(INUMP(x), x, ARG1, s_remainder);
- ASSERT(INUMP(y), y, ARG2, s_remainder);
+ ASRTER(INUMP(x), x, ARG1, s_remainder);
+ ASRTER(INUMP(y), y, ARG2, s_remainder);
#endif
if (!(z = INUM(y)))
ov: wta(y, (char *)OVFLOW, s_remainder);
@@ -469,7 +469,7 @@ SCM modulo(x, y)
register long yy, z;
#ifdef BIGDIG
if NINUMP(x) {
- ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_modulo);
+ ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_modulo);
if NINUMP(y) {
ASRTGO(NIMP(y) && BIGP(y), bady);
return divbigbig(BDIGITS(x), NUMDIGS(x), BDIGITS(y), NUMDIGS(y),
@@ -486,8 +486,8 @@ SCM modulo(x, y)
return (BIGSIGN(y) ? (INUM(x)>0) : (INUM(x)<0)) ? sum(x, y) : x;
}
#else
- ASSERT(INUMP(x), x, ARG1, s_modulo);
- ASSERT(INUMP(y), y, ARG2, s_modulo);
+ ASRTER(INUMP(x), x, ARG1, s_modulo);
+ ASRTER(INUMP(y), y, ARG2, s_modulo);
#endif
if (!(yy = INUM(y)))
ov: wta(y, (char *)OVFLOW, s_modulo);
@@ -509,11 +509,11 @@ SCM lgcd(x, y)
#ifdef BIGDIG
if NINUMP(x) {
big_gcd:
- ASSERT(NIMP(x) && BIGP(x), x, ARG1, s_gcd);
+ ASRTER(NIMP(x) && BIGP(x), x, ARG1, s_gcd);
if BIGSIGN(x) x = copybig(x, 0);
newy:
if NINUMP(y) {
- ASSERT(NIMP(y) && BIGP(y), y, ARG2, s_gcd);
+ ASRTER(NIMP(y) && BIGP(y), y, ARG2, s_gcd);
if BIGSIGN(y) y = copybig(y, 0);
switch (bigcomp(x, y)) {
case -1:
@@ -527,8 +527,8 @@ SCM lgcd(x, y)
}
if NINUMP(y) { t=x; x=y; y=t; goto big_gcd;}
#else
- ASSERT(INUMP(x), x, ARG1, s_gcd);
- ASSERT(INUMP(y), y, ARG2, s_gcd);
+ ASRTER(INUMP(x), x, ARG1, s_gcd);
+ ASRTER(INUMP(y), y, ARG2, s_gcd);
#endif
u = INUM(x);
if (u<0) u = -u;
@@ -1003,7 +1003,7 @@ SCM scm_logior(x, y)
}}
#else
ASRTGO(INUMP(x), badx);
- ASSERT(INUMP(y), y, ARG2, s_logior);
+ ASRTER(INUMP(y), y, ARG2, s_logior);
#endif
return MAKINUM(INUM(x) | INUM(y));
}
@@ -1052,7 +1052,7 @@ SCM scm_logand(x, y)
}}
#else
ASRTGO(INUMP(x), badx);
- ASSERT(INUMP(y), y, ARG2, s_logand);
+ ASRTER(INUMP(y), y, ARG2, s_logand);
#endif
return MAKINUM(INUM(x) & INUM(y));
}
@@ -1094,7 +1094,7 @@ SCM scm_logxor(x, y)
}}
#else
ASRTGO(INUMP(x), badx);
- ASSERT(INUMP(y), y, ARG2, s_logxor);
+ ASRTER(INUMP(y), y, ARG2, s_logxor);
#endif
return (x ^ y) + INUM0;
}
@@ -1132,7 +1132,7 @@ SCM scm_logtest(x, y)
}}
#else
ASRTGO(INUMP(x), badx);
- ASSERT(INUMP(y), y, ARG2, s_logtest);
+ ASRTER(INUMP(y), y, ARG2, s_logtest);
#endif
return (INUM(x) & INUM(y)) ? BOOL_T : BOOL_F;
}
@@ -1140,10 +1140,10 @@ SCM scm_logtest(x, y)
SCM scm_logbitp(index, j1)
SCM index, j1;
{
- ASSERT(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp);
+ ASRTER(INUMP(index) && INUM(index) >= 0, index, ARG1, s_logbitp);
#ifdef BIGDIG
if NINUMP(j1) {
- ASSERT(NIMP(j1) && BIGP(j1), j1, ARG2, s_logbitp);
+ ASRTER(NIMP(j1) && BIGP(j1), j1, ARG2, s_logbitp);
if (NUMDIGS(j1) * BITSPERDIG < INUM(index)) return BOOL_F;
else if BIGSIGN(j1) {
long num = -1;
@@ -1162,15 +1162,16 @@ SCM scm_logbitp(index, j1)
(1L << (INUM(index)%BITSPERDIG))) ? BOOL_T : BOOL_F;
}
#else
- ASSERT(INUMP(j1), j1, ARG2, s_logbitp);
+ ASRTER(INUMP(j1), j1, ARG2, s_logbitp);
#endif
+ if (index >= LONG_BIT) return j1 < 0 ? BOOL_T : BOOL_F;
return ((1L << INUM(index)) & INUM(j1)) ? BOOL_T : BOOL_F;
}
SCM scm_copybit(index, j1, bit)
SCM index, j1, bit;
{
- ASSERT(INUMP(index) && INUM(index) >= 0, index, ARG1, s_copybit);
+ ASRTER(INUMP(index) && INUM(index) >= 0, index, ARG1, s_copybit);
#ifdef BIGDIG
{
SCM res;
@@ -1178,7 +1179,7 @@ SCM scm_copybit(index, j1, bit)
sizet i = INUM(index);
int sign;
if (!INUMP(j1)) {
- ASSERT(NIMP(j1) && BIGP(j1), j1, ARG2, s_copybit);
+ ASRTER(NIMP(j1) && BIGP(j1), j1, ARG2, s_copybit);
sign = BIGSIGN(j1);
ovflow:
res = scm_copy_big_2scomp(j1, i + 1, sign);
@@ -1196,8 +1197,8 @@ SCM scm_copybit(index, j1, bit)
}
}
#else
- ASSERT(INUMP(j1), j1, ARG2, s_copybit);
- ASSERT(INUM(index) < LONG_BIT - 3, index, OUTOFRANGE, s_copybit);
+ ASRTER(INUMP(j1), j1, ARG2, s_copybit);
+ ASRTER(INUM(index) < LONG_BIT - 3, index, OUTOFRANGE, s_copybit);
#endif
if NFALSEP(bit)
return MAKINUM(INUM(j1) | (1L << INUM(index)));
@@ -1215,10 +1216,13 @@ SCM scm_ash(n, cnt)
SCM n, cnt;
{
SCM res = INUM(n);
- ASSERT(INUMP(cnt), cnt, ARG2, s_ash);
+ ASRTER(INUMP(cnt), cnt, ARG2, s_ash);
cnt = INUM(cnt);
if (INUMP(n)) {
- if (cnt < 0) return MAKINUM(SRS(res, -cnt));
+ if (cnt < 0) {
+ if (-cnt >= LONG_BIT) return INUM0;
+ return MAKINUM(SRS(res, -cnt));
+ }
if (cnt >= LONG_BIT) goto ovflow;
res = MAKINUM(res<<cnt);
if (INUM(res)>>cnt != INUM(n))
@@ -1227,7 +1231,7 @@ SCM scm_ash(n, cnt)
return res;
}
#ifdef BIGDIG
- ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_ash);
+ ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_ash);
ovflow:
if (0==cnt) return n;
return scm_big_ash(n, cnt);
@@ -1242,15 +1246,15 @@ SCM scm_bitfield(n, start, end)
SCM n, start, end;
{
int sign;
- ASSERT(INUMP(start), start, ARG2, s_bitfield);
- ASSERT(INUMP(end), end, ARG3, s_bitfield);
+ ASRTER(INUMP(start), start, ARG2, s_bitfield);
+ ASRTER(INUMP(end), end, ARG3, s_bitfield);
start = INUM(start); end = INUM(end);
- ASSERT(end >= start, MAKINUM(end), OUTOFRANGE, s_bitfield);
+ ASRTER(end >= start, MAKINUM(end), OUTOFRANGE, s_bitfield);
#ifdef BIGDIG
if (NINUMP(n)) {
BIGDIG *ds;
sizet i, nd;
- ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_bitfield);
+ ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_bitfield);
sign = BIGSIGN(n);
big:
if (sign) n = scm_copy_big_2scomp(n, (sizet)end, 0);
@@ -1272,8 +1276,8 @@ SCM scm_bitfield(n, start, end)
goto big;
}
#else
- ASSERT(INUMP(n), n, ARG1, s_bitfield);
- ASSERT(end < LONG_BIT - 2, MAKINUM(end), OUTOFRANGE, s_bitfield);
+ ASRTER(INUMP(n), n, ARG1, s_bitfield);
+ ASRTER(end < LONG_BIT - 2, MAKINUM(end), OUTOFRANGE, s_bitfield);
#endif
return MAKINUM((INUM(n)>>start) & ((1L<<(end - start)) - 1));
}
@@ -1286,9 +1290,9 @@ SCM scm_bitif(mask, n0, n1)
return scm_logior(scm_logand(mask, n0),
scm_logand(scm_lognot(mask), n1));
#else
- ASSERT(INUMP(mask), mask, ARG1, s_bitif);
- ASSERT(INUMP(n0), n0, ARG2, s_bitif);
- ASSERT(INUMP(n1), n1, ARG3, s_bitif);
+ ASRTER(INUMP(mask), mask, ARG1, s_bitif);
+ ASRTER(INUMP(n0), n0, ARG2, s_bitif);
+ ASRTER(INUMP(n1), n1, ARG3, s_bitif);
#endif
return MAKINUM((INUM(mask) & INUM(n0)) | (~(INUM(mask)) & INUM(n1)));
}
@@ -1307,10 +1311,10 @@ SCM scm_copybitfield(to, start, rest)
ASRTGO(NIMP(rest) && CONSP(rest), wna);
from = CAR(rest);
ASRTGO(NULLP(CDR(rest)), wna);
- ASSERT(INUMP(start) && INUM(start)>=0, start, ARG2, s_copybitfield);
+ ASRTER(INUMP(start) && INUM(start)>=0, start, ARG2, s_copybitfield);
len = INUM(end) - INUM(start);
- ASSERT(INUMP(end), end, ARG3, s_copybitfield);
- ASSERT(len >= 0, MAKINUM(len), OUTOFRANGE, s_copybitfield);
+ ASRTER(INUMP(end), end, ARG3, s_copybitfield);
+ ASRTER(len >= 0, MAKINUM(len), OUTOFRANGE, s_copybitfield);
#ifdef BIGDIG
if (NINUMP(from) || NINUMP(to) || (INUM(end) >= LONG_BIT - 2)) {
SCM mask = difference(scm_ash(MAKINUM(1L), MAKINUM(len)), MAKINUM(1L));
@@ -1319,9 +1323,9 @@ SCM scm_copybitfield(to, start, rest)
scm_logand(scm_lognot(mask), to));
}
#else
- ASSERT(INUMP(to), to, ARG1, s_copybitfield);
- ASSERT(INUMP(from), from, ARG4, s_copybitfield);
- ASSERT(INUM(end) < LONG_BIT - 2, end, OUTOFRANGE, s_copybitfield);
+ ASRTER(INUMP(to), to, ARG1, s_copybitfield);
+ ASRTER(INUMP(from), from, ARG4, s_copybitfield);
+ ASRTER(INUM(end) < LONG_BIT - 2, end, OUTOFRANGE, s_copybitfield);
#endif
{
long mask = ((1L<<len) - 1)<<INUM(start);
@@ -1338,7 +1342,7 @@ SCM scm_logcount(n)
#ifdef BIGDIG
if NINUMP(n) {
sizet i; BIGDIG *ds, d;
- ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_logcount);
+ ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_logcount);
if BIGSIGN(n) return scm_logcount(difference(MAKINUM(-1L), n));
ds = BDIGITS(n);
for(i = NUMDIGS(n); i--; )
@@ -1346,7 +1350,7 @@ SCM scm_logcount(n)
return MAKINUM(c);
}
#else
- ASSERT(INUMP(n), n, ARG1, s_logcount);
+ ASRTER(INUMP(n), n, ARG1, s_logcount);
#endif
if ((nn = INUM(n)) < 0) nn = -1 - nn;
for(; nn; nn >>= 4) c += logtab[15 & nn];
@@ -1363,7 +1367,7 @@ SCM scm_intlength(n)
#ifdef BIGDIG
if NINUMP(n) {
BIGDIG *ds, d;
- ASSERT(NIMP(n) && BIGP(n), n, ARG1, s_intlength);
+ ASRTER(NIMP(n) && BIGP(n), n, ARG1, s_intlength);
if BIGSIGN(n) return scm_intlength(difference(MAKINUM(-1L), n));
ds = BDIGITS(n);
d = ds[c = NUMDIGS(n)-1];
@@ -1371,7 +1375,7 @@ SCM scm_intlength(n)
return MAKINUM(c - 4 + l);
}
#else
- ASSERT(INUMP(n), n, ARG1, s_intlength);
+ ASRTER(INUMP(n), n, ARG1, s_intlength);
#endif
if ((nn = INUM(n)) < 0) nn = -1 - nn;
for(;nn; nn >>= 4) {c += 4; l = ilentab[15 & nn];}
@@ -1386,120 +1390,120 @@ SCM charp(x)
SCM char_lessp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ch_lessp);
- ASSERT(ICHRP(y), y, ARG2, s_ch_lessp);
+ ASRTER(ICHRP(x), x, ARG1, s_ch_lessp);
+ ASRTER(ICHRP(y), y, ARG2, s_ch_lessp);
return (ICHR(x) < ICHR(y)) ? BOOL_T : BOOL_F;
}
SCM char_leqp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ch_leqp);
- ASSERT(ICHRP(y), y, ARG2, s_ch_leqp);
+ ASRTER(ICHRP(x), x, ARG1, s_ch_leqp);
+ ASRTER(ICHRP(y), y, ARG2, s_ch_leqp);
return (ICHR(x) <= ICHR(y)) ? BOOL_T : BOOL_F;
}
SCM char_grp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ch_grp);
- ASSERT(ICHRP(y), y, ARG2, s_ch_grp);
+ ASRTER(ICHRP(x), x, ARG1, s_ch_grp);
+ ASRTER(ICHRP(y), y, ARG2, s_ch_grp);
return (ICHR(x) > ICHR(y)) ? BOOL_T : BOOL_F;
}
SCM char_geqp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ch_geqp);
- ASSERT(ICHRP(y), y, ARG2, s_ch_geqp);
+ ASRTER(ICHRP(x), x, ARG1, s_ch_geqp);
+ ASRTER(ICHRP(y), y, ARG2, s_ch_geqp);
return (ICHR(x) >= ICHR(y)) ? BOOL_T : BOOL_F;
}
SCM chci_eq(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ci_eq);
- ASSERT(ICHRP(y), y, ARG2, s_ci_eq);
+ ASRTER(ICHRP(x), x, ARG1, s_ci_eq);
+ ASRTER(ICHRP(y), y, ARG2, s_ci_eq);
return (upcase[ICHR(x)]==upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
}
SCM chci_lessp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ci_lessp);
- ASSERT(ICHRP(y), y, ARG2, s_ci_lessp);
+ ASRTER(ICHRP(x), x, ARG1, s_ci_lessp);
+ ASRTER(ICHRP(y), y, ARG2, s_ci_lessp);
return (upcase[ICHR(x)] < upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
}
SCM chci_leqp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ci_leqp);
- ASSERT(ICHRP(y), y, ARG2, s_ci_leqp);
+ ASRTER(ICHRP(x), x, ARG1, s_ci_leqp);
+ ASRTER(ICHRP(y), y, ARG2, s_ci_leqp);
return (upcase[ICHR(x)] <= upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
}
SCM chci_grp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ci_grp);
- ASSERT(ICHRP(y), y, ARG2, s_ci_grp);
+ ASRTER(ICHRP(x), x, ARG1, s_ci_grp);
+ ASRTER(ICHRP(y), y, ARG2, s_ci_grp);
return (upcase[ICHR(x)] > upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
}
SCM chci_geqp(x, y)
SCM x, y;
{
- ASSERT(ICHRP(x), x, ARG1, s_ci_geqp);
- ASSERT(ICHRP(y), y, ARG2, s_ci_geqp);
+ ASRTER(ICHRP(x), x, ARG1, s_ci_geqp);
+ ASRTER(ICHRP(y), y, ARG2, s_ci_geqp);
return (upcase[ICHR(x)] >= upcase[ICHR(y)]) ? BOOL_T : BOOL_F;
}
SCM char_alphap(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_alphap);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_alphap);
return (isascii(ICHR(chr)) && isalpha(ICHR(chr))) ? BOOL_T : BOOL_F;
}
SCM char_nump(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_nump);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_nump);
return (isascii(ICHR(chr)) && isdigit(ICHR(chr))) ? BOOL_T : BOOL_F;
}
SCM char_whitep(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_whitep);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_whitep);
return (isascii(ICHR(chr)) && isspace(ICHR(chr))) ? BOOL_T : BOOL_F;
}
SCM char_upperp(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_upperp);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_upperp);
return (isascii(ICHR(chr)) && isupper(ICHR(chr))) ? BOOL_T : BOOL_F;
}
SCM char_lowerp(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_lowerp);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_lowerp);
return (isascii(ICHR(chr)) && islower(ICHR(chr))) ? BOOL_T : BOOL_F;
}
SCM char2int(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_char2int);
+ ASRTER(ICHRP(chr), chr, ARG1, s_char2int);
return MAKINUM(ICHR(chr));
}
SCM int2char(n)
SCM n;
{
- ASSERT(INUMP(n), n, ARG1, s_int2char);
- ASSERT((n >= INUM0) && (n < MAKINUM(CHAR_CODE_LIMIT)),
+ ASRTER(INUMP(n), n, ARG1, s_int2char);
+ ASRTER((n >= INUM0) && (n < MAKINUM(CHAR_CODE_LIMIT)),
n, OUTOFRANGE, s_int2char);
return MAKICHR(INUM(n));
}
SCM char_upcase(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_upcase);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_upcase);
return MAKICHR(upcase[ICHR(chr)]);
}
SCM char_downcase(chr)
SCM chr;
{
- ASSERT(ICHRP(chr), chr, ARG1, s_ch_downcase);
+ ASRTER(ICHRP(chr), chr, ARG1, s_ch_downcase);
return MAKICHR(downcase[ICHR(chr)]);
}
@@ -1515,11 +1519,11 @@ SCM string(chrs)
SCM res;
register unsigned char *data;
long i = ilength(chrs);
- ASSERT(i >= 0, chrs, ARG1, s_string);
+ ASRTER(i >= 0, chrs, ARG1, s_string);
res = makstr(i);
data = UCHARS(res);
for(;NNULLP(chrs);chrs = CDR(chrs)) {
- ASSERT(ICHRP(CAR(chrs)), chrs, ARG1, s_string);
+ ASRTER(ICHRP(CAR(chrs)), chrs, ARG1, s_string);
*data++ = ICHR(CAR(chrs));
}
return res;
@@ -1530,12 +1534,12 @@ SCM make_string(k, chr)
SCM res;
register unsigned char *dst;
register long i;
- ASSERT(INUMP(k) && (k >= 0), k, ARG1, s_make_string);
+ ASRTER(INUMP(k) && (k >= 0), k, ARG1, s_make_string);
i = INUM(k);
res = makstr(i);
dst = UCHARS(res);
if (!UNBNDP(chr)) {
- ASSERT(ICHRP(chr), chr, ARG2, s_make_string);
+ ASRTER(ICHRP(chr), chr, ARG2, s_make_string);
for(i--;i >= 0;i--) dst[i] = ICHR(chr);
}
return res;
@@ -1543,24 +1547,24 @@ SCM make_string(k, chr)
SCM st_length(str)
SCM str;
{
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_length);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_length);
return MAKINUM(LENGTH(str));
}
SCM st_ref(str, k)
SCM str, k;
{
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_ref);
- ASSERT(INUMP(k), k, ARG2, s_st_ref);
- ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_ref);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_ref);
+ ASRTER(INUMP(k), k, ARG2, s_st_ref);
+ ASRTER(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_ref);
return MAKICHR(UCHARS(str)[INUM(k)]);
}
SCM st_set(str, k, chr)
SCM str, k, chr;
{
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_st_set);
- ASSERT(INUMP(k), k, ARG2, s_st_set);
- ASSERT(ICHRP(chr), chr, ARG3, s_st_set);
- ASSERT(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_set);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_st_set);
+ ASRTER(INUMP(k), k, ARG2, s_st_set);
+ ASRTER(ICHRP(chr), chr, ARG3, s_st_set);
+ ASRTER(INUM(k) < LENGTH(str) && INUM(k) >= 0, k, OUTOFRANGE, s_st_set);
UCHARS(str)[INUM(k)] = ICHR(chr);
return UNSPECIFIED;
}
@@ -1569,8 +1573,8 @@ SCM st_equal(s1, s2)
{
register sizet i;
register unsigned char *c1, *c2;
- ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_equal);
- ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_equal);
+ ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_equal);
+ ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_equal);
i = LENGTH(s2);
if (LENGTH(s1) != i) return BOOL_F;
c1 = UCHARS(s1);
@@ -1583,8 +1587,8 @@ SCM stci_equal(s1, s2)
{
register sizet i;
register unsigned char *c1, *c2;
- ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_equal);
- ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_equal);
+ ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_equal);
+ ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_equal);
i = LENGTH(s2);
if (LENGTH(s1) != i) return BOOL_F;
c1 = UCHARS(s1);
@@ -1598,8 +1602,8 @@ SCM st_lessp(s1, s2)
register sizet i, len;
register unsigned char *c1, *c2;
register int c;
- ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_lessp);
- ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_lessp);
+ ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_st_lessp);
+ ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_st_lessp);
len = LENGTH(s1);
i = LENGTH(s2);
if (len>i) i = len;
@@ -1633,8 +1637,8 @@ SCM stci_lessp(s1, s2)
register sizet i, len;
register unsigned char *c1, *c2;
register int c;
- ASSERT(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_lessp);
- ASSERT(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_lessp);
+ ASRTER(NIMP(s1) && STRINGP(s1), s1, ARG1, s_stci_lessp);
+ ASRTER(NIMP(s2) && STRINGP(s2), s2, ARG2, s_stci_lessp);
len = LENGTH(s1);
i = LENGTH(s2);
if (len>i) i=len;
@@ -1666,13 +1670,13 @@ SCM substring(str, start, end)
SCM str, start, end;
{
long l;
- ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_substring);
- ASSERT(INUMP(start), start, ARG2, s_substring);
- ASSERT(INUMP(end), end, ARG3, s_substring);
- ASSERT(INUM(start) <= LENGTH(str), start, OUTOFRANGE, s_substring);
- ASSERT(INUM(end) <= LENGTH(str), end, OUTOFRANGE, s_substring);
+ ASRTER(NIMP(str) && STRINGP(str), str, ARG1, s_substring);
+ ASRTER(INUMP(start), start, ARG2, s_substring);
+ ASRTER(INUMP(end), end, ARG3, s_substring);
+ ASRTER(INUM(start) <= LENGTH(str), start, OUTOFRANGE, s_substring);
+ ASRTER(INUM(end) <= LENGTH(str), end, OUTOFRANGE, s_substring);
l = INUM(end)-INUM(start);
- ASSERT(l >= 0, MAKINUM(l), OUTOFRANGE, s_substring);
+ ASRTER(l >= 0, MAKINUM(l), OUTOFRANGE, s_substring);
return makfromstr(&CHARS(str)[INUM(start)], (sizet)l);
}
SCM st_append(args)
@@ -1683,13 +1687,13 @@ SCM st_append(args)
register SCM l, s;
register unsigned char *data;
for(l = args;NIMP(l);) {
- ASSERT(CONSP(l), l, ARGn, s_st_append);
+ ASRTER(CONSP(l), l, ARGn, s_st_append);
s = CAR(l);
- ASSERT(NIMP(s) && STRINGP(s), s, ARGn, s_st_append);
+ ASRTER(NIMP(s) && STRINGP(s), s, ARGn, s_st_append);
i += LENGTH(s);
l = CDR(l);
}
- ASSERT(NULLP(l), args, ARGn, s_st_append);
+ ASRTER(NULLP(l), args, ARGn, s_st_append);
res = makstr(i);
data = UCHARS(res);
for(l = args;NIMP(l);l = CDR(l)) {
@@ -1708,7 +1712,7 @@ SCM vectorp(x)
SCM vector_length(v)
SCM v;
{
- ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_length);
+ ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_length);
return MAKINUM(LENGTH(v));
}
SCM vector(l)
@@ -1717,7 +1721,7 @@ SCM vector(l)
SCM res;
register SCM *data;
long i = ilength(l);
- ASSERT(i >= 0, l, ARG1, s_vector);
+ ASRTER(i >= 0, l, ARG1, s_vector);
res = make_vector(MAKINUM(i), UNSPECIFIED);
data = VELTS(res);
for(;NIMP(l);l = CDR(l)) *data++ = CAR(l);
@@ -1726,17 +1730,17 @@ SCM vector(l)
SCM vector_ref(v, k)
SCM v, k;
{
- ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_ref);
- ASSERT(INUMP(k), k, ARG2, s_ve_ref);
- ASSERT((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_ref);
+ ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_ref);
+ ASRTER(INUMP(k), k, ARG2, s_ve_ref);
+ ASRTER((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_ref);
return VELTS(v)[((long) INUM(k))];
}
SCM vector_set(v, k, obj)
SCM v, k, obj;
{
- ASSERT(NIMP(v) && VECTORP(v), v, ARG1, s_ve_set);
- ASSERT(INUMP(k), k, ARG2, s_ve_set);
- ASSERT((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_set);
+ ASRTER(NIMP(v) && VECTORP(v), v, ARG1, s_ve_set);
+ ASRTER(INUMP(k), k, ARG2, s_ve_set);
+ ASRTER((INUM(k) < LENGTH(v)) && (INUM(k) >= 0), k, OUTOFRANGE, s_ve_set);
VELTS(v)[((long) INUM(k))] = obj;
return UNSPECIFIED;
}
@@ -1748,9 +1752,9 @@ SCM make_vector(k, fill)
register long i;
register SCM *velts;
#ifdef SHORT_SIZET
- ASSERT(INUMP(k), k, ARG1, s_make_vector);
+ ASRTER(INUMP(k), k, ARG1, s_make_vector);
#else
- ASSERT(INUMP(k) && (!(~LENGTH_MAX & INUM(k))), k, ARG1, s_make_vector);
+ ASRTER(INUMP(k) && (!(~LENGTH_MAX & INUM(k))), k, ARG1, s_make_vector);
#endif
if UNBNDP(fill) fill = UNSPECIFIED;
i = INUM(k);
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 18:29:09 +0000