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 size_t safe_fread(void *ptr, size_t size, size_t nitems, FILE *stream)
  35 {
  36         size_t items_read = 0;
  37
  38         do {
  39                 items_read += fread((void*)((int*)ptr+items_read*size),size,nitems-items_read,stream);
  40         } while(items_read != nitems && errno == EINTR);
  41
  42         return items_read;
  43 }
  44
  45 size_t safe_fwrite(void *ptr, size_t size, size_t nitems, FILE *stream)
  46 {
  47         size_t items_written = 0;
  48
  49         do {
  50                 items_written += fwrite((void*)((int*)ptr+items_written*size),size,nitems-items_written,stream);
  51         } while(items_written != nitems && errno == EINTR);
  52
  53         return items_written;
  54 }
  55
  56 int safe_fclose(FILE *stream)
  57 {
  58         int ret = 0;
  59
  60         do {
  61                 ret = fclose(stream);
  62         } while(ret != 0 && errno == EINTR);
  63
  64         return ret;
  65 }
  66
  67 void factor_vm::primitive_fopen()
  68 {
  69         data_root<byte_array> mode(ctx->pop(),this);
  70         data_root<byte_array> path(ctx->pop(),this);
  71         mode.untag_check(this);
  72         path.untag_check(this);
  73
  74         FILE *file;
  75         do {
  76                 file = fopen((char *)(path.untagged() + 1),
  77                                    (char *)(mode.untagged() + 1));
  78                 if(file == NULL)
  79                         io_error();
  80         } while(errno == EINTR);
  81
  82         ctx->push(allot_alien(file));
  83 }
  84
  85 FILE *factor_vm::pop_file_handle()
  86 {
  87         return (FILE *)alien_offset(ctx->pop());
  88 }
  89
  90 void factor_vm::primitive_fgetc()
  91 {
  92         FILE *file = pop_file_handle();
  93
  94         do {
  95                 int c = fgetc(file);
  96                 if(c == EOF)
  97                 {
  98                         if(feof(file))
  99                         {
 100                                 ctx->push(false_object);
 101                                 break;
 102                         }
 103                         else
 104                                 io_error();
 105                 }
 106                 else
 107                 {
 108                         ctx->push(tag_fixnum(c));
 109                         break;
 110                 }
 111         } while(errno == EINTR);
 112 }
 113
 114 void factor_vm::primitive_fread()
 115 {
 116         FILE *file = pop_file_handle();
 117         fixnum size = unbox_array_size();
 118
 119         if(size == 0)
 120         {
 121                 ctx->push(tag<string>(allot_string(0,0)));
 122                 return;
 123         }
 124
 125         data_root<byte_array> buf(allot_uninitialized_array<byte_array>(size),this);
 126
 127         for(;;)
 128         {
 129                 int c = safe_fread(buf.untagged() + 1,1,size,file);
 130                 if(c == 0)
 131                 {
 132                         if(feof(file))
 133                         {
 134                                 ctx->push(false_object);
 135                                 break;
 136                         }
 137                         else
 138                                 io_error();
 139                 }
 140                 else
 141                 {
 142                         if(feof(file))
 143                         {
 144                                 byte_array *new_buf = allot_byte_array(c);
 145                                 memcpy(new_buf + 1, buf.untagged() + 1,c);
 146                                 buf = new_buf;
 147                         }
 148
 149                         ctx->push(buf.value());
 150                         break;
 151                 }
 152         }
 153 }
 154
 155 void factor_vm::primitive_fputc()
 156 {
 157         FILE *file = pop_file_handle();
 158         fixnum ch = to_fixnum(ctx->pop());
 159
 160         do {
 161                 if(fputc(ch,file) == EOF)
 162                         io_error();
 163                 else
 164                         break;
 165         } while(errno == EINTR);
 166 }
 167
 168 void factor_vm::primitive_fwrite()
 169 {
 170         FILE *file = pop_file_handle();
 171         byte_array *text = untag_check<byte_array>(ctx->pop());
 172         cell length = array_capacity(text);
 173         char *string = (char *)(text + 1);
 174
 175         if(length == 0)
 176                 return;
 177
 178         size_t written = safe_fwrite(string,1,length,file);
 179         if(written != length)
 180                 io_error();
 181 }
 182
 183 void factor_vm::primitive_ftell()
 184 {
 185         FILE *file = pop_file_handle();
 186         off_t offset;
 187
 188         do {
 189                 if((offset = FTELL(file)) == -1)
 190                         io_error();
 191                 else
 192                         break;
 193         } while(errno == EINTR);
 194
 195         ctx->push(from_signed_8(offset));
 196 }
 197
 198 void factor_vm::primitive_fseek()
 199 {
 200         int whence = to_fixnum(ctx->pop());
 201         FILE *file = pop_file_handle();
 202         off_t offset = to_signed_8(ctx->pop());
 203
 204         switch(whence)
 205         {
 206         case 0: whence = SEEK_SET; break;
 207         case 1: whence = SEEK_CUR; break;
 208         case 2: whence = SEEK_END; break;
 209         default:
 210                 critical_error("Bad value for whence",whence);
 211                 break;
 212         }
 213
 214         do {
 215                 if(FSEEK(file,offset,whence) == -1)
 216                         io_error();
 217                 else
 218                         break;
 219         } while(errno == EINTR);
 220 }
 221
 222 void factor_vm::primitive_fflush()
 223 {
 224         FILE *file = pop_file_handle();
 225         do {
 226                 if(fflush(file) == EOF)
 227                         io_error();
 228                 else
 229                         break;
 230         } while(errno == EINTR);
 231 }
 232
 233 void factor_vm::primitive_fclose()
 234 {
 235         FILE *file = pop_file_handle();
 236         if(safe_fclose(file) == EOF)
 237                 io_error();
 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()
 244 {
 245         return errno;
 246 }
 247
 248 VM_C_API void clear_err_no()
 249 {
 250         errno = 0;
 251 }
 252 }