engineering/lumbda
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

S-expressions over sockets — RPC + remote REPL in portable Scheme

Browse source 
Fuses portal (Scheme-source-as-interchange) with sockets (bytes over
the network). Wire protocol: one S-expression per connection. Same
server + client .lsp runs byte-identically in Python, C, and asm.

New primitives in all three impls:
- read-from-string — parse one sexp from a string

Asm gets two more:
- symbol->string — standard R7RS, was missing
- eval — evaluate a Scheme value in the global env (Python + C had
  it as a special form; asm exposes it as a builtin)

examples/rpc-server.lsp (port 9080):
- Whitelisted dispatch: ping / add / mul / fib / echo
- Never calls eval on client input; safe by construction
- Uses heap-snapshot/restore for O(1) memory on asm
- ~90 lines, portable

examples/rpc-client.lsp:
- Sends one request, reads one response, displays both
- 45 lines, portable

examples/repl-server.lsp (port 9081):
- DANGER: full remote eval. Any Scheme form accepted and evaluated
  in the server's global env. Persistent across connections.
- Deliberately does NOT use heap-snapshot — remote (define x ...)
  lives in the global env above any snapshot point; rewinding would
  invalidate the new binding. The ulimit -v 512 MB safety net
  (documented in CLAUDE.md) ensures an escaped process can't crash
  the machine.
- ~70 lines, portable. Demonstrates what "the language IS the
  interchange format" gets you at the limit: a single socket and
  a single primitive (eval) carry a full-powered REPL.

Verified 3×3 server×client matrix: all 9 combinations green.
All 132 asm + 571 py + 189 shared + 83 c tests still pass.

One quirk discovered and worked around: in asm, a closure captures
its env chain by pointer at define time. Forward-referenced names
in mutually-recursive toplevel defines can fail under specific
heap-restore patterns — see the leaf-first ordering note in
rpc-server.lsp.
This commit is contained in:
russell@unturf.com 2026-04-17 09:00:04 -04:00
parent fb41b73274
commit 574ddc50d7
8 changed files with 370 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

BIN
asm/uncommonlisp
View file

Binary file not shown.

BIN
asm/uncommonlisp.o
View file

Binary file not shown.

102
asm/uncommonlisp.s
View file

