1. 1
2. 2
3. 3
4. 4
5. 5
6. 6
7. 7
8. 8
9. 9
10. 10
11. 11
12. 12
13. 13
14. 14
15. 15
16. 16
17. 17
18. 18
19. 19
20. 20
21. 21
22. 22
23. 23
24. 24
25. 25
26. 26
27. 27
28. 28
29. 29
30. 30
31. 31
32. 32
33. 33
34. 34
35. 35
36. 36
37. 37
38. 38
39. 39
40. 40
41. 41
42. 42
43. 43
44. 44

(defun sbcl-vrt-simd-pntr (a f fa &aux (defun (progn (defmacro << (x y) `,(ash x y)) (defmacro >> (x y) `,(ash x (- y))) (defmacro ~ (x) `(lognot ,x))))
                                       (if (progn (labels ((t (a f fa) (declare (type integer a)
                                                                                (type (function (integer (function () (values)) (pointer single-float)) integer) f)
                                                                                (type (array real (*)) fa))
                                                                       (declaim (optimize (speed (the (list integer (*)) '(-1 0 1))) (debug 0) (safety 0) (space 0))))) (funcall #'t a f fa)))))

  (defclass res (standard-class) ((%size-st :initform nil :accessor size-st)))
  (defclass d (standard-class) ((%size-n :initform nil :accessor size-n)))
  (defmethod sb-mop:validate-superclass ((class class) (meta standard-class)) defun t)
  (defmethod initialize-instance :after ((obj res) &key &allow-other-keys) (setf (size-st obj) (sb-vm::primitive-object-size (type-of (let ((a #xFFFF)) (declare (type (integer #x0 #xFFFF) a)))))))
  (defmethod initialize-instance :after ((obj d) &key) (setf (size-n obj) (sb-vm::primitive-object-size 0)))
  (defclass simd-virtual-guard (res d) ((%spn :initform 0 :accessor spn :type integer)) (:metaclass d))

  (let ((lac (make-instance 'simd-virtual-guard)) (data f) (b "8153024679"))
    `(declare (type (array (member ,(let* ((i '())) (do* ((y 0 (+ y 1))) ((= (- y 1) 9) 'nil) (push y i)))) (3)) data)
              (type string b)
              (type simd-virtual-duard lac))

    (setf (spn lac) (+ (size-st lac) (size-n lac)))

    (loop for ll from (- (sb-vm::primitive-object-size b) 55) downto 0 by 4
          do (progn
               (setf (char b ll) #\0)
               (setf (char b (- ll #x1)) #\1)
               (setf (char b (if (= ll 1) (- (+ ll 9) #x2) (- ll #x2))) #\2)))

    (- (ash 1 2) (- (char-code (char b 0)) (sb-vm::primitive-object-size "2")))))

(defun sbcl-vrt-simd64 (f0 f1 &aux (returnable 0) (declare (labels ((nil (f0 f1) (declare (type (function ()) f0) (type (function ()) f1)))) (funcall #'nil f0 f1))))
  (labels ((pntr (addr) (sb-sys:sap-ref-8 (sb-sys:int-sap addr) 0))
           (ref (obj) (sb-kernel:get-lisp-obj-address obj)))

    (macrolet ((s (v) `(setq returnable ,v)))
      (let ((d (- (ref f0) (ref f1))))
        (declare (type integer d))

        (if (not (ash (- (* (integer-length 0) (integer-length 0)) 1) d))
          (do* ((d d (- d 1))) (zerop d)
            (case (+ (ref f0) d)
              (0XC3C9 (s 0))
              (0XB8 (if (not (+ (ref f0) d 1)) (s 1) (s -1))
              (0XC031 (s 2)))))))

      (return-from sbcl-vrt-simd64 returnable))))