summaryrefslogtreecommitdiffstats
path: root/unif.c
diff options
context:
space:
mode:
Diffstat (limited to 'unif.c')
-rw-r--r--unif.c424
1 files changed, 270 insertions, 154 deletions
diff --git a/unif.c b/unif.c
index c5fde47..b84e9e3 100644
--- a/unif.c
+++ b/unif.c
@@ -45,12 +45,13 @@
The set of uniform vector types is:
Vector of: Called:
char string
-boolean bvect
-signed int ivect
-unsigned int uvect
-float fvect
-double dvect
-complex double cvect
+boolean Vbool
+signed int VfixZ32
+unsigned int VfixN32
+float VfloR32
+complex float VfloC32
+double VfloR64
+complex double VfloC64
*/
#include "scm.h"
@@ -85,24 +86,32 @@ SCM resizuve(vect, len)
sz = sizeof(SCM);
break;
#ifdef ARRAYS
- case tc7_bvect:
+ case tc7_Vbool:
ol = (ol+LONG_BIT-1)/LONG_BIT;
l = (l+LONG_BIT-1)/LONG_BIT;
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
sz = sizeof(long);
break;
- case tc7_svect:
+ case tc7_VfixN16:
+ case tc7_VfixZ16:
sz = sizeof(short);
break;
+ case tc7_VfixN8:
+ case tc7_VfixZ8:
+ sz = sizeof(char);
+ break;
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
sz = sizeof(float);
break;
- case tc7_dvect:
+ case tc7_VfloC32:
+ sz = 2*sizeof(float);
+ break;
+ case tc7_VfloR64:
sz = sizeof(double);
break;
- case tc7_cvect:
+ case tc7_VfloC64:
sz = 2*sizeof(double);
break;
# endif
@@ -150,24 +159,24 @@ long scm_prot2type(prot)
{
if (ICHRP(prot)) return tc7_string;
switch (prot) {
- case BOOL_T: return tc7_bvect;
- case MAKINUM(8L):
- case MAKINUM(16L):
- case MAKINUM(32L): return tc7_uvect;
- case MAKINUM(-32L): return tc7_ivect;
- case MAKINUM(-16L): return tc7_svect;
- case MAKINUM(-8L): return tc7_svect;
- }
- /* if (INUMP(prot)) return INUM(prot) > 0 ? tc7_uvect : tc7_ivect; */
+ case BOOL_T: return tc7_Vbool;
+ case MAKINUM(8L): return tc7_VfixN8;
+ case MAKINUM(16L): return tc7_VfixN16;
+ case MAKINUM(32L): return tc7_VfixN32;
+ case MAKINUM(-32L): return tc7_VfixZ32;
+ case MAKINUM(-16L): return tc7_VfixZ16;
+ case MAKINUM(-8L): return tc7_VfixZ8;
+ }
+ /* if (INUMP(prot)) return INUM(prot) > 0 ? tc7_VfixN32 : tc7_VfixZ32; */
if (IMP(prot)) return tc7_vector;
# ifdef FLOATS
if (INEXP(prot)) {
double x;
- if (CPLXP(prot)) return tc7_cvect;
+ if (CPLXP(prot)) return (32.0==IMAG(prot)) ? tc7_VfloC32 : tc7_VfloC64;
x = REALPART(prot);
- if (32.0==x) return tc7_fvect;
- if (64.0==x) return tc7_dvect;
- return tc7_dvect;
+ if (32.0==x) return tc7_VfloR32;
+ if (64.0==x) return tc7_VfloR64;
+ return tc7_VfloR64;
}
# endif
return tc7_vector;
@@ -184,26 +193,35 @@ SCM make_uve(k, prot)
default:
case tc7_vector: /* Huge non-unif vectors are NOT supported. */
return make_vector(MAKINUM(k), UNDEFINED); /* no special vector */
- case tc7_bvect:
+ case tc7_Vbool:
i = sizeof(long)*((k+LONG_BIT-1)/LONG_BIT);
break;
case tc7_string:
i = sizeof(char)*(k + 1);
break;
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
i = sizeof(long)*k;
break;
- case tc7_svect:
+ case tc7_VfixN16:
+ case tc7_VfixZ16:
i = sizeof(short)*k;
+ break;
+ case tc7_VfixN8:
+ case tc7_VfixZ8:
+ i = sizeof(char)*k;
+ break;
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
i = sizeof(float)*k;
break;
- case tc7_dvect:
+ case tc7_VfloC32:
+ i = 2*sizeof(float)*k;
+ break;
+ case tc7_VfloR64:
i = sizeof(double)*k;
break;
- case tc7_cvect:
+ case tc7_VfloC64:
i = 2*sizeof(double)*k;
break;
# endif
@@ -232,14 +250,18 @@ SCM arrayp(v, prot)
if (enclosed++) return BOOL_F;
v = ARRAY_V(v);
goto loop;
- case tc7_bvect:
+ case tc7_Vbool:
case tc7_string:
- case tc7_uvect:
- case tc7_ivect:
- case tc7_svect:
- case tc7_fvect:
- case tc7_dvect:
- case tc7_cvect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
+ case tc7_VfixN16:
+ case tc7_VfixZ16:
+ case tc7_VfixN8:
+ case tc7_VfixZ8:
+ case tc7_VfloR32:
+ case tc7_VfloC32:
+ case tc7_VfloR64:
+ case tc7_VfloC64:
case tc7_vector:
if (UNBNDP(prot)) return BOOL_T;
if (scm_prot2type(prot)==typ) return BOOL_T;
@@ -399,7 +421,7 @@ int rafill(ra, fill, ignore)
ve[i] = f;
break;
}
- case tc7_bvect: {
+ case tc7_Vbool: {
long *ve = (long *)VELTS(ra);
if (1==inc && (n >= LONG_BIT || n==LENGTH(ra))) {
i = base/LONG_BIT;
@@ -432,11 +454,11 @@ int rafill(ra, fill, ignore)
}
break;
}
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
{
long *ve = VELTS(ra);
- long f = (tc7_uvect==TYP7(ra) ?
+ long f = (tc7_VfixN32==TYP7(ra) ?
num2ulong(fill, (char *)ARG2, s_array_fill) :
num2long(fill, (char *)ARG2, s_array_fill));
for (i = base; n--; i += inc)
@@ -444,21 +466,36 @@ int rafill(ra, fill, ignore)
break;
}
# ifdef FLOATS
- case tc7_fvect: {
+ case tc7_VfloR32: {
float *ve = (float *)VELTS(ra);
float f = num2dbl(fill, (char *)ARG2, s_array_fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
}
- case tc7_dvect: {
+ case tc7_VfloC32: {
+ float fr, fi=0.0;
+ float (*ve)[2] = (float (*)[2])VELTS(ra);
+ if (NIMP(fill) && CPLXP(fill)) {
+ fr = REAL(fill);
+ fi = IMAG(fill);
+ }
+ else
+ fr = num2dbl(fill, (char *)ARG2, s_array_fill);
+ for (i = base; n--; i += inc) {
+ ve[i][0] = fr;
+ ve[i][1] = fi;
+ }
+ break;
+ }
+ case tc7_VfloR64: {
double *ve = (double *)VELTS(ra);
double f = num2dbl(fill, (char *)ARG2, s_array_fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
}
- case tc7_cvect: {
+ case tc7_VfloC64: {
double fr, fi=0.0;
double (*ve)[2] = (double (*)[2])VELTS(ra);
if (NIMP(fill) && CPLXP(fill)) {
@@ -515,11 +552,12 @@ SCM dims2ura(dims, prot, fill)
switch TYP7(make_uve(0L, prot)) {
default: bit = LONG_BIT; break;
case tc7_vector: wta(dims, (char *)OUTOFRANGE, s_dims2ura);
- case tc7_bvect: bit = 1; break;
+ case tc7_Vbool: bit = 1; break;
case tc7_string: bit = CHAR_BIT; break;
- case tc7_fvect: bit = sizeof(float)*CHAR_BIT/sizeof(char); break;
- case tc7_dvect: bit = sizeof(double)*CHAR_BIT/sizeof(char); break;
- case tc7_cvect: bit = 2*sizeof(double)*CHAR_BIT/sizeof(char); break;
+ case tc7_VfloR32: bit = sizeof(float)*CHAR_BIT/sizeof(char); break;
+ case tc7_VfloC32: bit = 2*sizeof(float)*CHAR_BIT/sizeof(char); break;
+ case tc7_VfloR64: bit = sizeof(double)*CHAR_BIT/sizeof(char); break;
+ case tc7_VfloC64: bit = 2*sizeof(double)*CHAR_BIT/sizeof(char); break;
}
ARRAY_BASE(ra) = (LONG_BIT + bit - 1)/bit;
rlen += ARRAY_BASE(ra);
@@ -859,30 +897,39 @@ SCM aref(v, args)
}
return res;
}
- case tc7_bvect:
+ case tc7_Vbool:
if (VELTS(v)[pos/LONG_BIT]&(1L<<(pos%LONG_BIT)))
return BOOL_T;
else return BOOL_F;
case tc7_string:
return MAKICHR(CHARS(v)[pos]);
- case tc7_svect:
+ case tc7_VfixN8:
+ return MAKINUM(((unsigned char *)CDR(v))[pos]);
+ case tc7_VfixZ8:
+ return MAKINUM(((signed char *)CDR(v))[pos]);
+ case tc7_VfixN16:
+ return MAKINUM(((unsigned short *)CDR(v))[pos]);
+ case tc7_VfixZ16:
return MAKINUM(((short *)CDR(v))[pos]);
# ifdef INUMS_ONLY
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
return MAKINUM(VELTS(v)[pos]);
# else
- case tc7_uvect:
+ case tc7_VfixN32:
return ulong2num(VELTS(v)[pos]);
- case tc7_ivect:
+ case tc7_VfixZ32:
return long2num(VELTS(v)[pos]);
# endif
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
return makflo(((float *)CDR(v))[pos]);
- case tc7_dvect:
+ case tc7_VfloC32:
+ return makdbl(((float *)CDR(v))[2*pos],
+ ((float *)CDR(v))[2*pos+1]);
+ case tc7_VfloR64:
return makdbl(((double *)CDR(v))[pos], 0.0);
- case tc7_cvect:
+ case tc7_VfloC64:
return makdbl(((double *)CDR(v))[2*pos],
((double *)CDR(v))[2*pos+1]);
# endif
@@ -906,26 +953,58 @@ SCM cvref(v, pos, last)
{
switch TYP7(v) {
default: wta(v, (char *)ARG1, "PROGRAMMING ERROR: cvref");
- case tc7_bvect:
+ case tc7_smob: { /* enclosed array */
+ int k = ARRAY_NDIM(v);
+ if (IMP(last) || (!ARRAYP(last))) {
+ last = make_ra(k);
+ ARRAY_V(last) = ARRAY_V(v);
+ ARRAY_BASE(last) = pos;
+ while (k--) {
+ ARRAY_DIMS(last)[k].ubnd = ARRAY_DIMS(v)[k].ubnd;
+ ARRAY_DIMS(last)[k].lbnd = ARRAY_DIMS(v)[k].lbnd;
+ ARRAY_DIMS(last)[k].inc = ARRAY_DIMS(v)[k].inc;
+ }
+ }
+ return last;
+ }
+ case tc7_Vbool:
if (VELTS(v)[pos/LONG_BIT]&(1L<<(pos%LONG_BIT)))
return BOOL_T;
else return BOOL_F;
case tc7_string:
return MAKICHR(CHARS(v)[pos]);
- case tc7_svect:
+ case tc7_VfixN8:
+ return MAKINUM(((unsigned char *)CDR(v))[pos]);
+ case tc7_VfixZ8:
+ return MAKINUM(((signed char *)CDR(v))[pos]);
+ case tc7_VfixN16:
+ return MAKINUM(((unsigned short *)CDR(v))[pos]);
+ case tc7_VfixZ16:
return MAKINUM(((short *)CDR(v))[pos]);
# ifdef INUMS_ONLY
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
return MAKINUM(VELTS(v)[pos]);
# else
- case tc7_uvect:
+ case tc7_VfixN32:
return ulong2num(VELTS(v)[pos]);
- case tc7_ivect:
+ case tc7_VfixZ32:
return long2num(VELTS(v)[pos]);
# endif
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloC32:
+ if (0.0 != ((float *)CDR(v))[2*pos+1]) {
+ if (NIMP(last) && tc_dblc==CAR(last)) {
+ REAL(last) = ((float *)CDR(v))[2*pos];
+ IMAG(last) = ((float *)CDR(v))[2*pos+1];
+ return last;
+ }
+ return makdbl(((float *)CDR(v))[2*pos],
+ ((float *)CDR(v))[2*pos+1]);
+ }
+ else pos *= 2;
+ /* Fall through */
+ case tc7_VfloR32:
# ifdef SINGLES
if (NIMP(last) && (last != flo0) && (tc_flo==CAR(last))) {
FLO(last) = ((float *)CDR(v))[pos];
@@ -939,7 +1018,7 @@ SCM cvref(v, pos, last)
}
return makdbl((double)((float *)CDR(v))[pos], 0.0);
# endif
- case tc7_cvect:
+ case tc7_VfloC64:
if (0.0!=((double *)CDR(v))[2*pos+1]) {
if (NIMP(last) && tc_dblc==CAR(last)) {
REAL(last) = ((double *)CDR(v))[2*pos];
@@ -951,7 +1030,7 @@ SCM cvref(v, pos, last)
}
else pos *= 2;
/* Fall through */
- case tc7_dvect:
+ case tc7_VfloR64:
# ifdef CDR_DOUBLES
if (NIMP(last) && (last != flo0) && (tc_flo==CAR(last))) {
FLO(last) = ((double *)CDR(v))[pos];
@@ -961,31 +1040,17 @@ SCM cvref(v, pos, last)
# ifdef SINGLES
if (NIMP(last) && tc_dblr==CAR(last))
# else
- if (NIMP(last) && (last != flo0) && (tc_dblr==CAR(last)))
+ if (NIMP(last) && (last != flo0) && (tc_dblr==CAR(last)))
# endif
- {
- REAL(last) = ((double *)CDR(v))[pos];
- return last;
- }
+ {
+ REAL(last) = ((double *)CDR(v))[pos];
+ return last;
+ }
# endif /* ndef CDR_DOUBLES */
return makdbl(((double *)CDR(v))[pos], 0.0);
# endif /* def FLOATS */
case tc7_vector:
return VELTS(v)[pos];
- case tc7_smob: { /* enclosed array */
- int k = ARRAY_NDIM(v);
- if (IMP(last) || (!ARRAYP(last))) {
- last = make_ra(k);
- ARRAY_V(last) = ARRAY_V(v);
- while (k--) {
- ARRAY_DIMS(last)[k].ubnd = ARRAY_DIMS(v)[k].ubnd;
- ARRAY_DIMS(last)[k].lbnd = ARRAY_DIMS(v)[k].lbnd;
- ARRAY_DIMS(last)[k].inc = ARRAY_DIMS(v)[k].inc;
- }
- }
- ARRAY_BASE(last) = pos;
- return last;
- }
}
}
@@ -1017,7 +1082,7 @@ SCM aset(v, obj, args)
wna: wta(UNDEFINED, (char *)WNA, s_aset);
case tc7_smob: /* enclosed */
goto badarg1;
- case tc7_bvect:
+ case tc7_Vbool:
if (BOOL_F==obj)
VELTS(v)[pos/LONG_BIT] &= ~(1L<<(pos%LONG_BIT));
else if (BOOL_T==obj)
@@ -1027,25 +1092,41 @@ SCM aset(v, obj, args)
case tc7_string:
ASRTGO(ICHRP(obj), badarg2);
CHARS(v)[pos] = ICHR(obj); break;
- case tc7_svect:
+ case tc7_VfixN8:
+ ((unsigned char *)VELTS(v))[pos] = num2uchar(obj, (char *)ARG2, s_aset); break;
+ case tc7_VfixZ8:
+ ((signed char *)VELTS(v))[pos] = num2char(obj, (char *)ARG2, s_aset); break;
+ case tc7_VfixN16:
+ ((unsigned short *)VELTS(v))[pos] = num2ushort(obj, (char *)ARG2, s_aset); break;
+ case tc7_VfixZ16:
((short *)VELTS(v))[pos] = num2short(obj, (char *)ARG2, s_aset); break;
# ifdef INUMS_ONLY
- case tc7_uvect:
+ case tc7_VfixN32:
ASRTGO(INUM(obj) >= 0, badarg2);
- case tc7_ivect:
+ case tc7_VfixZ32:
ASRTGO(INUMP(obj), badarg2); VELTS(v)[pos] = INUM(obj); break;
# else
- case tc7_uvect:
+ case tc7_VfixN32:
VELTS(v)[pos] = num2ulong(obj, (char *)ARG2, s_aset); break;
- case tc7_ivect:
+ case tc7_VfixZ32:
VELTS(v)[pos] = num2long(obj, (char *)ARG2, s_aset); break;
# endif
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
((float*)VELTS(v))[pos] = (float)num2dbl(obj, (char *)ARG2, s_aset); break;
- case tc7_dvect:
+ case tc7_VfloC32:
+ if (NIMP(obj) && CPLXP(obj)) {
+ ((float *)CDR(v))[2*pos] = REALPART(obj);
+ ((float *)CDR(v))[2*pos+1] = IMAG(obj);
+ }
+ else {
+ ((float *)CDR(v))[2*pos] = num2dbl(obj, (char *)ARG2, s_aset);
+ ((float *)CDR(v))[2*pos+1] = 0.0;
+ }
+ break;
+ case tc7_VfloR64:
((double*)VELTS(v))[pos] = num2dbl(obj, (char *)ARG2, s_aset); break;
- case tc7_cvect:
+ case tc7_VfloC64:
if (NIMP(obj) && CPLXP(obj)) {
((double *)CDR(v))[2*pos] = REALPART(obj);
((double *)CDR(v))[2*pos+1] = IMAG(obj);
@@ -1081,7 +1162,7 @@ SCM array_contents(ra, strict)
len *= ARRAY_DIMS(ra)[k].ubnd - ARRAY_DIMS(ra)[k].lbnd + 1;
if (!UNBNDP(strict)) {
if (ndim && (1 != ARRAY_DIMS(ra)[ndim-1].inc)) return BOOL_F;
- if (tc7_bvect==TYP7(ARRAY_V(ra))) {
+ if (tc7_Vbool==TYP7(ARRAY_V(ra))) {
if (ARRAY_BASE(ra)%LONG_BIT) return BOOL_F;
if (len != LENGTH(ARRAY_V(ra)) && len%LONG_BIT) return BOOL_F;
}
@@ -1127,24 +1208,32 @@ SCM uve_read(v, port)
case tc7_string:
sz = sizeof(char);
break;
- case tc7_bvect:
+ case tc7_Vbool:
len = (len+LONG_BIT-1)/LONG_BIT;
start /= LONG_BIT;
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
sz = sizeof(long);
break;
- case tc7_svect:
+ case tc7_VfixN16:
+ case tc7_VfixZ16:
sz = sizeof(short);
break;
+ case tc7_VfixN8:
+ case tc7_VfixZ8:
+ sz = sizeof(char);
+ break;
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
sz = sizeof(float);
break;
- case tc7_dvect:
+ case tc7_VfloC32:
+ sz = 2*sizeof(float);
+ break;
+ case tc7_VfloR64:
sz = sizeof(double);
break;
- case tc7_cvect:
+ case tc7_VfloC64:
sz = 2*sizeof(double);
break;
# endif
@@ -1160,7 +1249,7 @@ SCM uve_read(v, port)
len -= 1;
}
SYSCALL(ans = fread(CHARS(v)+start*sz, (sizet)sz, (sizet)len, STREAM(port)););
- if (TYP7(v)==tc7_bvect) ans *= LONG_BIT;
+ if (TYP7(v)==tc7_Vbool) ans *= LONG_BIT;
return MAKINUM(ans);
}
@@ -1192,30 +1281,38 @@ SCM uve_write(v, port)
case tc7_string:
sz = sizeof(char);
break;
- case tc7_bvect:
+ case tc7_Vbool:
len = (len+LONG_BIT-1)/LONG_BIT;
start /= LONG_BIT;
- case tc7_uvect:
- case tc7_ivect:
+ case tc7_VfixN32:
+ case tc7_VfixZ32:
sz = sizeof(long);
break;
- case tc7_svect:
+ case tc7_VfixN16:
+ case tc7_VfixZ16:
sz = sizeof(short);
break;
+ case tc7_VfixN8:
+ case tc7_VfixZ8:
+ sz = sizeof(char);
+ break;
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
sz = sizeof(float);
break;
- case tc7_dvect:
+ case tc7_VfloC32:
+ sz = 2*sizeof(float);
+ break;
+ case tc7_VfloR64:
sz = sizeof(double);
break;
- case tc7_cvect:
+ case tc7_VfloC64:
sz = 2*sizeof(double);
break;
# endif
}
ans = lfwrite(CHARS(v)+start*sz, (sizet)sz, (sizet)len, port);
- if (TYP7(v)==tc7_bvect) ans *= LONG_BIT;
+ if (TYP7(v)==tc7_Vbool) ans *= LONG_BIT;
return MAKINUM(ans);
}
@@ -1232,7 +1329,7 @@ SCM lcount(item, seq)
tail:
switch TYP7(seq) {
default: badarg2: wta(seq, (char *)ARG2, s_count);
- case tc7_bvect:
+ case tc7_Vbool:
if (lbnd>ubnd) return INUM0;
i = ubnd/LONG_BIT;
imin = lbnd/LONG_BIT;
@@ -1293,7 +1390,7 @@ SCM bit_position(item, v, k)
tail:
switch TYP7(v) {
default: badarg2: wta(v, (char *)ARG2, s_uve_pos);
- case tc7_bvect:
+ case tc7_Vbool:
ASRTER((pos <= len) && (pos >= 0), k, OUTOFRANGE, s_uve_pos);
if (pos==len) return BOOL_F;
if (0==len) return MAKINUM(-1L);
@@ -1358,10 +1455,10 @@ SCM bit_set(v, kv, obj)
ASRTGO(NIMP(kv), badarg2);
switch TYP7(kv) {
default: badarg2: wta(kv, (char *)ARG2, s_bit_set);
- case tc7_uvect:
+ case tc7_VfixN32:
switch TYP7(v) {
default: badarg1: wta(v, (char *)ARG1, s_bit_set);
- case tc7_bvect:
+ case tc7_Vbool:
vlen = LENGTH(v);
if (BOOL_F==obj) for (i = LENGTH(kv);i;) {
k = VELTS(kv)[--i];
@@ -1377,8 +1474,8 @@ SCM bit_set(v, kv, obj)
badarg3: wta(obj, (char *)ARG3, s_bit_set);
}
break;
- case tc7_bvect:
- ASRTGO(TYP7(v)==tc7_bvect && LENGTH(v)==LENGTH(kv), badarg1);
+ case tc7_Vbool:
+ ASRTGO(TYP7(v)==tc7_Vbool && LENGTH(v)==LENGTH(kv), badarg1);
if (BOOL_F==obj)
for (k = (LENGTH(v)+LONG_BIT-1)/LONG_BIT;k--;)
VELTS(v)[k] &= ~(VELTS(kv)[k]);
@@ -1401,10 +1498,10 @@ SCM bit_count(v, kv, obj)
ASRTGO(NIMP(kv), badarg2);
switch TYP7(kv) {
default: badarg2: wta(kv, (char *)ARG2, s_bit_count);
- case tc7_uvect:
+ case tc7_VfixN32:
switch TYP7(v) {
default: badarg1: wta(v, (char *)ARG1, s_bit_count);
- case tc7_bvect:
+ case tc7_Vbool:
vlen = LENGTH(v);
if (BOOL_F==obj) for (i = LENGTH(kv);i;) {
k = VELTS(kv)[--i];
@@ -1420,8 +1517,8 @@ SCM bit_count(v, kv, obj)
badarg3: wta(obj, (char *)ARG3, s_bit_count);
}
break;
- case tc7_bvect:
- ASRTGO(TYP7(v)==tc7_bvect && LENGTH(v)==LENGTH(kv), badarg1);
+ case tc7_Vbool:
+ ASRTGO(TYP7(v)==tc7_Vbool && LENGTH(v)==LENGTH(kv), badarg1);
if (0==LENGTH(v)) return INUM0;
ASRTGO(BOOL_T==obj || BOOL_F==obj, badarg3);
obj = (BOOL_T==obj);
@@ -1445,7 +1542,7 @@ SCM bit_inv(v)
ASRTGO(NIMP(v), badarg1);
k = LENGTH(v);
switch TYP7(v) {
- case tc7_bvect:
+ case tc7_Vbool:
for (k = (k+LONG_BIT-1)/LONG_BIT;k--;)
VELTS(v)[k] = ~VELTS(v)[k];
break;
@@ -1585,7 +1682,7 @@ SCM array2list(v)
return ra2l(v, ARRAY_BASE(v), 0);
case tc7_vector: return vector2list(v);
case tc7_string: return string2list(v);
- case tc7_bvect: {
+ case tc7_Vbool: {
long *data = (long *)VELTS(v);
register unsigned long mask;
for (k = (LENGTH(v)-1)/LONG_BIT; k > 0; k--)
@@ -1596,21 +1693,21 @@ SCM array2list(v)
return res;
}
# ifdef INUMS_ONLY
- case tc7_uvect:
- case tc7_ivect: {
+ case tc7_VfixN32:
+ case tc7_VfixZ32: {
long *data = (long *)VELTS(v);
for (k = LENGTH(v) - 1; k >= 0; k--)
res = cons(MAKINUM(data[k]), res);
return res;
}
# else
- case tc7_uvect: {
+ case tc7_VfixN32: {
long *data = (long *)VELTS(v);
for (k = LENGTH(v) - 1; k >= 0; k--)
res = cons(ulong2num(data[k]), res);
return res;
}
- case tc7_ivect: {
+ case tc7_VfixZ32: {
long *data = (long *)VELTS(v);
for (k = LENGTH(v) - 1; k >= 0; k--)
res = cons(long2num(data[k]), res);
@@ -1618,19 +1715,25 @@ SCM array2list(v)
}
# endif
# ifdef FLOATS
- case tc7_fvect: {
+ case tc7_VfloR32: {
float *data = (float *)VELTS(v);
for (k = LENGTH(v) - 1; k >= 0; k--)
res = cons(makflo(data[k]), res);
return res;
}
- case tc7_dvect: {
+ case tc7_VfloC32: {
+ float (*data)[2] = (float (*)[2])VELTS(v);
+ for (k = LENGTH(v) - 1; k >= 0; k--)
+ res = cons(makdbl(data[k][0], data[k][1]), res);
+ return res;
+ }
+ case tc7_VfloR64: {
double *data = (double *)VELTS(v);
for (k = LENGTH(v) - 1; k >= 0; k--)
res = cons(makdbl(data[k], 0.0), res);
return res;
}
- case tc7_cvect: {
+ case tc7_VfloC64: {
double (*data)[2] = (double (*)[2])VELTS(v);
for (k = LENGTH(v) - 1; k >= 0; k--)
res = cons(makdbl(data[k][0], data[k][1]), res);
@@ -1772,9 +1875,9 @@ static void rapr1(ra, j, k, port, writing)
for (j += inc; n-- > 0; j += inc)
lputc(CHARS(ra)[j], port);
break;
- case tc7_uvect:
+ case tc7_VfixN32:
if (errjmp_bad) {
- ipruk("uvect", ra, port);
+ ipruk("VfixN32", ra, port);
break;
}
if (n-- > 0) intprint(VELTS(ra)[j], -10, port);
@@ -1783,7 +1886,7 @@ static void rapr1(ra, j, k, port, writing)
intprint(VELTS(ra)[j], -10, port);
}
break;
- case tc7_ivect:
+ case tc7_VfixZ32:
if (n-- > 0) intprint(VELTS(ra)[j], 10, port);
for (j += inc; n-- > 0; j += inc) {
lputc(' ', port);
@@ -1791,9 +1894,10 @@ static void rapr1(ra, j, k, port, writing)
}
break;
# ifdef FLOATS
- case tc7_fvect:
- case tc7_dvect:
- case tc7_cvect:
+ case tc7_VfloR32:
+ case tc7_VfloC32:
+ case tc7_VfloR64:
+ case tc7_VfloC64:
if (n-- > 0) {
SCM z = cvref(ra, j, UNDEFINED);
floprint(z, port, writing);
@@ -1832,7 +1936,7 @@ int raprin1(exp, port, writing)
goto tail;
}
}
- case tc7_bvect:
+ case tc7_Vbool:
if (exp==v) { /* a uve, not an array */
register long i, j, w;
lputc('*', port);
@@ -1856,24 +1960,32 @@ int raprin1(exp, port, writing)
default:
if (exp==v) lputc('1', port);
switch TYP7(v) {
- case tc7_bvect:
+ case tc7_Vbool:
lputs("A:bool", port); break;
case tc7_vector:
lputc('A', port); break;
case tc7_string:
lputs("A:char", port); break;
- case tc7_uvect:
+ case tc7_VfixN32:
lputs("A:fixN32b", port); break;
- case tc7_ivect:
+ case tc7_VfixZ32:
lputs("A:fixZ32b", port); break;
- case tc7_svect:
+ case tc7_VfixN16:
+ lputs("A:fixN16b", port); break;
+ case tc7_VfixZ16:
lputs("A:fixZ16b", port); break;
+ case tc7_VfixN8:
+ lputs("A:fixN8b", port); break;
+ case tc7_VfixZ8:
+ lputs("A:fixZ8b", port); break;
# ifdef FLOATS
- case tc7_fvect:
+ case tc7_VfloR32:
lputs("A:floR32b", port); break;
- case tc7_dvect:
+ case tc7_VfloC32:
+ lputs("A:floC32b", port); break;
+ case tc7_VfloR64:
lputs("A:floR64b", port); break;
- case tc7_cvect:
+ case tc7_VfloC64:
lputs("A:floC64b", port); break;
# endif /*FLOATS*/
}
@@ -1904,15 +2016,19 @@ SCM array_prot(ra)
ra = ARRAY_V(ra);
goto loop;
case tc7_vector: return EOL;
- case tc7_bvect: return BOOL_T;
+ case tc7_Vbool: return BOOL_T;
case tc7_string: return MAKICHR('a');
- case tc7_uvect: return MAKINUM(32L);
- case tc7_ivect: return MAKINUM(-32L);
- case tc7_svect: return MAKINUM(-16L);
+ case tc7_VfixN32: return MAKINUM(32L);
+ case tc7_VfixZ32: return MAKINUM(-32L);
+ case tc7_VfixN16: return MAKINUM(16L);
+ case tc7_VfixZ16: return MAKINUM(-16L);
+ case tc7_VfixN8: return MAKINUM(8L);
+ case tc7_VfixZ8: return MAKINUM(-8L);
# ifdef FLOATS
- case tc7_fvect: return makflo(32.0);
- case tc7_dvect: return makdbl(64.0, 0.0);
- case tc7_cvect: return makdbl(0.0, 64.0);
+ case tc7_VfloR32: return makflo(32.0);
+ case tc7_VfloC32: return makdbl(0.0, 32.0);
+ case tc7_VfloR64: return makdbl(64.0, 0.0);
+ case tc7_VfloC64: return makdbl(0.0, 64.0);
# endif
}
}
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-27 19:37:48 +0000