Skip to content
Permalink
Browse files

Fixed configure. Main and interpreter updated for memory size tracking

  • Loading branch information...
Esko Nuutila Esko Nuutila
Esko Nuutila authored and Esko Nuutila committed Jun 21, 2015
1 parent baa59dd commit 8bb216be7651539b0ce224b76e98e4c60aa6bd8b
Showing with 55 additions and 6 deletions.
  1. +9 −2 configure
  2. +12 −0 src/main/main.lisp
  3. +32 −4 src/rete/interpreter.lisp
  4. +2 −0 src/rete/rete-classes.lisp
@@ -102,10 +102,11 @@ fi
echo "Creating Makefile"
{
if [ $LISPTYPE=sbcl ]; then
INSTANS_HOME=`pwd`
cat <<EOF
DYNAMIC_SPACE_SIZE=$DYNAMIC_SPACE_SIZE
VERSION := \$(subst SBCL ,,\$(shell sbcl --version))
CACHE=\$(subst VERSION,\$(VERSION),\$(HOME)/.cache/common-lisp/sbcl-VERSION-macosx-x64\$(HOME)/instans/)
CACHE=\$(subst VERSION,\$(VERSION),${HOME}/.cache/common-lisp/sbcl-VERSION-macosx-x64${INSTANS_HOME})
EOF
fi
cat <<EOF
@@ -131,7 +132,13 @@ all: \$(EXECUTABLE)
--load-system instans \\
--eval '(in-package :instans)'
.PHONY: all
show-cache:
ls -d \$(CACHE)
cache-contents:
ls -lR \$(CACHE)
.PHONY: all show-cache cache-contents
EOF
if [ $LISPTYPE=sbcl ]; then
cat <<EOF
@@ -160,6 +160,7 @@
;; expected
debug
reporting
report-memory-sizes-file
rete-html-file)
(labels ((valid-value-p (value accepted-values &key test)
(or (funcall test value accepted-values)
@@ -491,6 +492,15 @@
unless (member (first tail) '(:select :construct :modify :rete-add :rete-remove :queue :call-succ-nodes :all :memory-summaries :memory-sizes :rdf-operations :execute))
do (usage))
(initialize-reporting instans reporting))
(report-sizes-file
:options ("--report-sizes-file=FILE")
:usage ("The CSV file to contain the sizes")
(setf report-memory-sizes-file value)
(unless (getf reporting :memory-sizes)
(setf reporting (cons :memory-sizes (cons 1 reporting))))
(setf (instans-memory-sizes-report-stream instans) (open-file report-memory-sizes-file :direction :output :if-exists :supersede :fmt "main: open ~{~A~^ ~}"))
(initialize-reporting instans reporting)
(report-memory-sizes-headers instans))
(prefix-encoding
:options ("--prefix-encoding=BOOL")
:usage ("If true, use known prefixes when printing IRIs. If false (the default), print IRIs as such.")
@@ -530,4 +540,6 @@
(when time-output-stream
(output-time "Done")
(close-stream-not-stdout-stderr time-output-stream))
(when report-memory-sizes-file
(close-stream-not-stdout-stderr (instans-memory-sizes-report-stream instans)))
(instans-close-open-streams instans)))))
@@ -347,7 +347,6 @@
(t
(error* "Illegal op ~S" op)))))))))


(defgeneric initialize-reporting (instans reporting)
(:method ((this instans) reporting)
(setf (instans-report-operation-kinds this) reporting)
@@ -359,9 +358,13 @@
(let ((store-sizes-alist (loop for (node . store) in (instans-stores this) collect (list node store (hash-table-count store)))))
(setf (instans-store-sizes-alist this) store-sizes-alist))
(let ((index-sizes-alist (loop for index in (instans-indices this) collect (list index (hash-table-count (hash-token-index-table index))))))
(setf (instans-index-sizes-alist this) index-sizes-alist)))))
(setf (instans-index-sizes-alist this) index-sizes-alist))
;; (inform "~A" (instans-store-sizes-alist this))
;; (inform "~A" (instans-index-sizes-alist this))
)))


(defgeneric report-sizes (instans)
(defgeneric report-memory-summaries (instans)
(:method ((this instans))
(let ((stream (instans-default-output this)))
(loop for item in (instans-store-sizes-alist this)
@@ -410,15 +413,40 @@
(format stream "queue-select-count = ~S~%" (rule-instance-queue-select-count queue))
(format stream "queue-modify-count = ~S~%" (rule-instance-queue-modify-count queue))))))

(defgeneric report-memory-sizes-headers (instans)
(:method ((this instans))
(let ((store-names (loop for item in (instans-store-sizes-alist this) collect (node-name (first item))))
(index-names (loop for item in (instans-index-sizes-alist this) collect (hash-token-index-id (first item)))))
(format (instans-memory-sizes-report-stream this) "~&~(~{~A~^,~}~)~%" (append store-names index-names)))))

(defgeneric report-memory-sizes (instans)
(:method ((this instans))
(let* ((deltap (instans-memory-sizes-report-delta-p this))
(store-sizes (loop for item in (instans-store-sizes-alist this)
for count = (third item)
for new-count = (hash-table-count (second item))
do (setf (third item) new-count)
collect (if deltap (- new-count count) new-count)))
(index-sizes (loop for item in (instans-index-sizes-alist this)
for count = (second item)
for new-count = (hash-table-count (hash-token-index-table (first item)))
do (setf (second item) new-count)
collect (if deltap (- new-count count) new-count))))
(format (instans-memory-sizes-report-stream this) "~&~{~A~^,~}~%" (append store-sizes index-sizes)))))

(defgeneric execute-rules (instans &optional policy)
(:method ((this instans) &optional policy)
(unless policy (setf policy (instans-queue-execution-policy this)))
(let ((queue (instans-rule-instance-queue this)))
; (inform "(instans-size-report-interval this) = ~A" (instans-size-report-interval this))
(when (instans-memory-summaries-report-interval this)
(when (zerop (mod (instans-memory-summaries-report-counter this) (instans-memory-summaries-report-interval this)))
(report-sizes this))
(report-memory-summaries this))
(incf (instans-memory-summaries-report-counter this)))
(when (instans-memory-sizes-report-interval this)
(when (zerop (mod (instans-memory-sizes-report-counter this) (instans-memory-sizes-report-interval this)))
(report-memory-sizes this))
(incf (instans-memory-sizes-report-counter this)))
(if (operation-report-p this :execute)
(format (instans-default-output this) "~&~A: Execute rules with policy ~A~%~%" (instans-name this) policy))
(case policy
@@ -289,6 +289,8 @@
(indices :accessor instans-indices :initform nil)
(memory-sizes-report-interval :accessor instans-memory-sizes-report-interval :initform nil)
(memory-sizes-report-counter :accessor instans-memory-sizes-report-counter :initform 0)
(memory-sizes-report-delta-p :accessor instans-memory-sizes-report-delta-p :initform nil)
(memory-sizes-report-stream :accessor instans-memory-sizes-report-stream :initform t)
(memory-summaries-report-interval :accessor instans-memory-summaries-report-interval :initform nil)
(memory-summaries-report-counter :accessor instans-memory-summaries-report-counter :initform 0)
(store-sizes-alist :accessor instans-store-sizes-alist :initform 0)

0 comments on commit 8bb216b

Please sign in to comment.
You can’t perform that action at this time.