2004-07-23 20:35:13 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
|
2004-07-24 00:54:57 -04:00
|
|
|
void init_io(void)
|
|
|
|
|
{
|
2004-08-15 21:50:44 -04:00
|
|
|
env.user[STDIN_ENV] = tag_object(port(0));
|
|
|
|
|
env.user[STDOUT_ENV] = tag_object(port(1));
|
|
|
|
|
env.user[STDERR_ENV] = tag_object(port(2));
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
bool can_read_line(PORT* port)
|
|
|
|
|
{
|
|
|
|
|
return false;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
void primitive_can_read_line(void)
|
|
|
|
|
{
|
|
|
|
|
PORT* port = untag_port(dpop());
|
|
|
|
|
dpush(tag_boolean(can_read_line(port)));
|
2004-07-24 00:54:57 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-13 02:32:11 -04:00
|
|
|
/* Return true if something was read */
|
|
|
|
|
bool read_step(PORT* port)
|
2004-07-23 20:35:13 -04:00
|
|
|
{
|
2004-08-13 02:32:11 -04:00
|
|
|
FIXNUM amount = read(port->fd,
|
|
|
|
|
port->buffer + 1,
|
|
|
|
|
port->buffer->capacity * 2);
|
2004-08-13 01:38:15 -04:00
|
|
|
|
2004-08-13 02:32:11 -04:00
|
|
|
if(amount == -1)
|
2004-08-13 01:38:15 -04:00
|
|
|
{
|
2004-08-13 02:32:11 -04:00
|
|
|
if(errno != EAGAIN)
|
2004-08-15 21:50:44 -04:00
|
|
|
io_error(port,__FUNCTION__);
|
2004-08-13 02:32:11 -04:00
|
|
|
return false;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
port->buf_fill = (amount < 0 ? 0 : amount);
|
|
|
|
|
port->buf_pos = 0;
|
|
|
|
|
return true;
|
2004-08-13 01:38:15 -04:00
|
|
|
}
|
2004-07-24 15:11:55 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
bool read_line_step(PORT* port)
|
2004-07-23 20:35:13 -04:00
|
|
|
{
|
2004-07-24 00:54:57 -04:00
|
|
|
int i;
|
2004-08-13 02:32:11 -04:00
|
|
|
char ch;
|
2004-07-24 00:54:57 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
SBUF* line = untag_sbuf(port->line);
|
2004-08-12 23:40:28 -04:00
|
|
|
|
|
|
|
|
for(i = port->buf_pos; i < port->buf_fill; i++)
|
2004-07-23 20:35:13 -04:00
|
|
|
{
|
2004-08-12 23:40:28 -04:00
|
|
|
ch = bget((CELL)port->buffer + sizeof(STRING) + i);
|
|
|
|
|
if(ch == '\n')
|
2004-07-23 20:35:13 -04:00
|
|
|
{
|
2004-08-12 23:40:28 -04:00
|
|
|
port->buf_pos = i + 1;
|
2004-08-15 21:50:44 -04:00
|
|
|
return true;
|
2004-08-12 23:40:28 -04:00
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
set_sbuf_nth(line,line->top,ch);
|
|
|
|
|
}
|
2004-07-24 17:37:42 -04:00
|
|
|
|
2004-08-12 23:40:28 -04:00
|
|
|
port->buf_pos = port->buf_fill;
|
2004-07-24 17:37:42 -04:00
|
|
|
|
2004-08-12 23:40:28 -04:00
|
|
|
/* We've reached the end of the above loop, without seeing a newline
|
|
|
|
|
or EOF, so read again */
|
2004-08-15 21:50:44 -04:00
|
|
|
return false;
|
2004-08-12 23:40:28 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
void primitive_read_line_fd_8(void)
|
|
|
|
|
{
|
|
|
|
|
PORT* port = untag_port(dpeek());
|
2004-08-15 21:50:44 -04:00
|
|
|
drepl(port->line);
|
|
|
|
|
port->line = F;
|
2004-08-13 02:32:11 -04:00
|
|
|
|
2004-07-23 20:35:13 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-13 02:19:22 -04:00
|
|
|
/* Return true if write was done */
|
|
|
|
|
bool write_step(PORT* port)
|
2004-08-11 16:56:48 -04:00
|
|
|
{
|
2004-08-12 23:40:28 -04:00
|
|
|
char* chars = (char*)port->buffer + sizeof(STRING);
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-13 02:19:22 -04:00
|
|
|
FIXNUM amount = write(port->fd,chars + port->buf_pos,
|
|
|
|
|
port->buf_fill - port->buf_pos);
|
2004-08-13 01:38:15 -04:00
|
|
|
|
2004-08-13 02:19:22 -04:00
|
|
|
if(amount == -1)
|
2004-08-13 01:38:15 -04:00
|
|
|
{
|
2004-08-13 02:32:11 -04:00
|
|
|
if(errno != EAGAIN)
|
2004-08-15 21:50:44 -04:00
|
|
|
io_error(port,__FUNCTION__);
|
2004-08-13 02:32:11 -04:00
|
|
|
return false;
|
2004-08-13 01:38:15 -04:00
|
|
|
}
|
2004-08-13 02:19:22 -04:00
|
|
|
else
|
|
|
|
|
{
|
|
|
|
|
port->buf_pos += amount;
|
|
|
|
|
return true;
|
|
|
|
|
}
|
2004-08-11 16:56:48 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
bool can_write(PORT* port, FIXNUM len)
|
2004-08-11 16:56:48 -04:00
|
|
|
{
|
2004-08-15 21:50:44 -04:00
|
|
|
CELL buf_capacity;
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
switch(port->buf_mode)
|
2004-08-12 23:40:28 -04:00
|
|
|
{
|
2004-08-15 21:50:44 -04:00
|
|
|
case B_NONE:
|
|
|
|
|
return true;
|
|
|
|
|
case B_READ_LINE:
|
|
|
|
|
return false;
|
|
|
|
|
case B_WRITE:
|
|
|
|
|
buf_capacity = port->buffer->capacity * CHARS;
|
|
|
|
|
/* Is the string longer than the buffer? */
|
|
|
|
|
if(port->buf_fill == 0 && len > buf_capacity)
|
|
|
|
|
{
|
|
|
|
|
/* Increase the buffer to fit the string */
|
|
|
|
|
port->buffer = allot_string(len / CHARS + 1);
|
|
|
|
|
return true;
|
|
|
|
|
}
|
|
|
|
|
else
|
|
|
|
|
return (port->buf_fill + len <= buf_capacity);
|
|
|
|
|
default:
|
|
|
|
|
critical_error("Bad buf_mode",port->buf_mode);
|
|
|
|
|
return false;
|
2004-08-12 23:40:28 -04:00
|
|
|
}
|
2004-08-15 21:50:44 -04:00
|
|
|
}
|
2004-08-12 23:40:28 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
void primitive_can_write(void)
|
|
|
|
|
{
|
|
|
|
|
PORT* port = untag_port(dpop());
|
|
|
|
|
FIXNUM len = to_fixnum(dpop());
|
|
|
|
|
dpush(tag_boolean(can_write(port,len)));
|
2004-08-11 16:56:48 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-12 17:36:36 -04:00
|
|
|
void write_fd_char_8(PORT* port, FIXNUM ch)
|
2004-07-27 21:12:22 -04:00
|
|
|
{
|
2004-08-11 16:56:48 -04:00
|
|
|
char c = (char)ch;
|
2004-07-27 21:12:22 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
if(!can_write(port,1))
|
|
|
|
|
io_error(port,__FUNCTION__);
|
2004-07-27 21:12:22 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
init_buffer(port,B_WRITE);
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-12 17:36:36 -04:00
|
|
|
bput((CELL)port->buffer + sizeof(STRING) + port->buf_fill,c);
|
|
|
|
|
port->buf_fill++;
|
2004-07-27 21:12:22 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-12 17:36:36 -04:00
|
|
|
void write_fd_string_8(PORT* port, STRING* str)
|
2004-07-23 20:35:13 -04:00
|
|
|
{
|
2004-08-15 21:50:44 -04:00
|
|
|
char* c_str;
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
/* Note this ensures the buffer is large enough to fit the string */
|
|
|
|
|
if(!can_write(port,str->capacity))
|
|
|
|
|
io_error(port,__FUNCTION__);
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
init_buffer(port,B_WRITE);
|
2004-08-12 23:40:28 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
c_str = to_c_string(str);
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-12 23:40:28 -04:00
|
|
|
/* Append string to buffer */
|
|
|
|
|
memcpy((void*)((CELL)port->buffer + sizeof(STRING)
|
|
|
|
|
+ port->buf_fill),c_str,str->capacity);
|
2004-08-11 16:56:48 -04:00
|
|
|
|
2004-08-12 23:40:28 -04:00
|
|
|
port->buf_fill += str->capacity;
|
2004-07-27 21:12:22 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
|
|
void primitive_write_fd_8(void)
|
|
|
|
|
{
|
2004-08-12 17:36:36 -04:00
|
|
|
PORT* port = untag_port(dpop());
|
2004-07-27 21:12:22 -04:00
|
|
|
|
|
|
|
|
CELL text = dpop();
|
2004-07-27 22:52:35 -04:00
|
|
|
CELL type = type_of(text);
|
|
|
|
|
|
|
|
|
|
switch(type)
|
|
|
|
|
{
|
|
|
|
|
case FIXNUM_TYPE:
|
2004-07-31 16:11:30 -04:00
|
|
|
case BIGNUM_TYPE:
|
2004-08-12 17:36:36 -04:00
|
|
|
write_fd_char_8(port,to_fixnum(text));
|
2004-07-27 22:52:35 -04:00
|
|
|
break;
|
|
|
|
|
case STRING_TYPE:
|
2004-08-12 17:36:36 -04:00
|
|
|
write_fd_string_8(port,untag_string(text));
|
2004-07-27 22:52:35 -04:00
|
|
|
break;
|
|
|
|
|
default:
|
2004-07-27 21:12:22 -04:00
|
|
|
type_error(STRING_TYPE,text);
|
2004-07-27 22:52:35 -04:00
|
|
|
break;
|
|
|
|
|
}
|
2004-07-23 20:35:13 -04:00
|
|
|
}
|
|
|
|
|
|
2004-08-11 16:56:48 -04:00
|
|
|
void primitive_close_fd(void)
|
2004-07-24 17:37:42 -04:00
|
|
|
{
|
2004-08-15 21:50:44 -04:00
|
|
|
/* This does not flush. */
|
2004-08-12 17:36:36 -04:00
|
|
|
PORT* port = untag_port(dpop());
|
|
|
|
|
close(port->fd);
|
2004-07-23 20:35:13 -04:00
|
|
|
}
|
2004-08-13 01:38:15 -04:00
|
|
|
|
2004-08-15 21:50:44 -04:00
|
|
|
void io_error(PORT* port, const char* func)
|
2004-08-13 01:38:15 -04:00
|
|
|
{
|
2004-08-15 21:50:44 -04:00
|
|
|
STRING* function = from_c_string(func);
|
|
|
|
|
STRING* error = from_c_string(strerror(errno));
|
|
|
|
|
|
|
|
|
|
CONS* c = cons(tag_object(function),tag_cons(
|
|
|
|
|
cons(tag_object(error),F)));
|
|
|
|
|
|
|
|
|
|
general_error(ERROR_IO,tag_cons(c));
|
2004-08-13 01:38:15 -04:00
|
|
|
}
|