summaryrefslogtreecommitdiff
path: root/lib/thread/atomic.myr
blob: 04a103d7eac844f9f05625487dafa8f9f082fc14 (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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
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 bool
	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 xget8	: (p : uint8# -> uint8)
	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 xset8	: (p : uint8#, v : uint8 -> void)
	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 xadd8	: (p : uint8#, v : uint8 -> uint8)
	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 xcas8	: (p : uint8#, old: uint8, new : uint8 -> uint8)
	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 xchg8	: (p : uint8#, v : uint8 -> uint8)
	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 bool =
	xget	= {p; -> (xget8((p : uint8#)) : bool)}
	xset	= {p, v; xset8((p : uint8#), (v : uint8))}
	xadd	= {p, v; -> (xadd8((p : uint8#), (v : uint8)) : bool)}
	xcas	= {p, old, new; -> (xcas8((p : uint8#), (old : uint8), (new : uint8)) : bool)}
	xchg	= {p, v; -> (xchg8((p : uint8#), (v : uint8)) : bool)}
;;

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#)
	;;
}