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   size_t items_read = 0;
  18   size_t ret = 0;
  19
  20   do {
  21     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       else if (errno != EINTR) {
  27         return 0;
  28       }
  29     }
  30     items_read += ret;
  31   } while (items_read != nitems);
  32
  33   return items_read;
  34 }
  35
  36 // Call fclose() once only. Issues #1335, #908.
  37 int raw_fclose(FILE* stream) {
  38   if (fclose(stream) == EOF && errno != EINTR)
  39     return -1;
  40   return 0;
  41 }
  42
  43
  44 void factor_vm::init_c_io() {
  45   special_objects[OBJ_STDIN] = allot_alien(false_object, (cell)stdin);
  46   special_objects[OBJ_STDOUT] = allot_alien(false_object, (cell)stdout);
  47   special_objects[OBJ_STDERR] = allot_alien(false_object, (cell)stderr);
  48 }
  49
  50 /* Allocates memory */
  51 void factor_vm::io_error_if_not_EINTR() {
  52   if (errno == EINTR)
  53     return;
  54
  55   general_error(ERROR_IO, tag_fixnum(errno), false_object);
  56 }
  57
  58 FILE* factor_vm::safe_fopen(char* filename, char* mode) {
  59   FILE* file;
  60   for (;;) {
  61     file = fopen(filename, mode);
  62     if (file == NULL)
  63       io_error_if_not_EINTR();
  64     else
  65       break;
  66   }
  67   return file;
  68 }
  69
  70 int factor_vm::safe_fgetc(FILE* stream) {
  71   int c;
  72   for (;;) {
  73     c = getc(stream);
  74     if (c == EOF) {
  75       if (feof(stream))
  76         return EOF;
  77       else
  78         io_error_if_not_EINTR();
  79     } else
  80       break;
  81   }
  82   return c;
  83 }
  84
  85 size_t factor_vm::safe_fread(void* ptr, size_t size, size_t nitems,
  86                              FILE* stream) {
  87   size_t ret = raw_fread(ptr, size, nitems, stream);
  88   if (!ret)
  89     io_error_if_not_EINTR();
  90   return ret;
  91 }
  92
  93 void factor_vm::safe_fputc(int c, FILE* stream) {
  94   for (;;) {
  95     if (putc(c, stream) == EOF)
  96       io_error_if_not_EINTR();
  97     else
  98       break;
  99   }
 100 }
 101
 102 size_t factor_vm::safe_fwrite(void* ptr, size_t size, size_t nitems,
 103                               FILE* stream) {
 104   size_t items_written = 0;
 105   size_t ret = 0;
 106
 107   do {
 108     ret = fwrite((void*)((int*)ptr + items_written * size), size,
 109                  nitems - items_written, stream);
 110     if (ret == 0)
 111       io_error_if_not_EINTR();
 112     items_written += ret;
 113   } while (items_written != nitems);
 114
 115   return items_written;
 116 }
 117
 118 int factor_vm::safe_ftell(FILE* stream) {
 119   off_t offset;
 120   for (;;) {
 121     if ((offset = FTELL(stream)) == -1)
 122       io_error_if_not_EINTR();
 123     else
 124       break;
 125   }
 126   return offset;
 127 }
 128
 129 void factor_vm::safe_fseek(FILE* stream, off_t offset, int whence) {
 130   switch (whence) {
 131     case 0:
 132       whence = SEEK_SET;
 133       break;
 134     case 1:
 135       whence = SEEK_CUR;
 136       break;
 137     case 2:
 138       whence = SEEK_END;
 139       break;
 140     default:
 141       critical_error("Bad value for whence", whence);
 142   }
 143
 144   for (;;) {
 145     if (FSEEK(stream, offset, whence) == -1)
 146       io_error_if_not_EINTR();
 147     else
 148       break;
 149   }
 150 }
 151
 152 void factor_vm::safe_fflush(FILE* stream) {
 153   for (;;) {
 154     if (fflush(stream) == EOF)
 155       io_error_if_not_EINTR();
 156     else
 157       break;
 158   }
 159 }
 160
 161 void factor_vm::safe_fclose(FILE* stream) {
 162   if (raw_fclose(stream) == -1)
 163     io_error_if_not_EINTR();
 164 }
 165
 166 void factor_vm::primitive_fopen() {
 167   data_root<byte_array> mode(ctx->pop(), this);
 168   data_root<byte_array> path(ctx->pop(), this);
 169   mode.untag_check(this);
 170   path.untag_check(this);
 171
 172   FILE* file;
 173   file = safe_fopen((char*)(path.untagged() + 1), (char*)(mode.untagged() + 1));
 174   ctx->push(allot_alien(file));
 175 }
 176
 177 FILE* factor_vm::pop_file_handle() { return (FILE*)alien_offset(ctx->pop()); }
 178
 179 FILE* factor_vm::peek_file_handle() { return (FILE*)alien_offset(ctx->peek()); }
 180
 181 void factor_vm::primitive_fgetc() {
 182   FILE* file = peek_file_handle();
 183
 184   int c = safe_fgetc(file);
 185   if (c == EOF && feof(file)) {
 186     clearerr(file);
 187     ctx->replace(false_object);
 188   } else
 189     ctx->replace(tag_fixnum(c));
 190 }
 191
 192 /* Allocates memory (from_unsigned_cell())*/
 193 void factor_vm::primitive_fread() {
 194   FILE* file = pop_file_handle();
 195   void* buf = (void*)alien_offset(ctx->pop());
 196   cell size = unbox_array_size();
 197
 198   if (size == 0) {
 199     ctx->push(from_unsigned_cell(0));
 200     return;
 201   }
 202
 203   size_t c = safe_fread(buf, 1, size, file);
 204   if (c == 0 || feof(file))
 205     clearerr(file);
 206   ctx->push(from_unsigned_cell(c));
 207 }
 208
 209 void factor_vm::primitive_fputc() {
 210   FILE* file = pop_file_handle();
 211   fixnum ch = to_fixnum(ctx->pop());
 212   safe_fputc((int)ch, file);
 213 }
 214
 215 void factor_vm::primitive_fwrite() {
 216   FILE* file = pop_file_handle();
 217   cell length = to_cell(ctx->pop());
 218   char* text = alien_offset(ctx->pop());
 219
 220   if (length == 0)
 221     return;
 222
 223   size_t written = safe_fwrite(text, 1, length, file);
 224   if (written != length)
 225     io_error_if_not_EINTR();
 226 }
 227
 228 void factor_vm::primitive_ftell() {
 229   FILE* file = peek_file_handle();
 230   ctx->replace(from_signed_8(safe_ftell(file)));
 231 }
 232
 233 void factor_vm::primitive_fseek() {
 234   FILE* file = pop_file_handle();
 235   int whence = (int)to_fixnum(ctx->pop());
 236   off_t offset = (off_t)to_signed_8(ctx->pop());
 237   safe_fseek(file, offset, whence);
 238 }
 239
 240 void factor_vm::primitive_fflush() {
 241   FILE* file = pop_file_handle();
 242   safe_fflush(file);
 243 }
 244
 245 void factor_vm::primitive_fclose() {
 246   FILE* file = pop_file_handle();
 247   safe_fclose(file);
 248 }
 249
 250 /* This function is used by FFI I/O. Accessing the errno global directly is
 251 not portable, since on some libc's errno is not a global but a funky macro that
 252 reads thread-local storage. */
 253 VM_C_API int err_no() { return errno; }
 254
 255 VM_C_API void set_err_no(int err) { errno = err; }
 256 }