]> gitweb.factorcode.org Git - factor.git/blob - vm/io.cpp
vm: non-copying primitive_fread
[factor.git] / vm / io.cpp
1 #include "master.hpp"
2
3 namespace factor
4 {
5
6 /* Simple wrappers for ANSI C I/O functions, used for bootstrapping.
7
8 Note the ugly loop logic in almost every function; we have to handle EINTR
9 and restart the operation if the system call was interrupted. Naive
10 applications don't do this, but then they quickly fail if one enables
11 itimer()s or other signals.
12
13 The Factor library provides platform-specific code for Unix and Windows
14 with many more capabilities so these words are not usually used in
15 normal operation. */
16
17 void factor_vm::init_c_io()
18 {
19         special_objects[OBJ_STDIN] = allot_alien(false_object,(cell)stdin);
20         special_objects[OBJ_STDOUT] = allot_alien(false_object,(cell)stdout);
21         special_objects[OBJ_STDERR] = allot_alien(false_object,(cell)stderr);
22 }
23
24 void factor_vm::io_error()
25 {
26 #ifndef WINCE
27         if(errno == EINTR)
28                 return;
29 #endif
30
31         general_error(ERROR_IO,tag_fixnum(errno),false_object);
32 }
33
34 FILE *factor_vm::safe_fopen(char *filename, char *mode)
35 {
36         FILE *file;
37         for(;;)
38         {
39                 file = fopen(filename,mode);
40                 if(file == NULL)
41                         io_error();
42                 else
43                         break;
44         }
45         return file;
46 }
47
48 int factor_vm::safe_fgetc(FILE *stream)
49 {
50         int c;
51         for(;;)
52         {
53                 c = fgetc(stream);
54                 if(c == EOF)
55                 {
56                         if(feof(stream))
57                                 return EOF;
58                         else
59                                 io_error();
60                 }
61                 else
62                         break;
63         }
64         return c;
65 }
66
67 size_t factor_vm::safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
68 {
69         size_t items_read = 0;
70         size_t ret = 0;
71
72         do
73         {
74                 ret = fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
75                 if(ret == 0)
76                 {
77                         if(feof(stream))
78                                 break;
79                         else
80                                 io_error();
81                 }
82                 items_read += ret;
83         } while(items_read != nitems);
84
85         return items_read;
86 }
87
88 void factor_vm::safe_fputc(int c, FILE *stream)
89 {
90         for(;;)
91         {
92                 if(fputc(c,stream) == EOF)
93                         io_error();
94                 else
95                         break;
96         }
97 }
98
99 size_t factor_vm::safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
100 {
101         size_t items_written = 0;
102         size_t ret = 0;
103
104         do {
105                 ret = fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
106                 if(ret == 0)
107                         io_error();
108                 items_written += ret;
109         } while(items_written != nitems);
110
111         return items_written;
112 }
113
114 int factor_vm::safe_ftell(FILE *stream)
115 {
116         off_t offset;
117         for(;;)
118         {
119                 if((offset = FTELL(stream)) == -1)
120                         io_error();
121                 else
122                         break;
123         }
124         return offset;
125 }
126
127 void factor_vm::safe_fseek(FILE *stream, off_t offset, int whence)
128 {
129         switch(whence)
130         {
131         case 0: whence = SEEK_SET; break;
132         case 1: whence = SEEK_CUR; break;
133         case 2: whence = SEEK_END; break;
134         default:
135                 critical_error("Bad value for whence",whence);
136         }
137
138         for(;;)
139         {
140                 if(FSEEK(stream,offset,whence) == -1)
141                         io_error();
142                 else
143                         break;
144         }
145 }
146
147 void factor_vm::safe_fflush(FILE *stream)
148 {
149         for(;;)
150         {
151                 if(fflush(stream) == EOF)
152                         io_error();
153                 else
154                         break;
155         }
156 }
157
158 void factor_vm::safe_fclose(FILE *stream)
159 {
160         for(;;)
161         {
162                 if(fclose(stream) == EOF)
163                         io_error();
164                 else
165                         break;
166         }
167 }
168
169 void factor_vm::primitive_fopen()
170 {
171         data_root<byte_array> mode(ctx->pop(),this);
172         data_root<byte_array> path(ctx->pop(),this);
173         mode.untag_check(this);
174         path.untag_check(this);
175
176         FILE *file;
177         file = safe_fopen((char *)(path.untagged() + 1),
178                 (char *)(mode.untagged() + 1));
179         ctx->push(allot_alien(file));
180 }
181
182 FILE *factor_vm::pop_file_handle()
183 {
184         return (FILE *)alien_offset(ctx->pop());
185 }
186
187 void factor_vm::primitive_fgetc()
188 {
189         FILE *file = pop_file_handle();
190
191         int c = safe_fgetc(file);
192         if(c == EOF && feof(file))
193         {
194                 clearerr(file);
195                 ctx->push(false_object);
196         }
197         else
198                 ctx->push(tag_fixnum(c));
199 }
200
201 void factor_vm::primitive_fread()
202 {
203         FILE *file = pop_file_handle();
204         void *buf = (void*)alien_offset(ctx->pop());
205         fixnum size = unbox_array_size();
206
207         if(size == 0)
208         {
209                 ctx->push(from_unsigned_cell(0));
210                 return;
211         }
212
213         size_t c = safe_fread(buf,1,size,file);
214         if(c == 0 || feof(file))
215                 clearerr(file);
216         ctx->push(from_unsigned_cell(c));
217 }
218
219 void factor_vm::primitive_fputc()
220 {
221         FILE *file = pop_file_handle();
222         fixnum ch = to_fixnum(ctx->pop());
223         safe_fputc((int)ch, file);
224 }
225
226 void factor_vm::primitive_fwrite()
227 {
228         FILE *file = pop_file_handle();
229         cell length = to_cell(ctx->pop());
230         char *text = alien_offset(ctx->pop());
231
232         if(length == 0)
233                 return;
234
235         size_t written = safe_fwrite(text,1,length,file);
236         if(written != length)
237                 io_error();
238 }
239
240 void factor_vm::primitive_ftell()
241 {
242         FILE *file = pop_file_handle();
243         ctx->push(from_signed_8(safe_ftell(file)));
244 }
245
246 void factor_vm::primitive_fseek()
247 {
248         FILE *file = pop_file_handle();
249         int whence = (int)to_fixnum(ctx->pop());
250         off_t offset = (off_t)to_signed_8(ctx->pop());
251         safe_fseek(file,offset,whence);
252 }
253
254 void factor_vm::primitive_fflush()
255 {
256         FILE *file = pop_file_handle();
257         safe_fflush(file);
258 }
259
260 void factor_vm::primitive_fclose()
261 {
262         FILE *file = pop_file_handle();
263         safe_fclose(file);
264 }
265
266 /* This function is used by FFI I/O. Accessing the errno global directly is
267 not portable, since on some libc's errno is not a global but a funky macro that
268 reads thread-local storage. */
269 VM_C_API int err_no()
270 {
271         return errno;
272 }
273
274 VM_C_API void set_err_no(int err)
275 {
276         errno = err;
277 }
278 }