lumbda/examples/http-server-noarena.lsp
russell@unturf.com f7352b51b0 rename: uncommonlisp -> lumbda throughout the repo
Historical internal name "uncommonlisp" retired in favor of the
public name "lumbda" ahead of lumbda.com going live. Scope of
this commit:

Source files renamed:
  uncommonlisp.py                     -> lumbda.py
  asm/uncommonlisp.s                  -> asm/lumbda.s
  c/uncommonlisp.h                    -> c/lumbda.h
  whitepaper/uncommonlisp-whitepaper  -> whitepaper/lumbda-whitepaper (.rst + .pdf)

Binaries renamed (tracked ones; c/ was always gitignored):
  asm/uncommonlisp, asm/uncommonlisp-gc, asm/uncommonlisp.o,
  asm/uncommonlisp-gc.o                -> asm/lumbda(-gc)(.o)
  c/.gitignore                          -> ignores lumbda

Internal string updates (sed pass ordered longest-first):
  asm/uncommonlisp -> asm/lumbda
  c/uncommonlisp   -> c/lumbda
  uncommonlisp.py  -> lumbda.py
  UNCOMMONLISP_BIN -> LUMBDA_BIN (asm/test.sh env var)
  "uncommonlisp> " -> "lumbda> " (asm REPL prompt baked into binary)
  UNCOMMONLISP     -> LUMBDA (macros, comments)
  uncommonlisp     -> lumbda (prose)

Binary portal magic updated:
  "ULPORTAL" -> "LUMBDAB1"   # "Lumbda Binary v1"
Old portal files are not backward-compatible — this is a deliberate
break since it's the rename moment. S-expression portals already
carry their own ";; lumbda-portal v1" header and remain cleanly
versioned.

WHITEPAPER.pdf / WHITEPAPER.rst symlinks repointed to the renamed
files. Makefile's whitepaper target targets lumbda-whitepaper.pdf.

Not changed (intentional, separate phases):
  - Filesystem directory /home/fox/git/uncommonlisp itself
    (fox renames locally and the gitlab repo URL in a follow-up)
  - tests.py hardcoded cwd=/home/fox/git/uncommonlisp
    (matches the current on-disk location; will flip when the
    directory rename ships)
  - Git history (immutable; old commits still say uncommonlisp,
    which is correct — that's what they were)

Verified:
  137 asm no-GC + 137 asm GC + 571 Python + 83 C + 189 shared
  functional tests all pass under the new names.
  bench-gc-http (2000 req): all 4 cells behave as expected
  (cells 1/2 flat, 3 leaks, 4 bounded at 1 chunk).
  Python REPL, C REPL, asm REPL all start cleanly.
2026-04-19 10:20:11 -04:00

85 lines
2.7 KiB
Text

;;; http-server-noarena.lsp — same HTTP server as http-server.lsp
;;; but with the heap-snapshot / heap-restore arena loop removed.
;;;
;;; On asm without GC this leaks per-request allocations forever
;;; (every request grows %r15). On asm with GC_NAIVE the collector
;;; reclaims between requests once heap pressure hits.
;;;
;;; Used by tests/bench-gc-http.sh to isolate whether GC_NAIVE
;;; actually holds memory under real load, independent of the
;;; portable snapshot pattern.
(define *port* 8080)
(define *crlf* "\r\n")
(define *crlf-crlf* "\r\n\r\n")
(define *max-requests* 100000)
(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))
(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)))))))
(define *bench-body*
(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>lumbda</title><h1>feedback is all you need</h1>"))
((string=? path "/bench")
(http-response "200 OK" "text/plain" *bench-body*))
(else
(http-response "404 Not Found" "text/plain"
(string-append "not found: " path "\n"))))))
(define server (tcp-listen *port*))
(define (server-loop n)
(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))
;; NO heap-restore here — heap grows per request.
(server-loop (+ n 1)))))
(display "noarena http server on :") (display *port*)
(display " (no heap-snapshot, heap grows per request)") (newline)
(server-loop 0)