# HG changeset patch # User Richard Westhaver # Date 1727482750 14400 # Node ID 5f88b237ce299f3805592ac02b0e220d760691ed # Parent 12287fab15d07ddadaafe34eb9b0dadac26b794f added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb diff -r 12287fab15d0 -r 5f88b237ce29 lisp/bin/bin.asd --- a/lisp/bin/bin.asd Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/bin/bin.asd Fri Sep 27 20:19:10 2024 -0400 @@ -30,6 +30,13 @@ :components ((:file "skel")) :depends-on (:uiop :cl-ppcre :std :cli :skel)) +(defsystem :bin/skc + :build-operation program-op + :build-pathname "skc" + :entry-point "bin/skc::start-skc" + :components ((:file "skc")) + :depends-on (:std :cli)) + (defsystem :bin/packy :build-operation program-op :build-pathname "packy" diff -r 12287fab15d0 -r 5f88b237ce29 lisp/bin/skc.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/bin/skc.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -0,0 +1,18 @@ +;;; skc.lisp --- Skel Client + +;; + +;;; Code: +(in-package :std-user) +(defpkg :bin/skc + (:use :cl) + (:nicknames :skc)) +(in-package :bin/skc) + +(define-cli *skc-cli* + :name "skc" + :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream))))) + +(defmain start-skc () + (with-cli (*skc-cli* opts cmds) (cli:args) + (do-cmd *skc-cli*))) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/bin/skel.lisp --- a/lisp/bin/skel.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/bin/skel.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -360,5 +360,6 @@ (setq *skel-project* (load-skelfile project)) (setq *skel-path* (sk-src *skel-project*)) (setq cli/shell:*shell-directory* (sk-src *skel-project*)))) + (do-opts *cli* t) (do-cmd *cli*) (debug-opts *cli*)))) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/ffi/rocksdb/checkpoint.lisp --- a/lisp/ffi/rocksdb/checkpoint.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/ffi/rocksdb/checkpoint.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -30,9 +30,9 @@ (options (* rocksdb-options)) (name c-string) (num-column-families int) - (column-family-names (array c-string)) - (column-family-options (array rocksdb-options)) - (column-family-handles (array rocksdb-column-family-handle))) + (column-family-names (* c-string)) + (column-family-options (* (* rocksdb-options))) + (column-family-handles (* (* rocksdb-column-family-handle)))) (def-with-errptr rocksdb-open-column-families-with-ttl (* rocksdb) (opts (* rocksdb-options)) @@ -40,7 +40,7 @@ (num-cfs int) (cf-names (array c-string)) (cf-opts (array (* rocksdb-options))) - (cf-handles (array (* rocksdb-column-family-handle))) + (cf-handles (* (* rocksdb-column-family-handle))) (ttls (array int))) (def-with-errptr rocksdb-open-for-read-only-column-families (* rocksdb) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/lib/rdb/db.lisp --- a/lisp/lib/rdb/db.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/lib/rdb/db.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -5,6 +5,19 @@ ;;; Code: (in-package :rdb) +(defmethod load-opts ((db rdb)) + (rocksdb::with-latest-options (rdb-name db) (db-opts cf-names cf-opts) + (let ((cfs (coerce + (loop for name across cf-names + for opt across cf-opts + collect + (let ((cf-opts (make-rdb-opts))) + (setf (rdb-opts-sap cf-opts) opt) + (make-rdb-cf name :opts cf-opts))) + 'vector))) + (setf (rdb-opts db) (make-rdb-opts* db-opts) + (rdb-cfs db) cfs)))) + (defmethod make-db ((engine (eql :rocksdb)) &rest initargs) (declare (ignore engine)) (funcall 'make-rdb initargs)) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/lib/rdb/macs.lisp --- a/lisp/lib/rdb/macs.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/lib/rdb/macs.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -9,9 +9,11 @@ (unwind-protect (handler-bind ((sb-sys:memory-fault-error (lambda (c) + (declare (ignore c)) (handle-errptr ,e ,errtyp ,params))) (error (lambda (c) + (declare (ignore c)) (handle-errptr ,e ,errtyp ,params)))) (progn ,@body)) (handle-errptr ,e ,errtyp ,params)))) @@ -139,17 +141,7 @@ ,@(when destroy `((destroy-sst ,sst))))) ;;; opts -(defmacro with-latest-opts ((db-var db-path) &body body) - `(rocksdb::with-latest-options ,(string db-path) (db-opts cf-names cf-opts) - (let ((opts (make-rdb-opts))) - (setf (rdb-opts-sap opts) db-opts) - (let ((cfs (coerce - (loop for name across cf-names - for opt across cf-opts - collect - (let ((cf-opts (make-rdb-opts))) - (setf (rdb-opts-sap cf-opts) opt) - (make-rdb-cf name :opts cf-opts))) - 'vector))) - (let ((,db-var (make-rdb ,db-path opts cfs))) - ,@body))))) +(defmacro with-latest-opts (db &body body) + `(progn + (let ((,db (load-opts ,db))) + ,@body))) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/lib/rdb/obj.lisp --- a/lisp/lib/rdb/obj.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/lib/rdb/obj.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -26,14 +26,14 @@ (defclass rdb-opts () ((table :initarg :table :type hash-table :accessor rdb-opts-table) - (sap :initarg :sap :type (or null alien) :accessor rdb-opts-sap))) + (sap :initform nil :initarg :sap :type (or null alien) :accessor rdb-opts-sap))) (defmethod initialize-instance ((self rdb-opts) &rest initargs &key &allow-other-keys) - (with-slots (sap table) self + (with-slots ((%sap sap) (%table table)) self ;; initialize slots - remember, initargs doesn't refer to slot ;; names, they're opt names. - (unless (getf initargs :table) (setf table (make-hash-table :test #'equal))) - (unless (getf initargs :sap) (setf sap (rocksdb-options-create))) + (setf %table (or (cdr (remprop 'initargs :table)) (make-hash-table :test 'equal)) + %sap (or (cdr (remprop 'initargs :sap)) (rocksdb-options-create))) (loop for (k v) on initargs by #'cddr while v do (let ((k (typecase k (string (string-downcase k)) @@ -47,6 +47,11 @@ (push-sap* opts) opts)) +(defun make-rdb-opts* (alien) + "Coerce ALIEN into an RDB-OPTS struct. This function doesn't populate the +values in Lisp, just binds the sap." + (make-instance 'rdb-opts :sap alien)) + (defmethod get-opt ((self rdb-opts) key) "Return the current value of KEY in SELF if found, else return nil." (gethash key (rdb-opts-table self))) @@ -381,23 +386,23 @@ (defmethod create-cf ((db rdb) (cf rdb-cf)) (create-cf-raw (rdb-db db) (rdb-cf-name cf) (rdb-opts-sap (rdb-opts db)))) -(defmethod open-cf ((db rdb) (cf rdb-cf) &optional (error t)) - (unless (null (rdb-cf-sap cf)) - (if error - (rdb-error "column family is already open - close before re-opening.") - cf) - (setf (rdb-cf-sap cf) (open-cf-raw (rdb-db db) (rdb-cf-opts cf) (rdb-cf-name cf))))) - -(defmethod open-cf ((db rdb) (cf string) &optional (error t)) - (if-let ((cf (find-cf cf db))) - (or (rdb-cf-sap cf) - (setf (rdb-cf-sap cf) (create-cf db cf))) - (when error (rdb-error "unable to find column-family")))) - -(defmethod open-cfs ((self rdb)) - (loop for cf across (rdb-cfs self) - do (setf (rdb-cf-sap cf) - (create-cf self cf)))) +(defmethod open-cfs ((db rdb) &rest names) + (let ((cf-names) (cf-opts)) + (loop for cf across (rdb-cfs db) + do (let ((name (rdb-cf-name cf))) + (when (or (not names) (member name names :test 'string=)) + (push name cf-names) + (push (rdb-opts-sap (rdb-cf-opts cf)) cf-opts))) + finally + (setf cf-names (nreverse cf-names) + cf-opts (nreverse cf-opts))) + (multiple-value-bind (db-sap cfs) (open-cfs-raw (rdb-opts db) (rdb-name db) cf-names cf-opts) + (setf (rdb-db db) db-sap) + (loop for cf across (rdb-cfs db) + with i = 0 + do (setf (rdb-cf-sap cf) (deref cfs i)) + do (incf i)) + db))) (defmethod close-cfs ((self rdb)) (loop for cf across (rdb-cfs self) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/lib/rdb/pkg.lisp --- a/lisp/lib/rdb/pkg.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/lib/rdb/pkg.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -46,6 +46,7 @@ :sst-put-raw :sst-delete-raw :sst-delete-range-raw :sst-file-size-raw :sst-put-str-raw :open-sst-file :close-sst-file + :cf-name-raw :cf-id-raw ;; proto :find-cf :put-key :put-kv @@ -119,10 +120,11 @@ :rdb-cf-key-type :rdb-cf-val-type :close-cf - :open-cf :close-cfs :rdb-cf-opts - :with-latest-opts)) + :with-latest-opts + :make-rdb-opts* + :load-opts)) (in-package :rdb) (rocksdb:load-rocksdb nil) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/lib/rdb/proto.lisp --- a/lisp/lib/rdb/proto.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/lib/rdb/proto.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -24,6 +24,9 @@ (:documentation "Push all options to internal sap.")) (defgeneric backfill-opts (self &key) (:documentation "Backfill opts from an alien.")) +(defgeneric load-opts (self) + (:documentation "Load existing database options. Assumes that the database has been opened and +flushed to disk at least once.")) (defgeneric push-sap (self key) (:documentation "Push a value associated with KEY to the sap associated with SELF. Typically used to send a value from one slot, to a foreign @@ -36,11 +39,9 @@ (:documentation "Implicitly pull foreign values from the sap associated with SELF.")) (defgeneric push-cf (cf self) (:documentation "Push a column-family to a sap.")) -(defgeneric open-cf (self cf &optional opts) - (:documentation "Open column-family CF in SELF. When ERROR is non-nil signal an error if the -column-family is already open.")) -(defgeneric open-cfs (self) - (:documentation "Open all column-fmailies belonging to SELF.")) +(defgeneric open-cfs (self &rest names) + (:documentation "Open the column-families indicated by NAMES or all column-fmailies belonging +to SELF.")) (defgeneric close-cf (self &optional error) (:documentation "Close the column-family SELF. When ERROR is non-nil signal an error if the column-family is already closed.")) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/lib/rdb/raw.lisp --- a/lisp/lib/rdb/raw.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/lib/rdb/raw.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -16,6 +16,10 @@ (make-rocksdb-options (lambda (o) (rocksdb-options-set-create-if-missing o t)))) +(defun load-opts-raw (dir) + (rocksdb::with-latest-options dir (db-opts names cf-opts) + (values db-opts names cf-opts))) + (defun get-stats-raw (opt htype) (with-alien ((hist (* rocksdb-statistics-histogram-data) (rocksdb-statistics-histogram-data-create))) (rocksdb-options-statistics-get-histogram-data opt htype hist) @@ -116,9 +120,17 @@ (when v (octets-to-string v))))) ;;; Column Family -(defun open-cf-raw (db name &optional (opt (rocksdb-options-create))) - (with-errptr (err 'rocksdb-cf-error (list :db db :cf name)) - (rocksdb-open-column-families opt name 1 nil nil nil err))) +(defun open-cfs-raw (db-opt name names opts) + (let ((n (length names))) + (with-alien ((cf-names (* c-string) (clone-strings names)) + (cf-opts (* (* rocksdb-options))) + (cf-handles (* (* rocksdb-column-family-handle)))) + (loop for opt in opts + for i below n + do (setf (deref cf-opts i) opt)) + (with-errptr (err 'rocksdb-cf-error (list :cf name)) + (let ((db (rocksdb-open-column-families db-opt name n cf-names cf-opts cf-handles err))) + (values db cf-handles)))))) (defun create-cf-raw (db name &optional (opt (rocksdb-options-create))) (with-errptr (err 'rocksdb-cf-error (list :db db :cf name)) @@ -170,6 +182,12 @@ (val-octets (string-to-octets val :null-terminate nil))) (put-cf-raw db cf key-octets val-octets opt))) +(defun cf-name-raw (cf-handle) + (rocksdb-column-family-handle-get-name cf-handle (make-alien unsigned-long))) + +(defun cf-id-raw (cf-handle) + (rocksdb-column-family-handle-get-id cf-handle)) + ;;; Iterators (defun create-iter-raw (db &optional (opt (rocksdb-readoptions-create))) (rocksdb-create-iterator db opt)) diff -r 12287fab15d0 -r 5f88b237ce29 lisp/std/alien.lisp --- a/lisp/std/alien.lisp Thu Sep 26 21:16:45 2024 -0400 +++ b/lisp/std/alien.lisp Fri Sep 27 20:19:10 2024 -0400 @@ -72,22 +72,17 @@ (incf index)))) (defun clone-strings (list) - (with-alien ((x (* (* char)) - (make-alien (* char) (length list)))) - (unwind-protect - (labels ((populate (list index function) - (declare (type sb-int:index index)) - (if list - (let ((array (sb-ext:string-to-octets (car list) :null-terminate t))) - (sb-sys:with-pinned-objects (array) - (setf (deref x index) (sap-alien (sb-sys:vector-sap array) (* char))) - (populate (cdr list) (1+ index) function))) - (funcall function)))) - (populate list 0 - (lambda () - (loop for i below (length list) - do (print (cast (deref x i) c-string)))))) - (free-alien x)))) + (let ((len (length list))) + (with-alien ((x (* (* char)) (make-alien (* char) len))) + (labels ((populate (list index) + (declare (type sb-int:index index)) + (if list + (let ((array (sb-ext:string-to-octets (car list) :null-terminate t))) + (sb-sys:with-pinned-objects (array) + (setf (deref x index) (sap-alien (sb-sys:vector-sap array) (* char))) + (populate (cdr list) (1+ index)))) + x))) + (cast (populate list 0) (* c-string)))))) (defun c-strings-to-string-list (c-strings) (declare (type (alien (* c-string)) c-strings)) diff -r 12287fab15d0 -r 5f88b237ce29 skelfile --- a/skelfile Thu Sep 26 21:16:45 2024 -0400 +++ b/skelfile Fri Sep 27 20:19:10 2024 -0400 @@ -92,6 +92,12 @@ (asdf:make :bin/skel)) #$mv lisp/bin/skel .stash/skel$#) (:install () #$install -C -m 755 .stash/skel /usr/local/bin/skel$#)) + (skc (%stash) + (:build () + (with-sbcl (:noinform t :quit t) + (ql:quickload :bin/skc) + (asdf:make :bin/skc)) + #$mv lisp/bin/skc .stash/skc$#)) (organ (%stash) (:build () (with-sbcl (:noinform t :quit t) (ql:quickload :bin/organ)