diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:31 -0800 |
commit | ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7 (patch) | |
tree | eee15e02ae016333546d3841712be591b2bcb06f /unif.c | |
parent | 302e3218b7d487539ec305bf23881a6ee7d5be99 (diff) | |
download | scm-ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7.tar.gz scm-ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7.zip |
Import Upstream version 5e2upstream/5e2
Diffstat (limited to 'unif.c')
-rw-r--r-- | unif.c | 104 |
1 files changed, 52 insertions, 52 deletions
@@ -114,10 +114,10 @@ SCM resizuve(vect, len) if (siz != l * sz) wta(MAKINUM(l * sz), (char *) NALLOC, s_resizuve); DEFER_INTS; must_realloc_cell(vect, ol*sz, (long)siz, s_resizuve); - if VECTORP(vect) + if (VECTORP(vect)) while(l > ol) VELTS(vect)[--l] = UNSPECIFIED; - else if STRINGP(vect) + else if (STRINGP(vect)) CHARS(vect)[l-1] = 0; SETLENGTH(vect, INUM(len), TYP7(vect)); ALLOW_INTS; @@ -148,7 +148,7 @@ SCM makflo (x) long scm_prot2type(prot) SCM prot; { - if ICHRP(prot) return tc7_string; + if (ICHRP(prot)) return tc7_string; switch (prot) { case BOOL_T: return tc7_bvect; case MAKINUM(8L): @@ -158,12 +158,12 @@ long scm_prot2type(prot) case MAKINUM(-16L): return tc7_svect; case MAKINUM(-8L): return tc7_svect; } - /* if INUMP(prot) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; */ - if IMP(prot) return tc7_vector; + /* if (INUMP(prot)) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; */ + if (IMP(prot)) return tc7_vector; # ifdef FLOATS - if INEXP(prot) { + if (INEXP(prot)) { double x; - if CPLXP(prot) return tc7_cvect; + if (CPLXP(prot)) return tc7_cvect; x = REALPART(prot); if (32.0==x) return tc7_fvect; if (64.0==x) return tc7_dvect; @@ -223,7 +223,7 @@ SCM arrayp(v, prot) { int enclosed = 0; long typ; - if IMP(v) return BOOL_F; + if (IMP(v)) return BOOL_F; loop: typ = TYP7(v); switch (typ) { @@ -249,14 +249,14 @@ SCM arrayp(v, prot) SCM array_rank(ra) SCM ra; { - if IMP(ra) return INUM0; + if (IMP(ra)) return INUM0; switch (TYP7(ra)) { default: return INUM0; case tc7_vector: case tcs_uves: return MAKINUM(1L); case tc7_smob: - if ARRAYP(ra) return MAKINUM(ARRAY_NDIM(ra)); + if (ARRAYP(ra)) return MAKINUM(ARRAY_NDIM(ra)); return INUM0; } } @@ -267,7 +267,7 @@ SCM array_dims(ra) SCM res=EOL; sizet k; array_dim *s; - if IMP(ra) return BOOL_F; + if (IMP(ra)) return BOOL_F; switch (TYP7(ra)) { default: return BOOL_F; case tc7_vector: @@ -287,14 +287,14 @@ SCM array_dims(ra) static char s_bad_ind[] = "Bad array index"; long aind(ra, args, what) SCM ra, args; - char *what; + const char *what; { SCM ind; register long j; register sizet pos = ARRAY_BASE(ra); register sizet k = ARRAY_NDIM(ra); array_dim *s = ARRAY_DIMS(ra); - if INUMP(args) { + if (INUMP(args)) { ASRTER(1==k, UNDEFINED, WNA, what); j = INUM(args); ASRTER(j >= (s->lbnd) && j <= (s->ubnd), args, OUTOFRANGE, what); @@ -333,7 +333,7 @@ static char s_bad_spec[] = "Bad array dimension"; /* Increments will still need to be set. */ SCM shap2ra(args, what) SCM args; - char *what; + const char *what; { array_dim *s; SCM ra, spec, sp; @@ -344,7 +344,7 @@ SCM shap2ra(args, what) s = ARRAY_DIMS(ra); for (; NIMP(args); s++, args = CDR(args)) { spec = CAR(args); - if IMP(spec) { + if (IMP(spec)) { ASRTER(INUMP(spec)&&INUM(spec)>=0, spec, s_bad_spec, what); s->lbnd = 0; s->ubnd = INUM(spec) - 1; @@ -371,7 +371,7 @@ int rafill(ra, fill, ignore) sizet i, n; long inc = 1; sizet base = 0; - if ARRAYP(ra) { + if (ARRAYP(ra)) { n = ARRAY_DIMS(ra)->ubnd - ARRAY_DIMS(ra)->lbnd + 1; inc = ARRAY_DIMS(ra)->inc; base = ARRAY_BASE(ra); @@ -486,10 +486,10 @@ 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) + if (NNULLP(fill)) rafill(ra, CAR(fill), UNDEFINED); return ra; } @@ -526,7 +526,7 @@ SCM dims2ura(dims, prot, fill) ARRAY_V(ra) = make_uve(rlen, prot); *((long *)VELTS(ARRAY_V(ra))) = rlen; } - if NNULLP(fill) { + if (NNULLP(fill)) { ASRTER(1==ilength(fill), UNDEFINED, WNA, s_dims2ura); rafill(ARRAY_V(ra), CAR(fill), UNDEFINED); } @@ -601,10 +601,10 @@ SCM make_sh_array(oldra, mapfunc, dims) } } imap = scm_cvapply(mapfunc, ARRAY_NDIM(ra), indv); - if ARRAYP(oldra) + if (ARRAYP(oldra)) i = (sizet)aind(oldra, imap, s_make_sh_array); else { - if NINUMP(imap) { + if (NINUMP(imap)) { ASRTER(1==ilength(imap) && INUMP(CAR(imap)), imap, s_bad_ind, s_make_sh_array); imap = CAR(imap); @@ -619,10 +619,10 @@ SCM make_sh_array(oldra, mapfunc, dims) imap = apply(mapfunc, reverse(inds), EOL); */ indv[k] = MAKINUM(INUM(indv[k]) + 1); imap = scm_cvapply(mapfunc, ARRAY_NDIM(ra), indv); - if ARRAYP(oldra) + if (ARRAYP(oldra)) s[k].inc = aind(oldra, imap, s_make_sh_array) - i; else { - if NINUMP(imap) { + if (NINUMP(imap)) { ASRTER(1==ilength(imap) && INUMP(CAR(imap)), imap, s_bad_ind, s_make_sh_array); imap = CAR(imap); @@ -723,7 +723,7 @@ SCM encl_array(axes) ASRTER(NIMP(axes), UNDEFINED, WNA, s_encl_array); ra = CAR(axes); axes = CDR(axes); - if NULLP(axes) + if (NULLP(axes)) axes = cons((ARRAYP(ra) ? MAKINUM(ARRAY_NDIM(ra) - 1) : INUM0), EOL); ninr = ilength(axes); ra_inr = make_ra(ninr); @@ -780,11 +780,11 @@ SCM array_inbp(args) ASRTGO(NIMP(args), wna); v = CAR(args); args = CDR(args); - if IMP(v) goto scalar; + if (IMP(v)) goto scalar; switch TYP7(v) { wna: wta(UNDEFINED, (char *)WNA, s_array_inbp); default: scalar: - if NULLP(args) return BOOL_T; + if (NULLP(args)) return BOOL_T; wta(v, (char *)ARG1, s_array_inbp); case tc7_smob: if (ARRAYP(v)) { @@ -818,16 +818,16 @@ SCM aref(v, args) SCM v, args; { long pos; - if IMP(v) { + if (IMP(v)) { ASRTGO(NULLP(args), badarg); return v; } - else if ARRAYP(v) { + else if (ARRAYP(v)) { pos = aind(v, args, s_aref); v = ARRAY_V(v); } else { - if NIMP(args) { + if (NIMP(args)) { ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aref); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); @@ -839,7 +839,7 @@ SCM aref(v, args) ASRTGO(pos >= 0 && pos < LENGTH(v), outrng); } switch TYP7(v) { - default: if NULLP(args) return v; + default: if (NULLP(args)) return v; badarg: wta(v, (char *)ARG1, s_aref); outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_aref); wna: wta(UNDEFINED, (char *)WNA, s_aref); @@ -995,12 +995,12 @@ SCM aset(v, obj, args) { long pos; ASRTGO(NIMP(v), badarg1); - if ARRAYP(v) { + if (ARRAYP(v)) { pos = aind(v, args, s_aset); v = ARRAY_V(v); } else { - if NIMP(args) { + if (NIMP(args)) { ASRTER(CONSP(args) && INUMP(CAR(args)), args, ARG2, s_aset); pos = INUM(CAR(args)); ASRTGO(NULLP(CDR(args)), wna); @@ -1067,7 +1067,7 @@ SCM array_contents(ra, strict) SCM ra, strict; { SCM sra; - if IMP(ra) return BOOL_F; + if (IMP(ra)) return BOOL_F; switch TYP7(ra) { default: return BOOL_F; @@ -1105,7 +1105,7 @@ SCM uve_read(v, port) { long sz, len, ans; long start=0; - if UNBNDP(port) port = cur_inp; + if (UNBNDP(port)) port = cur_inp; ASRTER(NIMP(port) && OPINFPORTP(port), port, ARG2, s_uve_rd); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); @@ -1115,7 +1115,7 @@ SCM uve_read(v, port) case tc7_smob: v = array_contents(v, BOOL_T); ASRTGO(NIMP(v), badarg1); - if ARRAYP(v) { + if (ARRAYP(v)) { array_dim *d = ARRAY_DIMS(v); start = ARRAY_BASE(v); len = d->inc * (d->ubnd - d->lbnd + 1); @@ -1152,7 +1152,7 @@ SCM uve_read(v, port) if (0==len) return INUM0; /* An ungetc before an fread will not work on some systems if setbuf(0), so we read one element char by char. */ - if CRDYP(port) { + if (CRDYP(port)) { int i; for (i = 0; i < sz; i++) CHARS(v)[start*sz + i] = lgetc(port); @@ -1170,7 +1170,7 @@ SCM uve_write(v, port) { long sz, len, ans; long start=0; - if UNBNDP(port) port = cur_outp; + if (UNBNDP(port)) port = cur_outp; ASRTER(NIMP(port) && OPOUTFPORTP(port), port, ARG2, s_uve_wr); ASRTGO(NIMP(v), badarg1); len = LENGTH(v); @@ -1180,7 +1180,7 @@ SCM uve_write(v, port) case tc7_smob: v = array_contents(v, BOOL_T); ASRTGO(NIMP(v), badarg1); - if ARRAYP(v) { + if (ARRAYP(v)) { array_dim *d = ARRAY_DIMS(v); start = ARRAY_BASE(v); len = d->inc * (d->ubnd - d->lbnd + 1); @@ -1237,13 +1237,13 @@ SCM lcount(item, seq) i = ubnd/LONG_BIT; imin = lbnd/LONG_BIT; w = VELTS(seq)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; w <<= LONG_BIT-1-(ubnd%LONG_BIT); w >>= LONG_BIT-1-(ubnd%LONG_BIT); /* There may be only a partial word. */ while (imin < i--) { for(;w;w >>= 4) cnt += cnt_tab[w & 0x0f]; w = VELTS(seq)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; } w >>= (lbnd%LONG_BIT); for(;w;w >>= 4) cnt += cnt_tab[w & 0x0f]; @@ -1258,7 +1258,7 @@ 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++; } @@ -1300,7 +1300,7 @@ SCM bit_position(item, v, k) lenw = (len-1)/LONG_BIT; /* watch for part words */ i = pos/LONG_BIT; w = VELTS(v)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; xbits = (pos%LONG_BIT); pos -= xbits; w = ((w >> xbits) << xbits); @@ -1319,7 +1319,7 @@ SCM bit_position(item, v, k) if (++i > lenw) break; pos += LONG_BIT; w = VELTS(v)[i]; - if FALSEP(item) w = ~w; + if (FALSEP(item)) w = ~w; } return BOOL_F; case tc7_smob: ASRTGO(ARRAYP(v) && 1==ARRAY_NDIM(v) && !enclosed++, badarg2); @@ -1665,7 +1665,7 @@ SCM list2ura(ndim, prot, lst) aset(ra, CAR(lst), MAKINUM(k)); return ra; } - if NULLP(shp) { + if (NULLP(shp)) { aset(ra, lst, EOL); return ra; } @@ -1693,7 +1693,7 @@ static int l2ra(lst, ra, base, k) base += inc; lst = CDR(lst); } - if NNULLP(lst) return 0; + if (NNULLP(lst)) return 0; } else { while (n--) { @@ -1702,7 +1702,7 @@ static int l2ra(lst, ra, base, k) base += inc; lst = CDR(lst); } - if NNULLP(lst) return 0; + if (NNULLP(lst)) return 0; } return ok; } @@ -1746,7 +1746,7 @@ static void rapr1(ra, j, k, port, writing) } break; } - if ARRAY_NDIM(ra) { /* Could be zero-dimensional */ + if (ARRAY_NDIM(ra)) { /* Could be zero-dimensional */ inc = ARRAY_DIMS(ra)[k].inc; n = (ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1); } @@ -1821,7 +1821,7 @@ int raprin1(exp, port, writing) long ndim = ARRAY_NDIM(v); base = ARRAY_BASE(v); v = ARRAY_V(v); - if ARRAYP(v) { + if (ARRAYP(v)) { lputs("<enclosed-array ", port); rapr1(exp, base, 0, port, writing); lputc('>', port); @@ -1930,13 +1930,13 @@ SCM scm_logaref(args) ASRTER(NIMP(args), UNDEFINED, WNA, s_logaref); ra = CAR(args); ASRTER(NIMP(ra), ra, ARG1, s_logaref); - if ARRAYP(ra) rank = ARRAY_NDIM(ra); + if (ARRAYP(ra)) rank = ARRAY_NDIM(ra); inds = args = CDR(args); for (i = rank; i; i--) { ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaref); args = CDR(args); } - if NULLP(args) return aref(ra, inds); + if (NULLP(args)) return aref(ra, inds); ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)), inds, WNA, s_logaref); ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaref); @@ -1964,13 +1964,13 @@ SCM scm_logaset(ra, obj, args) SCM oval, inds, ibit; int i, rank = 1; ASRTER(NIMP(ra), ra, ARG1, s_logaset); - if ARRAYP(ra) rank = ARRAY_NDIM(ra); + if (ARRAYP(ra)) rank = ARRAY_NDIM(ra); inds = args; for (i = rank; i; i--) { ASRTER(NIMP(args) && CONSP(args), UNDEFINED, WNA, s_logaset); args = CDR(args); } - if NNULLP(args) { + if (NNULLP(args)) { ASRTER(NIMP(args) && CONSP(args) && NULLP(CDR(args)), inds, WNA, s_logaset); ASRTER(INUMP(CAR(args)), CAR(args), ARGn, s_logaset); |