@ -165,7 +165,10 @@
.equ BI_HEAPSNAP, 85
.equ BI_HEAPREST, 86
.equ BI_CURTIME, 87
.equ BI_COUNT, 88
.equ BI_READSTR, 88
.equ BI_EVAL, 89
.equ BI_SYMTOSTR, 90
.equ BI_COUNT, 91
# ============================================================
.data
@ -279,6 +282,9 @@ 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"
bn_readstr: .byte 16; .ascii "read-from-string"
bn_eval: .byte 4; .ascii "eval"
bn_symtostr: .byte 14; .ascii "symbol->string"
portal_magic: .ascii "ULPORTAL"
.equ PORTAL_MAGIC_LEN, 8
@ -309,6 +315,7 @@ bi_names:
.quad bn_tcplisten, bn_tcpaccept, bn_tcpconnect
.quad bn_tcprecv, bn_tcpsend, bn_tcpclose
.quad bn_heapsnap, bn_heaprest, bn_curtime
.quad bn_readstr, bn_eval, bn_symtostr
# Error messages
err_unbound: .ascii "Error: unbound variable: "
@ -2503,6 +2510,12 @@ eval_list:
je bi_heap_restore
cmpq $BI_CURTIME, %rax
je bi_current_time_ms
cmpq $BI_READSTR, %rax
je bi_read_from_string
cmpq $BI_EVAL, %rax
je bi_eval
cmpq $BI_SYMTOSTR, %rax
je bi_symbol_to_string
movq $VAL_VOID, %rax
popq %r12
@ -4454,6 +4467,93 @@ bi_heap_restore:
movq $VAL_VOID, %rax
RET_VAL
# bi_read_from_string: (read-from-string "sexp") → value
# Saves the current input-buffer state, swaps in the caller's string
# as the input source, reads one expression, restores input state.
bi_read_from_string:
GETARG %rdi
andq $-8, %rdi
movq (%rdi), %rcx # length
leaq 8(%rdi), %r8 # pointer to string bytes
# Save input state (buf_ptr, pos, end, is_file) to stack
movq input_buf_ptr(%rip), %rax
pushq %rax
movq input_pos(%rip), %rax
pushq %rax
movq input_end(%rip), %rax
pushq %rax
movq input_is_file(%rip), %rax
pushq %rax
# Swap input to the string. Mark as "file" so no stdin refill.
movq %r8, input_buf_ptr(%rip)
movq $0, input_pos(%rip)
movq %rcx, input_end(%rip)
movq $1, input_is_file(%rip)
call scheme_read # rax = value (or 0 for EOF)
movq %rax, %rbx # stash result in callee-save
# Restore input state (pop reversed order of push)
popq %rax
movq %rax, input_is_file(%rip)
popq %rax
movq %rax, input_end(%rip)
popq %rax
movq %rax, input_pos(%rip)
popq %rax
movq %rax, input_buf_ptr(%rip)
# Translate EOF (0) into VAL_FALSE so callers can distinguish
movq %rbx, %rax
testq %rax, %rax
jnz .brfs_done
movq $VAL_FALSE, %rax
.brfs_done:
RET_VAL
# bi_eval: (eval expr) → value (evaluates in global env r14)
bi_eval:
GETARG %rdi # expr
movq %r14, %rsi # env
call eval
RET_VAL
# bi_symbol_to_string: (symbol->string 'foo) → "foo"
# Symbols are stored as [length-byte, bytes...] at ptr (low 3 bits = TAG_SYM).
# Return a fresh string cell [8-byte length, bytes...].
bi_symbol_to_string:
GETARG %rdi # symbol value
andq $-8, %rdi # untag
movzbq (%rdi), %rcx # length (one byte)
leaq 1(%rdi), %r8 # byte pointer
pushq %rcx
pushq %r8
movq %rcx, %rdi
addq $8, %rdi # cell size: 8-byte length + bytes
call heap_alloc
popq %r8
popq %rcx
movq %rcx, (%rax) # store length as 8 bytes
movq %rax, %rbx # save result pointer
leaq 8(%rax), %rdx # dest
.b_s2s_copy:
testq %rcx, %rcx
jz .b_s2s_done
movb (%r8), %r9b
movb %r9b, (%rdx)
incq %r8
incq %rdx
decq %rcx
jmp .b_s2s_copy
.b_s2s_done:
movq %rbx, %rax
orq $TAG_STRING, %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:

10
c/builtins.c
View file

