vm/io.c

   1 #include "master.h"
   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         CELL error = tag_object(from_char_string(strerror(errno)));
  29         general_error(ERROR_IO,error,F,NULL);
  30 }
  31
  32 void primitive_fopen(void)
  33 {
  34         char *mode = unbox_char_string();
  35         REGISTER_C_STRING(mode);
  36         char *path = unbox_char_string();
  37         UNREGISTER_C_STRING(mode);
  38
  39         for(;;)
  40         {
  41                 FILE *file = fopen(path,mode);
  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 = 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 = unbox_alien();
  80         CELL size = unbox_array_size();
  81
  82         if(size == 0)
  83         {
  84                 dpush(tag_object(allot_string(0,0)));
  85                 return;
  86         }
  87
  88         F_BYTE_ARRAY *buf = allot_byte_array(size);
  89
  90         for(;;)
  91         {
  92                 int c = fread(buf + 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                                 REGISTER_UNTAGGED(buf);
 108                                 F_BYTE_ARRAY *new_buf = allot_byte_array(c);
 109                                 UNREGISTER_UNTAGGED(buf);
 110                                 memcpy(new_buf + 1, buf + 1,c);
 111                                 buf = new_buf;
 112                         }
 113                         dpush(tag_object(buf));
 114                         break;
 115                 }
 116         }
 117 }
 118
 119 void primitive_fputc(void)
 120 {
 121         FILE *file = unbox_alien();
 122         F_FIXNUM ch = to_fixnum(dpop());
 123
 124         for(;;)
 125         {
 126                 if(fputc(ch,file) == EOF)
 127                 {
 128                         io_error();
 129
 130                         /* Still here? EINTR */
 131                 }
 132                 else
 133                         break;
 134         }
 135 }
 136
 137 void primitive_fwrite(void)
 138 {
 139         FILE *file = unbox_alien();
 140         F_BYTE_ARRAY *text = untag_byte_array(dpop());
 141         F_FIXNUM length = array_capacity(text);
 142         char *string = (char *)(text + 1);
 143
 144         if(length == 0)
 145                 return;
 146
 147         for(;;)
 148         {
 149                 size_t written = fwrite(string,1,length,file);
 150                 if(written == length)
 151                         break;
 152                 else
 153                 {
 154                         if(feof(file))
 155                                 break;
 156                         else
 157                                 io_error();
 158
 159                         /* Still here? EINTR */
 160                         length -= written;
 161                         string += written;
 162                 }
 163         }
 164 }
 165
 166 void primitive_fflush(void)
 167 {
 168         FILE *file = unbox_alien();
 169         for(;;)
 170         {
 171                 if(fflush(file) == EOF)
 172                         io_error();
 173                 else
 174                         break;
 175         }
 176 }
 177
 178 void primitive_fclose(void)
 179 {
 180         FILE *file = unbox_alien();
 181         for(;;)
 182         {
 183                 if(fclose(file) == EOF)
 184                         io_error();
 185                 else
 186                         break;
 187         }
 188 }
 189
 190 /* This function is used by FFI I/O. Accessing the errno global directly is
 191 not portable, since on some libc's errno is not a global but a funky macro that
 192 reads thread-local storage. */
 193 int err_no(void)
 194 {
 195         return errno;
 196 }
 197
 198 void clear_err_no(void)
 199 {
 200         errno = 0;
 201 }