Skip to content

Commit

Permalink
Unroll inexact comparisons too and use array instead of alist to store
Browse files Browse the repository at this point in the history 
received results.
  • Loading branch information
@m00natic
m00natic committed Sep 12, 2018
1 parent af1f3a5 commit b7bc9a4
Show file tree
Hide file tree
Showing 3 changed files with 69 additions and 77 deletions.
108 changes: 47 additions & 61 deletions filter.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,74 +97,60 @@ 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."
(declare (special buffer-var offset-var))
(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))))))))))))
32 changes: 17 additions & 15 deletions storage-file.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -136,29 +136,30 @@ 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)
(lparallel:receive-result chan)
(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))
Expand Down Expand Up @@ -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)
Expand All @@ -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))
Expand Down
6 changes: 5 additions & 1 deletion utils.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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."
Expand Down

0 comments on commit b7bc9a4

Please sign in to comment.