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

Parent Directory | 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