[MLton-commit] r4536
Ville Laurikari
MLton@mlton.org
Sat, 13 May 2006 14:26:12 -0700
Ported to PowerPC/AIX.
Fixed a bug in the runtime for the cases where nonblocking IO with
sockets was implemented using MSG_DONTWAIT. This flag does not exist
on AIX, Cygwin, HPUX, and MinGW and was previously just ignored. Now
the runtime simulates the flag for these platforms (except MinGW, yet,
where it's still ignored).
Some cosmetics.
----------------------------------------------------------------------
U mlton/trunk/basis-library/misc/primitive.sml
U mlton/trunk/basis-library/mlton/platform.sig
U mlton/trunk/basis-library/mlton/platform.sml
U mlton/trunk/basis-library/sml-nj/sml-nj.sml
U mlton/trunk/bin/mlton-script
U mlton/trunk/bin/platform
U mlton/trunk/bin/upgrade-basis
U mlton/trunk/doc/changelog
U mlton/trunk/lib/mlton-stubs/mlton.sml
U mlton/trunk/lib/mlton-stubs/platform.sig
U mlton/trunk/runtime/basis/Net/Socket/Socket.c
A mlton/trunk/runtime/platform/aix.c
A mlton/trunk/runtime/platform/aix.h
U mlton/trunk/runtime/platform/cygwin.c
U mlton/trunk/runtime/platform/cygwin.h
U mlton/trunk/runtime/platform/darwin.h
U mlton/trunk/runtime/platform/freebsd.h
U mlton/trunk/runtime/platform/hpux.c
U mlton/trunk/runtime/platform/hpux.h
U mlton/trunk/runtime/platform/linux.h
U mlton/trunk/runtime/platform/mingw.h
U mlton/trunk/runtime/platform/netbsd.h
U mlton/trunk/runtime/platform/openbsd.h
A mlton/trunk/runtime/platform/recv.nonblock.c
U mlton/trunk/runtime/platform/solaris.h
U mlton/trunk/runtime/platform.h
U mlton/trunk/runtime/types.h
----------------------------------------------------------------------
Modified: mlton/trunk/basis-library/misc/primitive.sml
===================================================================
--- mlton/trunk/basis-library/misc/primitive.sml 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/basis-library/misc/primitive.sml 2006-05-13 21:26:09 UTC (rev 4536)
@@ -964,7 +964,8 @@
structure OS =
struct
datatype t =
- Cygwin
+ AIX
+ | Cygwin
| Darwin
| FreeBSD
| HPUX
@@ -976,7 +977,8 @@
val host: t =
case _const "MLton_Platform_OS_host": string; of
- "cygwin" => Cygwin
+ "aix" => AIX
+ | "cygwin" => Cygwin
| "darwin" => Darwin
| "freebsd" => FreeBSD
| "hpux" => HPUX
Modified: mlton/trunk/basis-library/mlton/platform.sig
===================================================================
--- mlton/trunk/basis-library/mlton/platform.sig 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/basis-library/mlton/platform.sig 2006-05-13 21:26:09 UTC (rev 4536)
@@ -20,7 +20,8 @@
structure OS:
sig
datatype t =
- Cygwin
+ AIX
+ | Cygwin
| Darwin
| FreeBSD
| HPUX
Modified: mlton/trunk/basis-library/mlton/platform.sml
===================================================================
--- mlton/trunk/basis-library/mlton/platform.sml 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/basis-library/mlton/platform.sml 2006-05-13 21:26:09 UTC (rev 4536)
@@ -43,7 +43,8 @@
struct
open OS
- val all = [(Cygwin, "Cygwin"),
+ val all = [(AIX, "AIX"),
+ (Cygwin, "Cygwin"),
(Darwin, "Darwin"),
(FreeBSD, "FreeBSD"),
(HPUX, "HPUX"),
Modified: mlton/trunk/basis-library/sml-nj/sml-nj.sml
===================================================================
--- mlton/trunk/basis-library/sml-nj/sml-nj.sml 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/basis-library/sml-nj/sml-nj.sml 2006-05-13 21:26:09 UTC (rev 4536)
@@ -30,7 +30,8 @@
open MLton.Platform.OS
in
case host of
- Cygwin => UNIX
+ AIX => UNIX
+ | Cygwin => UNIX
| Darwin => MACOS
| FreeBSD => UNIX
| HPUX => UNIX
Modified: mlton/trunk/bin/mlton-script
===================================================================
--- mlton/trunk/bin/mlton-script 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/bin/mlton-script 2006-05-13 21:26:09 UTC (rev 4536)
@@ -96,10 +96,12 @@
-malign-functions=5
-malign-jumps=2
-malign-loops=2' \
+ -target-link-opt aix '-lgmp' \
-target-link-opt amd64 '-m32' \
-target-link-opt cygwin '-lgmp' \
-target-link-opt darwin "$darwinLinkOpts -lgmp" \
-target-link-opt freebsd '-L/usr/local/lib/ -lgmp' \
+ -target-link-opt hpux '-lgmp' \
-target-link-opt linux '-lgmp' \
-target-link-opt mingw \
'-lgmp -lws2_32 -lkernel32 -lpsapi -lnetapi32' \
Modified: mlton/trunk/bin/platform
===================================================================
--- mlton/trunk/bin/platform 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/bin/platform 2006-05-13 21:26:09 UTC (rev 4536)
@@ -24,8 +24,13 @@
esac
uname=`uname`
+arch_flag=-m
case "$uname" in
+AIX)
+ HOST_OS='aix'
+ arch_flag=-p
+;;
CYGWIN*)
HOST_OS='cygwin'
;;
@@ -58,7 +63,7 @@
;;
esac
-arch=`uname -m`
+arch=`uname $arch_flag`
case "$arch" in
alpha*)
@@ -90,6 +95,9 @@
# big-endian and little-endian detect via headers
HOST_ARCH=mips
;;
+powerpc)
+ HOST_ARCH=powerpc
+;;
ppc*)
HOST_ARCH=powerpc
;;
Modified: mlton/trunk/bin/upgrade-basis
===================================================================
--- mlton/trunk/bin/upgrade-basis 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/bin/upgrade-basis 2006-05-13 21:26:09 UTC (rev 4536)
@@ -135,6 +135,9 @@
esac
case "$OS" in
+aix)
+ os='AIX'
+;;
cygwin)
os='Cygwin'
;;
@@ -209,10 +212,11 @@
structure OS =
struct
- datatype t = Cygwin | Darwin | FreeBSD | HPUX | Linux | MinGW
- | NetBSD | OpenBSD | Solaris
+ datatype t = AIX | Cygwin | Darwin | FreeBSD | HPUX | Linux
+ | MinGW | NetBSD | OpenBSD | Solaris
- val all = [(Cygwin, "Cygwin"),
+ val all = [(AIX, "AIX"),
+ (Cygwin, "Cygwin"),
(Darwin, "Darwin"),
(FreeBSD, "FreeBSD"),
(HPUX, "HPUX"),
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/doc/changelog 2006-05-13 21:26:09 UTC (rev 4536)
@@ -1,5 +1,13 @@
Here are the changes since version 20051202.
+* 2006-05-11
+ - Ported to PowerPC-AIX.
+ - Fixed a bug in the runtime for the cases where nonblocking IO with
+ sockets was implemented using MSG_DONTWAIT. This flag does not
+ exist on AIX, Cygwin, HPUX, and MinGW and was previously just
+ ignored. Now the runtime simulates the flag for these platforms
+ (except MinGW, yet, where it's still ignored).
+
* 2006-04-25
- Ported to HPPA-HPUX.
- Fixed PackReal{,32,64}{Big,Little} to follow the Basis Library
Modified: mlton/trunk/lib/mlton-stubs/mlton.sml
===================================================================
--- mlton/trunk/lib/mlton-stubs/mlton.sml 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/lib/mlton-stubs/mlton.sml 2006-05-13 21:26:09 UTC (rev 4536)
@@ -210,7 +210,8 @@
structure OS =
struct
datatype t =
- Cygwin
+ AIX
+ | Cygwin
| Darwin
| FreeBSD
| HPUX
@@ -222,7 +223,8 @@
val host: t = Linux
- val all = [(Cygwin, "Cygwin"),
+ val all = [(AIX, "AIX"),
+ (Cygwin, "Cygwin"),
(Darwin, "Darwin"),
(FreeBSD, "FreeBSD"),
(HPUX, "HPUX"),
Modified: mlton/trunk/lib/mlton-stubs/platform.sig
===================================================================
--- mlton/trunk/lib/mlton-stubs/platform.sig 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/lib/mlton-stubs/platform.sig 2006-05-13 21:26:09 UTC (rev 4536)
@@ -20,7 +20,8 @@
structure OS:
sig
datatype t =
- Cygwin
+ AIX
+ | Cygwin
| Darwin
| FreeBSD
| HPUX
Modified: mlton/trunk/runtime/basis/Net/Socket/Socket.c
===================================================================
--- mlton/trunk/runtime/basis/Net/Socket/Socket.c 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/basis/Net/Socket/Socket.c 2006-05-13 21:26:09 UTC (rev 4536)
@@ -30,13 +30,13 @@
Int Socket_recv (Int s, Char *msg, Int start, Int len, Word flags) {
MLton_initSockets ();
- return recv (s, (void*)((char *)msg + start), (size_t)len, flags);
+ return mlton_recv (s, (void*)((char *)msg + start), (size_t)len, flags);
}
Int Socket_recvFrom (Int s, Char *msg, Int start, Int len, Word flags,
Char* addr, Int *addrlen) {
MLton_initSockets ();
- return recvfrom (s, (void*)((char *)msg + start), (size_t)len, flags,
+ return mlton_recvfrom (s, (void*)((char *)msg + start), (size_t)len, flags,
(struct sockaddr*)addr, (socklen_t*)addrlen);
}
Added: mlton/trunk/runtime/platform/aix.c
===================================================================
--- mlton/trunk/runtime/platform/aix.c 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/aix.c 2006-05-13 21:26:09 UTC (rev 4536)
@@ -0,0 +1,170 @@
+
+/* On AIX 5.1 (and older) there is no fegetround() or fesetround().
+ Instead, float.h defines fp_read_rnd() and fp_swap_rnd() with
+ equivalent functionality. GCC has its own version of float.h, so
+ we include the system header directly before everything else. */
+#include "/usr/include/float.h"
+#include "platform.h"
+
+#include <sys/mman.h>
+#include <sys/procfs.h>
+#include <sys/vminfo.h>
+
+#include "getrusage.c"
+#include "mkdir2.c"
+#include "recv.nonblock.c"
+#include "ssmmap.c"
+#include "use-mmap.c"
+
+int fegetround(void)
+{
+ return fp_read_rnd ();
+}
+
+void fesetround(int mode)
+{
+ fp_swap_rnd (mode);
+}
+
+int fpclassify64(double d)
+{
+ int c;
+ c = class (d);
+ switch (c) {
+ case FP_PLUS_NORM:
+ case FP_MINUS_NORM:
+ return FP_NORMAL;
+ case FP_PLUS_ZERO:
+ case FP_MINUS_ZERO:
+ return FP_ZERO;
+ case FP_PLUS_INF:
+ case FP_MINUS_INF:
+ return FP_INFINITE;
+ case FP_PLUS_DENORM:
+ case FP_MINUS_DENORM:
+ return FP_SUBNORMAL;
+ case FP_SNAN:
+ case FP_QNAN:
+ return FP_NAN;
+ default:
+ die ("Real_class error: invalid class %d\n", c);
+ }
+}
+
+W32 totalRam (GC_state s) {
+ struct vminfo info;
+ int pagesize;
+
+ pagesize = sysconf (_SC_PAGESIZE);
+ if (vmgetinfo (&info, VMINFO, sizeof(info)) < 0)
+ diee ("totalRam error: vmgetinfo failed\n");
+ return info.memsizepgs * pagesize;
+}
+
+
+struct map_type {
+ int flag;
+ char *type;
+};
+
+static struct map_type map_types[] =
+ {{MA_MAINEXEC, "main"},
+ {MA_KERNTEXT, "kern"},
+ {MA_SHARED, "shared"},
+ {MA_STACK, "stack"},
+ {0, NULL}};
+
+
+struct map_segment {
+ prptr64_t start;
+ prptr64_t end;
+ char *name;
+};
+
+static struct map_segment map_segments[] =
+ {{0x00000000, 0x0fffffff, "kernel"},
+ /* Application program text. */
+ {0x10000000, 0x1fffffff, "text"},
+ /* Application program data and the application stack. */
+ {0x20000000, 0x2fffffff, "data"},
+ /* Available for use by shared memory or mmap services. */
+ {0x30000000, 0xafffffff, "mmap"},
+ /* Shared library text. */
+ {0xd0000000, 0xdfffffff, "shtext"},
+ /* Miscellaneous kernel data. */
+ {0xe0000000, 0xefffffff, "kdata"},
+ /* Application shared library data. */
+ {0xf0000000, 0xffffffff, "shdata"},
+ {0, 0, NULL}};
+
+
+static char *
+get_map_type(int flags, prptr64_t addr)
+{
+ struct map_type *m;
+
+ for (m = map_types; m->flag; m++)
+ if (m->flag & flags)
+ return m->type;
+ if ((addr >= 0xd0000000 && addr <= 0xdfffffff)
+ || (addr >= 0xf0000000 && addr <= 0xffffffff))
+ return "shlib";
+ return "";
+}
+
+static char *
+get_map_segment(prptr64_t addr)
+{
+ struct map_segment *m;
+
+ for (m = map_segments; m->name; m++)
+ if (m->start <= addr && m->end >= addr)
+ return m->name;
+ return "";
+}
+
+#define BUFLEN 65536
+
+void showMem(void)
+{
+ pid_t pid = getpid ();
+ char fname[128];
+ int fd = 0;
+ char *buf;
+ struct prmap *map;
+
+ printf ("va_start va_end perm type segment file (member) [object]\n");
+ printf ("--------+--------+---+------+------+----------------------\n");
+
+ snprintf (fname, sizeof (fname), "/proc/%d/map", pid);
+ fd = open (fname, O_RDONLY);
+ if (fd == -1)
+ diee ("showMem error: opening %s failed", fname);
+
+ /* I couldn't figure out a way to get the size of the map file
+ beforehand (only open, read, write, and close work on files under
+ /proc), so let's just hope that 64k will be enough. */
+ buf = malloc (BUFLEN);
+ if (buf == NULL)
+ die ("showMem error: out of memory.");
+
+ read (fd, buf, BUFLEN);
+ map = (struct prmap*)buf;
+
+ for (map = (struct prmap*)buf; map->pr_size; map++) {
+ char *m = buf + map->pr_pathoff;
+ m += strlen (m) + 1;
+ if (!m[0])
+ m = NULL;
+ printf ("%08llx %08llx %s%s%s %-6s %-6s %s %s%s%s[%s]\n",
+ map->pr_vaddr, map->pr_vaddr + map->pr_size,
+ map->pr_mflags & MA_READ ? "r" : "-",
+ map->pr_mflags & MA_WRITE ? "w" : "-",
+ map->pr_mflags & MA_EXEC ? "x" : "-",
+ get_map_type (map->pr_mflags, map->pr_vaddr),
+ get_map_segment (map->pr_vaddr),
+ buf + map->pr_pathoff,
+ m ? "(" : "", m ? m : "", m ? ") " : "",
+ map->pr_mapname);
+ }
+}
Added: mlton/trunk/runtime/platform/aix.h
===================================================================
--- mlton/trunk/runtime/platform/aix.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/aix.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -0,0 +1,52 @@
+#define HAS_FEROUND TRUE
+#define HAS_FPCLASSIFY FALSE
+#define HAS_FPCLASSIFY64 TRUE
+#define HAS_MSG_DONTWAIT FALSE
+#define HAS_PTRACE FALSE
+#define HAS_REMAP FALSE
+#define HAS_SIGALTSTACK TRUE
+#define HAS_SIGNBIT FALSE
+#define HAS_SPAWN FALSE
+#define HAS_TIME_PROFILING FALSE
+
+#define MLton_Platform_OS_host "aix"
+#define __ppc__
+
+#include <grp.h>
+#include <math.h>
+#include <netdb.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <pwd.h>
+#include <sys/ioctl.h>
+#include <sys/poll.h>
+#include <sys/select.h>
+#include <sys/socket.h>
+#include <sys/syslog.h>
+#include <sys/times.h>
+#include <sys/types.h>
+#include <sys/types.h>
+#include <sys/un.h>
+#include <sys/utsname.h>
+#include <termios.h>
+
+
+#include "feround.h"
+
+#define FE_TOWARDZERO 0 // FP_RND_RZ
+#define FE_TONEAREST 1 // FP_RND_RN
+#define FE_UPWARD 2 // FP_RND_RP
+#define FE_DOWNWARD 3 // FP_RND_RM
+
+enum {
+ FP_NAN,
+ FP_INFINITE,
+ FP_ZERO,
+ FP_SUBNORMAL,
+ FP_NORMAL
+};
+
+int fpclassify64(double d);
+
+/* This should not conflict with existing flags. */
+#define MSG_DONTWAIT 0x1000000
Modified: mlton/trunk/runtime/platform/cygwin.c
===================================================================
--- mlton/trunk/runtime/platform/cygwin.c 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/cygwin.c 2006-05-13 21:26:09 UTC (rev 4536)
@@ -5,6 +5,7 @@
#include "getrusage.c"
#include "mkdir2.c"
#include "mmap.c"
+#include "recv.nonblock.c"
#include "totalRam.sysconf.c"
#include "windows.c"
Modified: mlton/trunk/runtime/platform/cygwin.h
===================================================================
--- mlton/trunk/runtime/platform/cygwin.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/cygwin.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -23,8 +23,9 @@
#define MLton_Platform_OS_host "cygwin"
+#define HAS_FEROUND FALSE
#define HAS_FPCLASSIFY TRUE
-#define HAS_FEROUND FALSE
+#define HAS_MSG_DONTWAIT FALSE
#define HAS_PTRACE FALSE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK FALSE
@@ -47,7 +48,8 @@
#define _SC_RE_DUP_MAX _SC_BOGUS
#define _SC_STREAM_MAX _SC_BOGUS
-#define MSG_DONTWAIT 0
+/* This should not conflict with existing flags. */
+#define MSG_DONTWAIT 0x1000000
#define PF_INET6 0
struct sockaddr_in6 {};
Modified: mlton/trunk/runtime/platform/darwin.h
===================================================================
--- mlton/trunk/runtime/platform/darwin.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/darwin.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -25,6 +25,7 @@
#define HAS_FEROUND TRUE
#define HAS_FPCLASSIFY TRUE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE FALSE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK TRUE
Modified: mlton/trunk/runtime/platform/freebsd.h
===================================================================
--- mlton/trunk/runtime/platform/freebsd.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/freebsd.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -25,6 +25,7 @@
#define HAS_FEROUND TRUE
#define HAS_FPCLASSIFY TRUE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE TRUE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK TRUE
Modified: mlton/trunk/runtime/platform/hpux.c
===================================================================
--- mlton/trunk/runtime/platform/hpux.c 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/hpux.c 2006-05-13 21:26:09 UTC (rev 4536)
@@ -1,17 +1,19 @@
#include "platform.h"
+
#include <sys/mman.h>
-#define MAP_ANON MAP_ANONYMOUS
-
+#include <sys/newsig.h>
#include <sys/param.h>
#include <sys/pstat.h>
-#include <sys/newsig.h>
-#include "ssmmap.c"
+#define MAP_ANON MAP_ANONYMOUS
+
#include "getrusage.c"
-#include "use-mmap.c"
#include "mkdir2.c"
+#include "recv.nonblock.c"
#include "setenv.putenv.c"
+#include "ssmmap.c"
+#include "use-mmap.c"
W32 totalRam (GC_state s) {
struct pst_static buf;
Modified: mlton/trunk/runtime/platform/hpux.h
===================================================================
--- mlton/trunk/runtime/platform/hpux.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/hpux.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -22,6 +22,7 @@
#define HAS_FEROUND TRUE
#define HAS_FPCLASSIFY TRUE
+#define HAS_MSG_DONTWAIT FALSE
#define HAS_PTRACE FALSE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK TRUE
@@ -34,7 +35,8 @@
#define LOG_PERROR 0
#define LOG_AUTHPRIV LOG_AUTH
-#define MSG_DONTWAIT 0
+/* This should not conflict with existing flags. */
+#define MSG_DONTWAIT 0x1000000
#ifndef PF_INET6
/* Old versions of HP-UX don't have IPv6 support. */
Modified: mlton/trunk/runtime/platform/linux.h
===================================================================
--- mlton/trunk/runtime/platform/linux.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/linux.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -24,6 +24,7 @@
#define HAS_FEROUND TRUE
#define HAS_FPCLASSIFY TRUE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE TRUE
#define HAS_REMAP TRUE
#define HAS_SIGALTSTACK TRUE
Modified: mlton/trunk/runtime/platform/mingw.h
===================================================================
--- mlton/trunk/runtime/platform/mingw.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/mingw.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -19,6 +19,7 @@
// classifies subnormals as normals. So, we disable it here, which causes the
// runtime to use our own version.
#define HAS_FPCLASSIFY FALSE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE FALSE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK FALSE
@@ -61,8 +62,6 @@
#define F_SETLKW 9
#define FD_CLOEXEC 1
-#define MSG_DONTWAIT 0
-
#define SHUT_RD SD_RECEIVE
#define SHUT_WR SD_SEND
#define SHUT_RDWR SD_BOTH
Modified: mlton/trunk/runtime/platform/netbsd.h
===================================================================
--- mlton/trunk/runtime/platform/netbsd.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/netbsd.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -22,6 +22,7 @@
#define HAS_FEROUND FALSE
#define HAS_FPCLASSIFY TRUE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE FALSE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK TRUE
Modified: mlton/trunk/runtime/platform/openbsd.h
===================================================================
--- mlton/trunk/runtime/platform/openbsd.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/openbsd.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -21,6 +21,7 @@
#define HAS_FEROUND FALSE
#define HAS_FPCLASSIFY FALSE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE FALSE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK TRUE
Added: mlton/trunk/runtime/platform/recv.nonblock.c
===================================================================
--- mlton/trunk/runtime/platform/recv.nonblock.c 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/recv.nonblock.c 2006-05-13 21:26:09 UTC (rev 4536)
@@ -0,0 +1,38 @@
+/* Simulates MSG_DONTWAIT using fcntl() and O_NONBLOCK. */
+
+static void fd_modify(int fd, int flags, int add, int remove)
+{
+ if (flags & MSG_DONTWAIT) {
+ int f = fcntl(fd, F_GETFL);
+ fcntl(fd, F_SETFL, (f | add) & ~remove);
+ }
+}
+
+static void set_nonblock(int fd, int flags)
+{
+ fd_modify(fd, flags, O_NONBLOCK, 0);
+}
+
+static void clear_nonblock(int fd, int flags)
+{
+ fd_modify(fd, flags, 0, O_NONBLOCK);
+}
+
+int mlton_recv(int s, void *buf, int len, int flags)
+{
+ int ret;
+ set_nonblock(s, flags);
+ ret = recv(s, buf, len, flags & ~MSG_DONTWAIT);
+ clear_nonblock(s, flags);
+ return ret;
+}
+
+int mlton_recvfrom(int s, void *buf, int len, int flags, void *from,
+ socklen_t *fromlen)
+{
+ int ret;
+ set_nonblock(s, flags);
+ ret = recvfrom(s, buf, len, flags & ~MSG_DONTWAIT, from, fromlen);
+ clear_nonblock(s, flags);
+ return ret;
+}
Modified: mlton/trunk/runtime/platform/solaris.h
===================================================================
--- mlton/trunk/runtime/platform/solaris.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform/solaris.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -34,6 +34,7 @@
#define HAS_FEROUND TRUE
#define HAS_FPCLASSIFY FALSE
#define HAS_FPCLASSIFY64 TRUE
+#define HAS_MSG_DONTWAIT TRUE
#define HAS_PTRACE TRUE
#define HAS_REMAP FALSE
#define HAS_SIGALTSTACK TRUE
Modified: mlton/trunk/runtime/platform.h
===================================================================
--- mlton/trunk/runtime/platform.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/platform.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -58,7 +58,9 @@
#define __Darwin__
#endif
-#if (defined (__CYGWIN__))
+#if (defined (_AIX))
+#include "platform/aix.h"
+#elif (defined (__CYGWIN__))
#include "platform/cygwin.h"
#elif (defined (__Darwin__))
#include "platform/darwin.h"
@@ -160,6 +162,10 @@
#error HAS_TIME_PROFILING not defined
#endif
+#ifndef HAS_MSG_DONTWAIT
+#error HAS_MSG_DONTWAIT not defined
+#endif
+
#ifndef EXECVP
#define EXECVP execvp
#endif
@@ -201,6 +207,17 @@
#endif
#endif
+#if HAS_MSG_DONTWAIT
+#define mlton_recv recv
+#define mlton_recvfrom recvfrom
+#else
+/* Platform has no MSG_DONTWAIT flag for recv(), so these must be
+ defined to simulate that flag. */
+int mlton_recv(int s, void *buf, int len, int flags);
+int mlton_recvfrom(int s, void *buf, int len, int flags, void *from,
+ socklen_t *fromlen);
+#endif
+
/* If HAS_TIME_PROFILING, then you must define these. */
void *getTextStart ();
void *getTextEnd ();
Modified: mlton/trunk/runtime/types.h
===================================================================
--- mlton/trunk/runtime/types.h 2006-05-13 21:11:02 UTC (rev 4535)
+++ mlton/trunk/runtime/types.h 2006-05-13 21:26:09 UTC (rev 4536)
@@ -16,7 +16,7 @@
#ifndef _ISOC99_SOURCE
#define _ISOC99_SOURCE
#endif
-#if (defined(__hpux__) || defined (__OpenBSD__))
+#if defined(_AIX) || (defined(__hpux__) || defined (__OpenBSD__))
#include <inttypes.h>
#elif (defined (__sun__))
#include <sys/int_types.h>