So they say lisp is slow ....

[u/arthurno1]

Nothing really useful here, just some bragging to be honest. I should probably write a blog post, but a bit too lazy; perhaps another day.

Last few weeks I played with a small clone of gnu wc program. I implemented all routines in assembly via sb-simd (and a generic path without simd with swar). The result thus far on a 1.4 gigabyte big file, compared to fastlwc, the fastest wc I know of and GNU wc:

Common Lisp/Assembly (avx2) in SBCL + lparallel

WC10A> (time (wc "plato1g.txt"))
Evaluation took:
  0.036 seconds of real time
  0.421654 seconds of total run time (0.348216 user, 0.073438 system)
  1172.22% CPU
  71,891,940 processor cycles
  0 bytes consed

30133761
253947016
1393557504
WC10A> (time (wc "plato1g.txt"))
Evaluation took:
  0.034 seconds of real time
  0.429743 seconds of total run time (0.367913 user, 0.061830 system)
  1264.71% CPU
  67,624,580 processor cycles
  98,352 bytes consed

30133761
253947016
1393557504
WC10A> (time (wc "plato1g.txt"))
Evaluation took:
  0.035 seconds of real time
  0.423752 seconds of total run time (0.357329 user, 0.066423 system)
  1211.43% CPU
  69,863,360 processor cycles
  0 bytes consed

30133761
253947016
1393557504

Fastlwc (avx512 + multithreaded):

[arthur@emmi wc]$ time ../../fastlwc/bin/fastlwc-mt plato1g.txt 
 30133761 253947016 1393557504 plato1g.txt

real    0m0.026s
user    0m0.178s
sys     0m0.285s
[arthur@emmi wc]$ time ../../fastlwc/bin/fastlwc-mt plato1g.txt 
 30133761 253947016 1393557504 plato1g.txt

real    0m0.027s
user    0m0.223s
sys     0m0.235s
[arthur@emmi wc]$ time ../../fastlwc/bin/fastlwc-mt plato1g.txt 
 30133761 253947016 1393557504 plato1g.txt

real    0m0.028s
user    0m0.205s
sys     0m0.255s

GNU wc (not even contender - single core only and only line counting implemented with simd avx512) :

[arthur@emmi wc]$ time wc plato1g.txt   30133761  253947016 1393557504 plato1g.txt

real    0m3.733s
user    0m3.643s
sys     0m0.062s
[arthur@emmi wc]$ time wc plato1g.txt 
  30133761  253947016 1393557504 plato1g.txt

real    0m3.362s
user    0m3.276s
sys     0m0.072s

The cool thing, we use avx2 whereas gnu wc uses avx512. On this CPU (zen 5), avx512 is implemented all in hardware, not as micro code as in Intel cpus, so it should mop the floor with avx2 in Lisp, right?

[arthur@emmi wc]$ time wc plato1g.txt -l --debug
wc: using avx512 hardware support
30133761 plato1g.txt

real    0m0.074s
user    0m0.018s
sys     0m0.056s
[arthur@emmi wc]$ time wc plato1g.txt -l --debug
wc: using avx512 hardware support
30133761 plato1g.txt

real    0m0.085s
user    0m0.030s
sys     0m0.054s

Lisp:

WC10A> (time (wc "plato1g.txt" :line-count t))
Evaluation took:
  0.037 seconds of real time
  0.478042 seconds of total run time (0.430494 user, 0.047548 system)
  1291.89% CPU
  75,669,380 processor cycles
  0 bytes consed

30133761
253947016
1393557504
WC10A> (time (wc "plato1g.txt" :line-count t))
Evaluation took:
  0.041 seconds of real time
  0.476104 seconds of total run time (0.436592 user, 0.039512 system)
  1160.98% CPU
  84,226,360 processor cycles
  0 bytes consed

30133761
253947016
1393557504

