example-test.lisp

   1 (in-package :cl-user)
   2
   3 (defun test-foo ()
   4   (let ((arr1 (make-array 10 :element-type 'single-float :initial-element 0f0))
   5         (arr2 (make-array 10 :element-type 'single-float :initial-element 0f0)))
   6
   7     (loop for i from 0 below 10
   8           do (setf
   9               (aref arr1 i) (float (* i 100))
  10               (aref arr2 i) (float i)))
  11
  12     (format t "Before: ~S~%~S~%" arr1 arr2)
  13     (format t "b <- a + b, idx 0~%")
  14
  15     (sb-sys:%primitive sb-vm::%sse-add/simple-array-single-float-1 arr2 arr2 arr1 0)
  16
  17     (format t "After: ~S~%~S~%" arr1 arr2)
  18
  19     (format t "a <- sqrt(b), idx 4~%")
  20
  21     (sb-sys:%primitive sb-vm::%sse-sqrt/simple-array-single-float-1 arr1 arr2 4)
  22
  23     (format t "After: ~S~%~S~%" arr1 arr2)
  24
  25     ))
  26
  27 (defun test-2 ()
  28   (let ((arr1 (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0))
  29         (arr2 (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
  30
  31     (loop for i from 0 below 16 do (setf (aref arr1 i) (* (1+ i) 10)
  32                                          (aref arr2 i) (1+ i)))
  33
  34     (format t "Before: ~S~%~S~%" arr1 arr2)
  35     (format t "b <- a+b, idx 4~%")
  36
  37     (sb-sys:%primitive sb-vm::%sse-add/simple-array-unsigned-byte-8-1 arr2 arr1 arr2 4)
  38
  39     (format t "After: ~S~%~S~%" arr1 arr2)
  40
  41     ))
  42
  43 (defparameter +sse-highbit-single-float-mask+ (make-array 16 :element-type '(unsigned-byte 8)
  44                                                        :initial-contents '(0 0 0 128
  45                                                                            0 0 0 128
  46                                                                            0 0 0 128
  47                                                                            0 0 0 128)))
  48 (defparameter +sse-lowbits-single-float-mask+ (make-array 16 :element-type '(unsigned-byte 8)
  49                                                        :initial-contents '(255 255 255 127
  50                                                                            255 255 255 127
  51                                                                            255 255 255 127
  52                                                                            255 255 255 127)))
  53
  54 (defun sign (float-array)
  55   (let ((res (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
  56
  57     (sb-sys:%primitive sb-vm::%SSE-AND/SIMPLE-ARRAY-SINGLE-FLOAT/SIMPLE-ARRAY-UNSIGNED-BYTE-8-1
  58                        res
  59                        float-array
  60                        +sse-highbit-single-float-mask+
  61                        0)
  62     (values-list (mapcar #'(lambda (x) (/= x 0)) (list (aref res 3) (aref res 7) (aref res 11) (aref res 15))))))
  63
  64 (defun %neg (float-array)
  65   (let ((res (make-array 4 :element-type 'single-float :initial-element 0f0)))
  66
  67     (sb-sys:%primitive sb-vm::%SSE-XOR/SIMPLE-ARRAY-SINGLE-FLOAT/SIMPLE-ARRAY-UNSIGNED-BYTE-8-1
  68                        res
  69                        float-array
  70                        +sse-highbit-single-float-mask+
  71                        0)
  72     res))
  73
  74 (defun %abs (float-array)
  75   (let ((res (make-array 4 :element-type 'single-float :initial-element 0f0)))
  76
  77     (sb-sys:%primitive sb-vm::%SSE-AND/SIMPLE-ARRAY-SINGLE-FLOAT/SIMPLE-ARRAY-UNSIGNED-BYTE-8-1
  78                        res
  79                        float-array
  80                        +sse-lowbits-single-float-mask+
  81                        0)
  82     res))
  83
  84 (defun test-sign ()
  85   (let ((arr1 (make-array 10 :element-type 'single-float :initial-element 0f0)))
  86     (loop for i from 0 below 10 do (setf (aref arr1 i)
  87                                          (float (* (expt -1 i) (- (* (1+ i) 10) (* 2 i i))))))
  88     (format t "array: ~S~%" arr1)
  89     (multiple-value-bind (s1 s2 s3 s4) (sign arr1)
  90       (format t "sign0->3: ~A ~A ~A ~A~%" s1 s2 s3 s4))
  91     (format t "neg: ~S~%" (%neg arr1))
  92     (format t "abs: ~S~%" (%abs arr1))
  93     t))