From 5037c9ac22cbab91eb3cf1ee6261c8589e17e81d Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sat, 16 Mar 2002 21:16:08 +0000 Subject: [PATCH] 0.7.1.42: Merged DB "alpha floating point traps and infinities" patch sbcl-devel 2002-03-14 ... added a comment about the commentary nature of the x86/linux implementation of os_context_fp_control ... moved the "interpreter" stubs back to src/code/float.lisp, protected by #!-alpha --- src/code/alpha-vm.lisp | 40 ++++----- src/code/cold-init.lisp | 30 ++----- src/code/float-trap.lisp | 40 +++++---- src/compiler/alpha/float.lisp | 176 ++++++++++++++++------------------------ src/compiler/alpha/insts.lisp | 5 ++ src/compiler/alpha/parms.lisp | 53 +++++++++--- src/runtime/Config.alpha-linux | 2 +- src/runtime/alpha-arch.c | 15 ++-- src/runtime/alpha-linux-os.c | 8 ++ src/runtime/interrupt.c | 2 +- src/runtime/ldso-stubs.S | 6 +- src/runtime/x86-linux-os.c | 17 ++++ version.lisp-expr | 2 +- 13 files changed, 208 insertions(+), 188 deletions(-) diff --git a/src/code/alpha-vm.lisp b/src/code/alpha-vm.lisp index f6753b8..8681ea8 100644 --- a/src/code/alpha-vm.lisp +++ b/src/code/alpha-vm.lisp @@ -115,27 +115,29 @@ (setf (deref (context-float-register-addr context index)) (coerce new format))) +;;; This sets the software fp_control word, which is not the same +;;; thing as the hardware fpcr. We have to do this so that OS FPU +;;; completion works properly + +;;; Note that this means we can't set rounding modes; we'd have to do +;;; that separately. That said, almost everybody seems to agree that +;;; changing the rounding mode is rarely a good idea, because it upsets +;;; libm functions. So adding that is not a priority. Sorry. +;;; -dan 2001.02.06 + +(define-alien-routine + ("arch_get_fp_control" floating-point-modes) (sb!alien:unsigned 64)) + +(define-alien-routine + ("arch_set_fp_control" %floating-point-modes-setter) void (fp (sb!alien:unsigned 64))) + +(defun (setf floating-point-modes) (val) (%floating-point-modes-setter val)) + ;;; Given a signal context, return the floating point modes word in ;;; the same format as returned by FLOATING-POINT-MODES. -(defun context-floating-point-modes (context) - ;; FIXME: As of sbcl-0.6.7 and the big rewrite of signal handling for - ;; POSIXness and (at the Lisp level) opaque signal contexts, - ;; this is stubified. It needs to be rewritten as an - ;; alien function. - (warn "stub CONTEXT-FLOATING-POINT-MODES") - - ;; old code for Linux: - #+nil - (let ((cw (slot (deref (slot context 'fpstate) 0) 'cw)) - (sw (slot (deref (slot context 'fpstate) 0) 'sw))) - ;;(format t "cw = ~4X~%sw = ~4X~%" cw sw) - ;; NOT TESTED -- Clear sticky bits to clear interrupt condition. - (setf (slot (deref (slot context 'fpstate) 0) 'sw) (logandc2 sw #x3f)) - ;;(format t "new sw = ~X~%" (slot (deref (slot context 'fpstate) 0) 'sw)) - ;; Simulate floating-point-modes VOP. - (logior (ash (logand sw #xffff) 16) (logxor (logand cw #xffff) #x3f))) - - 0) +(define-alien-routine ("os_context_fp_control" context-floating-point-modes) + (sb!alien:unsigned 64) (context (* os-context-t))) + ;;;; INTERNAL-ERROR-ARGS diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp index bbecff2..f2dca7d 100644 --- a/src/code/cold-init.lisp +++ b/src/code/cold-init.lisp @@ -205,15 +205,9 @@ ;; FIXME: This list of modes should be defined in one place and ;; explicitly shared between here and REINIT. - ;; - ;; FIXME: In CMU CL, this is done "here" (i.e. in the analogous - ;; lispinit.lisp code) for every processor architecture. But Daniel - ;; Barlow's Alpha patches suppress it for Alpha. Why the difference? - #!+alpha - (set-floating-point-modes :traps '(:overflow - #!+alpha :underflow - :invalid - :divide-by-zero)) + + ;; Why was this marked #!+alpha? CMUCL does it here on all architectures + (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)) (show-and-call !class-finalize) @@ -279,18 +273,12 @@ instead (which is another name for the same thing).")) (signal-cold-init-or-reinit) (gc-reinit) (setf (sb!alien:extern-alien "internal_errors_enabled" boolean) t) - (set-floating-point-modes :traps - '(:overflow - :invalid - :divide-by-zero - ;; PRINT seems not to like x86 NPX - ;; denormal floats like - ;; LEAST-NEGATIVE-SINGLE-FLOAT, so - ;; the :UNDERFLOW exceptions are - ;; disabled by default. Joe User can - ;; explicitly enable them if - ;; desired. - #!+alpha :underflow)) + ;; PRINT seems not to like x86 NPX denormal floats like + ;; LEAST-NEGATIVE-SINGLE-FLOAT, so the :UNDERFLOW exceptions are + ;; disabled by default. Joe User can explicitly enable them if + ;; desired. + (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)) + ;; Clear pseudo atomic in case this core wasn't compiled with ;; support. ;; diff --git a/src/code/float-trap.lisp b/src/code/float-trap.lisp index 5723d47..c2e44e5 100644 --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -39,9 +39,15 @@ names))) ) ; EVAL-WHEN -;;; interpreter stubs -(defun floating-point-modes () (floating-point-modes)) -(defun (setf floating-point-modes) (new) (setf (floating-point-modes) new)) +;;; interpreter stubs for floating point modes get/setters for the +;;; alpha have been removed to alpha-vm.lisp, as they are implemented +;;; in C rather than as VOPs. +#!-alpha +(progn + (defun floating-point-modes () + (floating-point-modes)) + (defun (setf floating-point-modes) (new) + (setf (floating-point-modes) new))) ;;; This function sets options controlling the floating-point ;;; hardware. If a keyword is not supplied, then the current value is @@ -49,13 +55,13 @@ ;;; :TRAPS ;;; A list of the exception conditions that should cause traps. ;;; Possible exceptions are :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID, -;;; :DIVIDE-BY-ZERO, and on the X86 :DENORMALIZED-OPERAND. Initially -;;; all traps except :INEXACT are enabled. +;;; :DIVIDE-BY-ZERO, and on the X86 :DENORMALIZED-OPERAND. ;;; ;;;:ROUNDING-MODE ;;; The rounding mode to use when the result is not exact. Possible ;;; values are :NEAREST, :POSITIVE-INFINITY, :NEGATIVE-INFINITY and -;;; :ZERO. Initially, the rounding mode is :NEAREST. +;;; :ZERO. Setting this away from :NEAREST is liable to upset SBCL's +;;; maths routines which depend on it. ;;; ;;;:CURRENT-EXCEPTIONS ;;;:ACCRUED-EXCEPTIONS @@ -64,11 +70,14 @@ ;;; ;;;:FAST-MODE ;;; Set the hardware's \"fast mode\" flag, if any. When set, IEEE -;;; conformance or debuggability may be impaired. Some machines may not -;;; have this feature, in which case the value is always NIL. +;;; conformance or debuggability may be impaired. Some machines don't +;;; have this feature, and some SBCL ports don't implement it anyway +;;; -- in such cases the value is always NIL. ;;; ;;; GET-FLOATING-POINT-MODES may be used to find the floating point modes -;;; currently in effect. +;;; currently in effect. See cold-init.lisp for the list of initially +;;; enabled traps + (defun set-floating-point-modes (&key (traps nil traps-p) (rounding-mode nil round-p) (current-exceptions nil current-x-p) @@ -129,15 +138,6 @@ (defun sigfpe-handler (signal info context) (declare (ignore signal info context)) (declare (type system-area-pointer context)) - ;; FIXME: The find-the-detailed-problem code below went stale with - ;; the big switchover to POSIX signal handling and signal contexts - ;; which are opaque at the Lisp level ca. sbcl-0.6.7. It needs to be - ;; revived, which will require writing a C-level os-dependent - ;; function to extract floating point modes, and a Lisp-level - ;; DEFINE-ALIEN-ROUTINE to get to the C-level os-dependent function. - ;; Meanwhile we just say "something went wrong". - (error 'floating-point-exception) - #| (let* ((modes (context-floating-point-modes (sb!alien:sap-alien context (* os-context-t)))) (traps (logand (ldb float-exceptions-byte modes) @@ -158,9 +158,7 @@ (error 'floating-point-exception :traps (getf (get-floating-point-modes) :traps))) (t - (error "SIGFPE with no exceptions currently enabled?")))) - |# - ) + (error 'floating-point-exception))))) ;;; Execute BODY with the floating point exceptions listed in TRAPS ;;; masked (disabled). TRAPS should be a list of possible exceptions diff --git a/src/compiler/alpha/float.lisp b/src/compiler/alpha/float.lisp index dba65bd..4f33837 100644 --- a/src/compiler/alpha/float.lisp +++ b/src/compiler/alpha/float.lisp @@ -478,13 +478,15 @@ ;;;; float conversion (macrolet - ((frob (name translate inst ld-inst to-sc to-type &optional single) - (declare (ignorable single)) + ((frob (name translate inst ld-inst to-sc to-type) `(define-vop (,name) (:args (x :scs (signed-reg) :target temp :load-if (not (sc-is x signed-stack)))) - (:temporary (:scs (single-stack)) temp) - (:results (y :scs (,to-sc))) + (:temporary (:scs (,to-sc)) freg1) + (:temporary (:scs (,to-sc)) freg2) + (:temporary (:scs (single-stack)) temp) + + (:results (y :scs (,to-sc))) (:arg-types signed-num) (:result-types ,to-type) (:policy :fast-safe) @@ -503,71 +505,78 @@ temp) (signed-stack x)))) - (inst ,ld-inst y + (inst ,ld-inst freg1 (* (tn-offset stack-tn) n-word-bytes) (current-nfp-tn vop)) (note-this-location vop :internal-error) - ,@(when single - `((inst cvtlq y y))) - (inst ,inst y y)))))) - (frob %single-float/signed %single-float cvtqs lds single-reg single-float t) - (frob %double-float/signed %double-float cvtqt lds double-reg double-float t)) - + (inst cvtlq freg1 freg2) + (inst ,inst freg2 y) + (inst excb) + ))))) + (frob %single-float/signed %single-float cvtqs_sui lds single-reg single-float) + (frob %double-float/signed %double-float cvtqt_sui lds double-reg double-float)) + +;;; see previous comment about software trap handlers: also applies here (macrolet ((frob (name translate inst from-sc from-type to-sc to-type) `(define-vop (,name) - (:args (x :scs (,from-sc))) - (:results (y :scs (,to-sc))) - (:arg-types ,from-type) - (:result-types ,to-type) - (:policy :fast-safe) - (:note "inline float coercion") - (:translate ,translate) - (:vop-var vop) - (:save-p :compute-only) - (:generator 2 - (note-this-location vop :internal-error) - (inst ,inst x y))))) - (frob %single-float/double-float %single-float cvtts - double-reg double-float single-reg single-float) + (:args (x :scs (,from-sc))) + (:results (y :scs (,to-sc) :from :load)) + (:arg-types ,from-type) + (:result-types ,to-type) + (:policy :fast-safe) + (:note "inline float coercion") + (:translate ,translate) + (:vop-var vop) + (:save-p :compute-only) + (:generator 2 + (note-this-location vop :internal-error) + (inst ,inst x y) + (inst excb) + )))) + (frob %single-float/double-float %single-float cvtts_su + double-reg double-float single-reg single-float) (frob %double-float/single-float %double-float fmove - single-reg single-float double-reg double-float)) + single-reg single-float double-reg double-float)) (macrolet ((frob (trans from-sc from-type inst &optional single) - (declare (ignorable single)) - `(define-vop (,(symbolicate trans "/" from-type)) - (:args (x :scs (,from-sc) :target temp)) - (:temporary (:from (:argument 0) :sc single-reg) temp) - (:temporary (:scs (signed-stack)) stack-temp) - (:results (y :scs (signed-reg) - :load-if (not (sc-is y signed-stack)))) - (:arg-types ,from-type) - (:result-types signed-num) - (:translate ,trans) - (:policy :fast-safe) - (:note "inline float truncate") - (:vop-var vop) - (:save-p :compute-only) - (:generator 5 - (note-this-location vop :internal-error) - (inst ,inst x temp) - (sc-case y - (signed-stack - (inst stt temp - (* (tn-offset y) n-word-bytes) - (current-nfp-tn vop))) - (signed-reg - (inst stt temp - (* (tn-offset stack-temp) - n-word-bytes) - (current-nfp-tn vop)) - (inst ldq y - (* (tn-offset stack-temp) n-word-bytes) - (current-nfp-tn vop)))))))) - (frob %unary-truncate single-reg single-float cvttq/c t) - (frob %unary-truncate double-reg double-float cvttq/c) - (frob %unary-round single-reg single-float cvttq t) - (frob %unary-round double-reg double-float cvttq)) + (declare (ignorable single)) + `(define-vop (,(symbolicate trans "/" from-type)) + (:args (x :scs (,from-sc) :target temp)) + (:temporary (:from :load ;(:argument 0) + :sc single-reg) temp) + (:temporary (:scs (signed-stack)) stack-temp) + (:results (y :scs (signed-reg) + :load-if (not (sc-is y signed-stack)))) + (:arg-types ,from-type) + (:result-types signed-num) + (:translate ,trans) + (:policy :fast-safe) + (:note "inline float truncate") + (:vop-var vop) + (:save-p :compute-only) + (:generator 5 + (note-this-location vop :internal-error) + (inst ,inst x temp) + (sc-case y + (signed-stack + (inst stt temp + (* (tn-offset y) n-word-bytes) + (current-nfp-tn vop))) + (signed-reg + (inst stt temp + (* (tn-offset stack-temp) + n-word-bytes) + (current-nfp-tn vop)) + (inst ldq y + (* (tn-offset stack-temp) n-word-bytes) + (current-nfp-tn vop)))) + (inst excb) + )))) + (frob %unary-truncate single-reg single-float cvttq/c_sv t) + (frob %unary-truncate double-reg double-float cvttq/c_sv) + (frob %unary-round single-reg single-float cvttq_sv t) + (frob %unary-round double-reg double-float cvttq_sv)) (define-vop (make-single-float) (:args (bits :scs (signed-reg) :target res @@ -730,51 +739,7 @@ (inst mskll lo-bits 4 lo-bits))) -;;;; float mode hackery - -(sb!xc:deftype float-modes () '(unsigned-byte 32)) ;actually 24 -dan -(defknown floating-point-modes () float-modes (flushable)) -(defknown ((setf floating-point-modes)) (float-modes) - float-modes) - -;;; Modes bits are (byte 12 52) of fpcr. Grab and return in low bits. -(define-vop (floating-point-modes) - (:results (res :scs (unsigned-reg))) - (:result-types unsigned-num) - (:translate floating-point-modes) - (:policy :fast-safe) - (:vop-var vop) - (:temporary (:sc double-stack) temp) - (:temporary (:sc double-reg) temp1) - (:generator 5 - (let ((nfp (current-nfp-tn vop))) - (inst excb) - (inst mf_fpcr temp1 temp1 temp1) - (inst excb) - (inst stt temp1 (* n-word-bytes (tn-offset temp)) nfp) - (inst ldl res (* (1+ (tn-offset temp)) n-word-bytes) nfp) - (inst srl res 49 res)))) - -(define-vop (set-floating-point-modes) - (:args (new :scs (unsigned-reg) :target res)) - (:results (res :scs (unsigned-reg))) - (:arg-types unsigned-num) - (:result-types unsigned-num) - (:translate (setf floating-point-modes)) - (:policy :fast-safe) - (:temporary (:sc double-stack) temp) - (:temporary (:sc double-reg) temp1) - (:vop-var vop) - (:generator 8 - (let ((nfp (current-nfp-tn vop))) - (inst sll new 49 res) - (inst stl zero-tn (* (tn-offset temp) n-word-bytes) nfp) - (inst stl res (* (1+ (tn-offset temp)) n-word-bytes) nfp) - (inst ldt temp1 (* (tn-offset temp) n-word-bytes) nfp) - (inst excb) - (inst mt_fpcr temp1 temp1 temp1) - (inst excb) - (move res new)))) +;;;; float mode hackery has moved to alpha-vm.lisp ;;;; complex float VOPs @@ -894,3 +859,4 @@ (:translate imagpart) (:note "complex double float imagpart") (:variant :imag)) + diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index f17f4a7..05f996c 100644 --- a/src/compiler/alpha/insts.lisp +++ b/src/compiler/alpha/insts.lisp @@ -419,9 +419,14 @@ (defconstant +suid+ #x7c0) (define-fp-operate cvtqs_su #x16 (logior +su+ #x0bc) 2) + (define-fp-operate cvtqs_sui #x16 (logior +sui+ #x0bc) 2) (define-fp-operate cvtqt_su #x16 (logior +su+ #x0be) 2) + (define-fp-operate cvtqt_sui #x16 (logior +sui+ #x0be) 2) (define-fp-operate cvtts_su #x16 (logior +su+ #x0ac) 2) + (define-fp-operate cvttq_sv #x16 (logior +su+ #x0af) 2) + (define-fp-operate cvttq/c_sv #x16 (logior +su+ #x02f) 2) + (define-fp-operate adds_su #x16 (logior +su+ #x080)) (define-fp-operate addt_su #x16 (logior +su+ #x0a0)) (define-fp-operate divs_su #x16 (logior +su+ #x083)) diff --git a/src/compiler/alpha/parms.lisp b/src/compiler/alpha/parms.lisp index 8c23a45..4f05647 100644 --- a/src/compiler/alpha/parms.lisp +++ b/src/compiler/alpha/parms.lisp @@ -51,30 +51,57 @@ (defconstant double-float-digits (+ (byte-size double-float-significand-byte) n-word-bits 1)) -;; Values in 17f code seem to be same as HPPA. These values are from -;; DEC Assembly Language Programmers guide. The active bits are -;; actually in (byte 12 52) of the fpcr. (byte 6 52) contain the -;; exception flags. Bit 63 is the bitwise logor of all exceptions. -;; The enable and exception bytes are in a software control word -;; manipulated via OS functions and the bits in the SCP match those -;; defs. This mapping follows +;;; These values are originally from the DEC Assembly Language +;;; Programmers guide. Where possible we read/write the software +;;; fp_control word, which apparently is necessary for the OS FPU +;;; completion (OS handler which fixes up non-IEEE answers that the +;;; hardware occasionally gives us) to work properly. The rounding +;;; mode, however, can't be set that way, so we have to deal with that +;;; directly. (FIXME: we actually don't suport setting the rounding mode +;;; at the moment anyway) + +;;; Short guide to floating point trap terminology: an "exception" is +;;; cheap and can happen at almost any time. An exception will only +;;; generate a trap if that trap is enabled, otherwise a default value +;;; will be substituted. A "trap" will end up somewhere in the +;;; kernel, which may play by its own rules, (on Alpha it allegedly +;;; actually fixes up some non-IEEE compliant results to get the +;;; _right_ answer) but if something is really wrong will eventually +;;; signal SIGFPE and let us sort it out. + +;;; Old comment follows: The active bits are actually in (byte 12 52) +;;; of the fpcr. (byte 6 52) contain the exception flags. Bit 63 is the +;;; bitwise logor of all exceptions. The enable and exception bytes +;;; are in a software control word manipulated via OS functions and the +;;; bits in the SCP match those defs. This mapping follows +;;; + +;;; trap enables are set in software (fp_control) (defconstant float-inexact-trap-bit (ash 1 4)) ; rw (defconstant float-underflow-trap-bit (ash 1 3)) ; rw (defconstant float-overflow-trap-bit (ash 1 2)) ; ro (defconstant float-divide-by-zero-trap-bit (ash 1 1)) ; ro (defconstant float-invalid-trap-bit (ash 1 0)) ; ro +(defconstant-eqx float-traps-byte (byte 6 1) #'equalp) +;;; exceptions are also read/written in software (by syscalls, no less). +;;; This is kind of dumb, but has to be done +(defconstant-eqx float-sticky-bits (byte 6 17) #'equalp) ; fp_control + +;;; (We don't actually _have_ "current exceptions" on Alpha; the +;;; hardware only ever sets bits. So, set this the same as accrued +;;; exceptions) +(defconstant-eqx float-exceptions-byte (byte 6 17) #'equalp) + +;;; Rounding modes can only be set by frobbing the hardware fpcr directly (defconstant float-round-to-zero 0) (defconstant float-round-to-negative 1) (defconstant float-round-to-nearest 2) (defconstant float-round-to-positive 3) +(defconstant-eqx float-rounding-mode (byte 2 58) #'equalp) -;; These aren't quite correct yet. Work in progress. -(defconstant-eqx float-rounding-mode (byte 2 58) #'equalp) ; hardware fpcr -(defconstant-eqx float-exceptions-byte (byte 6 52) #'equalp) ; hardware fpcr -(defconstant-eqx float-sticky-bits (byte 6 17) #'equalp) ; software (clear only) -(defconstant-eqx float-traps-byte (byte 6 1) #'equalp) ; software fp control word -(defconstant float-condition-bit (ash 1 63)) ; summary - not used?? XXX +;;; Miscellaneous stuff - I think it's far to say that you deserve +;;; what you get if you ask for fast mode. (defconstant float-fast-bit 0) ); eval-when diff --git a/src/runtime/Config.alpha-linux b/src/runtime/Config.alpha-linux index 7928947..61f4739 100644 --- a/src/runtime/Config.alpha-linux +++ b/src/runtime/Config.alpha-linux @@ -11,7 +11,7 @@ # else. CFLAGS += -mcpu=pca56 -Dalpha LD = ld -taso -LINKFLAGS = -v -g -Wl,-T -Wl,ld-script.alpha-linux +LINKFLAGS = -dynamic -v -g -Wl,-T -Wl,ld-script.alpha-linux NM = nm -p ASSEM_SRC = alpha-assem.S ldso-stubs.S diff --git a/src/runtime/alpha-arch.c b/src/runtime/alpha-arch.c index 6a41dcb..bbf1741 100644 --- a/src/runtime/alpha-arch.c +++ b/src/runtime/alpha-arch.c @@ -363,17 +363,22 @@ sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context) } } -static void sigfpe_handler(int signal, int code, os_context_t *context) +unsigned long +arch_get_fp_control() { - /* what should this contain? interesting question. If it really - * is empty, why don't we just ignore the signal? -dan 2001.08.10 - */ + return ieee_get_fp_control(); +} + +void +arch_set_fp_control(unsigned long fp) +{ + ieee_set_fp_control(fp); } + void arch_install_interrupt_handlers() { undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler); - undoably_install_low_level_interrupt_handler(SIGFPE, sigfpe_handler); } extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); diff --git a/src/runtime/alpha-linux-os.c b/src/runtime/alpha-linux-os.c index 3597e04..249136d 100644 --- a/src/runtime/alpha-linux-os.c +++ b/src/runtime/alpha-linux-os.c @@ -34,6 +34,7 @@ #include #include #include +#include #include "validate.h" size_t os_vm_page_size; @@ -67,6 +68,13 @@ os_context_sigmask_addr(os_context_t *context) return &context->uc_sigmask; } +unsigned long +os_context_fp_control(os_context_t *context) +{ + return ieee_fpcr_to_swcr((context->uc_mcontext).sc_fpcr); +} + + void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { asm volatile ("imb" : : : "memory" ); diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 159a9ae..b749059 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -40,6 +40,7 @@ void sigaddset_blockable(sigset_t *s) sigaddset(s, SIGPIPE); sigaddset(s, SIGALRM); sigaddset(s, SIGURG); + sigaddset(s, SIGFPE); sigaddset(s, SIGTSTP); sigaddset(s, SIGCHLD); sigaddset(s, SIGIO); @@ -290,7 +291,6 @@ interrupt_handle_pending(os_context_t *context) { undo_fake_foreign_function_call(context); } - fprintf(stderr,"interrupt-handle-pending: back from MAYBE_GC\n"); } /* FIXME: This isn't very clear. It would be good to reverse diff --git a/src/runtime/ldso-stubs.S b/src/runtime/ldso-stubs.S index 35568f2..a4a0868 100644 --- a/src/runtime/ldso-stubs.S +++ b/src/runtime/ldso-stubs.S @@ -179,4 +179,8 @@ ldso_stub__ ## fct: ; \ LDSO_STUBIFY(log) LDSO_STUBIFY(log10) LDSO_STUBIFY(sqrt) -#endif \ No newline at end of file +#endif +#if defined alpha + LDSO_STUBIFY(ieee_get_fp_control) + LDSO_STUBIFY(ieee_set_fp_control) +#endif diff --git a/src/runtime/x86-linux-os.c b/src/runtime/x86-linux-os.c index ed7a9e0..560babb 100644 --- a/src/runtime/x86-linux-os.c +++ b/src/runtime/x86-linux-os.c @@ -76,6 +76,23 @@ os_context_sp_addr(os_context_t *context) return &context->uc_mcontext.gregs[17]; } +unsigned long +os_context_fp_control(os_context_t *context) +{ + /* probably the code snippet + * #ifdef __linux__ + * SET_FPU_CONTROL_WORD(context->__fpregs_mem.cw); + * #endif + * is relevant to implementing this correctly */ + + /* Note that currently this is not called, as there is an analogous + * stub in lisp-land (x86-vm.lisp), also returning 0, with the old + * lisp fp-control code. This is here more as a signpost of a possible + * way of restoring functionality, and if it is the way to go would + * need to be included for other architectures as well. */ + return 0; +} + sigset_t * os_context_sigmask_addr(os_context_t *context) { diff --git a/version.lisp-expr b/version.lisp-expr index dc0c0f8..6406f30 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.7.1.41" +"0.7.1.42" -- 1.7.10.4