/[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.20 by camm, Sat Mar 1 22:37:37 2003 UTC revision 1.20.4.1 by camm, Wed Jul 16 02:02:51 2003 UTC
# Line 164  DEFUN_NEW("ROW-MAJOR-AREF", object, fLro Line 164  DEFUN_NEW("ROW-MAJOR-AREF", object, fLro
164      case aet_uchar:      case aet_uchar:
165        return small_fixnum(x->ust.ust_self[i]);        return small_fixnum(x->ust.ust_self[i]);
166      case aet_short:      case aet_short:
167        return make_fixnum(SHORT(x, i));        return make_fixnum(SHORT_GCL(x, i));
168      case aet_ushort:      case aet_ushort:
169        return small_fixnum(USHORT(x, i));        return make_fixnum(USHORT_GCL(x, i));
170    
171      default:      default:
172        FEerror("unknown array type",0);        FEerror("unknown array type",0);
# Line 234  DEFUN_NEW("ASET1", object, fSaset1, SI, Line 234  DEFUN_NEW("ASET1", object, fSaset1, SI,
234        break;        break;
235      case aet_short:      case aet_short:
236        ASSURE_TYPE(val,t_fixnum);        ASSURE_TYPE(val,t_fixnum);
237        SHORT(x, i) = Mfix(val);        SHORT_GCL(x, i) = Mfix(val);
238        break;        break;
239      case aet_ushort:      case aet_ushort:
240        ASSURE_TYPE(val,t_fixnum);        ASSURE_TYPE(val,t_fixnum);
241        USHORT(x, i) = Mfix(val);        USHORT_GCL(x, i) = Mfix(val);
242        break;        break;
243      default:      default:
244        FEerror("unknown array type",0);        FEerror("unknown array type",0);
# Line 739  adjust_displaced(object x, int diff) Line 739  adjust_displaced(object x, int diff)
739  static char *  static char *
740  raw_aet_ptr(object x, short int typ)  raw_aet_ptr(object x, short int typ)
741  {  /* doubles are the largest raw type */  {  /* doubles are the largest raw type */
742    static double u;  
743    if (x==Cnil) return aet_types[typ].dflt;    static union{
744        object o;char c;fixnum i;shortfloat f;longfloat d;
745        unsigned char uc;short s;unsigned short us;} u;
746    
747      if (x==Cnil)
748        return aet_types[typ].dflt;
749    
750    switch (typ){    switch (typ){
751  #define STORE_TYPED(pl,type,val) *((type *) pl) = (type) val; break;  /* #define STORE_TYPED(pl,type,val) *((type *) pl) = (type) val; break; */
752    case aet_object: STORE_TYPED(&u,object,x);    case aet_object:
753    case aet_ch:     STORE_TYPED(&u,char, char_code(x));      /* STORE_TYPED(&u,object,x); */
754    case aet_bit:    STORE_TYPED(&u,fixnum, -Mfix(x));      u.o=x;
755    case aet_fix:    STORE_TYPED(&u,fixnum, Mfix(x));      break;
756    case aet_sf:     STORE_TYPED(&u,shortfloat, Msf(x));    case aet_ch:    
757    case aet_lf:     STORE_TYPED(&u,longfloat, Mlf(x));      /* STORE_TYPED(&u,char, char_code(x)); */
758    case aet_char:   STORE_TYPED(&u, char, Mfix(x));      u.c=char_code(x);
759    case aet_uchar:  STORE_TYPED(&u, unsigned char, Mfix(x));      break;
760    case aet_short:  STORE_TYPED(&u, short, Mfix(x));    case aet_bit:    
761    case aet_ushort: STORE_TYPED(&u,unsigned short,Mfix(x));      /* STORE_TYPED(&u,fixnum, -Mfix(x)); */
762    default: FEerror("bad elttype",0);      u.i=-Mfix(x);
763        break;
764      case aet_fix:    
765        /* STORE_TYPED(&u,fixnum, Mfix(x)); */
766        u.i=Mfix(x);
767        break;
768      case aet_sf:    
769        /* STORE_TYPED(&u,shortfloat, Msf(x)); */
770        u.f=Msf(x);
771        break;
772      case aet_lf:    
773        /* STORE_TYPED(&u,longfloat, Mlf(x)); */
774        u.d=Mlf(x);
775        break;
776      case aet_char:  
777        /* STORE_TYPED(&u, char, Mfix(x)); */
778        u.c=(char)Mfix(x);
779        break;
780      case aet_uchar:  
781        /* STORE_TYPED(&u, unsigned char, Mfix(x)); */
782        u.uc=(unsigned char)Mfix(x);
783        break;
784      case aet_short:  
785        /* STORE_TYPED(&u, short, Mfix(x)); */
786        u.s=(short)Mfix(x);
787        break;
788      case aet_ushort:
789        /* STORE_TYPED(&u,unsigned short,Mfix(x)); */
790        u.us=(unsigned short)Mfix(x);
791        break;
792      default:
793        FEerror("bad elttype",0);
794        break;
795    }    }
796    return (char *)&u;    return (char *)&u;
797  }  }

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

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