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