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::io_error_if_not_EINTR() {
49 general_error(ERROR_IO, tag_fixnum(errno), false_object);
52 FILE* factor_vm::safe_fopen(char* filename, const char* mode) {
55 file = fopen(filename, mode);
57 io_error_if_not_EINTR();
64 int factor_vm::safe_fgetc(FILE* stream) {
72 io_error_if_not_EINTR();
79 size_t factor_vm::safe_fread(void* ptr, size_t size, size_t nitems,
81 size_t ret = raw_fread(ptr, size, nitems, stream);
82 if (ret == 0 && !feof(stream))
83 io_error_if_not_EINTR();
87 void factor_vm::safe_fputc(int c, FILE* stream) {
89 if (putc(c, stream) == EOF)
90 io_error_if_not_EINTR();
96 size_t factor_vm::safe_fwrite(void* ptr, size_t size, size_t nitems,
98 size_t items_written = 0;
102 ret = fwrite((void*)((int*)ptr + items_written * size), size,
103 nitems - items_written, stream);
105 io_error_if_not_EINTR();
106 items_written += ret;
107 } while (items_written != nitems);
109 return items_written;
112 off_t factor_vm::safe_ftell(FILE* stream) {
115 if ((offset = FTELL(stream)) == -1)
116 io_error_if_not_EINTR();
123 void factor_vm::safe_fseek(FILE* stream, off_t offset, int whence) {
135 general_error(ERROR_IO, tag_fixnum(EINVAL), false_object);
139 if (FSEEK(stream, offset, whence) == -1)
140 io_error_if_not_EINTR();
146 void factor_vm::safe_fflush(FILE* stream) {
148 if (fflush(stream) == EOF)
149 io_error_if_not_EINTR();
155 void factor_vm::primitive_fopen() {
156 byte_array *mode = untag_check<byte_array>(ctx->pop());
157 byte_array *path = untag_check<byte_array>(ctx->pop());
159 FILE* file = safe_fopen((char*)(path + 1), (char*)(mode + 1));
160 ctx->push(allot_alien((cell)file));
163 FILE* factor_vm::pop_file_handle() {
164 return (FILE*)alien_offset(ctx->pop());
167 FILE* factor_vm::peek_file_handle() {
168 return (FILE*)alien_offset(ctx->peek());
171 void factor_vm::primitive_fgetc() {
172 FILE* file = peek_file_handle();
174 int c = safe_fgetc(file);
175 if (c == EOF && feof(file)) {
177 ctx->replace(false_object);
179 ctx->replace(tag_fixnum(c));
182 // Allocates memory (from_unsigned_cell())
183 void factor_vm::primitive_fread() {
184 FILE* file = pop_file_handle();
185 void* buf = (void*)alien_offset(ctx->pop());
186 cell size = unbox_array_size();
189 ctx->push(from_unsigned_cell(0));
192 size_t c = safe_fread(buf, 1, size, file);
193 if (c == 0 || feof(file))
195 ctx->push(from_unsigned_cell(c));
198 void factor_vm::primitive_fputc() {
199 FILE* file = pop_file_handle();
200 fixnum ch = to_fixnum(ctx->pop());
201 safe_fputc((int)ch, file);
204 void factor_vm::primitive_fwrite() {
205 FILE* file = pop_file_handle();
206 cell length = to_cell(ctx->pop());
207 char* text = alien_offset(ctx->pop());
212 size_t written = safe_fwrite(text, 1, length, file);
213 if (written != length)
214 io_error_if_not_EINTR();
217 void factor_vm::primitive_ftell() {
218 FILE* file = peek_file_handle();
219 ctx->replace(from_signed_8(safe_ftell(file)));
222 void factor_vm::primitive_fseek() {
223 FILE* file = pop_file_handle();
224 int whence = (int)to_fixnum(ctx->pop());
225 off_t offset = (off_t)to_signed_8(ctx->pop());
226 safe_fseek(file, offset, whence);
229 void factor_vm::primitive_fflush() {
230 FILE* file = pop_file_handle();
234 void factor_vm::primitive_fclose() {
235 FILE* file = pop_file_handle();
236 if (raw_fclose(file) == -1)
237 io_error_if_not_EINTR();
240 // This function is used by FFI I/O. Accessing the errno global directly is
241 // not portable, since on some libc's errno is not a global but a funky macro that
242 // reads thread-local storage.
243 VM_C_API int err_no() { return errno; }
245 VM_C_API void set_err_no(int err) { errno = err; }