blob: 049a0e576af1bb1f56b50ba180c7ac56f93f420b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
#+(or (not x86) (not linux)) (invoke-restart 'run-tests::skip-file)
(in-package sb-vm)
(defconstant os-page-size 4096)
(defparameter *tls-size-in-bytes* (extern-alien "dynamic_values_bytes" int))
(defparameter *tls-size-in-pages* (/ *tls-size-in-bytes* os-page-size))
(defun make-tls-reader (disp)
;; Return anything that proves that the memory load worked.
;; True I don't really need to compile a new function, because
;; CURRENT-THREAD-OFFSET-SAP can obviously take a variable.
;; I prefer it this way which asserts on the disassembly.
;; And if this stuff weren't confusing, then we wouldn't have gotten it
;; wrong now, would we have?
(let ((f
(compile nil
`(lambda ()
(declare (optimize (sb-c::verify-arg-count 0)))
(%make-lisp-obj
;; CURRENT-THREAD-OFFSET-SAP wants a word index, not a byte index.
(logand (sb-sys:sap-int (sb-vm::current-thread-offset-sap
,(ash disp (- sb-vm:word-shift))))
#xFFFFFFFC))))))
;; Being pedantic here...
(let ((string (with-output-to-string (s) (disassemble f :stream s))))
(assert (search (format nil "FS:[#x~X]" disp) string)))
f))
;;; Assert that loading via the FS: segment can see up to and including the last TLS cell
(test-util:with-test (:name :tls-fencepost-positive-test
:skipped-on (not :sb-thread))
(dotimes (i *tls-size-in-pages*)
(let* ((begin (* os-page-size i))
(end (+ begin os-page-size (- n-word-bytes)))
(f1 (make-tls-reader begin))
(f2 (make-tls-reader end)))
(funcall f1)
(funcall f2))))
;;; ... and not one word beyond.
;;; This says the fault address is 0, I wonder if we can do better than that.
(test-util:with-test (:name :tls-fencepost-negative-test
:skipped-on (not :sb-thread))
(let ((f (make-tls-reader *tls-size-in-bytes*)))
(setf (extern-alien "lose_on_corruption_p" int) 0)
(catch 'success
(handler-bind ((memory-fault-error
(lambda (c)
(format t "~&Got [~A]" c)
(throw 'success t))))
(funcall f))
(error "Expected a memory fault"))))
|
