Commit 99ff1c7c82c34233fa628c5f6e7f4d6537e6d2ef

Thomas de Grivel 2024-05-08T12:58:39

portable common lisp, dropping sb-ext:truly-the and replacing sb-thread calls with bordeaux-threads api

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)