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