heap-snapshot + native HTTP client + MOAD-0001 cleanup
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.
This commit is contained in:
parent
477bd5f7cd
commit
b8d6afdeb3
7 changed files with 239 additions and 34 deletions
BIN
asm/uncommonlisp
BIN
asm/uncommonlisp
Binary file not shown.
Binary file not shown.
|
|
@ -35,6 +35,8 @@
|
|||
.equ SYS_LISTEN,50
|
||||
.equ SYS_SETSOCKOPT,54
|
||||
.equ SYS_EXIT, 60
|
||||
.equ SYS_CLOCK_GETTIME, 228
|
||||
.equ CLOCK_REALTIME, 0
|
||||
|
||||
.equ AF_INET, 2
|
||||
.equ SOCK_STREAM,1
|
||||
|
|
@ -160,7 +162,10 @@
|
|||
.equ BI_TCPRECV, 82
|
||||
.equ BI_TCPSEND, 83
|
||||
.equ BI_TCPCLOSE, 84
|
||||
.equ BI_COUNT, 85
|
||||
.equ BI_HEAPSNAP, 85
|
||||
.equ BI_HEAPREST, 86
|
||||
.equ BI_CURTIME, 87
|
||||
.equ BI_COUNT, 88
|
||||
|
||||
# ============================================================
|
||||
.data
|
||||
|
|
@ -271,6 +276,9 @@ bn_tcpconnect: .byte 11; .ascii "tcp-connect"
|
|||
bn_tcprecv: .byte 8; .ascii "tcp-recv"
|
||||
bn_tcpsend: .byte 8; .ascii "tcp-send"
|
||||
bn_tcpclose: .byte 9; .ascii "tcp-close"
|
||||
bn_heapsnap: .byte 13; .ascii "heap-snapshot"
|
||||
bn_heaprest: .byte 12; .ascii "heap-restore"
|
||||
bn_curtime: .byte 15; .ascii "current-time-ms"
|
||||
|
||||
portal_magic: .ascii "ULPORTAL"
|
||||
.equ PORTAL_MAGIC_LEN, 8
|
||||
|
|
@ -300,6 +308,7 @@ bi_names:
|
|||
.quad bn_writefile, bn_filetostr
|
||||
.quad bn_tcplisten, bn_tcpaccept, bn_tcpconnect
|
||||
.quad bn_tcprecv, bn_tcpsend, bn_tcpclose
|
||||
.quad bn_heapsnap, bn_heaprest, bn_curtime
|
||||
|
||||
# Error messages
|
||||
err_unbound: .ascii "Error: unbound variable: "
|
||||
|
|
@ -2488,6 +2497,12 @@ eval_list:
|
|||
je bi_tcp_send
|
||||
cmpq $BI_TCPCLOSE, %rax
|
||||
je bi_close_port
|
||||
cmpq $BI_HEAPSNAP, %rax
|
||||
je bi_heap_snapshot
|
||||
cmpq $BI_HEAPREST, %rax
|
||||
je bi_heap_restore
|
||||
cmpq $BI_CURTIME, %rax
|
||||
je bi_current_time_ms
|
||||
|
||||
movq $VAL_VOID, %rax
|
||||
popq %r12
|
||||
|
|
@ -4399,6 +4414,67 @@ bi_file_to_string:
|
|||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# ============================================================
|
||||
# Heap snapshot/restore: UNSAFE escape hatch for long-running loops.
|
||||
# asm has no GC. A server that bump-allocates every request leaks
|
||||
# ~64 MB per heap_grow forever. heap-snapshot captures r15; a later
|
||||
# heap-restore rewinds r15 to that point, reclaiming everything
|
||||
# allocated since.
|
||||
#
|
||||
# DANGER: any Scheme value that lives past the restore point but was
|
||||
# allocated after the snapshot becomes a dangling pointer. Use only
|
||||
# when the programmer can prove no such references exist — the
|
||||
# canonical pattern is a per-request scope in a server loop:
|
||||
#
|
||||
# (let ((snap (heap-snapshot)))
|
||||
# (loop ...)
|
||||
# (heap-restore snap))
|
||||
#
|
||||
# Top-level bindings stay alive because they allocate before the snap.
|
||||
# ============================================================
|
||||
|
||||
bi_heap_snapshot:
|
||||
# Return r15 as a tagged int (61-bit payload fits a 64-bit pointer
|
||||
# because all asm heap addresses have 0 in the low 3 bits already).
|
||||
movq %r15, %rax
|
||||
# Low 3 bits of r15 are 0 (8-aligned). TAG_INT = 0, so no OR needed.
|
||||
RET_VAL
|
||||
|
||||
bi_heap_restore:
|
||||
GETARG %rax
|
||||
# Untag: caller passed a heap-snapshot int. Clear tag bits just in case.
|
||||
andq $-8, %rax
|
||||
# Sanity: don't rewind past heap_base or forward past current r15.
|
||||
cmpq heap_base(%rip), %rax
|
||||
jl .hr_noop
|
||||
cmpq %r15, %rax
|
||||
ja .hr_noop
|
||||
movq %rax, %r15
|
||||
.hr_noop:
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
# bi_current_time_ms: (current-time-ms) → int ms since epoch
|
||||
# struct timespec is { int64_t tv_sec; int64_t tv_nsec; } — 16 bytes.
|
||||
bi_current_time_ms:
|
||||
subq $16, %rsp
|
||||
movq $SYS_CLOCK_GETTIME, %rax
|
||||
movq $CLOCK_REALTIME, %rdi
|
||||
movq %rsp, %rsi
|
||||
syscall
|
||||
movq (%rsp), %rax # tv_sec
|
||||
movq 8(%rsp), %rcx # tv_nsec
|
||||
addq $16, %rsp
|
||||
imulq $1000, %rax # sec * 1000
|
||||
movq %rax, %r8 # stash
|
||||
movq %rcx, %rax # rax = tv_nsec
|
||||
xorq %rdx, %rdx
|
||||
movq $1000000, %rcx
|
||||
divq %rcx # rax = tv_nsec / 1e6
|
||||
addq %r8, %rax # total ms
|
||||
shlq $3, %rax # tag as int
|
||||
RET_VAL
|
||||
|
||||
# ============================================================
|
||||
# TCP sockets: fd encoded as port (same as file ports).
|
||||
# tcp-recv = sys_read, tcp-send = sys_write, tcp-close = close-port.
|
||||
|
|
|
|||
48
c/builtins.c
48
c/builtins.c
|
|
@ -1204,6 +1204,28 @@ static Value bi_tcp_close(Value *a, int n, Env *e) {
|
|||
p->closed = true;
|
||||
return VAL_VOID;
|
||||
}
|
||||
|
||||
/* heap-snapshot / heap-restore: asm-only arena primitives. The asm impl
|
||||
* has no GC; these let a server rewind its bump allocator between
|
||||
* requests. Python + C have real GCs — no-ops here so portable .lsp
|
||||
* code can call them unconditionally. */
|
||||
static Value bi_heap_snapshot(Value *a, int n, Env *e) {
|
||||
(void)a; (void)n; (void)e;
|
||||
return VAL_FALSE;
|
||||
}
|
||||
static Value bi_heap_restore(Value *a, int n, Env *e) {
|
||||
(void)a; (void)n; (void)e;
|
||||
return VAL_VOID;
|
||||
}
|
||||
|
||||
#include <time.h>
|
||||
static Value bi_current_time_ms(Value *a, int n, Env *e) {
|
||||
(void)a; (void)n; (void)e;
|
||||
struct timespec ts;
|
||||
clock_gettime(CLOCK_REALTIME, &ts);
|
||||
int64_t ms = (int64_t)ts.tv_sec * 1000 + ts.tv_nsec / 1000000;
|
||||
return VAL_INT(ms);
|
||||
}
|
||||
static Value bi_open_output_string(Value *a, int n, Env *e) {
|
||||
(void)e;
|
||||
return make_string_output_port();
|
||||
|
|
@ -1528,19 +1550,24 @@ static Value bi_string_replace(Value *a, int n, Env *e) {
|
|||
const char *from = AS_STRING(a[1])->data;
|
||||
const char *to = AS_STRING(a[2])->data;
|
||||
size_t from_len = strlen(from), to_len = strlen(to);
|
||||
if (from_len == 0) return a[0];
|
||||
|
||||
/* Use strstr (libc-tuned, often Boyer-Moore-Horspool) to skip the
|
||||
* O(N*k) hand-rolled strncmp-at-every-position sediment. */
|
||||
char buf[8192];
|
||||
size_t pos = 0;
|
||||
while (*src && pos < sizeof(buf) - to_len - 1) {
|
||||
if (strncmp(src, from, from_len) == 0) {
|
||||
memcpy(buf + pos, to, to_len);
|
||||
pos += to_len;
|
||||
src += from_len;
|
||||
} else {
|
||||
buf[pos++] = *src++;
|
||||
}
|
||||
const char *cur = src;
|
||||
const char *hit;
|
||||
while ((hit = strstr(cur, from)) != NULL) {
|
||||
size_t chunk = (size_t)(hit - cur);
|
||||
if (pos + chunk + to_len >= sizeof(buf) - 1) break;
|
||||
memcpy(buf + pos, cur, chunk); pos += chunk;
|
||||
memcpy(buf + pos, to, to_len); pos += to_len;
|
||||
cur = hit + from_len;
|
||||
}
|
||||
while (*src && pos < sizeof(buf) - 1) buf[pos++] = *src++;
|
||||
size_t tail = strlen(cur);
|
||||
if (pos + tail >= sizeof(buf)) tail = sizeof(buf) - pos - 1;
|
||||
memcpy(buf + pos, cur, tail); pos += tail;
|
||||
buf[pos] = '\0';
|
||||
return make_string_from_cstr(buf);
|
||||
}
|
||||
|
|
@ -1836,6 +1863,9 @@ Env *make_global_env(void) {
|
|||
DEF("tcp-recv", bi_tcp_recv);
|
||||
DEF("tcp-send", bi_tcp_send);
|
||||
DEF("tcp-close", bi_tcp_close);
|
||||
DEF("heap-snapshot", bi_heap_snapshot);
|
||||
DEF("heap-restore", bi_heap_restore);
|
||||
DEF("current-time-ms", bi_current_time_ms);
|
||||
DEF("open-input-string", bi_open_input_string);
|
||||
DEF("open-output-string", bi_open_output_string);
|
||||
DEF("get-output-string", bi_get_output_string);
|
||||
|
|
|
|||
66
examples/http-client-bench.lsp
Normal file
66
examples/http-client-bench.lsp
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
;;; http-client-bench.lsp — sequential HTTP load generator in Scheme
|
||||
;;;
|
||||
;;; Makes N requests to 127.0.0.1:PORT and reports elapsed wall time
|
||||
;;; + requests/sec. Uses only the six tcp-* primitives, so it runs
|
||||
;;; identically in Python, C, and asm.
|
||||
;;;
|
||||
;;; The earlier tests/web-benchmark.sh used curl — each curl fork+exec
|
||||
;;; costs ~2 ms, swamping actual server work. This client keeps every
|
||||
;;; request in-process: that irreducible cost disappears, so the real
|
||||
;;; server throughput shows up.
|
||||
;;;
|
||||
;;; Usage:
|
||||
;;; python3 uncommonlisp.py --fast examples/http-client-bench.lsp
|
||||
;;; ./c/uncommonlisp examples/http-client-bench.lsp
|
||||
;;; ./asm/uncommonlisp < examples/http-client-bench.lsp
|
||||
;;;
|
||||
;;; Override N or PORT by pre-setting *n-requests* / *port* before load.
|
||||
|
||||
(define *host* "127.0.0.1")
|
||||
(define *port* 8080)
|
||||
(define *n-requests* 500)
|
||||
(define *path* "/bench")
|
||||
|
||||
(define *request*
|
||||
(string-append
|
||||
"GET " *path* " HTTP/1.0\r\n"
|
||||
"Host: " *host* "\r\n"
|
||||
"Connection: close\r\n\r\n"))
|
||||
|
||||
;;; Pass snap as arg so heap-restore can rewind per-request
|
||||
;;; allocations on asm without invalidating the client loop's
|
||||
;;; closure env.
|
||||
|
||||
(define (one-request)
|
||||
(let ((sock (tcp-connect *host* *port*)))
|
||||
(if sock
|
||||
(begin
|
||||
(tcp-send sock *request*)
|
||||
(let ((resp (tcp-recv sock 8192)))
|
||||
(tcp-close sock)
|
||||
(if (and resp (> (string-length resp) 0)) 1 0)))
|
||||
0)))
|
||||
|
||||
(define (client-loop n ok snap)
|
||||
(if (= n 0)
|
||||
ok
|
||||
(let ((got (one-request)))
|
||||
(heap-restore snap)
|
||||
(client-loop (- n 1) (+ ok got) snap))))
|
||||
|
||||
(define t0 (current-time-ms))
|
||||
(define ok (client-loop *n-requests* 0 (heap-snapshot)))
|
||||
(define t1 (current-time-ms))
|
||||
|
||||
(define elapsed-ms (- t1 t0))
|
||||
(define rps
|
||||
(if (> elapsed-ms 0)
|
||||
(quotient (* *n-requests* 1000) elapsed-ms)
|
||||
0))
|
||||
|
||||
(display "target : http://") (display *host*) (display ":") (display *port*)
|
||||
(display *path*) (newline)
|
||||
(display "requests : ") (display *n-requests*) (newline)
|
||||
(display "ok : ") (display ok) (newline)
|
||||
(display "elapsed : ") (display elapsed-ms) (display " ms") (newline)
|
||||
(display "rps : ") (display rps) (newline)
|
||||
|
|
@ -15,12 +15,17 @@
|
|||
(define *crlf* "\r\n")
|
||||
(define *crlf-crlf* "\r\n\r\n")
|
||||
|
||||
;;; Hard request ceiling. The asm impl has no GC: every request
|
||||
;;; bump-allocates heap cells that never get reclaimed. An unbounded
|
||||
;;; server leaks ~64 MB per heap growth until OOM. This ceiling makes
|
||||
;;; the server self-terminate long before it starves the machine.
|
||||
;;; Benchmarks that want a different cap should `set!` it after load.
|
||||
(define *max-requests* 50000)
|
||||
;;; 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 ─────────────────────────────────────────────
|
||||
|
||||
|
|
@ -82,22 +87,31 @@
|
|||
|
||||
;;; ── 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)
|
||||
(let ((server (tcp-listen *port*)))
|
||||
(display "uncommonlisp http server on :") (display *port*)
|
||||
(display " (max ") (display *max-requests*) (display " requests)") (newline)
|
||||
(let loop ((n 0))
|
||||
(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))
|
||||
(loop (+ n 1)))))))
|
||||
(display "uncommonlisp http server on :") (display *port*)
|
||||
(display " (max ") (display *max-requests*) (display " requests)") (newline)
|
||||
(server-loop 0 (heap-snapshot)))
|
||||
|
||||
(serve)
|
||||
|
|
|
|||
|
|
@ -322,12 +322,25 @@ def _tokenize(src):
|
|||
return [t for t in _TOK_RE.findall(src) if not t.startswith(';')]
|
||||
|
||||
def _tokenize_lines(src):
|
||||
"""Tokenize with line numbers: returns list of (token, line_number) tuples."""
|
||||
"""Tokenize with line numbers: returns list of (token, line_number) tuples.
|
||||
|
||||
MOAD-0001 fix: precompute line-start offsets once (one pass over src),
|
||||
then bisect_right to map any token position -> line in O(log M).
|
||||
Total cost: O(M + N log M) instead of the old O(N*M) scan sediment.
|
||||
"""
|
||||
# line_starts[k] = byte offset where line (k+1) begins; line 1 starts at 0.
|
||||
line_starts = [0]
|
||||
i = src.find('\n')
|
||||
while i != -1:
|
||||
line_starts.append(i + 1)
|
||||
i = src.find('\n', i + 1)
|
||||
from bisect import bisect_right
|
||||
|
||||
result = []
|
||||
for m in _TOK_RE.finditer(src):
|
||||
tok = m.group()
|
||||
if tok.startswith(';'): continue
|
||||
line = src.count('\n', 0, m.start()) + 1
|
||||
line = bisect_right(line_starts, m.start())
|
||||
result.append((tok, line))
|
||||
return result
|
||||
|
||||
|
|
@ -3260,6 +3273,12 @@ def make_global_env():
|
|||
d(S('tcp-recv'), lambda a, _: _tcp_recv(a[0], int(a[1])))
|
||||
d(S('tcp-send'), lambda a, _: _tcp_send(a[0], _str_val(a[1])))
|
||||
d(S('tcp-close'), lambda a, _: (a[0].close(), VOID)[-1])
|
||||
# heap-snapshot/heap-restore are asm-only arena primitives. Python has
|
||||
# real GC so these are no-ops here — they exist only to let portable
|
||||
# .lsp code call them unconditionally.
|
||||
d(S('heap-snapshot'), lambda a, _: False)
|
||||
d(S('heap-restore'), lambda a, _: VOID)
|
||||
d(S('current-time-ms'), lambda a, _: int(__import__('time').time() * 1000))
|
||||
d(S('open-input-string'), lambda a, _: StringInputPort(_str_val(a[0])))
|
||||
d(S('open-output-string'),lambda a, _: StringOutputPort())
|
||||
d(S('get-output-string'), lambda a, _: a[0].getvalue() if isinstance(a[0], StringOutputPort) else '')
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue