Initial files

Makefile

@@ -0,0 +1,23 @@
+PROGS = sum-no-sync \
+        sum-mutex \
+        sum-spin-lock \
+        sum-atomic-fxbox \
+        sum-atomic-box 
+
+SCMFILES = $(addsuffix .scm, $(PROGS))
+CFILES = $(addsuffix .c, $(PROGS))
+
+all: srfi/230.o $(PROGS)
+
+$(PROGS): %: %.scm
+	cyclone $<
+	./$@
+
+srfi/230.o: srfi/230.sld
+	cyclone srfi/230.sld
+
+test: all test.scm
+	cyclone test.scm && ./test
+
+clean: 
+	rm -f $(PROGS) srfi/230.o srfi/230.c srfi/230.so *.meta *.o

examples/sum-atomic-box.scm

@@ -0,0 +1,31 @@
+(import (scheme base)
+	(scheme write)
+	(srfi 18)
+	(srfi 230))
+
+(define *atomic-counter* (make-atomic-box 0.0))
+
+(define (task)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    ;(atomic-fxbox+/fetch! *atomic-counter* 1)
+    (let loop ()
+      (let ((expected (atomic-box-ref *atomic-counter*)))
+        (if (not (eq? expected (atomic-box-compare-and-swap! *atomic-counter* expected (+ expected 1))))
+            (loop))))
+    ))
+
+(define threads (make-vector 10))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (let ((thread (make-thread task)))
+    (vector-set! threads i thread)
+    (thread-start! thread)))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (thread-join! (vector-ref threads i)))
+
+(display (atomic-box-ref *atomic-counter*))
+(newline)

examples/sum-atomic-fxbox.scm

@@ -0,0 +1,31 @@
+(import (scheme base)
+	(scheme write)
+	(srfi 18)
+	(srfi 230))
+
+(define *atomic-counter* (make-atomic-fxbox 0))
+
+(define (task)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    ;(atomic-fxbox+/fetch! *atomic-counter* 1)
+    (let loop ()
+      (let ((expected (atomic-fxbox-ref *atomic-counter*)))
+        (if (not (eq? expected (atomic-fxbox-compare-and-swap! *atomic-counter* expected (+ expected 1))))
+            (loop))))
+    ))
+
+(define threads (make-vector 10))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (let ((thread (make-thread task)))
+    (vector-set! threads i thread)
+    (thread-start! thread)))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (thread-join! (vector-ref threads i)))
+
+(display (atomic-fxbox-ref *atomic-counter*))
+(newline)

examples/sum-mutex.scm

@@ -0,0 +1,29 @@
+(import (scheme base)
+	(scheme write)
+	(srfi 18)
+	(srfi 230))
+
+(define *lock* (make-mutex))
+(define *counter* 0)
+
+(define (task)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (mutex-lock! *lock*)
+    (set! *counter* (+ *counter* 1))
+    (mutex-unlock! *lock*)))
+
+(define threads (make-vector 10))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (let ((thread (make-thread task)))
+    (vector-set! threads i thread)
+    (thread-start! thread)))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (thread-join! (vector-ref threads i)))
+
+(display *counter*)
+(newline)

examples/sum-no-sync.scm

@@ -0,0 +1,26 @@
+(import (scheme base)
+	(scheme write)
+	(srfi 18)
+	(srfi 230))
+
+(define *counter* 0)
+
+(define (task)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (set! *counter* (+ *counter* 1))))
+
+(define threads (make-vector 10))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (let ((thread (make-thread task)))
+    (vector-set! threads i thread)
+    (thread-start! thread)))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (thread-join! (vector-ref threads i)))
+
+(display *counter*)
+(newline)

examples/sum-spin-lock.scm

@@ -0,0 +1,37 @@
+(import (scheme base)
+	(scheme write)
+	(srfi 18)
+	(srfi 230))
+
+(define *flag* (make-atomic-flag))
+(define *counter* 0)
+
+(define (spin-lock flag)
+  (let loop ()
+    (if (atomic-flag-test-and-set! flag)
+        (loop))))
+
+(define (spin-unlock flag)
+  (atomic-flag-clear! flag))
+
+(define (task)
+  (do ((i 0 (+ i 1)))
+      ((= i 100000))
+    (spin-lock *flag*)
+    (set! *counter* (+ *counter* 1))
+    (spin-unlock *flag*) ))
+
+(define threads (make-vector 10))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (let ((thread (make-thread task)))
+    (vector-set! threads i thread)
+    (thread-start! thread)))
+
+(do ((i 0 (+ i 1)))
+    ((= i 10))
+  (thread-join! (vector-ref threads i)))
+
+(display *counter*)
+(newline)

package.scm

@@ -0,0 +1,15 @@
+(package
+ (name           srfi-230)
+ (version        0.1)
+ (license        "MIT")
+ (authors        "Justin Ethier")
+ (maintainers    "Justin Ethier <justin.ethier at gmail dot com>")
+ (description    "Atomic Operations")
+ (tags           "srfi")
+ (docs           "https://github.com/cyclone-scheme/cyclone-winds/wiki/srfi-230")
+ (test           "test.scm")
+
+ (library
+     (name (srfi 230))
+   (description "Atomic Operations")))
+