Go to the documentation of this file.
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;
155 register pointer *dim=
a->c.ary.dim,p1,p2;
176 printf(
"aref %d\n", i);
178 if (isvector(
a)){
return(
vref(
a,i));}
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");
218 fp=
intval(
a->c.ary.fillpointer);
235 fp=ckintval(
a->c.ary.fillpointer);
236 vset(
a->c.ary.entity,fp+
intval(
a->c.ary.offset),argv[0]);
244 {
register pointer a=argv[1],entity,
new;
245 register int i,fp,vsize;
250 fp=ckintval(
a->c.ary.fillpointer);
251 entity=
a->c.ary.entity;
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]);
261 pointer_update(
a->c.ary.entity,entity);
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;
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;
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;
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;
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;
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;
438 while (i<(
s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]= ~(bv1[i] | bv2[i]); i++;}
456 while (i<(
s+WORD_SIZE-1)/WORD_SIZE) { rbv[i]= ~bv1[i]; i++;}
void vectorarray(context *ctx, pointer mod)
pointer SVSET(context *ctx, int n, argv)
int arrayindex(pointer a, int n, pointer *indices)
defun("ADR_TO_STRING", mod, ADR_TO_STRING)
pointer VECTORP(context *ctx, int n, argv)
pointer BITNAND(context *ctx, int n, argv)
pointer AREF(context *ctx, int n, argv)
pointer BITNOR(context *ctx, int n, argv)
pointer makevector(pointer, int)
pointer SVREF(context *ctx, int n, argv)
pointer BIT(context *ctx, int n, argv)
pointer MKINTVECTOR(context *ctx, int n, argv)
pointer SETBIT(context *ctx, int n, argv)
eusinteger_t coerceintval(pointer)
pointer vset(pointer a, int n, pointer newval)
pointer VECTOREXPUSH(context *ctx, int n, argv)
pointer BITNOT(context *ctx, int n, argv)
pointer VECTORPOP(context *ctx, int n, argv)
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
pointer BITEQV(context *ctx, int n, argv)
pointer MKVECTOR(context *ctx, int n, argv)
pointer BITXOR(context *ctx, int n, argv)
pointer ARRAYP(context *ctx, int n, argv)
pointer ASET(context *ctx, int n, argv)
pointer vref(pointer a, int n)
pointer BITIOR(context *ctx, int n, argv)
pointer BITAND(context *ctx, int n, argv)
pointer VECTORPUSH(context *ctx, int n, argv)
euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43