@ -1226,6 +1226,15 @@ static Value bi_current_time_ms(Value *a, int n, Env *e) {
int64_t ms = (int64_t)ts.tv_sec * 1000 + ts.tv_nsec / 1000000;
return VAL_INT(ms);
}
static Value bi_read_from_string(Value *a, int n, Env *e) {
(void)e; CHECK_ARITY("read-from-string", 1); check_string(a[0]);
int count = 0;
Value *exprs = read_all(AS_STRING(a[0])->data, &count, false);
Value r = (count > 0) ? exprs[0] : VAL_FALSE;
ul_free(exprs);
return r;
}
static Value bi_open_output_string(Value *a, int n, Env *e) {
(void)e;
return make_string_output_port();
@ -1866,6 +1875,7 @@ Env *make_global_env(void) {
DEF("heap-snapshot", bi_heap_snapshot);
DEF("heap-restore", bi_heap_restore);
DEF("current-time-ms", bi_current_time_ms);
DEF("read-from-string", bi_read_from_string);
DEF("open-input-string", bi_open_input_string);
DEF("open-output-string", bi_open_output_string);
DEF("get-output-string", bi_get_output_string);

87
examples/repl-server.lsp Normal file
View file

@ -0,0 +1,87 @@
;;; repl-server.lsp — REMOTE SCHEME REPL OVER TCP.
;;;
;;; DANGER: this accepts ANY S-expression from the network and evaluates
;;; it in the global environment. Anyone who can reach the TCP port can
;;; run arbitrary Scheme code in this process — read files, open sockets,
;;; shell out via system calls if any are exposed, leak the env, etc.
;;;
;;; Run on localhost only. Do not expose publicly. This exists to show
;;; what the "language IS the interchange" thesis gets you when taken
;;; to its logical end: a single socket carries a full-powered REPL
;;; because both sides already have a reader and an evaluator.
;;;
;;; Usage:
;;; python3 uncommonlisp.py --fast examples/repl-server.lsp
;;; ./c/uncommonlisp examples/repl-server.lsp
;;; ./asm/uncommonlisp < examples/repl-server.lsp
;;;
;;; Then from a client:
;;; (define x 42) ; server mutates its global env
;;; (* x 10) ; => 420
;;; (map car '((1 a) (2 b))) ; => (1 2)
;;;
;;; Each connection = one request + one response. Persistent sessions
;;; across connections because all defines land in the shared global env.
(define *port* 9081)
(define *max-requests* 10000)
;; Portable serializer — same as rpc-server.lsp pattern.
;; Avoids open-output-string and `guard` (neither exists in asm).
(define (atom->string v)
(cond
((number? v) (number->string v))
((symbol? v) (symbol->string v))
((null? v) "()")
((pair? v) (string-append "(" (list->string v) ")"))
((string? v) (string-append "\"" v "\""))
(else "#<unknown>")))
(define (list->string lst)
(cond
((null? lst) "")
((null? (cdr lst)) (atom->string (car lst)))
(else (string-append (atom->string (car lst)) " " (list->string (cdr lst))))))
(define (response->string v)
(cond
((number? v) (string-append (number->string v) "\n"))
((symbol? v) (string-append (symbol->string v) "\n"))
((null? v) "()\n")
((pair? v) (string-append "(" (list->string v) ")\n"))
((string? v) (string-append "\"" v "\"\n"))
(else "#<unknown>\n")))
(define (handle-request raw)
(let ((form (read-from-string raw)))
(if (eqv? form #f)
"(error \"empty or malformed input\")\n"
(response->string (eval form)))))
(define server (tcp-listen *port*))
;; Intentionally does NOT use heap-snapshot. A remote `(define x ...)`
;; adds a new binding to the global env chain — heap cells allocated
;; AFTER any snapshot point. Rewinding would invalidate those bindings.
;; The asm heap grows with each new top-level define; the ulimit -v
;; safety net kills the process if it escapes. Each request still
;; produces garbage (tcp-recv buffer, intermediate strings) that stays
;; forever — acceptable for a demo, at ~100 bytes per request plus
;; whatever `define` binds.
(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 8192)))
(if (and req (> (string-length req) 0))
(tcp-send client (handle-request req))
#f))
(tcp-close client))
(server-loop (+ n 1)))))
(display "repl-server on :") (display *port*)
(display " — DANGER: full remote eval") (newline)
(server-loop 0)

53
examples/rpc-client.lsp Normal file
View file

