Raymond Toy pushed to branch issue-355-solaris-x86-fp-trap-handler at cmucl / cmucl

Commits: 959faae1 by Raymond Toy at 2024-08-29T20:47:11-07:00 More debugging

Add C functions to get the x87 and sse2 modes from the sigcontext. Also add functions to set the modes in the sigcontext. Make these available to Lisp.

Use these functions in sigfpe-handler to examine the modes and to clear out the current exception.

Still needs work. Overflow is signaled correctly, but after aborting, the FP modes still contains the exception.

- - - - -

3 changed files:

- src/code/float-trap.lisp - src/code/x86-vm.lisp - src/lisp/solaris-os.c

Changes:

===================================== src/code/float-trap.lisp ===================================== @@ -482,6 +482,13 @@ (let* ((modes (sigcontext-floating-point-modes (alien:sap-alien scp (* unix:sigcontext))))) (format t "Current modes: ~32,'0b~%" modes) + (format t "sigcontext x87: ~32,'0b~%" + (sigcontext-floating-point-modes-x87 + (alien:sap-alien scp (* unix:sigcontext)))) + (format t "sigcontext sse2: ~32,'0b~%" + (sigcontext-floating-point-modes-sse2 + (alien:sap-alien scp (* unix:sigcontext)))) + (multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) @@ -529,14 +536,19 @@ (format t "new x87 modes: ~32,'0b~%" (vm::x87-floating-point-modes)) (format t "new sse2 modes: ~32,'0b~%" (vm::sse2-floating-point-modes))) (let* ((trap-bit (third (assoc code +fpe-code-info-alist+))) - (new-modes - (dpb (logandc2 (ldb float-exceptions-byte modes) - trap-bit) - float-exceptions-byte modes))) - (format t "New modes: ~32,'0b~%" new-modes) - (setf (sigcontext-floating-point-modes) - (alien:sap-alien scp (* unix:sigcontext)) - new-modes)))))) + (x87-modes (sigcontext-floating-point-modes-x87 + (alien:sap-alien scp (* unix:sigcontext)))) + (sse2-modes (sigcontext-floating-point-modes-sse2 + (alien:sap-alien scp (* unix:sigcontext))))) + (format t "Trap bit: ~D~%" trap-bit) + (format t "New sigcontext x87: ~32,'0b~%" (logandc2 x87-modes trap-bit)) + (format t "New sigcontext sse2: ~32,'0b~%" (logandc2 sse2-modes trap-bit)) + (%set-sigcontext-floating-point-modes-x87 + (alien:sap-alien scp (* unix:sigcontext)) + (logandc2 x87-modes trap-bit)) + (%set-sigcontext-floating-point-modes-sse2 + (alien:sap-alien scp (* unix:sigcontext)) + (logandc2 sse2-modes trap-bit)))))))

