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