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