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 factorvm::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);
25 void factorvm::io_error()
32 general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
36 inline void factorvm::vmprim_fopen()
38 gc_root<byte_array> mode(dpop(),this);
39 gc_root<byte_array> path(dpop(),this);
40 mode.untag_check(this);
41 path.untag_check(this);
45 FILE *file = fopen((char *)(path.untagged() + 1),
46 (char *)(mode.untagged() + 1));
59 PRIMITIVE_GETVM()->vmprim_fopen();
62 inline void factorvm::vmprim_fgetc()
64 FILE *file = (FILE *)unbox_alien();
89 PRIMITIVE_GETVM()->vmprim_fgetc();
92 inline void factorvm::vmprim_fread()
94 FILE *file = (FILE *)unbox_alien();
95 fixnum size = unbox_array_size();
99 dpush(tag<string>(allot_string(0,0)));
103 gc_root<byte_array> buf(allot_array_internal<byte_array>(size),this);
107 int c = fread(buf.untagged() + 1,1,size,file);
122 byte_array *new_buf = allot_byte_array(c);
123 memcpy(new_buf + 1, buf.untagged() + 1,c);
134 PRIMITIVE_GETVM()->vmprim_fread();
137 inline void factorvm::vmprim_fputc()
139 FILE *file = (FILE *)unbox_alien();
140 fixnum ch = to_fixnum(dpop());
144 if(fputc(ch,file) == EOF)
148 /* Still here? EINTR */
157 PRIMITIVE_GETVM()->vmprim_fputc();
160 inline void factorvm::vmprim_fwrite()
162 FILE *file = (FILE *)unbox_alien();
163 byte_array *text = untag_check<byte_array>(dpop());
164 cell length = array_capacity(text);
165 char *string = (char *)(text + 1);
172 size_t written = fwrite(string,1,length,file);
173 if(written == length)
182 /* Still here? EINTR */
191 PRIMITIVE_GETVM()->vmprim_fwrite();
194 inline void factorvm::vmprim_fseek()
196 int whence = to_fixnum(dpop());
197 FILE *file = (FILE *)unbox_alien();
198 off_t offset = to_signed_8(dpop());
202 case 0: whence = SEEK_SET; break;
203 case 1: whence = SEEK_CUR; break;
204 case 2: whence = SEEK_END; break;
206 critical_error("Bad value for whence",whence);
210 if(FSEEK(file,offset,whence) == -1)
214 /* Still here? EINTR */
215 critical_error("Don't know what to do; EINTR from fseek()?",0);
221 PRIMITIVE_GETVM()->vmprim_fseek();
224 inline void factorvm::vmprim_fflush()
226 FILE *file = (FILE *)unbox_alien();
229 if(fflush(file) == EOF)
238 PRIMITIVE_GETVM()->vmprim_fflush();
241 inline void factorvm::vmprim_fclose()
243 FILE *file = (FILE *)unbox_alien();
246 if(fclose(file) == EOF)
255 PRIMITIVE_GETVM()->vmprim_fclose();
258 /* This function is used by FFI I/O. Accessing the errno global directly is
259 not portable, since on some libc's errno is not a global but a funky macro that
260 reads thread-local storage. */
261 VM_C_API int err_no()
266 VM_C_API void clear_err_no()