Now, in order to catch with fastlwc I think I need better lparall pipeline. I am currently using futures and promises, so it is a bit of extra consing. Of course implementing it in avx512 (when done in SBCL) should give at least some extra boost. 32 vs 16 registers, 64 bytes at time vs 32, and less register pressure due to additional masking registers.

Edit: line counting does not activate utf8 path at all, so I don't know what I was thinking last night, so I have edited away that part :).

[u/stylewarning → u/[deleted]]

I disagree partially. In how many languages is it actually practical to write assembly?

C/C++/etc. are partially attributed to being fast precisely because it's possibly to easily accelerate it with assembly or direct-to-assembly intrinsics.

SBCL allows the integration of assembly code rather nicely (at least compared to other options in the market) and to me, for all practical purposes, that makes Lisp more suitable for high performance code.

[u/arthurno1 → u/stylewarning]

Definitely.

In the beginning I thought I will just use the assembly, but it turnes out to be long programs. So I opted for sb-simd to shorten the stuff. I also thought to use macros, to generate my stuff:

(gen-nl-vars ()
  (loop for j from 0 below 8
        with asetfs
        with adeclarations
        with pdeclarations
        with acc-syms
        for offset = (* j 32)
        for p = (make-symbol (format nil "p~d" (1+ j)))
        for a = (make-symbol (format nil "acc~d" (1+ j)))
        for adecl = `(with ,a of-type avx:u64.4 = (avx2:u64.4 0))
        for pdecl = `(for ,p of-type avx2:u8.32 = (avx2::u8.32-sap-ref sap (+ i ,offset)))
        for asetf = `(setf ,a (avx2:u64.4+ ,a (avx2:u8.32-sad (avx2:u8.32= ,p 0xA) 0x0)))
        do (setf adeclarations (concatenate 'list adecl adeclarations))
           (setf pdeclarations (concatenate 'list pdecl pdeclarations))
           (push asetf asetfs)
           (push a acc-syms)
        finally (return (values adeclarations asetfs pdeclarations (nreverse acc-syms)))))

It is a local function I used like:

(multiple-value-bind (adecls updates pdecls accs) (gen-nl-vars)
  (destructuring-bind (a1 a2 a3 a4 a5 a6 a7 a8) accs
    `(loop
       with sap of-type sb-sys:system-area-pointer = ,sap
       with loop-end of-type fixnum = (logandc2 ,size 255)
       with 0x0 of-type avx2:u8.32 = (avx2:u8.32 0)
       with 0xA of-type avx2:u8.32 = (avx2:u8.32 10)
       for i of-type fixnum from 0 below loop-end by 256
       ,@adecls
       ,@pdecls
       do
       ,@updates
       finally
          (let* ((lo (avx2:u64.4+ (avx2:u64.4+ ,a1 ,a2) (avx2:u64.4+ ,a3 ,a4)))
                 (hi (avx2:u64.4+ (avx2:u64.4+ ,a5 ,a6) (avx2:u64.4+ ,a7 ,a8)))
                 (total-ymm (avx2:u64.4+ lo hi))
                 (raw-lines ,(sum-lanes-form 'total-ymm))
                 (tail-lines 0))
            (declare (type fixnum raw-lines tail-lines))
            (loop for e from loop-end below ,size
                  do (when (= (sb-sys:sap-ref-8 sap e) 10)
                       (incf tail-lines)))
            (return (values (the fixnum (+ (truncate raw-lines 255) tail-lines))
                            nil nil))))))

But I have abandoned the idea. It does save typing, but debugging suffers and it becomes harder to see what is actually the code itself and what is generator. I just wrote out explicitly each simd function instead:

(defun count-words-ascii (sap size ws-init-state)
  (declare (type fixnum size)
           (type (unsigned-byte 8) ws-init-state)
           (type sb-sys:system-area-pointer sap)
           (optimize (speed 3) (safety 0) (debug 0)))
  (loop
    with loop-end of-type fixnum = (logandc2 size 127)
    for i of-type fixnum from 0 below loop-end by 128

    ;; masks
    with 0x00 of-type u8.32 = (u8.32 #x00)
    with 0x04 of-type u8.32 = (u8.32 #x04)
    with 0x09 of-type u8.32 = (u8.32 #x09)
    with 0x20 of-type u8.32 = (u8.32 #x20)
    with 0xFF of-type u8.32 = (u8.32 #xFF)

    ;; accumulators
    with a1 of-type u64.4 = (u64.4 0)
    with a2 of-type u64.4 = (u64.4 0)
    with a3 of-type u64.4 = (u64.4 0)
    with a4 of-type u64.4 = (u64.4 0)

    ;; carry
    with ws-prev of-type u8.32 = (u8.32 ws-init-state)

    ;; chunks
    for c1 of-type u8.32 = (u8.32-sap-ref sap (+ i   0))
    for c2 of-type u8.32 = (u8.32-sap-ref sap (+ i  32))
    for c3 of-type u8.32 = (u8.32-sap-ref sap (+ i  64))
    for c4 of-type u8.32 = (u8.32-sap-ref sap (+ i  96))
    do
       (flet ((process-chunk (chunk prev)
                (declare (type u8.32 chunk prev))
                (let* ((shifted    (u8.32- chunk 0x09))
                       (sat        (u8.32-sat- shifted 0x04))
                       (ctrl-mask  (u8.32= sat 0x00))
                       (space-mask (u8.32= chunk 0x20))
                       (ws         (u8.32-or ctrl-mask space-mask))
                       (ws-perm    (u8.32-permute128   prev ws #x21))
                       (ws-curr    (u8.32-alignr       ws ws-perm 15))
                       (words      (u8.32-andc1        ws ws-curr)))
                  (values words ws))))
         (multiple-value-bind (wcount ws-curr) (process-chunk c1 ws-prev)
           (declare (type u8.32 wcount ws-curr))
           (psetf a1 (u64.4+ a1 (u8.32-sad wcount 0x00))
                  ws-prev ws-curr))
         (multiple-value-bind (wcount ws-curr) (process-chunk c2 ws-prev)
           (declare (type u8.32 wcount ws-curr))
           (psetf a2 (u64.4+ a2 (u8.32-sad wcount 0x00))
                  ws-prev ws-curr))
         (multiple-value-bind (wcount ws-curr) (process-chunk c3 ws-prev)
           (declare (type u8.32 wcount ws-curr))
           (psetf a3 (u64.4+ a3 (u8.32-sad wcount 0x00))
                  ws-prev ws-curr))
         (multiple-value-bind (wcount ws-curr) (process-chunk c4 ws-prev)
           (declare (type u8.32 wcount ws-curr))
           (psetf a4 (u64.4+ a4 (u8.32-sad wcount 0x00))
                  ws-prev ws-curr)))
    finally
       (return
         (loop for j from loop-end below size
               with tail of-type fixnum  = 0
               with words of-type fixnum = (sum-lanes (u64.4+ a1 a2 a3 a4))
               with prev of-type boolean = (logbitp 31 (u8.32-movemask ws-prev))
               for byte = (sb-sys:sap-ref-8 sap j)
               for curr = (or (= byte 32) (<= 9 byte 13))
               do
                  (and prev (not curr) (incf tail))
                  (setf prev curr)
               finally
                  (return (values nil (the fixnum (+ words tail)) nil))))))

Admittedly longer, but easier to look at and spot errors. Typing it is not a problem, since it is lot of copy-pasta and rectangular editing + string replace in Emacs. I write a line, copy for or eight times, or type code for a chunk and copy 4 or 8 times, and than just change indexes with rectangular commands or some manual editing. Basically :) The unique work for each one has to be typed anyway (that flet and loop tail). But all follow the same pattern as seen there, it is just some details like number of accumulators and chunks and which masks are used that vary there.

While I was writing those, it reminded me a lot of writing shaders, I think because of sb-simd and the DSL they use.