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 data_root<byte_array> mode(ctx->pop(),this);
37 data_root<byte_array> path(ctx->pop(),this);
38 mode.untag_check(this);
39 path.untag_check(this);
43 FILE *file = fopen((char *)(path.untagged() + 1),
44 (char *)(mode.untagged() + 1));
49 ctx->push(allot_alien(file));
55 FILE *factor_vm::pop_file_handle()
57 return (FILE *)alien_offset(ctx->pop());
60 void factor_vm::primitive_fgetc()
62 FILE *file = pop_file_handle();
71 ctx->push(false_object);
79 ctx->push(tag_fixnum(c));
85 void factor_vm::primitive_fread()
87 FILE *file = pop_file_handle();
88 fixnum size = unbox_array_size();
92 ctx->push(tag<string>(allot_string(0,0)));
96 data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this);
100 int c = fread(buf.untagged() + 1,1,size,file);
105 ctx->push(false_object);
115 byte_array *new_buf = allot_byte_array(c);
116 memcpy(new_buf + 1, buf.untagged() + 1,c);
119 ctx->push(buf.value());
125 void factor_vm::primitive_fputc()
127 FILE *file = pop_file_handle();
128 fixnum ch = to_fixnum(ctx->pop());
132 if(fputc(ch,file) == EOF)
136 /* Still here? EINTR */
143 void factor_vm::primitive_fwrite()
145 FILE *file = pop_file_handle();
146 byte_array *text = untag_check<byte_array>(ctx->pop());
147 cell length = array_capacity(text);
148 char *string = (char *)(text + 1);
155 size_t written = fwrite(string,1,length,file);
156 if(written == length)
165 /* Still here? EINTR */
172 void factor_vm::primitive_ftell()
174 FILE *file = pop_file_handle();
177 if((offset = FTELL(file)) == -1)
180 ctx->push(from_signed_8(offset));
183 void factor_vm::primitive_fseek()
185 int whence = to_fixnum(ctx->pop());
186 FILE *file = pop_file_handle();
187 off_t offset = to_signed_8(ctx->pop());
191 case 0: whence = SEEK_SET; break;
192 case 1: whence = SEEK_CUR; break;
193 case 2: whence = SEEK_END; break;
195 critical_error("Bad value for whence",whence);
199 if(FSEEK(file,offset,whence) == -1)
203 /* Still here? EINTR */
204 critical_error("Don't know what to do; EINTR from fseek()?",0);
208 void factor_vm::primitive_fflush()
210 FILE *file = pop_file_handle();
213 if(fflush(file) == EOF)
220 void factor_vm::primitive_fclose()
222 FILE *file = pop_file_handle();
225 if(fclose(file) == EOF)
232 /* This function is used by FFI I/O. Accessing the errno global directly is
233 not portable, since on some libc's errno is not a global but a funky macro that
234 reads thread-local storage. */
235 VM_C_API int err_no()
240 VM_C_API void clear_err_no()