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 // Allocates memory
  45 void factor_vm::io_error_if_not_EINTR() {
  46   if (errno == EINTR)
  47     return;
  48
  49   general_error(ERROR_IO, tag_fixnum(errno), false_object);
  50 }
  51
  52 FILE* factor_vm::safe_fopen(char* filename, const char* mode) {
  53   FILE* file;
  54   for (;;) {
  55     file = fopen(filename, mode);
  56     if (file == NULL)
  57       io_error_if_not_EINTR();
  58     else
  59       break;
  60   }
  61   return file;
  62 }
  63
  64 int factor_vm::safe_fgetc(FILE* stream) {
  65   int c;
  66   for (;;) {
  67     c = getc(stream);
  68     if (c == EOF) {
  69       if (feof(stream))
  70         return EOF;
  71       else
  72         io_error_if_not_EINTR();
  73     } else
  74       break;
  75   }
  76   return c;
  77 }
  78
  79 size_t factor_vm::safe_fread(void* ptr, size_t size, size_t nitems,
  80                              FILE* stream) {
  81   size_t ret = raw_fread(ptr, size, nitems, stream);
  82   if (ret == 0 && !feof(stream))
  83     io_error_if_not_EINTR();
  84   return ret;
  85 }
  86
  87 void factor_vm::safe_fputc(int c, FILE* stream) {
  88   for (;;) {
  89     if (putc(c, stream) == EOF)
  90       io_error_if_not_EINTR();
  91     else
  92       break;
  93   }
  94 }
  95
  96 size_t factor_vm::safe_fwrite(void* ptr, size_t size, size_t nitems,
  97                               FILE* stream) {
  98   size_t items_written = 0;
  99   size_t ret = 0;
 100
 101   do {
 102     ret = fwrite((void*)((int*)ptr + items_written * size), size,
 103                  nitems - items_written, stream);
 104     if (ret == 0)
 105       io_error_if_not_EINTR();
 106     items_written += ret;
 107   } while (items_written != nitems);
 108
 109   return items_written;
 110 }
 111
 112 off_t factor_vm::safe_ftell(FILE* stream) {
 113   off_t offset;
 114   for (;;) {
 115     if ((offset = FTELL(stream)) == -1)
 116       io_error_if_not_EINTR();
 117     else
 118       break;
 119   }
 120   return offset;
 121 }
 122
 123 void factor_vm::safe_fseek(FILE* stream, off_t offset, int whence) {
 124   switch (whence) {
 125     case 0:
 126       whence = SEEK_SET;
 127       break;
 128     case 1:
 129       whence = SEEK_CUR;
 130       break;
 131     case 2:
 132       whence = SEEK_END;
 133       break;
 134     default:
 135       general_error(ERROR_IO, tag_fixnum(EINVAL), false_object);
 136   }
 137
 138   for (;;) {
 139     if (FSEEK(stream, offset, whence) == -1)
 140       io_error_if_not_EINTR();
 141     else
 142       break;
 143   }
 144 }
 145
 146 void factor_vm::safe_fflush(FILE* stream) {
 147   for (;;) {
 148     if (fflush(stream) == EOF)
 149       io_error_if_not_EINTR();
 150     else
 151       break;
 152   }
 153 }
 154
 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());
 158
 159   FILE* file = safe_fopen((char*)(path + 1), (char*)(mode + 1));
 160   ctx->push(allot_alien((cell)file));
 161 }
 162
 163 FILE* factor_vm::pop_file_handle() {
 164   return (FILE*)alien_offset(ctx->pop());
 165 }
 166
 167 FILE* factor_vm::peek_file_handle() {
 168   return (FILE*)alien_offset(ctx->peek());
 169 }
 170
 171 void factor_vm::primitive_fgetc() {
 172   FILE* file = peek_file_handle();
 173
 174   int c = safe_fgetc(file);
 175   if (c == EOF && feof(file)) {
 176     clearerr(file);
 177     ctx->replace(false_object);
 178   } else
 179     ctx->replace(tag_fixnum(c));
 180 }
 181
 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();
 187
 188   if (size == 0) {
 189     ctx->push(from_unsigned_cell(0));
 190     return;
 191   }
 192   size_t c = safe_fread(buf, 1, size, file);
 193   if (c == 0 || feof(file))
 194     clearerr(file);
 195   ctx->push(from_unsigned_cell(c));
 196 }
 197
 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);
 202 }
 203
 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());
 208
 209   if (length == 0)
 210     return;
 211
 212   size_t written = safe_fwrite(text, 1, length, file);
 213   if (written != length)
 214     io_error_if_not_EINTR();
 215 }
 216
 217 void factor_vm::primitive_ftell() {
 218   FILE* file = peek_file_handle();
 219   ctx->replace(from_signed_8(safe_ftell(file)));
 220 }
 221
 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);
 227 }
 228
 229 void factor_vm::primitive_fflush() {
 230   FILE* file = pop_file_handle();
 231   safe_fflush(file);
 232 }
 233
 234 void factor_vm::primitive_fclose() {
 235   FILE* file = pop_file_handle();
 236   if (raw_fclose(file) == -1)
 237     io_error_if_not_EINTR();
 238 }
 239
 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; }
 244
 245 VM_C_API void set_err_no(int err) { errno = err; }
 246 }