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