From b7bc9a4e8d426a811765e5ac4e17fa9d305c444c Mon Sep 17 00:00:00 2001 From: Andrey Kotlarski Date: Wed, 12 Sep 2018 00:03:28 +0300 Subject: [PATCH] Unroll inexact comparisons too and use array instead of alist to store received results. --- filter.lisp | 108 ++++++++++++++++++++-------------------------- storage-file.lisp | 32 +++++++------- utils.lisp | 6 ++- 3 files changed, 69 insertions(+), 77 deletions(-) diff --git a/filter.lisp b/filter.lisp index 93b15fa..a731500 100644 --- a/filter.lisp +++ b/filter.lisp @@ -97,34 +97,33 @@ This a bit pessimistic." (with-slots ((offset1 offset) (size1 size)) field1 (with-slots ((offset2 offset) (size2 size) (filter2 filter)) field2 (cond ((null filter2) ;regex is taken from a field - `(progn - (loop for i fixnum from ,offset1 - below ,(+ offset1 size1) - for j fixnum from (the fixnum (+ ,offset-var ,offset1)) - do (setf (aref ,line-var i) - (code-char (aref ,buffer-var j)))) - (loop for i fixnum from ,offset2 - below ,(+ offset2 size2) - for j fixnum from (the fixnum (+ ,offset-var ,offset2)) - do (setf (aref ,line-var i) - (code-char (aref ,buffer-var j)))) - (cl-ppcre:scan (subseq ,line-var ,offset2 - :end ,(+ offset2 size2)) - ,line-var :start ,offset1 - :end ,(+ offset1 size1)))) + `(progn (loop for i fixnum from ,offset1 + below ,(+ offset1 size1) + for j fixnum from (+ ,offset-var ,offset1) + do (setf (aref ,line-var i) + (code-char (aref ,buffer-var j)))) + (loop for i fixnum from ,offset2 + below ,(+ offset2 size2) + for j fixnum from (+ ,offset-var ,offset2) + do (setf (aref ,line-var i) + (code-char (aref ,buffer-var j)))) + (cl-ppcre:scan (subseq ,line-var ,offset2 + :end ,(+ offset2 size2)) + ,line-var :start ,offset1 + :end ,(+ offset1 size1)))) ((simple-regex? filter2) ;use plain search instead of regex `(search ,(ascii:string-to-ub filter2) ,buffer-var :start1 ,offset2 :end1 ,(+ offset2 size2) - :start2 (the fixnum (+ ,offset-var ,offset1)) - :end2 (the fixnum (+ ,offset-var ,(+ offset1 size1))))) - (t `(progn - (loop for i fixnum from ,offset1 - below ,(+ offset1 size1) - for j fixnum from (the fixnum (+ ,offset-var ,offset1)) - do (setf (aref ,line-var i) - (code-char (aref ,buffer-var j)))) - (cl-ppcre:scan ,filter2 ,line-var :start ,offset1 - :end ,(+ offset1 size1)))))))) + :start2 (+ ,offset-var ,offset1) + :end2 (+ ,offset-var ,(+ offset1 size1)))) + (t `(progn (loop for i fixnum from ,offset1 + below ,(+ offset1 size1) + for j fixnum from (+ ,offset-var ,offset1) + do (setf (aref ,line-var i) + (code-char (aref ,buffer-var j)))) + (cl-ppcre:scan ,filter2 ,line-var + :start ,offset1 + :end ,(+ offset1 size1)))))))) (defmethod gen-field-clause-raw (op field1 field2) "Generate code for a comparison clause over raw byte buffer." @@ -132,39 +131,26 @@ This a bit pessimistic." (with-slots ((offset1 offset) (size1 size) (filter1 filter)) field1 (with-slots ((offset2 offset) (size2 size) (filter2 filter)) field2 (let ((size (min size1 size2))) - (cond ((= 1 size) ;optimize single character comparison - (list (translate-op op t) - (if filter1 ;string literal? - (char-code (aref filter1 0)) - `(aref ,buffer-var (the fixnum (+ ,offset-var ,offset1)))) - (if filter2 - (char-code (aref filter2 0)) - `(aref ,buffer-var (the fixnum (+ ,offset-var ,offset2)))))) - ((and (or filter1 filter2) (member op '(= /=))) - `(and ,@(loop for i from 0 below size ;unroll exact comparison - collect (list op - (if filter1 - (char-code (aref filter1 i)) - `(aref ,buffer-var - (the fixnum (+ ,offset-var - ,(+ offset1 i))))) - (if filter2 - (char-code (aref filter2 i)) - `(aref ,buffer-var - (the fixnum (+ ,offset-var - ,(+ offset2 i))))))))) - (t `(,(translate-op op) - ,(if filter1 - (ascii:string-to-ub filter1) - buffer-var) - ,(if filter2 - (ascii:string-to-ub filter2) - buffer-var) - ,@(if filter1 - (list :start1 offset1 :end1 (the fixnum (+ offset1 size))) - `(:start1 (the fixnum (+ ,offset-var ,offset1)) - :end1 (the fixnum (+ ,offset-var ,(+ offset1 size))))) - ,@(if filter2 - (list :start2 offset2 :end2 (the fixnum (+ offset2 size))) - `(:start2 (the fixnum (+ ,offset-var ,offset2)) - :end2 (the fixnum (+ ,offset-var ,(+ offset2 size)))))))))))) + (flet ((gen-field1-char (i) + (if filter1 ;string literal? + (char-code (aref filter1 i)) + `(aref ,buffer-var (+ ,offset-var ,(+ offset1 i))))) + (gen-field2-char (i) + (if filter2 + (char-code (aref filter2 i)) + `(aref ,buffer-var (+ ,offset-var ,(+ offset2 i)))))) + (cond ((= 1 size) ;optimize single character comparison + (list op (gen-field1-char 0) (gen-field2-char 0))) + ((member op '(= /=)) + `(and ,@(loop for i from 0 below size ;unroll exact comparison + collect (list op (gen-field1-char i) + (gen-field2-char i))))) + (t (let ((last-i (1- size))) + `(cond + ,@(loop for i from 0 below last-i + collect (let ((op1 (gen-field1-char i)) + (op2 (gen-field2-char i))) + `((/= ,op1 ,op2) + ,(list op op1 op2)))) + (t ,(list op (gen-field1-char last-i) + (gen-field2-char last-i)))))))))))) diff --git a/storage-file.lisp b/storage-file.lisp index 856d959..85447db 100644 --- a/storage-file.lisp +++ b/storage-file.lisp @@ -136,10 +136,11 @@ to raw byte buffer and current line offset within it respectively." (progn (loop for i fixnum from 0 below ,jobs do (lparallel:submit-task chan #'mapper i)) - (let ((ready-res nil) + (let ((ready-res (make-array 0 :fill-pointer 0 :adjustable t)) (next 1)) - (declare (type list ready-res) - (type fixnum next)) + (declare (type (vector (cons fixnum ,(or result-type t))) ready-res) + (type fixnum next) + (dynamic-extent ready-res)) (loop with more? = t while more? do (destructuring-bind (res . job-id) @@ -147,18 +148,18 @@ to raw byte buffer and current line offset within it respectively." (if job-id (lparallel:submit-task chan #'mapper job-id) (setf more? nil)) - (push res ready-res)) - #1=(loop for res = (assoc next ready-res) + (vector-push-extend res ready-res)) + #1=(loop for res = (find next ready-res :key #'car) while res do (locally - (declare (type (cons fixnum ,result-type) + (declare (type (cons fixnum ,(or result-type t)) res)) (setf result (,reduce-fn result (cdr res)) ready-res (delete next ready-res - :key #'car))) + :key #'car :test #'=))) (incf next))) (lparallel:do-fast-receives (res chan (1- ,jobs)) - (push (car res) ready-res) + (vector-push-extend (car res) ready-res) #1#))) (lparallel:end-kernel)) result)) @@ -238,9 +239,10 @@ to raw byte buffer and current line offset within it respectively." (unwind-protect (let ((portion-count 0) (next 1) - (ready-res nil)) + (ready-res (make-array 0 :fill-pointer 0 :adjustable t))) (declare (type fixnum portion-count next) - (type list ready-res)) + (type (vector (cons fixnum ,(or result-type t))) ready-res) + (dynamic-extent ready-res)) (loop for i fixnum from 0 below ,jobs for bytes fixnum = (read-sequence (aref ,buffer-array i) ins) until (zerop bytes) @@ -256,19 +258,19 @@ to raw byte buffer and current line offset within it respectively." (setf more? nil) (lparallel:submit-task chan #'mapper bytes job-id (incf portion-count)))) - (push res ready-res)) - #1=(loop for res = (assoc next ready-res) + (vector-push-extend res ready-res)) + #1=(loop for res = (find next ready-res :key #'car) while res do (locally - (declare (type (cons fixnum ,result-type) + (declare (type (cons fixnum ,(or result-type t)) res)) (setf result (,reduce-fn result (cdr res)) ready-res (delete next ready-res - :key #'car))) + :key #'car :test #'=))) (incf next))) (lparallel:do-fast-receives (res chan (min portion-count (1- ,jobs))) - (push (car res) ready-res) + (vector-push-extend (car res) ready-res) #1#))) (lparallel:end-kernel)) result)) diff --git a/utils.lisp b/utils.lisp index 2b65721..4c649f4 100644 --- a/utils.lisp +++ b/utils.lisp @@ -134,7 +134,11 @@ LINE-VAR in this case is treated as the byte buffer." :reduce-fn '+ :jobs jobs :result-var 'result :result-initform 0 :result-type 'fixnum))) -(declaim (inline append-vec)) +(declaim (inline append-vec) + (type (function ((vector (simple-array simple-base-string)) + (vector (simple-array simple-base-string))) + (vector (simple-array simple-base-string))) + append-vec)) (defun append-vec (vec1 vec2) "Append VEC2 to the end of VEC1."