(macrolet ((with-float-traps (name merge-traps docstring)

===================================== src/code/x86-vm.lisp ===================================== @@ -378,6 +378,41 @@

(defsetf sigcontext-floating-point-modes %set-sigcontext-floating-point-modes)

+#+solaris +(progn +(defun sigcontext-floating-point-modes-x87 (scp) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_sigcontext_x87_modes" + (function (integer 32) + (* unix:sigcontext))))) + (alien-funcall fn scp))) + +(defun %set-sigcontext-floating-point-modes-x87 (scp new-modes) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_set_sigcontext_x87_modes" + (function c-call:void + (* unix:sigcontext) + c-call:unsigned-int)))) + (alien-funcall fn scp new-modes) + new-modes)) + +(defun sigcontext-floating-point-modes-sse2 (scp) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_sigcontext_sse2_modes" + (function (integer 32) + (* unix:sigcontext))))) + (alien-funcall fn scp))) + +(defun %set-sigcontext-floating-point-modes-sse2 (scp new-modes) + (declare (type (alien (* unix:sigcontext)) scp)) + (let ((fn (extern-alien "os_set_sigcontext_sse2_modes" + (function c-call:void + (* unix:sigcontext) + c-call:unsigned-int)))) + (alien-funcall fn scp new-modes) + new-modes)) +) +  ;;; EXTERN-ALIEN-NAME -- interface. ;;;

===================================== src/lisp/solaris-os.c ===================================== @@ -615,9 +615,9 @@ os_sigcontext_fpu_modes(ucontext_t *scp)

modes = ((cw & 0x3f) << 7) | (sw & 0x3f);

- DPRINTF(0, (stderr, "cw = 0x%04x\n", cw)); - DPRINTF(0, (stderr, "sw = 0x%04x\n", sw)); - DPRINTF(0, (stderr, "modes = 0x%08x\n", modes)); + DPRINTF(0, (stderr, "os_sigcontext_fpu cw = 0x%04x\n", cw)); + DPRINTF(0, (stderr, "os_sigcontext_fpu sw = 0x%04x\n", sw)); + DPRINTF(0, (stderr, "os_sigcontext_fpu modes = 0x%08x\n", modes));

#ifdef FEATURE_SSE2 /* @@ -627,7 +627,7 @@ os_sigcontext_fpu_modes(ucontext_t *scp) unsigned long mxcsr;

mxcsr = fpr->fp_reg_set.fpchip_state.mxcsr; - DPRINTF(0, (stderr, "SSE2 modes = %08lx\n", mxcsr)); + DPRINTF(0, (stderr, "os_sigcontext_fpu SSE2 modes = %08lx\n", mxcsr));

modes |= mxcsr; } @@ -637,6 +637,65 @@ os_sigcontext_fpu_modes(ucontext_t *scp) return modes; }

+unsigned int +os_sigcontext_x87_modes(ucontext_t *scp) +{ + unsigned short cw, sw; + fpregset_t *fpr; + fpr = &scp->uc_mcontext.fpregs; + + cw = fpr->fp_reg_set.fpchip_state.state[0] & 0xffff; + sw = fpr->fp_reg_set.fpchip_state.state[1] & 0xffff; + + DPRINTF(1, (stderr, "os_sigcontext_x87 cw, sw = #x%04x #x%04x\n", cw, sw)); + + return (cw << 16) | sw; +} + +void +os_set_sigcontext_x87_modes(ucontext_t *scp, unsigned int modes) +{ + unsigned short cw, sw; + fpregset_t *fpr; + fpr = &scp->uc_mcontext.fpregs; + + sw = modes & 0xffff; + cw = (modes >> 16) & 0xffff; + + fpr->fp_reg_set.fpchip_state.state[0] = cw; + fpr->fp_reg_set.fpchip_state.state[1] = sw; + + DPRINTF(1, (stderr, "os_set_sigcontext_x87 modes = #x%08x\n", modes)); + DPRINTF(1, (stderr, "os_set_sigcontext_x87 cw, sw = #x%04x #x%04x\n", cw, sw)); +} + + +#ifdef FEATURE_SSE2 +unsigned int +os_sigcontext_sse2_modes(ucontext_t *scp) +{ + unsigned long mxcsr; + fpregset_t *fpr; + + fpr = &scp->uc_mcontext.fpregs; + mxcsr = fpr->fp_reg_set.fpchip_state.mxcsr; + DPRINTF(1, (stderr, "os_sigcontext_sse2 mxcsr = #x%08lx\n", mxcsr)); + + return mxcsr; +} + +void +os_set_sigcontext_sse2_modes(ucontext_t *scp, unsigned int modes) +{ + fpregset_t *fpr; + fpr = &scp->uc_mcontext.fpregs; + + fpr->fp_reg_set.fpchip_state.mxcsr = modes; + + DPRINTF(1, (stderr, "os_set_sigcontext_sse2 mxcsr = #x%08x\n", modes)); +} +#endif + unsigned int os_set_sigcontext_fpu_modes(ucontext_t *scp, uint32_t modes) {

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/959faae166c9f9df7bf448fa...