8 static char *
rcsid=
"@(#)$Id$";
19 for (i=0; i<
n; i++) v->
c.
vec.
v[i]=argv[i];
32 for (i=0; i<
n; i++) v->
c.
ivec.
iv[i]=bigintval(argv[i]);
45 switch(elmtypeof(a)) {
48 case ELM_BYTE:
return(
makeint(a->c.str.chars[n]));
49 case ELM_FLOAT:
return(
makeflt(a->c.fvec.fv[n]));
50 case ELM_INT: x=a->c.ivec.iv[
n];
return(mkbigint(x));
58 case ELM_BIT: x=1L<<(n % 64);
59 if (a->c.ivec.iv[n/64] & x)
return(
makeint(1));
62 case ELM_BIT: x=1<<(n % 32);
63 if (a->c.ivec.iv[n/32] & x)
return(
makeint(1));
66 case ELM_FOREIGN:
return(
makeint(((
byte *)(a->c.ivec.iv[0]))[
n]));
68 default:
return(a->c.vec.v[n]);}}
79 if (elmtypeof(a)==ELM_POINTER) {
81 return(a->
c.
vec.
v[n]);}
98 switch(elmtypeof(a)) {
102 y=(ckintval(newval) & 1L)<<(n % 64);
103 a->c.ivec.iv[n/64]=(a->c.ivec.iv[n/64] & (~ x)) | y;
108 y=(ckintval(newval) & 1)<<(n % 32);
109 a->c.ivec.iv[n/32]=a->c.ivec.iv[n/32] & (~ x) | y;
112 case ELM_BYTE:
case ELM_CHAR:
113 a->c.str.chars[
n]=ckintval(newval);
return(newval);
118 a->c.fvec.fv[
n]=
ckfltval(newval);
return(newval);
120 ((
byte *)(a->c.ivec.iv[0]))[n]=ckintval(newval);
123 pointer_update(a->c.vec.v[n],newval);
130 {
register pointer a=argv[0],newval=argv[2];
135 if (elmtypeof(a)==ELM_POINTER) {
137 pointer_update(a->
c.
vec.
v[n],newval);
142 pointer_update(a->
c.
obj.
iv[n],newval);
154 {
register int index=0,i1,i2;
164 index=index*i2 + i1; }
165 return(index+
intval(a->c.ary.offset));}
176 printf(
"aref %d\n", i);
178 if (isvector(a)){
return(
vref(a,i));}
190 register pointer val=argv[n-1];
193 if (isvector(a))
return(
vset(a,ckintval(argv[1]),val));
202 if (isnum(argv[0]))
return(
NIL);
203 else if (isarray(argv[0]))
return(
T);
204 else if (isvector(argv[0]))
return(
T);
215 printf(
"vectorpop\n");
244 {
register pointer a=argv[1],entity,
new;
245 register int i,fp,vsize;
252 vsize=vecsize(entity);
255 switch(elmtypeof(entity)) {
256 case ELM_BIT: n=(vsize+WORD_SIZE-1)/WORD_SIZE;
break;
259 for (i=0; i<
n; i++) pointer_update(new->c.vec.v[i],entity->c.vec.v[i]);
263 vset(entity,fp,argv[0]);
273 if (ispointer(a))
return(elmtypeof(a)?
T:
NIL);
280 #define isbitvector(p) (isvector(p) && (elmtypeof(p)==ELM_BIT)) 290 #if (WORD_SIZE == 64) 291 if (isbitvector(a)) {
293 x=(a->
c.
ivec.
iv[n/64]) & (1L<<(n % 64));
296 if (isbitvector(a)) {
298 x=(a->
c.
ivec.
iv[n/32]) & (1<<(n % 32));
311 val=ckintval(argv[2]) & 1;
312 #if (WORD_SIZE == 64) 313 if (isbitvector(a)) {
315 if (val) a->
c.
ivec.
iv[n/64]|= (1L<<(n%64));
316 else a->
c.
ivec.
iv[n/64]&= ~(1L<<(n%64));
319 if (isbitvector(a)) {
321 if (val) a->
c.
ivec.
iv[n/32]|= (1<<(n%32));
322 else a->
c.
ivec.
iv[n/32]&= ~(1<<(n%32));
332 register eusinteger_t *bv1, *bv2, *rbv,
s;
register long i=0;
342 bv1=argv[0]->c.ivec.iv; bv2=argv[1]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
343 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]=bv1[i] & bv2[i]; i++;}
351 register eusinteger_t *bv1, *bv2, *rbv,
s;
register long i=0;
361 bv1=argv[0]->c.ivec.iv; bv2=argv[1]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
362 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]=bv1[i] | bv2[i]; i++;}
370 register eusinteger_t *bv1, *bv2, *rbv,
s;
register long i=0;
380 bv1=argv[0]->c.ivec.iv; bv2=argv[1]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
381 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]=bv1[i] ^ bv2[i]; i++;}
389 register eusinteger_t *bv1, *bv2, *rbv,
s;
register long i=0;
399 bv1=argv[0]->c.ivec.iv; bv2=argv[1]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
400 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]= ~(bv1[i] ^ bv2[i]); i++;}
408 register eusinteger_t *bv1, *bv2, *rbv,
s;
register long i=0;
418 bv1=argv[0]->c.ivec.iv; bv2=argv[1]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
419 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]= ~(bv1[i] & bv2[i]); i++;}
427 register eusinteger_t *bv1, *bv2, *rbv,
s;
register long i=0;
437 bv1=argv[0]->c.ivec.iv; bv2=argv[1]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
438 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]= ~(bv1[i] | bv2[i]); i++;}
455 bv1=argv[0]->c.ivec.iv; rbv=result->
c.
ivec.
iv;
456 while (i<(s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]= ~bv1[i]; i++;}
pointer VECTORPOP(context *ctx, int n, argv)
pointer ARRAYP(context *ctx, int n, argv)
pointer ASET(context *ctx, int n, argv)
eusinteger_t coerceintval(pointer)
pointer BITAND(context *ctx, int n, argv)
pointer BIT(context *ctx, int n, argv)
pointer SETBIT(context *ctx, int n, argv)
pointer BITNOR(context *ctx, int n, argv)
pointer SVREF(context *ctx, int n, argv)
pointer BITEQV(context *ctx, int n, argv)
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
pointer SVSET(context *ctx, int n, argv)
pointer makevector(pointer, int)
pointer MKINTVECTOR(context *ctx, int n, argv)
int arrayindex(pointer a, int n, pointer *indices)
pointer VECTOREXPUSH(context *ctx, int n, argv)
pointer BITNOT(context *ctx, int n, argv)
pointer VECTORP(context *ctx, int n, argv)
pointer AREF(context *ctx, int n, argv)
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
pointer vset(pointer a, int n, pointer newval)
pointer vref(pointer a, int n)
pointer BITIOR(context *ctx, int n, argv)
pointer BITNAND(context *ctx, int n, argv)
pointer BITXOR(context *ctx, int n, argv)
pointer VECTORPUSH(context *ctx, int n, argv)
pointer MKVECTOR(context *ctx, int n, argv)
void vectorarray(context *ctx, pointer mod)