russell@unturf.com
94b29421ed
asm-gc gains (tcp-sendfile socket path) → builtin (90 lines) that issues SYS_SENDFILE(40) in a loop, streaming a file from fd → socket with no bounce through the Lumbda heap. Zero-copy kernel path for large responses. examples/http-static-server-sendfile.lsp (hybrid): small assets (≤ 16 KB) stay inline-cached as full HTTP responses; large assets cache only headers and stream the body via tcp-sendfile. 4-way race on i5-8350U, 100 PDF requests (2.56 MiB), concurrency 8: uncached 159 req/s 406 MiB/s 15.5 MB RSS cached 238 req/s 603 MiB/s 7.2 MB RSS sendfile 480 req/s 1226 MiB/s 4.2 MB RSS caddy 485 req/s 1238 MiB/s 37.1 MB RSS sendfile lands within 2% of caddy on throughput with 9x less peak RSS in a 27 KB binary vs caddy's 38 MB (1400x smaller). examples/http-static-server-adaptive.lsp (learning preload): per-URL hit counter persisted to www.hits every N requests. At boot, ranks and preloads top *cache-max* URLs from the prior run's data (cold-start falls back to a seed list). Cold requests beyond the seed promote on first hit. Drops heap-restore arena pattern since the server mutates persistent state every request; relies on GC build's mark-sweep. tests/bench-www-race.sh: adds sendfile variant on port 8083, auto-sizes PDF byte count from the on-disk whitepaper so a whitepaper rebuild doesn't desync the MiB/s calc. Whitepaper §11.7 "Static File Serving: Cache, Sendfile, and Adaptive Preload" documents the four variants, benchmark table, and the arena-vs-mutation tradeoff. §13 Future Work adds DAG-of-hot-paths predictive preload as the direction for > 1000-resource deployments where frequency-only ranking is too narrow.
298 lines
10 KiB
Text
298 lines
10 KiB
Text
;;; http-static-server-adaptive.lsp — static server that learns which
|
|
;;; paths matter. A hit counter per URL is updated on every request and
|
|
;;; periodically flushed to disk (*hits-path*, newline-delimited
|
|
;;; "url count" records). At startup, if hit data exists from a prior
|
|
;;; run, the top *cache-max* URLs are preloaded; otherwise we fall
|
|
;;; back to *seed-paths* (a minimal cold-start set).
|
|
;;;
|
|
;;; This is the "~95% of the win" version of predictive preloading
|
|
;;; for small deployments (<=1000 resources). The DAG-of-hot-paths
|
|
;;; variant for larger fleets is future work — see whitepaper §Future.
|
|
;;;
|
|
;;; Assets above *inline-threshold* bytes are cached as
|
|
;;; headers-only + fs-path and streamed via tcp-sendfile, same as
|
|
;;; http-static-server-sendfile.lsp.
|
|
|
|
(define *port* 8080)
|
|
(define *docroot* "www")
|
|
(define *hits-path* "www.hits")
|
|
(define *cache-max* 100)
|
|
(define *max-requests* 1000000)
|
|
(define *inline-threshold* 16384)
|
|
(define *hits-save-every* 500)
|
|
|
|
(define *crlf* "\r\n")
|
|
(define *crlf-crlf* "\r\n\r\n")
|
|
|
|
;;; Seed paths used on first boot (no hit history yet). Anything
|
|
;;; requested afterwards gets learned and promoted across restarts.
|
|
(define *seed-paths*
|
|
(list "/"
|
|
"/404.html"))
|
|
|
|
;;; ── helpers ─────────────────────────────────────────────────
|
|
|
|
(define SPACE 32)
|
|
(define NEWLINE 10)
|
|
(define ZERO 48)
|
|
(define NINE 57)
|
|
|
|
(define (char-at s i) (char->integer (string-ref s i)))
|
|
|
|
(define (ends-with? s suffix)
|
|
(let ((ns (string-length s)) (nf (string-length suffix)))
|
|
(if (< ns nf) #f
|
|
(string=? suffix (substring s (- ns nf) ns)))))
|
|
|
|
(define (mime-of path)
|
|
(cond
|
|
((ends-with? path ".html") "text/html; charset=utf-8")
|
|
((ends-with? path ".css") "text/css; charset=utf-8")
|
|
((ends-with? path ".pdf") "application/pdf")
|
|
((ends-with? path ".txt") "text/plain; charset=utf-8")
|
|
((ends-with? path ".js") "application/javascript")
|
|
((ends-with? path ".svg") "image/svg+xml")
|
|
((ends-with? path ".png") "image/png")
|
|
((ends-with? path ".jpg") "image/jpeg")
|
|
((ends-with? path ".ico") "image/x-icon")
|
|
(else "application/octet-stream")))
|
|
|
|
(define (url-to-fs url-path)
|
|
(cond
|
|
((string=? url-path "/") (string-append *docroot* "/index.html"))
|
|
(else (string-append *docroot* url-path))))
|
|
|
|
(define (inline-response status ctype body)
|
|
(string-append
|
|
"HTTP/1.0 " status *crlf*
|
|
"Content-Type: " ctype *crlf*
|
|
"Content-Length: " (number->string (string-length body)) *crlf*
|
|
"Connection: close" *crlf-crlf*
|
|
body))
|
|
|
|
(define (headers-only status ctype nbytes)
|
|
(string-append
|
|
"HTTP/1.0 " status *crlf*
|
|
"Content-Type: " ctype *crlf*
|
|
"Content-Length: " (number->string nbytes) *crlf*
|
|
"Connection: close" *crlf-crlf*))
|
|
|
|
;;; ── hit-counter persistence ─────────────────────────────────
|
|
|
|
(define *hits* (make-hash-table))
|
|
|
|
(define (bump-hit! path)
|
|
(let ((n (hash-table-ref/default *hits* path 0)))
|
|
(hash-table-set! *hits* path (+ n 1))))
|
|
|
|
;;; Serialize *hits* to "url count\n" lines and write atomically.
|
|
(define (hits-save)
|
|
(let loop ((keys (hash-table-keys *hits*)) (acc ""))
|
|
(cond
|
|
((null? keys) (write-file *hits-path* acc))
|
|
(else
|
|
(let ((k (car keys)))
|
|
(loop (cdr keys)
|
|
(string-append acc k " "
|
|
(number->string
|
|
(hash-table-ref/default *hits* k 0))
|
|
"\n")))))))
|
|
|
|
;;; Parse "url count\n" records into a list of (url . count) pairs.
|
|
;;; Defensive — skips malformed lines so a corrupt hits file never
|
|
;;; takes the server down.
|
|
(define (parse-int-token s i len)
|
|
(let loop ((j i) (n 0))
|
|
(cond
|
|
((= j len) (cons n j))
|
|
((and (>= (char-at s j) ZERO) (<= (char-at s j) NINE))
|
|
(loop (+ j 1) (+ (* n 10) (- (char-at s j) ZERO))))
|
|
(else (cons n j)))))
|
|
|
|
(define (parse-line s start end)
|
|
;; end is the index of '\n' (or the length). Split on first space.
|
|
(let loop ((i start))
|
|
(cond
|
|
((>= i end) #f)
|
|
((= (char-at s i) SPACE)
|
|
(let ((pr (parse-int-token s (+ i 1) end)))
|
|
(cons (substring s start i) (car pr))))
|
|
(else (loop (+ i 1))))))
|
|
|
|
(define (hits-parse s)
|
|
(let ((n (string-length s)))
|
|
(let loop ((i 0) (acc '()))
|
|
(cond
|
|
((>= i n) (reverse acc))
|
|
(else
|
|
(let find-nl ((j i))
|
|
(cond
|
|
((or (= j n) (= (char-at s j) NEWLINE))
|
|
(let ((rec (parse-line s i j)))
|
|
(loop (+ j 1) (if rec (cons rec acc) acc))))
|
|
(else (find-nl (+ j 1))))))))))
|
|
|
|
(define (hits-load)
|
|
(let ((s (file->string *hits-path*)))
|
|
(if s (hits-parse s) '())))
|
|
|
|
;;; Insertion sort by cdr descending. N is cache-max, so O(N²) is fine.
|
|
(define (insert-desc x xs)
|
|
(cond
|
|
((null? xs) (list x))
|
|
((>= (cdr x) (cdr (car xs))) (cons x xs))
|
|
(else (cons (car xs) (insert-desc x (cdr xs))))))
|
|
|
|
(define (sort-desc pairs)
|
|
(let loop ((in pairs) (out '()))
|
|
(cond
|
|
((null? in) out)
|
|
(else (loop (cdr in) (insert-desc (car in) out))))))
|
|
|
|
(define (take n xs)
|
|
(cond
|
|
((or (= n 0) (null? xs)) '())
|
|
(else (cons (car xs) (take (- n 1) (cdr xs))))))
|
|
|
|
;;; ── cache (headers + either body or fs-path) ────────────────
|
|
|
|
(define *cache-inline* (make-hash-table))
|
|
(define *cache-sendfile* (make-hash-table))
|
|
|
|
(define (cache-count)
|
|
(+ (hash-table-size *cache-inline*)
|
|
(hash-table-size *cache-sendfile*)))
|
|
|
|
(define (cache-add! url-path)
|
|
(if (>= (cache-count) *cache-max*)
|
|
'capped
|
|
(let ((fs-path (url-to-fs url-path)))
|
|
(let ((body (file->string fs-path)))
|
|
(cond
|
|
((not body) 'missing)
|
|
((<= (string-length body) *inline-threshold*)
|
|
(hash-table-set! *cache-inline* url-path
|
|
(inline-response "200 OK" (mime-of fs-path) body))
|
|
'inline)
|
|
(else
|
|
(hash-table-set! *cache-sendfile* url-path
|
|
(cons (headers-only "200 OK" (mime-of fs-path)
|
|
(string-length body))
|
|
fs-path))
|
|
'sendfile))))))
|
|
|
|
(define (preload-all paths)
|
|
(cond
|
|
((null? paths) 'done)
|
|
(else (cache-add! (car paths)) (preload-all (cdr paths)))))
|
|
|
|
(define (preload-top-n ranked n)
|
|
;; ranked is ((url . count) ...), preload URLs only.
|
|
(let loop ((xs ranked) (left n))
|
|
(cond
|
|
((or (null? xs) (= left 0)) 'done)
|
|
(else
|
|
(cache-add! (car (car xs)))
|
|
(loop (cdr xs) (- left 1))))))
|
|
|
|
;;; ── startup: load hits, rank, preload ───────────────────────
|
|
|
|
(define *resp-404*
|
|
(let ((body (file->string (string-append *docroot* "/404.html"))))
|
|
(if body
|
|
(inline-response "404 Not Found" "text/html; charset=utf-8" body)
|
|
(inline-response "404 Not Found" "text/plain" "not found\n"))))
|
|
|
|
(define *boot-hits* (hits-load))
|
|
(cond
|
|
((null? *boot-hits*)
|
|
(display "adaptive: cold start — preloading seed paths") (newline)
|
|
(preload-all *seed-paths*))
|
|
(else
|
|
(display "adaptive: loaded ") (display (length *boot-hits*))
|
|
(display " hit records, preloading top ") (display *cache-max*)
|
|
(newline)
|
|
(preload-top-n (sort-desc *boot-hits*) *cache-max*)
|
|
;; Re-seed the in-memory counter from disk so learned ranks
|
|
;; don't reset each boot.
|
|
(let loop ((xs *boot-hits*))
|
|
(cond
|
|
((null? xs) 'done)
|
|
(else
|
|
(hash-table-set! *hits* (car (car xs)) (cdr (car xs)))
|
|
(loop (cdr xs)))))))
|
|
|
|
;;; ── per-request ─────────────────────────────────────────────
|
|
|
|
(define (second-token s)
|
|
(let ((len (string-length s)))
|
|
(let loop1 ((i 0))
|
|
(cond
|
|
((= i len) "/")
|
|
((= (char-at s i) SPACE)
|
|
(let loop2 ((j (+ i 1)))
|
|
(cond
|
|
((= j len) (substring s (+ i 1) len))
|
|
((= (char-at s j) SPACE) (substring s (+ i 1) j))
|
|
(else (loop2 (+ j 1))))))
|
|
(else (loop1 (+ i 1)))))))
|
|
|
|
(define (serve client req)
|
|
(let ((path (second-token req)))
|
|
(bump-hit! path)
|
|
(let ((inline (hash-table-ref/default *cache-inline* path #f)))
|
|
(if inline
|
|
(tcp-send client inline)
|
|
(let ((sf (hash-table-ref/default *cache-sendfile* path #f)))
|
|
(if sf
|
|
(begin
|
|
(tcp-send client (car sf))
|
|
(tcp-sendfile client (cdr sf)))
|
|
;; Cold path: try to warm the cache for next hit,
|
|
;; then serve via the new entry. Caps at *cache-max*.
|
|
(let ((tag (cache-add! path)))
|
|
(cond
|
|
((equal? tag 'inline)
|
|
(tcp-send client
|
|
(hash-table-ref/default *cache-inline* path *resp-404*)))
|
|
((equal? tag 'sendfile)
|
|
(let ((sf2 (hash-table-ref/default *cache-sendfile* path #f)))
|
|
(tcp-send client (car sf2))
|
|
(tcp-sendfile client (cdr sf2))))
|
|
(else
|
|
(tcp-send client *resp-404*))))))))))
|
|
|
|
;;; ── main loop ───────────────────────────────────────────────
|
|
;;;
|
|
;;; This server mutates persistent state on every request
|
|
;;; (hit-counter bump, cold-path cache promotion), so the
|
|
;;; arena-pattern heap-restore used by the other servers would
|
|
;;; corrupt the hits table and cache. We run under lumbda-gc
|
|
;;; and rely on mark-sweep to reclaim per-request transients.
|
|
|
|
(define server (tcp-listen *port*))
|
|
|
|
(define (server-loop n)
|
|
(if (>= n *max-requests*)
|
|
(begin
|
|
(display "request cap reached, exiting\n")
|
|
(hits-save)
|
|
(tcp-close server))
|
|
(begin
|
|
(let ((client (tcp-accept server)))
|
|
(let ((req (tcp-recv client 4096)))
|
|
(if (and req (> (string-length req) 0))
|
|
(serve client req)
|
|
#f))
|
|
(tcp-close client))
|
|
(if (and (> n 0) (= (remainder n *hits-save-every*) 0))
|
|
(hits-save)
|
|
#f)
|
|
(server-loop (+ n 1)))))
|
|
|
|
(display "lumbda-www adaptive on :") (display *port*)
|
|
(display " serving ") (display *docroot*)
|
|
(display " (") (display (cache-count)) (display "/") (display *cache-max*)
|
|
(display " cached, hits=") (display *hits-path*) (display ")")
|
|
(newline)
|
|
(server-loop 0)
|