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 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(F);
  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(F);
 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_fseek()
 168 {
 169         int whence = to_fixnum(dpop());
 170         FILE *file = (FILE *)unbox_alien();
 171         off_t offset = to_signed_8(dpop());
 172
 173         switch(whence)
 174         {
 175         case 0: whence = SEEK_SET; break;
 176         case 1: whence = SEEK_CUR; break;
 177         case 2: whence = SEEK_END; break;
 178         default:
 179                 critical_error("Bad value for whence",whence);
 180                 break;
 181         }
 182
 183         if(FSEEK(file,offset,whence) == -1)
 184         {
 185                 io_error();
 186
 187                 /* Still here? EINTR */
 188                 critical_error("Don't know what to do; EINTR from fseek()?",0);
 189         }
 190 }
 191
 192 void factor_vm::primitive_fflush()
 193 {
 194         FILE *file = (FILE *)unbox_alien();
 195         for(;;)
 196         {
 197                 if(fflush(file) == EOF)
 198                         io_error();
 199                 else
 200                         break;
 201         }
 202 }
 203
 204 void factor_vm::primitive_fclose()
 205 {
 206         FILE *file = (FILE *)unbox_alien();
 207         for(;;)
 208         {
 209                 if(fclose(file) == EOF)
 210                         io_error();
 211                 else
 212                         break;
 213         }
 214 }
 215
 216 /* This function is used by FFI I/O. Accessing the errno global directly is
 217 not portable, since on some libc's errno is not a global but a funky macro that
 218 reads thread-local storage. */
 219 VM_C_API int err_no()
 220 {
 221         return errno;
 222 }
 223
 224 VM_C_API void clear_err_no()
 225 {
 226         errno = 0;
 227 }
 228 }