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 userenv[STDIN_ENV] = allot_alien(F,(cell)stdin);
20 userenv[STDOUT_ENV] = allot_alien(F,(cell)stdout);
21 userenv[STDERR_ENV] = allot_alien(F,(cell)stderr);
24 void factor_vm::io_error()
31 general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
34 inline 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));
57 PRIMITIVE_GETVM()->primitive_fopen();
60 inline void factor_vm::primitive_fgetc()
62 FILE *file = (FILE *)unbox_alien();
87 PRIMITIVE_GETVM()->primitive_fgetc();
90 inline void factor_vm::primitive_fread()
92 FILE *file = (FILE *)unbox_alien();
93 fixnum size = unbox_array_size();
97 dpush(tag<string>(allot_string(0,0)));
101 gc_root<byte_array> buf(allot_array_internal<byte_array>(size),this);
105 int c = fread(buf.untagged() + 1,1,size,file);
120 byte_array *new_buf = allot_byte_array(c);
121 memcpy(new_buf + 1, buf.untagged() + 1,c);
132 PRIMITIVE_GETVM()->primitive_fread();
135 inline void factor_vm::primitive_fputc()
137 FILE *file = (FILE *)unbox_alien();
138 fixnum ch = to_fixnum(dpop());
142 if(fputc(ch,file) == EOF)
146 /* Still here? EINTR */
155 PRIMITIVE_GETVM()->primitive_fputc();
158 inline void factor_vm::primitive_fwrite()
160 FILE *file = (FILE *)unbox_alien();
161 byte_array *text = untag_check<byte_array>(dpop());
162 cell length = array_capacity(text);
163 char *string = (char *)(text + 1);
170 size_t written = fwrite(string,1,length,file);
171 if(written == length)
180 /* Still here? EINTR */
189 PRIMITIVE_GETVM()->primitive_fwrite();
192 inline void factor_vm::primitive_fseek()
194 int whence = to_fixnum(dpop());
195 FILE *file = (FILE *)unbox_alien();
196 off_t offset = to_signed_8(dpop());
200 case 0: whence = SEEK_SET; break;
201 case 1: whence = SEEK_CUR; break;
202 case 2: whence = SEEK_END; break;
204 critical_error("Bad value for whence",whence);
208 if(FSEEK(file,offset,whence) == -1)
212 /* Still here? EINTR */
213 critical_error("Don't know what to do; EINTR from fseek()?",0);
219 PRIMITIVE_GETVM()->primitive_fseek();
222 inline void factor_vm::primitive_fflush()
224 FILE *file = (FILE *)unbox_alien();
227 if(fflush(file) == EOF)
236 PRIMITIVE_GETVM()->primitive_fflush();
239 inline void factor_vm::primitive_fclose()
241 FILE *file = (FILE *)unbox_alien();
244 if(fclose(file) == EOF)
253 PRIMITIVE_GETVM()->primitive_fclose();
256 /* This function is used by FFI I/O. Accessing the errno global directly is
257 not portable, since on some libc's errno is not a global but a funky macro that
258 reads thread-local storage. */
259 VM_C_API int err_no()
264 VM_C_API void clear_err_no()