for review: file locking

Thomas Charles CONWAY conway at cs.mu.oz.au
Tue Jul 15 14:48:48 AEST 1997
Previous message: [m-dev.] diff: mc --> mmc
Next message: [m-dev.] for review: file locking
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Hi

For whoever.

-- 
ZZ:wq!
^X^C
Thomas Conway               				      conway at cs.mu.oz.au
AD DEUM ET VINUM	  			      Every sword has two edges.


library/io.m:
	add io__lock_file and io__unlock_file which perform
	advisory locking on (open) files.

NEWS:
	mention io__lock_file and io__unlock_file.

cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.58
diff -u -r1.58 NEWS
--- NEWS	1997/07/08 16:48:05	1.58
+++ NEWS	1997/07/15 04:46:20
@@ -191,8 +191,11 @@
     lists using a user-specified procedure to write the elements and separating
     the elements with a user-specified separator string.
 
-  - We've add io__read_file/{3,4} and io__read_binary_file/{3,4} which read
+  - We've added io__read_file/{3,4} and io__read_binary_file/{3,4} which read
     whole files (until error or eof).
+
+  - We've added io__lock_file and io__unlock_file which perform advisory
+    file locking with the POSIX flock call.
 
   - We've added a double accumulator version of list__foldl/4 called
     list__foldl2/6, which is a convenient generalisation for accumulators
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
cvs diff: Diffing compiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing library
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.126
diff -u -r1.126 io.m
--- io.m	1997/06/30 06:35:39	1.126
+++ io.m	1997/07/15 04:43:20
@@ -21,7 +21,7 @@
 
 :- module io.
 :- interface.
-:- import_module char, string, std_util, list.
+:- import_module bool, char, string, std_util, list.
 
 %-----------------------------------------------------------------------------%
 
@@ -838,6 +838,41 @@
 
 %-----------------------------------------------------------------------------%
 
