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

Diff of /gcl/o/xdrfuns.c

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

revision 1.4 by camm, Sat Feb 15 00:38:28 2003 UTC revision 1.4.2.1 by camm, Thu Mar 20 15:22:55 2003 UTC
# Line 15  License for more details. Line 15  License for more details.
15    
16  */  */
17    
   
18  #ifdef HAVE_XDR  #ifdef HAVE_XDR
19    
20  #ifdef AIX3  #ifdef AIX3
# Line 35  siGxdr_open(f) Line 34  siGxdr_open(f)
34    xdrstdio_create(xdrs, f->sm.sm_fp,    xdrstdio_create(xdrs, f->sm.sm_fp,
35                    (f->sm.sm_mode == smm_input ?  XDR_DECODE :                    (f->sm.sm_mode == smm_input ?  XDR_DECODE :
36                     f->sm.sm_mode == smm_output ?  XDR_ENCODE :                     f->sm.sm_mode == smm_output ?  XDR_ENCODE :
37                     FEerror("stream not input or output",0)))                     (FEerror("stream not input or output",0),XDR_ENCODE)))
38                     ;                     ;
39    return ar;    return ar;
40  }  }
41    
42  object  object
43  siGxdr_write(str,elt)  siGxdr_write(object str,object elt) {
44       object str,elt;  
45  { XDR *xdrp= (XDR *) str->ust.ust_self;    XDR *xdrp= (XDR *) str->ust.ust_self;
46      xdrproc_t e;
47    switch (type_of(elt))  
48     { case t_fixnum:    switch (type_of(elt)) {
49         if(!xdr_int(xdrp,&fix(elt))) goto error;    case t_fixnum:
50          return elt;      if(!xdr_long(xdrp,&fix(elt))) goto error;
51       case t_longfloat:      break;
52         if(!xdr_double(xdrp,&lf(elt))) goto error;    case t_longfloat:
53          return elt;      if(!xdr_double(xdrp,&lf(elt))) goto error;
54       case t_shortfloat:      break;
55         if(!xdr_float(xdrp,&sf(elt))) goto error;    case t_shortfloat:
56          return elt;      if(!xdr_float(xdrp,&sf(elt))) goto error;
57       case t_vector:      break;
58         if(!xdr_array(xdrp,(char **)&elt->v.v_self,    case t_vector:
59                   &elt->v.v_fillp,      
60                   elt->v.v_dim,      switch(elt->v.v_elttype) {
61                   aet_sizes[elt->v.v_elttype],      case aet_lf:
62                   (elt->v.v_elttype == aet_lf ? xdr_double :        e=(xdrproc_t)xdr_double;
63                    elt->v.v_elttype == aet_sf ? xdr_float :        break;
64                    elt->v.v_elttype == aet_fix ? xdr_int :      case aet_sf:
65                    elt->v.v_elttype == aet_short ? xdr_short :        e=(xdrproc_t)xdr_float;
66                    (FEerror("unsupported xdr size",0),xdr_short))))        break;
67           goto error ;      case aet_fix:
68         return elt;        e=(xdrproc_t)xdr_long;
69       default:        break;
70         FEerror("unsupported xdr ~a",1,elt);      case aet_short:
71       }        e=(xdrproc_t)xdr_short;
72          break;
73        default:
74          FEerror("unsupported xdr size",0);
75          goto error;
76          break;
77        }
78        if(!xdr_array(xdrp,(char **)&elt->v.v_self,
79                      &elt->v.v_fillp,
80                      elt->v.v_dim,
81                      aet_sizes[elt->v.v_elttype],
82                      e))
83          goto error;
84        break;
85      default:
86        FEerror("unsupported xdr ~a",1,elt);
87        break;
88      }
89    return elt;    return elt;
90   error:   error:
91    FEerror("bad xdr read",0);    FEerror("bad xdr read",0);
92       }    return elt;
93    }
94    
95  object  object
96  siGxdr_read(str,elt)  siGxdr_read(object str,object elt) {
97            object str,elt;  
98  { XDR *xdrp= (XDR *) str->ust.ust_self;    XDR *xdrp= (XDR *) str->ust.ust_self;
99    switch (type_of(elt))    xdrproc_t e;
100     { case t_fixnum:  
101         {int l;    switch (type_of(elt)) {
102              case t_fixnum:
103         if(!xdr_int(xdrp,&l)) goto error;      {fixnum l;
104          return make_fixnum(l);}      if(!xdr_long(xdrp,&l)) goto error;
105         break;      return make_fixnum(l);}
106       case t_longfloat:      break;
107         { double x;    case t_longfloat:
108         if(!xdr_double(xdrp,&x)) goto error;      {double x;
109          return make_longfloat(x);}      if(!xdr_double(xdrp,&x)) goto error;
110       case t_shortfloat:      return make_longfloat(x);}
111         { float x;    case t_shortfloat:
112         if(!xdr_float(xdrp,&x)) goto error;      {float x;
113          return make_shortfloat(x);}      if(!xdr_float(xdrp,&x)) goto error;
114       case t_vector:      return make_shortfloat(x);}
115        if(! xdr_array(xdrp,(char **)&elt->v.v_self,    case t_vector:
116                   &elt->v.v_fillp,      switch(elt->v.v_elttype) {
117                   elt->v.v_dim,      case aet_lf:
118                   aet_sizes[elt->v.v_elttype],        e=(xdrproc_t)xdr_double;
119                   (elt->v.v_elttype == aet_lf ? xdr_double :        break;
120                    elt->v.v_elttype == aet_sf ? xdr_float :      case aet_sf:
121                    elt->v.v_elttype == aet_fix ? xdr_int :        e=(xdrproc_t)xdr_float;
122                    elt->v.v_elttype == aet_short ? xdr_short :        break;
123                    (FEerror("unsupported xdr size",0),xdr_short))))      case aet_fix:
124          goto error;        e=(xdrproc_t)xdr_long;
125         return elt;        break;
126       default:      case aet_short:
127         FEerror("unsupported xdr ~a",1,elt);        e=(xdrproc_t)xdr_short;
128       }        break;
129       error:      default:
130          FEerror("unsupported xdr size",0);
131          goto error;
132          break;
133        }
134    
135        if(!xdr_array(xdrp,(char **)&elt->v.v_self,
136                      &elt->v.v_fillp,
137                      elt->v.v_dim,
138                      aet_sizes[elt->v.v_elttype],
139                      e))
140          goto error;
141        return elt;
142        break;
143      default:
144        FEerror("unsupported xdr ~a",1,elt);
145        return elt;
146        break;
147      }
148     error:
149    FEerror("bad xdr read",0);    FEerror("bad xdr read",0);
150    return elt;    return elt;
151  }  }
152  static  static void
153  init_xdrfuns()  init_xdrfuns()
154  { make_si_sfun("XDR-WRITE",siGxdr_write,  { make_si_sfun("XDR-WRITE",siGxdr_write,
155                 ARGTYPE2(f_object,f_object)|RESTYPE(f_object));                 ARGTYPE2(f_object,f_object)|RESTYPE(f_object));

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.4.2.1

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