/usr/share/doc/ats-lang-anairiats-examples/examples/AUP/AUP_2_4_3.dats is in ats-lang-anairiats-examples 0.2.5-0ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 | //
// Author: Hongwei Xi (hwxi AT cs DOT bu DOT edu)
// Time: Summer, 2009
//
(* ****** ****** *)
// book: AUP (2nd edition), pages 80 - 85
(* ****** ****** *)
staload "libc/sys/SATS/types.sats"
staload "libc/SATS/errno.sats"
staload "libc/SATS/fcntl.sats"
staload "libc/SATS/random.sats"
staload "libc/SATS/unistd.sats"
(* ****** ****** *)
#define LOCKDIR "/tmp/"
%{^
#define LOCKDIR "/tmp/"
%} // end of [%{^]
(* ****** ****** *)
#define MAXTRIES 10
#define NAPLENGTH 2
(* ****** ****** *)
%{^
static
ats_ptr_type lockpath (ats_ptr_type name) {
static char path[100] ;
if (snprintf (path, sizeof(path), "%s%s", LOCKDIR, (char*)name) > sizeof(path))
return (char*)0;
return path ;
} // end of [lockpath]
%} // end of [%{^]
extern
fun lockpath (name: !READ(string)): Stropt = "lockpath"
(* ****** ****** *)
extern fun lock (name: !READ(string)): bool
extern fun unlock (name: !READ(string)): bool
(* ****** ****** *)
macdef errno_is_EAGAIN () = (errno_get () = EAGAIN)
macdef errno_is_EEXIST () = (errno_get () = EEXIST)
(* ****** ****** *)
implement lock (name) = let
val path = lockpath (name)
val ans = stropt_is_some (path)
in
if ans then let
val path = stropt_unsome (path)
val flag = O_WRONLY lor O_CREAT lor O_EXCL
val err = loop (path, flag, 0) where {
fun loop (
path: !READ(string), flag: flag_t, n: int
) : int(*err*) = let
val (pf_fdopt | fd) = open_flag_err (path, flag)
in
if (fd >= 0) then let
prval open_v_succ (pf_fd) = pf_fdopt
val () = close_loop_exn (pf_fd | fd)
in
0(*success*)
end else let
prval open_v_fail () = pf_fdopt
in
if errno_is_EEXIST () then
(if n >= MAXTRIES - 1 then (errno_set EAGAIN; ~1) else loop (path, flag, n+1))
else ~1(*failure*)
end (* end of [if] *)
end // end of [loop]
} // end of [val]
in
if err = 0 then true else false
end else false
end // end of [lock]
(* ****** ****** *)
implement unlock (name) = let
val path = lockpath (name)
val ans = stropt_is_some (path)
in
if ans then let
val path = stropt_unsome (path)
val err = unlink (path)
in
if err <> ~1 then true else false
end else false
end // end of [unlock]
(* ****** ****** *)
fn testlock (): void = loop (1) where {
#define N 4
#define NAME "accounts"
fun loop (i: natLte N): void = let
val status = (if lock (NAME) then let
val pid = getpid ()
val () = printf ("Process %ld acquired the lock\n", @(lint_of_pid pid))
val _leftover = sleep (randint 5 + 1); // work on the accounts
val ans = unlock (NAME)
val () = if ~ans then (prerr "Exit: [testlock] failed"; exit 1)
in
1(* succ *)
end else let
val () = if errno_is_EAGAIN () then let
val pid = getpid ()
val () = printf ("Process %ld tired of busy waiting\n", @(lint_of_pid pid))
val () = errno_reset ()
in
// nothing
end else (prerr "Exit: [testlock] failed"; exit 1)
in
0(* fail *)
end) : natLte 2 // end of [val]
val _leftover = sleep (randint 5 + 5) // work on somthing else
val i = i + status
in
if i <= N then loop (i) else ()
end // end of [loop]
} // end of [testlock]
(* ****** ****** *)
implement main () = testlock ()
(* ****** ****** *)
(* end of [AUP_2_4_3.dats] *)
|