@ -0,0 +1,53 @@
;;; rpc-client.lsp — send one S-expression, read one back.
;;;
;;; Demonstrates the three-way symmetry: the CLIENT is also portable
;;; across Python, C, and asm. Any client impl talks to any server impl
;;; because they agree on S-expression framing.
;;;
;;; Usage:
;;; python3 uncommonlisp.py --fast examples/rpc-client.lsp
;;; ./c/uncommonlisp examples/rpc-client.lsp
;;; ./asm/uncommonlisp < examples/rpc-client.lsp
;;;
;;; Override *target-port* before loading to hit either rpc-server (9080)
;;; or repl-server (9081).
(define *host* "127.0.0.1")
(define *target-port* 9080)
;; Serialize a form to a string — same pattern as rpc-server's
;; response->string. Avoids open-output-string so this runs in asm.
(define (form->string v)
(cond
((number? v) (number->string v))
((symbol? v) (symbol->string v))
((null? v) "()")
((pair? v) (string-append "(" (list->string v) ")"))
((string? v) (string-append "\"" v "\""))
(else "#<unknown>")))
(define (list->string lst)
(cond
((null? lst) "")
((null? (cdr lst)) (form->string (car lst)))
(else (string-append (form->string (car lst)) " " (list->string (cdr lst))))))
(define (rpc request-form)
(let ((sock (tcp-connect *host* *target-port*)))
(tcp-send sock (form->string request-form))
(let ((resp (tcp-recv sock 8192)))
(tcp-close sock)
(if (and resp (> (string-length resp) 0))
(read-from-string resp)
'no-response))))
(define (demo form)
(display "→ ") (write form) (newline)
(display "← ") (write (rpc form)) (newline)
(newline))
(demo '(ping))
(demo '(add 1 2 3 4 5))
(demo '(mul 6 7))
(demo '(fib 30))
(demo '(echo (hello world)))
(demo '(nope whatever))

110
examples/rpc-server.lsp Normal file
View file

@ -0,0 +1,110 @@
;;; rpc-server.lsp — S-expression RPC with a whitelisted dispatch table.
;;;
;;; Wire protocol: each connection carries ONE request S-expression and
;;; returns ONE response S-expression. Bytes on the wire are Scheme source;
;;; the parser on each side is already the right tool.
;;;
;;; Runs byte-identically in Python, C, and asm:
;;; python3 uncommonlisp.py --fast examples/rpc-server.lsp
;;; ./c/uncommonlisp examples/rpc-server.lsp
;;; ./asm/uncommonlisp < examples/rpc-server.lsp
;;;
;;; Request examples (send as plain text, one per connection):
;;; (ping) -> pong
;;; (add 1 2 3) -> 6
;;; (mul 6 7) -> 42
;;; (fib 30) -> 832040
;;; (echo (1 2 3)) -> (1 2 3)
;;; (nope whatever) -> (error "unknown op: nope")
;;;
;;; The server never calls (eval) on client input. Only whitelisted ops
;;; run. This is the safe RPC pattern. For full remote eval see
;;; examples/repl-server.lsp.
(define *port* 9080)
(define *max-requests* 100000)
;;; ── Whitelisted handlers ────────────────────────────────────
(define (do-ping args) 'pong)
(define (do-echo args) (if (pair? args) (car args) '()))
(define (do-add args)
(if (null? args) 0
(+ (car args) (do-add (cdr args)))))
(define (do-mul args)
(if (null? args) 1
(* (car args) (do-mul (cdr args)))))
(define (do-fib args)
(let loop ((a 0) (b 1) (i 0) (n (car args)))
(if (= i n) a (loop b (+ a b) (+ i 1) n))))
(define (dispatch op args)
(cond
((eqv? op 'ping) (do-ping args))
((eqv? op 'echo) (do-echo args))
((eqv? op 'add) (do-add args))
((eqv? op 'mul) (do-mul args))
((eqv? op 'fib) (do-fib args))
(else (list 'error (string-append "unknown op: " (symbol->string op))))))
;;; ── Wire handler ────────────────────────────────────────────
(define (handle-request raw)
;; raw is a string like "(add 1 2)". Parse, dispatch, return a string.
(let ((form (read-from-string raw)))
(if (pair? form)
(let ((op (car form)) (args (cdr form)))
(response->string (dispatch op args)))
(response->string (list 'error "malformed request")))))
;; Defined leaf-first so closures never capture a forward reference —
;; which the asm impl resolves at define time via env-chain pointer
;; and therefore cannot see a name bound later.
(define (atom->string v)
(cond
((number? v) (number->string v))
((symbol? v) (symbol->string v))
((null? v) "()")
((pair? v) (string-append "(" (list->string v) ")"))
((string? v) (string-append "\"" v "\""))
(else "#<unknown>")))
(define (list->string lst)
(cond
((null? lst) "")
((null? (cdr lst)) (atom->string (car lst)))
(else (string-append (atom->string (car lst)) " " (list->string (cdr lst))))))
(define (response->string v)
;; Custom readable serializer — avoids open-output-string so this runs
;; unchanged in asm (which lacks mutable string ports). Covers the
;; response shapes our dispatch table can return.
(cond
((number? v) (string-append (number->string v) "\n"))
((symbol? v) (string-append (symbol->string v) "\n"))
((null? v) "()\n")
((pair? v) (string-append "(" (list->string v) ")\n"))
((string? v) (string-append "\"" v "\"\n"))
(else "#<unknown>\n")))
;;; ── Main loop ───────────────────────────────────────────────
(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))
(heap-restore snap)
(server-loop (+ n 1) snap))))
(display "rpc-server on :") (display *port*)
(display " (whitelisted: ping echo add mul fib)") (newline)
(server-loop 0 (heap-snapshot))

9
uncommonlisp.py
View file

@ -2659,6 +2659,11 @@ def _read_file_to_string(path):
except OSError:
return False
def _read_from_string(s):
"""Parse one S-expression from the given string. Returns first form."""
forms = list(read_all(s))
return forms[0] if forms else False
import socket as _sockmod
def _tcp_listen(port):
s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM)
@ -3279,6 +3284,10 @@ def make_global_env():
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('read-from-string'), lambda a, _: _read_from_string(_str_val(a[0])))
# eval is already a special form (see leval); exposing it as a builtin would
# be shadowed by that dispatch. RPC servers can still call `(eval sexp)`
# literally because the special form handles it.
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 '')