Skip to content
Browse files

adjust logging; add keyword for number of locks

  • Loading branch information...
1 parent b8cd7b9 commit f5fcc60caa1e5b33ac3f618311e8876a94508818 @kraison committed
Showing with 45 additions and 42 deletions.
  1. +1 −1 serialize.lisp
  2. +27 −25 store.lisp
  3. +13 −13 transaction.lisp
  4. +4 −3 vivace-graph-v2-package.lisp
2 serialize.lisp
@@ -167,7 +167,7 @@
(let ((tx (nth 0 args)))
;;(serialize (length (tx-queue tx)) stream)
(dolist (a (reverse (tx-queue tx)))
- (logger :info "TX: serializing ~A / ~A~%" (first a) (rest a))
+ (logger :debug "TX: serializing ~A / ~A~%" (first a) (rest a))
(apply #'serialize-action
(nconc (list (first a) stream) (rest a))))))
52 store.lisp
@@ -38,37 +38,38 @@
(sort result #'string>)))
(defun make-fresh-store (name location &key (num-locks 10000))
- (let ((store
- (make-instance 'local-triple-store
- :name name
- :location location
- :main-idx (make-hierarchical-index)
- :lock-pool (make-lock-pool num-locks)
- :locks (make-hash-table :synchronized t :test 'equal)
- :text-idx (make-instance 'montezuma:index
- :path
- (format nil "~A/text-idx"
- location))
- :log-mailbox (sb-concurrency:make-mailbox)
- :index-queue (sb-concurrency:make-queue)
- :delete-queue (sb-concurrency:make-queue)
- :templates (make-hash-table :synchronized t
- :test 'eql)
- :indexed-predicates (make-hash-table :synchronized t
- :test 'equalp))))
+ (let* ((text-dir (merge-pathnames (format nil "~A/text-idx/" location)))
+ (store
+ (make-instance 'local-triple-store
+ :name name
+ :location location
+ :main-idx (make-hierarchical-index)
+ :lock-pool (make-lock-pool num-locks)
+ :locks (make-hash-table :synchronized t :test 'equal)
+ :text-idx (make-instance 'montezuma:index
+ :path text-dir)
+ :log-mailbox (sb-concurrency:make-mailbox)
+ :index-queue (sb-concurrency:make-queue)
+ :delete-queue (sb-concurrency:make-queue)
+ :templates (make-hash-table :synchronized t
+ :test 'eql)
+ :indexed-predicates (make-hash-table
+ :synchronized t
+ :test 'equalp))))
(add-to-index (main-idx store) (make-uuid-table :synchronized t) :id-idx)
(setf (logger-thread store) (start-logger store))
-(defun make-local-triple-store (name location)
- (make-fresh-store name location))
+(defun make-local-triple-store (name location &key (num-locks 10000))
+ (make-fresh-store name location :num-locks num-locks))
(defun create-triple-store (&key name if-exists? location host port
- user password)
+ user password num-locks)
(declare (ignore if-exists?))
(setq *graph* (or name location (format nil "~A:~A" host port)))
(if location
- (let ((store (make-local-triple-store *graph* location)))
+ (let ((store (make-local-triple-store
+ *graph* location :num-locks num-locks)))
(if (triple-store? store)
(setf (gethash (store-name store) *store-table*) store
*store* store)
@@ -93,7 +94,7 @@
(montezuma:close (text-idx store))
-(defun open-triple-store (&key name location host port user password)
+(defun open-triple-store (&key name location host port user password num-locks)
(let ((store (create-triple-store :name name
:location location
:if-exists? :open
@@ -101,7 +102,8 @@
:port port
:user user
:port port
- :password password)))
+ :password password
+ :num-locks num-locks)))
(restore-triple-store store)
(setq *store* store)))
@@ -131,7 +133,7 @@
(multiple-value-bind (subject predicate object graph)
(intern-spog subject predicate object graph)
(let ((lock nil) (pattern (list subject predicate object graph)))
- (logger :info "~A: Locking pattern ~A~%" *current-transaction* pattern)
+ (logger :debug "~A: Locking pattern ~A~%" *current-transaction* pattern)
(sb-ext:with-locked-hash-table ((locks store))
(setq lock
(or (gethash pattern (locks store))
26 transaction.lisp
@@ -102,11 +102,11 @@
(maphash #'(lambda (id triple)
(declare (ignore id))
(when (persistent? triple)
- (logger :info "serializing ~A: ~A"
+ (logger :debug "serializing ~A: ~A"
(triple-id triple) triple)
(serialize triple stream)))
(gethash :id-idx (index-table (main-idx store)))))
- (logger :info "Recording null byte")
+ (logger :debug "Recording null byte")
(write-byte 0 stream)
(force-output stream)))
@@ -145,13 +145,13 @@
(defun dump-transaction (stream tx)
(when (and (transaction? tx) (tx-queue tx))
- (logger :info "Dumping tx ~A to ~A" tx stream)
+ (logger :debug "Dumping tx ~A to ~A" tx stream)
(serialize-action :transaction stream tx)
(force-output stream)))
(defun record-tx (tx store)
(when (and (transaction? tx) (tx-queue tx))
- (logger :info "Recording tx ~A~%" (reverse (tx-queue tx)))
+ (logger :debug "Recording tx ~A~%" (reverse (tx-queue tx)))
(with-open-file (stream
(format nil "~A/tx-~A-~A" (location store)
@@ -176,7 +176,7 @@
(let ((msg (sb-concurrency:receive-message mailbox)))
- (logger :info "tx-log thread received message ~A" msg)
+ (logger :debug "tx-log thread received message ~A" msg)
(typecase msg
(transaction (record-tx msg store))
@@ -187,12 +187,12 @@
(set-clean store)
- (logger :info "Processing all pending messages.")
+ (logger :debug "Processing all pending messages.")
- (logger :info "Processing message ~A" msg)
+ (logger :debug "Processing message ~A" msg)
(when (transaction? msg)
(record-tx msg store)))
;;(logger :info "Snapshotting the store.")
@@ -204,9 +204,9 @@
(logger :info "Snapshot commencing")
(snapshot store)
- (logger :info "Snapshot complete. Set store CLEAN")
+ (logger :debug "Snapshot complete. Set store CLEAN")
(set-clean store)
- (logger :info "Store set CLEAN")
+ (logger :debug "Store set CLEAN")
(setq last-snapshot (gettimeofday))
(logger :info "Snapshot finished"))
@@ -246,18 +246,18 @@
"Unable to execute transaction. Too may retries (~A)."
(let ((*current-transaction* (make-transaction :store store)))
- (logger :info "~A execute-tx starting" *current-transaction*)
+ (logger :debug "~A execute-tx starting" *current-transaction*)
(sb-ext:with-timeout timeout
(funcall fn))
(sb-ext:timeout (condition)
- (logger :info "~A execute-tx timeout ~A"
+ (logger :debug "~A execute-tx timeout ~A"
*current-transaction* condition)
(rollback-tx *current-transaction*)
(release-all-locks *current-transaction*)
(execute-tx store fn timeout max-tries (1+ retries)))
(error (condition)
- (logger :info "~A execute-tx error ~A"
+ (logger :debug "~A execute-tx error ~A"
*current-transaction* condition)
(rollback-tx *current-transaction*)
(release-all-locks *current-transaction*)
@@ -266,7 +266,7 @@
(format nil "Unable to execute transaction: ~A"
(:no-error (result)
- (logger :info "~A execute-tx success (~A)"
+ (logger :debug "~A execute-tx success (~A)"
*current-transaction* result)
(when (tx-queue *current-transaction*)
7 vivace-graph-v2-package.lisp
@@ -1,9 +1,9 @@
(in-package #:cl-user)
(defpackage #:vivace-graph-v2
- (:use #:cl
- #:cffi
- #:bordeaux-threads
+ (:use #:cl
+ #:cffi
+ #:bordeaux-threads
(:export #:*store*
@@ -11,6 +11,7 @@
+ #:snapshot

0 comments on commit f5fcc60

Please sign in to comment.
Something went wrong with that request. Please try again.