vm/io.cpp

   1 #include "master.hpp"
   2
   3 namespace factor {
   4
   5 // Simple wrappers for ANSI C I/O functions, used for bootstrapping.
   6
   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.
  11
  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
  14 // normal operation.
  15
  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;
  19
  20   do {
  21     size_t ret = fread((void*)((int*)ptr + items_read * size), size,
  22                        nitems - items_read, stream);
  23     if (ret == 0) {
  24       if (feof(stream)) {
  25         break;
  26       }
  27       else if (errno != EINTR) {
  28         return 0;
  29       }
  30     }
  31     items_read += ret;
  32   } while (items_read != nitems);
  33
  34   return items_read;
  35 }
  36
  37 // Call fclose() once only. Issues #1335, #908.
  38 int raw_fclose(FILE* stream) {
  39   if (fclose(stream) == EOF && errno != EINTR)
  40     return -1;
  41   return 0;
  42 }
  43
  44
  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);
  49 }
  50
  51 // Allocates memory
  52 void factor_vm::io_error_if_not_EINTR() {
  53   if (errno == EINTR)
  54     return;
  55
  56   general_error(ERROR_IO, tag_fixnum(errno), false_object);
  57 }
  58
  59 FILE* factor_vm::safe_fopen(char* filename, const char* mode) {
  60   FILE* file;
  61   for (;;) {
  62     file = fopen(filename, mode);
  63     if (file == NULL)
  64       io_error_if_not_EINTR();
  65     else
  66       break;
  67   }
  68   return file;
  69 }
  70
  71 int factor_vm::safe_fgetc(FILE* stream) {
  72   int c;
  73   for (;;) {
  74     c = getc(stream);
  75     if (c == EOF) {
  76       if (feof(stream))
  77         return EOF;
  78       else
  79         io_error_if_not_EINTR();
  80     } else
  81       break;
  82   }
  83   return c;
  84 }
  85
  86 size_t factor_vm::safe_fread(void* ptr, size_t size, size_t nitems,
  87                              FILE* stream) {
  88   size_t ret = raw_fread(ptr, size, nitems, stream);
  89   if (ret == 0 && !feof(stream))
  90     io_error_if_not_EINTR();
  91   return ret;
  92 }
  93
  94 void factor_vm::safe_fputc(int c, FILE* stream) {
  95   for (;;) {
  96     if (putc(c, stream) == EOF)
  97       io_error_if_not_EINTR();
  98     else
  99       break;
 100   }
 101 }
 102
 103 size_t factor_vm::safe_fwrite(void* ptr, size_t size, size_t nitems,
 104                               FILE* stream) {
 105   size_t items_written = 0;
 106   size_t ret = 0;
 107
 108   do {
 109     ret = fwrite((void*)((int*)ptr + items_written * size), size,
 110                  nitems - items_written, stream);
 111     if (ret == 0)
 112       io_error_if_not_EINTR();
 113     items_written += ret;
 114   } while (items_written != nitems);
 115
 116   return items_written;
 117 }
 118
 119 int factor_vm::safe_ftell(FILE* stream) {
 120   off_t offset;
 121   for (;;) {
 122     if ((offset = FTELL(stream)) == -1)
 123       io_error_if_not_EINTR();
 124     else
 125       break;
 126   }
 127   return offset;
 128 }
 129
 130 void factor_vm::safe_fseek(FILE* stream, off_t offset, int whence) {
 131   switch (whence) {
 132     case 0:
 133       whence = SEEK_SET;
 134       break;
 135     case 1:
 136       whence = SEEK_CUR;
 137       break;
 138     case 2:
 139       whence = SEEK_END;
 140       break;
 141     default:
 142       critical_error("Bad value for whence", whence);
 143   }
 144
 145   for (;;) {
 146     if (FSEEK(stream, offset, whence) == -1)
 147       io_error_if_not_EINTR();
 148     else
 149       break;
 150   }
 151 }
 152
 153 void factor_vm::safe_fflush(FILE* stream) {
 154   for (;;) {
 155     if (fflush(stream) == EOF)
 156       io_error_if_not_EINTR();
 157     else
 158       break;
 159   }
 160 }
 161
 162 void factor_vm::primitive_fopen() {
 163   data_root<byte_array> mode(ctx->pop(), this);
 164   data_root<byte_array> path(ctx->pop(), this);
 165   check_tagged(mode);
 166   check_tagged(path);
 167
 168   FILE* file;
 169   file = safe_fopen((char*)(path.untagged() + 1),
 170                     (char*)(mode.untagged() + 1));
 171   ctx->push(allot_alien((cell)file));
 172 }
 173
 174 FILE* factor_vm::pop_file_handle() { return (FILE*)alien_offset(ctx->pop()); }
 175
 176 FILE* factor_vm::peek_file_handle() { return (FILE*)alien_offset(ctx->peek()); }
 177
 178 void factor_vm::primitive_fgetc() {
 179   FILE* file = peek_file_handle();
 180
 181   int c = safe_fgetc(file);
 182   if (c == EOF && feof(file)) {
 183     clearerr(file);
 184     ctx->replace(false_object);
 185   } else
 186     ctx->replace(tag_fixnum(c));
 187 }
 188
 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();
 194
 195   if (size == 0) {
 196     ctx->push(from_unsigned_cell(0));
 197     return;
 198   }
 199   size_t c = safe_fread(buf, 1, size, file);
 200   if (c == 0 || feof(file))
 201     clearerr(file);
 202   ctx->push(from_unsigned_cell(c));
 203 }
 204
 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);
 209 }
 210
 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());
 215
 216   if (length == 0)
 217     return;
 218
 219   size_t written = safe_fwrite(text, 1, length, file);
 220   if (written != length)
 221     io_error_if_not_EINTR();
 222 }
 223
 224 void factor_vm::primitive_ftell() {
 225   FILE* file = peek_file_handle();
 226   ctx->replace(from_signed_8(safe_ftell(file)));
 227 }
 228
 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);
 234 }
 235
 236 void factor_vm::primitive_fflush() {
 237   FILE* file = pop_file_handle();
 238   safe_fflush(file);
 239 }
 240
 241 void factor_vm::primitive_fclose() {
 242   FILE* file = pop_file_handle();
 243   if (raw_fclose(file) == -1)
 244     io_error_if_not_EINTR();
 245 }
 246
 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; }
 251
 252 VM_C_API void set_err_no(int err) { errno = err; }
 253 }