[m-rev.] posix patch (stat, pipe, kill)
Michael Day
mikeday at corplink.com.au
Thu Jul 19 13:18:27 AEST 2001
Hi,
Fergus' review comments have been applied and the other modules committed.
Here is the stat module again with more types rather than just ints. Also
added are wrappers for the pipe and kill system calls. Someone could
probably write a shell in Mercury now... :)
(Incidentally, I don't receive any mails from mercury-reviews. I guess I
am not actually subscribed?)
Michael
-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 1999, 2001 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__closedir.
:- include_module posix__dup.
:- include_module posix__exec.
:- include_module posix__fork.
:- include_module posix__kill.
:- include_module posix__lseek.
:- include_module posix__mkdir.
:- include_module posix__open.
:- include_module posix__opendir.
:- include_module posix__pipe.
:- include_module posix__read.
:- include_module posix__readdir.
:- include_module posix__rmdir.
:- include_module posix__select.
:- include_module posix__socket.
:- include_module posix__stat.
:- include_module posix__wait.
:- include_module posix__write.
% Generic file descriptors.
:- type fd ---> fd(int).
% Directory streams.
:- type dir ---> dir(c_pointer).
% Devices.
:- type dev ---> dev(int).
% Inodes.
:- type ino ---> ino(int).
% Process identifiers.
:- type pid ---> pid(int).
% User identifiers.
:- type uid ---> uid(int).
% Group identifiers.
:- type gid ---> gid(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;
}
}").
-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 2001 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__stat.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__stat.
:- interface.
:- import_module int, string, time.
:- type file_type
---> file
; directory
; symbolic_link
; character_device
; block_device
; fifo
; unknown
.
:- type stat.
:- func dev(stat) = dev.
:- func ino(stat) = ino.
:- func mode(stat) = (mode).
:- func file_type(stat) = file_type.
:- func nlink(stat) = int.
:- func uid(stat) = uid.
:- func gid(stat) = gid.
:- func rdev(stat) = dev.
:- func size(stat) = int.
:- func blksize(stat) = int.
:- func blocks(stat) = int.
:- func atime(stat) = time_t.
:- func mtime(stat) = time_t.
:- func ctime(stat) = time_t.
:- pred stat(string, posix__result(stat), io__state, io__state).
:- mode stat(in, out, di, uo) is det.
%------------------------------------------------------------------------------%
:- implementation.
:- pragma c_header_code("
#include <sys/types.h>
#include <sys/stat.h>
#include <unistd.h>
").
%------------------------------------------------------------------------------%
:- type stat ---> stat(c_pointer).
stat(Path, Result) -->
stat0(Path, Res, Stat),
( if { Res = 0 } then
{ Result = ok(Stat) }
else
errno(Err),
{ Result = error(Err) }
).
:- pred stat0(string, int, stat, io__state, io__state).
:- mode stat0(in, out, out, di, uo) is det.
:- pragma c_code(stat0(Path::in, Res::out, Stat::out, IO0::di, IO::uo),
[will_not_call_mercury, thread_safe], "{
Stat = (MR_Word) GC_NEW(struct stat);
Res = stat(Path, (struct stat *)Stat);
IO = IO0;
}").
file_type(Stat) =
( if is_slnk(Mode) then symbolic_link
else if is_reg(Mode) then file
else if is_dir(Mode) then directory
else if is_chr(Mode) then character_device
else if is_blk(Mode) then block_device
else if is_fifo(Mode) then fifo
else unknown ) :- Mode = Stat ^ (mode).
:- pred is_slnk(mode).
:- mode is_slnk(in) is semidet.
:- pragma c_code(is_slnk(Mode::in), [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = S_ISLNK(Mode); ").
:- pred is_reg(mode).
:- mode is_reg(in) is semidet.
:- pragma c_code(is_reg(Mode::in), [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = S_ISREG(Mode); ").
:- pred is_dir(mode).
:- mode is_dir(in) is semidet.
:- pragma c_code(is_dir(Mode::in), [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = S_ISDIR(Mode); ").
:- pred is_chr(mode).
:- mode is_chr(in) is semidet.
:- pragma c_code(is_chr(Mode::in), [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = S_ISCHR(Mode); ").
:- pred is_blk(mode).
:- mode is_blk(in) is semidet.
:- pragma c_code(is_blk(Mode::in), [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = S_ISBLK(Mode); ").
:- pred is_fifo(mode).
:- mode is_fifo(in) is semidet.
:- pragma c_code(is_fifo(Mode::in), [will_not_call_mercury, thread_safe], "
SUCCESS_INDICATOR = S_ISFIFO(Mode); ").
:- pragma c_code(dev(S::in) = (Dev::out),
[will_not_call_mercury, thread_safe],
"Dev = ((struct stat *)S)->st_dev; ").
:- pragma c_code(ino(S::in) = (Ino::out),
[will_not_call_mercury, thread_safe],
"Ino = ((struct stat *)S)->st_ino; ").
:- pragma c_code(mode(S::in) = (Mode::out),
[will_not_call_mercury, thread_safe],
"Mode = ((struct stat *)S)->st_mode; ").
:- pragma c_code(nlink(S::in) = (Nlink::out),
[will_not_call_mercury, thread_safe],
"Nlink = ((struct stat *)S)->st_nlink; ").
:- pragma c_code(uid(S::in) = (Uid::out),
[will_not_call_mercury, thread_safe],
"Uid = ((struct stat *)S)->st_uid; ").
:- pragma c_code(gid(S::in) = (Gid::out),
[will_not_call_mercury, thread_safe],
"Gid = ((struct stat *)S)->st_gid; ").
:- pragma c_code(rdev(S::in) = (Rdev::out),
[will_not_call_mercury, thread_safe],
"Rdev = ((struct stat *)S)->st_rdev; ").
:- pragma c_code(size(S::in) = (Size::out),
[will_not_call_mercury, thread_safe],
"Size = ((struct stat *)S)->st_size; ").
:- pragma c_code(blksize(S::in) = (Blksize::out),
[will_not_call_mercury, thread_safe],
"Blksize = ((struct stat *)S)->st_blksize; ").
:- pragma c_code(blocks(S::in) = (Blocks::out),
[will_not_call_mercury, thread_safe],
"Blocks = ((struct stat *)S)->st_blocks; ").
:- pragma c_code(atime(S::in) = (Atime::out),
[will_not_call_mercury, thread_safe],
"Atime = ((struct stat *)S)->st_atime; ").
:- pragma c_code(mtime(S::in) = (Mtime::out),
[will_not_call_mercury, thread_safe],
"Mtime = ((struct stat*)S)->st_mtime; ").
:- pragma c_code(ctime(S::in) = (Ctime::out),
[will_not_call_mercury, thread_safe],
"Ctime = ((struct stat *)S)->st_ctime; ").
%------------------------------------------------------------------------------%
-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 2001 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__pipe.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__pipe.
:- interface.
:- pred pipe(posix__result({fd, fd}), io__state, io__state).
:- mode pipe(out, di, uo) is det.
%------------------------------------------------------------------------------%
:- implementation.
:- import_module int.
:- pragma c_header_code("
#include <sys/types.h>
#include <unistd.h>
").
%------------------------------------------------------------------------------%
pipe(Result) -->
pipe0(Reading, Writing, Res),
( if { Res \= 0 } then
errno(Err),
{ Result = error(Err) }
else
{ Result = ok({Reading, Writing}) }
).
:- pred pipe0(fd, fd, int, io__state, io__state).
:- mode pipe0(out, out, out, di, uo) is det.
:- pragma c_code(pipe0(R::out, W::out, Res::out, IO0::di, IO::uo),
[will_not_call_mercury], "{
int filedes[2];
Res = pipe(filedes);
R = filedes[0];
W = filedes[1];
IO = IO0;
}").
%------------------------------------------------------------------------------%
-------------- next part --------------
%------------------------------------------------------------------------------%
% Copyright (C) 2001 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__kill.m
% main author: Michael Day <miked at lendtech.com.au>
%
%------------------------------------------------------------------------------%
:- module posix__kill.
:- interface.
:- import_module int.
:- pred kill(pid, int, posix__result, io__state, io__state).
:- mode kill(in, in, out, di, uo) is det.
%------------------------------------------------------------------------------%
:- implementation.
:- pragma c_header_code("
#include <sys/types.h>
#include <signal.h>
").
%------------------------------------------------------------------------------%
kill(Pid, Sig, Result) -->
kill0(Pid, Sig, Res),
( if { Res \= 0 } then
errno(Err),
{ Result = error(Err) }
else
{ Result = ok }
).
:- pred kill0(pid, int, int, io__state, io__state).
:- mode kill0(in, in, out, di, uo) is det.
:- pragma c_code(kill0(Pid::in, Sig::in, Res::out, IO0::di, IO::uo),
[will_not_call_mercury], "{
Res = kill(Pid, Sig);
IO = IO0;
}").
%------------------------------------------------------------------------------%
More information about the reviews
mailing list