1.1--- a/lisp/bin/bin.asd Thu Sep 26 21:16:45 2024 -0400
1.2+++ b/lisp/bin/bin.asd Fri Sep 27 20:19:10 2024 -0400
1.3@@ -30,6 +30,13 @@
1.4 :components ((:file "skel"))
1.5 :depends-on (:uiop :cl-ppcre :std :cli :skel))
1.6
1.7+(defsystem :bin/skc
1.8+ :build-operation program-op
1.9+ :build-pathname "skc"
1.10+ :entry-point "bin/skc::start-skc"
1.11+ :components ((:file "skc"))
1.12+ :depends-on (:std :cli))
1.13+
1.14 (defsystem :bin/packy
1.15 :build-operation program-op
1.16 :build-pathname "packy"
2.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
2.2+++ b/lisp/bin/skc.lisp Fri Sep 27 20:19:10 2024 -0400
2.3@@ -0,0 +1,18 @@
2.4+;;; skc.lisp --- Skel Client
2.5+
2.6+;;
2.7+
2.8+;;; Code:
2.9+(in-package :std-user)
2.10+(defpkg :bin/skc
2.11+ (:use :cl)
2.12+ (:nicknames :skc))
2.13+(in-package :bin/skc)
2.14+
2.15+(define-cli *skc-cli*
2.16+ :name "skc"
2.17+ :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream)))))
2.18+
2.19+(defmain start-skc ()
2.20+ (with-cli (*skc-cli* opts cmds) (cli:args)
2.21+ (do-cmd *skc-cli*)))
3.1--- a/lisp/bin/skel.lisp Thu Sep 26 21:16:45 2024 -0400
3.2+++ b/lisp/bin/skel.lisp Fri Sep 27 20:19:10 2024 -0400
3.3@@ -360,5 +360,6 @@
3.4 (setq *skel-project* (load-skelfile project))
3.5 (setq *skel-path* (sk-src *skel-project*))
3.6 (setq cli/shell:*shell-directory* (sk-src *skel-project*))))
3.7+ (do-opts *cli* t)
3.8 (do-cmd *cli*)
3.9 (debug-opts *cli*))))
4.1--- a/lisp/ffi/rocksdb/checkpoint.lisp Thu Sep 26 21:16:45 2024 -0400
4.2+++ b/lisp/ffi/rocksdb/checkpoint.lisp Fri Sep 27 20:19:10 2024 -0400
4.3@@ -30,9 +30,9 @@
4.4 (options (* rocksdb-options))
4.5 (name c-string)
4.6 (num-column-families int)
4.7- (column-family-names (array c-string))
4.8- (column-family-options (array rocksdb-options))
4.9- (column-family-handles (array rocksdb-column-family-handle)))
4.10+ (column-family-names (* c-string))
4.11+ (column-family-options (* (* rocksdb-options)))
4.12+ (column-family-handles (* (* rocksdb-column-family-handle))))
4.13
4.14 (def-with-errptr rocksdb-open-column-families-with-ttl (* rocksdb)
4.15 (opts (* rocksdb-options))
4.16@@ -40,7 +40,7 @@
4.17 (num-cfs int)
4.18 (cf-names (array c-string))
4.19 (cf-opts (array (* rocksdb-options)))
4.20- (cf-handles (array (* rocksdb-column-family-handle)))
4.21+ (cf-handles (* (* rocksdb-column-family-handle)))
4.22 (ttls (array int)))
4.23
4.24 (def-with-errptr rocksdb-open-for-read-only-column-families (* rocksdb)
5.1--- a/lisp/lib/rdb/db.lisp Thu Sep 26 21:16:45 2024 -0400
5.2+++ b/lisp/lib/rdb/db.lisp Fri Sep 27 20:19:10 2024 -0400
5.3@@ -5,6 +5,19 @@
5.4 ;;; Code:
5.5 (in-package :rdb)
5.6
5.7+(defmethod load-opts ((db rdb))
5.8+ (rocksdb::with-latest-options (rdb-name db) (db-opts cf-names cf-opts)
5.9+ (let ((cfs (coerce
5.10+ (loop for name across cf-names
5.11+ for opt across cf-opts
5.12+ collect
5.13+ (let ((cf-opts (make-rdb-opts)))
5.14+ (setf (rdb-opts-sap cf-opts) opt)
5.15+ (make-rdb-cf name :opts cf-opts)))
5.16+ 'vector)))
5.17+ (setf (rdb-opts db) (make-rdb-opts* db-opts)
5.18+ (rdb-cfs db) cfs))))
5.19+
5.20 (defmethod make-db ((engine (eql :rocksdb)) &rest initargs)
5.21 (declare (ignore engine))
5.22 (funcall 'make-rdb initargs))
6.1--- a/lisp/lib/rdb/macs.lisp Thu Sep 26 21:16:45 2024 -0400
6.2+++ b/lisp/lib/rdb/macs.lisp Fri Sep 27 20:19:10 2024 -0400
6.3@@ -9,9 +9,11 @@
6.4 (unwind-protect
6.5 (handler-bind ((sb-sys:memory-fault-error
6.6 (lambda (c)
6.7+ (declare (ignore c))
6.8 (handle-errptr ,e ,errtyp ,params)))
6.9 (error
6.10 (lambda (c)
6.11+ (declare (ignore c))
6.12 (handle-errptr ,e ,errtyp ,params))))
6.13 (progn ,@body))
6.14 (handle-errptr ,e ,errtyp ,params))))
6.15@@ -139,17 +141,7 @@
6.16 ,@(when destroy `((destroy-sst ,sst)))))
6.17
6.18 ;;; opts
6.19-(defmacro with-latest-opts ((db-var db-path) &body body)
6.20- `(rocksdb::with-latest-options ,(string db-path) (db-opts cf-names cf-opts)
6.21- (let ((opts (make-rdb-opts)))
6.22- (setf (rdb-opts-sap opts) db-opts)
6.23- (let ((cfs (coerce
6.24- (loop for name across cf-names
6.25- for opt across cf-opts
6.26- collect
6.27- (let ((cf-opts (make-rdb-opts)))
6.28- (setf (rdb-opts-sap cf-opts) opt)
6.29- (make-rdb-cf name :opts cf-opts)))
6.30- 'vector)))
6.31- (let ((,db-var (make-rdb ,db-path opts cfs)))
6.32- ,@body)))))
6.33+(defmacro with-latest-opts (db &body body)
6.34+ `(progn
6.35+ (let ((,db (load-opts ,db)))
6.36+ ,@body)))
7.1--- a/lisp/lib/rdb/obj.lisp Thu Sep 26 21:16:45 2024 -0400
7.2+++ b/lisp/lib/rdb/obj.lisp Fri Sep 27 20:19:10 2024 -0400
7.3@@ -26,14 +26,14 @@
7.4
7.5 (defclass rdb-opts ()
7.6 ((table :initarg :table :type hash-table :accessor rdb-opts-table)
7.7- (sap :initarg :sap :type (or null alien) :accessor rdb-opts-sap)))
7.8+ (sap :initform nil :initarg :sap :type (or null alien) :accessor rdb-opts-sap)))
7.9
7.10 (defmethod initialize-instance ((self rdb-opts) &rest initargs &key &allow-other-keys)
7.11- (with-slots (sap table) self
7.12+ (with-slots ((%sap sap) (%table table)) self
7.13 ;; initialize slots - remember, initargs doesn't refer to slot
7.14 ;; names, they're opt names.
7.15- (unless (getf initargs :table) (setf table (make-hash-table :test #'equal)))
7.16- (unless (getf initargs :sap) (setf sap (rocksdb-options-create)))
7.17+ (setf %table (or (cdr (remprop 'initargs :table)) (make-hash-table :test 'equal))
7.18+ %sap (or (cdr (remprop 'initargs :sap)) (rocksdb-options-create)))
7.19 (loop for (k v) on initargs by #'cddr while v
7.20 do (let ((k (typecase k
7.21 (string (string-downcase k))
7.22@@ -47,6 +47,11 @@
7.23 (push-sap* opts)
7.24 opts))
7.25
7.26+(defun make-rdb-opts* (alien)
7.27+ "Coerce ALIEN into an RDB-OPTS struct. This function doesn't populate the
7.28+values in Lisp, just binds the sap."
7.29+ (make-instance 'rdb-opts :sap alien))
7.30+
7.31 (defmethod get-opt ((self rdb-opts) key)
7.32 "Return the current value of KEY in SELF if found, else return nil."
7.33 (gethash key (rdb-opts-table self)))
7.34@@ -381,23 +386,23 @@
7.35 (defmethod create-cf ((db rdb) (cf rdb-cf))
7.36 (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db))))
7.37
7.38-(defmethod open-cf ((db rdb) (cf rdb-cf) &optional (error t))
7.39- (unless (null (rdb-cf-sap cf))
7.40- (if error
7.41- (rdb-error "column family is already open - close before re-opening.")
7.42- cf)
7.43- (setf (rdb-cf-sap cf) (open-cf-raw (rdb-db db) (rdb-cf-opts cf) (rdb-cf-name cf)))))
7.44-
7.45-(defmethod open-cf ((db rdb) (cf string) &optional (error t))
7.46- (if-let ((cf (find-cf cf db)))
7.47- (or (rdb-cf-sap cf)
7.48- (setf (rdb-cf-sap cf) (create-cf db cf)))
7.49- (when error (rdb-error "unable to find column-family"))))
7.50-
7.51-(defmethod open-cfs ((self rdb))
7.52- (loop for cf across (rdb-cfs self)
7.53- do (setf (rdb-cf-sap cf)
7.54- (create-cf self cf))))
7.55+(defmethod open-cfs ((db rdb) &rest names)
7.56+ (let ((cf-names) (cf-opts))
7.57+ (loop for cf across (rdb-cfs db)
7.58+ do (let ((name (rdb-cf-name cf)))
7.59+ (when (or (not names) (member name names :test 'string=))
7.60+ (push name cf-names)
7.61+ (push (rdb-opts-sap (rdb-cf-opts cf)) cf-opts)))
7.62+ finally
7.63+ (setf cf-names (nreverse cf-names)
7.64+ cf-opts (nreverse cf-opts)))
7.65+ (multiple-value-bind (db-sap cfs) (open-cfs-raw (rdb-opts db) (rdb-name db) cf-names cf-opts)
7.66+ (setf (rdb-db db) db-sap)
7.67+ (loop for cf across (rdb-cfs db)
7.68+ with i = 0
7.69+ do (setf (rdb-cf-sap cf) (deref cfs i))
7.70+ do (incf i))
7.71+ db)))
7.72
7.73 (defmethod close-cfs ((self rdb))
7.74 (loop for cf across (rdb-cfs self)
8.1--- a/lisp/lib/rdb/pkg.lisp Thu Sep 26 21:16:45 2024 -0400
8.2+++ b/lisp/lib/rdb/pkg.lisp Fri Sep 27 20:19:10 2024 -0400
8.3@@ -46,6 +46,7 @@
8.4 :sst-put-raw :sst-delete-raw :sst-delete-range-raw :sst-file-size-raw
8.5 :sst-put-str-raw
8.6 :open-sst-file :close-sst-file
8.7+ :cf-name-raw :cf-id-raw
8.8 ;; proto
8.9 :find-cf
8.10 :put-key :put-kv
8.11@@ -119,10 +120,11 @@
8.12 :rdb-cf-key-type
8.13 :rdb-cf-val-type
8.14 :close-cf
8.15- :open-cf
8.16 :close-cfs
8.17 :rdb-cf-opts
8.18- :with-latest-opts))
8.19+ :with-latest-opts
8.20+ :make-rdb-opts*
8.21+ :load-opts))
8.22
8.23 (in-package :rdb)
8.24 (rocksdb:load-rocksdb nil)
9.1--- a/lisp/lib/rdb/proto.lisp Thu Sep 26 21:16:45 2024 -0400
9.2+++ b/lisp/lib/rdb/proto.lisp Fri Sep 27 20:19:10 2024 -0400
9.3@@ -24,6 +24,9 @@
9.4 (:documentation "Push all options to internal sap."))
9.5 (defgeneric backfill-opts (self &key)
9.6 (:documentation "Backfill opts from an alien."))
9.7+(defgeneric load-opts (self)
9.8+ (:documentation "Load existing database options. Assumes that the database has been opened and
9.9+flushed to disk at least once."))
9.10 (defgeneric push-sap (self key)
9.11 (:documentation "Push a value associated with KEY to the sap associated
9.12 with SELF. Typically used to send a value from one slot, to a foreign
9.13@@ -36,11 +39,9 @@
9.14 (:documentation "Implicitly pull foreign values from the sap associated with SELF."))
9.15 (defgeneric push-cf (cf self)
9.16 (:documentation "Push a column-family to a sap."))
9.17-(defgeneric open-cf (self cf &optional opts)
9.18- (:documentation "Open column-family CF in SELF. When ERROR is non-nil signal an error if the
9.19-column-family is already open."))
9.20-(defgeneric open-cfs (self)
9.21- (:documentation "Open all column-fmailies belonging to SELF."))
9.22+(defgeneric open-cfs (self &rest names)
9.23+ (:documentation "Open the column-families indicated by NAMES or all column-fmailies belonging
9.24+to SELF."))
9.25 (defgeneric close-cf (self &optional error)
9.26 (:documentation "Close the column-family SELF. When ERROR is non-nil signal an error if the
9.27 column-family is already closed."))
10.1--- a/lisp/lib/rdb/raw.lisp Thu Sep 26 21:16:45 2024 -0400
10.2+++ b/lisp/lib/rdb/raw.lisp Fri Sep 27 20:19:10 2024 -0400
10.3@@ -16,6 +16,10 @@
10.4 (make-rocksdb-options
10.5 (lambda (o) (rocksdb-options-set-create-if-missing o t))))
10.6
10.7+(defun load-opts-raw (dir)
10.8+ (rocksdb::with-latest-options dir (db-opts names cf-opts)
10.9+ (values db-opts names cf-opts)))
10.10+
10.11 (defun get-stats-raw (opt htype)
10.12 (with-alien ((hist (* rocksdb-statistics-histogram-data) (rocksdb-statistics-histogram-data-create)))
10.13 (rocksdb-options-statistics-get-histogram-data opt htype hist)
10.14@@ -116,9 +120,17 @@
10.15 (when v (octets-to-string v)))))
10.16
10.17 ;;; Column Family
10.18-(defun open-cf-raw (db name &optional (opt (rocksdb-options-create)))
10.19- (with-errptr (err 'rocksdb-cf-error (list :db db :cf name))
10.20- (rocksdb-open-column-families opt name 1 nil nil nil err)))
10.21+(defun open-cfs-raw (db-opt name names opts)
10.22+ (let ((n (length names)))
10.23+ (with-alien ((cf-names (* c-string) (clone-strings names))
10.24+ (cf-opts (* (* rocksdb-options)))
10.25+ (cf-handles (* (* rocksdb-column-family-handle))))
10.26+ (loop for opt in opts
10.27+ for i below n
10.28+ do (setf (deref cf-opts i) opt))
10.29+ (with-errptr (err 'rocksdb-cf-error (list :cf name))
10.30+ (let ((db (rocksdb-open-column-families db-opt name n cf-names cf-opts cf-handles err)))
10.31+ (values db cf-handles))))))
10.32
10.33 (defun create-cf-raw (db name &optional (opt (rocksdb-options-create)))
10.34 (with-errptr (err 'rocksdb-cf-error (list :db db :cf name))
10.35@@ -170,6 +182,12 @@
10.36 (val-octets (string-to-octets val :null-terminate nil)))
10.37 (put-cf-raw db cf key-octets val-octets opt)))
10.38
10.39+(defun cf-name-raw (cf-handle)
10.40+ (rocksdb-column-family-handle-get-name cf-handle (make-alien unsigned-long)))
10.41+
10.42+(defun cf-id-raw (cf-handle)
10.43+ (rocksdb-column-family-handle-get-id cf-handle))
10.44+
10.45 ;;; Iterators
10.46 (defun create-iter-raw (db &optional (opt (rocksdb-readoptions-create)))
10.47 (rocksdb-create-iterator db opt))
11.1--- a/lisp/std/alien.lisp Thu Sep 26 21:16:45 2024 -0400
11.2+++ b/lisp/std/alien.lisp Fri Sep 27 20:19:10 2024 -0400
11.3@@ -72,22 +72,17 @@
11.4 (incf index))))
11.5
11.6 (defun clone-strings (list)
11.7- (with-alien ((x (* (* char))
11.8- (make-alien (* char) (length list))))
11.9- (unwind-protect
11.10- (labels ((populate (list index function)
11.11- (declare (type sb-int:index index))
11.12- (if list
11.13- (let ((array (sb-ext:string-to-octets (car list) :null-terminate t)))
11.14- (sb-sys:with-pinned-objects (array)
11.15- (setf (deref x index) (sap-alien (sb-sys:vector-sap array) (* char)))
11.16- (populate (cdr list) (1+ index) function)))
11.17- (funcall function))))
11.18- (populate list 0
11.19- (lambda ()
11.20- (loop for i below (length list)
11.21- do (print (cast (deref x i) c-string))))))
11.22- (free-alien x))))
11.23+ (let ((len (length list)))
11.24+ (with-alien ((x (* (* char)) (make-alien (* char) len)))
11.25+ (labels ((populate (list index)
11.26+ (declare (type sb-int:index index))
11.27+ (if list
11.28+ (let ((array (sb-ext:string-to-octets (car list) :null-terminate t)))
11.29+ (sb-sys:with-pinned-objects (array)
11.30+ (setf (deref x index) (sap-alien (sb-sys:vector-sap array) (* char)))
11.31+ (populate (cdr list) (1+ index))))
11.32+ x)))
11.33+ (cast (populate list 0) (* c-string))))))
11.34
11.35 (defun c-strings-to-string-list (c-strings)
11.36 (declare (type (alien (* c-string)) c-strings))
12.1--- a/skelfile Thu Sep 26 21:16:45 2024 -0400
12.2+++ b/skelfile Fri Sep 27 20:19:10 2024 -0400
12.3@@ -92,6 +92,12 @@
12.4 (asdf:make :bin/skel))
12.5 #$mv lisp/bin/skel .stash/skel$#)
12.6 (:install () #$install -C -m 755 .stash/skel /usr/local/bin/skel$#))
12.7+ (skc (%stash)
12.8+ (:build ()
12.9+ (with-sbcl (:noinform t :quit t)
12.10+ (ql:quickload :bin/skc)
12.11+ (asdf:make :bin/skc))
12.12+ #$mv lisp/bin/skc .stash/skc$#))
12.13 (organ (%stash)
12.14 (:build () (with-sbcl (:noinform t :quit t)
12.15 (ql:quickload :bin/organ)
