portable common lisp, dropping sb-ext:truly-the and replacing sb-thread calls with bordeaux-threads api
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
diff --git a/facts.asd b/facts.asd
index 121d557..6aad2ae 100644
--- a/facts.asd
+++ b/facts.asd
@@ -21,7 +21,7 @@
:author "Thomas de Grivel <thoxdg@gmail.com>"
:version "0.2"
:description "in-memory graph database"
- :depends-on ("compare" "local-time" "rollback")
+ :depends-on ("bordeaux-threads" "compare" "local-time" "rollback")
:components
((:file "package")
(:file "fact" :depends-on ("package"))
diff --git a/skip-list.lisp b/skip-list.lisp
index 3c27f59..78ebc8e 100644
--- a/skip-list.lisp
+++ b/skip-list.lisp
@@ -97,7 +97,7 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
(declare (type fixnum spacing max-level)
(optimize speed))
(assert (= 2 spacing))
- (do ((level 1 (sb-ext:truly-the fixnum (1+ level))))
+ (do ((level 1 (the fixnum (1+ level))))
((or (= level max-level)
(= (random 4) 3)) ;;
level)
@@ -168,7 +168,7 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
(optimize (speed 3)))
(let* ((u spacing)
(k (the positive-fixnum (random (expt u max-height)))))
- (do ((uʳ 1 (sb-ext:truly-the positive-fixnum (* u uʳ)))
+ (do ((uʳ 1 (the positive-fixnum (* u uʳ)))
(r 0 (1+ r)))
((< k uʳ)
(the fixnum (1+ (mod (- max-height r) max-height))))
diff --git a/transaction.lisp b/transaction.lisp
index c5aacc5..5c08356 100644
--- a/transaction.lisp
+++ b/transaction.lisp
@@ -20,7 +20,7 @@
(defvar *db-path-defaults* (make-pathname :type "facts"))
(defvar *db-log-path-defaults* (make-pathname :type "facts-log"))
(defvar *transaction-vars* nil)
-(defvar *transaction-mutex* (sb-thread:make-mutex :name "transaction-mutex"))
+(defvar *transaction-lock* (bordeaux-threads:make-lock))
(defun transaction-var (value name)
(let ((cell (rassoc name *transaction-vars* :test #'eq)))
@@ -70,22 +70,21 @@
(dolist (operation (transaction-log tx))
(apply #'rollback operation)))
-(defmacro with-mutex ((mutex timeout) &body body)
+(defmacro with-mutex ((mutex) &body body)
(let ((g!mutex (gensym "MUTEX-"))
(g!result (gensym "RESULT-")))
`(let ((,g!mutex ,mutex)
,g!result)
- (if (sb-thread:with-mutex (,g!mutex :wait-p t)
+ (if (bordeaux-threads:with-lock-held (,g!mutex)
(setf ,g!result (progn ,@body))
t)
,g!result
- (error "Could not acquire ~S for ~D seconds."
- ,g!mutex ,timeout)))))
+ (error "Could not acquire ~S." ,g!mutex)))))
(defmacro with-transaction (&body body)
`(if *transaction*
(progn ,@body)
- (with-mutex (*transaction-mutex* 1)
+ (with-mutex (*transaction-mutex*)
(let ((*transaction* (make-transaction)))
(unwind-protect (prog1 (progn ,@body)
(commit-transaction *transaction*))
diff --git a/usl.lisp b/usl.lisp
index 940f2ea..50b41de 100644
--- a/usl.lisp
+++ b/usl.lisp
@@ -129,7 +129,7 @@ L1: 50%, L2: 25%, L3: 12.5%, ..."
(optimize speed))
(assert (= 2 spacing))
(lambda ()
- (do ((level 1 (sb-ext:truly-the fixnum (1+ level))))
+ (do ((level 1 (the fixnum (1+ level))))
((or (= level max-level)
(= (random 4) 3)) ;;
level)