/[cmucl]/src/code/x86-vm.lisp
ViewVC logotype

Diff of /src/code/x86-vm.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37.4.1 by rtoy, Sat Aug 28 00:01:23 2010 UTC revision 1.39 by rtoy, Mon Aug 30 20:01:15 2010 UTC
# Line 300  Line 300 
300              (complex-double-float              (complex-double-float
301               (setf (sap-ref-double sap 0) (realpart new))               (setf (sap-ref-double sap 0) (realpart new))
302               (setf (sap-ref-double sap 8) (imagpart new))))))))               (setf (sap-ref-double sap 8) (imagpart new))))))))
303    
304  ;;;  ;;;
305  (defsetf sigcontext-float-register %set-sigcontext-float-register)  (defsetf sigcontext-float-register %set-sigcontext-float-register)
306    
# Line 533  Line 534 
534        (when (< entry (lisp::foreign-linkage-symbols))        (when (< entry (lisp::foreign-linkage-symbols))
535          (lisp::foreign-linkage-entry entry)))))          (lisp::foreign-linkage-entry entry)))))
536  )  )
537    
538    (in-package "X86")
539    
540    (defun get-fp-operation (scp)
541      (declare (type (alien (* sigcontext)) scp))
542      ;; Get the offending FP instruction from the context.  We return the
543      ;; operation associated with the FP instruction, the precision of
544      ;; the operation, and the operands of the instruction.
545    
546      ;; For SSE2, the PC should be at the offending SSE2 instruction
547      (let ((pc (sigcontext-program-counter scp)))
548        #+(or)
549        (progn
550          (format *debug-io* "~&PC = ~S~%" pc)
551          (format *debug-io* " ~2,'0X~%" (sys:sap-ref-8 pc 0))
552          (format *debug-io* " ~2,'0X~%" (sys:sap-ref-8 pc 1))
553          (format *debug-io* " ~2,'0X~%" (sys:sap-ref-8 pc 2))
554          (format *debug-io* " ~2,'0X~%" (sys:sap-ref-8 pc 3))
555          (format *debug-io* " ~2,'0X~%" (sys:sap-ref-8 pc 4))
556          (finish-output *debug-io*))
557    
558        (labels
559            ((fop (x)
560               ;; Look at the byte and see what kind of operation is
561               ;; encoded.
562               (cdr (assoc x '((#x58 . +) (#x59 . *) (#x5c . -) (#x5e . /)))))
563             (decode-mod-r/m (byte)
564               ;; Return the mod bits, the r/m bits, and the value, in
565               ;; that order.  See, for example, Table 2-1 in the Intel 64
566               ;; and IA-32 Architectures Software Developer's Manual,
567               ;; Volume 2A.
568               (values (ldb (byte 2 6) byte)
569                       (ldb (byte 3 0) byte)
570                       (ldb (byte 3 3) byte)))
571             (decode-operands (offset format)
572               (multiple-value-bind (mod r/m v)
573                   (decode-mod-r/m (sys:sap-ref-8 pc offset))
574                 #+(or)
575                 (format *debug-io* "~&mod = #b~2,'0b~%r/m = #b~3,'0b~%v   = #b~3,'0b~%" mod r/m v)
576                 ;; I'm lazy right now and don't want to try to fetch the
577                 ;; operand from memory if the source is in memory.  Just
578                 ;; return NIL for that.
579                 (values (sigcontext-float-register scp (+ 8 v) format)
580                         (when (= mod #b11)
581                           (sigcontext-float-register scp (+ 8 r/m) format))))))
582          ;; Look at the instruction and see if it's one of the arithmetic
583          ;; SSE2 instructions.  If so, figure out the operation and try
584          ;; to get the operands.  Currently, if an operand is in memory,
585          ;; we don't try to fetch it.
586          ;;
587          ;; Also, for the packed operations that hold complex numbers,
588          ;; it's not exactly clear what to do.  The main issue is that
589          ;; when multiplying or dividing complex numbers, there is no
590          ;; single instruction.  The operation is decomposed into several
591          ;; operations and the contents of the packed register may not
592          ;; have any simple relationship to the Lisp complex number.  For
593          ;; now, instead of returning the complex number, we return a
594          ;; list of the components.  Perhaps this is better than nothing,
595          ;; but might be confusing.
596          (cond ((and (= (sys:sap-ref-8 pc 0) #xf2)
597                      (= (sys:sap-ref-8 pc 1) #x0f)
598                      (fop (sys:sap-ref-8 pc 2)))
599                 ;; ADDSD:  F2 0F 58
600                 ;; MULSD:  F2 0F 59
601                 ;; SUBSD:  F2 0F 5C
602                 ;; DIVSD:  F2 0F 5E
603                 ;; SQRTSD: F2 0F 51
604                 (multiple-value-bind (dst src)
605                     (decode-operands 3 'double-float)
606                   (values (fop (sys:sap-ref-8 pc 2)) dst src)))
607                ((and (= (sys:sap-ref-8 pc 0) #xf3)
608                      (= (sys:sap-ref-8 pc 1) #x0f)
609                      (fop (sys:sap-ref-8 pc 2)))
610                 ;; ADDSS:  F3 0F 58
611                 ;; MULSS:  F3 0F 59
612                 ;; SUBSS:  F3 0F 5C
613                 ;; DIVSS:  F3 0F 5E
614                 ;; SQRTSS: F3 0F 51
615                 (multiple-value-bind (dst src)
616                     (decode-operands 3 'single-float)
617                   (values (fop (sys:sap-ref-8 pc 2)) dst src)))
618                ((and (= (sys:sap-ref-8 pc 0) #x66)
619                      (= (sys:sap-ref-8 pc 1) #x0f)
620                      (fop (sys:sap-ref-8 pc 2)))
621                 ;; ADDPD:  66 0F 58
622                 ;; MULPD:  66 0F 59
623                 ;; SUBPD:  66 0F 5C
624                 ;; DIVPD:  66 0F 5E
625                 (multiple-value-bind (dst src)
626                     (decode-operands 3 'complex-double-float)
627                   (values (fop (sys:sap-ref-8 pc 2))
628                           (list (realpart dst)
629                                 (imagpart dst))
630                           (when src
631                             (list (realpart src)
632                                   (imagpart src))))))
633                ((and (= (sys:sap-ref-8 pc 0) #x0f)
634                      (fop (sys:sap-ref-8 pc 1)))
635                 ;; ADDPS:  0F 58
636                 ;; MULPS:  0F 59
637                 ;; SUBPS:  0F 5C
638                 ;; DIVPS:  0F 5E
639                 (multiple-value-bind (dst src)
640                     (decode-operands 2 'complex-single-float)
641                   (values (fop (sys:sap-ref-8 pc 1))
642                           (list (realpart dst)
643                                 (imagpart dst))
644                           (when src
645                             (list (realpart src)
646                                   (imagpart src))))))
647                (t
648                 (values nil nil nil nil))))))
649    
650    (defun get-fp-operands (scp modes)
651      (declare (type (alien (* sigcontext)) scp)
652               (ignore modes))
653      ;; From the offending FP instruction, get the operation and
654      ;; operands, if we can.
655      ;;
656      ;; FIXME: How do we distinguish between an exception caused by SSE2
657      ;; and one caused by x87?
658      (multiple-value-bind (fop dst src)
659          (get-fp-operation scp)
660        (values fop (list dst src))))

Legend:
Removed from v.1.37.4.1  
changed lines
  Added in v.1.39

  ViewVC Help
Powered by ViewVC 1.1.5