[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