summaryrefslogtreecommitdiff
path: root/lib/thread/atomic.myr
blob: f71528f50f20a759fd51c10d0ed84d2b0062a9dd (plain)
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
use std
use "common"

pkg thread =
	trait atomic @a :: integral,numeric @a =
		xget	: (p : @a# -> @a)
		xset	: (p : @a#, v : @a -> void)
		xadd	: (p : @a#, v : @a -> @a)
		xcas	: (p : @a#, old : @a, new : @a -> @a)
		xchg	: (p : @a#, new : @a -> @a)
	;;

	impl atomic int32
	impl atomic int64
	impl atomic uint32
	impl atomic uint64

	generic xgetptr : (p : @a## -> std.option(@a#))
	generic xsetptr : (p : @a##, v : std.option(@a#) -> void)
	generic xcasptr : (p : @a##, old : std.option(@a#), new : std.option(@a#) -> std.option(@a#))
	generic xchgptr : (p : @a##, new : std.option(@a#) -> std.option(@a#))

	pkglocal extern const xget32	: (p : uint32# -> uint32)
	pkglocal extern const xget64	: (p : uint64# -> uint64)
	pkglocal extern const xgetp	: (p : std.intptr# -> std.intptr)

	pkglocal extern const xset32	: (p : uint32#, v : uint32 -> void)
	pkglocal extern const xset64	: (p : uint64#, v : uint64 -> void)
	pkglocal extern const xsetp	: (p : std.intptr#, v : std.intptr -> void)

	pkglocal extern const xadd32	: (p : uint32#, v : uint32 -> uint32)
	pkglocal extern const xadd64	: (p : uint64#, v : uint64 -> uint64)
	pkglocal extern const xaddp	: (p : std.intptr#, v : std.intptr -> std.intptr)

	pkglocal extern const xcas32	: (p : uint32#, old: uint32, new : uint32 -> uint32)
	pkglocal extern const xcas64	: (p : uint64#, old: uint64, new : uint64 -> uint64)
	pkglocal extern const xcasp	: (p : std.intptr#, old: std.intptr, new : std.intptr -> std.intptr)

	pkglocal extern const xchg32	: (p : uint32#, v : uint32 -> uint32)
	pkglocal extern const xchg64	: (p : uint64#, v : uint64 -> uint64)
	pkglocal extern const xchgp	: (p : std.intptr#, v : std.intptr -> std.intptr)
;;

impl atomic int32 =
	xget	= {p; -> (xget32((p : uint32#)) : int32)}
	xset	= {p, v; xset32((p : uint32#), (v : uint32))}
	xadd	= {p, v; -> (xadd32((p : uint32#), (v : uint32)) : int32)}
	xcas	= {p, old, new; -> (xcas32((p : uint32#), (old : uint32), (new : uint32)) : int32)}
	xchg	= {p, v; -> (xchg32((p : uint32#), (v : uint32)) : int32)}
;;


impl atomic int64 =
	xget	= {p; -> (xget64((p : uint64#)) : int64)}
	xset	= {p, v; xset64((p : uint64#), (v : uint64))}
	xadd	= {p, v; -> (xadd64((p : uint64#), (v : uint64)) : int64)}
	xcas	= {p, old, new; -> (xcas64((p : uint64#), (old : uint64), (new : uint64)) : int64)}
	xchg	= {p, v; -> (xchg64((p : uint64#), (v : uint64)) : int64)}
;;

impl atomic uint32 =
	xget	= {p; -> xget32(p)}
	xset	= {p, v; xset32(p, v)}
	xadd	= {p, v; -> xadd32(p, v)}
	xcas	= {p, old, new; -> xcas32(p, old, new)}
	xchg	= {p, v; -> xchg32(p, v)}
;;


impl atomic uint64 =
	xget	= {p; -> xget64(p)}
	xset	= {p, v; xset64(p, v)}
	xadd	= {p, v; -> xadd64(p, v)}
	xcas	= {p, old, new; -> xcas64(p, old, new)}
	xchg	= {p, v; -> xchg64(p, v)}
;;

impl atomic std.intptr =
	xget	= {p; -> xgetp(p)}
	xset	= {p, v; xsetp(p, v)}
	xadd	= {p, v; -> xaddp(p, v)}
	xcas	= {p, old, new; -> xcasp(p, old, new)}
	xchg	= {p, v; -> xchgp(p, v)}
;;

generic xgetptr = {p
	match xget((p : std.intptr#))
	| 0: -> `std.None
	| n: -> `std.Some (n : @a#)
	;;
}

generic xsetptr = {p, v
	xset((p : std.intptr#), (std.getv(v, Zptr) : std.intptr))
}

generic xcasptr = {p, old, new
	match xcas((p : std.intptr#), (std.getv(old, Zptr) : std.intptr), (std.getv(new, Zptr) : std.intptr))
	| 0: -> `std.None
	| n: -> `std.Some (n : @a#)
	;;
}

generic xchgptr = {p, new
	match xchg((p : std.intptr#), (std.getv(new, Zptr) : std.intptr))
	| 0: -> `std.None
	| n: -> `std.Some (n : @a#)
	;;
}