/[gcl]/gcl/o/array.c
ViewVC logotype

Diff of /gcl/o/array.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.19 by camm, Thu Feb 27 15:50:59 2003 UTC revision 1.20 by camm, Sat Mar 1 22:37:37 2003 UTC
# Line 63  extern short aet_sizes[]; Line 63  extern short aet_sizes[];
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;
# Line 90  DEFUNO_NEW("AREF", object, fLaref, LISP, Line 90  DEFUNO_NEW("AREF", object, fLaref, LISP,
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);}
# Line 122  fScheck_bounds_bounds(object x, int i) Line 122  fScheck_bounds_bounds(object x, int i)
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
# Line 135  DEFUNO_NEW("SVREF", object, fLsvref, LIS Line 135  DEFUNO_NEW("SVREF", object, fLsvref, LIS
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  {  {
# Line 182  DEFUN_NEW("ROW-MAJOR-AREF", object, fLro Line 182  DEFUN_NEW("ROW-MAJOR-AREF", object, fLro
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:
# Line 257  DEFUN_NEW("ASET1", object, fSaset1, SI, Line 257  DEFUN_NEW("ASET1", object, fSaset1, SI,
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;
# Line 316  DEFUNO_NEW("ASET", object, fSaset, SI, 1 Line 316  DEFUNO_NEW("ASET", object, fSaset, SI, 1
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);
# Line 335  DEFUNO_NEW("SVSET", object, fSsvset, SI, Line 335  DEFUNO_NEW("SVSET", object, fSsvset, SI,
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;
# Line 430  DEFUN_NEW("MAKE-VECTOR1",object,fSmake_v Line 430  DEFUN_NEW("MAKE-VECTOR1",object,fSmake_v
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;    
# Line 502  DEFUNO_NEW("MAKE-VECTOR",object,fSmake_v Line 502  DEFUNO_NEW("MAKE-VECTOR",object,fSmake_v
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);
# Line 801  gset(void *p1, void *val, int n, int typ Line 801  gset(void *p1, void *val, int n, int typ
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 \
# Line 896  array_allocself(object x, int staticp, o Line 896  array_allocself(object x, int staticp, o
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)|
# Line 983  DEFUNO_NEW("ARRAY-RANK",object,fLarray_r Line 983  DEFUNO_NEW("ARRAY-RANK",object,fLarray_r
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)

Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26