Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/rt-transition/runtime/sml-basis-lib/file-io.c
ViewVC logotype

Annotation of /sml/branches/rt-transition/runtime/sml-basis-lib/file-io.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2906 - (view) (download) (as text)

1 : jhr 2898 /* file-io.c
2 :     *
3 :     * COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies.
4 :     *
5 :     * File I/O support for the SML'97 Basis on Unix.
6 :     */
7 :    
8 :     #include "ml-base.h"
9 :     #include "ml-unixdep.h"
10 :     #include <unistd.h>
11 :     #include <fcntl.h>
12 :     #include "ml-values.h"
13 :     #include "ml-objects.h"
14 :     #include "ml-c.h"
15 :     #include "sml-basis.h"
16 :    
17 :    
18 :     /* openFile:
19 :     */
20 :     ML_iodesc_t openFile (ml_state_t *msp, ML_string_t s, int flgs)
21 :     {
22 :     int flags;
23 :     int fd;
24 :    
25 :     /* get flags */
26 :     switch (flgs & 0x3) {
27 :     case OPEN_RD: flags = O_RDONLY; break;
28 :     case OPEN_WR: flags = O_WRONLY; break;
29 :     case OPEN_RDWR: flags = O_RDWR; break;
30 :     default: return RAISE_ERROR(msp, "openFile: bogus flags");
31 :     }
32 :     if (flgs & OPEN_CREATE) flags |= O_CREAT;
33 :     if (flgs & OPEN_TRUNC) flags |= O_TRUNC;
34 :     if (flgs & OPEN_APPEND) flags |= O_APPEND;
35 :    
36 :     fd = open (STR_MLtoC(s), flags, 0666);
37 :     /* SayDebug("openFile(%s) = %d; flgs = %d\n", STR_MLtoC(s), fd, flgs); */
38 :    
39 :     CHK_RETURN(msp, fd)
40 :    
41 :     } /* end of openFile */
42 :    
43 :     /* closeFile:
44 :     */
45 :     void closeFile (ML_iodesc_t iod)
46 :     {
47 :     close(INT_MLtoC(iod));
48 :    
49 :     } /* end of closeFile */
50 :    
51 :     /* cmpIODesc:
52 :     */
53 :     int cmpIODesc (ML_iodesc_t iod1,ML_iodesc_t iod2)
54 :     {
55 :     return (iod1 - iod2);
56 :    
57 :     } /* end of cmpIODesc */
58 :    
59 :     /* readTextVec:
60 :     */
61 :     ML_charvec_opt_t readTextVec (
62 :     ml_state_t *msp,
63 :     ML_bool_t noblock,
64 :     ML_iodesc_t iod,
65 :     int nbytes)
66 :     {
67 :     int fd = INT_MLtoC(iod);
68 :     ml_val_t vec, hdr, res;
69 :     int n;
70 :    
71 :     if (nbytes == 0){
72 :     OPTION_SOME (msp, res, ML_string0);
73 :     return res;
74 :     }
75 :    
76 :     /* allocate the vector; note that this might cause a GC */
77 :     vec = ML_AllocRaw32 (msp, BYTES_TO_WORDS(nbytes));
78 :     n = read (fd, PTR_MLtoC(char, vec), nbytes);
79 :     if (n < 0)
80 :     return RAISE_SYSERR(msp, n);
81 :     else if (n == 0) {
82 :     OPTION_SOME (msp, res, ML_string0);
83 :     return res;
84 :     }
85 :    
86 :     if (n < nbytes) {
87 :     /* we need to shrink the vector */
88 :     ML_ShrinkRaw32 (msp, vec, BYTES_TO_WORDS(n));
89 :     }
90 :    
91 :     SEQHDR_ALLOC (msp, hdr, DESC_string, vec, n);
92 :     OPTION_SOME (msp, res, hdr);
93 :    
94 :     return res;
95 :    
96 :     } /* end of readTextVec */
97 :    
98 :     /* readTextArr:
99 :     */
100 :     ML_int_t readTextArr (
101 :     ml_state_t *msp,
102 :     ML_bool_t noblock,
103 :     ML_iodesc_t iod,
104 :     ML_chararr_t arr,
105 :     int nbytes,
106 :     int offset)
107 :     {
108 :     int fd = INT_MLtoC(iod);
109 :     char *start = STR_MLtoC(arr) + offset;
110 :     int n;
111 :    
112 :     n = read (fd, start, nbytes);
113 :    
114 :     CHK_RETURN (msp, n)
115 :    
116 :     } /* end of readTextArr */
117 :    
118 :     /* writeTextVec:
119 :     */
120 :     ML_int_t writeTextVec (
121 :     ml_state_t *msp,
122 :     ML_bool_t noblock,
123 :     ML_iodesc_t iod,
124 :     ML_charvec_t buf,
125 :     int offset,
126 :     int nbytes)
127 :     {
128 :     int fd = INT_MLtoC(iod);
129 :     char *start = STR_MLtoC(buf) + offset;
130 :     ssize_t n;
131 :    
132 :     n = write (fd, start, nbytes);
133 :    
134 :     CHK_RETURN (msp, n)
135 :    
136 :     } /* end of writeTextVec */
137 :    
138 :     /* writeTextArr:
139 :     */
140 :     ML_int_t writeTextArr (
141 :     ml_state_t *msp,
142 :     ML_bool_t noblock,
143 :     ML_iodesc_t iod,
144 :     ML_chararr_t buf,
145 :     int offset,
146 :     int nbytes)
147 :     {
148 :     int fd = INT_MLtoC(iod);
149 :     char *start = STR_MLtoC(buf) + offset;
150 :     ssize_t n;
151 :    
152 :     n = write (fd, start, nbytes);
153 :    
154 :     CHK_RETURN (msp, n)
155 :    
156 :     } /* end of writeTextArr */
157 :    
158 :     /* readBinVec:
159 :     */
160 :     ML_word8vec_t readBinVec (
161 :     ml_state_t *msp,
162 :     ML_bool_t noblock,
163 :     ML_iodesc_t iod,
164 :     int nbytes)
165 :     {
166 :     int fd = INT_MLtoC(iod);
167 :     ml_val_t vec, hdr, res;
168 :     int n;
169 :    
170 :     /* SayDebug("readBinVec: iod = %d, nbytes = %d\n", fd, nbytes); */
171 :     if (nbytes == 0){
172 :     OPTION_SOME (msp, res, ML_string0);
173 :     return res;
174 :     }
175 :    
176 :     /* allocate the vector; note that this might cause a GC */
177 :     vec = ML_AllocRaw32 (msp, BYTES_TO_WORDS(nbytes));
178 :     /* SayDebug(" vec = %p\n", PTR_MLtoC(void, vec)); */
179 :     n = read (fd, PTR_MLtoC(void, vec), (size_t)nbytes);
180 :     /* SayDebug(" %d bytes read\n", n); */
181 :     if (n < 0)
182 :     return RAISE_SYSERR(msp, n);
183 :     else if (n == 0) {
184 :     OPTION_SOME (msp, res, ML_string0);
185 :     return res;
186 :     }
187 :    
188 :     if (n < nbytes) {
189 :     /* we need to shrink the vector */
190 :     ML_ShrinkRaw32 (msp, vec, BYTES_TO_WORDS(n));
191 :     }
192 :    
193 :     SEQHDR_ALLOC (msp, hdr, DESC_word8vec, vec, n);
194 :     OPTION_SOME (msp, res, hdr);
195 :    
196 :     return res;
197 :    
198 :     } /* end of readBinVec */
199 :    
200 :     /* readBinArr:
201 :     */
202 :     ML_int_t readBinArr (
203 :     ml_state_t *msp,
204 :     ML_bool_t noblock,
205 :     ML_iodesc_t iod,
206 :     ML_word8arr_t arr,
207 :     int nbytes,
208 :     int offset)
209 :     {
210 :     int fd = INT_MLtoC(iod);
211 :     char *start = STR_MLtoC(arr) + offset;
212 :     int n;
213 :    
214 :     n = read (fd, start, nbytes);
215 :    
216 :     CHK_RETURN (msp, n)
217 :    
218 :     } /* end of readBinArr */
219 :    
220 :     /* writeBinVec:
221 :     */
222 :     ML_int_t writeBinVec (
223 :     ml_state_t *msp,
224 :     ML_bool_t noblock,
225 :     ML_iodesc_t iod,
226 :     ML_word8vec_t buf,
227 :     int offset,
228 :     int nbytes)
229 :     {
230 :     int fd = INT_MLtoC(iod);
231 :     ssize_t n;
232 :    
233 :     n = write (fd, STR_MLtoC(buf), nbytes);
234 :    
235 :     CHK_RETURN (msp, n)
236 :    
237 :     } /* end of writeBinVec */
238 :    
239 :     /* writeBinArr:
240 :     */
241 :     ML_int_t writeBinArr (
242 :     ml_state_t *msp,
243 :     ML_bool_t noblock,
244 :     ML_iodesc_t iod,
245 :     ML_word8arr_t buf,
246 :     int offset,
247 :     int nbytes)
248 :     {
249 :     int fd = INT_MLtoC(iod);
250 :     char *start = STR_MLtoC(buf) + offset;
251 :     ssize_t n;
252 :    
253 :     n = write (fd, start, nbytes);
254 :    
255 :     CHK_RETURN (msp, n)
256 :    
257 :     } /* end of writeBinArr */
258 :    
259 :     /* getPos:
260 :     */
261 :     ML_int32_t getPos (ml_state_t *msp, ML_iodesc_t iod)
262 :     {
263 :     int fd = INT_MLtoC(iod);
264 :     off_t sts;
265 :    
266 :     sts = lseek (fd, 0, SEEK_CUR);
267 :    
268 :     if (sts < 0)
269 :     return RAISE_SYSERR(msp, sts);
270 :     else {
271 :     ml_val_t pos;
272 : jhr 2906 INT32_ALLOC(msp, pos, (int)sts);
273 : jhr 2898 return pos;
274 :     }
275 :    
276 :     } /* end of getPos */
277 :    
278 :     /* setPos:
279 :     */
280 :     ML_unit_t setPos (ml_state_t *msp, ML_iodesc_t iod, ML_int32_t offset, int whence)
281 :     {
282 :     int fd = INT_MLtoC(iod);
283 :     off_t sts;
284 :    
285 :     switch (whence) {
286 :     case SET_POS_BEGIN: whence = SEEK_SET; break;
287 :     case SET_POS_CUR: whence = SEEK_CUR; break;
288 :     case SET_POS_END: whence = SEEK_END; break;
289 :     default: Die("bogus whence");
290 :     }
291 :    
292 :     /* SayDebug("setPos: iod=%d, offset=%d\n", fd, INT32_MLtoC(offset)); */
293 :     sts = lseek (fd, INT32_MLtoC(offset), whence);
294 :    
295 :     if (sts < 0)
296 :     return RAISE_SYSERR(msp, sts);
297 :     else
298 :     return ML_unit;
299 :    
300 :     } /* end of setPos */
301 :    
302 :     /* getStdIn:
303 :     */
304 :     ML_iodesc_t getStdIn ()
305 :     {
306 :     return INT_CtoML(0);
307 :    
308 :     } /* end of getStdIn */
309 :    
310 :     /* getStdOut:
311 :     */
312 :     ML_iodesc_t getStdOut ()
313 :     {
314 :     return INT_CtoML(1);
315 :    
316 :     } /* end of getStdOut */
317 :    
318 :     /* getStdErr:
319 :     */
320 :     ML_iodesc_t getStdErr ()
321 :     {
322 :     return INT_CtoML(2);
323 :    
324 :     } /* end of getStdErr */

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0