1.1--- a/.hgignore Tue Apr 23 17:46:12 2024 -0400
1.2+++ b/.hgignore Wed Apr 24 16:12:15 2024 -0400
1.3@@ -1,4 +1,4 @@
1.4-./x$
1.5+^x$
1.6 .*Cargo.lock$
1.7 .*target/.*
1.8 .*system-index.txt$
2.1--- a/lisp/ffi/rocksdb/comparator.lisp Tue Apr 23 17:46:12 2024 -0400
2.2+++ b/lisp/ffi/rocksdb/comparator.lisp Wed Apr 24 16:12:15 2024 -0400
2.3@@ -4,21 +4,24 @@
2.4
2.5 ;;; Code:
2.6 (in-package :rocksdb)
2.7+
2.8 ;; TODO 2023-12-11:
2.9-;; (define-alien-routine rocksdb-comparator-create (* rocksdb-comparator)
2.10-;; (state (* void))
2.11-;; (destructor (* void))
2.12-;; (compare (* int))
2.13-;; (name (* unsigned-char)))
2.14+(define-alien-routine rocksdb-comparator-create (* rocksdb-comparator)
2.15+ (state (* t))
2.16+ (destructor (* t))
2.17+ (compare (* int))
2.18+ (name (* unsigned-char)))
2.19+
2.20+;; (rocksdb-comparator-create nil nil (make-alien int 1) (make-alien unsigned-char 10))
2.21
2.22 (define-alien-routine rocksdb-comparator-destroy void (self (* rocksdb-comparator)))
2.23
2.24-;; (define-alien-routine rocksdb-comparator-with-ts-create (* rocksdb-comparator)
2.25-;; (state (* void))
2.26-;; (destructor (* void))
2.27-;; (compare (* int))
2.28-;; (compare-ts (* int))
2.29-;; (compare-without-ts (* int))
2.30-;; (name (* unsigned-char)))
2.31+(define-alien-routine rocksdb-comparator-with-ts-create (* rocksdb-comparator)
2.32+ (state (* t))
2.33+ (destructor (* t))
2.34+ (compare (* int))
2.35+ (compare-ts (* int))
2.36+ (compare-without-ts (* int))
2.37+ (name (* unsigned-char)))
2.38
2.39-(export '(rocksdb-comparator-destroy))
2.40+(export '(rocksdb-comparator-destroy rocksdb-comparator-create rocksdb-comparator-with-ts-create))
3.1--- a/lisp/ffi/rocksdb/sst.lisp Tue Apr 23 17:46:12 2024 -0400
3.2+++ b/lisp/ffi/rocksdb/sst.lisp Wed Apr 24 16:12:15 2024 -0400
3.3@@ -91,7 +91,7 @@
3.4
3.5 (def-with-errptr rocksdb-ingest-external-file-cf void
3.6 (db (* rocksdb))
3.7- (handle (* rocksdb-column-family-handle))
3.8+ (cf-handle (* rocksdb-column-family-handle))
3.9 (file-list (array c-string))
3.10 (list-len size-t)
3.11 (opt (* rocksdb-ingestexternalfileoptions)))
4.1--- a/lisp/lib/net/codec/dns.lisp Tue Apr 23 17:46:12 2024 -0400
4.2+++ b/lisp/lib/net/codec/dns.lisp Wed Apr 24 16:12:15 2024 -0400
4.3@@ -5,6 +5,121 @@
4.4 ;;; Code:
4.5 (in-package :net/codec/dns)
4.6
4.7+;;; Record Types
4.8+
4.9+(define-condition dns-condition ()
4.10+ ())
4.11+
4.12+(define-condition dns-server-failure (error dns-condition)
4.13+ ((dns-server :initarg :dns-server :reader dns-server)
4.14+ (response-code :initarg :response-code :reader response-code))
4.15+ (:report (lambda (c s) (format s "DNS server ~% ~a~%responded with failure code ~d~@[~% ~a~]"
4.16+ (dns-server c) (response-code c) (response-code-name (response-code c))))))
4.17+
4.18+(define-condition dns-servers-exhausted (error dns-condition)
4.19+ ()
4.20+ (:report (lambda (c s) (declare (ignore c)) (format s "All DNS servers failed to provide an answer for the query."))))
4.21+
4.22+(defun response-code-name (code)
4.23+ (case code
4.24+ (0 :success)
4.25+ (1 :format-error)
4.26+ (2 :server-failure)
4.27+ (3 :no-such-domain)
4.28+ (4 :not-implemented)
4.29+ (5 :query-refused)
4.30+ (6 :name-should-not-exist)
4.31+ (7 :set-should-not-exist)
4.32+ (8 :set-does-not-exist)
4.33+ (9 :not-authorized)
4.34+ (10 :not-in-zone)
4.35+ (11 :type-not-implemented)
4.36+ (16 :bad-version)
4.37+ (17 :key-not-recognised)
4.38+ (18 :bad-time)
4.39+ (19 :bad-mode)
4.40+ (20 :duplicate-key)
4.41+ (21 :bad-algorithm)
4.42+ (22 :bad-truncation)
4.43+ (23 :bad-cookie)))
4.44+
4.45+(defmacro with-dns-error-handling (&body body)
4.46+ `(handler-bind ((dns-server-failure
4.47+ (lambda (e)
4.48+ (unless (find (response-code e) '(1 3 6 7 8))
4.49+ (continue e)))))
4.50+ ,@body))
4.51+
4.52+;;; Note: we assume that we never cross byte boundaries when accessing bits.
4.53+(defmacro with-decoding ((octets start &optional (pos (gensym "POS"))) &body body)
4.54+ `(let ((,pos ,start))
4.55+ (flet ((int1 ()
4.56+ (prog1 (logbitp (* 8 (rem ,pos 1)) (aref ,octets (floor ,pos)))
4.57+ (incf ,pos 1/8)))
4.58+ (int4 ()
4.59+ (prog1 (ldb (byte 4 (* 8 (rem ,pos 1))) (aref ,octets (floor ,pos)))
4.60+ (incf ,pos 4/8)))
4.61+ (int8 ()
4.62+ (prog1 (aref ,octets (floor ,pos))
4.63+ (incf ,pos 1)))
4.64+ (int16 () ;; big-endian
4.65+ (prog1 (+ (ash (aref ,octets (+ 0 (floor ,pos))) 8)
4.66+ (ash (aref ,octets (+ 1 (floor ,pos))) 0))
4.67+ (incf ,pos 2)))
4.68+ (int32 ()
4.69+ (prog1 (+ (ash (aref ,octets (+ 0 (floor ,pos))) 24)
4.70+ (ash (aref ,octets (+ 1 (floor ,pos))) 16)
4.71+ (ash (aref ,octets (+ 2 (floor ,pos))) 8)
4.72+ (ash (aref ,octets (+ 3 (floor ,pos))) 0))
4.73+ (incf ,pos 4))))
4.74+ (declare (ignorable #'int1 #'int4 #'int8 #'int16 #'int32))
4.75+ ,@body)))
4.76+
4.77+(defmacro with-encoding ((octets start &optional (pos (gensym "POS"))) &body body)
4.78+ `(let ((,pos ,start))
4.79+ (flet ((int1 (value)
4.80+ (let ((octet (aref ,octets (floor ,pos))))
4.81+ (setf (ldb (byte 1 (* 8 (rem ,pos 1))) octet)
4.82+ (ecase value
4.83+ ((0 1) value)
4.84+ ((T) 1)
4.85+ ((NIL) 0)))
4.86+ (setf (aref ,octets (floor ,pos)) octet)
4.87+ (incf ,pos 1/8)))
4.88+ (int4 (value)
4.89+ (let ((octet (aref ,octets (floor ,pos))))
4.90+ (setf (ldb (byte 4 (* 8 (rem ,pos 1))) octet) value)
4.91+ (setf (aref ,octets (floor ,pos)) octet)
4.92+ (incf ,pos 4/8)))
4.93+ (int8 (value)
4.94+ (setf (aref ,octets (floor ,pos)) value)
4.95+ (incf ,pos 1))
4.96+ (int16 (value) ;; big-endian
4.97+ (setf (aref ,octets (+ 0 ,pos)) (ldb (byte 8 8) value))
4.98+ (setf (aref ,octets (+ 1 ,pos)) (ldb (byte 8 0) value))
4.99+ (incf ,pos 2))
4.100+ (int32 (value) ;; big-endian
4.101+ (setf (aref ,octets (+ 0 ,pos)) (ldb (byte 8 24) value))
4.102+ (setf (aref ,octets (+ 1 ,pos)) (ldb (byte 8 16) value))
4.103+ (setf (aref ,octets (+ 2 ,pos)) (ldb (byte 8 8) value))
4.104+ (setf (aref ,octets (+ 3 ,pos)) (ldb (byte 8 0) value))
4.105+ (incf ,pos 4)))
4.106+ (declare (ignorable #'int1 #'int4 #'int8 #'int16 #'int32))
4.107+ ,@body)))
4.108+
4.109+(defmacro maybe-set ((octets offset) &body calls)
4.110+ `(with-encoding (,octets ,offset pos)
4.111+ ,@(loop for (func value) in calls
4.112+ collect `(if ,value
4.113+ (,func ,value)
4.114+ (incf pos ,(ecase func
4.115+ (int1 1/8)
4.116+ (int4 4/8)
4.117+ (int8 1)
4.118+ (int16 2)
4.119+ (int32 4)))))
4.120+ pos))
4.121+
4.122 (defparameter *record-type-table*
4.123 '((:A 1)
4.124 (:AAAA 28)
4.125@@ -268,7 +383,7 @@
4.126 (setf (getf data :data) (decode-record-payload (getf data :type) octets pos (+ pos (getf data :length))))
4.127 (values data (+ pos (getf data :length)))))
4.128
4.129-(defun decode-response (server octets offset limit)
4.130+(defun decode-response (server octets offset #+nil limit)
4.131 ;; FIXME: Implement buffer limiting.
4.132 (multiple-value-bind (header pos) (decode-header octets offset)
4.133 (when (< 0 (getf header :response-code))
5.1--- a/lisp/lib/net/net.asd Tue Apr 23 17:46:12 2024 -0400
5.2+++ b/lisp/lib/net/net.asd Wed Apr 24 16:12:15 2024 -0400
5.3@@ -5,10 +5,9 @@
5.4 :depends-on
5.5 (:sb-concurrency :sb-posix
5.6 :sb-bsd-sockets :cl-ppcre
5.7- :dat
5.8- :obj
5.9- :swank-client :dexador
5.10- :puri ;; fetch
5.11+ :dat :obj
5.12+ :swank :swank-client
5.13+ :dexador :puri ;; fetch
5.14 :hunchentoot :std :log)
5.15 :serial t
5.16 :components ((:file "pkg")
6.1--- a/lisp/lib/net/pkg.lisp Tue Apr 23 17:46:12 2024 -0400
6.2+++ b/lisp/lib/net/pkg.lisp Wed Apr 24 16:12:15 2024 -0400
6.3@@ -48,11 +48,15 @@
6.4
6.5 (defpackage :net/codec/dns
6.6 (:nicknames :codec/dns)
6.7- (:use :cl :std :net/core)
6.8+ (:use :cl :std :net/core :net/codec/punycode)
6.9 (:export
6.10 :*record-type-table*
6.11 :record-type-id
6.12- :id-record-type))
6.13+ :id-record-type
6.14+ :decode-record :decode-response
6.15+ :encode-host :decode-host :encode-header :decode-header
6.16+ :encode-query :decode-query
6.17+ :decode-data))
6.18
6.19 (defpackage :net/codec/tlv
6.20 (:nicknames :codec/tlv)
7.1--- a/lisp/lib/net/proto/dns.lisp Tue Apr 23 17:46:12 2024 -0400
7.2+++ b/lisp/lib/net/proto/dns.lisp Wed Apr 24 16:12:15 2024 -0400
7.3@@ -27,10 +27,10 @@
7.4
7.5 (defun try-server (server send send-length recv recv-length &key (attempts 1) (timeout 1))
7.6 (handler-case
7.7- (let ((socket (sb-bsd-sockets:socket-connect server +dns-port+
7.8- :protocol :datagram
7.9- :element-type '(unsigned-byte 8)
7.10- :timeout 1)))
7.11+ (let ((socket (sb-bsd-sockets:socket-connect
7.12+ (make-instance 'inet-socket
7.13+ :type :datagram :protocol :udp)
7.14+ (cons server +dns-port+))))
7.15 (unwind-protect
7.16 (loop repeat attempts
7.17 do (usocket:socket-send socket send send-length)
7.18@@ -38,14 +38,14 @@
7.19 (let ((received (nth-value 1 (usocket:socket-receive socket recv recv-length))))
7.20 (when (and received (< 0 received))
7.21 (return received)))))
7.22- (usocket:socket-close socket)))
7.23- (usocket:socket-error (e)
7.24+ (socket-close socket)))
7.25+ (socket-error (e)
7.26 (values NIL e))))
7.27
7.28 (defmacro with-query-buffer ((send pos hostname type &rest header-args) &body body)
7.29 `(let* ((,send (make-array 512 :element-type '(unsigned-byte 8) :initial-element 0))
7.30- (,pos (codec/dns::encode-header ,send 0 :id 42 :recursion-desired T :question-count 1 ,@header-args))
7.31- (,pos (codec/dns::encode-query ,send ,pos ,hostname :type ,type :class 1)))
7.32+ (,pos (encode-header ,send 0 :id 42 :recursion-desired T :question-count 1 ,@header-args))
7.33+ (,pos (encode-query ,send ,pos ,hostname :type ,type :class 1)))
7.34 (declare (dynamic-extent ,send))
7.35 ,@body))
7.36
7.37@@ -58,7 +58,7 @@
7.38 for recv-length = (try-server server send send-length recv +dns-buffer-length+ :attempts attempts :timeout timeout)
7.39 do (when recv-length
7.40 (with-simple-restart (continue "Skip this DNS server.")
7.41- (return (codec/dns::decode-response server recv 0 recv-length))))
7.42+ (return (decode-response server recv 0 recv-length))))
7.43 finally (with-simple-restart (continue "Return NIL instead.")
7.44 (error 'dns-servers-exhausted)))))))
7.45
7.46@@ -94,129 +94,3 @@
7.47 (values (first list) list T)))
7.48 (dns-condition ()
7.49 (values NIL NIL NIL))))
7.50-
7.51-(define-condition dns-condition ()
7.52- ())
7.53-
7.54-(define-condition dns-server-failure (error dns-condition)
7.55- ((dns-server :initarg :dns-server :reader dns-server)
7.56- (response-code :initarg :response-code :reader response-code))
7.57- (:report (lambda (c s) (format s "DNS server ~% ~a~%responded with failure code ~d~@[~% ~a~]"
7.58- (dns-server c) (response-code c) (response-code-name (response-code c))))))
7.59-
7.60-(define-condition dns-servers-exhausted (error dns-condition)
7.61- ()
7.62- (:report (lambda (c s) (declare (ignore c)) (format s "All DNS servers failed to provide an answer for the query."))))
7.63-
7.64-(defun response-code-name (code)
7.65- (case code
7.66- (0 :success)
7.67- (1 :format-error)
7.68- (2 :server-failure)
7.69- (3 :no-such-domain)
7.70- (4 :not-implemented)
7.71- (5 :query-refused)
7.72- (6 :name-should-not-exist)
7.73- (7 :set-should-not-exist)
7.74- (8 :set-does-not-exist)
7.75- (9 :not-authorized)
7.76- (10 :not-in-zone)
7.77- (11 :type-not-implemented)
7.78- (16 :bad-version)
7.79- (17 :key-not-recognised)
7.80- (18 :bad-time)
7.81- (19 :bad-mode)
7.82- (20 :duplicate-key)
7.83- (21 :bad-algorithm)
7.84- (22 :bad-truncation)
7.85- (23 :bad-cookie)))
7.86-
7.87-(defmacro with-dns-error-handling (&body body)
7.88- `(handler-bind ((dns-server-failure
7.89- (lambda (e)
7.90- (unless (find (response-code e) '(1 3 6 7 8))
7.91- (continue e)))))
7.92- ,@body))
7.93-
7.94-;;; Note: we assume that we never cross byte boundaries when accessing bits.
7.95-(defmacro with-decoding ((octets start &optional (pos (gensym "POS"))) &body body)
7.96- `(let ((,pos ,start))
7.97- (flet ((int1 ()
7.98- (prog1 (logbitp (* 8 (rem ,pos 1)) (aref ,octets (floor ,pos)))
7.99- (incf ,pos 1/8)))
7.100- (int4 ()
7.101- (prog1 (ldb (byte 4 (* 8 (rem ,pos 1))) (aref ,octets (floor ,pos)))
7.102- (incf ,pos 4/8)))
7.103- (int8 ()
7.104- (prog1 (aref ,octets (floor ,pos))
7.105- (incf ,pos 1)))
7.106- (int16 () ;; big-endian
7.107- (prog1 (+ (ash (aref ,octets (+ 0 (floor ,pos))) 8)
7.108- (ash (aref ,octets (+ 1 (floor ,pos))) 0))
7.109- (incf ,pos 2)))
7.110- (int32 ()
7.111- (prog1 (+ (ash (aref ,octets (+ 0 (floor ,pos))) 24)
7.112- (ash (aref ,octets (+ 1 (floor ,pos))) 16)
7.113- (ash (aref ,octets (+ 2 (floor ,pos))) 8)
7.114- (ash (aref ,octets (+ 3 (floor ,pos))) 0))
7.115- (incf ,pos 4))))
7.116- (declare (ignorable #'int1 #'int4 #'int8 #'int16 #'int32))
7.117- ,@body)))
7.118-
7.119-(defmacro with-encoding ((octets start &optional (pos (gensym "POS"))) &body body)
7.120- `(let ((,pos ,start))
7.121- (flet ((int1 (value)
7.122- (let ((octet (aref ,octets (floor ,pos))))
7.123- (setf (ldb (byte 1 (* 8 (rem ,pos 1))) octet)
7.124- (ecase value
7.125- ((0 1) value)
7.126- ((T) 1)
7.127- ((NIL) 0)))
7.128- (setf (aref ,octets (floor ,pos)) octet)
7.129- (incf ,pos 1/8)))
7.130- (int4 (value)
7.131- (let ((octet (aref ,octets (floor ,pos))))
7.132- (setf (ldb (byte 4 (* 8 (rem ,pos 1))) octet) value)
7.133- (setf (aref ,octets (floor ,pos)) octet)
7.134- (incf ,pos 4/8)))
7.135- (int8 (value)
7.136- (setf (aref ,octets (floor ,pos)) value)
7.137- (incf ,pos 1))
7.138- (int16 (value) ;; big-endian
7.139- (setf (aref ,octets (+ 0 ,pos)) (ldb (byte 8 8) value))
7.140- (setf (aref ,octets (+ 1 ,pos)) (ldb (byte 8 0) value))
7.141- (incf ,pos 2))
7.142- (int32 (value) ;; big-endian
7.143- (setf (aref ,octets (+ 0 ,pos)) (ldb (byte 8 24) value))
7.144- (setf (aref ,octets (+ 1 ,pos)) (ldb (byte 8 16) value))
7.145- (setf (aref ,octets (+ 2 ,pos)) (ldb (byte 8 8) value))
7.146- (setf (aref ,octets (+ 3 ,pos)) (ldb (byte 8 0) value))
7.147- (incf ,pos 4)))
7.148- (declare (ignorable #'int1 #'int4 #'int8 #'int16 #'int32))
7.149- ,@body)))
7.150-
7.151-(defmacro maybe-set ((octets offset) &body calls)
7.152- `(with-encoding (,octets ,offset pos)
7.153- ,@(loop for (func value) in calls
7.154- collect `(if ,value
7.155- (,func ,value)
7.156- (incf pos ,(ecase func
7.157- (int1 1/8)
7.158- (int4 4/8)
7.159- (int8 1)
7.160- (int16 2)
7.161- (int32 4)))))
7.162- pos))
7.163-
7.164-(defun split (on string)
7.165- (let ((parts ())
7.166- (buffer (make-string-output-stream)))
7.167- (flet ((finish ()
7.168- (let ((buffer (get-output-stream-string buffer)))
7.169- (push buffer parts))))
7.170- (loop for char across string
7.171- do (if (char= on char)
7.172- (finish)
7.173- (write-char char buffer))
7.174- finally (finish)))
7.175- (nreverse parts)))
8.1--- a/lisp/lib/rdb/err.lisp Tue Apr 23 17:46:12 2024 -0400
8.2+++ b/lisp/lib/rdb/err.lisp Wed Apr 24 16:12:15 2024 -0400
8.3@@ -38,7 +38,11 @@
8.4
8.5 (define-condition ingest-db-error (rocksdb-error)
8.6 ()
8.7- (:documentation "Error signaled while flushing a database."))
8.8+ (:documentation "Error signaled while ingesting a database."))
8.9+
8.10+(define-condition sst-writer-error (rocksdb-error)
8.11+ ()
8.12+ (:documentation "Error signaled while writing a SST file."))
8.13
8.14 (define-condition repair-db-error (rocksdb-error)
8.15 ()
9.1--- a/lisp/lib/rdb/macs.lisp Tue Apr 23 17:46:12 2024 -0400
9.2+++ b/lisp/lib/rdb/macs.lisp Wed Apr 24 16:12:15 2024 -0400
9.3@@ -126,3 +126,20 @@
9.4 ,(if destroy
9.5 `(destroy-db ,db-var)
9.6 `(shutdown-db ,db-var)))))
9.7+;;; sst
9.8+(defmacro with-sst ((sst &key file comparator destroy) &body body)
9.9+ "Do BODY with SST bound to a SST-FILE-WRITER. When FILE is supplied
9.10+the writer will automatically open that file.
9.11+
9.12+When COMPARATOR is supplied it is used as the comparator function for
9.13+the writer. Every key inserted MUST be in ascending order, according
9.14+to the comparator. By default the ordering is binary
9.15+lexicographically.
9.16+
9.17+It is up to the developer to ensure that the comparator used by a
9.18+writer is exactly the same as the comparator used when ingesting the
9.19+file by a RDB instance."
9.20+ `(let ((,sst (make-sst-file-writer ,comparator)))
9.21+ ,@(when file `((open-sst ,sst ,file)))
9.22+ ,@body
9.23+ ,@(when destroy `((destroy-sst ,sst)))))
10.1--- a/lisp/lib/rdb/obj.lisp Tue Apr 23 17:46:12 2024 -0400
10.2+++ b/lisp/lib/rdb/obj.lisp Wed Apr 24 16:12:15 2024 -0400
10.3@@ -413,8 +413,14 @@
10.4 (loop for cf across (rdb-cfs self)
10.5 do (create-cf self cf))))
10.6
10.7-(defmethod ingest-db ((self rdb) (files list) &key)
10.8- (ingest-db-raw (rdb-db self) files))
10.9+(defmethod find-cf ((cf string) (self rdb) &key)
10.10+ "Find a CF by name."
10.11+ (find cf (rdb-cfs self) :key 'rdb-cf-name :test 'equal))
10.12+
10.13+(defmethod ingest-db ((self rdb) (files list) &key cf (opts (rocksdb-ingestexternalfileoptions-create)))
10.14+ (if cf
10.15+ (ingest-db-cf-raw (rdb-db self) (find-cf cf self) files opts)
10.16+ (ingest-db-raw (rdb-db self) files opts)))
10.17
10.18 (defmethod destroy-cfs ((self rdb) &key &allow-other-keys)
10.19 (with-slots (cfs) self
11.1--- a/lisp/lib/rdb/pkg.lisp Tue Apr 23 17:46:12 2024 -0400
11.2+++ b/lisp/lib/rdb/pkg.lisp Wed Apr 24 16:12:15 2024 -0400
11.3@@ -47,6 +47,7 @@
11.4 :sst-put-str-raw
11.5 :open-sst-file :close-sst-file
11.6 ;; proto
11.7+ :find-cf
11.8 :put-key :put-kv
11.9 :get-key :get-kv
11.10 :put-cf-key :get-cf-key
11.11@@ -110,7 +111,8 @@
11.12 :with-cf
11.13 :do-cf
11.14 :with-iter ;; generic
11.15- :do-cfs))
11.16+ :do-cfs
11.17+ :with-sst))
11.18
11.19 (in-package :rdb)
11.20 (rocksdb:load-rocksdb t)
12.1--- a/lisp/lib/rdb/proto.lisp Tue Apr 23 17:46:12 2024 -0400
12.2+++ b/lisp/lib/rdb/proto.lisp Wed Apr 24 16:12:15 2024 -0400
12.3@@ -64,6 +64,8 @@
12.4 (:documentation "Flush the database SELF."))
12.5 (defgeneric sync-db (self other &key) ;;nyi
12.6 (:documentation "Perform a synchronization on SELF using OTHER."))
12.7+(defgeneric find-cf (cf self &key)
12.8+ (:documentation "Find the column-familiy CF in SELF."))
12.9 (defgeneric flush-cf (self cf &key)
12.10 (:documentation "Flush the column-family CF in SELF."))
12.11 (defgeneric repair-db (self &key)
13.1--- a/lisp/lib/rdb/raw.lisp Tue Apr 23 17:46:12 2024 -0400
13.2+++ b/lisp/lib/rdb/raw.lisp Wed Apr 24 16:12:15 2024 -0400
13.3@@ -62,6 +62,15 @@
13.4 do (setf (deref flist i) (make-alien-string f :null-terminate nil)))
13.5 (rocksdb-ingest-external-file db flist flen opts err)))))
13.6
13.7+(defun ingest-db-cf-raw (db cf files &optional (opts (rocksdb-ingestexternalfileoptions-create)))
13.8+ (let ((flen (length files)))
13.9+ (with-errptr (err 'ingest-db-error)
13.10+ (with-alien ((flist (* c-string) (make-alien c-string flen)))
13.11+ (loop for f in files
13.12+ for i from 0 to flen
13.13+ do (setf (deref flist i) (make-alien-string f :null-terminate nil)))
13.14+ (rocksdb-ingest-external-file-cf db cf flist flen opts err)))))
13.15+
13.16 ;;; KVs
13.17 (defun put-kv-raw (db key val &optional (opts (rocksdb-writeoptions-create)))
13.18 (let ((klen (length key))
13.19@@ -222,8 +231,14 @@
13.20 (rocksdb-release-snapshot db snapshot))
13.21
13.22 ;;; SST
13.23-(defun create-sst-writer-raw ()
13.24- (rocksdb-sstfilewriter-create (rocksdb-envoptions-create) (rocksdb-options-create)))
13.25+(defun create-sst-writer-raw (&optional (env-opts (rocksdb-envoptions-create)) (io-opts (rocksdb-options-create)))
13.26+ (rocksdb-sstfilewriter-create env-opts io-opts))
13.27+
13.28+(defun create-sst-writer-with-comparator-raw (comparator
13.29+ &optional
13.30+ (env-opts (rocksdb-envoptions-create))
13.31+ (io-opts (rocksdb-options-create)))
13.32+ (rocksdb-sstfilewriter-create-with-comparator env-opts io-opts comparator))
13.33
13.34 (defun finish-sst-writer-raw (writer)
13.35 (with-errptr (err 'rocksdb-error)
13.36@@ -257,7 +272,7 @@
13.37 (let ((key-octets (string-to-octets key :null-terminate nil))
13.38 (val-octets (string-to-octets val :null-terminate nil)))
13.39 (sst-put-raw writer key-octets val-octets)))
13.40-
13.41+
13.42 (defun sst-put-ts-raw (writer key val ts)
13.43 (with-errptr (err 'rocksdb-error)
13.44 (rocksdb-sstfilewriter-put-with-ts writer key (length key) val (length val) ts (length ts) err)))
14.1--- a/lisp/lib/rdb/sst.lisp Tue Apr 23 17:46:12 2024 -0400
14.2+++ b/lisp/lib/rdb/sst.lisp Wed Apr 24 16:12:15 2024 -0400
14.3@@ -17,10 +17,13 @@
14.4 (defstruct (sst-file-writer (:constructor %make-sst-file-writer (sap)))
14.5 (sap nil :type (or null alien)))
14.6
14.7-(defun make-sst-file-writer (&optional sap)
14.8+(defun make-sst-file-writer (&optional comparator
14.9+ (env-opts (rocksdb-envoptions-create))
14.10+ (io-opts (rocksdb-options-create)))
14.11 (%make-sst-file-writer
14.12- (or sap
14.13- (create-sst-writer-raw))))
14.14+ (if comparator
14.15+ (create-sst-writer-with-comparator-raw comparator env-opts io-opts)
14.16+ (create-sst-writer-raw env-opts io-opts))))
14.17
14.18 (defun sst-file-size (writer)
14.19 (declare (sst-file-writer writer))
15.1--- a/lisp/lib/rdb/tests.lisp Tue Apr 23 17:46:12 2024 -0400
15.2+++ b/lisp/lib/rdb/tests.lisp Wed Apr 24 16:12:15 2024 -0400
15.3@@ -46,6 +46,9 @@
15.4 (rocksdb:rocksdb-iter-seek-to-first iter)
15.5 (dotimes (i 999)
15.6 (rocksdb:rocksdb-iter-next iter)
15.7+ (with-alien ((tslen size-t))
15.8+ (rocksdb-iter-timestamp iter (addr tslen))
15.9+ (is (zerop tslen)))
15.10 (is (rocksdb:rocksdb-iter-valid iter))
15.11 (is (string= (get-kv-str-raw db (iter-key-str-raw iter)) (iter-val-str-raw iter))))
15.12 (rocksdb:rocksdb-iter-next iter)
15.13@@ -55,7 +58,7 @@
15.14 (deftest rdb ()
15.15 "Test RDB struct and methods."
15.16 ;; NOTE: passing a directory with trailing slash causes segfault - guess we gotta handle tht
15.17- (with-db (db (debug! (create-db "/tmp/rdb" :open t)))
15.18+ (with-db (db (create-db "/tmp/rdb" :open t))
15.19 (info! (hash-table-alist (backfill-opts db :full t)))
15.20 ;; get/set without cf
15.21 (put-kv-str-raw (rdb-db db) "key" "val")
15.22@@ -92,6 +95,7 @@
15.23 (iter-seek-to-first it)
15.24 (is (sequence:emptyp (iter-key it)))
15.25 (is (sequence:emptyp (iter-val it)))
15.26+ (is (zerop (nth 1 (multiple-value-list (iter-timestamp it)))))
15.27 (is (not (iter-valid-p it)))
15.28 (iter-seek-to-last it)
15.29 (is (typep (iter-kv it) 'rdb-kv))
15.30@@ -111,12 +115,12 @@
15.31 (rdb-name tmp)
15.32 (get-prop tmp "rocksdb.dbstats")
15.33 (get-prop tmp "rocksdb.levelstats")
15.34- (print-stats tmp)
15.35- )))
15.36+ (print-stats tmp))))
15.37+
15.38
15.39 (deftest metadata ()
15.40 "Test metadata types: CF -> LEVEL -> SST-FILE."
15.41- (with-temp-db (tmp () :open t)
15.42+ (with-temp-db (tmp () :open t :destroy t)
15.43 (insert-key tmp "foo" "bar")
15.44 (flush-db tmp)
15.45 (let ((cf-meta (get-metadata tmp)))
15.46@@ -129,13 +133,17 @@
15.47 (deftest sst ()
15.48 "Test SST-FILE-WRITER and INGEST-DB."
15.49 (with-temp-db (tmp () :open t :destroy t)
15.50+ ;; without macro
15.51 (let ((writer (make-sst-file-writer))
15.52 (path (namestring (merge-pathnames (format nil "~A" (gensym "sst"))))))
15.53 (open-sst writer path)
15.54 (dotimes (i 10000)
15.55 (put-key writer (integer-to-octets i 64) (string-to-octets (format nil "~A" (gensym)))))
15.56 (finish-sst writer) ;; will fail on empty writer
15.57+ (destroy-sst writer)
15.58 (ingest-db tmp (list path))
15.59- (destroy-sst writer)
15.60- (delete-file path))))
15.61+ (delete-file path)
15.62+ ;; with macro
15.63+ (with-sst (s :file path :destroy t)
15.64+ (put-kv s (make-kv "nil" "nil"))))))
15.65
16.1--- a/lisp/std/bit.lisp Tue Apr 23 17:46:12 2024 -0400
16.2+++ b/lisp/std/bit.lisp Wed Apr 24 16:12:15 2024 -0400
16.3@@ -9,13 +9,6 @@
16.4 ;;; Code:
16.5 (in-package :std/bit)
16.6
16.7-;;; Types
16.8-;; Bytes aren't necessarily 8 bits wide in Lisp. OCTET is always 8
16.9-;; bits.
16.10-(deftype octet () '(unsigned-byte 8))
16.11-(deftype octet-vector (&optional length)
16.12- `(simple-array octet (,length)))
16.13-
16.14 ;;; Bits
16.15 (defun make-bits (length &rest args)
16.16 (apply #'make-array length (nconc (list :element-type 'bit) args)))
17.1--- a/lisp/std/pkg.lisp Tue Apr 23 17:46:12 2024 -0400
17.2+++ b/lisp/std/pkg.lisp Wed Apr 24 16:12:15 2024 -0400
17.3@@ -81,11 +81,13 @@
17.4
17.5 (defpkg :std/type
17.6 (:use :cl)
17.7- (:import-from :std/sym :format-symbol)
17.8+ (:import-from :std/sym :format-symbol :with-gensyms)
17.9 (:import-from :std/list :ensure-car)
17.10 (:export :+default-element-type+
17.11 :array-index :array-length
17.12- :negative-integer :non-negative-integer :positive-integer))
17.13+ :negative-integer :non-negative-integer
17.14+ :positive-integer :octet
17.15+ :octet-vector))
17.16
17.17 (defpkg :std/num
17.18 (:use :cl)
17.19@@ -278,14 +280,13 @@
17.20
17.21 (defpkg :std/bit
17.22 (:use :cl)
17.23+ (:import-from :std/type :octet :octet-vector)
17.24 (:export
17.25 :make-bits
17.26 :sign-bit
17.27 :different-signs-p
17.28 :mortify-bits
17.29 :int-list-bits
17.30- :octet
17.31- :octet-vector
17.32 :aref-bit
17.33 :make-bit-vector
17.34 :logbit
17.35@@ -336,6 +337,7 @@
17.36 (defpkg :std/file
17.37 (:use :cl)
17.38 (:import-from :std/macs :define-constant :once-only :eval-always)
17.39+ (:import-from :std/type :octet :octet-vector :array-index :array-length)
17.40 (:export
17.41 :tmpfile
17.42 :file-pathname
18.1--- a/lisp/std/type.lisp Tue Apr 23 17:46:12 2024 -0400
18.2+++ b/lisp/std/type.lisp Wed Apr 24 16:12:15 2024 -0400
18.3@@ -5,6 +5,12 @@
18.4 ;;; Code:
18.5 (in-package :std/type)
18.6
18.7+;; Bytes aren't necessarily 8 bits wide in Lisp. OCTET is always 8
18.8+;; bits.
18.9+(deftype octet () '(unsigned-byte 8))
18.10+(deftype octet-vector (&optional length)
18.11+ `(simple-array octet (,length)))
18.12+
18.13 (defconstant +default-element-type+ 'character)
18.14
18.15 (deftype array-index (&optional (length (1- array-dimension-limit)))
19.1--- a/skelfile Tue Apr 23 17:46:12 2024 -0400
19.2+++ b/skelfile Wed Apr 24 16:12:15 2024 -0400
19.3@@ -14,4 +14,5 @@
19.4 (clean () #$rm -rf .stash$#
19.5 #$cd rust && cargo clean$#
19.6 #$cd emacs && rm -rf */*.elc$#
19.7- #$find lisp -name '*.fasl' -type f -delete$#))
19.8+ #$find lisp -name '*.fasl' -type f -delete$#)
19.9+ (deploy () #$mv .stash/{prelude.core,std.core} $PACKY_DIR$#))
20.1--- a/x.lisp Tue Apr 23 17:46:12 2024 -0400
20.2+++ b/x.lisp Wed Apr 24 16:12:15 2024 -0400
20.3@@ -161,6 +161,7 @@
20.4 (defun x-save (args)
20.5 (if args
20.6 (let ((name (car args)))
20.7+ (ensure-directories-exist *stash-path*)
20.8 (format t "saving core to: ~A~%" (merge-pathnames name *stash-path*))
20.9 (string-case (name)
20.10 ("prelude" (compile-prelude t t))
