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

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