1 ;;;; Testing the stack alignment of foreign calls. Uses stack-alignment-offset.c.
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (use-package :sb-alien
)
16 ;;; Callbacks are not part of the exported interface yet -- when they are this can
18 (import 'sb-alien
::alien-lambda
)
20 (defun run (program &rest arguments
)
21 (let* ((stringstream (make-string-output-stream))
22 (proc (run-program program arguments
23 :output stringstream
:error sb-sys
:*tty
*
24 :search
(or #+win32 t
)))
25 (output (get-output-stream-string stringstream
)))
26 (unless (zerop (process-exit-code proc
))
27 (error "Bad exit code: ~S~%Output:~% ~S"
28 (process-exit-code proc
)
31 (defun cc (&rest arguments
)
32 (apply #'run
#+unix
"./run-compiler.sh" #+win32
"gcc" arguments
))
34 (defvar *required-alignment
*
38 #+(and ppc
(not darwin
)) 8
39 #+(or arm64 x86 x86-64 riscv ppc64
) 16
41 (error "Unknown platform")))
43 ;;;; Build the offset-tool as regular excutable, and run it with
44 ;;;; fork/exec, so that no lisp is on the stack. This is our known-good
47 (defvar *exename
* (scratch-file-name (or #+win32
"exe" nil
)))
48 (defvar *soname
* (scratch-file-name (or #+win32
"dll" "so")))
51 (cc #+unix
"-sbcl-pic" "-o" *exename
* "stack-alignment-offset.c")
53 (defparameter *good-offset
*
54 (parse-integer (run *exename
*
55 (princ-to-string *required-alignment
*))))
56 (format t
"~s is ~d~%" '*good-offset
* *good-offset
*)
57 ;; Build the tool again, this time as a shared object, and load it
59 #+unix
(cc "-sbcl-shared" "-sbcl-pic" "-o" *soname
* "stack-alignment-offset.c")
60 #+win32
(cc "-shared" "-o" *soname
* "stack-alignment-offset.c")
62 (load-shared-object *soname
*)
64 (define-alien-routine stack-alignment-offset int
(alignment int
))
66 (define-alien-routine trampoline int
(callback (function int
))))
68 ;;;; Now get the offset by calling from lisp, first with a regular foreign function
69 ;;;; call, then with an intervening callback.
71 (with-test (:name
:regular
)
72 (assert (= *good-offset
* (stack-alignment-offset *required-alignment
*))))
75 (with-test (:name
:callback
)
76 (assert (= *good-offset
*
77 (trampoline (alien-lambda int
()
78 (stack-alignment-offset *required-alignment
*))))))
80 (ignore-errors (delete-file *exename
*))
81 (ignore-errors (delete-file *soname
*))