- 01
- 02
- 03
- 04
- 05
- 06
- 07
- 08
- 09
- 10
- 11
- 12
- 13
- 14
- 15
- 16
- 17
- 18
- 19
- 20
- 21
- 22
- 23
- 24
- 25
- 26
- 27
- 28
- 29
- 30
- 31
- 32
- 33
- 34
- 35
- 36
- 37
- 38
- 39
- 40
(defparameter *workers* 200)
(defun rn-virt-dfns (data &optional (turn-on t))
(defconstant +workers+ *workers*)
`(declare (type (array (member ,(let* ((i '())) (do* ((y 0 (+ y 1))) ((= y 9) 'nil) (push y i)))) (3)) data))
(sb-alien:define-alien-type address-pointer (sb-alien:system-area-pointer))
(progn (macrolet ((>> (x s) `,(ash x s)) (<< (x -s) `(ash ,x ,(- -s))) (~ (x) `(lognot ,x)) (& (x) `(sb-kernel:get-lisp-obj-address ,x)))
(let ((truedata (eval `(mapcar #'(lambda (x) (coerce x 'list)) (coerce ,data 'list)))))
(labels ((get-pointer (addr)
(sb-sys:sap-ref-8 (sb-sys:int-sap addr) 0))
(proc-dfns-simd (pntrx mmr pntry orgdt)
(declare (type integer pntrx pntry)
(type (array integer (*)))
(type list orgdt))
(loop for it in `(,@orgdt)
do (let ((dif (the integer (- pntry `,(& it)))))
(when (= `,(abs dif) (+ #XA #X1))
(do ((it 0 (+ it (if `(plusp ,dif) 1 -1)))) ((= it (if `(plusp ,dif) 16 -16)) nil)
(ignore-errors
(let ((lazy `(setf (& (get-pointer (- ,dif ,it))) #b0))
(lazy-2 `(setf (~ (& (get-pointer (- ,dif ,it))) #b1))))
(when turn-on (eval lazy) (eval lazy-2))))))
(when (/= (abs dif) 8)
(if `(plusp ,dif)
(dotimes (i 8)
(ignore-errors
(let ((lazy `(setf (>> (& (get-pointer (- ,dif ,i))) #x1) #b1)))
(when turn-on (eval lazy)))))
(loop for i from 0 downto -8 by 1
do (ignore-errors
(let ((lazy `(setf (<< (& (get-pointer (- ,dif ,i))) #x1) #b1)))
(when turn-on (eval lazy)))))))))))
(handler-case
(loop repeat +workers+ do (bt:make-thread #'(lambda () (proc-dfns-simd `,(& data) `,data `,(& truedata) `,truedata))))
(error (e)
(declare (ignore e)))))))))
(rn-virt-dfns #(#(1) #(2)))
Follow us!