diff --git a/asm/test.sh b/asm/test.sh index a3fed76..03cc01f 100644 --- a/asm/test.sh +++ b/asm/test.sh @@ -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" diff --git a/asm/uncommonlisp b/asm/uncommonlisp index dacd550..7ebf6a2 100755 Binary files a/asm/uncommonlisp and b/asm/uncommonlisp differ diff --git a/asm/uncommonlisp.o b/asm/uncommonlisp.o index bf826ba..c7efe25 100644 Binary files a/asm/uncommonlisp.o and b/asm/uncommonlisp.o differ diff --git a/asm/uncommonlisp.s b/asm/uncommonlisp.s index c4c0a99..312341a 100644 --- a/asm/uncommonlisp.s +++ b/asm/uncommonlisp.s @@ -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 # ============================================================ diff --git a/c/builtins.c b/c/builtins.c index de4c5d6..bf2bf46 100644 --- a/c/builtins.c +++ b/c/builtins.c @@ -1110,6 +1110,100 @@ static Value bi_open_input_string(Value *a, int n, Env *e) { ULString *s = AS_STRING(a[0]); return make_string_input_port(s->data, s->len); } + +/* ── TCP sockets: fd wrapped in a FILE* via fdopen, unbuffered ─ */ +#include +#include +#include +#include +#include +#include + +static Value wrap_fd_as_port(int fd, PortDir dir) { + FILE *fp = fdopen(fd, dir == PORT_INPUT ? "rb" : "r+b"); + if (!fp) { close(fd); return VAL_FALSE; } + setvbuf(fp, NULL, _IONBF, 0); + return make_file_port(fp, dir); +} + +static Value bi_tcp_listen(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("tcp-listen", 1); + int port = (int)as_int(a[0]); + int fd = socket(AF_INET, SOCK_STREAM, 0); + if (fd < 0) return VAL_FALSE; + int one = 1; + setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(one)); + struct sockaddr_in addr = {0}; + addr.sin_family = AF_INET; + addr.sin_addr.s_addr = htonl(INADDR_ANY); + addr.sin_port = htons((uint16_t)port); + if (bind(fd, (struct sockaddr *)&addr, sizeof(addr)) < 0) { close(fd); return VAL_FALSE; } + if (listen(fd, 128) < 0) { close(fd); return VAL_FALSE; } + return wrap_fd_as_port(fd, PORT_INPUT); +} + +static Value bi_tcp_accept(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("tcp-accept", 1); + ULPort *p = AS_PORT(a[0]); + int server_fd = fileno(p->fp); + struct sockaddr_in caddr; + socklen_t clen = sizeof(caddr); + int cfd = accept(server_fd, (struct sockaddr *)&caddr, &clen); + if (cfd < 0) return VAL_FALSE; + return wrap_fd_as_port(cfd, PORT_OUTPUT); +} + +static Value bi_tcp_connect(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("tcp-connect", 2); check_string(a[0]); + const char *host = AS_STRING(a[0])->data; + int port = (int)as_int(a[1]); + int fd = socket(AF_INET, SOCK_STREAM, 0); + if (fd < 0) return VAL_FALSE; + struct sockaddr_in addr = {0}; + addr.sin_family = AF_INET; + addr.sin_port = htons((uint16_t)port); + if (inet_pton(AF_INET, host, &addr.sin_addr) <= 0) { + struct hostent *he = gethostbyname(host); + if (!he) { close(fd); return VAL_FALSE; } + memcpy(&addr.sin_addr, he->h_addr_list[0], he->h_length); + } + if (connect(fd, (struct sockaddr *)&addr, sizeof(addr)) < 0) { close(fd); return VAL_FALSE; } + return wrap_fd_as_port(fd, PORT_OUTPUT); +} + +static Value bi_tcp_recv(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("tcp-recv", 2); + ULPort *p = AS_PORT(a[0]); + size_t cap = (size_t)as_int(a[1]); + if (cap > (1u << 20)) cap = (1u << 20); + char *buf = ul_malloc(cap + 1); + int fd = fileno(p->fp); + ssize_t got = read(fd, buf, cap); + if (got < 0) { ul_free(buf); return VAL_FALSE; } + buf[got] = '\0'; + Value r = make_string(buf, got, false); + ul_free(buf); + return r; +} + +static Value bi_tcp_send(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("tcp-send", 2); check_string(a[1]); + ULPort *p = AS_PORT(a[0]); + ULString *s = AS_STRING(a[1]); + int fd = fileno(p->fp); + ssize_t wrote = write(fd, s->data, s->len); + if (wrote < 0) return VAL_FALSE; + return VAL_INT(wrote); +} + +static Value bi_tcp_close(Value *a, int n, Env *e) { + (void)e; CHECK_ARITY("tcp-close", 1); + ULPort *p = AS_PORT(a[0]); + if (p->fp && p->fp != stdin && p->fp != stdout && p->fp != stderr) + fclose(p->fp); + p->closed = true; + return VAL_VOID; +} static Value bi_open_output_string(Value *a, int n, Env *e) { (void)e; return make_string_output_port(); @@ -1736,6 +1830,12 @@ Env *make_global_env(void) { DEF("open-output-file", bi_open_output_file); DEF("write-file", bi_write_file); DEF("file->string", bi_file_to_string); + DEF("tcp-listen", bi_tcp_listen); + DEF("tcp-accept", bi_tcp_accept); + DEF("tcp-connect", bi_tcp_connect); + DEF("tcp-recv", bi_tcp_recv); + DEF("tcp-send", bi_tcp_send); + DEF("tcp-close", bi_tcp_close); 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-server.lsp b/examples/http-server.lsp new file mode 100644 index 0000000..8c0aaac --- /dev/null +++ b/examples/http-server.lsp @@ -0,0 +1,90 @@ +;;; http-server.lsp — portable HTTP/1.0 server in pure Scheme +;;; +;;; Runs identically in Python, C, and asm. The only primitives used are +;;; the six socket builtins + display/string-append/substring. +;;; +;;; python3 uncommonlisp.py --fast examples/http-server.lsp +;;; ./c/uncommonlisp examples/http-server.lsp +;;; ./asm/uncommonlisp < examples/http-server.lsp +;;; +;;; Default port 8080. First-line dispatch: GET / → greeting page. +;;; GET /bench → 1 KB body for throughput benchmarks. +;;; Other paths → 404. + +(define *port* 8080) +(define *crlf* "\r\n") +(define *crlf-crlf* "\r\n\r\n") + +;;; ── HTTP helpers ───────────────────────────────────────────── + +(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)) + +;; Compare via char->integer so we don't need char=? (asm lacks it). +(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))))))) + +;;; ── Request handler ───────────────────────────────────────── + +(define *bench-body* + ;; ~1 KB payload so clients have something to measure throughput on. + (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" + "uncommonlisp

