From c7d035ae1a729232579a0fe41ed5affa131d3623 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:27 -0800 Subject: Import Upstream version 5d9 --- subr.c | 294 +++++++++++++++++++++++++++++++++-------------------------------- 1 file changed, 149 insertions(+), 145 deletions(-) (limited to 'subr.c') 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 != 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<>= 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); -- cgit v1.2.3