[m-dev.] for review: add the POSIX stuff to the extras
Fergus Henderson
fjh at cs.mu.OZ.AU
Sat Oct 16 05:26:23 AEST 1999
On 12-Oct-1999, Thomas Conway <conway at cs.mu.OZ.AU> wrote:
> Add a bunch of modules for accessing POSIX.3 functionality directly from
> Mercury.
>
> NEWS:
> Mention the addition of the posix directory.
>
> extras/posix/* the necessary stuff.
Here's a diff for the new files.
cvs diff: Diffing .
Index: Mmake
===================================================================
RCS file: Mmake
diff -N Mmake
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/aaaYp1hx_ Sat Oct 16 05:24:33 1999
@@ -0,0 +1,12 @@
+
+MLLIBS = posix_workarounds.o
+
+depend : hello.depend
+
+default_target : hello
+
+hello : posix_workarounds.o
+
+clean :
+ -/bin/rm -f posix_workarounds.o
+
Index: README
===================================================================
RCS file: README
diff -N README
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/baa0pWxIW Sat Oct 16 05:24:33 1999
@@ -0,0 +1,4 @@
+This directory contains stuff for accessing POSIX.3 stuff directly from
+Mercury. Since I don't actually have a copy of the standard, it's more
+like the stuff that man pages claim is in POSIX.3, and not even all of
+that. :-) conway, 12/10/99
Index: hello.m
===================================================================
RCS file: hello.m
diff -N hello.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/caaZ2DDH_ Sat Oct 16 05:24:33 1999
@@ -0,0 +1,38 @@
+:- module hello.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io:state, io:state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module posix, posix:open, posix:write, text.
+:- import_module list, string.
+
+main -->
+ open("/dev/tty", [wronly], Res0),
+ (
+ { Res0 = ok(Fd) },
+ { Str = "hello world.\n" },
+ { length(Str, Len) },
+ write(Fd, Len, text(Str), Res1),
+ (
+ { Res1 = ok(NWritten) },
+ ( { NWritten \= Len } ->
+ % We didn't write all of it!
+ write("failed to write it all\n")
+ ;
+ []
+ )
+ ;
+ { Res1 = error(Err) },
+ write(Err), nl
+ )
+ ;
+ { Res0 = error(Err) },
+ write(Err), nl
+ ).
+
Index: posix.lseek.m
===================================================================
RCS file: posix.lseek.m
diff -N posix.lseek.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/daa0NPVNF Sat Oct 16 05:24:33 1999
@@ -0,0 +1,66 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: posix:lseek.m
+% main author: conway at cs.mu.oz.au
+%
+%------------------------------------------------------------------------------%
+:- module posix:lseek.
+
+:- interface.
+
+:- type whence
+ ---> set
+ ; cur
+ ; end
+ .
+
+:- pred lseek(fd, int, lseek:whence, posix:result(int), io__state, io__state).
+:- mode lseek(in, in, in, out, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+
+:- pragma c_header_code("
+ #include <sys/types.h>
+ #include <unistd.h>
+").
+
+%------------------------------------------------------------------------------%
+
+lseek(Fd, Offset, Whence, Result) -->
+ lseek0(Fd, Offset, whence(Whence), Res),
+ ( { Res < 0 } ->
+ errno(Err),
+ { Result = error(Err) }
+ ;
+ { Result = ok(Res) }
+ ).
+
+:- pred lseek0(fd, int, int, int, io__state, io__state).
+:- mode lseek0(in, in, in, out, di, uo) is det.
+
+:- pragma c_code(lseek0(Fd::in, Offset::in, Whence::in, Res::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe], "{
+
+ Res = lseek(Fd, Offset, Whence);
+
+ IO = IO0;
+}").
+
+:- func whence(lseek:whence) = int.
+
+:- pragma c_code(whence(W::in) = (V::out),
+ [will_not_call_mercury, thread_safe], "{
+ static int whence_flags[] = { SEEK_SET, SEEK_CUR, SEEK_END } ;
+ V = whence_flags[W];
+}").
+
+%------------------------------------------------------------------------------%
+
Index: posix.m
===================================================================
RCS file: posix.m
diff -N posix.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/eaajahwk_ Sat Oct 16 05:24:33 1999
@@ -0,0 +1,238 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: posix.m
+% main author: conway at cs.mu.oz.au
+%
+% This module (with its submodules) provides a bare interface to the POSIX.3
+% operating system interface. It is intended for providing basic functionality
+% to other library functionality (such as a user oriented IO facility).
+%
+% Conventions
+% -----------
+%
+% File descriptors and other `descriptor' like entities are represented by
+% distinct types using a single-constructor, single-argument wrapper, which
+% is mandated by Mercury to have the same representation as the argument
+% (these are sometimes refered to as `notag' types). In most cases these
+% are concrete rather than abstract, because the intent for this POSIX
+% binding is to provide flexible glue to the C functionality, rather than
+% to provide abstractions of the functionality.
+%
+% Flags are represented by enumerations. Since Mercury doesn't [yet] allow
+% for user assignable values for enumerations, these are mapped onto ints,
+% and the ints are used to index static C arrays of the flag constants.
+%
+%------------------------------------------------------------------------------%
+:- module posix.
+
+:- interface.
+
+:- import_module io.
+
+:- include_module posix:lseek.
+:- include_module posix:open.
+:- include_module posix:read.
+:- include_module posix:select.
+:- include_module posix:socket.
+:- include_module posix:write.
+
+ % Generic file descriptors.
+:- type fd ---> fd(int).
+
+:- type error
+ ---> e2BIG /* Arg list too long */
+ ; eACCES /* Permission denied */
+ ; eAGAIN /* Try again */
+ ; eBADF /* Bad file number */
+ ; eBADMSG /* Not a data message */
+ ; eBUSY /* Device or resource busy */
+ %; eCANCELED /* Operation canceled */
+ ; eCHILD /* No child processes */
+ ; eDEADLK /* Resource deadlock would occur */
+ ; eDOM /* Math argument out of domain */
+ ; eEXIST /* File exists */
+ ; eFAULT /* Bad address */
+ ; eFBIG /* File too large */
+ ; eINPROGRESS /* Operation now in progress */
+ ; eINTR /* Interrupted system call */
+ ; eINVAL /* Invalid argument */
+ ; eIO /* I/O error */
+ ; eISDIR /* Is a directory */
+ ; eMFILE /* Too many open files */
+ ; eMLINK /* Too many links */
+ ; eMSGSIZE /* Message too long */
+ ; eNAMETOOLONG /* File name too long */
+ ; eNFILE /* File table overflow */
+ ; eNODEV /* No such device */
+ ; eNOENT /* No such file or directory */
+ ; eNOEXEC /* Exec format error */
+ %; eNOLOCK /* No locks available */
+ ; eNOMEM /* Out of memory */
+ ; eNOSPC /* No space left on device */
+ ; eNOSYS /* Function not implemented */
+ ; eNOTDIR /* Not a directory */
+ ; eNOTEMPTY /* Directory not empty */
+ %; eNOTSUP /* Not supported */
+ ; eNOTTY /* Not a typewriter */
+ ; eNXIO /* No such device or address */
+ ; ePERM /* Operation not permitted */
+ ; ePIPE /* Broken pipe */
+ ; eRANGE /* Math result not representable */
+ ; eROFS /* Read-only file system */
+ ; eSPIPE /* Illegal seek */
+ ; eSRCH /* No such process */
+ ; eTIMEDOUT /* Connection timed out */
+ ; eXDEV /* Cross-device link */
+ ; unknown(int, string) % unknown(Errno, Msg)
+ .
+
+:- type posix:result
+ ---> ok
+ ; error(posix:error)
+ .
+
+:- type posix:result(T)
+ ---> ok(T)
+ ; error(posix:error)
+ .
+
+:- type (mode) ---> mode(int).
+
+:- type timeval
+ ---> timeval(int, int). % time(Sec, uSec)
+
+:- pred errno(posix:error, io__state, io__state).
+:- mode errno(out, di, uo) is det.
+
+:- implementation.
+
+:- import_module require.
+
+:- pragma c_header_code("
+ #include <unistd.h>
+ #include <errno.h>
+").
+
+errno(Error) -->
+ errno0(ErrNo),
+ { Error = error(errnumber(ErrNo)) }.
+
+:- pred errno0(int, io__state, io__state).
+:- mode errno0(out, di, uo) is det.
+
+:- pragma c_code(errno0(E::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ E = errno;
+ IO = IO0;
+}").
+
+:- func error(int) = posix:error.
+
+error(Num) = Res :-
+ (( Num = 0, Err = e2BIG
+ ; Num = 1, Err = eACCES
+ ; Num = 2, Err = eAGAIN
+ ; Num = 3, Err = eBADF
+ ; Num = 4, Err = eBADMSG
+ ; Num = 5, Err = eBUSY
+ %; Num = 6, Err = eCANCELED
+ ; Num = 7, Err = eCHILD
+ ; Num = 8, Err = eDEADLK
+ ; Num = 9, Err = eDOM
+ ; Num = 10, Err = eEXIST
+ ; Num = 11, Err = eFAULT
+ ; Num = 12, Err = eFBIG
+ ; Num = 13, Err = eINPROGRESS
+ ; Num = 14, Err = eINTR
+ ; Num = 15, Err = eINVAL
+ ; Num = 16, Err = eIO
+ ; Num = 17, Err = eISDIR
+ ; Num = 18, Err = eMFILE
+ ; Num = 19, Err = eMLINK
+ ; Num = 20, Err = eMSGSIZE
+ ; Num = 21, Err = eNAMETOOLONG
+ ; Num = 22, Err = eNFILE
+ ; Num = 23, Err = eNODEV
+ ; Num = 24, Err = eNOENT
+ ; Num = 25, Err = eNOEXEC
+ %; Num = 26, Err = eNOLOCK
+ ; Num = 27, Err = eNOMEM
+ ; Num = 28, Err = eNOSPC
+ ; Num = 29, Err = eNOSYS
+ ; Num = 30, Err = eNOTDIR
+ ; Num = 31, Err = eNOTEMPTY
+ %; Num = 32, Err = eNOTSUP
+ ; Num = 33, Err = eNOTTY
+ ; Num = 34, Err = eNXIO
+ ; Num = 35, Err = ePERM
+ ; Num = 36, Err = ePIPE
+ ; Num = 37, Err = eRANGE
+ ; Num = 38, Err = eROFS
+ ; Num = 39, Err = eSPIPE
+ ; Num = 40, Err = eSRCH
+ ; Num = 41, Err = eTIMEDOUT
+ ; Num = 42, Err = eXDEV
+ ) ->
+ Res = Err
+ ;
+ Res = unknown(Num, "unknown errno")
+ ).
+
+:- func errnumber(int) = int.
+:- mode (errnumber(in) = out) is det.
+
+:- pragma c_code(errnumber(Er::in) = (En::out),
+ [will_not_call_mercury, thread_safe], "{
+ switch (Er) {
+ case E2BIG: En = 0; break;
+ case EACCES: En = 1; break;
+ case EAGAIN: En = 2; break;
+ case EBADF: En = 3; break;
+ case EBADMSG: En = 4; break;
+ case EBUSY: En = 5; break;
+ /* case ECANCELED: En = 6; break; */
+ case ECHILD: En = 7; break;
+ case EDEADLK: En = 8; break;
+ case EDOM: En = 9; break;
+ case EEXIST: En = 10; break;
+ case EFAULT: En = 11; break;
+ case EFBIG: En = 12; break;
+ case EINPROGRESS: En = 13; break;
+ case EINTR: En = 14; break;
+ case EINVAL: En = 15; break;
+ case EIO: En = 16; break;
+ case EISDIR: En = 17; break;
+ case EMFILE: En = 18; break;
+ case EMLINK: En = 19; break;
+ case EMSGSIZE: En = 20; break;
+ case ENAMETOOLONG: En = 21; break;
+ case ENFILE: En = 22; break;
+ case ENODEV: En = 23; break;
+ case ENOENT: En = 24; break;
+ case ENOEXEC: En = 25; break;
+ /* case ENOLOCK: En = 26; break; */
+ case ENOMEM: En = 27; break;
+ case ENOSPC: En = 28; break;
+ case ENOSYS: En = 29; break;
+ case ENOTDIR: En = 30; break;
+ case ENOTEMPTY: En = 31; break;
+ /* case ENOTSUP: En = 32; break; */
+ case ENOTTY: En = 33; break;
+ case ENXIO: En = 34; break;
+ case EPERM: En = 35; break;
+ case EPIPE: En = 36; break;
+ case ERANGE: En = 37; break;
+ case EROFS: En = 38; break;
+ case ESPIPE: En = 39; break;
+ case ESRCH: En = 40; break;
+ case ETIMEDOUT: En = 41; break;
+ case EXDEV: En = 42; break;
+ default:
+ En = -1;
+ }
+}").
+
Index: posix.open.m
===================================================================
RCS file: posix.open.m
diff -N posix.open.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/faajiwPI_ Sat Oct 16 05:24:33 1999
@@ -0,0 +1,163 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: posix:open.
+% main author: conway at cs.mu.oz.au
+%
+% This module provides and interface to the open function and its
+% relatives.
+%
+%------------------------------------------------------------------------------%
+:- module posix:open.
+
+:- interface.
+
+:- import_module list.
+
+:- type oflag
+ ---> rdonly
+ ; wronly
+ ; rdwr
+ ; creat
+ ; excl
+ ; noctty
+ ; trunc
+ ; append
+ ; ndelay
+ ; sync
+ .
+
+:- pred open(string, list(oflag), posix:result(fd), io__state, io__state).
+:- mode open(in, in, out, di, uo) is det.
+
+:- pred open(string, list(oflag), (mode), posix:result(fd),
+ io__state, io__state).
+:- mode open(in, in, in, out, di, uo) is det.
+
+:- pred creat(string, (mode), posix:result(fd), io__state, io__state).
+:- mode creat(in, in, out, di, uo) is det.
+
+:- pred close(fd, posix:result, io__state, io__state).
+:- mode close(in, out, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+
+:- pragma c_header_code("
+ #include <unistd.h>
+ #include <fcntl.h>
+").
+
+%------------------------------------------------------------------------------%
+
+open(PathName, FlagList, Result) -->
+ open0(PathName, oflags(FlagList), FdNo),
+ ( { FdNo < 0 } ->
+ errno(Error),
+ { Result = error(Error) }
+ ;
+ { Result = ok(fd(FdNo)) }
+ ).
+
+:- pred open0(string, int, int, io__state, io__state).
+:- mode open0(in, in, out, di, uo) is det.
+
+:- pragma c_code(open0(PathName::in, Flags::in, FileDes::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ FileDes = open(PathName, Flags);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+open(PathName, FlagList, Mode, Result) -->
+ open0(PathName, oflags(FlagList), Mode, FdNo),
+ ( { FdNo < 0 } ->
+ errno(Error),
+ { Result = error(Error) }
+ ;
+ { Result = ok(fd(FdNo)) }
+ ).
+
+:- pred open0(string, int, (mode), int, io__state, io__state).
+:- mode open0(in, in, in, out, di, uo) is det.
+
+:- pragma c_code(open0(PathName::in, Flags::in, Mode::in, FileDes::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe], "{
+ FileDes = open(PathName, Flags, Mode);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+creat(PathName, Mode, Result) -->
+ creat0(PathName, Mode, FdNo),
+ ( { FdNo < 0 } ->
+ errno(Error),
+ { Result = error(Error) }
+ ;
+ { Result = ok(fd(FdNo)) }
+ ).
+
+:- pred creat0(string, (mode), int, io__state, io__state).
+:- mode creat0(in, in, out, di, uo) is det.
+
+:- pragma c_code(creat0(PathName::in, Mode::in, FileDes::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe], "{
+ FileDes = creat(PathName, Mode);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+close(fd(FdNo), Result) -->
+ close0(FdNo, Res0),
+ ( { Res0 < 0 } ->
+ errno(Error),
+ { Result = error(Error) }
+ ;
+ { Result = ok }
+ ).
+
+:- pred close0(int, int, io__state, io__state).
+:- mode close0(in, out, di, uo) is det.
+
+:- pragma c_code(close0(Fd::in, Res::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ Res = close(Fd);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- func oflags(list(oflag)) = int.
+
+oflags(FlagList) = Or :-
+ orflags(FlagList, 0, Or).
+
+:- pred orflags(list(oflag), int, int).
+:- mode orflags(in, in, out) is det.
+
+orflags([], Or, Or).
+orflags([F|Fs], Or0, Or) :-
+ Or1 = Or0 \/ oflagval(F),
+ orflags(Fs, Or1, Or).
+
+:- func oflagval(oflag) = int.
+:- mode (oflagval(in) = out) is det.
+
+:- pragma c_code(oflagval(F::in) = (V::out),
+ [will_not_call_mercury, thread_safe], "{
+ static int oflag_values[] = {
+ O_RDONLY, O_WRONLY, O_RDWR, O_CREAT, O_EXCL, O_NOCTTY,
+ O_TRUNC, O_APPEND, O_NDELAY, O_SYNC };
+
+ V = oflag_values[F];
+}").
+
Index: posix.read.m
===================================================================
RCS file: posix.read.m
diff -N posix.read.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/gaa0g42Mg Sat Oct 16 05:24:33 1999
@@ -0,0 +1,58 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: posix:read.m
+% main author: conway at cs.mu.oz.au
+%
+%------------------------------------------------------------------------------%
+:- module posix:read.
+
+:- interface.
+
+:- import_module text.
+
+:- pred read(fd, int, posix:result(int), text, text, io__state, io__state).
+:- mode read(in, in, out, di, uo, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+
+:- pragma c_header_code("
+ #include <unistd.h>
+ #include ""text_header.h""
+").
+
+%------------------------------------------------------------------------------%
+
+read(Fd, ToRead, Result, Text0, Text) -->
+ read0(Fd, ToRead, Read, Text0, Text),
+ ( { Read < 0 } ->
+ errno(Err),
+ { Result = error(Err) }
+ ;
+ { Result = ok(Read) }
+ ).
+
+:- pred read0(fd, int, int, text, text, io__state, io__state).
+:- mode read0(in, in, out, di, uo, di, uo) is det.
+
+:- pragma c_code(read0(Fd::in, ToRead::in, Read::out, Text0::di, Text::uo,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Text0;
+
+ Read = read(Fd, txtptr->data, ToRead);
+
+ Text = Text0;
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
Index: posix.select.m
===================================================================
RCS file: posix.select.m
diff -N posix.select.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/haazPoq9_ Sat Oct 16 05:24:33 1999
@@ -0,0 +1,123 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: posix:select.m
+% main author: conway at cs.mu.oz.au
+%
+%------------------------------------------------------------------------------%
+:- module posix:select.
+
+:- interface.
+
+:- import_module bool.
+
+:- type fdset.
+
+:- pred select(int, fdset, fdset, fdset, timeval, posix:result(int),
+ io__state, io__state).
+:- mode select(in, in, in, in, in, out, di, uo) is det.
+
+:- pred new_fdset(fdset, io__state, io__state).
+:- mode new_fdset(out, di, uo) is det.
+
+:- pred fd_clr(fd, fdset, io__state, io__state).
+:- mode fd_clr(in, in, di, uo) is det.
+
+:- pred fd_isset(fd, fdset, bool, io__state, io__state).
+:- mode fd_isset(in, in, out, di, uo) is det.
+
+:- pred fd_set(fd, fdset, io__state, io__state).
+:- mode fd_set(in, in, di, uo) is det.
+
+:- pred fd_zero(fdset, io__state, io__state).
+:- mode fd_zero(in, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, std_util.
+
+:- pragma c_header_code("
+ #include <sys/time.h>
+ #include <sys/types.h>
+ #include <unistd.h>
+
+ #include ""posix_workarounds.h""
+").
+
+:- type fdset
+ ---> fdset(c_pointer).
+
+%------------------------------------------------------------------------------%
+
+select(Fd, R, W, E, Timeout, Result) -->
+ { Timeout = timeval(TS, TM) },
+ select0(Fd, R, W, E, TS, TM, Res),
+ ( { Res < 0 } ->
+ errno(Err),
+ { Result = error(Err) }
+ ;
+ { Result = ok(Res) }
+ ).
+
+:- pred select0(int, fdset, fdset, fdset, int, int, int, io__state, io__state).
+:- mode select0(in, in, in, in, in, in, out, di, uo) is det.
+
+:- pragma c_code(select0(N::in, R::in, W::in, E::in, TS::in, TM::in, Res::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe], "{
+ struct timeval tv;
+
+ tv.tv_sec = TS;
+ tv.tv_usec = TM;
+ Res = select(N, (fd_set *)R, (fd_set *)W, (fd_set *)E, &tv);
+
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(new_fdset(Fds::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+
+ incr_hp(Fds, 1+sizeof(fd_set)/sizeof(Word));
+ ME_fd_zero((fd_set *) Fds);
+
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(fd_clr(Fd::in, Fds::in, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_fd_clr(Fd, (fd_set *) Fds);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(fd_zero(Fds::in, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_fd_zero((fd_set *) Fds);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(fd_isset(Fd::in, Fds::in, Res::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ Res = (ME_fd_isset(Fd, (fd_set *) Fds) ? 1 : 0 );
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(fd_set(Fd::in, Fds::in, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_fd_set(Fd, (fd_set *) Fds);
+ IO = IO0;
+}").
+
Index: posix.socket.m
===================================================================
RCS file: posix.socket.m
diff -N posix.socket.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/iaa_gfYb_ Sat Oct 16 05:24:33 1999
@@ -0,0 +1,253 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module posix:socket.
+% main author: conway at cs.mu.oz.au
+%
+%------------------------------------------------------------------------------%
+:- module posix:socket.
+
+:- interface.
+
+:- import_module std_util.
+
+:- type posix:socket:domain
+ ---> unix
+ ; inet
+ .
+
+:- type posix:socket:(type)
+ ---> stream
+ ; dgram
+ ; raw
+ ; seqpacket
+ ; rdm
+ .
+
+:- type protocol
+ ---> protocol(int)
+ .
+
+:- type sockaddr
+ ---> inet(port, inet_addr)
+ .
+
+:- type port
+ ---> port(int).
+
+:- type inet_addr
+ ---> inet_addr(int).
+
+:- pred socket(domain, (type), protocol, posix:result(fd),
+ io__state, io__state).
+:- mode socket(in, in, in, out, di, uo) is det.
+
+:- pred accept(fd, posix:result(fd), io__state, io__state).
+:- mode accept(in, out, di, uo) is det.
+
+:- pred bind(fd, sockaddr, posix:result, io__state, io__state).
+:- mode bind(in, in, out, di, uo) is det.
+
+:- pred connect(fd, sockaddr, posix:result, io__state, io__state).
+:- mode connect(in, in, out, di, uo) is det.
+
+:- pred listen(fd, int, posix:result, io__state, io__state).
+:- mode listen(in, in, out, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+
+:- pragma c_header_code("
+ #include <string.h>
+ #include <sys/types.h>
+ #include <sys/socket.h>
+ #include <netinet/in.h>
+ #include <arpa/inet.h>
+").
+
+%------------------------------------------------------------------------------%
+
+socket(Dom, Typ, protocol(Prot), Result) -->
+ socket0(domain(Dom), type(Typ), Prot, FdNo),
+ ( { FdNo < 0 } ->
+ errno(Err),
+ { Result = error(Err) }
+ ;
+ { Result = ok(fd(FdNo)) }
+ ).
+
+:- pred socket0(int, int, int, int, io__state, io__state).
+:- mode socket0(in, in, in, out, di, uo) is det.
+
+:- pragma c_code(socket0(Dom::in, Typ::in, Prot::in, Fd::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ Fd = socket(Dom, Typ, Prot);
+ IO = IO0;
+}").
+
+:- func domain(domain) = int.
+:- mode (domain(in) = out) is det.
+
+:- pragma c_code(domain(D::in) = (V::out),
+ [will_not_call_mercury, thread_safe], "{
+ static int domain_values[] = {
+ AF_UNIX, AF_INET
+ };
+
+ V = domain_values[D];
+}").
+
+:- func type(type) = int.
+:- mode (type(in) = out) is det.
+
+:- pragma c_code(type(T::in) = (V::out),
+ [will_not_call_mercury, thread_safe], "{
+ static int type_values[] = {
+ SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, SOCK_SEQPACKET, SOCK_RDM
+ };
+
+ V = type_values[T];
+}").
+
+%------------------------------------------------------------------------------%
+
+:- type sockaddr_ptr
+ ---> sockaddr_ptr(c_pointer).
+
+bind(Fd, SockAddr, Result) -->
+ { mksockaddr_struct(SockAddr, Ptr, Len) },
+ bind0(Fd, Ptr, Len, Res0),
+ ( { Res0 = 0 } ->
+ { Result = ok }
+ ;
+ errno(Errno),
+ { Result = error(Errno) }
+ ).
+
+:- pred bind0(fd, sockaddr_ptr, int, int, io__state, io__state).
+:- mode bind0(in, in, in, out, di, uo) is det.
+
+:- pragma c_code(bind0(Fd::in, Addr::in, Len::in, Res::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ Res = bind(Fd, (struct sockaddr *) Addr, Len);
+ IO = IO0;
+}").
+
+:- pred mksockaddr_struct(sockaddr, sockaddr_ptr, int).
+:- mode mksockaddr_struct(in, out, out) is det.
+
+mksockaddr_struct(inet(Port, Addr), Ptr, Len) :-
+ mkinet_addr(Addr, Port, Ptr, Len).
+
+:- pred mkinet_addr(inet_addr, port, sockaddr_ptr, int).
+:- mode mkinet_addr(in, in, out, out) is det.
+
+:- pragma c_code(mkinet_addr(A::in, P::in, Ptr::out, Len::out),
+ [will_not_call_mercury, thread_safe], "{
+ struct sockaddr_in *ptr;
+
+ incr_hp(Ptr, (1 + sizeof(struct sockaddr_in)/sizeof(Word)));
+ ptr = (struct sockaddr_in *) Ptr;
+
+ memset((void *) ptr, 0, sizeof(struct sockaddr_in));
+ ptr->sin_family = AF_INET;
+ ptr->sin_addr.s_addr = A;
+ ptr->sin_port = htons(P);
+
+ Len = sizeof(struct sockaddr_in);
+}").
+
+%------------------------------------------------------------------------------%
+
+connect(Fd, SockAddr, Result) -->
+ { mksockaddr_struct(SockAddr, Ptr, Len) },
+ connect0(Fd, Ptr, Len, Res),
+ ( { Res = 0 } ->
+ { Result = ok }
+ ;
+ errno(Err),
+ { Result = error(Err) }
+ ).
+
+:- pred connect0(fd, sockaddr_ptr, int, int, io__state, io__state).
+:- mode connect0(in, in, in, out, di, uo) is det.
+
+:- pragma c_code(connect0(Fd::in, Addr::in, Len::in, Res::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ Res = connect(Fd, (struct sockaddr *) Addr, Len);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+listen(Fd, N, Result) -->
+ listen0(Fd, N, Res0),
+ ( { Res0 = 0 } ->
+ { Result = ok }
+ ;
+ errno(Errno),
+ { Result = error(Errno) }
+ ).
+
+:- pred listen0(fd, int, int, io__state, io__state).
+:- mode listen0(in, in, out, di, uo) is det.
+
+:- pragma c_code(listen0(Fd::in, N::in, Res::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ Res = listen(Fd, N);
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
+accept(Fd, Result) -->
+ accept0(Fd, Ptr, NewFd),
+ ( { NewFd < 0 } ->
+ errno(Errno),
+ { Result = error(Errno) }
+ ;
+ % { cons_sockaddr(Ptr, SockAddr) },
+ % { Result = ok(SockAddr - fd(NewFd)) }
+ { Result = ok(fd(NewFd)) }
+ ).
+
+:- pred accept0(fd, sockaddr_ptr, int, io__state, io__state).
+:- mode accept0(in, out, out, di, uo) is det.
+
+:- pragma c_code(accept0(Fd::in, Ptr::out, NewFd::out, IO0::di, IO::uo),
+ [will_not_call_mercury, thread_safe], "{
+ struct sockaddr_in *ptr;
+ int len = sizeof(struct sockaddr_in);
+
+ incr_hp(Ptr, (1 + sizeof(struct sockaddr_in)/sizeof(Word)));
+ ptr = (struct sockaddr_in *) Ptr;
+
+ NewFd = accept(Fd, ptr, &len);
+ IO = IO0;
+}").
+
+:- pred cons_sockaddr(sockaddr_ptr, sockaddr).
+:- mode cons_sockaddr(in, out) is det.
+
+:- pragma c_code(cons_sockaddr(Ptr::in, Sok::out),
+ [will_not_call_mercury, thread_safe], "{
+ struct sockaddr_in *ptr;
+
+ ptr = (struct sockaddr_in *) Ptr;
+
+ if (ptr->sin_family == AF_INET) {
+ incr_hp(Ptr, 2);
+ field(MR_mktag(0), Ptr, 0) = ntohs(ptr->sin_port);
+ field(MR_mktag(0), Ptr, 1) = ptr->sin_addr.s_addr;
+ } else {
+ fatal_error(""cons_sockaddr: unknown type"");
+ }
+}").
+
Index: posix.write.m
===================================================================
RCS file: posix.write.m
diff -N posix.write.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/jaa0sy6i1 Sat Oct 16 05:24:33 1999
@@ -0,0 +1,57 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: posix:write.m
+% main author: conway at cs.mu.oz.au
+%
+%------------------------------------------------------------------------------%
+:- module posix:write.
+
+:- interface.
+
+:- import_module text.
+
+:- pred write(fd, int, text, posix:result(int), io__state, io__state).
+:- mode write(in, in, in, out, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+
+:- pragma c_header_code("
+ #include <unistd.h>
+ #include ""text_header.h""
+").
+
+%------------------------------------------------------------------------------%
+
+write(Fd, ToWrite, Text, Result) -->
+ write0(Fd, ToWrite, Text, Res),
+ ( { Res < 0 } ->
+ errno(Err),
+ { Result = error(Err) }
+ ;
+ { Result = ok(Res) }
+ ).
+
+:- pred write0(fd, int, text, int, io__state, io__state).
+:- mode write0(in, in, in, out, di, uo) is det.
+
+:- pragma c_code(write0(Fd::in, ToWrite::in, Text::in, Res::out,
+ IO0::di, IO::uo), [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Text;
+
+ Res = write(Fd, txtptr->data, ToWrite);
+
+ IO = IO0;
+}").
+
+%------------------------------------------------------------------------------%
+
Index: posix_workarounds.c
===================================================================
RCS file: posix_workarounds.c
diff -N posix_workarounds.c
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/kaa0mc0rV Sat Oct 16 05:24:34 1999
@@ -0,0 +1,38 @@
+/*----------------------------------------------------------------------------*/
+/* Copyright (C) 1999 The University of Melbourne. */
+/* This file may only be copied under the terms of the GNU Library General */
+/* Public License - see the file COPYING.LIB in the Mercury distribution. */
+/*----------------------------------------------------------------------------*/
+/* */
+/* This file contains a bunch of functions for working on fd_set objects. */
+/* The reason that these are necessary is that gcc generates inline assembler */
+/* for these which conflicts with our use of global registers. */
+/* */
+/*----------------------------------------------------------------------------*/
+
+#include <sys/types.h>
+#include <sys/time.h>
+#include <unistd.h>
+
+#include "posix_workarounds.h"
+
+void ME_fd_zero(fd_set *fds)
+{
+ FD_ZERO(fds);
+}
+
+void ME_fd_clr(int fd, fd_set *fds)
+{
+ FD_CLR(fd, fds);
+}
+
+void ME_fd_set(int fd, fd_set *fds)
+{
+ FD_SET(fd, fds);
+}
+
+int ME_fd_isset(int fd, fd_set *fds)
+{
+ return FD_ISSET(fd, fds);
+}
+
Index: posix_workarounds.h
===================================================================
RCS file: posix_workarounds.h
diff -N posix_workarounds.h
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/laa0IQ_QS Sat Oct 16 05:24:34 1999
@@ -0,0 +1,18 @@
+/*----------------------------------------------------------------------------*/
+/* Copyright (C) 1999 The University of Melbourne. */
+/* This file may only be copied under the terms of the GNU Library General */
+/* Public License - see the file COPYING.LIB in the Mercury distribution. */
+/*----------------------------------------------------------------------------*/
+
+#ifndef ME_POSIX_WORKAROUNDS_H
+#define ME_POSIX_WORKAROUNDS_H
+
+void ME_fd_zero(fd_set *fds);
+
+void ME_fd_clr(int fd, fd_set *fds);
+
+void ME_fd_set(int fd, fd_set *fds);
+
+int ME_fd_isset(int fd, fd_set *fds);
+
+#endif
Index: text.m
===================================================================
RCS file: text.m
diff -N text.m
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/maa0uM2SN Sat Oct 16 05:24:34 1999
@@ -0,0 +1,210 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 1999 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%------------------------------------------------------------------------------%
+%
+% module: text.m
+% main author: conway at cs.mu.oz.au
+%
+% This module provides a byte-array module intended for storing text and
+% binary byte-oriented data.
+%
+%------------------------------------------------------------------------------%
+:- module text.
+
+:- interface.
+
+:- type text.
+
+:- type byte == int. % Using low 8 bits only.
+
+:- func text(string) = text.
+:- mode (text(in) = uo) is det.
+
+:- pred create(int, byte, text).
+:- mode create(in, in, uo) is det.
+
+:- pred index(text, int, byte).
+:- mode index(ui, in, out) is det.
+:- mode index(in, in, out) is det.
+
+:- pred update(int, byte, text, text).
+:- mode update(in, in, di, uo) is det.
+
+:- pred length(text, int).
+:- mode length(ui, out) is det.
+:- mode length(in, out) is det.
+
+:- func unique(text) = text.
+:- mode (unique(in) = uo) is det.
+
+:- pred split(text, int, text, text).
+:- mode split(di, in, uo, uo) is det.
+
+:- pred combine(text, text, text).
+:- mode combine(di, di, uo) is det.
+
+%------------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module char, int, list, std_util, string.
+
+:- type text
+ ---> text(c_pointer).
+
+:- pragma c_header_code("
+ #include ""text_header.h""
+
+ /*
+ ** ME_words(amt) returns the number of words necessary to
+ ** to store `amt' bytes.
+ */
+ #define ME_words(x) (1+(x)/sizeof(Word))
+").
+
+%------------------------------------------------------------------------------%
+
+text(Str) = Text :-
+ length(Str, Len),
+ create(Len, 0, Text0),
+ string__to_char_list(Str, Chars),
+ text_2(Chars, 0, Text0, Text).
+
+:- pred text_2(list(char), int, text, text).
+:- mode text_2(in, in, di, uo) is det.
+
+text_2([], _, Text, Text).
+text_2([C|Cs], N, Text0, Text) :-
+ char__to_int(C, I),
+ update(N, I, Text0, Text1),
+ text_2(Cs, N+1, Text1, Text).
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(create(Len::in, Val::in, Txt::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+ Word tmp;
+ int i;
+
+ incr_hp(Txt, ME_words(sizeof(ME_Text)));
+ incr_hp_atomic(tmp, ME_words(Len));
+ txtptr = (ME_Text *) Txt;
+ txtptr->len = Len;
+ txtptr->data = (char *) tmp;
+ for (i=0; i < Len; i++)
+ txtptr->data[i] = Val;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(index(Txt::ui, Ind::in, Val::out),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Txt;
+ if (Ind < 0 || Ind >= txtptr->len) {
+ fatal_error(""text:index : index out of range"");
+ }
+
+ Val = txtptr->data[Ind];
+
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(index(Txt::in, Ind::in, Val::out),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Txt;
+ if (Ind < 0 || Ind >= txtptr->len) {
+ fatal_error(""text:index : index out of range"");
+ }
+
+ Val = txtptr->data[Ind];
+
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(update(Ind::in, Val::in, Txt0::di, Txt::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Txt0;
+ if (Ind < 0 || Ind >= txtptr->len) {
+ fatal_error(""text:index : index out of range"");
+ }
+
+ txtptr->data[Ind] = Val;
+
+ Txt = Txt0;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(length(Txt::ui, Len::out),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Txt;
+ Len = txtptr->len;
+}").
+
+:- pragma c_code(length(Txt::in, Len::out),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr;
+
+ txtptr = (ME_Text *) Txt;
+ Len = txtptr->len;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(unique(A::in) = (B::uo),
+ [will_not_call_mercury, thread_safe], "{
+ B = A;
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(split(Text0::di, Where::in, Text1::uo, Text2::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr1, *txtptr2;
+
+ txtptr1 = (ME_Text *) Text0;
+ if (Where < 0 || Where >= txtptr1->len) {
+ fatal_error(""text:split : index out of range"");
+ }
+
+ Text1 = Text0;
+
+ incr_hp(Text2, ME_words(sizeof(ME_Text)));
+ txtptr2 = (ME_Text *) Text2;
+ txtptr2->len = txtptr1->len - Where;
+ txtptr2->data = txtptr1->data + Where;
+
+ txtptr1->len = Where;
+
+}").
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_code(combine(Text0::di, Text1::di, Text::uo),
+ [will_not_call_mercury, thread_safe], "{
+ ME_Text *txtptr1, *txtptr2;
+
+ txtptr1 = (ME_Text *) Text0;
+ txtptr2 = (ME_Text *) Text1;
+
+ if (txtptr1->data + txtptr1->len != txtptr2->data) {
+ fatal_error(""text:combine : not adjacent text"");
+ }
+
+ txtptr1->len = txtptr1->len + txtptr2->len;
+
+ Text = Text0;
+}").
+
Index: text_header.h
===================================================================
RCS file: text_header.h
diff -N text_header.h
--- /dev/null Sat Oct 16 01:45:53 1999
+++ /var/tmp/naacYraF_ Sat Oct 16 05:24:34 1999
@@ -0,0 +1,9 @@
+#ifndef ME_TEXT_HEADER_H
+#define ME_TEXT_HEADER_H
+
+typedef struct {
+ unsigned len;
+ char *data;
+} ME_Text;
+
+#endif
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list