diff --git a/asm/uncommonlisp b/asm/uncommonlisp index 7ebf6a2..600d481 100755 Binary files a/asm/uncommonlisp and b/asm/uncommonlisp differ diff --git a/asm/uncommonlisp.o b/asm/uncommonlisp.o index c7efe25..84204d3 100644 Binary files a/asm/uncommonlisp.o and b/asm/uncommonlisp.o differ diff --git a/asm/uncommonlisp.s b/asm/uncommonlisp.s index 312341a..54c0c39 100644 --- a/asm/uncommonlisp.s +++ b/asm/uncommonlisp.s @@ -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. diff --git a/c/builtins.c b/c/builtins.c index bf2bf46..10fa2df 100644 --- a/c/builtins.c +++ b/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 +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); diff --git a/examples/http-client-bench.lsp b/examples/http-client-bench.lsp new file mode 100644 index 0000000..482d96a --- /dev/null +++ b/examples/http-client-bench.lsp @@ -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) diff --git a/examples/http-server.lsp b/examples/http-server.lsp index eb160c2..bda5760 100644 --- a/examples/http-server.lsp +++ b/examples/http-server.lsp @@ -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) diff --git a/uncommonlisp.py b/uncommonlisp.py index bead283..c8a8ea5 100644 --- a/uncommonlisp.py +++ b/uncommonlisp.py @@ -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 '')