6 /* Simple wrappers for ANSI C I/O functions, used for bootstrapping.
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.
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
17 void factor_vm::init_c_io()
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);
24 void factor_vm::io_error()
31 general_error(ERROR_IO,tag_fixnum(errno),false_object);
34 FILE *factor_vm::safe_fopen(char *filename, char *mode)
39 file = fopen(filename,mode);
48 int factor_vm::safe_fgetc(FILE *stream)
67 size_t factor_vm::safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
69 size_t items_read = 0;
74 ret = fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
83 } while(items_read != nitems);
88 void factor_vm::safe_fputc(int c, FILE *stream)
92 if(fputc(c,stream) == EOF)
99 size_t factor_vm::safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
101 size_t items_written = 0;
105 ret = fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
108 items_written += ret;
109 } while(items_written != nitems);
111 return items_written;
114 int factor_vm::safe_ftell(FILE *stream)
119 if((offset = FTELL(stream)) == -1)
127 void factor_vm::safe_fseek(FILE *stream, off_t offset, int whence)
131 case 0: whence = SEEK_SET; break;
132 case 1: whence = SEEK_CUR; break;
133 case 2: whence = SEEK_END; break;
135 critical_error("Bad value for whence",whence);
140 if(FSEEK(stream,offset,whence) == -1)
147 void factor_vm::safe_fflush(FILE *stream)
151 if(fflush(stream) == EOF)
158 void factor_vm::safe_fclose(FILE *stream)
162 if(fclose(stream) == EOF)
169 void factor_vm::primitive_fopen()
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);
177 file = safe_fopen((char *)(path.untagged() + 1),
178 (char *)(mode.untagged() + 1));
179 ctx->push(allot_alien(file));
182 FILE *factor_vm::pop_file_handle()
184 return (FILE *)alien_offset(ctx->pop());
187 void factor_vm::primitive_fgetc()
189 FILE *file = pop_file_handle();
191 int c = safe_fgetc(file);
192 if(c == EOF && feof(file))
195 ctx->push(false_object);
198 ctx->push(tag_fixnum(c));
201 void factor_vm::primitive_fread()
203 FILE *file = pop_file_handle();
204 void *buf = (void*)alien_offset(ctx->pop());
205 fixnum size = unbox_array_size();
209 ctx->push(from_unsigned_cell(0));
213 size_t c = safe_fread(buf,1,size,file);
214 if(c == 0 || feof(file))
216 ctx->push(from_unsigned_cell(c));
219 void factor_vm::primitive_fputc()
221 FILE *file = pop_file_handle();
222 fixnum ch = to_fixnum(ctx->pop());
223 safe_fputc((int)ch, file);
226 void factor_vm::primitive_fwrite()
228 FILE *file = pop_file_handle();
229 cell length = to_cell(ctx->pop());
230 char *text = alien_offset(ctx->pop());
235 size_t written = safe_fwrite(text,1,length,file);
236 if(written != length)
240 void factor_vm::primitive_ftell()
242 FILE *file = pop_file_handle();
243 ctx->push(from_signed_8(safe_ftell(file)));
246 void factor_vm::primitive_fseek()
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);
254 void factor_vm::primitive_fflush()
256 FILE *file = pop_file_handle();
260 void factor_vm::primitive_fclose()
262 FILE *file = pop_file_handle();
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()
274 VM_C_API void set_err_no(int err)