vmpp/io.cpp

   1 #include "master.hpp"
   2
   3 /* Simple wrappers for ANSI C I/O functions, used for bootstrapping.
   4
   5 Note the ugly loop logic in almost every function; we have to handle EINTR
   6 and restart the operation if the system call was interrupted. Naive
   7 applications don't do this, but then they quickly fail if one enables
   8 itimer()s or other signals.
   9
  10 The Factor library provides platform-specific code for Unix and Windows
  11 with many more capabilities so these words are not usually used in
  12 normal operation. */
  13
  14 void init_c_io(void)
  15 {
  16         userenv[STDIN_ENV] = allot_alien(F,(CELL)stdin);
  17         userenv[STDOUT_ENV] = allot_alien(F,(CELL)stdout);
  18         userenv[STDERR_ENV] = allot_alien(F,(CELL)stderr);
  19 }
  20
  21 void io_error(void)
  22 {
  23 #ifndef WINCE
  24         if(errno == EINTR)
  25                 return;
  26 #endif
  27
  28         general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
  29 }
  30
  31 void primitive_fopen(void)
  32 {
  33         gc_root<F_BYTE_ARRAY> mode(dpop());
  34         gc_root<F_BYTE_ARRAY> path(dpop());
  35         mode.untag_check();
  36         path.untag_check();
  37
  38         for(;;)
  39         {
  40                 FILE *file = fopen((char *)(path.untagged() + 1),
  41                                    (char *)(mode.untagged() + 1));
  42                 if(file == NULL)
  43                         io_error();
  44                 else
  45                 {
  46                         box_alien(file);
  47                         break;
  48                 }
  49         }
  50 }
  51
  52 void primitive_fgetc(void)
  53 {
  54         FILE *file = (FILE *)unbox_alien();
  55
  56         for(;;)
  57         {
  58                 int c = fgetc(file);
  59                 if(c == EOF)
  60                 {
  61                         if(feof(file))
  62                         {
  63                                 dpush(F);
  64                                 break;
  65                         }
  66                         else
  67                                 io_error();
  68                 }
  69                 else
  70                 {
  71                         dpush(tag_fixnum(c));
  72                         break;
  73                 }
  74         }
  75 }
  76
  77 void primitive_fread(void)
  78 {
  79         FILE *file = (FILE *)unbox_alien();
  80         F_FIXNUM size = unbox_array_size();
  81
  82         if(size == 0)
  83         {
  84                 dpush(tag_object(allot_string(0,0)));
  85                 return;
  86         }
  87
  88         gc_root<F_BYTE_ARRAY> buf(allot_array_internal<F_BYTE_ARRAY>(size));
  89
  90         for(;;)
  91         {
  92                 int c = fread(buf.untagged() + 1,1,size,file);
  93                 if(c <= 0)
  94                 {
  95                         if(feof(file))
  96                         {
  97                                 dpush(F);
  98                                 break;
  99                         }
 100                         else
 101                                 io_error();
 102                 }
 103                 else
 104                 {
 105                         if(c != size)
 106                         {
 107                                 F_BYTE_ARRAY *new_buf = allot_byte_array(c);
 108                                 memcpy(new_buf + 1, buf.untagged() + 1,c);
 109                                 buf = new_buf;
 110                         }
 111                         dpush(buf.value());
 112                         break;
 113                 }
 114         }
 115 }
 116
 117 void primitive_fputc(void)
 118 {
 119         FILE *file = (FILE *)unbox_alien();
 120         F_FIXNUM ch = to_fixnum(dpop());
 121
 122         for(;;)
 123         {
 124                 if(fputc(ch,file) == EOF)
 125                 {
 126                         io_error();
 127
 128                         /* Still here? EINTR */
 129                 }
 130                 else
 131                         break;
 132         }
 133 }
 134
 135 void primitive_fwrite(void)
 136 {
 137         FILE *file = (FILE *)unbox_alien();
 138         F_BYTE_ARRAY *text = untag_byte_array(dpop());
 139         CELL length = array_capacity(text);
 140         char *string = (char *)(text + 1);
 141
 142         if(length == 0)
 143                 return;
 144
 145         for(;;)
 146         {
 147                 size_t written = fwrite(string,1,length,file);
 148                 if(written == length)
 149                         break;
 150                 else
 151                 {
 152                         if(feof(file))
 153                                 break;
 154                         else
 155                                 io_error();
 156
 157                         /* Still here? EINTR */
 158                         length -= written;
 159                         string += written;
 160                 }
 161         }
 162 }
 163
 164 void primitive_fseek(void)
 165 {
 166         int whence = to_fixnum(dpop());
 167         FILE *file = (FILE *)unbox_alien();
 168         off_t offset = to_signed_8(dpop());
 169
 170         switch(whence)
 171         {
 172         case 0: whence = SEEK_SET; break;
 173         case 1: whence = SEEK_CUR; break;
 174         case 2: whence = SEEK_END; break;
 175         default:
 176                 critical_error("Bad value for whence",whence);
 177                 break;
 178         }
 179
 180         if(FSEEK(file,offset,whence) == -1)
 181         {
 182                 io_error();
 183
 184                 /* Still here? EINTR */
 185                 critical_error("Don't know what to do; EINTR from fseek()?",0);
 186         }
 187 }
 188
 189 void primitive_fflush(void)
 190 {
 191         FILE *file = (FILE *)unbox_alien();
 192         for(;;)
 193         {
 194                 if(fflush(file) == EOF)
 195                         io_error();
 196                 else
 197                         break;
 198         }
 199 }
 200
 201 void primitive_fclose(void)
 202 {
 203         FILE *file = (FILE *)unbox_alien();
 204         for(;;)
 205         {
 206                 if(fclose(file) == EOF)
 207                         io_error();
 208                 else
 209                         break;
 210         }
 211 }
 212
 213 /* This function is used by FFI I/O. Accessing the errno global directly is
 214 not portable, since on some libc's errno is not a global but a funky macro that
 215 reads thread-local storage. */
 216 int err_no(void)
 217 {
 218         return errno;
 219 }
 220
 221 void clear_err_no(void)
 222 {
 223         errno = 0;
 224 }