+++ /dev/null
-#include "factor.h"
-
-/* Return true if something was read */
-bool read_step(F_PORT* port)
-{
- F_FIXNUM amount = 0;
- F_STRING* buffer = untag_string(port->buffer);
- CELL capacity = buffer->capacity;
-
- if(port->type == PORT_RECV)
- {
- /* try reading OOB data. */
- amount = recv(port->fd,buffer + 1,capacity * CHARS,MSG_OOB);
- }
-
- if(amount <= 0)
- {
- amount = read(port->fd,buffer + 1,capacity * CHARS);
- }
-
- if(amount < 0)
- {
- if(errno != EAGAIN)
- {
- postpone_io_error(port,__FUNCTION__);
- return true;
- }
- else
- return false;
- }
- else
- {
- port->buf_fill = (amount < 0 ? 0 : amount);
- port->buf_pos = 0;
- return true;
- }
-}
-
-bool read_line_step(F_PORT* port)
-{
- int i;
- BYTE ch;
-
- F_SBUF* line = untag_sbuf(port->line);
- F_STRING* buffer = untag_string(port->buffer);
-
- for(i = port->buf_pos; i < port->buf_fill; i++)
- {
- ch = bget((CELL)buffer + sizeof(F_STRING) + i);
-
- if(ch == '\r')
- {
- if(i != port->buf_fill - 1)
- {
- ch = bget((CELL)buffer
- + sizeof(F_STRING) + i + 1);
- if(ch == '\n')
- i++;
- }
-
- port->buf_pos = i + 1;
- port->line_ready = true;
- return true;
- }
-
- if(ch == '\n')
- {
- port->buf_pos = i + 1;
- port->line_ready = true;
- return true;
- }
- else
- set_sbuf_nth(line,line->top,ch);
- }
-
- /* We've reached the end of the above loop, without seeing a newline
- or EOF, so read again */
- port->buf_pos = port->buf_fill;
- port->line_ready = false;
- return false;
-}
-
-bool can_read_line(F_PORT* port)
-{
- pending_io_error(port);
-
- if(port->type != PORT_READ && port->type != PORT_RECV)
- general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
-
- if(port->line_ready)
- return true;
- else
- {
- init_line_buffer(port,LINE_SIZE);
- read_line_step(port);
- return port->line_ready;
- }
-}
-
-void primitive_can_read_line(void)
-{
- F_PORT* port = untag_port(dpop());
- box_boolean(can_read_line(port));
-}
-
-void primitive_add_read_line_io_task(void)
-{
- CELL callback, port;
-
- maybe_garbage_collection();
-
- callback = dpop();
- port = dpop();
- add_io_task(IO_TASK_READ_LINE,port,F,callback,
- read_io_tasks,&read_fd_count);
-
- init_line_buffer(untag_port(port),LINE_SIZE);
-}
-
-bool perform_read_line_io_task(F_PORT* port)
-{
- if(port->buf_pos >= port->buf_fill)
- {
- if(!read_step(port))
- return false;
- }
-
- if(port->buf_fill == 0)
- {
- /* EOF */
- if(port->line != F)
- {
- if(untag_sbuf(port->line)->top == 0)
- port->line = F;
- }
- port->line_ready = true;
- return true;
- }
- else
- return read_line_step(port);
-}
-
-void primitive_read_line_8(void)
-{
- F_PORT* port;
-
- maybe_garbage_collection();
-
- port = untag_port(dpeek());
-
- pending_io_error(port);
-
- if(port->line_ready)
- {
- drepl(port->line);
- port->line = F;
- port->line_ready = false;
- }
- else
- io_error(__FUNCTION__);
-
-}
-
-bool read_count_step(F_PORT* port)
-{
- int i;
- BYTE ch;
-
- F_SBUF* line = untag_sbuf(port->line);
- F_STRING* buffer = untag_string(port->buffer);
-
- for(i = port->buf_pos; i < port->buf_fill; i++)
- {
- ch = bget((CELL)buffer + sizeof(F_STRING) + i);
- set_sbuf_nth(line,line->top,ch);
- if(line->top == port->count)
- {
- port->buf_pos = i + 1;
- return true;
- }
- }
-
- /* We've reached the end of the above loop, without seeing enough chars
- or EOF, so read again */
- port->buf_pos = port->buf_fill;
- return false;
-}
-
-bool can_read_count(F_PORT* port, F_FIXNUM count)
-{
- pending_io_error(port);
-
- if(port->type != PORT_READ && port->type != PORT_RECV)
- general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
-
- if(port->line != F && CAN_READ_COUNT(port,count))
- return true;
- else
- {
- port->count = count;
- init_line_buffer(port,count);
- read_count_step(port);
- return CAN_READ_COUNT(port,count);
- }
-}
-
-void primitive_can_read_count(void)
-{
- F_PORT* port;
- F_FIXNUM len;
-
- maybe_garbage_collection();
-
- port = untag_port(dpop());
- len = to_fixnum(dpop());
- box_boolean(can_read_count(port,len));
-}
-
-void primitive_add_read_count_io_task(void)
-{
- CELL callback;
- F_PORT* port;
- F_FIXNUM count;
-
- maybe_garbage_collection();
-
- callback = dpop();
- port = untag_port(dpop());
- count = to_fixnum(dpop());
- add_io_task(IO_TASK_READ_COUNT,
- tag_object(port),F,callback,
- read_io_tasks,&read_fd_count);
-
- port->count = count;
- init_line_buffer(port,count);
-}
-
-bool perform_read_count_io_task(F_PORT* port)
-{
- if(port->buf_pos >= port->buf_fill)
- {
- if(!read_step(port))
- return false;
- }
-
- if(port->buf_fill == 0)
- return true;
- else
- return read_count_step(port);
-}
-
-void primitive_read_count_8(void)
-{
- F_PORT* port;
- F_FIXNUM len;
-
- maybe_garbage_collection();
-
- port = untag_port(dpop());
- len = to_fixnum(dpop());
- if(port->count != len)
- critical_error("read# counts don't match",tag_object(port));
-
- pending_io_error(port);
-
- dpush(port->line);
- port->line = F;
- port->line_ready = false;
-}
+++ /dev/null
-#include "factor.h"
-
-void signal_handler(int signal, siginfo_t* siginfo, void* uap)
-{
- if(active.here > active.limit)
- {
- fprintf(stderr,"Out of memory\n");
- fprintf(stderr,"active.base = %ld\n",active.base);
- fprintf(stderr,"active.here = %ld\n",active.here);
- fprintf(stderr,"active.limit = %ld\n",active.limit);
- fflush(stderr);
- exit(1);
- }
- else
- signal_error(signal);
-}
-
-/* Called from a signal handler. XXX - is this safe? */
-void call_profiling_step(int signal, siginfo_t* siginfo, void* uap)
-{
- CELL depth = (cs - cs_bot) / CELLS;
- int i;
- CELL obj;
- for(i = profile_depth; i < depth; i++)
- {
- obj = get(cs_bot + i * CELLS);
- if(TAG(obj) == WORD_TYPE)
- untag_word(obj)->call_count++;
- }
-
- executing->call_count++;
-}
-
-void init_signals(void)
-{
- struct sigaction custom_sigaction;
- struct sigaction profiling_sigaction;
- struct sigaction ign_sigaction;
- custom_sigaction.sa_sigaction = signal_handler;
- custom_sigaction.sa_flags = SA_SIGINFO;
- profiling_sigaction.sa_sigaction = call_profiling_step;
- profiling_sigaction.sa_flags = SA_SIGINFO;
- ign_sigaction.sa_handler = SIG_IGN;
- sigaction(SIGABRT,&custom_sigaction,NULL);
- sigaction(SIGFPE,&custom_sigaction,NULL);
- sigaction(SIGBUS,&custom_sigaction,NULL);
- sigaction(SIGSEGV,&custom_sigaction,NULL);
- sigaction(SIGPIPE,&ign_sigaction,NULL);
- sigaction(SIGPROF,&profiling_sigaction,NULL);
-}
-
-void primitive_call_profiling(void)
-{
- CELL d = dpop();
- if(d == F)
- {
- timerclear(&prof_timer.it_interval);
- timerclear(&prof_timer.it_value);
-
- profile_depth = 0;
- }
- else
- {
- prof_timer.it_interval.tv_sec = 0;
- prof_timer.it_interval.tv_usec = 1000;
- prof_timer.it_value.tv_sec = 0;
- prof_timer.it_value.tv_usec = 1000;
-
- profile_depth = to_fixnum(d);
- }
-
- if(setitimer(ITIMER_PROF,&prof_timer,NULL) < 0)
- io_error(__FUNCTION__);
-}
+++ /dev/null
-#include "factor.h"
-
-void init_sockaddr(struct sockaddr_in* name,
- const char* hostname, uint16_t port)
-{
- struct hostent *hostinfo;
-
- name->sin_family = AF_INET;
- name->sin_port = htons(port);
- hostinfo = gethostbyname(hostname);
-
- if(hostinfo == NULL)
- io_error(__FUNCTION__);
-
- name->sin_addr = *((struct in_addr *)hostinfo->h_addr);
-}
-
-int make_client_socket(const char* hostname, uint16_t port)
-{
- int sock;
- struct sockaddr_in servername;
-
- /* Create the socket. */
- sock = socket(PF_INET,SOCK_STREAM,0);
- if(sock < 0)
- io_error(__FUNCTION__);
-
- if(fcntl(sock,F_SETFL,O_NONBLOCK,1) == -1)
- io_error(__FUNCTION__);
-
- /* Connect to the server. */
- init_sockaddr(&servername,hostname,port);
- if(connect(sock,(struct sockaddr *)&servername,sizeof(servername)) < 0)
- {
- if(errno != EINPROGRESS)
- {
- close(sock);
- io_error(__FUNCTION__);
- }
- }
-
- return sock;
-}
-
-void primitive_client_socket(void)
-{
- uint16_t p = (uint16_t)to_fixnum(dpop());
- char* host;
- int sock;
-
- maybe_garbage_collection();
-
- host = unbox_c_string();
- sock = make_client_socket(host,p);
-
- dpush(tag_object(port(PORT_RECV,sock)));
- dpush(tag_object(port(PORT_WRITE,sock)));
-}
-
-int make_server_socket(uint16_t port)
-{
- int sock;
- struct sockaddr_in name;
-
- int reuseaddr = 1;
-
- /* Create the socket */
- sock = socket(PF_INET, SOCK_STREAM, 0);
-
- if(sock < 0)
- io_error(__FUNCTION__);
-
- /* Reuse port number */
- if(setsockopt(sock,SOL_SOCKET,SO_REUSEADDR,&reuseaddr,sizeof(int)) < 0)
- io_error(__FUNCTION__);
-
- /* Give the socket a name */
- name.sin_family = AF_INET;
- name.sin_port = htons(port);
- name.sin_addr.s_addr = htonl(INADDR_ANY);
- if(bind(sock,(struct sockaddr *)&name, sizeof(name)) < 0)
- {
- close(sock);
- io_error(__FUNCTION__);
- }
-
- /* Start listening for connections */
- if(listen(sock,1) < 0)
- {
- close(sock);
- io_error(__FUNCTION__);
- }
-
- return sock;
-}
-
-void primitive_server_socket(void)
-{
- uint16_t p = (uint16_t)to_fixnum(dpop());
- maybe_garbage_collection();
- dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p))));
-}
-
-void primitive_add_accept_io_task(void)
-{
- CELL callback, port;
- maybe_garbage_collection();
- callback = dpop();
- port = dpop();
- add_io_task(IO_TASK_ACCEPT,port,F,callback,
- read_io_tasks,&read_fd_count);
-}
-
-CELL accept_connection(F_PORT* p)
-{
- struct sockaddr_in clientname;
- size_t size = sizeof(clientname);
-
- int new = accept(p->fd,(struct sockaddr *)&clientname,&size);
- if(new < 0)
- {
- if(errno == EAGAIN)
- return false;
- else
- io_error(__FUNCTION__);
- }
-
- p->client_host = tag_object(from_c_string(inet_ntoa(
- clientname.sin_addr)));
- p->client_port = tag_fixnum(ntohs(clientname.sin_port));
- p->client_socket = new;
-
- return true;
-}
-
-void primitive_accept_fd(void)
-{
- F_PORT* p;
- maybe_garbage_collection();
- p = untag_port(dpop());
- pending_io_error(p);
- dpush(p->client_host);
- dpush(p->client_port);
- dpush(tag_object(port(PORT_RECV,p->client_socket)));
- dpush(tag_object(port(PORT_WRITE,p->client_socket)));
-}
--- /dev/null
+#include "../factor.h"
+
+/* Return true if something was read */
+bool read_step(F_PORT* port)
+{
+ F_FIXNUM amount = 0;
+ F_STRING* buffer = untag_string(port->buffer);
+ CELL capacity = buffer->capacity;
+
+ if(port->type == PORT_RECV)
+ {
+ /* try reading OOB data. */
+ amount = recv(port->fd,buffer + 1,capacity * CHARS,MSG_OOB);
+ }
+
+ if(amount <= 0)
+ {
+ amount = read(port->fd,buffer + 1,capacity * CHARS);
+ }
+
+ if(amount < 0)
+ {
+ if(errno != EAGAIN)
+ {
+ postpone_io_error(port,__FUNCTION__);
+ return true;
+ }
+ else
+ return false;
+ }
+ else
+ {
+ port->buf_fill = (amount < 0 ? 0 : amount);
+ port->buf_pos = 0;
+ return true;
+ }
+}
+
+bool read_line_step(F_PORT* port)
+{
+ int i;
+ BYTE ch;
+
+ F_SBUF* line = untag_sbuf(port->line);
+ F_STRING* buffer = untag_string(port->buffer);
+
+ for(i = port->buf_pos; i < port->buf_fill; i++)
+ {
+ ch = bget((CELL)buffer + sizeof(F_STRING) + i);
+
+ if(ch == '\r')
+ {
+ if(i != port->buf_fill - 1)
+ {
+ ch = bget((CELL)buffer
+ + sizeof(F_STRING) + i + 1);
+ if(ch == '\n')
+ i++;
+ }
+
+ port->buf_pos = i + 1;
+ port->line_ready = true;
+ return true;
+ }
+
+ if(ch == '\n')
+ {
+ port->buf_pos = i + 1;
+ port->line_ready = true;
+ return true;
+ }
+ else
+ set_sbuf_nth(line,line->top,ch);
+ }
+
+ /* We've reached the end of the above loop, without seeing a newline
+ or EOF, so read again */
+ port->buf_pos = port->buf_fill;
+ port->line_ready = false;
+ return false;
+}
+
+bool can_read_line(F_PORT* port)
+{
+ pending_io_error(port);
+
+ if(port->type != PORT_READ && port->type != PORT_RECV)
+ general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
+
+ if(port->line_ready)
+ return true;
+ else
+ {
+ init_line_buffer(port,LINE_SIZE);
+ read_line_step(port);
+ return port->line_ready;
+ }
+}
+
+void primitive_can_read_line(void)
+{
+ F_PORT* port = untag_port(dpop());
+ box_boolean(can_read_line(port));
+}
+
+void primitive_add_read_line_io_task(void)
+{
+ CELL callback, port;
+
+ maybe_garbage_collection();
+
+ callback = dpop();
+ port = dpop();
+ add_io_task(IO_TASK_READ_LINE,port,F,callback,
+ read_io_tasks,&read_fd_count);
+
+ init_line_buffer(untag_port(port),LINE_SIZE);
+}
+
+bool perform_read_line_io_task(F_PORT* port)
+{
+ if(port->buf_pos >= port->buf_fill)
+ {
+ if(!read_step(port))
+ return false;
+ }
+
+ if(port->buf_fill == 0)
+ {
+ /* EOF */
+ if(port->line != F)
+ {
+ if(untag_sbuf(port->line)->top == 0)
+ port->line = F;
+ }
+ port->line_ready = true;
+ return true;
+ }
+ else
+ return read_line_step(port);
+}
+
+void primitive_read_line_8(void)
+{
+ F_PORT* port;
+
+ maybe_garbage_collection();
+
+ port = untag_port(dpeek());
+
+ pending_io_error(port);
+
+ if(port->line_ready)
+ {
+ drepl(port->line);
+ port->line = F;
+ port->line_ready = false;
+ }
+ else
+ io_error(__FUNCTION__);
+
+}
+
+bool read_count_step(F_PORT* port)
+{
+ int i;
+ BYTE ch;
+
+ F_SBUF* line = untag_sbuf(port->line);
+ F_STRING* buffer = untag_string(port->buffer);
+
+ for(i = port->buf_pos; i < port->buf_fill; i++)
+ {
+ ch = bget((CELL)buffer + sizeof(F_STRING) + i);
+ set_sbuf_nth(line,line->top,ch);
+ if(line->top == port->count)
+ {
+ port->buf_pos = i + 1;
+ return true;
+ }
+ }
+
+ /* We've reached the end of the above loop, without seeing enough chars
+ or EOF, so read again */
+ port->buf_pos = port->buf_fill;
+ return false;
+}
+
+bool can_read_count(F_PORT* port, F_FIXNUM count)
+{
+ pending_io_error(port);
+
+ if(port->type != PORT_READ && port->type != PORT_RECV)
+ general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
+
+ if(port->line != F && CAN_READ_COUNT(port,count))
+ return true;
+ else
+ {
+ port->count = count;
+ init_line_buffer(port,count);
+ read_count_step(port);
+ return CAN_READ_COUNT(port,count);
+ }
+}
+
+void primitive_can_read_count(void)
+{
+ F_PORT* port;
+ F_FIXNUM len;
+
+ maybe_garbage_collection();
+
+ port = untag_port(dpop());
+ len = to_fixnum(dpop());
+ box_boolean(can_read_count(port,len));
+}
+
+void primitive_add_read_count_io_task(void)
+{
+ CELL callback;
+ F_PORT* port;
+ F_FIXNUM count;
+
+ maybe_garbage_collection();
+
+ callback = dpop();
+ port = untag_port(dpop());
+ count = to_fixnum(dpop());
+ add_io_task(IO_TASK_READ_COUNT,
+ tag_object(port),F,callback,
+ read_io_tasks,&read_fd_count);
+
+ port->count = count;
+ init_line_buffer(port,count);
+}
+
+bool perform_read_count_io_task(F_PORT* port)
+{
+ if(port->buf_pos >= port->buf_fill)
+ {
+ if(!read_step(port))
+ return false;
+ }
+
+ if(port->buf_fill == 0)
+ return true;
+ else
+ return read_count_step(port);
+}
+
+void primitive_read_count_8(void)
+{
+ F_PORT* port;
+ F_FIXNUM len;
+
+ maybe_garbage_collection();
+
+ port = untag_port(dpop());
+ len = to_fixnum(dpop());
+ if(port->count != len)
+ critical_error("read# counts don't match",tag_object(port));
+
+ pending_io_error(port);
+
+ dpush(port->line);
+ port->line = F;
+ port->line_ready = false;
+}
--- /dev/null
+#include "../factor.h"
+
+void signal_handler(int signal, siginfo_t* siginfo, void* uap)
+{
+ if(active.here > active.limit)
+ {
+ fprintf(stderr,"Out of memory\n");
+ fprintf(stderr,"active.base = %ld\n",active.base);
+ fprintf(stderr,"active.here = %ld\n",active.here);
+ fprintf(stderr,"active.limit = %ld\n",active.limit);
+ fflush(stderr);
+ exit(1);
+ }
+ else
+ signal_error(signal);
+}
+
+/* Called from a signal handler. XXX - is this safe? */
+void call_profiling_step(int signal, siginfo_t* siginfo, void* uap)
+{
+ CELL depth = (cs - cs_bot) / CELLS;
+ int i;
+ CELL obj;
+ for(i = profile_depth; i < depth; i++)
+ {
+ obj = get(cs_bot + i * CELLS);
+ if(TAG(obj) == WORD_TYPE)
+ untag_word(obj)->call_count++;
+ }
+
+ executing->call_count++;
+}
+
+void init_signals(void)
+{
+ struct sigaction custom_sigaction;
+ struct sigaction profiling_sigaction;
+ struct sigaction ign_sigaction;
+ custom_sigaction.sa_sigaction = signal_handler;
+ custom_sigaction.sa_flags = SA_SIGINFO;
+ profiling_sigaction.sa_sigaction = call_profiling_step;
+ profiling_sigaction.sa_flags = SA_SIGINFO;
+ ign_sigaction.sa_handler = SIG_IGN;
+ sigaction(SIGABRT,&custom_sigaction,NULL);
+ sigaction(SIGFPE,&custom_sigaction,NULL);
+ sigaction(SIGBUS,&custom_sigaction,NULL);
+ sigaction(SIGSEGV,&custom_sigaction,NULL);
+ sigaction(SIGPIPE,&ign_sigaction,NULL);
+ sigaction(SIGPROF,&profiling_sigaction,NULL);
+}
+
+void primitive_call_profiling(void)
+{
+ CELL d = dpop();
+ if(d == F)
+ {
+ timerclear(&prof_timer.it_interval);
+ timerclear(&prof_timer.it_value);
+
+ profile_depth = 0;
+ }
+ else
+ {
+ prof_timer.it_interval.tv_sec = 0;
+ prof_timer.it_interval.tv_usec = 1000;
+ prof_timer.it_value.tv_sec = 0;
+ prof_timer.it_value.tv_usec = 1000;
+
+ profile_depth = to_fixnum(d);
+ }
+
+ if(setitimer(ITIMER_PROF,&prof_timer,NULL) < 0)
+ io_error(__FUNCTION__);
+}
--- /dev/null
+#include "../factor.h"
+
+void init_sockaddr(struct sockaddr_in* name,
+ const char* hostname, uint16_t port)
+{
+ struct hostent *hostinfo;
+
+ name->sin_family = AF_INET;
+ name->sin_port = htons(port);
+ hostinfo = gethostbyname(hostname);
+
+ if(hostinfo == NULL)
+ io_error(__FUNCTION__);
+
+ name->sin_addr = *((struct in_addr *)hostinfo->h_addr);
+}
+
+int make_client_socket(const char* hostname, uint16_t port)
+{
+ int sock;
+ struct sockaddr_in servername;
+
+ /* Create the socket. */
+ sock = socket(PF_INET,SOCK_STREAM,0);
+ if(sock < 0)
+ io_error(__FUNCTION__);
+
+ if(fcntl(sock,F_SETFL,O_NONBLOCK,1) == -1)
+ io_error(__FUNCTION__);
+
+ /* Connect to the server. */
+ init_sockaddr(&servername,hostname,port);
+ if(connect(sock,(struct sockaddr *)&servername,sizeof(servername)) < 0)
+ {
+ if(errno != EINPROGRESS)
+ {
+ close(sock);
+ io_error(__FUNCTION__);
+ }
+ }
+
+ return sock;
+}
+
+void primitive_client_socket(void)
+{
+ uint16_t p = (uint16_t)to_fixnum(dpop());
+ char* host;
+ int sock;
+
+ maybe_garbage_collection();
+
+ host = unbox_c_string();
+ sock = make_client_socket(host,p);
+
+ dpush(tag_object(port(PORT_RECV,sock)));
+ dpush(tag_object(port(PORT_WRITE,sock)));
+}
+
+int make_server_socket(uint16_t port)
+{
+ int sock;
+ struct sockaddr_in name;
+
+ int reuseaddr = 1;
+
+ /* Create the socket */
+ sock = socket(PF_INET, SOCK_STREAM, 0);
+
+ if(sock < 0)
+ io_error(__FUNCTION__);
+
+ /* Reuse port number */
+ if(setsockopt(sock,SOL_SOCKET,SO_REUSEADDR,&reuseaddr,sizeof(int)) < 0)
+ io_error(__FUNCTION__);
+
+ /* Give the socket a name */
+ name.sin_family = AF_INET;
+ name.sin_port = htons(port);
+ name.sin_addr.s_addr = htonl(INADDR_ANY);
+ if(bind(sock,(struct sockaddr *)&name, sizeof(name)) < 0)
+ {
+ close(sock);
+ io_error(__FUNCTION__);
+ }
+
+ /* Start listening for connections */
+ if(listen(sock,1) < 0)
+ {
+ close(sock);
+ io_error(__FUNCTION__);
+ }
+
+ return sock;
+}
+
+void primitive_server_socket(void)
+{
+ uint16_t p = (uint16_t)to_fixnum(dpop());
+ maybe_garbage_collection();
+ dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p))));
+}
+
+void primitive_add_accept_io_task(void)
+{
+ CELL callback, port;
+ maybe_garbage_collection();
+ callback = dpop();
+ port = dpop();
+ add_io_task(IO_TASK_ACCEPT,port,F,callback,
+ read_io_tasks,&read_fd_count);
+}
+
+CELL accept_connection(F_PORT* p)
+{
+ struct sockaddr_in clientname;
+ size_t size = sizeof(clientname);
+
+ int new = accept(p->fd,(struct sockaddr *)&clientname,&size);
+ if(new < 0)
+ {
+ if(errno == EAGAIN)
+ return false;
+ else
+ io_error(__FUNCTION__);
+ }
+
+ p->client_host = tag_object(from_c_string(inet_ntoa(
+ clientname.sin_addr)));
+ p->client_port = tag_fixnum(ntohs(clientname.sin_port));
+ p->client_socket = new;
+
+ return true;
+}
+
+void primitive_accept_fd(void)
+{
+ F_PORT* p;
+ maybe_garbage_collection();
+ p = untag_port(dpop());
+ pending_io_error(p);
+ dpush(p->client_host);
+ dpush(p->client_port);
+ dpush(tag_object(port(PORT_RECV,p->client_socket)));
+ dpush(tag_object(port(PORT_WRITE,p->client_socket)));
+}
--- /dev/null
+#include "../factor.h"
+
+/* Return true if write was done */
+void write_step(F_PORT* port)
+{
+ BYTE* chars = (BYTE*)untag_string(port->buffer) + sizeof(F_STRING);
+
+ F_FIXNUM amount = write(port->fd,chars + port->buf_pos,
+ port->buf_fill - port->buf_pos);
+
+ if(amount == -1)
+ {
+ if(errno != EAGAIN)
+ postpone_io_error(port,__FUNCTION__);
+ }
+ else
+ port->buf_pos += amount;
+}
+
+bool can_write(F_PORT* port, F_FIXNUM len)
+{
+ CELL buf_capacity;
+
+ if(port->type != PORT_WRITE)
+ general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
+
+ buf_capacity = untag_string(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 = tag_object(allot_string(len / CHARS + 1));
+ return true;
+ }
+ else
+ return (port->buf_fill + len <= buf_capacity);
+}
+
+void primitive_can_write(void)
+{
+ F_PORT* port;
+ F_FIXNUM len;
+
+ maybe_garbage_collection();
+
+ port = untag_port(dpop());
+ len = to_fixnum(dpop());
+ pending_io_error(port);
+ box_boolean(can_write(port,len));
+}
+
+void primitive_add_write_io_task(void)
+{
+ CELL callback, port;
+
+ maybe_garbage_collection();
+
+ callback = dpop();
+ port = dpop();
+ add_io_task(IO_TASK_WRITE,port,F,callback,
+ write_io_tasks,&write_fd_count);
+}
+
+bool perform_write_io_task(F_PORT* port)
+{
+ if(port->buf_pos == port->buf_fill || port->io_error != F)
+ {
+ /* Nothing to write */
+ port->buf_pos = 0;
+ port->buf_fill = 0;
+ return true;
+ }
+ else
+ {
+ write_step(port);
+ return false;
+ }
+}
+
+void write_char_8(F_PORT* port, F_FIXNUM ch)
+{
+ BYTE c = (BYTE)ch;
+
+ pending_io_error(port);
+
+ if(!can_write(port,1))
+ io_error(__FUNCTION__);
+
+ bput((CELL)untag_string(port->buffer) + sizeof(F_STRING) + port->buf_fill,c);
+ port->buf_fill++;
+}
+
+/* Caller must ensure buffer is of the right size. */
+void write_string_raw(F_PORT* port, BYTE* str, CELL len)
+{
+ /* Append string to buffer */
+ memcpy((void*)((CELL)untag_string(port->buffer) + sizeof(F_STRING)
+ + port->buf_fill),str,len);
+
+ port->buf_fill += len;
+}
+
+void write_string_8(F_PORT* port, F_STRING* str)
+{
+ BYTE* c_str;
+
+ pending_io_error(port);
+
+ /* Note this ensures the buffer is large enough to fit the string */
+ if(!can_write(port,str->capacity))
+ io_error(__FUNCTION__);
+
+ c_str = to_c_string_unchecked(str);
+ write_string_raw(port,c_str,str->capacity);
+}
+
+void primitive_write_8(void)
+{
+ F_PORT* port;
+ CELL text, type;
+ F_STRING* str;
+
+ maybe_garbage_collection();
+
+ port = untag_port(dpop());
+
+ text = dpop();
+ type = type_of(text);
+
+ pending_io_error(port);
+
+ switch(type)
+ {
+ case FIXNUM_TYPE:
+ case BIGNUM_TYPE:
+ write_char_8(port,to_fixnum(text));
+ break;
+ case STRING_TYPE:
+ str = untag_string(text);
+ write_string_8(port,str);
+ break;
+ default:
+ type_error(TEXT_TYPE,text);
+ break;
+ }
+}
--- /dev/null
+#include "../factor.h"
+
+void primitive_add_write_io_task (void)
+{
+ callback_list = cons(dpop(), callback_list);
+ dpop();
+}
+
+void primitive_can_write (void)
+{
+ dpop(); dpop();
+ box_boolean(true);
+}
+
+void write_char_8 (PORT *port, FIXNUM ch)
+{
+ char buf = (char)ch;
+ WriteFile((HANDLE)port->fd, &buf, 1, NULL, NULL);
+}
+
+void write_string_8 (PORT *port, STRING *str)
+{
+ WriteFile((HANDLE)port->fd, to_c_string(str), str->capacity, NULL, NULL);
+}
+
+void primitive_write_8 (void)
+{
+ PORT *port;
+ CELL text, type;
+
+ maybe_garbage_collection();
+
+ port = untag_port(dpop());
+ text = dpop();
+ type = type_of(text);
+
+ switch (type)
+ {
+ case FIXNUM_TYPE:
+ case BIGNUM_TYPE:
+ write_char_8(port, to_fixnum(text));
+ break;
+ case STRING_TYPE:
+ write_string_8(port, untag_string(text));
+ break;
+ default:
+ type_error(TEXT_TYPE, text);
+ break;
+ }
+}
+++ /dev/null
-#include "factor.h"
-
-/* Return true if write was done */
-void write_step(F_PORT* port)
-{
- BYTE* chars = (BYTE*)untag_string(port->buffer) + sizeof(F_STRING);
-
- F_FIXNUM amount = write(port->fd,chars + port->buf_pos,
- port->buf_fill - port->buf_pos);
-
- if(amount == -1)
- {
- if(errno != EAGAIN)
- postpone_io_error(port,__FUNCTION__);
- }
- else
- port->buf_pos += amount;
-}
-
-bool can_write(F_PORT* port, F_FIXNUM len)
-{
- CELL buf_capacity;
-
- if(port->type != PORT_WRITE)
- general_error(ERROR_INCOMPATIBLE_PORT,tag_object(port));
-
- buf_capacity = untag_string(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 = tag_object(allot_string(len / CHARS + 1));
- return true;
- }
- else
- return (port->buf_fill + len <= buf_capacity);
-}
-
-void primitive_can_write(void)
-{
- F_PORT* port;
- F_FIXNUM len;
-
- maybe_garbage_collection();
-
- port = untag_port(dpop());
- len = to_fixnum(dpop());
- pending_io_error(port);
- box_boolean(can_write(port,len));
-}
-
-void primitive_add_write_io_task(void)
-{
- CELL callback, port;
-
- maybe_garbage_collection();
-
- callback = dpop();
- port = dpop();
- add_io_task(IO_TASK_WRITE,port,F,callback,
- write_io_tasks,&write_fd_count);
-}
-
-bool perform_write_io_task(F_PORT* port)
-{
- if(port->buf_pos == port->buf_fill || port->io_error != F)
- {
- /* Nothing to write */
- port->buf_pos = 0;
- port->buf_fill = 0;
- return true;
- }
- else
- {
- write_step(port);
- return false;
- }
-}
-
-void write_char_8(F_PORT* port, F_FIXNUM ch)
-{
- BYTE c = (BYTE)ch;
-
- pending_io_error(port);
-
- if(!can_write(port,1))
- io_error(__FUNCTION__);
-
- bput((CELL)untag_string(port->buffer) + sizeof(F_STRING) + port->buf_fill,c);
- port->buf_fill++;
-}
-
-/* Caller must ensure buffer is of the right size. */
-void write_string_raw(F_PORT* port, BYTE* str, CELL len)
-{
- /* Append string to buffer */
- memcpy((void*)((CELL)untag_string(port->buffer) + sizeof(F_STRING)
- + port->buf_fill),str,len);
-
- port->buf_fill += len;
-}
-
-void write_string_8(F_PORT* port, F_STRING* str)
-{
- BYTE* c_str;
-
- pending_io_error(port);
-
- /* Note this ensures the buffer is large enough to fit the string */
- if(!can_write(port,str->capacity))
- io_error(__FUNCTION__);
-
- c_str = to_c_string_unchecked(str);
- write_string_raw(port,c_str,str->capacity);
-}
-
-void primitive_write_8(void)
-{
- F_PORT* port;
- CELL text, type;
- F_STRING* str;
-
- maybe_garbage_collection();
-
- port = untag_port(dpop());
-
- text = dpop();
- type = type_of(text);
-
- pending_io_error(port);
-
- switch(type)
- {
- case FIXNUM_TYPE:
- case BIGNUM_TYPE:
- write_char_8(port,to_fixnum(text));
- break;
- case STRING_TYPE:
- str = untag_string(text);
- write_string_8(port,str);
- break;
- default:
- type_error(TEXT_TYPE,text);
- break;
- }
-}