← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to o/xdrfuns.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/xdrfuns.c
 
1
/*
 
2
 Copyright (C) 1994  W. Schelter
 
3
 
 
4
This file is part of GNU Common Lisp, herein referred to as GCL
 
5
 
 
6
GCL is free software; you can redistribute it and/or modify it under
 
7
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
 
8
the Free Software Foundation; either version 2, or (at your option)
 
9
any later version.
 
10
 
 
11
GCL is distributed in the hope that it will be useful, but WITHOUT
 
12
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
 
13
FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
 
14
License for more details.
 
15
 
 
16
*/
 
17
 
 
18
#ifdef HAVE_XDR
 
19
 
 
20
#ifdef AIX3
 
21
#include <sys/select.h>
 
22
#endif
 
23
#include <rpc/rpc.h>
 
24
 
 
25
extern short aet_sizes[];
 
26
static object
 
27
FFN(siGxdr_open)(f)
 
28
     object f;
 
29
{ XDR *xdrs;
 
30
  object ar= alloc_simple_string(sizeof(XDR));
 
31
  array_allocself(ar,1,0);
 
32
  xdrs= (XDR *) ar->a.a_self;
 
33
  if (f->sm.sm_fp == 0) FEerror("stream not ok for xdr io",0);
 
34
  xdrstdio_create(xdrs, f->sm.sm_fp,
 
35
                  (f->sm.sm_mode == smm_input ?  XDR_DECODE :
 
36
                   f->sm.sm_mode == smm_output ?  XDR_ENCODE :
 
37
                   (FEerror("stream not input or output",0),XDR_ENCODE)))
 
38
                   ;
 
39
  return ar;
 
40
}
 
41
 
 
42
static object
 
43
FFN(siGxdr_write)(object str,object elt) {
 
44
 
 
45
  XDR *xdrp= (XDR *) str->ust.ust_self;
 
46
  xdrproc_t e;
 
47
 
 
48
  switch (type_of(elt)) {
 
49
  case t_fixnum:
 
50
    if(!xdr_long(xdrp,&fix(elt))) goto error;
 
51
    break;
 
52
  case t_longfloat:
 
53
    if(!xdr_double(xdrp,&lf(elt))) goto error;
 
54
    break;
 
55
  case t_shortfloat:
 
56
    if(!xdr_float(xdrp,&sf(elt))) goto error;
 
57
    break;
 
58
  case t_vector:
 
59
    
 
60
    switch(elt->v.v_elttype) {
 
61
    case aet_lf:
 
62
      e=(xdrproc_t)xdr_double;
 
63
      break;
 
64
    case aet_sf:
 
65
      e=(xdrproc_t)xdr_float;
 
66
      break;
 
67
    case aet_fix:
 
68
      e=(xdrproc_t)xdr_long;
 
69
      break;
 
70
    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;
 
90
 error:
 
91
  FEerror("bad xdr read",0);
 
92
  return elt;
 
93
}
 
94
 
 
95
static object
 
96
FFN(siGxdr_read)(object str,object elt) {
 
97
 
 
98
  XDR *xdrp= (XDR *) str->ust.ust_self;
 
99
  xdrproc_t e;
 
100
 
 
101
  switch (type_of(elt)) { 
 
102
  case t_fixnum:
 
103
    {fixnum l;
 
104
    if(!xdr_long(xdrp,&l)) goto error;
 
105
    return make_fixnum(l);}
 
106
    break;
 
107
  case t_longfloat:
 
108
    {double x;
 
109
    if(!xdr_double(xdrp,&x)) goto error;
 
110
    return make_longfloat(x);}
 
111
  case t_shortfloat:
 
112
    {float x;
 
113
    if(!xdr_float(xdrp,&x)) goto error;
 
114
    return make_shortfloat(x);}
 
115
  case t_vector:
 
116
    switch(elt->v.v_elttype) {
 
117
    case aet_lf:
 
118
      e=(xdrproc_t)xdr_double;
 
119
      break;
 
120
    case aet_sf:
 
121
      e=(xdrproc_t)xdr_float;
 
122
      break;
 
123
    case aet_fix:
 
124
      e=(xdrproc_t)xdr_long;
 
125
      break;
 
126
    case aet_short:
 
127
      e=(xdrproc_t)xdr_short;
 
128
      break;
 
129
    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);
 
150
  return elt;
 
151
}
 
152
static void
 
153
gcl_init_xdrfuns()
 
154
{ make_si_sfun("XDR-WRITE",siGxdr_write,
 
155
               ARGTYPE2(f_object,f_object)|RESTYPE(f_object));
 
156
 
 
157
  make_si_sfun("XDR-READ",siGxdr_read,
 
158
               ARGTYPE2(f_object,f_object)|RESTYPE(f_object));
 
159
  make_si_sfun("XDR-OPEN",siGxdr_open,
 
160
               ARGTYPE1(f_object)|RESTYPE(f_object));
 
161
  
 
162
}
 
163
#else
 
164
static void gcl_init_xdrfuns(void) {;}
 
165
#endif