1. Haskell / Говнокод #29143

    0

    1. 01
    2. 02
    3. 03
    4. 04
    5. 05
    6. 06
    7. 07
    8. 08
    9. 09
    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
    (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)))

    Запостил: lisp-worst-code, 08 Июня 2025

    Комментарии (5) RSS

    Добавить комментарий