Replace Scheme jerboa-coreutils with Rust uutils FFI and fix static binary FFI symbol scan
ober
7503afa9dfbb699784af7a1783f898d7735e16e0
--- a/Makefile +++ b/Makefile @@ -1,9 +1,8 @@ SCHEME = scheme JERBOA = $(HOME)/mine/jerboa JSH = vendor/jerboa-shell/src -COREUTILS = $(HOME)/mine/jerboa-coreutils/lib GHERKIN = $(HOME)/mine/gherkin/src -LIBDIRS = --libdirs lib:$(JERBOA)/lib:$(JSH):$(COREUTILS):$(GHERKIN):$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla/src:$(HOME)/mine/chez-qt +LIBDIRS = --libdirs lib:$(JERBOA)/lib:$(JSH):$(GHERKIN):$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla/src:$(HOME)/mine/chez-qt JERBUILD = $(SCHEME) --libdirs $(JERBOA)/lib --script $(JERBOA)/jerbuild.ss export LD_LIBRARY_PATH := .:$(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/chez-qt:vendor/jerboa-shell:$(LD_LIBRARY_PATH) export CHEZ_SCINTILLA_LIB := $(HOME)/mine/chez-scintilla @@ -253,7 +252,6 @@ PCRE2_SRC ?= $(HOME)/mine/chez-pcre2 SCI_SRC ?= $(HOME)/mine/chez-scintilla QT_SRC ?= $(HOME)/mine/chez-qt QTSHIM_SRC ?= $(HOME)/mine/gerbil-qt -COREUTILS_SRC ?= $(HOME)/mine/jerboa-coreutils JSH_COREUTILS_LIB ?= $(JSH_SRC)/rust-coreutils/target/x86_64-unknown-linux-musl/release/libjsh_coreutils.a DEPS_IMAGE := jemacs-deps:$(ARCH) @@ -371,7 +369,6 @@ build-jemacs-qt-static: check-root CHEZ_SCINTILLA_DIR=/deps/chez-scintilla/src \ CHEZ_QT_DIR=/deps/chez-qt \ CHEZ_QT_SHIM_DIR=/deps/gerbil-qt/vendor \ - COREUTILS_DIR=/deps/coreutils \ JSH_COREUTILS_LIB=/deps/jsh/libjsh_coreutils.a \ TREE_SITTER_INCLUDE=/opt/tree-sitter-include \ TREE_SITTER_LIB=/opt/tree-sitter-lib \ @@ -380,7 +377,7 @@ build-jemacs-qt-static: check-root TREE_SITTER_QUERIES_OBJ=/tmp/jemacs-build/treesitter_queries.o \ PKG_CONFIG_PATH=/opt/qt6-static/lib/pkgconfig \ /opt/chez/bin/scheme \ - --libdirs lib:/deps/jerboa/lib:/deps/jsh/src:/deps/coreutils:/deps/gherkin/src:/deps/chez-pcre2:/deps/chez-scintilla/src:/deps/chez-qt \ + --libdirs lib:/deps/jerboa/lib:/deps/jsh/src:/deps/gherkin/src:/deps/chez-pcre2:/deps/chez-scintilla/src:/deps/chez-qt \ --script build-binary-qt.ss linux-static-qt-docker: @@ -390,15 +387,12 @@ linux-static-qt-docker: --ulimit nofile=8192:8192 \ -v $(CURDIR):/src:z \ -v $(JERBOA)/lib/std:/host-jerboa-std:ro \ - -v $(COREUTILS_SRC)/lib:/host-coreutils:ro \ -v $(JSH_SRC)/src:/host-jsh-src:ro \ -v $(JSH_COREUTILS_LIB):/host-jsh-coreutils.a:ro \ $(DEPS_IMAGE) \ sh -c "apk add --no-cache libvterm-dev libvterm-static >/dev/null 2>&1; \ cp /host-jsh-coreutils.a /deps/jsh/libjsh_coreutils.a; \ cp -a /host-jsh-src/. /deps/jsh/src/; \ - cp -a /host-coreutils/. /deps/coreutils/; \ - find /deps/coreutils -name '*.sls' -exec sed -i 's/(load-shared-object #f)/(void)/g' {} +; \ for f in \ misc/atom.sls misc/channel.sls misc/completion.sls misc/list.sls \ misc/memo.sls misc/number.sls misc/ports.sls misc/process.sls \ --- a/build-binary-qt.ss +++ b/build-binary-qt.ss @@ -83,10 +83,6 @@ (or (getenv "CHEZ_QT_SHIM_DIR") (format "~a/mine/gerbil-qt/vendor" home))) -(define coreutils-dir - (or (getenv "COREUTILS_DIR") - "/deps/coreutils")) - ;; Static build detection (needed before dep checks) (define jemacs-static? (let ((v (getenv "JEMACS_STATIC"))) @@ -402,7 +398,7 @@ ;; define-foreign name "c-name" — jsh macro (C name is the second string) (gen-cmd (format - "{ { cat ~a ~a; find ~a ~a/jerboa ~a/chez-scintilla lib/jerboa-emacs lib/jerboa vendor -name '*.sls' -o -name '*.ss' | xargs cat 2>/dev/null; cat ~a/jerboa-coreutils/top.sls 2>/dev/null; } | \ + "{ { cat ~a ~a; find ~a ~a/jerboa ~a/std/os ~a/std/net ~a/std/crypto ~a/std/security ~a/chez-scintilla lib/jerboa-emacs lib/jerboa vendor -name '*.sls' -o -name '*.ss' | xargs cat 2>/dev/null; } | \ sed 's/;;.*//' | grep -oE '(foreign-procedure|foreign-entry\\?) \"[^\"]*\"' | sed 's/.* \"//;s/\"//'; \ { cat ~a ~a; } | sed 's/;;.*//' | grep -o 'define-optional-ffi [^ ]* \"[^\"]*\"' | sed 's/.*define-optional-ffi [^ ]* \"//;s/\"//'; \ find ~a -name '*.sls' -o -name '*.ss' | \ @@ -412,7 +408,8 @@ find ~a -name '*.sls' -o -name '*.ss' | \ sort -u | grep -v '^$' | grep -v '^_NSGetExecutablePath$' | grep -v '^io_uring_' | \ grep -v '^jerboa_' | grep -v '^SSL_' | grep -v '^TLS_' | grep -v '^EVP_' | \ grep -v '^CRYPTO_' | grep -v '^PKCS5_' | grep -v '^RAND_' | \ -grep -v '^QRcode_' | grep -v '^embed_encrypt$' | grep -v '^embed_random_bytes$' > /tmp/ffi_syms.txt && \ +grep -v '^QRcode_' | grep -v '^embed_encrypt$' | grep -v '^embed_random_bytes$' | \ +grep -v '^kqueue$' | grep -v '^kevent$' | grep -v '^sandbox_' > /tmp/ffi_syms.txt && \ awk '\ BEGIN{ print \"/* Auto-generated — do not edit */\"; \ print \"#include \\\"scheme.h\\\"\"; print \"\"; } \ @@ -425,7 +422,7 @@ echo \"}\" >> qt_static_symbols.c && \ rm /tmp/ffi_syms.txt && \ echo OK" ffi-path pcre2-ffi-path - jsh-dir jerboa-dir sci-dir coreutils-dir + jsh-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir jerboa-dir sci-dir ffi-path pcre2-ffi-path jsh-dir)) (result (shell-output gen-cmd ""))) --- a/lib/jerboa-emacs/qt/commands-shell.sls +++ b/lib/jerboa-emacs/qt/commands-shell.sls @@ -84,7 +84,6 @@ schedule-periodic! cancel-periodic!) (only (jsh registry) builtin-lookup builtin-register!) - (rename (jerboa-coreutils top) (main cu-top-main)) (only (jerboa-emacs persist) theme-settings-save! theme-settings-load! mx-history-save! mx-history-load! *auto-fill-mode* *fill-column* *abbrev-table* @@ -2157,21 +2156,24 @@ (define *top-buffer-name*--cell (vector "*top*")) (define *top-active*--cell (vector #f)) (def (top-capture-output) - "Run coreutils top in batch mode (-b -n 1) and capture output as a string.\n Calls cu-top-main directly (imported from jerboa-coreutils/top)." - (with-output-to-string + "Run system top in batch mode (-b -n 1) and capture output as a string." + (with-catch + (lambda (e) + (string-append + "top: error: " + (with-output-to-string (lambda () (display-condition e))) + "\n")) (lambda () - (with-catch - (lambda (e) - (display "top: error: ") - (display - (with-output-to-string (lambda () (display-condition e)))) - (newline)) - (lambda () - (call/cc - (lambda (k) - (parameterize ([exit-handler - (lambda (code) (k (void)))]) - (cu-top-main "-b" "-n" "1"))))))))) + (let-values ([(p-stdin p-stdout p-stderr pid) + (open-process-ports + "top -b -n 1" + 'block + (native-transcoder))]) + (close-port p-stdin) + (let ([output (get-string-all p-stdout)]) + (close-port p-stdout) + (close-port p-stderr) + (if (eof-object? output) "" output)))))) (def (top-refresh! app) "Refresh the *top* buffer with current coreutils top output." (let* ([ed (current-qt-editor app)] --- a/scripts/jemacs-rc.sh +++ b/scripts/jemacs-rc.sh @@ -78,7 +78,7 @@ jemacs-start() { else # Interpreted mode: use offscreen platform (dynamically loaded) QT_QPA_PLATFORM=offscreen LD_PRELOAD=./qt_chez_shim.so \ - scheme --libdirs "lib:$HOME/mine/jerboa/lib:$HOME/mine/jerboa-shell/src:$HOME/mine/jerboa-coreutils:$HOME/mine/chez-gherkin:$HOME/mine/chez-pcre2:$HOME/mine/chez-scintilla/src:$HOME/mine/chez-qt" \ + scheme --libdirs "lib:$HOME/mine/jerboa/lib:$HOME/mine/jerboa-shell/src:$HOME/mine/chez-gherkin:$HOME/mine/chez-pcre2:$HOME/mine/chez-scintilla/src:$HOME/mine/chez-qt" \ --script qt-main.ss --repl 0 & _JEMACS_PID=$! fi --- a/src/jerboa-emacs/qt/commands-shell.ss +++ b/src/jerboa-emacs/qt/commands-shell.ss @@ -15,7 +15,6 @@ (only-in :jerboa-emacs/vtscreen new-vtscreen) (only-in :jerboa-emacs/async schedule-periodic! cancel-periodic!) (only-in :jsh/registry builtin-lookup builtin-register!) - (rename-in :jerboa-coreutils/top (main cu-top-main)) (only-in :jerboa-emacs/persist theme-settings-save! theme-settings-load! mx-history-save! mx-history-load! *auto-fill-mode* *fill-column* @@ -1856,20 +1855,19 @@ SPC = page down, DEL = page up, q = quit view-mode." (def *top-active* #f) ;; the app when top is running, or #f (def (top-capture-output) - "Run coreutils top in batch mode (-b -n 1) and capture output as a string. - Calls cu-top-main directly (imported from jerboa-coreutils/top)." - (with-output-to-string + "Run system top in batch mode (-b -n 1) and capture output as a string." + (with-catch + (lambda (e) + (string-append "top: error: " + (with-output-to-string (lambda () (display-condition e))) "\n")) (lambda () - (with-catch - (lambda (e) - (display "top: error: ") - (display (with-output-to-string (lambda () (display-condition e)))) - (newline)) - (lambda () - (call/cc - (lambda (k) - (parameterize ((exit-handler (lambda (code) (k (void))))) - (cu-top-main "-b" "-n" "1"))))))))) + (let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports "top -b -n 1" 'block (native-transcoder)))) + (close-port p-stdin) + (let ((output (get-string-all p-stdout))) + (close-port p-stdout) + (close-port p-stderr) + (if (eof-object? output) "" output)))))) (def (top-refresh! app) "Refresh the *top* buffer with current coreutils top output." --- a/tests/test-functional.ss +++ b/tests/test-functional.ss @@ -29,8 +29,7 @@ *mx-history* mx-history-add! mx-history-ordered-candidates) (only (jerboa-emacs helm-commands) register-helm-commands!) (jerboa-emacs helm) - (only (std srfi srfi-13) string-contains string-prefix?) - (rename (jerboa-coreutils top) (main cu-top-main))) + (only (std srfi srfi-13) string-contains string-prefix?)) (define pass-count 0) (define fail-count 0) @@ -1646,44 +1645,19 @@ ;;; Coreutils Top Tests ;;;============================================================================ -(display "\n--- coreutils-top: cu-top-main is a procedure ---\n") -(check (procedure? cu-top-main) => #t) - -(display "--- coreutils-top: batch mode produces output ---\n") -(let ((output (with-output-to-string - (lambda () - (call/cc - (lambda (k) - (parameterize ([exit-handler (lambda (code) (k (void)))]) - (cu-top-main "-b" "-n" "1")))))))) - ;; Output should be non-empty - (check (> (string-length output) 100) => #t) - ;; Should contain standard top header fields (string-contains returns index, not #t) - (check (and (string-contains output "load average") #t) => #t) - (check (and (string-contains output "Tasks:") #t) => #t) - (check (and (string-contains output "Cpu") #t) => #t) - (check (and (string-contains output "Mem") #t) => #t) - ;; Should contain PID column header - (check (and (string-contains output "PID") #t) => #t)) - -(display "--- coreutils-top: output is multi-line ---\n") -(let* ((output (with-output-to-string - (lambda () - (call/cc - (lambda (k) - (parameterize ([exit-handler (lambda (code) (k (void)))]) - (cu-top-main "-b" "-n" "1"))))))) - (lines (let loop ((s output) (acc '())) - (let ((nl (let find ((i 0)) - (if (>= i (string-length s)) #f - (if (char=? (string-ref s i) #\newline) i - (find (+ i 1))))))) - (if nl - (loop (substring s (+ nl 1) (string-length s)) - (cons (substring s 0 nl) acc)) - (reverse (cons s acc))))))) - ;; Should have many lines (header + processes) - (check (> (length lines) 10) => #t)) +(display "\n--- coreutils-top: batch mode via subprocess produces output ---\n") +(let-values (((p-stdin p-stdout p-stderr pid) + (open-process-ports "top -b -n 1" 'block (native-transcoder)))) + (close-port p-stdin) + (let ((output (get-string-all p-stdout))) + (close-port p-stdout) + (close-port p-stderr) + (let ((out (if (eof-object? output) "" output))) + ;; Output should be non-empty + (check (> (string-length out) 100) => #t) + ;; Should contain standard top header fields + (check (and (string-contains out "load average") #t) => #t) + (check (and (string-contains out "PID") #t) => #t)))) ;;;============================================================================ ;;; Group: Backward-Delete-Char Comprehensive Tests