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