diff --git a/compiler/sparc/insts.lisp b/compiler/sparc/insts.lisp index 4d871413722893c447eff8a43782efecd5e5e495..af7f0b5fba26a5d6011512642c4246719913141a 100644 --- a/compiler/sparc/insts.lisp +++ b/compiler/sparc/insts.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.16 1998/03/10 21:24:35 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.17 1998/03/11 17:00:26 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -21,7 +21,7 @@ (def-assembler-params :scheduler-p t - :max-locations 68) + :max-locations 100) ;;;; Constants, types, conversion functions, some disassembler stuff. @@ -61,15 +61,15 @@ (float-registers (+ (tn-offset loc) 32)) (control-registers - 64) + 96) (immediate-constant nil))) (symbol (ecase loc (:memory 0) - (:psr 65) - (:fsr 66) - (:y 67))))) + (:psr 97) + (:fsr 98) + (:y 99))))) ;;; symbols used for disassembly printing ;;; @@ -93,7 +93,7 @@ (defparameter float-reg-symbols (coerce - (loop for n from 0 to 31 collect (make-symbol (format nil "%F~d" n))) + (loop for n from 0 to 63 collect (make-symbol (format nil "%F~d" n))) 'vector)) (disassem:define-argument-type fp-reg @@ -107,6 +107,21 @@ regname dstate)))) +;;; The extended 6 bit floating point register encoding for the double +;;; and long instructions of the sparc V9. +(disassem:define-argument-type fp-ext-reg + :printer #'(lambda (value stream dstate) + (declare (stream stream) (fixnum value)) + (let* (;; Decode the register number. + (value (if (oddp value) (+ value 31) value)) + (regname (aref float-reg-symbols value))) + (princ regname stream) + (disassem:maybe-note-associated-storage-ref + value + 'float-registers + regname + dstate)))) + (disassem:define-argument-type relative-label :sign-extend t :use-label #'(lambda (value dstate) @@ -218,9 +233,8 @@ (immed :field (byte 13 0) :sign-extend t)) ; usually sign extended (disassem:define-instruction-format - (format-3-fpop 32 - :default-printer - '(:name :tab (:unless (:same-as rd) rs1 ", ") rs2 ", " rd)) + (format-binary-fpop 32 + :default-printer '(:name :tab rd ", " rs1 ", " rs2)) (op :field (byte 2 30)) (rd :field (byte 5 25) :type 'fp-reg) (op3 :field (byte 6 19)) @@ -228,6 +242,56 @@ (opf :field (byte 9 5)) (rs2 :field (byte 5 0) :type 'fp-reg)) +;;; Floating point load/save instructions encoding. +(disassem:define-instruction-format + (format-unary-fpop 32 :default-printer '(:name :tab rd ", " rs2)) + (op :field (byte 2 30)) + (rd :field (byte 5 25) :type 'fp-reg) + (op3 :field (byte 6 19)) + (rs1 :field (byte 5 14) :value 0) + (opf :field (byte 9 5)) + (rs2 :field (byte 5 0) :type 'fp-reg)) + +;;; Floating point comparison instructions encoding. +(disassem:define-instruction-format + (format-cmp-fpop 32 :default-printer '(:name :tab rs1 ", " rs2)) + (op :field (byte 2 30)) + (rd :field (byte 5 25) :value 0) + (op3 :field (byte 6 19)) + (rs1 :field (byte 5 14) :type 'fp-reg) + (opf :field (byte 9 5)) + (rs2 :field (byte 5 0) :type 'fp-reg)) + +;;; Double and long float instruction format of the sparc V9. +(disassem:define-instruction-format + (format-binary-ext-fpop 32 + :default-printer '(:name :tab rd ", " rs1 ", " rs2)) + (op :field (byte 2 30)) + (rd :field (byte 5 25) :type 'fp-ext-reg) + (op3 :field (byte 6 19)) + (rs1 :field (byte 5 14) :type 'fp-ext-reg) + (opf :field (byte 9 5)) + (rs2 :field (byte 5 0) :type 'fp-ext-reg)) + +;;; Double and long floating point load/save instructions encoding. +(disassem:define-instruction-format + (format-unary-ext-fpop 32 :default-printer '(:name :tab rd ", " rs2)) + (op :field (byte 2 30)) + (rd :field (byte 5 25) :type 'fp-ext-reg) + (op3 :field (byte 6 19)) + (rs1 :field (byte 5 14) :value 0) + (opf :field (byte 9 5)) + (rs2 :field (byte 5 0) :type 'fp-ext-reg)) + +;;; Double and long floating point comparison instructions encoding. +(disassem:define-instruction-format + (format-cmp-ext-fpop 32 :default-printer '(:name :tab rs1 ", " rs2)) + (op :field (byte 2 30)) + (rd :field (byte 5 25) :value 0) + (op3 :field (byte 6 19)) + (rs1 :field (byte 5 14) :type 'fp-ext-reg) + (opf :field (byte 9 5)) + (rs2 :field (byte 5 0) :type 'fp-ext-reg)) ;;;; Primitive emitters. @@ -260,7 +324,6 @@ (define-emitter emit-format-3-fpop 32 (byte 2 30) (byte 5 25) (byte 6 19) (byte 5 14) (byte 9 5) (byte 5 0)) - ;;;; Most of the format-3-instructions. @@ -689,19 +752,12 @@ ;;;; Unary and binary fp insts. -(defun emit-fp-inst (segment opf op3 dst src1 src2 &optional odd) - (flet ((maybe-fp-reg-tn-encoding (reg) - (if reg (fp-reg-tn-encoding reg odd) 0))) - (emit-format-3-fpop segment #b10 (maybe-fp-reg-tn-encoding dst) op3 - (maybe-fp-reg-tn-encoding src1) opf - (maybe-fp-reg-tn-encoding src2)))) - (eval-when (compile eval) -(defmacro define-unary-fp-inst (name opf &key reads odd) +(defmacro define-unary-fp-inst (name opf &key reads) `(define-instruction ,name (segment dst src) (:declare (type tn dst src)) - (:printer format-3-fpop ((op #b10) (op3 #b110100) (opf ,opf))) + (:printer format-unary-fpop ((op #b10) (op3 #b110100) (opf ,opf) (rs1 0))) (:dependencies ,@(when reads `((reads ,reads))) @@ -709,13 +765,14 @@ (reads src) (writes dst)) (:delay 0) - (:emitter (emit-fp-inst segment ,opf #b110100 dst nil src ,odd)))) + (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst) + #b110100 0 ,opf (fp-reg-tn-encoding src))))) -(defmacro define-binary-fp-inst (name opf - &key (op3 #b110100) reads writes delay) +(defmacro define-binary-fp-inst (name opf &key (op3 #b110100) + reads writes delay) `(define-instruction ,name (segment dst src1 src2) (:declare (type tn dst src1 src2)) - (:printer format-3-fpop ((op #b10) (op3 ,op3) (opf ,opf))) + (:printer format-binary-fpop ((op #b10) (op3 ,op3) (opf ,opf))) (:dependencies ,@(when reads `((reads ,reads))) @@ -727,33 +784,87 @@ ,@(if delay `((:delay ,delay)) '((:delay 0))) - (:emitter (emit-fp-inst segment ,opf ,op3 dst src1 src2)))) + (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst) + ,op3 (fp-reg-tn-encoding src1) ,opf + (fp-reg-tn-encoding src2))))) -(defmacro define-fp-cmp-inst (name opf) +(defmacro define-cmp-fp-inst (name opf) `(define-instruction ,name (segment src1 src2) (:declare (type tn src1 src2)) - (:printer format-3-fpop ((op #b10) (op3 #b110101) (opf ,opf))) + (:printer format-cmp-fpop ((op #b10) (op3 #b110101) (opf ,opf) (rd 0))) (:dependencies (reads src1) (reads src2) (writes :fsr)) (:delay 1) - (:emitter (emit-fp-inst segment ,opf #b110101 nil src1 src2)))) - + (:emitter (emit-format-3-fpop segment #b10 0 #b110101 + (fp-reg-tn-encoding src1) ,opf (fp-reg-tn-encoding src2))))) + +;;; Double and long float instruction encodings. + +(defmacro define-unary-ext-fp-inst (name opf &key reads) + `(define-instruction ,name (segment dst src) + (:declare (type tn dst src)) + (:printer format-unary-ext-fpop ((op #b10) (op3 #b110100) (opf ,opf) + (rs1 0))) + (:dependencies + ,@(when reads + `((reads ,reads))) + (reads dst) + (reads src) + (writes dst)) + (:delay 0) + (:emitter (emit-format-3-fpop segment #b10 + (fp-reg-tn-encoding dst) #b110100 0 ,opf + (fp-reg-tn-encoding src))))) + +(defmacro define-binary-ext-fp-inst (name opf &key (op3 #b110100) + reads writes delay) + `(define-instruction ,name (segment dst src1 src2) + (:declare (type tn dst src1 src2)) + (:printer format-binary-ext-fpop ((op #b10) (op3 ,op3) (opf ,opf))) + (:dependencies + ,@(when reads + `((reads ,reads))) + (reads src1) + (reads src2) + ,@(when writes + `((writes ,writes))) + (writes dst)) + ,@(if delay + `((:delay ,delay)) + '((:delay 0))) + (:emitter (emit-format-3-fpop segment #b10 + (fp-reg-tn-encoding dst) ,op3 (fp-reg-tn-encoding src1) ,opf + (fp-reg-tn-encoding src2))))) + +(defmacro define-cmp-ext-fp-inst (name opf) + `(define-instruction ,name (segment src1 src2) + (:declare (type tn src1 src2)) + (:printer format-cmp-ext-fpop ((op #b10) (op3 #b110101) (opf ,opf) + (rd 0))) + (:dependencies + (reads src1) + (reads src2) + (writes :fsr)) + (:delay 1) + (:emitter (emit-format-3-fpop segment #b10 0 #b110101 + (fp-reg-tn-encoding src1) ,opf (fp-reg-tn-encoding src2))))) + ); eval-when (compile eval) (define-unary-fp-inst fitos #b011000100 :reads :fsr) -(define-unary-fp-inst fitod #b011001000 :reads :fsr) -(define-unary-fp-inst fitox #b011001100 :reads :fsr) +(define-unary-ext-fp-inst fitod #b011001000 :reads :fsr) +(define-unary-ext-fp-inst fitox #b011001100 :reads :fsr) (define-unary-fp-inst fstoir #b011000001 :reads :fsr) -(define-unary-fp-inst fdtoir #b011000010 :reads :fsr) -(define-unary-fp-inst fxtoir #b011000011 :reads :fsr) +(define-unary-ext-fp-inst fdtoir #b011000010 :reads :fsr) +(define-unary-ext-fp-inst fxtoir #b011000011 :reads :fsr) (define-unary-fp-inst fstoi #b011010001) -(define-unary-fp-inst fdtoi #b011010010) -(define-unary-fp-inst fxtoi #b011010011) +(define-unary-ext-fp-inst fdtoi #b011010010) +(define-unary-ext-fp-inst fxtoi #b011010011) (define-unary-fp-inst fstod #b011001001 :reads :fsr) (define-unary-fp-inst fstox #b011001101 :reads :fsr) @@ -767,40 +878,42 @@ (:declare (type tn dst src1)) (:dependencies (reads dst) (reads src1) (writes dst)) (:delay 0) - (:emitter (emit-fp-inst segment #b000000001 #b110100 dst nil src1 t))) -(define-unary-fp-inst fmovd #b000000010) ; V9 -(define-unary-fp-inst fmovq #b000000011) ; V9 + (:emitter (emit-format-3-fpop segment #b10 (fp-reg-tn-encoding dst t) + #b110100 0 #b000000001 + (fp-reg-tn-encoding src1 t)))) +(define-unary-ext-fp-inst fmovd #b000000010) ; V9 +(define-unary-ext-fp-inst fmovq #b000000011) ; V9 (define-unary-fp-inst fnegs #b000000101) (define-unary-fp-inst fabss #b000001001) (define-unary-fp-inst fsqrts #b000101001 :reads :fsr) -(define-unary-fp-inst fsqrtd #b000101010 :reads :fsr) -(define-unary-fp-inst fsqrtx #b000101011 :reads :fsr) +(define-unary-ext-fp-inst fsqrtd #b000101010 :reads :fsr) +(define-unary-ext-fp-inst fsqrtx #b000101011 :reads :fsr) (define-binary-fp-inst fadds #b001000001) -(define-binary-fp-inst faddd #b001000010) -(define-binary-fp-inst faddx #b001000011) +(define-binary-ext-fp-inst faddd #b001000010) +(define-binary-ext-fp-inst faddx #b001000011) (define-binary-fp-inst fsubs #b001000101) -(define-binary-fp-inst fsubd #b001000110) -(define-binary-fp-inst fsubx #b001000111) +(define-binary-ext-fp-inst fsubd #b001000110) +(define-binary-ext-fp-inst fsubx #b001000111) (define-binary-fp-inst fmuls #b001001001) -(define-binary-fp-inst fmuld #b001001010) -(define-binary-fp-inst fmulx #b001001011) +(define-binary-ext-fp-inst fmuld #b001001010) +(define-binary-ext-fp-inst fmulx #b001001011) (define-binary-fp-inst fdivs #b001001101) -(define-binary-fp-inst fdivd #b001001110) -(define-binary-fp-inst fdivx #b001001111) +(define-binary-ext-fp-inst fdivd #b001001110) +(define-binary-ext-fp-inst fdivx #b001001111) ;;; Float comparison instructions. ;;; -(define-fp-cmp-inst fcmps #b001010001) -(define-fp-cmp-inst fcmpd #b001010010) -(define-fp-cmp-inst fcmpx #b001010011) -(define-fp-cmp-inst fcmpes #b001010101) -(define-fp-cmp-inst fcmped #b001010110) -(define-fp-cmp-inst fcmpex #b001010111) +(define-cmp-fp-inst fcmps #b001010001) +(define-cmp-ext-fp-inst fcmpd #b001010010) +(define-cmp-ext-fp-inst fcmpx #b001010011) +(define-cmp-fp-inst fcmpes #b001010101) +(define-cmp-ext-fp-inst fcmped #b001010110) +(define-cmp-ext-fp-inst fcmpex #b001010111) diff --git a/compiler/sparc/vm.lisp b/compiler/sparc/vm.lisp index bd7c965c003df0f52858fe4e3fcd22423795d960..8ecd0a77009476709ff56811b39821a21b9d5f51 100644 --- a/compiler/sparc/vm.lisp +++ b/compiler/sparc/vm.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.9 1998/01/21 10:10:05 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/vm.lisp,v 1.10 1998/03/11 17:00:24 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -95,7 +95,7 @@ ;;;; SB and SC definition: (define-storage-base registers :finite :size 32) -(define-storage-base float-registers :finite :size 32) +(define-storage-base float-registers :finite :size 64) (define-storage-base control-stack :unbounded :size 8) (define-storage-base non-descriptor-stack :unbounded :size 0) (define-storage-base constant :non-packed)