perf: bulk memcpy for UDP/TCP packet FFI copies
ober
9c069d4c3d3833b0393e732e0833e4d68bcac5d7
--- a/lib/jerboa-dns/server.ss +++ b/lib/jerboa-dns/server.ss @@ -78,6 +78,10 @@ (def c-close (foreign-procedure "close" (int) int)) (def c-recvfrom (foreign-procedure __collect_safe "recvfrom" (int void* size_t int void* void*) ssize_t)) (def c-sendto (foreign-procedure __collect_safe "sendto" (int void* size_t int void* int) ssize_t)) + ;; Bulk copies between Scheme bytevectors (u8*) and foreign memory (void*), + ;; replacing per-byte foreign-ref/foreign-set! loops with one FFI crossing. + (def c-memcpy-in (foreign-procedure "memcpy" (u8* void* size_t) void*)) + (def c-memcpy-out (foreign-procedure "memcpy" (void* u8* size_t) void*)) (def c-listen (foreign-procedure "listen" (int int) int)) (def c-accept (foreign-procedure __collect_safe "accept" (int void* void*) int)) ; jerboa-security: suppress missing-eintr-retry (def c-recv (foreign-procedure __collect_safe "recv" (int void* size_t int) ssize_t)) ; jerboa-security: suppress missing-eintr-retry @@ -587,8 +591,7 @@ [t0 (now-monotonic-ns)] [src (client-src-str client-addr)]) ;; Copy from foreign memory to bytevector - (do ([i 0 (+ i 1)]) ((= i pkt-len)) - (bytevector-u8-set! pkt i (foreign-ref 'unsigned-8 pkt-buf i))) + (c-memcpy-in pkt pkt-buf pkt-len) (guard (e [#t ;; On any error, log SERVFAIL and try to send one over the wire @@ -700,8 +703,7 @@ void (lambda () ;; Copy bytevector to foreign memory - (do ([i 0 (+ i 1)]) ((= i len)) - (foreign-set! 'unsigned-8 foreign-buf i (bytevector-u8-ref buf i))) + (c-memcpy-out foreign-buf buf len) (c-sendto sock foreign-buf len 0 client-addr SOCKADDR_IN_SIZE)) (lambda () (foreign-free foreign-buf))))) @@ -721,8 +723,7 @@ (foreign-set! 'unsigned-8 foreign-buf 0 (bitwise-and (bitwise-arithmetic-shift-right len 8) #xff)) (foreign-set! 'unsigned-8 foreign-buf 1 (bitwise-and len #xff)) - (do ([i 0 (+ i 1)]) ((= i len)) - (foreign-set! 'unsigned-8 foreign-buf (+ i 2) (bytevector-u8-ref buf i))) + (c-memcpy-out (+ foreign-buf 2) buf len) (let ([ok? (send-all client-fd foreign-buf (+ len 2) deadline-ns)]) (free-buf!) ok?)))))