146 |
i += BV_OFFSET(x); |
i += BV_OFFSET(x); |
147 |
return make_fixnum(BITREF(x, i)); |
return make_fixnum(BITREF(x, i)); |
148 |
case aet_fix: |
case aet_fix: |
149 |
|
case aet_nnfix: |
150 |
return make_fixnum(x->fixa.fixa_self[i]); |
return make_fixnum(x->fixa.fixa_self[i]); |
151 |
case aet_sf: |
case aet_sf: |
152 |
return make_shortfloat(x->sfa.sfa_self[i]); |
return make_shortfloat(x->sfa.sfa_self[i]); |
153 |
case aet_lf: |
case aet_lf: |
154 |
return make_longfloat(x->lfa.lfa_self[i]); |
return make_longfloat(x->lfa.lfa_self[i]); |
155 |
case aet_char: |
case aet_char: |
156 |
|
case aet_nnchar: |
157 |
return small_fixnum(x->st.st_self[i]); |
return small_fixnum(x->st.st_self[i]); |
158 |
case aet_uchar: |
case aet_uchar: |
159 |
return small_fixnum(x->ust.ust_self[i]); |
return small_fixnum(x->ust.ust_self[i]); |
160 |
case aet_short: |
case aet_short: |
161 |
|
case aet_nnshort: |
162 |
return make_fixnum(SHORT_GCL(x, i)); |
return make_fixnum(SHORT_GCL(x, i)); |
163 |
case aet_ushort: |
case aet_ushort: |
164 |
return make_fixnum(USHORT_GCL(x, i)); |
return make_fixnum(USHORT_GCL(x, i)); |
212 |
goto AGAIN_BIT;} |
goto AGAIN_BIT;} |
213 |
break;} |
break;} |
214 |
case aet_fix: |
case aet_fix: |
215 |
|
case aet_nnfix: |
216 |
ASSURE_TYPE(val,t_fixnum); |
ASSURE_TYPE(val,t_fixnum); |
217 |
(x->fixa.fixa_self[i]) = Mfix(val); |
(x->fixa.fixa_self[i]) = Mfix(val); |
218 |
break; |
break; |
225 |
(x->lfa.lfa_self[i]) = Mlf(val); |
(x->lfa.lfa_self[i]) = Mlf(val); |
226 |
break; |
break; |
227 |
case aet_char: |
case aet_char: |
228 |
|
case aet_nnchar: |
229 |
ASSURE_TYPE(val,t_fixnum); |
ASSURE_TYPE(val,t_fixnum); |
230 |
x->st.st_self[i] = Mfix(val); |
x->st.st_self[i] = Mfix(val); |
231 |
break; |
break; |
234 |
(x->ust.ust_self[i])= Mfix(val); |
(x->ust.ust_self[i])= Mfix(val); |
235 |
break; |
break; |
236 |
case aet_short: |
case aet_short: |
237 |
|
case aet_nnshort: |
238 |
ASSURE_TYPE(val,t_fixnum); |
ASSURE_TYPE(val,t_fixnum); |
239 |
SHORT_GCL(x, i) = Mfix(val); |
SHORT_GCL(x, i) = Mfix(val); |
240 |
break; |
break; |
453 |
{(char *) &DFLT_aet_ch, &sLstring_char,},/* string-char */ |
{(char *) &DFLT_aet_ch, &sLstring_char,},/* string-char */ |
454 |
{(char *) &DFLT_aet_fix, &sLbit,}, /* bit */ |
{(char *) &DFLT_aet_fix, &sLbit,}, /* bit */ |
455 |
{(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */ |
{(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */ |
456 |
|
{(char *) &DFLT_aet_fix, &sLnon_negative_fixnum,}, /* non-neg fixnum */ |
457 |
{(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */ |
{(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */ |
458 |
{(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */ |
{(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */ |
459 |
{(char *) &DFLT_aet_char,&sLsigned_char,}, /* signed char */ |
{(char *) &DFLT_aet_char,&sLsigned_char,}, /* signed char */ |
460 |
{(char *) &DFLT_aet_char,&sLunsigned_char,}, /* unsigned char */ |
{(char *) &DFLT_aet_char,&sLnon_negative_char,}, /* non-neg char */ |
461 |
|
{(char *) &DFLT_aet_char,&sLunsigned_char,}, /* unsigned char */ |
462 |
{(char *) &DFLT_aet_short,&sLsigned_short,}, /* signed short */ |
{(char *) &DFLT_aet_short,&sLsigned_short,}, /* signed short */ |
463 |
|
{(char *) &DFLT_aet_short,&sLnon_negative_short,}, /* non-neg short */ |
464 |
{(char *) &DFLT_aet_short, &sLunsigned_short}, /* unsigned short */ |
{(char *) &DFLT_aet_short, &sLunsigned_short}, /* unsigned short */ |
465 |
}; |
}; |
466 |
|
|
469 |
for (i=0 ; i < aet_last ; i++) |
for (i=0 ; i < aet_last ; i++) |
470 |
if (x == * aet_types[i].namep) |
if (x == * aet_types[i].namep) |
471 |
return make_fixnum((enum aelttype) i); |
return make_fixnum((enum aelttype) i); |
472 |
if (x == sLlong_float || x == sLsingle_float || x == sLdouble_float) |
if (x == sLsingle_float || x == sLdouble_float) |
473 |
return make_fixnum(aet_lf); |
return make_fixnum(aet_lf); |
474 |
if (x==sLnon_negative_char) |
if (x==sLnegative_char) |
475 |
return make_fixnum(aet_char); |
return make_fixnum(aet_char); |
476 |
if (x==sLnon_negative_short) |
if (x==sLnegative_short) |
477 |
return make_fixnum(aet_short); |
return make_fixnum(aet_short); |
478 |
if (x==sLnon_negative_fixnum) |
if (x==sLnegative_fixnum || x==sLsigned_fixnum) |
479 |
return make_fixnum(aet_fix); |
return make_fixnum(aet_fix); |
480 |
return make_fixnum(aet_object); |
return make_fixnum(aet_object); |
481 |
} |
} |
807 |
u.i=-Mfix(x); |
u.i=-Mfix(x); |
808 |
break; |
break; |
809 |
case aet_fix: |
case aet_fix: |
810 |
|
case aet_nnfix: |
811 |
/* STORE_TYPED(&u,fixnum, Mfix(x)); */ |
/* STORE_TYPED(&u,fixnum, Mfix(x)); */ |
812 |
u.i=Mfix(x); |
u.i=Mfix(x); |
813 |
break; |
break; |
820 |
u.d=Mlf(x); |
u.d=Mlf(x); |
821 |
break; |
break; |
822 |
case aet_char: |
case aet_char: |
823 |
|
case aet_nnchar: |
824 |
/* STORE_TYPED(&u, char, Mfix(x)); */ |
/* STORE_TYPED(&u, char, Mfix(x)); */ |
825 |
u.c=(char)Mfix(x); |
u.c=(char)Mfix(x); |
826 |
break; |
break; |
829 |
u.uc=(unsigned char)Mfix(x); |
u.uc=(unsigned char)Mfix(x); |
830 |
break; |
break; |
831 |
case aet_short: |
case aet_short: |
832 |
|
case aet_nnshort: |
833 |
/* STORE_TYPED(&u, short, Mfix(x)); */ |
/* STORE_TYPED(&u, short, Mfix(x)); */ |
834 |
u.s=(short)Mfix(x); |
u.s=(short)Mfix(x); |
835 |
break; |
break; |
869 |
case aet_ch: GSET(p1,n,char,val); |
case aet_ch: GSET(p1,n,char,val); |
870 |
/* Note n is number of fixnum WORDS for bit */ |
/* Note n is number of fixnum WORDS for bit */ |
871 |
case aet_bit: GSET(p1,n,fixnum,val); |
case aet_bit: GSET(p1,n,fixnum,val); |
872 |
case aet_fix: GSET(p1,n,fixnum,val); |
case aet_fix:case aet_nnfix: GSET(p1,n,fixnum,val); |
873 |
case aet_sf: GSET(p1,n,shortfloat,val); |
case aet_sf: GSET(p1,n,shortfloat,val); |
874 |
case aet_lf: GSET(p1,n,longfloat,val); |
case aet_lf: GSET(p1,n,longfloat,val); |
875 |
case aet_char: GSET(p1,n,char,val); |
case aet_char:case aet_nnchar: GSET(p1,n,char,val); |
876 |
case aet_uchar: GSET(p1,n,unsigned char,val); |
case aet_uchar: GSET(p1,n,unsigned char,val); |
877 |
case aet_short: GSET(p1,n,short,val); |
case aet_short:case aet_nnshort: GSET(p1,n,short,val); |
878 |
case aet_ushort: GSET(p1,n,unsigned short,val); |
case aet_ushort: GSET(p1,n,unsigned short,val); |
879 |
default: FEerror("bad elttype",0); |
default: FEerror("bad elttype",0); |
880 |
} |
} |
954 |
break; |
break; |
955 |
case aet_ch: |
case aet_ch: |
956 |
case aet_char: |
case aet_char: |
957 |
|
case aet_nnchar: |
958 |
case aet_uchar: |
case aet_uchar: |
959 |
x->st.st_self = AR_ALLOC(*fun,n,char); |
x->st.st_self = AR_ALLOC(*fun,n,char); |
960 |
break; |
break; |
961 |
case aet_short: |
case aet_short: |
962 |
|
case aet_nnshort: |
963 |
case aet_ushort: |
case aet_ushort: |
964 |
x->ust.ust_self = (unsigned char *) AR_ALLOC(*fun,n,short); |
x->ust.ust_self = (unsigned char *) AR_ALLOC(*fun,n,short); |
965 |
break; |
break; |
967 |
n = (n+W_SIZE-1)/W_SIZE; |
n = (n+W_SIZE-1)/W_SIZE; |
968 |
SET_BV_OFFSET(x,0); |
SET_BV_OFFSET(x,0); |
969 |
case aet_fix: |
case aet_fix: |
970 |
|
case aet_nnfix: |
971 |
x->fixa.fixa_self = AR_ALLOC(*fun,n,fixnum); |
x->fixa.fixa_self = AR_ALLOC(*fun,n,fixnum); |
972 |
break; |
break; |
973 |
case aet_sf: |
case aet_sf: |
1054 |
LISP,1,1,NONE,OO,OO,OO,OO,void,Ladjustable_array_p,(object x),"") |
LISP,1,1,NONE,OO,OO,OO,OO,void,Ladjustable_array_p,(object x),"") |
1055 |
{ |
{ |
1056 |
IisArray(x); |
IisArray(x); |
1057 |
return sLt; |
switch (type_of(x)) { |
1058 |
|
case t_array: |
1059 |
|
x=x->a.a_adjustable ? Ct : Cnil; |
1060 |
|
break; |
1061 |
|
case t_string: |
1062 |
|
x=x->st.st_adjustable ? Ct : Cnil; |
1063 |
|
break; |
1064 |
|
case t_vector: |
1065 |
|
x=x->v.v_adjustable ? Ct : Cnil; |
1066 |
|
break; |
1067 |
|
case t_bitvector: |
1068 |
|
x=x->bv.bv_adjustable ? Ct : Cnil; |
1069 |
|
break; |
1070 |
|
default: |
1071 |
|
FEerror("Bad array type",0); |
1072 |
|
break; |
1073 |
|
} |
1074 |
|
return x; |
1075 |
} |
} |
1076 |
|
|
1077 |
DEFUNO_NEW("DISPLACED-ARRAY-P",object,fSdisplaced_array_p,SI,1, |
DEFUNO_NEW("DISPLACED-ARRAY-P",object,fSdisplaced_array_p,SI,1, |