63 |
#define N_FIXNUM_ARGS 6 |
#define N_FIXNUM_ARGS 6 |
64 |
|
|
65 |
DEFUNO_NEW("AREF", object, fLaref, LISP, 1, ARRAY_RANK_LIMIT, |
DEFUNO_NEW("AREF", object, fLaref, LISP, 1, ARRAY_RANK_LIMIT, |
66 |
NONE, OO, II, II, II,void,Laref,(object x, int i, ...),"") |
NONE, OO, II, II, II,void,Laref,(object x,fixnum i, ...),"") |
67 |
{ int n = VFUN_NARGS; |
{ int n = VFUN_NARGS; |
68 |
int i1; |
int i1; |
69 |
va_list ap; |
va_list ap; |
90 |
if (m <= rank) |
if (m <= rank) |
91 |
{ i1 = i1 * x->a.a_dims[m]; |
{ i1 = i1 * x->a.a_dims[m]; |
92 |
if (m < N_FIXNUM_ARGS) |
if (m < N_FIXNUM_ARGS) |
93 |
{ k = va_arg(ap,int);} |
{ k = va_arg(ap,fixnum);} |
94 |
else {object x = va_arg(ap,object); |
else {object x = va_arg(ap,object); |
95 |
check_type(x,t_fixnum); |
check_type(x,t_fixnum); |
96 |
k = Mfix(x);} |
k = Mfix(x);} |
122 |
} |
} |
123 |
|
|
124 |
DEFUNO_NEW("SVREF", object, fLsvref, LISP, 2, 2, |
DEFUNO_NEW("SVREF", object, fLsvref, LISP, 2, 2, |
125 |
ONE_VAL, OO, IO, OO,OO,void,Lsvref,(object x, unsigned int i), |
ONE_VAL, OO, IO, OO,OO,void,Lsvref,(object x,ufixnum i), |
126 |
"For array X and index I it returns (aref x i) ") |
"For array X and index I it returns (aref x i) ") |
127 |
{ |
{ |
128 |
if (type_of(x)==t_vector |
if (type_of(x)==t_vector |
135 |
} |
} |
136 |
|
|
137 |
DEFUN_NEW("ROW-MAJOR-AREF", object, fLrow_major_aref, LISP, 2, 2, |
DEFUN_NEW("ROW-MAJOR-AREF", object, fLrow_major_aref, LISP, 2, 2, |
138 |
NONE, OO, IO, OO,OO,(object x, int i), |
NONE, OO, IO, OO,OO,(object x,fixnum i), |
139 |
"For array X and index I it returns (aref x i) as if x were \ |
"For array X and index I it returns (aref x i) as if x were \ |
140 |
1 dimensional, even though its rank may be bigger than 1") |
1 dimensional, even though its rank may be bigger than 1") |
141 |
{ |
{ |
182 |
} |
} |
183 |
|
|
184 |
object |
object |
185 |
aset1(object x,int i,object val) { |
aset1(object x,fixnum i,object val) { |
186 |
return fSaset1(x,i,val); |
return fSaset1(x,i,val); |
187 |
} |
} |
188 |
|
|
189 |
DEFUN_NEW("ASET1", object, fSaset1, SI, 3, 3, NONE, OO, IO, OO,OO,(object x, int i,object val),"") |
DEFUN_NEW("ASET1", object, fSaset1, SI, 3, 3, NONE, OO, IO, OO,OO,(object x, fixnum i,object val),"") |
190 |
{ |
{ |
191 |
switch (type_of(x)) { |
switch (type_of(x)) { |
192 |
case t_array: |
case t_array: |
257 |
} |
} |
258 |
|
|
259 |
DEFUNO_NEW("ASET", object, fSaset, SI, 1, ARG_LIMIT, NONE, OO, |
DEFUNO_NEW("ASET", object, fSaset, SI, 1, ARG_LIMIT, NONE, OO, |
260 |
IO, OO, OO,void,siLaset,(object x,int i,object y, ...),"") |
IO, OO, OO,void,siLaset,(object x,fixnum i,object y, ...),"") |
261 |
{ int i1; |
{ int i1; |
262 |
int n = VFUN_NARGS; |
int n = VFUN_NARGS; |
263 |
va_list ap; |
va_list ap; |
316 |
} |
} |
317 |
|
|
318 |
DEFUNO_NEW("SVSET", object, fSsvset, SI, 3, 3, NONE, OO, IO, OO, |
DEFUNO_NEW("SVSET", object, fSsvset, SI, 3, 3, NONE, OO, IO, OO, |
319 |
OO,void,siLsvset,(object x,int i,object val),"") |
OO,void,siLsvset,(object x,fixnum i,object val),"") |
320 |
{ if (TYPE_OF(x) != t_vector |
{ if (TYPE_OF(x) != t_vector |
321 |
|| DISPLACED_TO(x) != Cnil) |
|| DISPLACED_TO(x) != Cnil) |
322 |
Wrong_type_error("simple array",0); |
Wrong_type_error("simple array",0); |
335 |
|
|
336 |
|
|
337 |
DEFUN_NEW("MAKE-VECTOR1",object,fSmake_vector1,SI,3,8,NONE,OI, |
DEFUN_NEW("MAKE-VECTOR1",object,fSmake_vector1,SI,3,8,NONE,OI, |
338 |
IO,OO,OO,(int n,int elt_type,object staticp,...),"") |
IO,OO,OO,(fixnum n,fixnum elt_type,object staticp,...),"") |
339 |
|
|
340 |
{ |
{ |
341 |
int displaced_index_offset=0; |
int displaced_index_offset=0; |
430 |
static object DFLT_aet_object = Cnil; |
static object DFLT_aet_object = Cnil; |
431 |
static char DFLT_aet_ch = ' '; |
static char DFLT_aet_ch = ' '; |
432 |
static char DFLT_aet_char = 0; |
static char DFLT_aet_char = 0; |
433 |
static int DFLT_aet_fix = 0 ; |
static fixnum DFLT_aet_fix = 0 ; |
434 |
static short DFLT_aet_short = 0; |
static short DFLT_aet_short = 0; |
435 |
static shortfloat DFLT_aet_sf = 0.0; |
static shortfloat DFLT_aet_sf = 0.0; |
436 |
static longfloat DFLT_aet_lf = 0.0; |
static longfloat DFLT_aet_lf = 0.0; |
502 |
|
|
503 |
DEFUN_NEW("MAKE-ARRAY1",object,fSmake_array1,SI,6,6, |
DEFUN_NEW("MAKE-ARRAY1",object,fSmake_array1,SI,6,6, |
504 |
NONE,OI,OO,OI,OO, |
NONE,OI,OO,OI,OO, |
505 |
(int elt_type,object staticp,object initial_element,object displaced_to, int displaced_index_offset, |
(fixnum elt_type,object staticp,object initial_element,object displaced_to,fixnum displaced_index_offset, |
506 |
object dimensions),"") |
object dimensions),"") |
507 |
{ |
{ |
508 |
int rank = length(dimensions); |
int rank = length(dimensions); |
801 |
*/ |
*/ |
802 |
|
|
803 |
DEFUN_NEW("COPY-ARRAY-PORTION",object,fScopy_array_portion,SI,4, |
DEFUN_NEW("COPY-ARRAY-PORTION",object,fScopy_array_portion,SI,4, |
804 |
5,NONE,OO,OI,IO,OO,(object x,object y,int i1,int i2,object n1o), |
5,NONE,OO,OI,IO,OO,(object x,object y,fixnum i1,fixnum i2,object n1o), |
805 |
"Copy elements from X to Y starting at x[i1] to x[i2] and doing N1 \ |
"Copy elements from X to Y starting at x[i1] to x[i2] and doing N1 \ |
806 |
elements if N1 is supplied otherwise, doing the length of X - I1 \ |
elements if N1 is supplied otherwise, doing the length of X - I1 \ |
807 |
elements. If the types of the arrays are not the same, this has \ |
elements. If the types of the arrays are not the same, this has \ |
896 |
} |
} |
897 |
|
|
898 |
DEFUNO_NEW("FILL-POINTER-SET",object,fSfill_pointer_set,SI,2,2, |
DEFUNO_NEW("FILL-POINTER-SET",object,fSfill_pointer_set,SI,2,2, |
899 |
NONE,OO,IO,OO,OO,void,siLfill_pointer_set,(object x,int i),"") |
NONE,OO,IO,OO,OO,void,siLfill_pointer_set,(object x,fixnum i),"") |
900 |
{ |
{ |
901 |
|
|
902 |
if (!(TS_MEMBER(type_of(x),TS(t_vector)| |
if (!(TS_MEMBER(type_of(x),TS(t_vector)| |
983 |
} |
} |
984 |
|
|
985 |
DEFUNO_NEW("ARRAY-DIMENSION",object,fLarray_dimension,LISP,2,2, |
DEFUNO_NEW("ARRAY-DIMENSION",object,fLarray_dimension,LISP,2,2, |
986 |
NONE,OO,IO,OO,OO,void,Larray_dimension,(object x,int i),"") |
NONE,OO,IO,OO,OO,void,Larray_dimension,(object x,fixnum i),"") |
987 |
{ |
{ |
988 |
if (type_of(x) == t_array) |
if (type_of(x) == t_array) |
989 |
{ if ((unsigned int)i >= x->a.a_rank) |
{ if ((unsigned int)i >= x->a.a_rank) |