From 0789e36e7d4a7a790bcef9dbc0912ab89a1f1298 Mon Sep 17 00:00:00 2001 From: Yoshiki Obinata Date: Thu, 11 Jun 2026 16:57:41 +0900 Subject: [PATCH 1/3] Fix callback function tests broken by modern GCC and Linux kernel NX protection Three bugs prevented defun-c-callable / callback tests from working: 1. test/test_foreign.c: set_ifunc and set_ffunc lacked return statements. GCC -O2 generated no retq, causing fall-through from set_ifunc -> set_ffunc -> call_ifunc -> jmp *g where g was the integer argument (e.g. 12345), crashing at address 0x3039. Fixed by adding `return 0;` to both. 2. lisp/l/eusforeign.l: trampoline (podcode) lives in GC heap which is non-executable on Linux kernel >= 5.8 even with -z execstack. Fixed by adding defforeign for mprotect via sys::sysmod and calling it in foreign-pod :init to mark the trampoline page PROT_READ|PROT_WRITE|PROT_EXEC. Page address is computed with (* (floor (/ addr 4096)) 4096) to avoid a 32-bit truncation bug in (logand addr (lognot 4095)). 3. test/test-foreign.l: uncommented callback tests and restructured them as proper deftest forms. defun-c-callable must be at top level (not inside deftest) because it uninters and re-interns the symbol; quote-captured 'LISP-IFUNC inside a deftest body would hold the pre-unintern symbol. Use (intern "LISP-IFUNC") at runtime to look up the re-interned foreign-pod. Co-Authored-By: Claude Sonnet 4.6 --- lisp/l/eusforeign.l | 8 ++++++++ test/test-foreign.l | 35 ++++++++++++++++++----------------- test/test_foreign.c | 2 ++ 3 files changed, 28 insertions(+), 17 deletions(-) diff --git a/lisp/l/eusforeign.l b/lisp/l/eusforeign.l index 910790cee..6ada96e73 100644 --- a/lisp/l/eusforeign.l +++ b/lisp/l/eusforeign.l @@ -148,6 +148,10 @@ (setf (symbol-function (intern (string-upcase fname))) (make-foreign-code fname nil :integer ,mod)))) +; mprotect(addr, len, prot) -- used to make trampoline pages executable on x86_64 +#+:x86_64 +(defforeign c-mprotect (sys::sysmod) "mprotect" (:integer :integer :integer) :integer) + ;(eval-when (compile) ; (defclass foreign-pod :super symbol :slots (podcode paramtypes resulttype))) @@ -370,6 +374,10 @@ :start1 100) (if *debug* (format t "PODCODE ADDR: ~x~%" (+ 16 (sys:address podcode)))) podcode) +#+:x86_64 + (let* ((addr (sys:address podcode)) + (page-addr (* (floor (/ addr 4096)) 4096))) + (c-mprotect page-addr (* 2 4096) 7)) #+:sh4 (progn (setq podcode (byte-string diff --git a/test/test-foreign.l b/test/test-foreign.l index 9365c3365..fbcf893ac 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -549,21 +549,19 @@ test-testd = 1.23456 (assert (= (ret-eusinteger 123 645000) (+ 123 645000))) ) -#| -;; ret-int -;; ret-short -;; ret-char - ;; callback function (defun-c-callable LISP-IFUNC () :integer (format t "LISP-INTFUNC is called, return ~D~%" 1234) 1234) -;; -(format t "~%callback function test(integer)~%") -(format t " callback function is set~%") -(set-ifunc (pod-address 'LISP-IFUNC)) -(format t " expected result: LISP-INTFUNC is called, return 1234~%") -(format t " call-ifunc = ~A~%" (call-ifunc)) + +(deftest test-callback-integer () + (format t "~%callback function test(integer)~%") + (format t " callback function is set~%") + (set-ifunc (pod-address (intern "LISP-IFUNC"))) + (format t " expected result: LISP-INTFUNC is called, return 1234~%") + (let ((result (call-ifunc))) + (format t " call-ifunc = ~A~%" result) + (assert (= result 1234)))) (defun-c-callable LISP-FFUNC ((i0 :integer) (i1 :integer) (i2 :integer) (i3 :integer) (i4 :integer) (i5 :integer) @@ -580,10 +578,12 @@ test-testd = 1.23456 (format t "~A ~A~%" i6 i7) (format t "return ~A~%" 0.12345) 0.12345) -(format t "~%callback function test(float)~%") -(format t " callback function is set~%") -(set-ffunc (pod-address 'LISP-FFUNC)) -(format t " expected result: LISP-FFUNC is called + +(deftest test-callback-float () + (format t "~%callback function test(float)~%") + (format t " callback function is set~%") + (set-ffunc (pod-address (intern "LISP-FFUNC"))) + (format t " expected result: LISP-FFUNC is called 100 101 102 103 104 105 1000.0 1010.0 1020.0 1030.0 @@ -591,8 +591,9 @@ test-testd = 1.23456 2080.0 2090.0 206 207 return 0.12345~%") -(format t "call-ffunc = ~A~%" (call-ffunc)) -|# + (let ((result (call-ffunc))) + (format t "call-ffunc = ~A~%" result) + (assert (< (abs (- result 0.12345)) 1e-4)))) (eval-when (load eval) (run-all-tests) diff --git a/test/test_foreign.c b/test/test_foreign.c index 48f62bd2f..a41477d0a 100644 --- a/test/test_foreign.c +++ b/test/test_foreign.c @@ -337,6 +337,7 @@ long set_ifunc(long (*f) ()) { g = f; printf("set_ifunc, g = %lX\n", g); + return 0; } long set_ffunc(double (*f) ()) @@ -348,6 +349,7 @@ long set_ffunc(double (*f) ()) double d8, double d9, long i6, long i7))f; printf("set_ffunc, gf = %lX\n", gf); + return 0; } long call_ifunc() { From 3447530eb81b2a1e3300ba464623820f5302d265 Mon Sep 17 00:00:00 2001 From: Yoshiki Obinata Date: Fri, 12 Jun 2026 09:37:47 +0900 Subject: [PATCH 2/3] Fix CI failures: guard mprotect and callback tests for non-Linux-x86_64 macOS (Intel x86_64) CI failed because euscomp reads eusforeign.l at startup and the #+:x86_64 guard is true on macOS, but mprotect is not findable via (system::find-entry "mprotect" (sys::sysmod)) on Darwin. Fix: wrap defforeign in (when (system::find-entry ...)) so it is only defined when mprotect is actually available in sysmod. Similarly guard the mprotect call in foreign-pod :init with (fboundp 'c-mprotect) to skip it when the defforeign was not executed. ARM/i386/RISC-V CI failed because the new callback tests run on all platforms, but defun-c-callable trampolines are x86_64-specific machine code. Fix: add #+:x86_64 reader guards to both defun-c-callable and deftest forms for the callback tests. Co-Authored-By: Claude Sonnet 4.6 --- lisp/l/eusforeign.l | 13 ++++++++----- test/test-foreign.l | 6 +++++- 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/lisp/l/eusforeign.l b/lisp/l/eusforeign.l index 6ada96e73..0664e4a88 100644 --- a/lisp/l/eusforeign.l +++ b/lisp/l/eusforeign.l @@ -148,9 +148,11 @@ (setf (symbol-function (intern (string-upcase fname))) (make-foreign-code fname nil :integer ,mod)))) -; mprotect(addr, len, prot) -- used to make trampoline pages executable on x86_64 +; mprotect(addr, len, prot) -- used to make trampoline pages executable on x86_64 Linux +; wrapped in when because mprotect may not be in sysmod on non-Linux platforms (e.g. macOS) #+:x86_64 -(defforeign c-mprotect (sys::sysmod) "mprotect" (:integer :integer :integer) :integer) +(when (system::find-entry "mprotect" (sys::sysmod)) + (defforeign c-mprotect (sys::sysmod) "mprotect" (:integer :integer :integer) :integer)) ;(eval-when (compile) ; (defclass foreign-pod :super symbol :slots (podcode paramtypes resulttype))) @@ -375,9 +377,10 @@ (if *debug* (format t "PODCODE ADDR: ~x~%" (+ 16 (sys:address podcode)))) podcode) #+:x86_64 - (let* ((addr (sys:address podcode)) - (page-addr (* (floor (/ addr 4096)) 4096))) - (c-mprotect page-addr (* 2 4096) 7)) + (when (fboundp 'c-mprotect) + (let* ((addr (sys:address podcode)) + (page-addr (* (floor (/ addr 4096)) 4096))) + (c-mprotect page-addr (* 2 4096) 7))) #+:sh4 (progn (setq podcode (byte-string diff --git a/test/test-foreign.l b/test/test-foreign.l index fbcf893ac..9316c8e30 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -549,11 +549,13 @@ test-testd = 1.23456 (assert (= (ret-eusinteger 123 645000) (+ 123 645000))) ) -;; callback function +;; callback function -- x86_64 only (trampoline machine code is architecture-specific) +#+:x86_64 (defun-c-callable LISP-IFUNC () :integer (format t "LISP-INTFUNC is called, return ~D~%" 1234) 1234) +#+:x86_64 (deftest test-callback-integer () (format t "~%callback function test(integer)~%") (format t " callback function is set~%") @@ -563,6 +565,7 @@ test-testd = 1.23456 (format t " call-ifunc = ~A~%" result) (assert (= result 1234)))) +#+:x86_64 (defun-c-callable LISP-FFUNC ((i0 :integer) (i1 :integer) (i2 :integer) (i3 :integer) (i4 :integer) (i5 :integer) (f0 :float) (f1 :float) (f2 :float) (f3 :float) @@ -579,6 +582,7 @@ test-testd = 1.23456 (format t "return ~A~%" 0.12345) 0.12345) +#+:x86_64 (deftest test-callback-float () (format t "~%callback function test(float)~%") (format t " callback function is set~%") From 880a821842a821978ac15ffd7026abd60c5734c7 Mon Sep 17 00:00:00 2001 From: Yoshiki Obinata Date: Fri, 12 Jun 2026 10:29:23 +0900 Subject: [PATCH 3/3] test-foreign: restrict callback tests to Linux x86_64 #+:x86_64 is also true on macOS Intel, but there mprotect is not available in sysmod so the GC heap cannot be made executable. The callback tests crash on macOS even though the build no longer fails. Use #+(and :x86_64 :linux) to limit them to Linux x86_64 only. Co-Authored-By: Claude Sonnet 4.6 --- test/test-foreign.l | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/test/test-foreign.l b/test/test-foreign.l index 9316c8e30..9672d743e 100644 --- a/test/test-foreign.l +++ b/test/test-foreign.l @@ -549,13 +549,15 @@ test-testd = 1.23456 (assert (= (ret-eusinteger 123 645000) (+ 123 645000))) ) -;; callback function -- x86_64 only (trampoline machine code is architecture-specific) -#+:x86_64 +;; callback function -- Linux x86_64 only +;; trampoline machine code is x86_64-specific, and mprotect is needed to make +;; the GC heap executable (not available in sysmod on macOS) +#+(and :x86_64 :linux) (defun-c-callable LISP-IFUNC () :integer (format t "LISP-INTFUNC is called, return ~D~%" 1234) 1234) -#+:x86_64 +#+(and :x86_64 :linux) (deftest test-callback-integer () (format t "~%callback function test(integer)~%") (format t " callback function is set~%") @@ -565,7 +567,7 @@ test-testd = 1.23456 (format t " call-ifunc = ~A~%" result) (assert (= result 1234)))) -#+:x86_64 +#+(and :x86_64 :linux) (defun-c-callable LISP-FFUNC ((i0 :integer) (i1 :integer) (i2 :integer) (i3 :integer) (i4 :integer) (i5 :integer) (f0 :float) (f1 :float) (f2 :float) (f3 :float) @@ -582,7 +584,7 @@ test-testd = 1.23456 (format t "return ~A~%" 0.12345) 0.12345) -#+:x86_64 +#+(and :x86_64 :linux) (deftest test-callback-float () (format t "~%callback function test(float)~%") (format t " callback function is set~%")