vm/io.cpp

   1 #include "master.hpp"
   2
   3 namespace factor
   4 {
   5
   6 /* Simple wrappers for ANSI C I/O functions, used for bootstrapping.
   7
   8 Note the ugly loop logic in almost every function; we have to handle EINTR
   9 and restart the operation if the system call was interrupted. Naive
  10 applications don't do this, but then they quickly fail if one enables
  11 itimer()s or other signals.
  12
  13 The Factor library provides platform-specific code for Unix and Windows
  14 with many more capabilities so these words are not usually used in
  15 normal operation. */
  16
  17 void factor_vm::init_c_io()
  18 {
  19         special_objects[OBJ_STDIN] = allot_alien(false_object,(cell)stdin);
  20         special_objects[OBJ_STDOUT] = allot_alien(false_object,(cell)stdout);
  21         special_objects[OBJ_STDERR] = allot_alien(false_object,(cell)stderr);
  22 }
  23
  24 void factor_vm::io_error()
  25 {
  26 #ifndef WINCE
  27         if(errno == EINTR)
  28                 return;
  29 #endif
  30
  31         general_error(ERROR_IO,tag_fixnum(errno),false_object,NULL);
  32 }
  33
  34 FILE *factor_vm::safe_fopen(char *filename, char *mode)
  35 {
  36         FILE *file;
  37         do {
  38                 file = fopen(filename,mode);
  39                 if(file == NULL)
  40                         io_error();
  41                 else
  42                         break;
  43         } while(errno == EINTR);
  44         return file;
  45 }
  46
  47 int factor_vm::safe_fgetc(FILE *stream)
  48 {
  49         int c;
  50         do {
  51                 c = fgetc(stream);
  52                 if(c == EOF)
  53                 {
  54                         if(feof(stream))
  55                                 return EOF;
  56                         else
  57                                 io_error();
  58                 }
  59                 else
  60                         break;
  61         } while(errno == EINTR);
  62         return c;
  63 }
  64
  65 size_t factor_vm::safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
  66 {
  67         size_t items_read = 0;
  68
  69         do {
  70                 items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
  71         } while(items_read != nitems && errno == EINTR);
  72
  73         return items_read;
  74 }
  75
  76 void factor_vm::safe_fputc(int c, FILE *stream)
  77 {
  78         do {
  79                 if(fputc(c,stream) == EOF)
  80                         io_error();
  81                 else
  82                         break;
  83         } while(errno == EINTR);
  84 }
  85
  86 size_t factor_vm::safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
  87 {
  88         size_t items_written = 0;
  89
  90         do {
  91                 items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
  92         } while(items_written != nitems && errno == EINTR);
  93
  94         return items_written;
  95 }
  96
  97 int factor_vm::safe_ftell(FILE *stream)
  98 {
  99         off_t offset;
 100         do {
 101                 if((offset = FTELL(stream)) == -1)
 102                         io_error();
 103                 else
 104                         break;
 105         } while(errno == EINTR);
 106         return offset;
 107 }
 108
 109 void factor_vm::safe_fseek(FILE *stream, off_t offset, int whence)
 110 {
 111         switch(whence)
 112         {
 113         case 0: whence = SEEK_SET; break;
 114         case 1: whence = SEEK_CUR; break;
 115         case 2: whence = SEEK_END; break;
 116         default:
 117                 critical_error("Bad value for whence",whence);
 118         }
 119
 120         do {
 121                 if(FSEEK(stream,offset,whence) == -1)
 122                         io_error();
 123                 else
 124                         break;
 125         } while(errno == EINTR);
 126 }
 127
 128 void factor_vm::safe_fflush(FILE *stream)
 129 {
 130         do {
 131                 if(fflush(stream) == EOF)
 132                         io_error();
 133                 else
 134                         break;
 135         } while(errno == EINTR);
 136 }
 137
 138 void factor_vm::safe_fclose(FILE *stream)
 139 {
 140         do {
 141                 if(fclose(stream) == EOF)
 142                         io_error();
 143                 else
 144                         break;
 145         } while(errno == EINTR);
 146 }
 147
 148 void factor_vm::primitive_fopen()
 149 {
 150         data_root<byte_array> mode(ctx->pop(),this);
 151         data_root<byte_array> path(ctx->pop(),this);
 152         mode.untag_check(this);
 153         path.untag_check(this);
 154
 155         FILE *file;
 156         file = safe_fopen((char *)(path.untagged() + 1),
 157                 (char *)(mode.untagged() + 1));
 158         ctx->push(allot_alien(file));
 159 }
 160
 161 FILE *factor_vm::pop_file_handle()
 162 {
 163         return (FILE *)alien_offset(ctx->pop());
 164 }
 165
 166 void factor_vm::primitive_fgetc()
 167 {
 168         FILE *file = pop_file_handle();
 169
 170         int c = safe_fgetc(file);
 171         if(c == EOF && feof(file))
 172                 ctx->push(false_object);
 173         else
 174                 ctx->push(tag_fixnum(c));
 175 }
 176
 177 void factor_vm::primitive_fread()
 178 {
 179         FILE *file = pop_file_handle();
 180         fixnum size = unbox_array_size();
 181
 182         if(size == 0)
 183         {
 184                 ctx->push(tag<string>(allot_string(0,0)));
 185                 return;
 186         }
 187
 188         data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this);
 189
 190         int c = safe_fread(buf.untagged() + 1,1,size,file);
 191         if(c == 0)
 192         {
 193                 if(feof(file))
 194                         ctx->push(false_object);
 195                 else
 196                         io_error();
 197         }
 198         else
 199         {
 200                 if(feof(file))
 201                 {
 202                         byte_array *new_buf = allot_byte_array(c);
 203                         memcpy(new_buf + 1, buf.untagged() + 1,c);
 204                         buf = new_buf;
 205                 }
 206
 207                 ctx->push(buf.value());
 208         }
 209 }
 210
 211 void factor_vm::primitive_fputc()
 212 {
 213         FILE *file = pop_file_handle();
 214         fixnum ch = to_fixnum(ctx->pop());
 215         safe_fputc(ch, file);
 216 }
 217
 218 void factor_vm::primitive_fwrite()
 219 {
 220         FILE *file = pop_file_handle();
 221         byte_array *text = untag_check<byte_array>(ctx->pop());
 222         cell length = array_capacity(text);
 223         char *string = (char *)(text + 1);
 224
 225         if(length == 0)
 226                 return;
 227
 228         size_t written = safe_fwrite(string,1,length,file);
 229         if(written != length)
 230                 io_error();
 231 }
 232
 233 void factor_vm::primitive_ftell()
 234 {
 235         FILE *file = pop_file_handle();
 236         ctx->push(from_signed_8(safe_ftell(file)));
 237 }
 238
 239 void factor_vm::primitive_fseek()
 240 {
 241         int whence = to_fixnum(ctx->pop());
 242         FILE *file = pop_file_handle();
 243         off_t offset = to_signed_8(ctx->pop());
 244         safe_fseek(file,offset,whence);
 245 }
 246
 247 void factor_vm::primitive_fflush()
 248 {
 249         FILE *file = pop_file_handle();
 250         safe_fflush(file);
 251 }
 252
 253 void factor_vm::primitive_fclose()
 254 {
 255         FILE *file = pop_file_handle();
 256         safe_fclose(file);
 257 }
 258
 259 /* This function is used by FFI I/O. Accessing the errno global directly is
 260 not portable, since on some libc's errno is not a global but a funky macro that
 261 reads thread-local storage. */
 262 VM_C_API int err_no()
 263 {
 264         return errno;
 265 }
 266
 267 VM_C_API void set_err_no(int err)
 268 {
 269         errno = err;
 270 }
 271 }