sockets + portable HTTP server — 6 primitives, same server runs in all 3

Added tcp-listen/accept/connect/recv/send/close to Python, C, and asm.
One examples/http-server.lsp runs identically in all three impls and
serves HTTP/1.0 with routing, content-type, and content-length headers.

asm additions:
- SYS_SOCKET/BIND/LISTEN/ACCEPT/CONNECT/SETSOCKOPT syscalls
- 6 tcp-* builtins using the existing port encoding (SPECIAL ≥ 1000)
- bi_tcp_connect: dotted-quad IPv4 parser, no DNS dependency

Defects fixed along the way (surfaced by the HTTP server):
- string-append: was 2-arg only; now variadic (walks arg list twice)
- number->string: was stubbed to VAL_VOID; now correctly writes digits
  into a heap-allocated string (incl. negative handling)
- String-literal reader: \r and \0 escape sequences now handled (was
  silently dropping backslash, treating them as literal 'r' / '0')
- tcp_accept: sockaddr buffer was 8 bytes, now 16 (was corrupting
  caller's stack when accept wrote full struct sockaddr_in)

Pinocchio benchmark (tests/web-benchmark.sh):
At concurrency=20, 1000 requests, serving a 1KB body:

  uncommonlisp Python   373 req/s
  uncommonlisp C        370 req/s
  uncommonlisp asm      370 req/s
  python3 http.server   381 req/s  (stdlib reference)
  busybox httpd         382 req/s  (production reference)

All five converge within 3% — the client (curl fork/exec) is the
bottleneck, not the server. Our single-threaded blocking servers
are indistinguishable from battle-tested ones at this load.

Binary sizes:
  uncommonlisp asm    45 KB   (HTTP + everything else)
  busybox httpd       2.1 MB  (multi-call binary)
  python3             8 MB    (interpreter)

The asm HTTP server is 46× smaller than busybox and 176× smaller
than Python, serves from 7 Linux syscalls, and the entire protocol
handler is 70 lines of portable Scheme.

Test counts: 132 asm (up 1), rest unchanged. All green.
This commit is contained in:
russell@unturf.com 2026-04-16 18:58:27 -04:00
parent 5ce42a7089
commit bfd4ec7ec8
8 changed files with 762 additions and 89 deletions

View file

@ -263,6 +263,11 @@ check "port-display" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\")))
check "port-newline" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (display \"a\" p) (newline p) (display \"b\" p) (close-port p)) (string-length (file->string \"$LOAD_TMP/p.txt\")))" "3"
check "port-write-num" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (write 42 p) (close-port p)) (file->string \"$LOAD_TMP/p.txt\"))" '"42"'
echo "[unit] tcp sockets (create/close only)"
check "tcp-listen-close" "(let ((s (tcp-listen 0))) (port? s))" "#t"
# Note: tcp-listen 0 binds to ephemeral port. Can't accept (would block).
# Full connection round-trip tests live in the web-benchmark integration script.
echo "[integration] ports — S-expression portal written via ports"
PORTAL_TMP="$LOAD_TMP/port-portal.sexp"
check "port-portal" "(begin (define p (open-output-file \"$PORTAL_TMP\")) (display \"(define pp-x \" p) (write 42 p) (display \")\" p) (newline p) (display \"(define pp-y \" p) (write 777 p) (display \")\" p) (newline p) (close-port p) (define pp-x 0) (define pp-y 0) (load \"$PORTAL_TMP\") (+ pp-x pp-y))" "819"

Binary file not shown.

Binary file not shown.

View file

@ -28,8 +28,19 @@
.equ SYS_LSEEK, 8
.equ SYS_MMAP, 9
.equ SYS_MUNMAP,11
.equ SYS_SOCKET,41
.equ SYS_CONNECT,42
.equ SYS_ACCEPT,43
.equ SYS_BIND, 49
.equ SYS_LISTEN,50
.equ SYS_SETSOCKOPT,54
.equ SYS_EXIT, 60
.equ AF_INET, 2
.equ SOCK_STREAM,1
.equ SOL_SOCKET,1
.equ SO_REUSEADDR,2
.equ O_RDONLY, 0
.equ O_WRONLY, 1
.equ O_CREAT, 64
@ -143,7 +154,13 @@
.equ BI_PORTP, 76
.equ BI_WRITEFILE, 77
.equ BI_FILETOSTR, 78
.equ BI_COUNT, 79
.equ BI_TCPLISTEN, 79
.equ BI_TCPACCEPT, 80
.equ BI_TCPCONNECT, 81
.equ BI_TCPRECV, 82
.equ BI_TCPSEND, 83
.equ BI_TCPCLOSE, 84
.equ BI_COUNT, 85
# ============================================================
.data
@ -248,6 +265,12 @@ bn_closeport: .byte 10; .ascii "close-port"
bn_portp: .byte 5; .ascii "port?"
bn_writefile: .byte 10; .ascii "write-file"
bn_filetostr: .byte 12; .ascii "file->string"
bn_tcplisten: .byte 10; .ascii "tcp-listen"
bn_tcpaccept: .byte 10; .ascii "tcp-accept"
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"
portal_magic: .ascii "ULPORTAL"
.equ PORTAL_MAGIC_LEN, 8
@ -275,6 +298,8 @@ bi_names:
.quad bn_portalsave, bn_portalresume, bn_load
.quad bn_openout, bn_closeport, bn_portp
.quad bn_writefile, bn_filetostr
.quad bn_tcplisten, bn_tcpaccept, bn_tcpconnect
.quad bn_tcprecv, bn_tcpsend, bn_tcpclose
# Error messages
err_unbound: .ascii "Error: unbound variable: "
@ -1026,7 +1051,17 @@ scheme_read:
movb $9, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
2: movb %al, (%rsp,%rbx)
2: cmpb $'r', %al
jne 3f
movb $13, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
3: cmpb $'0', %al
jne 4f
movb $0, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
4: movb %al, (%rsp,%rbx)
incq %rbx
jmp .sr_str_loop
.sr_str_end:
@ -2441,6 +2476,18 @@ eval_list:
je bi_write_file
cmpq $BI_FILETOSTR, %rax
je bi_file_to_string
cmpq $BI_TCPLISTEN, %rax
je bi_tcp_listen
cmpq $BI_TCPACCEPT, %rax
je bi_tcp_accept
cmpq $BI_TCPCONNECT, %rax
je bi_tcp_connect
cmpq $BI_TCPRECV, %rax
je bi_tcp_recv
cmpq $BI_TCPSEND, %rax
je bi_tcp_send
cmpq $BI_TCPCLOSE, %rax
je bi_close_port
movq $VAL_VOID, %rax
popq %r12
@ -3326,56 +3373,61 @@ bi_strref:
RET_VAL
bi_strappend:
# (string-append s1 s2 ...)
# Simple 2-arg version
GETARG %rdi # s1
# (string-append s1 s2 ...) variadic
# Save arg list head for the second pass
pushq %r12 # original arg list head
# Pass 1: total length
xorq %rcx, %rcx # accumulator
movq %r12, %rax
.bsa_len_loop:
cmpq $VAL_NIL, %rax
je .bsa_alloc
movq %rax, %rbx
andq $-8, %rbx
movq (%rbx), %rdi # string value
andq $-8, %rdi
GETARG %rsi # s2
andq $-8, %rsi
movq (%rdi), %rcx # len1
movq (%rsi), %rdx # len2
movq %r15, %rax # result
leaq (%rcx,%rdx), %r8
movq %r8, (%r15) # total length
# Copy s1 bytes
leaq 8(%r15), %r9 # dest
leaq 8(%rdi), %r10 # src1
pushq %rcx
pushq %rdx
pushq %rsi
pushq %rax
.bsa_cp1:
addq (%rdi), %rcx # += length
movq 8(%rbx), %rax # advance
jmp .bsa_len_loop
.bsa_alloc:
# Allocate string cell: 8 byte length + rcx bytes
movq %rcx, %rbx # save total length
movq %rcx, %rdi
addq $8, %rdi
call heap_alloc
movq %rax, %rbp # string object base
movq %rbx, (%rbp) # store length
leaq 8(%rbp), %r9 # dest cursor
# Pass 2: copy each arg's bytes
popq %r12 # restore arg list
pushq %rbp # save string obj
movq %r12, %rax
.bsa_copy_loop:
cmpq $VAL_NIL, %rax
je .bsa_done
movq %rax, %rbx
andq $-8, %rbx
movq (%rbx), %rdi # string value
movq 8(%rbx), %rax # save advance
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %r10 # src bytes
.bsa_byte_loop:
testq %rcx, %rcx
jz .bsa_cp2_start
movb (%r10), %bl
movb %bl, (%r9)
jz .bsa_copy_loop
movb (%r10), %r8b
movb %r8b, (%r9)
incq %r10
incq %r9
decq %rcx
jmp .bsa_cp1
.bsa_cp2_start:
popq %rax
popq %rsi
popq %rdx
popq %rcx
leaq 8(%rsi), %r10 # src2
.bsa_cp2:
testq %rdx, %rdx
jz .bsa_done
movb (%r10), %bl
movb %bl, (%r9)
incq %r10
incq %r9
decq %rdx
jmp .bsa_cp2
jmp .bsa_byte_loop
.bsa_done:
# Align r15
leaq (%rcx,%rdx), %r8 # was already computed but clobbered
movq (%rax), %r8 # reload total len from result
addq $8, %r8 # +header
addq $7, %r8
andq $-8, %r8
addq %r8, %r15
popq %rbp
movq %rbp, %rax
orq $TAG_STRING, %rax
RET_VAL
@ -3401,57 +3453,60 @@ bi_streqp:
jmp .bseq_loop
bi_numtostr:
# (number->string n) string
# Write digits (reverse) into num_buf[end..], then copy into a heap cell.
GETARG %rax
sarq $3, %rax
# Convert int to string using itoa
pushq %rax
movq %r15, %rdx # result string obj
addq $8, %r15 # skip length field
movq %r15, %rdi # buffer
popq %rax
# Handle negative
sarq $3, %rax # untag int
leaq num_buf(%rip), %rdi
addq $63, %rdi # write backward from end
movb $0, (%rdi) # sentinel (not used for length)
movq %rdi, %rsi # save end pos
# Detect negative
xorq %r8, %r8 # negative flag
testq %rax, %rax
jns .bn2s_pos
jns .bn2s_absloop
movq $1, %r8
negq %rax
movb $'-', (%rdi)
incq %rdi
.bn2s_pos:
# itoa into buffer
movq %rdi, %r8 # start
movq $10, %rcx
.bn2s_dloop:
.bn2s_absloop:
xorq %rdx, %rdx
divq %rcx
movq $10, %rcx
divq %rcx # rax = q, rdx = r
addb $'0', %dl
decq %rdi
movb %dl, (%rdi)
incq %rdi
testq %rax, %rax
jnz .bn2s_dloop
# Reverse the digits
movq %rdi, %rsi # end
movq %r8, %rdi # start
decq %rsi
.bn2s_rev:
cmpq %rdi, %rsi
jle .bn2s_revdone
movb (%rdi), %al
movb (%rsi), %cl
movb %cl, (%rdi)
movb %al, (%rsi)
jnz .bn2s_absloop
testq %r8, %r8
jz .bn2s_copy
decq %rdi
movb $'-', (%rdi)
.bn2s_copy:
# rdi = start of digit bytes, rsi = end (exclusive)
movq %rsi, %rcx
subq %rdi, %rcx # length
# Allocate string cell: 8 byte length + rcx bytes
pushq %rdi
pushq %rcx
movq %rcx, %rdi
addq $8, %rdi
call heap_alloc
popq %rcx
popq %rdi
movq %rcx, (%rax) # length
movq %rax, %rbx # save obj
leaq 8(%rax), %rdx
.bn2s_copyloop:
testq %rcx, %rcx
jz .bn2s_done
movb (%rdi), %r8b
movb %r8b, (%rdx)
incq %rdi
decq %rsi
jmp .bn2s_rev
.bn2s_revdone:
# Compute length
movq %r15, %rax
subq $8, %rax # string obj start
movq %rsi, %rcx # approximate end... need actual end
# Redo: length = current r15 pos + digits - string start - 8
# Actually this is getting complex. Simpler approach:
# We wrote digits starting at (string_obj + 8), ending at current rdi+1
# The result string obj is at (r15 - 8 - digit_count - maybe_minus)
# Let me just use the print buffer approach
movq $VAL_VOID, %rax # TODO: fix numtostr properly
incq %rdx
decq %rcx
jmp .bn2s_copyloop
.bn2s_done:
movq %rbx, %rax
orq $TAG_STRING, %rax
RET_VAL
bi_strtonum:
@ -4344,6 +4399,288 @@ bi_file_to_string:
movq $VAL_FALSE, %rax
RET_VAL
# ============================================================
# TCP sockets: fd encoded as port (same as file ports).
# tcp-recv = sys_read, tcp-send = sys_write, tcp-close = close-port.
# ============================================================
# encode_port: %rdi = fd %rax = port value
encode_port:
movq %rdi, %rax
addq $PORT_SPECIAL_BASE, %rax
shlq $3, %rax
orq $TAG_SPECIAL, %rax
ret
# decode_port: %rdi = port value %rax = fd (or -1 if not a port)
decode_port:
movq %rdi, %rax
andq $TAG_MASK, %rax
cmpq $TAG_SPECIAL, %rax
jne .dp_bad
movq %rdi, %rax
shrq $3, %rax
cmpq $PORT_SPECIAL_BASE, %rax
jl .dp_bad
subq $PORT_SPECIAL_BASE, %rax
ret
.dp_bad:
movq $-1, %rax
ret
# bi_tcp_listen: (tcp-listen port) port or #f
bi_tcp_listen:
GETARG %rax
sarq $3, %rax # untag int port number
movq %rax, %rbp # save port
# socket(AF_INET, SOCK_STREAM, 0)
movq $SYS_SOCKET, %rax
movq $AF_INET, %rdi
movq $SOCK_STREAM, %rsi
xorq %rdx, %rdx
syscall
testq %rax, %rax
js .tl_fail
movq %rax, %rbx # fd
# setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, &one, 4)
subq $16, %rsp
movl $1, (%rsp)
movq $SYS_SETSOCKOPT, %rax
movq %rbx, %rdi
movq $SOL_SOCKET, %rsi
movq $SO_REUSEADDR, %rdx
movq %rsp, %r10
movq $4, %r8
syscall
addq $16, %rsp
# Build sockaddr_in on stack (16 bytes):
# [0:2] sin_family = AF_INET = 2
# [2:4] sin_port = htons(port)
# [4:8] sin_addr = 0 (INADDR_ANY)
# [8:16] padding = 0
subq $16, %rsp
movw $AF_INET, (%rsp)
# htons(port): swap bytes of lower 16 bits
movq %rbp, %rax
movw %ax, %cx
rolw $8, %cx
movw %cx, 2(%rsp)
movl $0, 4(%rsp)
movq $0, 8(%rsp)
# bind(fd, &addr, 16)
movq $SYS_BIND, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $16, %rdx
syscall
addq $16, %rsp
testq %rax, %rax
js .tl_close_fail
# listen(fd, 128)
movq $SYS_LISTEN, %rax
movq %rbx, %rdi
movq $128, %rsi
syscall
testq %rax, %rax
js .tl_close_fail
movq %rbx, %rdi
call encode_port
RET_VAL
.tl_close_fail:
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
.tl_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_accept: (tcp-accept server) port or #f
bi_tcp_accept:
GETARG %rdi
call decode_port
cmpq $0, %rax
jl .ta_fail
movq %rax, %rbx # server fd
# accept(fd, &addr, &addrlen); reserve 32 bytes:
# [0..4] addrlen (in: 16, out: 16)
# [8..24] sockaddr_in (16 bytes)
subq $32, %rsp
movl $16, (%rsp)
movq $SYS_ACCEPT, %rax
movq %rbx, %rdi
leaq 8(%rsp), %rsi # sockaddr buffer (16 bytes)
movq %rsp, %rdx # addrlen ptr
syscall
addq $32, %rsp
testq %rax, %rax
js .ta_fail
movq %rax, %rdi
call encode_port
RET_VAL
.ta_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_connect: (tcp-connect host port) port or #f
# Only supports dotted-quad IPv4 addresses (no DNS).
bi_tcp_connect:
GETARG %rdi # host string
GETARG %rax # port int
sarq $3, %rax
movq %rax, %rbp # port number
# Parse dotted quad into 4-byte addr on stack
subq $8, %rsp # buf
movl $0, (%rsp)
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %rdi # bytes
xorq %r8, %r8 # octet value
xorq %r9, %r9 # octet index (0..3)
.tc_parse:
testq %rcx, %rcx
jz .tc_store
movzbq (%rdi), %rax
cmpb $'.', %al
je .tc_dot
subb $'0', %al
cmpb $9, %al
ja .tc_fail_parse
imulq $10, %r8
addq %rax, %r8
incq %rdi
decq %rcx
jmp .tc_parse
.tc_dot:
movq %r9, %rax
movb %r8b, (%rsp,%rax)
incq %r9
cmpq $4, %r9
jge .tc_fail_parse
xorq %r8, %r8
incq %rdi
decq %rcx
jmp .tc_parse
.tc_store:
movq %r9, %rax
movb %r8b, (%rsp,%rax)
# socket()
movq $SYS_SOCKET, %rax
movq $AF_INET, %rdi
movq $SOCK_STREAM, %rsi
xorq %rdx, %rdx
syscall
testq %rax, %rax
js .tc_fail
movq %rax, %rbx # fd
# Build sockaddr_in
subq $16, %rsp
movw $AF_INET, (%rsp)
movq %rbp, %rax
movw %ax, %cx
rolw $8, %cx
movw %cx, 2(%rsp)
movl 16(%rsp), %eax # the parsed IP (dword at original buf)
movl %eax, 4(%rsp)
movq $0, 8(%rsp)
movq $SYS_CONNECT, %rax
movq %rbx, %rdi
movq %rsp, %rsi
movq $16, %rdx
syscall
addq $16, %rsp
addq $8, %rsp # discard parse buf
testq %rax, %rax
js .tc_close_fail
movq %rbx, %rdi
call encode_port
RET_VAL
.tc_close_fail:
movq $SYS_CLOSE, %rax
movq %rbx, %rdi
syscall
jmp .tc_fail_noparsebuf
.tc_fail_parse:
.tc_fail:
addq $8, %rsp
.tc_fail_noparsebuf:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_recv: (tcp-recv sock max) string or #f
bi_tcp_recv:
GETARG %rdi
call decode_port
cmpq $0, %rax
jl .tr_fail
movq %rax, %rbx # fd
GETARG %rax # max bytes
sarq $3, %rax
cmpq $65536, %rax
jle .tr_ok
movq $65536, %rax # cap at 64 KB
.tr_ok:
movq %rax, %rbp # size
# Allocate string cell: 8-byte length + size bytes
movq %rbp, %rdi
addq $8, %rdi
call heap_alloc
movq %rax, %r12 # string object base
# read(fd, cell+8, size)
movq $SYS_READ, %rax
movq %rbx, %rdi
leaq 8(%r12), %rsi
movq %rbp, %rdx
syscall
testq %rax, %rax
js .tr_fail
movq %rax, (%r12) # actual length
movq %r12, %rax
orq $TAG_STRING, %rax
RET_VAL
.tr_fail:
movq $VAL_FALSE, %rax
RET_VAL
# bi_tcp_send: (tcp-send sock string) int bytes written or #f
bi_tcp_send:
GETARG %rdi
call decode_port
cmpq $0, %rax
jl .ts_fail
movq %rax, %rbx # fd
GETARG %rdi # string
andq $-8, %rdi
movq (%rdi), %rdx # length
leaq 8(%rdi), %rsi # bytes
movq $SYS_WRITE, %rax
movq %rbx, %rdi
syscall
testq %rax, %rax
js .ts_fail
shlq $3, %rax # tag as int
RET_VAL
.ts_fail:
movq $VAL_FALSE, %rax
RET_VAL
# ============================================================
# list_reverse: %rdi = list -> %rax = reversed list
# ============================================================