+% File locking predicates (using adivsory locking only)
+
+:- type lock_type
+	--->	shared
+	;	exclusive
+	.
+
+:- type block
+	--->	block
+	;	no_block
+	.
+
+:- type io__poly_stream
+	--->	i(io__input_stream)
+	;	o(io__output_stream)
+	;	bi(io__binary_input_stream)
+	;	bo(io__binary_output_stream)
+	.
+
+	% Attempt to obtain a lock on a file.
+	% A file may have multiple shared locks, but only one exclusive
+	% lock. A file may not have both a shared lock and an exclusive
+	% lock simultaneously. If the block parameter is set to `block'
+	% then execution will block until the requested lock becomes
+	% available.
+:- pred io__lock_file(io__poly_stream, lock_type, block, io__res(bool),
+		io__state, io__state).
+:- mode io__lock_file(in, in, in, out, di, uo) is det.
+
+	% Unlock a file.
+:- pred io__unlock_file(io__poly_stream, io__state, io__state).
+:- mode io__unlock_file(in, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+
 % Memory management predicates.
 
 	% Write some memory/time usage statistics to stdout.
@@ -2698,8 +2733,8 @@
 
 /*---------------------------------------------------------------------------*/
 
-io__remove_file(FileName, Result, IO, IO) :-
-	io__remove_file_2(FileName, Res, ResString),
+io__remove_file(FileName, Result, IO0, IO) :-
+	io__remove_file_2(FileName, Res, ResString, IO0, IO),
 	( Res < 0 ->
 		Result = error(ResString)
 	;
@@ -2707,13 +2742,14 @@
 	).
 
 
-:- pred io__remove_file_2(string, int, string).
-:- mode io__remove_file_2(in, out, out) is det.
+:- pred io__remove_file_2(string, int, string, io__state, io__state).
+:- mode io__remove_file_2(in, out, out, di, uo) is det.
 
 %#include <string.h>
 %#include <errno.h>
 %#include "prof.h" % for strerror
-:- pragma(c_code, io__remove_file_2(FileName::in, RetVal::out, RetStr::out), "{
+:- pragma(c_code, io__remove_file_2(FileName::in, RetVal::out, RetStr::out,
+		IO0::di, IO::uo), "{
 	Word tmp;
 	char *buf;
 
@@ -2727,7 +2763,105 @@
 	} else {
 		RetStr = NULL;
 	}
+	update_io(IO0, IO);
 }").
 
+%------------------------------------------------------------------------------%
+
+:- pragma c_header_code("
+	#include <sys/file.h>
+").
+
+io__lock_file(PolyStream, Lock, Block, Result) -->
+	{ lock_type_to_flag(Lock, LockFlag) },
+	{ block_to_flag(Block, BlockFlag) },
+	{ unwrap_poly_stream(PolyStream, Stream) },
+	io__lock_file_2(Stream, LockFlag \/ BlockFlag, Status, Errno),
+	(
+		{ Status = 0 }
+	->
+		{ Result = ok(yes) }
+	;
+		{ would_block(Errno) }
+	->
+		{ Result = ok(no) }
+	;
+		{ Result = error("locking error") }
+	).
+
+:- pred io__lock_file_2(io__stream, int, int, int, io__state, io__state).
+:- mode io__lock_file_2(in, in, out, out, di, uo) is det.
+
+:- pragma c_code(io__lock_file_2(Stream::in, Flags::in, RStat::out,
+		Errno::out, IO0::di, IO::uo), "{
+
+	MercuryFile *stream = (MercuryFile *) Stream;
+
+	RStat = flock(fileno(stream->file), Flags);
+	Errno = errno;
+
+	update_io(IO0, IO);
+}").
+
+:- pred unwrap_poly_stream(io__poly_stream, io__stream).
+:- mode unwrap_poly_stream(in, out) is det.
+
+unwrap_poly_stream(i(S), S).
+unwrap_poly_stream(o(S), S).
+unwrap_poly_stream(bi(S), S).
+unwrap_poly_stream(bo(S), S).
+
+:- pred lock_type_to_flag(lock_type, int).
+:- mode lock_type_to_flag(in, out) is det.
+
+lock_type_to_flag(shared, Shared) :-
+	lock_type_to_flag_2(0, Shared).
+lock_type_to_flag(exclusive, Exclusive) :-
+	lock_type_to_flag_2(1, Exclusive).
+
+:- pred lock_type_to_flag_2(int, int).
+:- mode lock_type_to_flag_2(in, out) is det.
+
+:- pragma c_code(lock_type_to_flag_2(I::in, F::out), "{
+	static int lock_flags[] = { LOCK_SH, LOCK_EX };
+	F = lock_flags[I];
+}").
+
+:- pred block_to_flag(block, int).
+:- mode block_to_flag(in, out) is det.
+
+block_to_flag(block, 0).
+block_to_flag(no_block, Block) :-
+	block_to_flag_2(Block).
+
+:- pred block_to_flag_2(int).
+:- mode block_to_flag_2(out) is det.
+
+:- pragma c_code(block_to_flag_2(F::out), "{
+	F = LOCK_NB;
+}").
+
+:- pred would_block(int::out) is det.
+
+:- pragma c_code(would_block(I::out), "I = EWOULDBLOCK;").
+
+%------------------------------------------------------------------------------%
+
+io__unlock_file(PolyStream) -->
+	{ unwrap_poly_stream(PolyStream, Stream) },
+	io__unlock_file_2(Stream).
+
+:- pred io__unlock_file_2(io__stream, io__state, io__state).
+:- mode io__unlock_file_2(in, di, uo) is det.
+
+:- pragma c_code(io__unlock_file_2(Stream::in, IO0::di, IO::uo), "{
+
+	MercuryFile *stream = (MercuryFile *) Stream;
+
+	flock(fileno(stream->file), LOCK_UN);
+
+	update_io(IO0, IO);
+}").
+
+%------------------------------------------------------------------------------%
 
-/*---------------------------------------------------------------------------*/
Index: library/string.nu.nl
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/string.nu.nl,v
retrieving revision 1.15
diff -u -r1.15 string.nu.nl
--- string.nu.nl	1997/07/14 03:38:15	1.15
+++ string.nu.nl	1997/07/14 22:01:39
@@ -84,3 +84,8 @@
 	list__member(CharCode, List).
 
 %-----------------------------------------------------------------------------%
+
+string__unsafe_index(String, Index, Char) :-
+	string__index(String, Index, Char).
+
+%-----------------------------------------------------------------------------%
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing runtime
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/diff
cvs diff: Diffing scripts
cvs diff: Diffing tools
cvs diff: Diffing trial
cvs diff: Diffing util
Previous message: [m-dev.] diff: mc --> mmc
Next message: [m-dev.] for review: file locking
Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
More information about the developers mailing list