test-seq.lisp

   1 (in-package :cl-user)
   2
   3 (declaim (optimize (speed 3) (safety 0) (space 0) (debug 0)))
   4
   5 (defun sse-seq= (seq1 seq2)
   6   (declare (type (simple-array (unsigned-byte 8) (*)) seq1 seq2))
   7   (multiple-value-bind (256blocks rest) (truncate (length seq1) (floor (log (/ 256 8) 2)))
   8     (declare (ignore rest))
   9     (and (= (sb-sys:%primitive sb-vm::%sse-seq= seq1 seq2) 0)
  10          (loop for equal = t
  11                for i from (* 256blocks 32) below (length seq1)
  12                when (/= (aref seq1 i) (aref seq2 i)) do (setq equal nil)
  13                finally (return equal)))))
  14
  15 (defun seq= (seq1 seq2)
  16   (declare (type (simple-array (unsigned-byte 8) (*)) seq1 seq2))
  17   (and (= (length seq1) (length seq2))
  18        (loop for equal = t
  19              for s1 of-type unsigned-byte across seq1
  20              for s2 of-type unsigned-byte across seq2
  21              when (/= s1 s2) do (setq equal nil) (return nil)
  22              finally (return equal))))
  23
  24
  25 (defun test-seq (&optional (test-count 100000))
  26   (let ((arr1 (make-array #.(* 256 1024) :element-type '(unsigned-byte 8) :initial-element 0))
  27         (arr2 (make-array #.(* 256 1024) :element-type '(unsigned-byte 8) :initial-element 0))
  28         (arr3 (make-array #.(* 256 1024) :element-type '(unsigned-byte 8) :initial-element 0))
  29         (arr4 (make-array #.(* 256 1024) :element-type '(unsigned-byte 8) :initial-element 0))
  30         res)
  31
  32     (loop for i from 0 below (length arr1)
  33           do (setf (aref arr1 i) (mod (* (1+ i) 10) 256)
  34                    (aref arr2 i) (aref arr1 i)
  35                    (aref arr3 i) (aref arr1 i)
  36                    (aref arr4 i) (aref arr1 i)
  37                    ))
  38
  39     (setf (aref arr3 1200) (mod (1+ (aref arr3 1200)) 256)
  40           (aref arr4 256000) (mod (1+ (aref arr4 256000)) 256))
  41
  42 ;;    (time (dotimes (i 100000) (sse-seq= arr1 arr2)))
  43 ;;    (time (dotimes (i #.(/ 100000 30)) (seq= arr1 arr2)))
  44
  45     (format t "; seq= a1 a2~%")
  46     (time-sample-form #'(lambda () (dotimes (i (truncate test-count 30)) (setf res (seq= arr1 arr2)))))
  47
  48     (format t "; seq= a1 a3~%")
  49     (time-sample-form #'(lambda () (dotimes (i (truncate test-count 30)) (setf res (seq= arr1 arr3)))))
  50
  51     (format t "; seq= a2 a4~%")
  52     (time-sample-form #'(lambda () (dotimes (i (truncate test-count 30)) (setf res (seq= arr2 arr4)))))
  53
  54
  55     (format t "; sse-seq= a1 a2~%")
  56     (time-sample-form #'(lambda () (dotimes (i test-count) (setf res (sse-seq= arr1 arr2)))))
  57
  58     (format t "; sse-seq= a1 a3~%")
  59     (time-sample-form #'(lambda () (dotimes (i test-count) (setf res (sse-seq= arr1 arr3)))))
  60
  61     (format t "; sse-seq= a2 a4~%")
  62     (time-sample-form #'(lambda () (dotimes (i test-count) (setf res (sse-seq= arr2 arr4)))))
  63
  64     ))