Commit c4e198fd authored by rtoy's avatar rtoy
Browse files

Macroize the sap vops.

parent 33320f9d

compiler/x86/sse2-sap.lisp

+58 −132
Original line number Diff line number Diff line 
;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-

1;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: x86 -*-

;;;

;;; **********************************************************************

;;; This code was written as part of the CMU Common Lisp project at
@@ -7,7 +7,7 @@ 
;;; Scott Fahlman or slisp-group@cs.cmu.edu.

;;;

(ext:file-comment

 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sse2-sap.lisp,v 1.1.2.2 2008/09/28 19:52:38 rtoy Exp $")

 "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/sse2-sap.lisp,v 1.1.2.3 2008/10/05 03:15:13 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -16,133 +16,59 @@ 


(in-package :x86)



(define-vop (sap-ref-double)

  (:translate sap-ref-double)

(macrolet

    ((frob (name type inst)

       (let ((sc-type (symbolicate type "-REG"))

	     (res-type (symbolicate type "-FLOAT")))

	 `(progn

	    (define-vop (,(symbolicate "SAP-REF-" name))

	      (:translate ,(symbolicate "SAP-REF-" name))

	      (:policy :fast-safe)

	      (:args (sap :scs (sap-reg))

		     (offset :scs (signed-reg)))

	      (:arg-types system-area-pointer signed-num)

  (:results (result :scs (double-reg)))

  (:result-types double-float)

	      (:results (result :scs (,sc-type)))

	      (:result-types ,res-type)

	      (:generator 5

    (inst movsd result (make-ea :dword :base sap :index offset))))



(define-vop (sap-ref-double-c)

  (:translate sap-ref-double)

		(inst ,inst result (make-ea :dword :base sap :index offset))))

	    (define-vop (,(symbolicate "SAP-REF-" type "-C"))

		(:translate ,(symbolicate "SAP-REF-" type))

	      (:policy :fast-safe)

	      (:args (sap :scs (sap-reg)))

	      (:arg-types system-area-pointer (:constant (signed-byte 32)))

	      (:info offset)

  (:results (result :scs (double-reg)))

  (:result-types double-float)

	      (:results (result :scs (,sc-type)))

	      (:result-types ,res-type)

	      (:generator 4

    (inst movsd result (make-ea :dword :base sap :disp offset))))



(define-vop (%set-sap-ref-double)

  (:translate %set-sap-ref-double)

		(inst ,inst result (make-ea :dword :base sap :disp offset))))

	    (define-vop (,(symbolicate "%SET-SAP-REF-" type))

	      (:translate ,(symbolicate "%SET-SAP-REF-" type))

	      (:policy :fast-safe)

	      (:args (sap :scs (sap-reg) :to (:eval 0))

		     (offset :scs (signed-reg) :to (:eval 0))

	 (value :scs (double-reg)))

  (:arg-types system-area-pointer signed-num double-float)

  (:results (result :scs (double-reg)))

  (:result-types double-float)

		     (value :scs (,sc-type)))

	      (:arg-types system-area-pointer signed-num ,res-type)

	      (:results (result :scs (,sc-type)))

	      (:result-types ,res-type)

	      (:generator 5

       (inst movsd (make-ea :dword :base sap :index offset) value)

       (inst movsd result value)))



(define-vop (%set-sap-ref-double-c)

  (:translate %set-sap-ref-double)

		(inst ,inst (make-ea :dword :base sap :index offset) value)

		(unless (location= result value)

		  (inst ,inst result value))))

	    (define-vop (,(symbolicate "%SET-SAP-REF-" type "-C"))

	      (:translate ,(symbolicate "%SET-SAP-REF-" type))

	      (:policy :fast-safe)

	      (:args (sap :scs (sap-reg) :to (:eval 0))

	 (value :scs (double-reg)))

  (:arg-types system-area-pointer (:constant (signed-byte 32)) double-float)

		     (value :scs (,sc-type)))

	      (:arg-types system-area-pointer (:constant (signed-byte 32))

			  ,res-type)

	      (:info offset)

  (:results (result :scs (double-reg)))

  (:result-types double-float)

	      (:results (result :scs (,sc-type)))

	      (:result-types ,res-type)

	      (:generator 4

       (inst movsd (make-ea :dword :base sap :disp offset) value)

       (inst movsd result value)))



(define-vop (sap-ref-single)

  (:translate sap-ref-single)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg))

	 (offset :scs (signed-reg)))

  (:arg-types system-area-pointer signed-num)

  (:results (result :scs (single-reg)))

  (:result-types single-float)

  (:generator 5

    (inst movss result (make-ea :dword :base sap :index offset))))



(define-vop (sap-ref-single-c)

  (:translate sap-ref-single)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg)))

  (:arg-types system-area-pointer (:constant (signed-byte 32)))

  (:info offset)

  (:results (result :scs (single-reg)))

  (:result-types single-float)

  (:generator 4

    (inst movss result (make-ea :dword :base sap :disp offset))))



(define-vop (%set-sap-ref-single)

  (:translate %set-sap-ref-single)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg) :to (:eval 0))

	 (offset :scs (signed-reg) :to (:eval 0))

	 (value :scs (single-reg)))

  (:arg-types system-area-pointer signed-num single-float)

  (:results (result :scs (single-reg)))

  (:result-types single-float)

  (:generator 5

    (inst movss (make-ea :dword :base sap :index offset) value)

    (inst movss result value)))



(define-vop (%set-sap-ref-single-c)

  (:translate %set-sap-ref-single)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg) :to (:eval 0))

	 (value :scs (single-reg)))

  (:arg-types system-area-pointer (:constant (signed-byte 32)) single-float)

  (:info offset)

  (:results (result :scs (single-reg)))

  (:result-types single-float)

  (:generator 4

    (inst movss (make-ea :dword :base sap :disp offset) value)

    (inst movss result value)))



(define-vop (sap-ref-long)

  (:translate sap-ref-long)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg))

	 (offset :scs (signed-reg)))

  (:arg-types system-area-pointer signed-num)

  (:results (result :scs ( double-reg)))

  (:result-types double-float)

  (:generator 5

    (inst movsd result (make-ea :dword :base sap :index offset))))



(define-vop (sap-ref-long-c)

  (:translate sap-ref-long)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg)))

  (:arg-types system-area-pointer (:constant (signed-byte 32)))

  (:info offset)

  (:results (result :scs ( double-reg)))

  (:result-types double-float)

  (:generator 4

    (inst movsd result (make-ea :dword :base sap :disp offset))))



(define-vop (%set-sap-ref-long)

  (:translate %set-sap-ref-long)

  (:policy :fast-safe)

  (:args (sap :scs (sap-reg) :to (:eval 0))

	 (offset :scs (signed-reg) :to (:eval 0))

	 (value :scs ( double-reg)))

  (:arg-types system-area-pointer signed-num double-float)

  (:results (result :scs ( double-reg)))

  (:result-types double-float)

  (:generator 5

    (inst movsd (make-ea :dword :base sap :index offset) value)

    (inst movsd result value)))
 
		(inst ,inst (make-ea :dword :base sap :disp offset) value)

		(unless (location= result value)

		  (inst ,inst result value))))))))

  (frob double double movsd)

  (frob single single movss)

  ;; Not really right since these aren't long floats

  (frob long   double movsd))