void primitive_fwrite(void)
{
FILE *file = unbox_alien();
F_BYTE_ARRAY *text = untag_byte_array(dpop());
F_FIXNUM length = array_capacity(text);
char *string = (char *)(text + 1);
if(length == 0)
return;
for(;;)
{
size_t written = fwrite(string,1,length,file);
if(written == length)
break;
else
{
if(feof(file))
break;
else
io_error();
/* Still here? EINTR */
length -= written;
string += written;
}
}
}
void primitive_fclose(void)
{
FILE *file = unbox_alien();
for(;;)
{
if(fclose(file) == EOF)
io_error();
else
break;
}
}
void primitive_fputc(void)
{
FILE *file = unbox_alien();
F_FIXNUM ch = to_fixnum(dpop());
for(;;)
{
if(fputc(ch,file) == EOF)
{
io_error();
/* Still here? EINTR */
}
else
break;
}
}
void primitive_fread(void)
{
FILE* file = unbox_alien();
CELL size = unbox_array_size();
if(size == 0)
{
dpush(tag_object(allot_string(0,0)));
return;
}
F_BYTE_ARRAY *buf = allot_byte_array(size);
for(;;)
{
int c = fread(buf + 1,1,size,file);
if(c <= 0)
{
if(feof(file))
{
dpush(F);
break;
}
else
io_error();
}
else
{
if(c != size)
{
REGISTER_UNTAGGED(buf);
F_BYTE_ARRAY *new_buf = allot_byte_array(c);
UNREGISTER_UNTAGGED(buf);
memcpy(new_buf + 1, buf + 1,c);
buf = new_buf;
}
dpush(tag_object(buf));
break;
}
}
}
void primitive_fgetc(void)
{
FILE* file = unbox_alien();
for(;;)
{
int c = fgetc(file);
if(c == EOF)
{
if(feof(file))
{
dpush(F);
break;
}
else
io_error();
}
else
{
dpush(tag_fixnum(c));
break;
}
}
}
/* pop ( alien n ) from datastack, return alien's address plus n */
INLINE void *alien_pointer(void)
{
F_FIXNUM offset = to_fixnum(dpop());
return unbox_alien() + offset;
}
/* pop ( alien n ) from datastack, return alien's address plus n */
void *factorvm::alien_pointer()
{
fixnum offset = to_fixnum(dpop());
return unbox_alien() + offset;
}
