russell@unturf.com
b8d6afdeb3
Three wins in one commit.
1) heap-snapshot / heap-restore (asm arena primitive)
asm has no GC. Long-running servers leaked ~64 MB per heap growth.
Two new builtins let a programmer capture r15 and later rewind to
it, recycling intermediate allocations in O(1) memory.
Python + C get no-op versions so portable .lsp code can call them
unconditionally.
examples/http-server.lsp now takes a snapshot at top level and
rewinds after every request. Measured asm RSS: 88 KB initial,
100 KB after 100 requests, 100 KB after 1100 requests — flat.
Prior behavior was +64 MB per few thousand requests.
2) examples/http-client-bench.lsp — native HTTP load generator
Uses only the six tcp-* primitives + current-time-ms. Runs
identically in all three impls. Eliminates curl's ~2 ms/req
fork+exec overhead, so real server throughput shows up:
Python server ← Python client 2403 rps
C server ← C client 2439 rps
asm server ← asm client 2994 rps
asm server ← C client 2500 rps
The earlier curl-based bench was clamped near 400 rps by the
client; the actual servers handle 6–7× that.
3) MOAD-0001 cleanup
- c/builtins.c bi_string_replace: strncmp-at-every-position
(hand-rolled, sedimentary) → strstr (libc-tuned, typically
Boyer-Moore-Horspool). O(N*k) → O(N + matches*k).
- uncommonlisp.py _tokenize_lines: per-token src.count('\n', 0, pos)
→ precompute line_starts once, bisect_right per token.
O(N*M) → O(M + N log M).
Also adds current-time-ms to all three impls so benchmarks can
time themselves without relying on the Python/C float `current-time`
(asm has no floats). Seconds-since-epoch tagged as a 61-bit int.
Test counts unchanged: 571 py + 132 asm + 189 shared + 83 c = 975.
All green via make test-all.
117 lines
4.3 KiB
Text
117 lines
4.3 KiB
Text
;;; http-server.lsp — portable HTTP/1.0 server in pure Scheme
|
|
;;;
|
|
;;; Runs identically in Python, C, and asm. The only primitives used are
|
|
;;; the six socket builtins + display/string-append/substring.
|
|
;;;
|
|
;;; python3 uncommonlisp.py --fast examples/http-server.lsp
|
|
;;; ./c/uncommonlisp examples/http-server.lsp
|
|
;;; ./asm/uncommonlisp < examples/http-server.lsp
|
|
;;;
|
|
;;; Default port 8080. First-line dispatch: GET / → greeting page.
|
|
;;; GET /bench → 1 KB body for throughput benchmarks.
|
|
;;; Other paths → 404.
|
|
|
|
(define *port* 8080)
|
|
(define *crlf* "\r\n")
|
|
(define *crlf-crlf* "\r\n\r\n")
|
|
|
|
;;; Request ceiling. Acts as a belt-and-suspenders cap under the
|
|
;;; heap-snapshot loop below. The snapshot mechanism (asm only) rewinds
|
|
;;; per-request allocations so memory stays O(1) regardless of ceiling.
|
|
;;; On Python + C the GC handles this; the cap still bounds accidentally
|
|
;;; runaway demo servers.
|
|
(define *max-requests* 1000000)
|
|
|
|
;;; heap-snapshot / heap-restore are available in all three impls.
|
|
;;; On asm they rewind the bump allocator (recycling per-request
|
|
;;; allocations in O(1) memory). On Python + C they are no-ops
|
|
;;; because those runtimes already have a real GC.
|
|
|
|
;;; ── HTTP helpers ─────────────────────────────────────────────
|
|
|
|
(define (http-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))
|
|
|
|
;; Compare via char->integer so we don't need char=? (asm lacks it).
|
|
(define SPACE 32)
|
|
|
|
(define (char-at s i) (char->integer (string-ref s i)))
|
|
|
|
(define (first-token s)
|
|
(let ((len (string-length s)))
|
|
(let loop ((i 0))
|
|
(cond
|
|
((= i len) s)
|
|
((= (char-at s i) SPACE) (substring s 0 i))
|
|
(else (loop (+ i 1)))))))
|
|
|
|
(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)))))))
|
|
|
|
;;; ── Request handler ─────────────────────────────────────────
|
|
|
|
(define *bench-body*
|
|
;; ~1 KB payload so clients have something to measure throughput on.
|
|
(let loop ((s "") (i 0))
|
|
(if (= i 32) s
|
|
(loop (string-append s "0123456789abcdef0123456789abcdef") (+ i 1)))))
|
|
|
|
(define (handle-request req)
|
|
(let ((path (second-token req)))
|
|
(cond
|
|
((string=? path "/")
|
|
(http-response "200 OK" "text/html"
|
|
"<!doctype html><title>uncommonlisp</title><h1>feedback is all you need</h1><p>portable HTTP in Scheme.</p>"))
|
|
((string=? path "/bench")
|
|
(http-response "200 OK" "text/plain" *bench-body*))
|
|
((string=? path "/hello")
|
|
(http-response "200 OK" "text/plain" "hello world\n"))
|
|
(else
|
|
(http-response "404 Not Found" "text/plain"
|
|
(string-append "not found: " path "\n"))))))
|
|
|
|
;;; ── Main loop ───────────────────────────────────────────────
|
|
|
|
;;; Top-level `server` and `server-loop`. The snapshot `snap` is
|
|
;;; passed down as an explicit arg — this avoids any issue with
|
|
;;; closures captured before/after the snapshot.
|
|
|
|
(define server (tcp-listen *port*))
|
|
|
|
(define (server-loop n snap)
|
|
(if (>= n *max-requests*)
|
|
(begin
|
|
(display "request cap reached, exiting\n")
|
|
(tcp-close server))
|
|
(begin
|
|
(let ((client (tcp-accept server)))
|
|
(let ((req (tcp-recv client 4096)))
|
|
(if (and req (> (string-length req) 0))
|
|
(tcp-send client (handle-request req))
|
|
#f))
|
|
(tcp-close client))
|
|
;; Rewind per-request allocations on asm; no-op elsewhere.
|
|
(heap-restore snap)
|
|
(server-loop (+ n 1) snap))))
|
|
|
|
(define (serve)
|
|
(display "uncommonlisp http server on :") (display *port*)
|
|
(display " (max ") (display *max-requests*) (display " requests)") (newline)
|
|
(server-loop 0 (heap-snapshot)))
|
|
|
|
(serve)
|