asm/c/py: add (load), ports, write-file/file->string — full cross-impl parity
Asm gains the file I/O surface Python and C already had, unlocking 9/9 cells of the portal producer×consumer matrix (previously 6/9). asm: - (load "path") — mmaps file, swaps input source, loops scheme_read+eval, restores on exit. Nestable. Uses SYS_LSEEK + SYS_MUNMAP. - Output ports: (open-output-file), (close-port), (port?). Encoded as SPECIAL values ≥ 1000 (fd = (val>>3) − PORT_SPECIAL_BASE), no tag-bit expansion needed. - (display), (write), (newline) accept optional port arg; printer writes via output_fd global, swapped by port-aware builtins. - (write-file path content) / (file->string path) — bytes in/out. c, py: (write-file) / (file->string) added for parity. tests: 131 asm (up 23), 189 functional (up 8, shared py+c), tests/portal-cross-test.sh exercises 3×3 save×load matrix.
This commit is contained in:
parent
ba0e42d057
commit
57f3c9fab1
12 changed files with 916 additions and 28 deletions
85
asm/test.sh
85
asm/test.sh
|
|
@ -182,6 +182,91 @@ check "even-odd" "(define (my-even n) (if (= n 0) #t (my-odd (- n 1)))) (defin
|
|||
echo "[functional] closure state"
|
||||
check "counter" "(define c (let ((n 0)) (lambda () (set! n (+ n 1)) n))) (c) (c) (c)" "123"
|
||||
|
||||
# ─── LOAD BUILTIN: unit + integration + functional ───────
|
||||
|
||||
LOAD_TMP=$(mktemp -d)
|
||||
trap "rm -rf $LOAD_TMP" EXIT
|
||||
|
||||
echo "[unit] load — basic file"
|
||||
cat > "$LOAD_TMP/a.lsp" <<EOF
|
||||
(define loaded-x 42)
|
||||
EOF
|
||||
check "load-basic" "(load \"$LOAD_TMP/a.lsp\") loaded-x" "42"
|
||||
|
||||
echo "[unit] load — define procedure"
|
||||
cat > "$LOAD_TMP/b.lsp" <<EOF
|
||||
(define (square n) (* n n))
|
||||
EOF
|
||||
check "load-proc" "(load \"$LOAD_TMP/b.lsp\") (square 9)" "81"
|
||||
|
||||
echo "[unit] load — missing file returns #f"
|
||||
check "load-missing" "(load \"/tmp/__nope_uncommonlisp_$$\")" "#f"
|
||||
|
||||
echo "[unit] load — empty file is void"
|
||||
: > "$LOAD_TMP/empty.lsp"
|
||||
check "load-empty" "(load \"$LOAD_TMP/empty.lsp\") 99" "99"
|
||||
|
||||
echo "[integration] load — nested (outer loads inner)"
|
||||
cat > "$LOAD_TMP/inner.lsp" <<EOF
|
||||
(define inner-val 7)
|
||||
EOF
|
||||
cat > "$LOAD_TMP/outer.lsp" <<EOF
|
||||
(define outer-val 99)
|
||||
(load "$LOAD_TMP/inner.lsp")
|
||||
EOF
|
||||
check "load-nested" "(load \"$LOAD_TMP/outer.lsp\") (+ outer-val inner-val)" "106"
|
||||
|
||||
echo "[integration] load — continues after loaded file"
|
||||
cat > "$LOAD_TMP/c.lsp" <<EOF
|
||||
(define c-val 10)
|
||||
EOF
|
||||
check "load-after" "(load \"$LOAD_TMP/c.lsp\") (define after-val 20) (+ c-val after-val)" "30"
|
||||
|
||||
echo "[integration] load — S-expression portal resume"
|
||||
cat > "$LOAD_TMP/portal.sexp" <<EOF
|
||||
;; portable state
|
||||
(define p-int 777)
|
||||
(define p-list '(1 2 3 4 5))
|
||||
(define p-str "hello")
|
||||
EOF
|
||||
check "load-portal-int" "(load \"$LOAD_TMP/portal.sexp\") p-int" "777"
|
||||
check "load-portal-list" "(load \"$LOAD_TMP/portal.sexp\") (length p-list)" "5"
|
||||
check "load-portal-str" "(load \"$LOAD_TMP/portal.sexp\") (display p-str)" "hello"
|
||||
|
||||
echo "[functional] load — set! then restore from file"
|
||||
cat > "$LOAD_TMP/restore.sexp" <<EOF
|
||||
(define restored 12345)
|
||||
EOF
|
||||
check "load-restore" "(define restored 0) (load \"$LOAD_TMP/restore.sexp\") restored" "12345"
|
||||
|
||||
# ─── WRITE-FILE + FILE->STRING ───────────────────────────
|
||||
|
||||
echo "[unit] write-file / file->string"
|
||||
# `check` joins all REPL outputs; suffix the "answer" so we can match.
|
||||
check "wf-basic" "(begin (write-file \"$LOAD_TMP/wf.txt\" \"abc\") (file->string \"$LOAD_TMP/wf.txt\"))" '"abc"'
|
||||
check "wf-truth" "(write-file \"$LOAD_TMP/wf.txt\" \"x\")" "#t"
|
||||
check "fs-missing" "(file->string \"/tmp/__no_such_$$__\")" "#f"
|
||||
check "wf-overwrite" "(begin (write-file \"$LOAD_TMP/wf.txt\" \"one\") (write-file \"$LOAD_TMP/wf.txt\" \"two\") (file->string \"$LOAD_TMP/wf.txt\"))" '"two"'
|
||||
check "fs-length" "(begin (write-file \"$LOAD_TMP/wf.txt\" \"hello\") (string-length (file->string \"$LOAD_TMP/wf.txt\")))" "5"
|
||||
|
||||
echo "[integration] write-file + load round-trip"
|
||||
check "wf-load-rt" "(begin (write-file \"$LOAD_TMP/rt.sexp\" \"(define rt-val 456)\") (define rt-val 0) (load \"$LOAD_TMP/rt.sexp\") rt-val)" "456"
|
||||
|
||||
# ─── PORTS: open-output-file, close-port, port?, display/write/newline to port ──
|
||||
|
||||
echo "[unit] ports"
|
||||
check "port?-true" "(port? (open-output-file \"$LOAD_TMP/p.txt\"))" "#t"
|
||||
check "port?-false" "(port? 42)" "#f"
|
||||
check "port-close" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (close-port p)) 1)" "1"
|
||||
check "port-display" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (display \"hi\" p) (close-port p)) (file->string \"$LOAD_TMP/p.txt\"))" '"hi"'
|
||||
# newline in file gets eaten by tr -d '\n' in check helper, so count chars: a + \n + b = 3
|
||||
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 "[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"
|
||||
|
||||
echo "[functional] display output"
|
||||
# display writes to stdout without newline, result is void
|
||||
got=$(echo '(display 42) (newline)' | $UL 2>/dev/null)
|
||||
|
|
|
|||
BIN
asm/uncommonlisp
BIN
asm/uncommonlisp
Binary file not shown.
Binary file not shown.
|
|
@ -25,13 +25,17 @@
|
|||
.equ SYS_WRITE, 1
|
||||
.equ SYS_OPEN, 2
|
||||
.equ SYS_CLOSE, 3
|
||||
.equ SYS_LSEEK, 8
|
||||
.equ SYS_MMAP, 9
|
||||
.equ SYS_MUNMAP,11
|
||||
.equ SYS_EXIT, 60
|
||||
|
||||
.equ O_RDONLY, 0
|
||||
.equ O_WRONLY, 1
|
||||
.equ O_CREAT, 64
|
||||
.equ O_TRUNC, 512
|
||||
.equ SEEK_SET, 0
|
||||
.equ SEEK_END, 2
|
||||
|
||||
.equ TAG_INT, 0
|
||||
.equ TAG_PAIR, 1
|
||||
|
|
@ -52,6 +56,11 @@
|
|||
.equ VAL_FALSE, ((SPECIAL_FALSE << 3) | TAG_SPECIAL)
|
||||
.equ VAL_VOID, ((SPECIAL_VOID << 3) | TAG_SPECIAL)
|
||||
|
||||
# Ports: encoded as SPECIAL values ≥ PORT_SPECIAL_BASE.
|
||||
# Value layout: ((PORT_SPECIAL_BASE + fd) << 3) | TAG_SPECIAL
|
||||
# fd is recovered via (val >> 3) - PORT_SPECIAL_BASE.
|
||||
.equ PORT_SPECIAL_BASE, 1000
|
||||
|
||||
.equ HEAP_SIZE, 0x4000000 # 64 MB
|
||||
|
||||
# Builtin indices
|
||||
|
|
@ -128,7 +137,13 @@
|
|||
.equ BI_INTEGERP, 70
|
||||
.equ BI_PORTALSAVE, 71
|
||||
.equ BI_PORTALRESUME, 72
|
||||
.equ BI_COUNT, 73
|
||||
.equ BI_LOAD, 73
|
||||
.equ BI_OPENOUT, 74
|
||||
.equ BI_CLOSEPORT, 75
|
||||
.equ BI_PORTP, 76
|
||||
.equ BI_WRITEFILE, 77
|
||||
.equ BI_FILETOSTR, 78
|
||||
.equ BI_COUNT, 79
|
||||
|
||||
# ============================================================
|
||||
.data
|
||||
|
|
@ -227,6 +242,12 @@ bn_gcd: .byte 3; .ascii "gcd"
|
|||
bn_integerp: .byte 8; .ascii "integer?"
|
||||
bn_portalsave: .byte 11; .ascii "portal-save"
|
||||
bn_portalresume:.byte 13; .ascii "portal-resume"
|
||||
bn_load: .byte 4; .ascii "load"
|
||||
bn_openout: .byte 16; .ascii "open-output-file"
|
||||
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"
|
||||
|
||||
portal_magic: .ascii "ULPORTAL"
|
||||
.equ PORTAL_MAGIC_LEN, 8
|
||||
|
|
@ -251,7 +272,9 @@ bi_names:
|
|||
.quad bn_vector, bn_vecref, bn_vecset, bn_veclen, bn_vecp
|
||||
.quad bn_makevec, bn_vectolist, bn_listtovec
|
||||
.quad bn_charp, bn_listp, bn_substr, bn_expt, bn_gcd, bn_integerp
|
||||
.quad bn_portalsave, bn_portalresume
|
||||
.quad bn_portalsave, bn_portalresume, bn_load
|
||||
.quad bn_openout, bn_closeport, bn_portp
|
||||
.quad bn_writefile, bn_filetostr
|
||||
|
||||
# Error messages
|
||||
err_unbound: .ascii "Error: unbound variable: "
|
||||
|
|
@ -268,6 +291,7 @@ s_nil: .ascii "()"
|
|||
s_void: .ascii "#<void>"
|
||||
s_proc: .ascii "#<procedure>"
|
||||
s_bi: .ascii "#<builtin>"
|
||||
s_port: .ascii "#<port>"
|
||||
s_lparen: .ascii "("
|
||||
s_rparen: .ascii ")"
|
||||
s_space: .ascii " "
|
||||
|
|
@ -296,6 +320,9 @@ sym_else_val: .quad 0
|
|||
input_buf: .skip 65536
|
||||
input_pos: .skip 8
|
||||
input_end: .skip 8
|
||||
input_buf_ptr: .skip 8 # points at active read buffer (stdin buf or mmap'd file)
|
||||
input_is_file: .skip 8 # 0 = stdin (refill allowed), 1 = file (EOF at end)
|
||||
output_fd: .skip 8 # active fd for printer syscalls (defaults to 1 = stdout)
|
||||
is_tty: .skip 8
|
||||
num_buf: .skip 64
|
||||
sym_table: .skip 16384 # 2048 symbol pointers
|
||||
|
|
@ -336,6 +363,10 @@ _start:
|
|||
# Init input
|
||||
movq $0, input_pos(%rip)
|
||||
movq $0, input_end(%rip)
|
||||
leaq input_buf(%rip), %rax
|
||||
movq %rax, input_buf_ptr(%rip)
|
||||
movq $0, input_is_file(%rip)
|
||||
movq $1, output_fd(%rip)
|
||||
|
||||
# Check tty
|
||||
movq $16, %rax # sys_ioctl
|
||||
|
|
@ -688,7 +719,10 @@ read_char:
|
|||
movq input_pos(%rip), %rax
|
||||
cmpq input_end(%rip), %rax
|
||||
jl .rc_have
|
||||
# Read more
|
||||
# File-backed buffer: no refill, straight to EOF
|
||||
cmpq $0, input_is_file(%rip)
|
||||
jne .rc_eof
|
||||
# Refill from stdin into input_buf
|
||||
pushq %rbx
|
||||
movq $SYS_READ, %rax
|
||||
xorq %rdi, %rdi
|
||||
|
|
@ -702,7 +736,7 @@ read_char:
|
|||
movq $0, input_pos(%rip)
|
||||
xorq %rax, %rax
|
||||
.rc_have:
|
||||
leaq input_buf(%rip), %rcx
|
||||
movq input_buf_ptr(%rip), %rcx
|
||||
movzbq (%rcx,%rax), %rax
|
||||
movq input_pos(%rip), %rcx
|
||||
incq %rcx
|
||||
|
|
@ -717,6 +751,8 @@ peek_char:
|
|||
movq input_pos(%rip), %rax
|
||||
cmpq input_end(%rip), %rax
|
||||
jl .pc_have
|
||||
cmpq $0, input_is_file(%rip)
|
||||
jne .pc_eof
|
||||
pushq %rbx
|
||||
movq $SYS_READ, %rax
|
||||
xorq %rdi, %rdi
|
||||
|
|
@ -730,7 +766,7 @@ peek_char:
|
|||
movq $0, input_pos(%rip)
|
||||
xorq %rax, %rax
|
||||
.pc_have:
|
||||
leaq input_buf(%rip), %rcx
|
||||
movq input_buf_ptr(%rip), %rcx
|
||||
movzbq (%rcx,%rax), %rax
|
||||
ret
|
||||
.pc_eof:
|
||||
|
|
@ -1172,10 +1208,16 @@ scheme_print:
|
|||
je .sp_true
|
||||
cmpq $SPECIAL_FALSE, %rax
|
||||
je .sp_false
|
||||
cmpq $PORT_SPECIAL_BASE, %rax
|
||||
jge .sp_port
|
||||
# void
|
||||
leaq s_void(%rip), %rsi
|
||||
movq $7, %rdx
|
||||
jmp .sp_write
|
||||
.sp_port:
|
||||
leaq s_port(%rip), %rsi
|
||||
movq $7, %rdx
|
||||
jmp .sp_write
|
||||
.sp_nil:
|
||||
leaq s_nil(%rip), %rsi
|
||||
movq $2, %rdx
|
||||
|
|
@ -1191,7 +1233,7 @@ scheme_print:
|
|||
|
||||
.sp_write:
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
syscall
|
||||
popq %r12
|
||||
popq %rbx
|
||||
|
|
@ -1203,7 +1245,7 @@ scheme_print:
|
|||
movzbq (%rax), %rdx
|
||||
leaq 1(%rax), %rsi
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
syscall
|
||||
popq %r12
|
||||
popq %rbx
|
||||
|
|
@ -1226,17 +1268,17 @@ scheme_print:
|
|||
leaq 8(%rax), %rbx # data ptr
|
||||
# Print: "..."
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq dquote_ch(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
movq %rbx, %rsi
|
||||
movq %r12, %rdx
|
||||
syscall
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq dquote_ch(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1247,7 +1289,7 @@ scheme_print:
|
|||
.sp_pair:
|
||||
# Print "("
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_lparen(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1268,7 +1310,7 @@ scheme_print:
|
|||
jne .sp_pair_dot
|
||||
# Print " " then car
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_space(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1282,7 +1324,7 @@ scheme_print:
|
|||
jmp .sp_pair_rest
|
||||
.sp_pair_dot:
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_dotsp(%rip), %rsi
|
||||
movq $3, %rdx
|
||||
syscall
|
||||
|
|
@ -1290,7 +1332,7 @@ scheme_print:
|
|||
call scheme_print
|
||||
.sp_pair_close:
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_rparen(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1307,7 +1349,7 @@ scheme_print:
|
|||
movq (%rbx), %r12 # %r12 = length
|
||||
# Print "#("
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_hashparen(%rip), %rsi
|
||||
movq $2, %rdx
|
||||
syscall
|
||||
|
|
@ -1320,7 +1362,7 @@ scheme_print:
|
|||
jz .sp_vec_elem
|
||||
pushq %rcx
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_space(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1338,7 +1380,7 @@ scheme_print:
|
|||
jmp .sp_vec_loop
|
||||
.sp_vec_close:
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_rparen(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1354,7 +1396,7 @@ print_int64:
|
|||
jns .pi_pos
|
||||
pushq %rax
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq s_minus(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
|
|
@ -1387,7 +1429,7 @@ print_int64:
|
|||
movq %rax, %rdx # length
|
||||
movq %rbx, %rsi # start
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
syscall
|
||||
popq %rbx
|
||||
ret
|
||||
|
|
@ -2381,6 +2423,18 @@ eval_list:
|
|||
je bi_portal_save
|
||||
cmpq $BI_PORTALRESUME, %rax
|
||||
je bi_portal_resume
|
||||
cmpq $BI_LOAD, %rax
|
||||
je bi_load
|
||||
cmpq $BI_OPENOUT, %rax
|
||||
je bi_open_output_file
|
||||
cmpq $BI_CLOSEPORT, %rax
|
||||
je bi_close_port
|
||||
cmpq $BI_PORTP, %rax
|
||||
je bi_portp
|
||||
cmpq $BI_WRITEFILE, %rax
|
||||
je bi_write_file
|
||||
cmpq $BI_FILETOSTR, %rax
|
||||
je bi_file_to_string
|
||||
|
||||
movq $VAL_VOID, %rax
|
||||
popq %r12
|
||||
|
|
@ -2523,32 +2577,69 @@ bi_not:
|
|||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# resolve_output_fd: optional port arg from %r12. %rax = fd (1 if none).
|
||||
# Destructively consumes the port arg if present.
|
||||
resolve_output_fd:
|
||||
cmpq $VAL_NIL, %r12
|
||||
je .rof_stdout
|
||||
movq %r12, %rax
|
||||
andq $-8, %rax
|
||||
movq (%rax), %rcx # port value
|
||||
movq 8(%rax), %r12 # advance arg list
|
||||
movq %rcx, %rax
|
||||
andq $TAG_MASK, %rax
|
||||
cmpq $TAG_SPECIAL, %rax
|
||||
jne .rof_stdout
|
||||
movq %rcx, %rax
|
||||
shrq $3, %rax
|
||||
cmpq $PORT_SPECIAL_BASE, %rax
|
||||
jl .rof_stdout
|
||||
subq $PORT_SPECIAL_BASE, %rax
|
||||
ret
|
||||
.rof_stdout:
|
||||
movq $1, %rax
|
||||
ret
|
||||
|
||||
bi_display:
|
||||
GETARG %rdi
|
||||
# Strings: print without quotes
|
||||
movq %rdi, %rax
|
||||
GETARG %rbx # value to display
|
||||
call resolve_output_fd # %rax = fd (stdout or port)
|
||||
movq output_fd(%rip), %rcx
|
||||
pushq %rcx
|
||||
movq %rax, output_fd(%rip)
|
||||
|
||||
movq %rbx, %rax
|
||||
andq $TAG_MASK, %rax
|
||||
cmpq $TAG_STRING, %rax
|
||||
je .bd_str
|
||||
movq %rbx, %rdi
|
||||
call scheme_print
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
jmp .bd_restore
|
||||
.bd_str:
|
||||
movq %rbx, %rdi
|
||||
andq $-8, %rdi
|
||||
movq (%rdi), %rdx
|
||||
leaq 8(%rdi), %rsi
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
syscall
|
||||
.bd_restore:
|
||||
popq %rax
|
||||
movq %rax, output_fd(%rip)
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
bi_newline:
|
||||
call resolve_output_fd
|
||||
movq output_fd(%rip), %rcx
|
||||
pushq %rcx
|
||||
movq %rax, output_fd(%rip)
|
||||
movq $SYS_WRITE, %rax
|
||||
movq $1, %rdi
|
||||
movq output_fd(%rip), %rdi
|
||||
leaq newline_ch(%rip), %rsi
|
||||
movq $1, %rdx
|
||||
syscall
|
||||
popq %rax
|
||||
movq %rax, output_fd(%rip)
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
|
|
@ -3193,9 +3284,15 @@ bi_assoc:
|
|||
RET_VAL
|
||||
|
||||
bi_write:
|
||||
# Same as display for now
|
||||
GETARG %rdi
|
||||
GETARG %rbx # value to write (quoted strings, etc.)
|
||||
call resolve_output_fd
|
||||
movq output_fd(%rip), %rcx
|
||||
pushq %rcx
|
||||
movq %rax, output_fd(%rip)
|
||||
movq %rbx, %rdi
|
||||
call scheme_print
|
||||
popq %rax
|
||||
movq %rax, output_fd(%rip)
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
|
|
@ -3891,6 +3988,348 @@ bi_portal_resume:
|
|||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# ============================================================
|
||||
# bi_load: (load "path") — read file, eval every form in r14 env
|
||||
# Mmaps file into memory, swaps input_buf_ptr, loops scheme_read+eval,
|
||||
# restores input state. Nestable — prior state saved on stack.
|
||||
# ============================================================
|
||||
bi_load:
|
||||
GETARG %rdi # filename (string value)
|
||||
andq $-8, %rdi
|
||||
movq (%rdi), %rcx # length
|
||||
leaq 8(%rdi), %rdi # bytes
|
||||
|
||||
# Null-terminate filename on stack (256-byte slot)
|
||||
subq $256, %rsp
|
||||
movq %rsp, %rsi
|
||||
pushq %rcx
|
||||
.ld_copy:
|
||||
testq %rcx, %rcx
|
||||
jz .ld_copy_done
|
||||
movb (%rdi), %al
|
||||
movb %al, (%rsi)
|
||||
incq %rdi
|
||||
incq %rsi
|
||||
decq %rcx
|
||||
jmp .ld_copy
|
||||
.ld_copy_done:
|
||||
movb $0, (%rsi)
|
||||
popq %rcx
|
||||
|
||||
# Open file
|
||||
movq $SYS_OPEN, %rax
|
||||
movq %rsp, %rdi
|
||||
movq $O_RDONLY, %rsi
|
||||
xorq %rdx, %rdx
|
||||
syscall
|
||||
addq $256, %rsp
|
||||
testq %rax, %rax
|
||||
js .ld_fail
|
||||
movq %rax, %rbx # fd
|
||||
|
||||
# Size via lseek(fd, 0, SEEK_END)
|
||||
movq $SYS_LSEEK, %rax
|
||||
movq %rbx, %rdi
|
||||
xorq %rsi, %rsi
|
||||
movq $SEEK_END, %rdx
|
||||
syscall
|
||||
testq %rax, %rax
|
||||
js .ld_close_fail
|
||||
pushq %rax # save size at 0(%rsp)
|
||||
|
||||
# Empty file — nothing to eval, just close and return
|
||||
testq %rax, %rax
|
||||
jz .ld_empty
|
||||
|
||||
# Rewind: lseek(fd, 0, SEEK_SET)
|
||||
movq $SYS_LSEEK, %rax
|
||||
movq %rbx, %rdi
|
||||
xorq %rsi, %rsi
|
||||
movq $SEEK_SET, %rdx
|
||||
syscall
|
||||
|
||||
# mmap(NULL, size, PROT_READ, MAP_PRIVATE, fd, 0)
|
||||
movq $SYS_MMAP, %rax
|
||||
xorq %rdi, %rdi
|
||||
movq 0(%rsp), %rsi # size
|
||||
movq $1, %rdx # PROT_READ
|
||||
movq $0x02, %r10 # MAP_PRIVATE
|
||||
movq %rbx, %r8 # fd
|
||||
xorq %r9, %r9 # offset
|
||||
syscall
|
||||
cmpq $-1, %rax
|
||||
je .ld_mmap_fail
|
||||
movq %rax, %rbp # mmap addr
|
||||
|
||||
# Close fd — mmap keeps page mapping
|
||||
movq $SYS_CLOSE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
|
||||
# Save current input state
|
||||
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
|
||||
# Stack layout now: [is_file][end][pos][buf_ptr][size]
|
||||
# 0 8 16 24 32
|
||||
|
||||
# Install file as new input source
|
||||
movq %rbp, input_buf_ptr(%rip)
|
||||
movq $0, input_pos(%rip)
|
||||
movq 32(%rsp), %rax # size
|
||||
movq %rax, input_end(%rip)
|
||||
movq $1, input_is_file(%rip)
|
||||
|
||||
# Loop: scheme_read + eval
|
||||
.ld_loop:
|
||||
call scheme_read
|
||||
testq %rax, %rax
|
||||
jz .ld_loop_done
|
||||
movq %rax, %rdi # expr
|
||||
movq %r14, %rsi # global env
|
||||
call eval
|
||||
jmp .ld_loop
|
||||
|
||||
.ld_loop_done:
|
||||
# Restore input state
|
||||
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)
|
||||
|
||||
# munmap(addr, size)
|
||||
popq %rsi # size
|
||||
movq $SYS_MUNMAP, %rax
|
||||
movq %rbp, %rdi
|
||||
syscall
|
||||
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
.ld_empty:
|
||||
# File was size 0 — discard size from stack, close, return void
|
||||
addq $8, %rsp
|
||||
movq $SYS_CLOSE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
.ld_mmap_fail:
|
||||
addq $8, %rsp # discard size
|
||||
.ld_close_fail:
|
||||
movq $SYS_CLOSE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
.ld_fail:
|
||||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# ============================================================
|
||||
# Ports: output ports encoded as SPECIAL values ≥ PORT_SPECIAL_BASE.
|
||||
# fd extraction: (val >> 3) - PORT_SPECIAL_BASE.
|
||||
# ============================================================
|
||||
|
||||
# copy_fname_to_stack: %rdi=str_bytes, %rcx=len, %rsi=dest (256 bytes).
|
||||
# Copies + null-terminates; advances registers. Preserves %rbx.
|
||||
copy_fname_to_stack:
|
||||
.cfs_loop:
|
||||
testq %rcx, %rcx
|
||||
jz .cfs_done
|
||||
movb (%rdi), %al
|
||||
movb %al, (%rsi)
|
||||
incq %rdi
|
||||
incq %rsi
|
||||
decq %rcx
|
||||
jmp .cfs_loop
|
||||
.cfs_done:
|
||||
movb $0, (%rsi)
|
||||
ret
|
||||
|
||||
# bi_open_output_file: (open-output-file "path") → port value or #f on fail
|
||||
bi_open_output_file:
|
||||
GETARG %rdi
|
||||
andq $-8, %rdi
|
||||
movq (%rdi), %rcx # len
|
||||
leaq 8(%rdi), %rdi # bytes
|
||||
|
||||
subq $256, %rsp
|
||||
movq %rsp, %rsi
|
||||
call copy_fname_to_stack
|
||||
|
||||
movq $SYS_OPEN, %rax
|
||||
movq %rsp, %rdi
|
||||
movq $(O_WRONLY | O_CREAT | O_TRUNC), %rsi
|
||||
movq $0644, %rdx
|
||||
syscall
|
||||
addq $256, %rsp
|
||||
|
||||
testq %rax, %rax
|
||||
js .bof_fail
|
||||
# Encode port: ((PORT_SPECIAL_BASE + fd) << 3) | TAG_SPECIAL
|
||||
addq $PORT_SPECIAL_BASE, %rax
|
||||
shlq $3, %rax
|
||||
orq $TAG_SPECIAL, %rax
|
||||
RET_VAL
|
||||
.bof_fail:
|
||||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# bi_close_port: (close-port port) → void
|
||||
bi_close_port:
|
||||
GETARG %rax
|
||||
movq %rax, %rcx
|
||||
andq $TAG_MASK, %rcx
|
||||
cmpq $TAG_SPECIAL, %rcx
|
||||
jne .bcp_done
|
||||
shrq $3, %rax
|
||||
cmpq $PORT_SPECIAL_BASE, %rax
|
||||
jl .bcp_done
|
||||
subq $PORT_SPECIAL_BASE, %rax
|
||||
movq %rax, %rdi # fd
|
||||
movq $SYS_CLOSE, %rax
|
||||
syscall
|
||||
.bcp_done:
|
||||
movq $VAL_VOID, %rax
|
||||
RET_VAL
|
||||
|
||||
# bi_portp: (port? x) → #t or #f
|
||||
bi_portp:
|
||||
GETARG %rax
|
||||
movq %rax, %rcx
|
||||
andq $TAG_MASK, %rcx
|
||||
cmpq $TAG_SPECIAL, %rcx
|
||||
jne .bpp_false
|
||||
shrq $3, %rax
|
||||
cmpq $PORT_SPECIAL_BASE, %rax
|
||||
jl .bpp_false
|
||||
movq $VAL_TRUE, %rax
|
||||
RET_VAL
|
||||
.bpp_false:
|
||||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# bi_write_file: (write-file "path" "content") → #t or #f
|
||||
bi_write_file:
|
||||
GETARG %rdi
|
||||
andq $-8, %rdi
|
||||
movq (%rdi), %rcx # filename len
|
||||
leaq 8(%rdi), %rdi # filename bytes
|
||||
|
||||
subq $256, %rsp
|
||||
movq %rsp, %rsi
|
||||
call copy_fname_to_stack
|
||||
|
||||
# Open for writing (truncate)
|
||||
movq $SYS_OPEN, %rax
|
||||
movq %rsp, %rdi
|
||||
movq $(O_WRONLY | O_CREAT | O_TRUNC), %rsi
|
||||
movq $0644, %rdx
|
||||
syscall
|
||||
addq $256, %rsp
|
||||
testq %rax, %rax
|
||||
js .bwf_fail
|
||||
movq %rax, %rbx # fd
|
||||
|
||||
# Second arg: content string
|
||||
GETARG %rdi
|
||||
andq $-8, %rdi
|
||||
movq (%rdi), %rdx # length
|
||||
leaq 8(%rdi), %rsi # bytes
|
||||
movq $SYS_WRITE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
|
||||
movq $SYS_CLOSE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
|
||||
movq $VAL_TRUE, %rax
|
||||
RET_VAL
|
||||
.bwf_fail:
|
||||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# bi_file_to_string: (file->string "path") → string or #f
|
||||
# Reads whole file into a heap-allocated string object.
|
||||
bi_file_to_string:
|
||||
GETARG %rdi
|
||||
andq $-8, %rdi
|
||||
movq (%rdi), %rcx # filename len
|
||||
leaq 8(%rdi), %rdi # filename bytes
|
||||
|
||||
subq $256, %rsp
|
||||
movq %rsp, %rsi
|
||||
call copy_fname_to_stack
|
||||
|
||||
movq $SYS_OPEN, %rax
|
||||
movq %rsp, %rdi
|
||||
movq $O_RDONLY, %rsi
|
||||
xorq %rdx, %rdx
|
||||
syscall
|
||||
addq $256, %rsp
|
||||
testq %rax, %rax
|
||||
js .bfs_fail
|
||||
movq %rax, %rbx # fd
|
||||
|
||||
# Size via lseek(fd, 0, SEEK_END)
|
||||
movq $SYS_LSEEK, %rax
|
||||
movq %rbx, %rdi
|
||||
xorq %rsi, %rsi
|
||||
movq $SEEK_END, %rdx
|
||||
syscall
|
||||
movq %rax, %rbp # file size
|
||||
testq %rax, %rax
|
||||
js .bfs_close_fail
|
||||
|
||||
# Rewind
|
||||
movq $SYS_LSEEK, %rax
|
||||
movq %rbx, %rdi
|
||||
xorq %rsi, %rsi
|
||||
movq $SEEK_SET, %rdx
|
||||
syscall
|
||||
|
||||
# Allocate string cell [length | bytes...] on heap
|
||||
# Heap object = 8 (length) + size bytes, aligned to 8
|
||||
movq %rbp, %rdi
|
||||
addq $8, %rdi
|
||||
call heap_alloc # %rax = ptr
|
||||
movq %rax, %r12 # save heap pointer
|
||||
movq %rbp, (%r12) # store length
|
||||
|
||||
# Read file bytes into cell
|
||||
leaq 8(%r12), %rsi
|
||||
movq %rbp, %rdx
|
||||
movq $SYS_READ, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
|
||||
movq $SYS_CLOSE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
|
||||
# Tag and return
|
||||
movq %r12, %rax
|
||||
orq $TAG_STRING, %rax
|
||||
RET_VAL
|
||||
|
||||
.bfs_close_fail:
|
||||
movq $SYS_CLOSE, %rax
|
||||
movq %rbx, %rdi
|
||||
syscall
|
||||
.bfs_fail:
|
||||
movq $VAL_FALSE, %rax
|
||||
RET_VAL
|
||||
|
||||
# ============================================================
|
||||
# list_reverse: %rdi = list -> %rax = reversed list
|
||||
# ============================================================
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue