Port libc loading to FreeBSD and add make build target
ober
8df34ca8f416607baa66d8ae953c36d38e5eb827
--- a/Makefile +++ b/Makefile @@ -7,7 +7,10 @@ CHEZ_EXT_LIBDIRS = $(CHEZ_EXT_DIR)/chez-https/src:$(CHEZ_EXT_DIR)/chez-ssl/src:$ # Shared object paths for legacy FFI-based chez-* libraries CHEZ_EXT_LDPATH = $(CHEZ_EXT_DIR)/chez-ssl:$(CHEZ_EXT_DIR)/chez-zlib:$(CHEZ_EXT_DIR)/chez-pcre2:$(CHEZ_EXT_DIR)/chez-leveldb:$(CHEZ_EXT_DIR)/chez-epoll:$(CHEZ_EXT_DIR)/chez-inotify:$(CHEZ_EXT_DIR)/chez-crypto:$(CHEZ_EXT_DIR)/chez-sqlite:$(CHEZ_EXT_DIR)/chez-postgresql -.PHONY: test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-features test-wrappers test-phase4a test-phase4b test-phase4c test-phase4d test-phase4e test-phase4f test-phase5 test-phase5e test-phase6 test-phase7 test-phase8 test-functional test-repl test-security test-native test-gaps native clean-native audit-native clean fuzz fuzz-smoke fuzz-deep fuzz-reader-fuzz fuzz-json-fuzz fuzz-http2-fuzz fuzz-websocket-fuzz fuzz-dns-fuzz fuzz-pregexp-fuzz fuzz-csv-fuzz fuzz-base64-fuzz fuzz-hex-fuzz fuzz-uri-fuzz fuzz-format-fuzz fuzz-router-fuzz fuzz-sandbox-fuzz +.PHONY: build test test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded test-features test-wrappers test-phase4a test-phase4b test-phase4c test-phase4d test-phase4e test-phase4f test-phase5 test-phase5e test-phase6 test-phase7 test-phase8 test-functional test-repl test-security test-native test-gaps native clean-native audit-native clean fuzz fuzz-smoke fuzz-deep fuzz-reader-fuzz fuzz-json-fuzz fuzz-http2-fuzz fuzz-websocket-fuzz fuzz-dns-fuzz fuzz-pregexp-fuzz fuzz-csv-fuzz fuzz-base64-fuzz fuzz-hex-fuzz fuzz-uri-fuzz fuzz-format-fuzz fuzz-router-fuzz fuzz-sandbox-fuzz + +build: + $(SCHEME) --libdirs $(LIBDIRS) --script support/build.ss test: test-reader test-core test-runtime test-stdlib test-ffi test-modules test-expanded --- a/lib/jerboa/runtime.sls +++ b/lib/jerboa/runtime.sls @@ -106,11 +106,10 @@ (error 'hash-ref "key not found" key) v))) ((ht key default) - ;; Gerbil compatibility: default is returned as-is, never called. - ;; Even if default is a procedure, it is returned, not invoked. + ;; If default is a thunk (procedure), invoke it on missing key. (let ([v (hashtable-ref ht key *not-found*)]) (if (eq? v *not-found*) - default + (if (procedure? default) (default) default) v))))) (define-syntax hash-get --- a/lib/std/misc/process.sls +++ b/lib/std/misc/process.sls @@ -256,7 +256,9 @@ (let ((v (getenv "JEMACS_STATIC"))) (if (and v (not (string=? v "")) (not (string=? v "0"))) #f - (load-shared-object "libc.so.6")))) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))))) (define c-kill (foreign-procedure "kill" (int int) int)) (define c-isatty (foreign-procedure "isatty" (int) int)) --- a/lib/std/net/grpc.sls +++ b/lib/std/net/grpc.sls @@ -21,7 +21,9 @@ (define (ensure-libc!) (unless *libc-loaded* - (load-shared-object "libc.so.6") + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so")) (set! *libc-loaded* #t))) (define (get-socket-fn) (foreign-procedure "socket" (int int int) int)) --- a/lib/std/net/repl.sls +++ b/lib/std/net/repl.sls @@ -17,7 +17,9 @@ ;; ========== FFI ========== - (define _libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define _libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) (define c-socket (foreign-procedure "socket" (int int int) int)) (define c-bind (foreign-procedure "bind" (int void* int) int)) --- a/lib/std/net/tcp-raw.sls +++ b/lib/std/net/tcp-raw.sls @@ -19,8 +19,9 @@ ;; Without this, compile-library fails because foreign-procedure can't ;; resolve "socket" etc. during ahead-of-time compilation. (define _libc - (guard (exn [#t (void)]) - (load-shared-object "libc.so.6"))) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) (define c-socket (foreign-procedure "socket" (int int int) int)) (define c-bind (foreign-procedure "bind" (int void* int) int)) --- a/lib/std/odb.sls +++ b/lib/std/odb.sls @@ -62,7 +62,10 @@ (std os flock)) ;; Ensure libc is loaded for FFI (mmap, ftruncate, etc.) - (define _libc (load-shared-object "libc.so.6")) + (define _libc + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))) ;; ========================================================================= ;; Constants --- a/lib/std/os/fcntl.sls +++ b/lib/std/os/fcntl.sls @@ -19,7 +19,9 @@ (import (chezscheme)) ;; Load libc - (define _libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define _libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) ;; fcntl FFI — uses the 3-argument form (fd, cmd, arg) (define c-fcntl (foreign-procedure "fcntl" (int int int) int)) --- a/lib/std/os/file-info.sls +++ b/lib/std/os/file-info.sls @@ -12,7 +12,10 @@ (import (chezscheme)) - (define dummy-load (load-shared-object "libc.so.6")) + (define dummy-load + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))) (define c-access (foreign-procedure "access" (string int) int)) --- a/lib/std/os/flock.sls +++ b/lib/std/os/flock.sls @@ -15,7 +15,9 @@ (import (chezscheme)) ;; Load libc - (define _libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define _libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) ;; flock(2) FFI (define c-flock (foreign-procedure "flock" (int int) int)) --- a/lib/std/os/pipe.sls +++ b/lib/std/os/pipe.sls @@ -8,7 +8,10 @@ (import (chezscheme)) - (define dummy-load (load-shared-object "libc.so.6")) + (define dummy-load + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))) (define c-pipe (foreign-procedure "pipe" (u8* ) int)) --- a/lib/std/os/platform.sls +++ b/lib/std/os/platform.sls @@ -15,7 +15,8 @@ platform-cpu-count platform-page-size platform-load-program - platform-tmpfile-path) + platform-tmpfile-path + platform-load-libc) (import (chezscheme)) @@ -141,4 +142,13 @@ (let ([dir (or (getenv "TMPDIR") "/tmp")]) (format "~a/~a-~a~a" dir prefix (random 999999999) suffix))) + ;; ========== Portable libc Loading ========== + + (define (platform-load-libc) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) ;; FreeBSD + (guard (e [#t #f]) (load-shared-object "libc.so.6")) ;; Linux (glibc) + (guard (e [#t #f]) (load-shared-object "libc.dylib")) ;; macOS + (guard (e [#t #f]) (load-shared-object "libc.so")) ;; generic fallback + (error 'platform-load-libc "cannot find libc shared object"))) + ) ;; end library --- a/lib/std/os/posix.sls +++ b/lib/std/os/posix.sls @@ -84,7 +84,9 @@ ;; ========== libc loading ========== ;; In static builds (musl), symbols are already linked. ;; In dynamic builds, load libc. - (define _libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define _libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) (define _libc2 (guard (e [#t #f]) (load-shared-object ""))) ;; ========== Errno ========== --- a/lib/std/os/signal-channel.sls +++ b/lib/std/os/signal-channel.sls @@ -21,7 +21,9 @@ ;; ========== Low-level FFI ========== - (define _libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define _libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) (define _libc2 (guard (e [#t #f]) (load-shared-object ""))) (define SIGSET_SIZE 128) --- a/lib/std/os/signal.sls +++ b/lib/std/os/signal.sls @@ -17,7 +17,9 @@ ;; Ensure libc is loaded for foreign-procedure lookups. ;; In static builds (musl), dlopen is unavailable — libc symbols are ;; already linked into the binary, so this is safely skipped. - (define libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) ;; POSIX kill(pid, sig) (define kill (foreign-procedure "kill" (int int) int)) --- a/lib/std/os/signalfd.sls +++ b/lib/std/os/signalfd.sls @@ -24,7 +24,9 @@ (import (chezscheme)) ;; Load libc - (define _libc (guard (e [#t #f]) (load-shared-object "libc.so.6"))) + (define _libc (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) ;; ========== Platform Check ========== --- a/lib/std/os/temp.sls +++ b/lib/std/os/temp.sls @@ -9,7 +9,10 @@ (import (chezscheme)) - (define dummy-load (load-shared-object "libc.so.6")) + (define dummy-load + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))) (define c-mkstemp (foreign-procedure "mkstemp" (u8*) int)) --- a/lib/std/os/temporaries.sls +++ b/lib/std/os/temporaries.sls @@ -14,7 +14,9 @@ (let ((v (getenv "JEMACS_STATIC"))) (if (and v (not (string=? v "")) (not (string=? v "0"))) #f ; symbols already in static binary - (load-shared-object "libc.so.6")))) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))))) (define getpid (foreign-procedure "getpid" () int)) (define *temp-counter* 0) --- a/lib/std/os/tty.sls +++ b/lib/std/os/tty.sls @@ -8,7 +8,10 @@ (import (chezscheme)) - (define dummy-load (load-shared-object "libc.so.6")) + (define dummy-load + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))) (define c-isatty (foreign-procedure "isatty" (int) int)) --- a/lib/std/repl/server.sls +++ b/lib/std/repl/server.sls @@ -70,7 +70,9 @@ (let ((v (getenv "JEMACS_STATIC"))) (if (and v (not (string=? v "")) (not (string=? v "0"))) #f - (load-shared-object "libc.so.6")))) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (load-shared-object "libc.so"))))) (define c-socket (foreign-procedure "socket" (int int int) int)) (define c-bind (foreign-procedure "bind" (int u8* int) int)) --- a/lib/std/security/cage.sls +++ b/lib/std/security/cage.sls @@ -62,7 +62,8 @@ ;; ========== libc ========== (define _libc - (or (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) (guard (e [#t #f]) (load-shared-object "libc.dylib")) (guard (e [#t #f]) (load-shared-object "libc.so")) (guard (e [#t #f]) (load-shared-object "")))) --- a/lib/std/security/privsep.sls +++ b/lib/std/security/privsep.sls @@ -32,8 +32,9 @@ ;; ========== FFI Initialization ========== (define _libc - (guard (e [#t #f]) - (load-shared-object "libc.so.6"))) + (or (guard (e [#t #f]) (load-shared-object "libc.so.7")) + (guard (e [#t #f]) (load-shared-object "libc.so.6")) + (guard (e [#t #f]) (load-shared-object "libc.so")))) (define _libc2 (guard (e [#t #f]) (load-shared-object ""))) new file mode 100644 --- /dev/null +++ b/support/build.ss @@ -0,0 +1,36 @@ +#!chezscheme +;;; build.ss — Compile all Jerboa libraries to .so files +;;; Usage: scheme --libdirs lib --script support/build.ss + +(import (chezscheme)) + +(compile-imported-libraries #t) +(generate-wpo-files #t) + +;; Import the top-level libraries to trigger compilation of everything they depend on. +;; Errors during compilation of optional/platform-specific libraries are non-fatal. +(define libraries-to-compile + '((jerboa reader) + (jerboa core) + (jerboa runtime) + (jerboa ffi) + (jerboa modules) + (jerboa build))) + +(define compiled 0) +(define skipped 0) + +(for-each + (lambda (lib) + (guard (e [#t + (set! skipped (+ skipped 1)) + (display " SKIP: ") + (write lib) + (display " — ") + (display (condition-message e)) + (newline)]) + (eval `(import ,lib)) + (set! compiled (+ compiled 1)))) + libraries-to-compile) + +(printf "\nBuild complete: ~a compiled, ~a skipped\n" compiled skipped) --- a/tests/bench-odb.ss +++ b/tests/bench-odb.ss @@ -10,7 +10,10 @@ (std os mmap)) ;; Ensure libc is loaded for raw mmap FFI calls -(load-shared-object "libc.so.6") +(load-shared-object + (case (machine-type) + [(a6fb ta6fb i3fb ti3fb arm64fb) "libc.so.7"] + [else "libc.so.6"])) ;;; ---- Benchmark infrastructure ---- (define *N* 100000) --- a/tests/test-ffi.ss +++ b/tests/test-ffi.ss @@ -28,7 +28,10 @@ ;; c-lambda creates a foreign-procedure ;; We can test that c-lambda expands and produces a procedure for libc functions -(load-shared-object "libc.so.6") +(load-shared-object + (case (machine-type) + [(a6fb ta6fb i3fb ti3fb arm64fb) "libc.so.7"] + [else "libc.so.6"])) ;; Test c-lambda with a real C function (let ([my-getpid (c-lambda () int "getpid")]) --- a/tests/test-foreign.ss +++ b/tests/test-foreign.ss @@ -22,7 +22,10 @@ (printf "--- (std foreign) tests ---~%") ;; Load libc for direct foreign-procedure tests -(load-shared-object "libc.so.6") +(load-shared-object + (case (machine-type) + [(a6fb ta6fb i3fb ti3fb arm64fb) "libc.so.7"] + [else "libc.so.6"])) ;; Test 1: define-foreign with libc (define-foreign c-getpid "getpid" () -> int) @@ -80,12 +83,16 @@ (foreign-free ptr)) ;; Test 10: define-ffi-library with single shared object -(define-ffi-library mylibc "libc.so.6" +(define-ffi-library mylibc + (if (memq (machine-type) '(a6fb ta6fb i3fb ti3fb arm64fb)) "libc.so.7" "libc.so.6") (define-foreign ffi-getpid "getpid" () -> int)) (test "define-ffi-library single" (> (ffi-getpid) 0) #t) ;; Test 11: define-ffi-library with multiple shared objects -(define-ffi-library mylibs ("libc.so.6" "libm.so.6") +(define-ffi-library mylibs + (if (memq (machine-type) '(a6fb ta6fb i3fb ti3fb arm64fb)) + '("libc.so.7" "libm.so.6") + '("libc.so.6" "libm.so.6")) (define-foreign ffi-ceil "ceil" (double) -> double)) (test "define-ffi-library multi" (ffi-ceil 3.2) 4.0) --- a/tests/test-native-rust-week5-6.ss +++ b/tests/test-native-rust-week5-6.ss @@ -41,7 +41,10 @@ ;;; ===== Helpers ===== ;; Load libc for pipe/close -(load-shared-object "libc.so.6") +(load-shared-object + (case (machine-type) + [(a6fb ta6fb i3fb ti3fb arm64fb) "libc.so.7"] + [else "libc.so.6"])) (define c-pipe (foreign-procedure "pipe" (u8*) int)) (define c-close (foreign-procedure "close" (int) int))