/[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.21 by mjthomas, Wed Jul 2 23:54:46 2003 UTC revision 1.22 by camm, Tue Jul 15 18:03:38 2003 UTC
# Line 166  DEFUN_NEW("ROW-MAJOR-AREF", object, fLro Line 166  DEFUN_NEW("ROW-MAJOR-AREF", object, fLro
166      case aet_short:      case aet_short:
167        return make_fixnum(SHORT_GCL(x, i));        return make_fixnum(SHORT_GCL(x, i));
168      case aet_ushort:      case aet_ushort:
169        return small_fixnum(USHORT_GCL(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 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.21  
changed lines
  Added in v.1.22

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