]> gitweb.factorcode.org Git - factor.git/commitdiff
merged everything except read.c
authorSlava Pestov <slava@factorcode.org>
Sat, 11 Dec 2004 03:47:03 +0000 (03:47 +0000)
committerSlava Pestov <slava@factorcode.org>
Sat, 11 Dec 2004 03:47:03 +0000 (03:47 +0000)
native/read.c [deleted file]
native/signal.c [deleted file]
native/socket.c [deleted file]
native/unix/read.c [new file with mode: 0644]
native/unix/signal.c [new file with mode: 0644]
native/unix/socket.c [new file with mode: 0644]
native/unix/write.c [new file with mode: 0644]
native/win32/write.c [new file with mode: 0644]
native/write.c [deleted file]

diff --git a/native/read.c b/native/read.c
deleted file mode 100644 (file)
index 75a1cd9..0000000
+++ /dev/null
@@ -1,269 +0,0 @@
-#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;
-}
diff --git a/native/signal.c b/native/signal.c
deleted file mode 100644 (file)
index 37db15c..0000000
+++ /dev/null
@@ -1,74 +0,0 @@
-#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__);
-}
diff --git a/native/socket.c b/native/socket.c
deleted file mode 100644 (file)
index 5456091..0000000
+++ /dev/null
@@ -1,146 +0,0 @@
-#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)));
-}
diff --git a/native/unix/read.c b/native/unix/read.c
new file mode 100644 (file)
index 0000000..1f22f94
--- /dev/null
@@ -0,0 +1,269 @@
+#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;
+}
diff --git a/native/unix/signal.c b/native/unix/signal.c
new file mode 100644 (file)
index 0000000..f101c6f
--- /dev/null
@@ -0,0 +1,74 @@
+#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__);
+}
diff --git a/native/unix/socket.c b/native/unix/socket.c
new file mode 100644 (file)
index 0000000..cf0d9e5
--- /dev/null
@@ -0,0 +1,146 @@
+#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)));
+}
diff --git a/native/unix/write.c b/native/unix/write.c
new file mode 100644 (file)
index 0000000..81008c4
--- /dev/null
@@ -0,0 +1,146 @@
+#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;
+       }
+}
diff --git a/native/win32/write.c b/native/win32/write.c
new file mode 100644 (file)
index 0000000..4361e43
--- /dev/null
@@ -0,0 +1,50 @@
+#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;
+       }
+}
diff --git a/native/write.c b/native/write.c
deleted file mode 100644 (file)
index a781756..0000000
+++ /dev/null
@@ -1,146 +0,0 @@
-#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;
-       }
-}