feedback is all you need

portable HTTP in Scheme.

")) + ((string=? path "/bench") + (http-response "200 OK" "text/plain" *bench-body*)) + ((string=? path "/hello") + (http-response "200 OK" "text/plain" "hello world\n")) + (else + (http-response "404 Not Found" "text/plain" + (string-append "not found: " path "\n")))))) + +;;; ── Main loop ─────────────────────────────────────────────── + +(define (serve) + (let ((server (tcp-listen *port*))) + (display "uncommonlisp http server on :") (display *port*) (newline) + (let loop () + (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)))) + +(serve) diff --git a/tests/web-benchmark.sh b/tests/web-benchmark.sh new file mode 100755 index 0000000..55f8a09 --- /dev/null +++ b/tests/web-benchmark.sh @@ -0,0 +1,104 @@ +#!/bin/bash +# web-benchmark.sh — race the three uncommonlisp HTTP servers +# against Python http.server and busybox httpd. +# +# No wrk/ab/nginx dependency — we use xargs+curl for concurrency. +# +# Fixed 1KB body at /bench for all servers. Wall-clock time over +# N parallel-safe requests = throughput. + +set -u +cd "$(dirname "$0")/.." + +REQUESTS=${REQUESTS:-500} +CONCURRENCY=${CONCURRENCY:-10} +PY="python3 uncommonlisp.py --fast" +C="./c/uncommonlisp" +ASM="./asm/uncommonlisp" + +pad() { printf " %-36s " "$1"; } + +bench_one() { + local label="$1" port="$2" path="$3" + pad "$label" + # Warm up + curl -s "http://localhost:$port$path" > /dev/null + # Measure + local t0 t1 + t0=$(date +%s.%N) + seq 1 "$REQUESTS" | xargs -P "$CONCURRENCY" -I_ \ + curl -s -o /dev/null "http://localhost:$port$path" + t1=$(date +%s.%N) + python3 -c " +t = float('$t1') - float('$t0') +rps = $REQUESTS / t +print(f'{rps:8.0f} req/s ({t:.3f}s total, concurrency $CONCURRENCY)')" +} + +# Setup a 1KB static file for file-serving benchmarks +STATIC_DIR=$(mktemp -d) +printf '%.0s0123456789abcdef0123456789abcdef' {1..32} > "$STATIC_DIR/bench" +trap "rm -rf $STATIC_DIR" EXIT + +echo "═══════════════════════════════════════════════════════════════" +echo "HTTP benchmark — $REQUESTS requests, concurrency $CONCURRENCY" +echo "═══════════════════════════════════════════════════════════════" +echo + +# Helper to start + wait for port ready +start_server() { + local cmd="$1" port="$2" + eval "$cmd" > /dev/null 2>&1 & + local pid=$! + for _ in $(seq 1 20); do + if curl -s -o /dev/null -w "%{http_code}" "http://localhost:$port/" 2>/dev/null | grep -q 200; then + echo "$pid" + return 0 + fi + sleep 0.1 + done + kill "$pid" 2>/dev/null + return 1 +} + +# ── uncommonlisp Python ── +PID=$(start_server "$PY examples/http-server.lsp" 8080) +bench_one "uncommonlisp Python (/bench, 1 KB)" 8080 /bench +kill "$PID" 2>/dev/null; wait "$PID" 2>/dev/null +sleep 0.3 + +# ── uncommonlisp C ── +PID=$(start_server "$C examples/http-server.lsp" 8080) +bench_one "uncommonlisp C (/bench, 1 KB)" 8080 /bench +kill "$PID" 2>/dev/null; wait "$PID" 2>/dev/null +sleep 0.3 + +# ── uncommonlisp asm ── +PID=$(start_server "$ASM < examples/http-server.lsp" 8080) +bench_one "uncommonlisp asm (/bench, 1 KB)" 8080 /bench +kill "$PID" 2>/dev/null; wait "$PID" 2>/dev/null +sleep 0.3 + +# ── Python http.server (stdlib) ── +(cd "$STATIC_DIR" && python3 -m http.server 8080 > /dev/null 2>&1) & +PID=$! +sleep 1 +bench_one "python3 -m http.server (1 KB file)" 8080 /bench +kill "$PID" 2>/dev/null; wait "$PID" 2>/dev/null +sleep 0.3 + +# ── busybox httpd ── +busybox httpd -f -p 127.0.0.1:8080 -h "$STATIC_DIR" > /dev/null 2>&1 & +PID=$! +sleep 0.5 +bench_one "busybox httpd (1 KB file)" 8080 /bench +kill "$PID" 2>/dev/null; wait "$PID" 2>/dev/null + +echo +echo "═══════════════════════════════════════════════════════════════" +echo "Binary sizes" +echo "═══════════════════════════════════════════════════════════════" +printf " uncommonlisp asm: %s\n" "$(du -b asm/uncommonlisp | cut -f1) bytes" +printf " uncommonlisp C: %s\n" "$(du -b c/uncommonlisp | cut -f1) bytes" +printf " busybox httpd: %s\n" "$(du -b /usr/bin/busybox | cut -f1) bytes (multi-call)" +printf " python3: %s bytes (interpreter binary)\n" "$(du -bL $(which python3) | cut -f1)" diff --git a/uncommonlisp.py b/uncommonlisp.py index b001f55..bead283 100644 --- a/uncommonlisp.py +++ b/uncommonlisp.py @@ -2646,6 +2646,37 @@ def _read_file_to_string(path): except OSError: return False +import socket as _sockmod +def _tcp_listen(port): + s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM) + s.setsockopt(_sockmod.SOL_SOCKET, _sockmod.SO_REUSEADDR, 1) + s.bind(('0.0.0.0', port)) + s.listen(128) + return s + +def _tcp_accept(server): + client, _addr = server.accept() + return client + +def _tcp_connect(host, port): + s = _sockmod.socket(_sockmod.AF_INET, _sockmod.SOCK_STREAM) + s.connect((host, port)) + return s + +def _tcp_recv(sock, n): + try: + data = sock.recv(n) + except OSError: + return False + return data.decode('utf-8', errors='replace') + +def _tcp_send(sock, s): + data = s.encode('utf-8') if isinstance(s, str) else bytes(s) + try: + return sock.send(data) + except OSError: + return False + def _sym_val(x): if not isinstance(x, Symbol): raise LispErr(f'not a symbol: {show(x)}') return x @@ -3223,6 +3254,12 @@ def make_global_env(): d(S('open-output-file'), lambda a, _: open(_str_val(a[0]), 'w')) d(S('write-file'), lambda a, _: _write_file(_str_val(a[0]), _str_val(a[1]))) d(S('file->string'), lambda a, _: _read_file_to_string(_str_val(a[0]))) + d(S('tcp-listen'), lambda a, _: _tcp_listen(int(a[0]))) + d(S('tcp-accept'), lambda a, _: _tcp_accept(a[0])) + d(S('tcp-connect'), lambda a, _: _tcp_connect(_str_val(a[0]), int(a[1]))) + 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]) 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 '')