1.1--- a/lisp/ffi/rocksdb/compaction.lisp Tue Aug 13 22:05:23 2024 -0400
1.2+++ b/lisp/ffi/rocksdb/compaction.lisp Wed Aug 14 21:49:56 2024 -0400
1.3@@ -4,11 +4,6 @@
1.4
1.5 ;;; Code:
1.6 (in-package :rocksdb)
1.7-;; (define-alien-routine rocksdb-compactionfilter-create (* rocksdb-compactionfilter)
1.8-;; (state (* void))
1.9-;; (destructor (* void))
1.10-;; (filter (* unsigned-char))
1.11-;; (name (* unsigned-char)))
1.12
1.13 (define-alien-routine rocksdb-compactionfilter-set-ignore-snapshots void
1.14 (self (* rocksdb-compactionfilter)) (val unsigned-char))
1.15@@ -27,3 +22,19 @@
1.16 rocksdb-compactionfiltercontext-is-full-compaction rocksdb-compactionfiltercontext-is-manual-compaction))
1.17
1.18 ;;; Compaction Filter Factory
1.19+(define-alien-routine rocksdb-compactionfilter-create (* rocksdb-compactionfilter)
1.20+ (state (* t))
1.21+ (destructor (* t))
1.22+ (create-compaction-filter (* unsigned-char))
1.23+ (context (* rocksdb-compactionfiltercontext)))
1.24+
1.25+(define-alien-routine rocksdb-compacitonfilter-destroy void
1.26+ (factory (* rocksdb-compactionfilterfactory)))
1.27+
1.28+(export '(rocksdb-compactionfilter-create rocksdb-compactionfilter-destroy))
1.29+
1.30+(define-alien-callable rocksdb-create-compaction-filter (* rocksdb-compactionfilter)
1.31+ ((state (* t))
1.32+ (context (* rocksdb-compactionfiltercontext)))
1.33+ (declare (ignore state context))
1.34+ nil)
2.1--- a/lisp/ffi/rocksdb/comparator.lisp Tue Aug 13 22:05:23 2024 -0400
2.2+++ b/lisp/ffi/rocksdb/comparator.lisp Wed Aug 14 21:49:56 2024 -0400
2.3@@ -1,11 +1,36 @@
2.4 ;;; rocksdb/comparator.lisp --- RocksDB Comparators
2.5
2.6-;;
2.7+;; RocksDB Lisp Comparator API
2.8
2.9 ;;; Code:
2.10 (in-package :rocksdb)
2.11
2.12-;; TODO 2023-12-11:
2.13+(define-alien-type rocksdb-compare-function
2.14+ (function int
2.15+ (* t)
2.16+ c-string
2.17+ size-t
2.18+ c-string
2.19+ size-t))
2.20+
2.21+(define-alien-type rocksdb-compare-ts-function
2.22+ (function int
2.23+ (* t)
2.24+ c-string
2.25+ size-t
2.26+ c-string
2.27+ size-t))
2.28+
2.29+(define-alien-type rocksdb-compare-without-ts-function
2.30+ (function int
2.31+ (* t)
2.32+ c-string
2.33+ size-t
2.34+ unsigned-char
2.35+ c-string
2.36+ size-t
2.37+ unsigned-char))
2.38+
2.39 (define-alien-routine rocksdb-comparator-create (* rocksdb-comparator)
2.40 (state (* t))
2.41 (destructor (* t))
3.1--- a/lisp/ffi/rocksdb/merge.lisp Tue Aug 13 22:05:23 2024 -0400
3.2+++ b/lisp/ffi/rocksdb/merge.lisp Wed Aug 14 21:49:56 2024 -0400
3.3@@ -1,10 +1,40 @@
3.4 ;;; rocksdb/merge.lisp --- RocksDB Merge Operators
3.5
3.6-;;
3.7+;; RocksDB Lisp Merge Operator API
3.8+
3.9+;;; Commentary:
3.10+
3.11+;; When to use built-in ROCKSDB-MERGE:
3.12+
3.13+;; - You have data that needs to be incrementally updated.
3.14+
3.15+;; - You would usually need to read the data before knowing what the new value would be.
3.16+
3.17+;; Oterwise as far as the FFI is concerned - which doesn't support
3.18+;; AssociateMerge, you should use the Generic Merge API.
3.19+
3.20+;; When to use Associative Merge (unavailable in C/LISP API):
3.21+
3.22+;; - merge operands are formatted the same as Put values AND
3.23+
3.24+;; - it is okay to combine multiple operands into one
3.25+
3.26+;; When to use Generic Merge (this API):
3.27+
3.28+;; - you are unable to use Associate Merge
3.29+
3.30+;; - it is possible to combine multiple operands
3.31+
3.32+;;; Refs:
3.33+
3.34+;; impl: https://github.com/facebook/rocksdb/wiki/Merge-Operator-Implementation
3.35+
3.36+;; wiki: https://github.com/facebook/rocksdb/wiki/merge-operator
3.37
3.38 ;;; Code:
3.39 (in-package :rocksdb)
3.40
3.41+;; FullMerge() is used when a Put/Delete is the *existing_value (or null)
3.42 (define-alien-type rocksdb-full-merge-function
3.43 (function (* t)
3.44 (array unsigned-char)
3.45@@ -14,7 +44,7 @@
3.46 int
3.47 (array unsigned-char)
3.48 (* size-t)))
3.49-
3.50+;; PartialMerge() is used to combine two-merge operands (if possible)
3.51 (define-alien-type rocksdb-partial-merge-function
3.52 (function (* t)
3.53 (array unsigned-char)
3.54@@ -31,7 +61,7 @@
3.55 size-t))
3.56
3.57 (define-alien-type rocksdb-destructor-function
3.58- (function (* t)))
3.59+ (function void (* t)))
3.60
3.61 (define-alien-type rocksdb-name-function
3.62 (function c-string))
3.63@@ -40,7 +70,6 @@
3.64
3.65 ;; (sb-alien::define-alien-callable mangle int () 0)
3.66
3.67-;; (sb-alien::alien-callback
3.68 (define-alien-routine rocksdb-mergeoperator-create (* rocksdb-mergeoperator)
3.69 (state (* t))
3.70 (destructor (* rocksdb-destructor-function))
3.71@@ -61,17 +90,37 @@
3.72 (deftype rocksdb-mergeoperator-function ()
3.73 '(function (octet-vector (or octet-vector null) &rest t) (or null octet-vector)))
3.74
3.75+(define-alien-callable rocksdb-delete-value (* t)
3.76+ ((val (array unsigned-char))
3.77+ (vlen size-t))
3.78+ (declare (ignore val vlen))
3.79+ nil)
3.80+
3.81+(define-alien-callable rocksdb-destructor void ((self (* t)))
3.82+ (free-alien self))
3.83+
3.84+(define-alien-callable rocksdb-name c-string () (make-alien-string (symbol-name (gensym "rocksdb:"))))
3.85+
3.86 (define-alien-callable rocksdb-concat-full-merge (* t)
3.87- ((key (array unsigned-char)) (klen size-t)
3.88- (existing-val (array unsigned-char)) (existing-vlen size-t)
3.89- (ops (array (array unsigned-char))) (ops-length (* size-t)) (num-ops size-t)
3.90+ ((key (array unsigned-char))
3.91+ (klen size-t)
3.92+ (existing-val (array unsigned-char))
3.93+ (existing-vlen size-t)
3.94+ (ops (array (array unsigned-char)))
3.95+ (ops-length (* size-t))
3.96+ (num-ops size-t)
3.97 (success (array unsigned-char))
3.98 (new-vlen (* size-t)))
3.99+ (log:debug! (list key klen existing-val existing-vlen ops ops-length num-ops success new-vlen))
3.100 nil)
3.101
3.102 (define-alien-callable rocksdb-concat-partial-merge (* t)
3.103- ((key (array unsigned-char)) (klen size-t)
3.104- (ops (array (array unsigned-char))) (ops-length (* size-t)) (num-ops size-t)
3.105+ ((key (array unsigned-char))
3.106+ (klen size-t)
3.107+ (ops (array (array unsigned-char)))
3.108+ (ops-length (* size-t))
3.109+ (num-ops size-t)
3.110 (success (array unsigned-char))
3.111 (new-vlen (* size-t)))
3.112+ (log:debug! (list key klen ops ops-length num-ops success new-vlen))
3.113 nil)
4.1--- a/lisp/ffi/rocksdb/rocksdb.asd Tue Aug 13 22:05:23 2024 -0400
4.2+++ b/lisp/ffi/rocksdb/rocksdb.asd Wed Aug 14 21:49:56 2024 -0400
4.3@@ -18,9 +18,9 @@
4.4 (:file "slice")
4.5 (:file "db")
4.6 (:file "metadata")
4.7+ (:file "merge")
4.8 (:file "compaction")
4.9 (:file "comparator")
4.10- (:file "merge")
4.11 (:file "stats")
4.12 (:file "vars"))
4.13 :in-order-to ((test-op (test-op "rocksdb/tests"))))
5.1--- a/lisp/ffi/uring/uring.asd Tue Aug 13 22:05:23 2024 -0400
5.2+++ b/lisp/ffi/uring/uring.asd Wed Aug 14 21:49:56 2024 -0400
5.3@@ -16,8 +16,8 @@
5.4 (:file "util")
5.5 (:file "macs")
5.6 (:file "alien")
5.7+ (:file "opcode")
5.8 (:file "prim")
5.9- (:file "opcode")
5.10 (:file "register")
5.11 (:file "submit")
5.12 (:file "sq")
6.1--- a/lisp/ffi/uring/uring.lisp Tue Aug 13 22:05:23 2024 -0400
6.2+++ b/lisp/ffi/uring/uring.lisp Wed Aug 14 21:49:56 2024 -0400
6.3@@ -85,6 +85,8 @@
6.4 ;; res)))
6.5
6.6 ;; io-uring instance
6.7+(defvar *default-io-params* (make-io-params))
6.8+
6.9 (defstruct uring
6.10 (sq nil :type submission-queue)
6.11 (cq nil :type completion-queue)
6.12@@ -92,8 +94,6 @@
6.13 (params *default-io-params* :type io-params)
6.14 (memory nil :type io-memory-map))
6.15
6.16-(defvar *default-io-params* (make-io-params))
6.17-
6.18 (defstruct uring-builder
6.19 (params *default-io-params* :type io-params)
6.20 (dontfork nil :type boolean))
7.1--- a/lisp/lib/dat/pkg.lisp Tue Aug 13 22:05:23 2024 -0400
7.2+++ b/lisp/lib/dat/pkg.lisp Wed Aug 14 21:49:56 2024 -0400
7.3@@ -16,7 +16,8 @@
7.4 (:export
7.5 :sxp-fmt-designator
7.6 :form :formp :sxp-error :sxp-syntax-error :reader :writer :fmt
7.7- :wrap :wrap! :wrap-from-string! :unwrap :unwrap! :unwrap-or
7.8+ :wrap :unwrap
7.9+ :unwrap-or
7.10 :sxpp :build-ast :load-ast :load-ast*
7.11 :ast
7.12 :define-macro :define-fmt :read-sxp-file :write-sxp-file
8.1--- a/lisp/lib/dat/sxp.lisp Tue Aug 13 22:05:23 2024 -0400
8.2+++ b/lisp/lib/dat/sxp.lisp Wed Aug 14 21:49:56 2024 -0400
8.3@@ -18,10 +18,7 @@
8.4
8.5 ;;; Protocol
8.6 (defgeneric wrap (self form))
8.7-(defgeneric wrap! (self form))
8.8-(defgeneric wrap-from-string! (self str))
8.9 (defgeneric unwrap (self))
8.10-(defgeneric unwrap! (self))
8.11 (defgeneric unwrap-or (self lambda))
8.12 (defgeneric sxpp (self form))
8.13
8.14@@ -43,16 +40,10 @@
8.15 ((ast :initarg :ast :type form :accessor ast))
8.16 (:documentation "Dynamic class representing a SXP form."))
8.17
8.18-(defmethod wrap! ((self sxp) form) (setf (slot-value self 'ast) (ignore-errors form)))
8.19-
8.20-(defmethod wrap-from-string! ((self sxp) str) (setf (slot-value self 'ast) (ignore-errors (read str))))
8.21-
8.22 (defmethod wrap ((self sxp) form) (setf (slot-value self 'ast) form))
8.23
8.24 (defmethod unwrap ((self sxp)) (slot-value self 'ast))
8.25
8.26-(defmethod unwrap! ((self sxp)) (ignore-errors (slot-value self 'ast)))
8.27-
8.28 (defmethod unwrap-or ((self sxp) (else-fn function))
8.29 (if (slot-unbound 'sxp self 'ast)
8.30 (slot-value self 'ast)
9.1--- a/lisp/lib/organ/object/timestamp.lisp Tue Aug 13 22:05:23 2024 -0400
9.2+++ b/lisp/lib/organ/object/timestamp.lisp Wed Aug 14 21:49:56 2024 -0400
9.3@@ -22,28 +22,6 @@
9.4 ;;; Code:
9.5 (in-package :organ)
9.6
9.7-(defvar *org-duration-hmm-rx* (create-scanner "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{1,2\\}[ \t]*\\'")
9.8- "Regexp matching a duration expressed with H:MM or H:MM:SS format.
9.9-See *org-duration-hmmss-rx* to only match the latter. Hours
9.10-can use any number of digits.")
9.11-
9.12-(defvar *org-duration-hmmss-rx* (create-scanner "\\`[ \t]*[0-9]+\\(?::[0-9]\\{2\\}\\)\\{2\\}[ \t]*\\'")
9.13- "Regexp matching a duration expressed H:MM:SS format.
9.14-See *org-duration-hmm-rx* to also support H:MM format. Hours
9.15-can use any number of digits.")
9.16-
9.17-(defvar *org-duration-full-rx*
9.18- (create-scanner "\\`\\(?:[ ]*\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ ]*\\(min\\|[dhmwy]\\)\\)+[ ]*\\'")
9.19- "Regexp matching a duration expressed with units.")
9.20-
9.21-(defvar *org-duration-mixed-rx*
9.22- (create-scanner "\\`\\(?1:\\([ ]*\\([0-9]+\\(?:\\.[0-9]*\\)?\\)[ ]*\\(min\\|[dhmwy]\\)\\)+\\)[ ]*\\(?2:[0-9]+\\(?::[0-9][0-9]\\)\\{1,2\\}\\)[ ]*\\'")
9.23- "Regexp matching a duration with units and H:MM or H:MM:SS format.")
9.24-
9.25-(defvar *org-duration-units*
9.26- '(("min" . 1) ("h" . 60) ("d" . 1440) ("w" . 10080) ("m" . 43200)
9.27- ("y" . 525960.0)))
9.28-
9.29 (define-org-object active-timestamp (date time mod))
9.30 (define-org-object active-timestamp-range (ts1 ts2))
9.31 (define-org-object inactive-timestamp (date time mod))
10.1Binary file lisp/lib/organ/vars.lisp has changed
11.1--- a/lisp/lib/skel/comp/makefile.lisp Tue Aug 13 22:05:23 2024 -0400
11.2+++ b/lisp/lib/skel/comp/makefile.lisp Wed Aug 14 21:49:56 2024 -0400
11.3@@ -96,7 +96,7 @@
11.4 :description (sk-description self)
11.5 :opts '("mode: makefile-gmake;"))
11.6 out))
11.7- (sk-compile self out)))
11.8+ (sk-compile self :stream out)))
11.9
11.10 (defmethod sk-read-file ((self makefile) path)
11.11 (with-open-file (in path :direction :input)))
12.1--- a/lisp/lib/skel/core/obj.lisp Tue Aug 13 22:05:23 2024 -0400
12.2+++ b/lisp/lib/skel/core/obj.lisp Wed Aug 14 21:49:56 2024 -0400
12.3@@ -507,7 +507,7 @@
12.4 (invalid-skel-ast ast))))
12.5
12.6 ;; obj -> ast
12.7-(defmethod build-ast ((self sk-project) &key (nullp nil) (exclude '(ast id)))
12.8+(defmethod build-ast ((self sk-project) &key (nullp nil) (exclude '(ast id phases)))
12.9 (setf (ast self)
12.10 (unwrap-object self
12.11 :slots t
13.1--- a/lisp/lib/skel/core/vm.lisp Tue Aug 13 22:05:23 2024 -0400
13.2+++ b/lisp/lib/skel/core/vm.lisp Wed Aug 14 21:49:56 2024 -0400
13.3@@ -10,6 +10,7 @@
13.4 (defvar *skel-op-types*
13.5 (vector :nil :eval :set :get :end :jump :pop :spawn :wait :print :let))
13.6 (defvar *skel-arena-size* (ash 1 16))
13.7+ (defvar *skel-stack-size* 128)
13.8 (defun new-skel-arena () (sb-vm:new-arena *skel-arena-size*))
13.9 (defun init-skel-scope (&optional (map (sb-lockless:make-so-map/fixnum)))
13.10 (sb-lockless:so-insert map 0)
13.11@@ -29,8 +30,6 @@
13.12
13.13 (defvar *skel-arena* (new-skel-arena))
13.14
13.15-(defvar *skel-stack-size* 128)
13.16-
13.17 (deftype skel-op-type () `(member ,@(coerce *skel-op-types* 'list)))
13.18
13.19 (defstruct skel-op
14.1--- a/lisp/lib/skel/tests.lisp Tue Aug 13 22:05:23 2024 -0400
14.2+++ b/lisp/lib/skel/tests.lisp Wed Aug 14 21:49:56 2024 -0400
14.3@@ -46,7 +46,8 @@
14.4 "Ensure skelfiles are created and loaded correctly and that they signal
14.5 the appropriate restarts."
14.6 (do-tmp-path (tmp-path "sk")
14.7- (is (sk-write-file (make-instance 'sk-project :name "nada" :path "test" :vc :hg) :path %tmp :if-exists :supersede))
14.8+ (is (sk-write-file
14.9+ (make-instance 'sk-project :name "nada" :path "test" :vc :hg) :path %tmp :if-exists :supersede))
14.10 (ignore-errors (delete-file %tmp))
14.11 (setf %tmp (tmp-path "sk"))
14.12 (is (init-skelfile %tmp))
14.13@@ -90,13 +91,7 @@
14.14
14.15 (deftest vm ()
14.16 "EXPERIMENTAL"
14.17- (is (let ((vm (make-sk-vm 201)))
14.18- (dotimes (i 200)
14.19- (sks-pop vm))
14.20- t))
14.21- (let ((vm (make-sk-vm 1)))
14.22- (is (sks-pop vm))
14.23- (signals simple-error (sks-pop vm))))
14.24+ (is (make-skel-vm)))
14.25
14.26 (deftest asd ()
14.27 (let ((sk (make-instance 'sk-project :components '((:lisp "test")
15.1--- a/lisp/std/macs/ana.lisp Tue Aug 13 22:05:23 2024 -0400
15.2+++ b/lisp/std/macs/ana.lisp Wed Aug 14 21:49:56 2024 -0400
15.3@@ -528,8 +528,8 @@
15.4
15.5 ;; Graham's alambda
15.6 (defmacro alambda (parms &body body)
15.7- `(labels ((self ,parms ,@body))
15.8- #'self))
15.9+ `(labels ((%a ,parms ,@body))
15.10+ #'%a))
15.11
15.12 ;; Graham's aif
15.13 (defmacro aif (test then &optional else)
15.14@@ -575,17 +575,17 @@
15.15 ,g!b (progn ,@body))))))))
15.16
15.17 (defmacro alet% (letargs &rest body)
15.18- `(let ((this) ,@letargs)
15.19- (setq this ,@(last body))
15.20+ `(let ((%a) ,@letargs)
15.21+ (setq %a ,@(last body))
15.22 ,@(butlast body)
15.23- this))
15.24+ %a))
15.25
15.26 (defmacro alet (letargs &rest body)
15.27- `(let ((this) ,@letargs)
15.28- (setq this ,@(last body))
15.29+ `(let ((%a) ,@letargs)
15.30+ (setq %a ,@(last body))
15.31 ,@(butlast body)
15.32 (lambda (&rest params)
15.33- (apply this params))))
15.34+ (apply %a params))))
15.35
15.36 ;; swiped from fiveam. This is just like acond except it assumes that
15.37 ;; the TEST in each element of CLAUSES returns two values as opposed
16.1--- a/lisp/std/macs/pan.lisp Tue Aug 13 22:05:23 2024 -0400
16.2+++ b/lisp/std/macs/pan.lisp Wed Aug 14 21:49:56 2024 -0400
16.3@@ -23,11 +23,11 @@
16.4
16.5 (defmacro pandoriclet (letargs &rest body)
16.6 (let ((letargs (cons
16.7- '(this)
16.8+ '(%a)
16.9 (std/list:let-binding-transform
16.10 letargs))))
16.11 `(let (,@letargs)
16.12- (setq this ,@(last body))
16.13+ (setq %a ,@(last body))
16.14 ,@(butlast body)
16.15 (dlambda
16.16 (:pandoric-get (sym)
16.17@@ -35,7 +35,7 @@
16.18 (:pandoric-set (sym val)
16.19 ,(pandoriclet-set letargs))
16.20 (t (&rest args)
16.21- (apply this args))))))
16.22+ (apply %a args))))))
16.23
16.24 (declaim (inline get-pandoric))
16.25
16.26@@ -54,25 +54,25 @@
16.27 ,@body))
16.28
16.29 ;; (defun pandoric-hotpatch (box new)
16.30-;; (with-pandoric (this) box
16.31-;; (setq this new)))
16.32+;; (with-pandoric (%a) box
16.33+;; (setq %a new)))
16.34
16.35 (defmacro pandoric-recode (vars box new)
16.36- `(with-pandoric (this ,@vars) ,box
16.37- (setq this ,new)))
16.38+ `(with-pandoric (%a ,@vars) ,box
16.39+ (setq %a ,new)))
16.40
16.41 (defmacro plambda (largs pargs &rest body)
16.42 (let ((pargs (mapcar #'list pargs)))
16.43- `(let (this self)
16.44+ `(let (%a %p)
16.45 (setq
16.46- this (lambda ,largs ,@body)
16.47- self (dlambda
16.48+ %a (lambda ,largs ,@body)
16.49+ %p (dlambda
16.50 (:pandoric-get (sym)
16.51 ,(pandoriclet-get pargs))
16.52 (:pandoric-set (sym val)
16.53 ,(pandoriclet-set pargs))
16.54 (t (&rest args)
16.55- (apply this args)))))))
16.56+ (apply %a args)))))))
16.57
16.58 (defvar pandoric-eval-tunnel)
16.59
17.1--- a/lisp/std/pkg.lisp Tue Aug 13 22:05:23 2024 -0400
17.2+++ b/lisp/std/pkg.lisp Wed Aug 14 21:49:56 2024 -0400
17.3@@ -236,11 +236,11 @@
17.4 :alet%
17.5 :alet
17.6 :acond2
17.7+ :aif
17.8 :it
17.9- :aif
17.10- :this
17.11- :self
17.12+ :%a
17.13 ;; pan
17.14+ :%p
17.15 :pandoriclet
17.16 :pandoriclet-get
17.17 :pandoriclet-set
