5 // Simple wrappers for ANSI C I/O functions, used for bootstrapping.
7 // Note the ugly loop logic in almost every function; we have to handle EINTR
8 // and restart the operation if the system call was interrupted. Naive
9 // applications don't do this, but then they quickly fail if one enables
10 // itimer()s or other signals.
12 // The Factor library provides platform-specific code for Unix and Windows
13 // with many more capabilities so these words are not usually used in
16 size_t raw_fread(void* ptr, size_t size, size_t nitems, FILE* stream) {
17 FACTOR_ASSERT(nitems > 0);
18 size_t items_read = 0;
21 size_t ret = fread((void*)((int*)ptr + items_read * size), size,
22 nitems - items_read, stream);
27 else if (errno != EINTR) {
32 } while (items_read != nitems);
37 // Call fclose() once only. Issues #1335, #908.
38 int raw_fclose(FILE* stream) {
39 if (fclose(stream) == EOF && errno != EINTR)
45 void factor_vm::init_c_io() {
46 special_objects[OBJ_STDIN] = allot_alien(false_object, (cell)stdin);
47 special_objects[OBJ_STDOUT] = allot_alien(false_object, (cell)stdout);
48 special_objects[OBJ_STDERR] = allot_alien(false_object, (cell)stderr);
52 void factor_vm::io_error_if_not_EINTR() {
56 general_error(ERROR_IO, tag_fixnum(errno), false_object);
59 FILE* factor_vm::safe_fopen(char* filename, const char* mode) {
62 file = fopen(filename, mode);
64 io_error_if_not_EINTR();
71 int factor_vm::safe_fgetc(FILE* stream) {
79 io_error_if_not_EINTR();
86 size_t factor_vm::safe_fread(void* ptr, size_t size, size_t nitems,
88 size_t ret = raw_fread(ptr, size, nitems, stream);
89 if (ret == 0 && !feof(stream))
90 io_error_if_not_EINTR();
94 void factor_vm::safe_fputc(int c, FILE* stream) {
96 if (putc(c, stream) == EOF)
97 io_error_if_not_EINTR();
103 size_t factor_vm::safe_fwrite(void* ptr, size_t size, size_t nitems,
105 size_t items_written = 0;
109 ret = fwrite((void*)((int*)ptr + items_written * size), size,
110 nitems - items_written, stream);
112 io_error_if_not_EINTR();
113 items_written += ret;
114 } while (items_written != nitems);
116 return items_written;
119 int factor_vm::safe_ftell(FILE* stream) {
122 if ((offset = FTELL(stream)) == -1)
123 io_error_if_not_EINTR();
130 void factor_vm::safe_fseek(FILE* stream, off_t offset, int whence) {
142 critical_error("Bad value for whence", whence);
146 if (FSEEK(stream, offset, whence) == -1)
147 io_error_if_not_EINTR();
153 void factor_vm::safe_fflush(FILE* stream) {
155 if (fflush(stream) == EOF)
156 io_error_if_not_EINTR();
162 void factor_vm::primitive_fopen() {
163 data_root<byte_array> mode(ctx->pop(), this);
164 data_root<byte_array> path(ctx->pop(), this);
169 file = safe_fopen((char*)(path.untagged() + 1),
170 (char*)(mode.untagged() + 1));
171 ctx->push(allot_alien((cell)file));
174 FILE* factor_vm::pop_file_handle() { return (FILE*)alien_offset(ctx->pop()); }
176 FILE* factor_vm::peek_file_handle() { return (FILE*)alien_offset(ctx->peek()); }
178 void factor_vm::primitive_fgetc() {
179 FILE* file = peek_file_handle();
181 int c = safe_fgetc(file);
182 if (c == EOF && feof(file)) {
184 ctx->replace(false_object);
186 ctx->replace(tag_fixnum(c));
189 // Allocates memory (from_unsigned_cell())
190 void factor_vm::primitive_fread() {
191 FILE* file = pop_file_handle();
192 void* buf = (void*)alien_offset(ctx->pop());
193 cell size = unbox_array_size();
196 ctx->push(from_unsigned_cell(0));
199 size_t c = safe_fread(buf, 1, size, file);
200 if (c == 0 || feof(file))
202 ctx->push(from_unsigned_cell(c));
205 void factor_vm::primitive_fputc() {
206 FILE* file = pop_file_handle();
207 fixnum ch = to_fixnum(ctx->pop());
208 safe_fputc((int)ch, file);
211 void factor_vm::primitive_fwrite() {
212 FILE* file = pop_file_handle();
213 cell length = to_cell(ctx->pop());
214 char* text = alien_offset(ctx->pop());
219 size_t written = safe_fwrite(text, 1, length, file);
220 if (written != length)
221 io_error_if_not_EINTR();
224 void factor_vm::primitive_ftell() {
225 FILE* file = peek_file_handle();
226 ctx->replace(from_signed_8(safe_ftell(file)));
229 void factor_vm::primitive_fseek() {
230 FILE* file = pop_file_handle();
231 int whence = (int)to_fixnum(ctx->pop());
232 off_t offset = (off_t)to_signed_8(ctx->pop());
233 safe_fseek(file, offset, whence);
236 void factor_vm::primitive_fflush() {
237 FILE* file = pop_file_handle();
241 void factor_vm::primitive_fclose() {
242 FILE* file = pop_file_handle();
243 if (raw_fclose(file) == -1)
244 io_error_if_not_EINTR();
247 // This function is used by FFI I/O. Accessing the errno global directly is
248 // not portable, since on some libc's errno is not a global but a funky macro that
249 // reads thread-local storage.
250 VM_C_API int err_no() { return errno; }
252 VM_C_API void set_err_no(int err) { errno = err; }