15 |
|
|
16 |
*/ |
*/ |
17 |
|
|
|
|
|
18 |
#ifdef HAVE_XDR |
#ifdef HAVE_XDR |
19 |
|
|
20 |
#ifdef AIX3 |
#ifdef AIX3 |
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)); |