From c21244f05afe0d49339583460c8b9cd4063c42e7 Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Mon, 28 Sep 2026 21:26:49 +0300 Subject: [PATCH 1/7] Remove sys_entries, which is obsolete --- compiler/template.tmpl | 83 ------------------------------------------ 1 file changed, 83 deletions(-) diff --git a/compiler/template.tmpl b/compiler/template.tmpl index 7bb8279..4d0a4c3 100644 --- a/compiler/template.tmpl +++ b/compiler/template.tmpl @@ -1439,89 +1439,6 @@ fn_sys_cons_NOGC: ret -;; Return a list of directory-entries beneath the given prefix. -;; Return nil on failure. -FUNC fn_sys_entries - mov rbx, rdi - GET_TAG_BITS rbx - cmp rbx, TAG_ID_STRING - jne type_error - - UNTAG_REG rdi - - mov eax, SYS_open - mov esi, O_RDONLY | O_DIRECTORY - xor edx, edx - syscall - test rax, rax - js .failure - - mov r12, rax ; directory fd - STORE_NIL_REG r13 ; head of list - -.read_directory: - - mov eax, SYS_getdents64 - mov rdi, r12 - mov rsi, dir_buffer - mov edx, dir_buffer_end-dir_buffer - syscall - - test rax, rax - js .close_failure - test rax, rax - jz .done_reading - - mov r14, dir_buffer - lea r15, [dir_buffer+rax] - -.next_entry: - cmp r14, r15 - jae .read_directory - - movzx ebx, word [r14+16] ; record length - - lea rdi, [r14+19] - call strlen - inc rax ; include terminating NUL - push rbx - mov rbx, TAG_ID_STRING - call alloc - pop rbx - mov r11, rax ; destination buffer - - lea rdi, [r14+19] ; recompute source - mov rdx, r11 - call strcpy - - mov byte [rdx], 0 - - mov rdi, r11 - TAG_STRING_REG rdi - mov rsi, r13 - call fn_sys_cons_NOGC - mov r13, rax - add r14, rbx - jmp .next_entry - -.done_reading: - mov eax, SYS_close - mov rdi, r12 - syscall - mov rax, r13 - ret - -.close_failure: - mov eax, SYS_close - mov rdi, r12 - syscall - -.failure: - STORE_NIL_REG rax - ret - - - ;; Return a list of all environmental variables FUNC fn_sys_environment mov rbx, [envp_ptr] From 7fc56291f1b2db3c7173ce5284992f2f66860c14 Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Mon, 28 Sep 2026 21:27:27 +0300 Subject: [PATCH 2/7] Correctly pass arguments to syscalls. Fourth argument was wrong --- compiler/template.tmpl | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/compiler/template.tmpl b/compiler/template.tmpl index 4d0a4c3..fc1a731 100644 --- a/compiler/template.tmpl +++ b/compiler/template.tmpl @@ -2699,26 +2699,28 @@ FUNC fn_sys_substr ;; Make an arbitrary system call FUNC fn_sys_syscall - mov rax, rdi ; syscall number - mov rdi, rsi ; first arg from second - mov rsi, rdx ; second arg from third - mov rdx, rcx ; etc - mov rcx, r8 - mov r8, r9 + mov rax, rdi ; syscall number + + mov rdi, rsi ; arg 1 + mov rsi, rdx ; arg 2 + mov rdx, rcx ; arg 3 + mov r10, r8 ; arg 4 + mov r8, r9 ; arg 5 + UNTAG_REG rdi UNTAG_REG rsi UNTAG_REG rdx - UNTAG_REG rcx - UNTAG_REG rax + UNTAG_REG r10 UNTAG_REG r8 UNTAG_REG r9 + UNTAG_REG rax + syscall TAG_INTEGER_REG rax ret - section .text.out_of_range,"ax",@progbits out_of_range: mov rdi, out_of_range_msg ; show the error From 12e9ef5a789a8d110192c0e16e5348a9b9c1b9ca Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Mon, 28 Sep 2026 22:01:59 +0300 Subject: [PATCH 3/7] Ported sys_run to lisp. --- PRIMITIVES.md | 3 - compiler/template.tmpl | 155 +++++++++++------------------------------ inception.lisp | 2 +- stdlib.slisp | 62 +++++++++++++++++ 4 files changed, 104 insertions(+), 118 deletions(-) diff --git a/PRIMITIVES.md b/PRIMITIVES.md index 7886281..450cdd4 100644 --- a/PRIMITIVES.md +++ b/PRIMITIVES.md @@ -184,9 +184,6 @@ added to them too. * Return the size of the heap, in bytes. * `sys-heap-objects` * Return the number of objects stored within our heap. - * `sys_run` - * Helper for command execution. - ## Standard Library diff --git a/compiler/template.tmpl b/compiler/template.tmpl index fc1a731..77b58bb 100644 --- a/compiler/template.tmpl +++ b/compiler/template.tmpl @@ -59,17 +59,8 @@ ;; syscalls - searchable list online here ;; https://filippo.io/linux-syscall-table/ -SYS_read equ 0 SYS_write equ 1 -SYS_open equ 2 -SYS_close equ 3 -SYS_lseek equ 8 -SYS_dup2 equ 33 -SYS_fork equ 57 -SYS_exec equ 59 SYS_exit equ 60 -SYS_wait4 equ 61 -SYS_getdents64 equ 217 SYS_clock_gettime equ 228 SYS_prlimit64 equ 302 @@ -2096,101 +2087,6 @@ FUNC fn_sys_packages ret -;; system helper -FUNC fn_sys_run - mov rbx, rdi ; type check - GET_TAG_BITS rbx - cmp rbx, TAG_ID_STRING - jne type_error - mov rbx, rsi ; type check - GET_TAG_BITS rbx - cmp rbx, TAG_ID_STRING - jne type_error - - UNTAG_REG rdi - UNTAG_REG rsi - - mov r12, rdi ; command - mov r13, rsi ; output filename - - mov eax, SYS_fork - syscall - test rax, rax - js .error - jz .child - -.parent: - mov r14, rax ; child pid - sub rsp, 16 - mov edi, r14d ; pid - mov rsi, rsp ; &status - xor edx, edx ; options = 0 - xor r10, r10 ; rusage = NULL - mov eax, SYS_wait4 - syscall - - mov eax, [rsp] ; exit code - and eax, 0xff00 - shr eax, 8 - - add rsp, 16 - TAG_INTEGER_REG rax - ret - -.child: - mov eax, SYS_open - mov rdi, r13 - mov esi, 577 ; O_WRONLY|O_CREAT|O_TRUNC - mov edx, 0600o - syscall - - test rax, rax - js .child_fail - - mov r14, rax ; fd - - mov eax, SYS_dup2 ; STDOUT - mov rdi, r14 - mov esi, 1 - syscall - - mov eax, SYS_dup2 ; STDERR - mov rdi, r14 - mov esi, 2 - syscall - - mov eax, SYS_close - mov rdi, r14 - syscall - - ;; - ;; argv[] = { "/bin/sh", "-c", command, NULL } - ;; - sub rsp, 32 - lea rax, [rel shell_path] - mov [rsp], rax - lea rax, [rel dash_c] - mov [rsp+8], rax - mov [rsp+16], r12 - mov qword [rsp+24], 0 - - mov eax, SYS_exec - lea rdi, [rel shell_path] - mov rsi, rsp - mov rdx, [rel envp_ptr] - syscall - -.child_fail: - mov edi, 127 - mov eax, SYS_exit - syscall - -.error: - STORE_NIL_REG rax - ret - - - ;; split(string, char) FUNC fn_sys_split mov rbx, rdi ; type-check arg1: string @@ -2719,6 +2615,47 @@ FUNC fn_sys_syscall TAG_INTEGER_REG rax ret +;; Store a 64-bit value at the specified offset in the given string/buffer. +;; +;; The value is stored in native x86-64 little-endian byte order. +;; +;; This is used specifically for creating an array of strings, for the use +;; in our system function, however it may be more generally useful. +;; +;; undocumented. +FUNC fn_sys_u64BANG + mov rbx, rdi ; type-check arg1 + GET_TAG_BITS rbx + cmp rbx, TAG_ID_STRING + jne type_error + + mov rbx, rsi ; type-check arg2 + GET_TAG_BITS rbx + cmp rbx, TAG_ID_INTEGER + jne type_error + + UNTAG_REG rdi ; buffer + UNTAG_REG rsi ; offset + UNTAG_REG rdx ; value + + mov rax, rdi ; start of object + OBJ_TO_HEADER rax ; move to header + mov rax, [rax] ; read allocation size + sub rax, OBJ_PAYLOAD ; leave payload size + add rax, rdi ; RAX = end address (exclusive) + + add rdi, rsi ; RDI = destination. + + lea rcx, [rdi + 8] ; bounds checking + cmp rcx, rax + ja out_of_range + + mov qword [rdi], rdx ; Store the 64-bit value. + + mov rax, rdx ; return the same value.. + TAG_INTEGER_REG rax + ret + section .text.out_of_range,"ax",@progbits @@ -2862,16 +2799,6 @@ nan_msg: db "NaN" nan_msg_end: -;; Used by sys_run -align 16 -shell_path: - db "/bin/sh",0 - -;; Used by sys_run -align 16 -dash_c: - db "-c",0 - ;; Avoid calling the user's at_exit function more than once. at_exit_called: db 0x00 diff --git a/inception.lisp b/inception.lisp index 50b43a3..84146aa 100644 --- a/inception.lisp +++ b/inception.lisp @@ -325,7 +325,6 @@ (register-builtin "sys_package" (lambda (args) (sys_package (car args)))) (register-builtin "sys_packages" (lambda (args) (sys_packages ))) (register-builtin "sys_plus" (lambda (args) (sys_plus (car args) (cadr args)))) - (register-builtin "sys_run" (lambda (args) (sys_run (car args) (cadr args)))) (register-builtin "sys_split" (lambda (args) (sys_split (car args) (cadr args)))) (register-builtin "sys_sqrt" (lambda (args) (sys_sqrt (car args)))) (register-builtin "sys_stdlib" (lambda (args) (sys_stdlib))) @@ -337,6 +336,7 @@ (register-builtin "sys_strlen" (lambda (args) (sys_strlen (car args)))) (register-builtin "sys_substr" (lambda (args) (sys_substr (car args) (cadr args) (caddr args)))) (register-builtin "sys_syscall" (lambda (args) (sys_syscall (nth args 0) (nth args 1) (nth args 2) (nth args 3) (nth args 4)(nth args 5)))) + (register-builtin "sys_u64!" (lambda (args) (sys_u64! (car args) (cadr args) (caddr args)))) (register-builtin "sys_xor" (lambda (args) (sys_xor (car args) (cadr args)))) ) diff --git a/stdlib.slisp b/stdlib.slisp index 3ceab55..80bc294 100644 --- a/stdlib.slisp +++ b/stdlib.slisp @@ -610,6 +610,10 @@ Note that this does not create parents, use (mkdirs) for that." "Read and return a 64-bit value from the specified offset in the given buffer." (+ (u32 buf pos) (* (u32 buf (+ pos 4)) 4294967296))) +;; undocumented +(defun u64! (buf pos val) + (sys_u64! buf pos val)) + (defconst SYS_stat 4) (defun stat (path) @@ -1147,6 +1151,18 @@ Incrementing by the given step each time." (defconst SYS_read 0) +;; undocumented +(defun lst2array (lst) + "Convert a lisp list to a C-style array of strings" + (let ((i 0) + (n (length lst)) + (m (alloc (* (+ 1 n) 8)))) + (while (< i n) + (u64! m (* i 8) (nth lst i)) + (set! i (+ i 1))) + (u64! m (* i 8) 0) + m)) + (defun getc () "Read a single character from STDIN, and return it." (let ((str "s")) @@ -1202,6 +1218,52 @@ Uses (environment) to get all environmental variables, and filters." (strcat text (string (chr ch))))))) text)) +(defconst SYS_fork 57) +(defconst SYS_execve 59) +(defconst SYS_dup2 33) +(defconst SYS_wait4 61) +(defconst SYS_exit 60) + +(defun sys_run (command output) + "Run the given command, under the shell /bin/sh, and capture the output in the named file." + (let ((pid 0) + (fd 0) + (argv nil) + (status 0)) + + (set! pid (syscall SYS_fork)) + + (if (< pid 0) + (do (println "sys_run: fork failed") nil) + + (if (= pid 0) + + ;; Child. + (do + (set! fd (syscall SYS_open output 577 420)) + + (if (< fd 0) + (do (println "sys_run: failed to open output") (syscall SYS_exit 127)) + + (do + (syscall SYS_dup2 fd 1) + (syscall SYS_dup2 fd 2) + (syscall SYS_close fd) + + (let ((argv (lst2array (list "/bin/sh" "-c" command))) + (env (lst2array (environment)))) + + ;; execute + (syscall SYS_execve "/bin/sh" argv env) + + ;; execve only returns on failure. + (syscall SYS_exit 127))))) + ;; Parent. + (do + (let ((status (alloc 8))) + (let ((r (syscall SYS_wait4 pid status 0 0))) + (u32 status 0)))))))) + (defun system(cmd) "Run a command and return the output." (let ((tmp "/tmp/mktmp") ; tmp file for output From 0bcb9c5d7d34ab2c9bfc6d4ee41dfb995c899167 Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Mon, 28 Sep 2026 22:03:02 +0300 Subject: [PATCH 4/7] Remove comments that weren't stripped --- stdlib.slisp | 3 --- 1 file changed, 3 deletions(-) diff --git a/stdlib.slisp b/stdlib.slisp index 80bc294..2dbf326 100644 --- a/stdlib.slisp +++ b/stdlib.slisp @@ -518,15 +518,12 @@ It is assumed the filehandle came from fopen, but nil is also accepted." (if (nil? handle) nil (let ((size 0)) - ; seek to end of handle to get size (set! size (syscall SYS_lseek handle 0 SEEK_END)) (if (< size 0) nil (do - ; seek back to the start (syscall SYS_lseek handle 0 SEEK_START) - ; allocate memory and read into it (let ((mem (alloc size)) (res (syscall SYS_read handle mem size))) (if (< res 0) From 0030eebc9b96880838195158e2178636e248d518 Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Mon, 28 Sep 2026 22:03:59 +0300 Subject: [PATCH 5/7] mark more undocumented functions --- stdlib.slisp | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/stdlib.slisp b/stdlib.slisp index 2dbf326..3e2759f 100644 --- a/stdlib.slisp +++ b/stdlib.slisp @@ -591,18 +591,22 @@ Note that this does not create parents, use (mkdirs) for that." (defun rmdir (path) (syscall SYS_rmdir path)) +;; undocumented (defun u8 (buf pos) "Read and return a 8-bit value from the specified offset in the given buffer." (strat buf pos)) +;; undocumented (defun u16 (buf pos) "Read and return a 16-bit value from the specified offset in the given buffer." (+ (u8 buf pos) (* (u8 buf (+ pos 1)) 256))) +;; undocumented (defun u32 (buf pos) "Read and return a 32-bit value from the specified offset in the given buffer." (+ (u16 buf pos) (* (u16 buf (+ pos 2)) 65536))) +;; undocumented (defun u64 (buf pos) "Read and return a 64-bit value from the specified offset in the given buffer." (+ (u32 buf pos) (* (u32 buf (+ pos 4)) 4294967296))) @@ -1221,6 +1225,7 @@ Uses (environment) to get all environmental variables, and filters." (defconst SYS_wait4 61) (defconst SYS_exit 60) +;; undocumented (defun sys_run (command output) "Run the given command, under the shell /bin/sh, and capture the output in the named file." (let ((pid 0) From 9b534140dda6ba90bf849911f67510b91c5bb1e4 Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Tue, 29 Sep 2026 06:23:25 +0300 Subject: [PATCH 6/7] Added test-case for system --- test/system.lisp | 2 ++ test/system.test.expected | 1 + 2 files changed, 3 insertions(+) create mode 100644 test/system.lisp create mode 100644 test/system.test.expected diff --git a/test/system.lisp b/test/system.lisp new file mode 100644 index 0000000..5c7d995 --- /dev/null +++ b/test/system.lisp @@ -0,0 +1,2 @@ +(defun main () + (print (system "echo $FOO"))) diff --git a/test/system.test.expected b/test/system.test.expected new file mode 100644 index 0000000..ba578e4 --- /dev/null +++ b/test/system.test.expected @@ -0,0 +1 @@ +BAR From 1242e0f78325069d5ff00d2250d2aa56ecf33019 Mon Sep 17 00:00:00 2001 From: Steve Kemp Date: Tue, 29 Sep 2026 06:23:37 +0300 Subject: [PATCH 7/7] Removed defintions which are no longer used --- compiler/template.tmpl | 4 ---- 1 file changed, 4 deletions(-) diff --git a/compiler/template.tmpl b/compiler/template.tmpl index 77b58bb..8526075 100644 --- a/compiler/template.tmpl +++ b/compiler/template.tmpl @@ -64,10 +64,6 @@ SYS_exit equ 60 SYS_clock_gettime equ 228 SYS_prlimit64 equ 302 -;; (entries) -O_RDONLY equ 0 -O_DIRECTORY equ 0200000o - ;; stack size fetch RLIMIT_STACK equ 3