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,NULL);
34 void factor_vm::primitive_fopen()
36 gc_root<byte_array> mode(dpop(),this);
37 gc_root<byte_array> path(dpop(),this);
38 mode.untag_check(this);
39 path.untag_check(this);
43 FILE *file = fopen((char *)(path.untagged() + 1),
44 (char *)(mode.untagged() + 1));
55 void factor_vm::primitive_fgetc()
57 FILE *file = (FILE *)unbox_alien();
80 void factor_vm::primitive_fread()
82 FILE *file = (FILE *)unbox_alien();
83 fixnum size = unbox_array_size();
87 dpush(tag<string>(allot_string(0,0)));
91 gc_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this);
95 int c = fread(buf.untagged() + 1,1,size,file);
110 byte_array *new_buf = allot_byte_array(c);
111 memcpy(new_buf + 1, buf.untagged() + 1,c);
120 void factor_vm::primitive_fputc()
122 FILE *file = (FILE *)unbox_alien();
123 fixnum ch = to_fixnum(dpop());
127 if(fputc(ch,file) == EOF)
131 /* Still here? EINTR */
138 void factor_vm::primitive_fwrite()
140 FILE *file = (FILE *)unbox_alien();
141 byte_array *text = untag_check<byte_array>(dpop());
142 cell length = array_capacity(text);
143 char *string = (char *)(text + 1);
150 size_t written = fwrite(string,1,length,file);
151 if(written == length)
160 /* Still here? EINTR */
167 void factor_vm::primitive_ftell()
169 FILE *file = (FILE *)unbox_alien();
172 if((offset = FTELL(file)) == -1)
175 box_signed_8(offset);
178 void factor_vm::primitive_fseek()
180 int whence = to_fixnum(dpop());
181 FILE *file = (FILE *)unbox_alien();
182 off_t offset = to_signed_8(dpop());
186 case 0: whence = SEEK_SET; break;
187 case 1: whence = SEEK_CUR; break;
188 case 2: whence = SEEK_END; break;
190 critical_error("Bad value for whence",whence);
194 if(FSEEK(file,offset,whence) == -1)
198 /* Still here? EINTR */
199 critical_error("Don't know what to do; EINTR from fseek()?",0);
203 void factor_vm::primitive_fflush()
205 FILE *file = (FILE *)unbox_alien();
208 if(fflush(file) == EOF)
215 void factor_vm::primitive_fclose()
217 FILE *file = (FILE *)unbox_alien();
220 if(fclose(file) == EOF)
227 /* This function is used by FFI I/O. Accessing the errno global directly is
228 not portable, since on some libc's errno is not a global but a funky macro that
229 reads thread-local storage. */
230 VM_C_API int err_no()
235 VM_C_API void clear_err_no()