ref: 10a209f1937d161e1ff5409deb06253facff73a6
author: Ori Bernstein <ori@eigenstate.org>
date: Thu Aug 27 19:53:41 EDT 2015
Start of libthread for linux.
--- /dev/null
+++ b/lib/thread/atomic-impl+x64.s
@@ -1,0 +1,44 @@
+.globl thread$xget32
+thread$xget32:
+ movl (%rdi), %eax
+ ret
+.globl thread$xget64
+thread$xget64:
+ movq (%rdi), %rax
+ ret
+.globl thread$xset32
+thread$xset32:
+ movl %esi, (%rdi)
+ ret
+.globl thread$xset64
+thread$xset64:
+ movq %rsi, (%rdi)
+ ret
+.globl thread$xadd32
+thread$xadd32:
+ lock xaddl %esi, (%rdi)
+ ret
+.globl thread$xadd64
+thread$xadd64:
+ lock xaddq %rsi, (%rdi)
+ ret
+.globl thread$xsub32
+thread$xsub32:
+ lock xaddl %esi, (%rdi)
+ ret
+.globl thread$xsub64
+thread$xsub64:
+ lock xaddq %rsi, (%rdi)
+ ret
+.globl thread$xcas32
+thread$xcas32:
+ movl %esi, %eax
+ lock cmpxchgl %edx, (%rdi)
+ sete %al
+ ret
+.globl thread$xcas64
+thread$xcas64:
+ movq %rsi, %rax
+ lock cmpxchgq %rdx, (%rdi)
+ sete %al
+ ret
--- /dev/null
+++ b/lib/thread/atomic.myr
@@ -1,0 +1,65 @@
+use std
+
+pkg thread =
+ trait atomic @a::(integral,numeric) =
+ xget : (p : @a# -> @a)
+ xset : (p : @a#, v : @a -> void)
+ xadd : (p : @a#, v : @a -> @a)
+ xsub : (p : @a#, v : @a -> @a)
+ xcas : (p : @a#, old : @a, new : @a -> bool)
+ ;;
+
+ impl atomic int32
+ impl atomic int64
+ impl atomic uint32
+ impl atomic uint64
+;;
+
+impl atomic int32 =
+ xget = {p; -> xget32(p castto(uint32#)) castto(int32)}+ xset = {p, v; xset32(p castto(uint32#), v castto(uint32))}+ xadd = {p, v; -> xadd32(p castto(uint32#), v castto(uint32)) castto(int32)}+ xsub = {p, v; -> xsub32(p castto(uint32#), v castto(uint32)) castto(int32)}+ xcas = {p, old, new; -> xcas32(p castto(uint32#), old castto(uint32), new castto(uint32))}+;;
+
+
+impl atomic int64 =
+ xget = {p; -> xget64(p castto(uint64#)) castto(int64)}+ xset = {p, v; xset64(p castto(uint64#), v castto(uint64))}+ xadd = {p, v; -> xadd64(p castto(uint64#), v castto(uint64)) castto(int64)}+ xsub = {p, v; -> xsub64(p castto(uint64#), v castto(uint64)) castto(int64)}+ xcas = {p, old, new; -> xcas64(p castto(uint64#), old castto(uint64), new castto(uint64))}+;;
+
+impl atomic uint32 =
+ xget = {p; -> xget32(p)}+ xset = {p, v; xset32(p, v)}+ xadd = {p, v; -> xadd32(p, v)}+ xsub = {p, v; -> xsub32(p, v)}+ xcas = {p, old, new; -> xcas32(p, old, new)}+;;
+
+
+impl atomic uint64 =
+ xget = {p; -> xget64(p)}+ xset = {p, v; xset64(p, v)}+ xadd = {p, v; -> xadd64(p, v)}+ xsub = {p, v; -> xsub64(p, v)}+ xcas = {p, old, new; -> xcas64(p, old, new)}+;;
+
+extern const xget32 : (p : uint32# -> uint32)
+extern const xget64 : (p : uint64# -> uint64)
+
+extern const xset32 : (p : uint32#, v : uint32 -> void)
+extern const xset64 : (p : uint64#, v : uint64 -> void)
+
+extern const xadd32 : (p : uint32#, v : uint32 -> uint32)
+extern const xadd64 : (p : uint64#, v : uint64 -> uint64)
+
+extern const xsub32 : (p : uint32#, v : uint32 -> uint32)
+extern const xsub64 : (p : uint64#, v : uint64 -> uint64)
+
+extern const xcas32 : (p : uint32#, old: uint32, new : uint32 -> bool)
+extern const xcas64 : (p : uint64#, old: uint64, new : uint64 -> bool)
--- /dev/null
+++ b/lib/thread/bld.proj
@@ -1,0 +1,10 @@
+lib thread =
+ spawn+linux.myr
+ clone+linux-x64.s
+ atomic-impl+x64.s
+ atomic.myr
+;;
+
+test smoketest =
+ smoketest.myr
+;;
--- /dev/null
+++ b/lib/thread/clone+linux-x64.s
@@ -1,0 +1,27 @@
+.globl thread$clone
+thread$clone:
+ pushq %r15
+ movq 16(%rsp),%r15
+ /* clone(flags, stack, ptid, tls, ctid, regs) */
+ movq $56,%rax /* syscall num */
+ /* %rdi: flags */
+ /* %rsi: stack */
+ /* %rdx: ptid */
+ movq %rcx,%r10 /* tls */
+ /* %r8: ctid */
+ /* %r9: regs */
+ syscall
+
+ /* fn() */
+ testl %eax,%eax
+ jnz parent
+ call *%r15
+
+ /* exit(0) */
+ movq $60, %rax /* exit */
+ movq $0, %rdi /* arg: 0 */
+ syscall
+
+parent:
+ popq %r15
+ ret
--- /dev/null
+++ b/lib/thread/smoketest.myr
@@ -1,0 +1,33 @@
+use std
+use sys
+use thread
+
+var val : uint64 = 0
+var done : uint32 = 0
+
+const setvar = {+ var i
+
+ for i = 0; i < 10_000_000; i++
+ thread.xadd(&val, 1)
+ ;;
+ std.write(1, "done\n")
+ thread.xset(&done, 1)
+}
+
+const main = {+ var i
+
+ match thread.spawn(setvar)
+ | `std.Ok tid:
+ for i = 0; i < 100_000; i++
+ thread.xadd(&val, 1)
+ ;;
+ while thread.xget(&done) == 0
+ /* nothing */
+ ;;
+ std.assert(val == 10_100_000, "atomics are broken")
+ | `std.Fail err:
+ std.fatal("errno = {}\n", err)+ ;;
+}
--- /dev/null
+++ b/lib/thread/spawn+linux.myr
@@ -1,0 +1,56 @@
+use sys
+use std
+
+pkg thread =
+ type tid = sys.pid
+
+ const spawn : (fn : (-> void) -> std.result(tid, byte[:]))
+;;
+
+extern const clone : ( flags : sys.cloneopt, \
+ stk : byte#, \
+ ptid : sys.pid#, \
+ tls : byte#, \
+ ctid : sys.pid#, \
+ ptreg : byte#, \
+ fn : (-> void) \
+ -> sys.pid)
+/* Holy shit flag mania. */
+const Thrflag = sys.Clonevm | sys.Clonefs | sys.Clonefiles | \
+ sys.Clonesighand | sys.Clonethread |sys.Clonesysvsem | \
+ sys.Clonesettls | sys.Cloneparentsettid | sys.Clonechildcleartid
+
+const Stacksz = 8*std.MiB
+
+const spawn = {fn+ -> spawnstk(fn, Stacksz)
+}
+
+const spawnstk = {fn, sz+ var stk, tid, ctid, ret
+
+ stk = getstk(sz)
+ if stk == sys.Mapbad
+ -> `std.Fail "couldn't get stack"
+ ;;
+
+ ret = clone(Thrflag, stk, &tid, 0 castto(byte#), &ctid, 0 castto(byte#), fn) castto(tid)
+ if ret < 0
+ std.put("errno={}\n", -ret)+ -> `std.Fail "couldn't spawn thread"
+ ;;
+ -> `std.Ok ret
+}
+
+const getstk = {sz+ var p, m
+
+ p = sys.mmap(0 castto(byte#), sz, sys.Mprotrw, sys.Mpriv | sys.Manon, -1, 0)
+ if p == sys.Mapbad
+ -> p
+ ;;
+ /* stack starts at the top of memory and grows down. */
+ m = p castto(std.intptr)
+ m += sz castto(std.intptr)
+ -> m castto(byte#)
+}