X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fvm.lisp;h=2538e4981f593759baf1abb1a94192eff30c4dcf;hb=1540c1c1d517c58fa9a41629beb65cdce7dfafb6;hp=9f69ec4046fb71d1dbbfd3bc9abc9d959408834e;hpb=06b4f7dc62e1ce045ff7409686f27534ecb13ada;p=sbcl.git diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index 9f69ec4..2538e49 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -19,8 +19,8 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *byte-register-names* (make-array 32 :initial-element nil)) - (defvar *word-register-names* (make-array 16 :initial-element nil)) - (defvar *dword-register-names* (make-array 16 :initial-element nil)) + (defvar *word-register-names* (make-array 32 :initial-element nil)) + (defvar *dword-register-names* (make-array 32 :initial-element nil)) (defvar *qword-register-names* (make-array 32 :initial-element nil)) (defvar *float-register-names* (make-array 16 :initial-element nil))) @@ -82,7 +82,16 @@ (defreg bp 10 :word) (defreg si 12 :word) (defreg di 14 :word) - (defregset *word-regs* ax cx dx bx si di) + (defreg r8w 16 :word) + (defreg r9w 18 :word) + (defreg r10w 20 :word) + (defreg r11w 22 :word) + (defreg r12w 24 :word) + (defreg r13w 26 :word) + (defreg r14w 28 :word) + (defreg r15w 30 :word) + (defregset *word-regs* ax cx dx bx si di r8w r9w r10w + #+nil r11w #+nil r12w r13w r14w r15w) ;; double word registers (defreg eax 0 :dword) @@ -93,7 +102,16 @@ (defreg ebp 10 :dword) (defreg esi 12 :dword) (defreg edi 14 :dword) - (defregset *dword-regs* eax ecx edx ebx esi edi) + (defreg r8d 16 :dword) + (defreg r9d 18 :dword) + (defreg r10d 20 :dword) + (defreg r11d 22 :dword) + (defreg r12d 24 :dword) + (defreg r13d 26 :dword) + (defreg r14d 28 :dword) + (defreg r15d 30 :dword) + (defregset *dword-regs* eax ecx edx ebx esi edi r8d r9d r10d + #+nil r11d #+nil r12w r13d r14d r15d) ;; quadword registers (defreg rax 0 :qword) @@ -152,7 +170,10 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *register-arg-names* '(rdx rdi rsi))) (defregset *register-arg-offsets* rdx rdi rsi) - (defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9)) + #!-win32 + (defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9) + #!+win32 + (defregset *c-call-register-arg-offsets* rcx rdx r8 r9)) ;;;; SB definitions @@ -166,7 +187,7 @@ (define-storage-base float-registers :finite :size 16) -(define-storage-base stack :unbounded :size 8) +(define-storage-base stack :unbounded :size 4 :size-increment 1) (define-storage-base constant :non-packed) (define-storage-base immediate-constant :non-packed) (define-storage-base noise :unbounded :size 2) @@ -208,7 +229,7 @@ ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess ;;; has my gratitude.) (FIXME: Maybe this should be me..) (eval-when (:compile-toplevel :load-toplevel :execute) - (def!constant kludge-nondeterministic-catch-block-size 6)) + (def!constant kludge-nondeterministic-catch-block-size 5)) (!define-storage-classes @@ -217,6 +238,17 @@ (fp-single-zero immediate-constant) (fp-double-zero immediate-constant) + (fp-complex-single-zero immediate-constant) + (fp-complex-double-zero immediate-constant) + + (fp-single-immediate immediate-constant) + (fp-double-immediate immediate-constant) + (fp-complex-single-immediate immediate-constant) + (fp-complex-double-immediate immediate-constant) + + #!+sb-simd-pack (int-sse-immediate immediate-constant) + #!+sb-simd-pack (double-sse-immediate immediate-constant) + #!+sb-simd-pack (single-sse-immediate immediate-constant) (immediate immediate-constant) @@ -235,9 +267,14 @@ (sap-stack stack) ; System area pointers. (single-stack stack) ; single-floats (double-stack stack) - (complex-single-stack stack :element-size 2) ; complex-single-floats + (complex-single-stack stack) ; complex-single-floats (complex-double-stack stack :element-size 2) ; complex-double-floats - + #!+sb-simd-pack + (int-sse-stack stack :element-size 2) + #!+sb-simd-pack + (double-sse-stack stack :element-size 2) + #!+sb-simd-pack + (single-sse-stack stack :element-size 2) ;; ;; magic SCs @@ -325,32 +362,54 @@ ;; non-descriptor SINGLE-FLOATs (single-reg float-registers - :locations #.(loop for i from 0 below 15 collect i) - :constant-scs (fp-single-zero) + :locations #.*float-regs* + :constant-scs (fp-single-zero fp-single-immediate) :save-p t :alternate-scs (single-stack)) ;; non-descriptor DOUBLE-FLOATs (double-reg float-registers - :locations #.(loop for i from 0 below 15 collect i) - :constant-scs (fp-double-zero) + :locations #.*float-regs* + :constant-scs (fp-double-zero fp-double-immediate) :save-p t :alternate-scs (double-stack)) (complex-single-reg float-registers - :locations #.(loop for i from 0 to 14 by 2 collect i) - :element-size 2 - :constant-scs () + :locations #.*float-regs* + :constant-scs (fp-complex-single-zero fp-complex-single-immediate) :save-p t :alternate-scs (complex-single-stack)) (complex-double-reg float-registers - :locations #.(loop for i from 0 to 14 by 2 collect i) - :element-size 2 - :constant-scs () + :locations #.*float-regs* + :constant-scs (fp-complex-double-zero fp-complex-double-immediate) :save-p t :alternate-scs (complex-double-stack)) + ;; temporary only + #!+sb-simd-pack + (sse-reg float-registers + :locations #.*float-regs*) + ;; regular values + #!+sb-simd-pack + (int-sse-reg float-registers + :locations #.*float-regs* + :constant-scs (int-sse-immediate) + :save-p t + :alternate-scs (int-sse-stack)) + #!+sb-simd-pack + (double-sse-reg float-registers + :locations #.*float-regs* + :constant-scs (double-sse-immediate) + :save-p t + :alternate-scs (double-sse-stack)) + #!+sb-simd-pack + (single-sse-reg float-registers + :locations #.*float-regs* + :constant-scs (single-sse-immediate) + :save-p t + :alternate-scs (single-sse-stack)) + ;; a catch or unwind block (catch-block stack :element-size kludge-nondeterministic-catch-block-size)) @@ -369,6 +428,11 @@ ;;; These are used to (at least) determine operand size. (defparameter *float-sc-names* '(single-reg)) (defparameter *double-sc-names* '(double-reg double-stack)) +(defparameter *complex-sc-names* '(complex-single-reg complex-single-stack + complex-double-reg complex-double-stack)) +#!+sb-simd-pack +(defparameter *oword-sc-names* '(sse-reg int-sse-reg single-sse-reg double-sse-reg + sse-stack int-sse-stack single-sse-stack double-sse-stack)) ) ; EVAL-WHEN ;;;; miscellaneous TNs for the various registers @@ -390,14 +454,26 @@ (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi r8 r9 r10 r11 r12 r13 r14 r15) - (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi) - (def-misc-reg-tns word-reg ax bx cx dx bp sp di si) + (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi + r8d r9d r10d r11d r12d r13d r14d r15d) + (def-misc-reg-tns word-reg ax bx cx dx bp sp di si + r8w r9w r10w r11w r12w r13w r14w r15w) (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b r11b r12b r13b r14b r15b) (def-misc-reg-tns single-reg float0 float1 float2 float3 float4 float5 float6 float7 float8 float9 float10 float11 float12 float13 float14 float15)) +(defun reg-in-size (tn size) + (make-random-tn :kind :normal + :sc (sc-or-lose + (ecase size + (:byte 'byte-reg) + (:word 'word-reg) + (:dword 'dword-reg) + (:qword 'unsigned-reg))) + :offset (tn-offset tn))) + ;; A register that's never used by the code generator, and can therefore ;; be used as an assembly temporary in cases where a VOP :TEMPORARY can't ;; be used. @@ -413,19 +489,9 @@ (make-random-tn :kind :normal :sc (sc-or-lose 'unsigned-reg ) :offset r12-offset)) -(defparameter fp-single-zero-tn - (make-random-tn :kind :normal - :sc (sc-or-lose 'single-reg) - :offset 15)) - -(defparameter fp-double-zero-tn - (make-random-tn :kind :normal - :sc (sc-or-lose 'double-reg) - :offset 15)) - ;;; If value can be represented as an immediate constant, then return ;;; the appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) character) @@ -434,21 +500,60 @@ (when (static-symbol-p value) (sc-number-or-lose 'immediate))) (single-float - (if (eql value 0f0) - (sc-number-or-lose 'fp-single-zero ) - nil)) + (sc-number-or-lose + (if (eql value 0f0) 'fp-single-zero 'fp-single-immediate))) (double-float - (if (eql value 0d0) - (sc-number-or-lose 'fp-double-zero ) - nil)))) - + (sc-number-or-lose + (if (eql value 0d0) 'fp-double-zero 'fp-double-immediate))) + ((complex single-float) + (sc-number-or-lose + (if (eql value #c(0f0 0f0)) + 'fp-complex-single-zero + 'fp-complex-single-immediate))) + ((complex double-float) + (sc-number-or-lose + (if (eql value #c(0d0 0d0)) + 'fp-complex-double-zero + 'fp-complex-double-immediate))) + #!+sb-simd-pack + (#+sb-xc-host nil + #-sb-xc-host (simd-pack double-float) + (sc-number-or-lose 'double-sse-immediate)) + #!+sb-simd-pack + (#+sb-xc-host nil + #-sb-xc-host (simd-pack single-float) + (sc-number-or-lose 'single-sse-immediate)) + #!+sb-simd-pack + (#+sb-xc-host nil + #-sb-xc-host simd-pack + (sc-number-or-lose 'int-sse-immediate)))) + +(defun boxed-immediate-sc-p (sc) + (eql sc (sc-number-or-lose 'immediate))) ;;;; miscellaneous function call parameters -;;; offsets of special stack frame locations -(def!constant ocfp-save-offset 0) -(def!constant return-pc-save-offset 1) +;;; Offsets of special stack frame locations relative to RBP. +;;; +;;; Consider the standard prologue PUSH RBP; MOV RBP, RSP: the return +;;; address is at RBP+8, the old control stack frame pointer is at +;;; RBP, the magic 3rd slot is at RBP-8. Then come the locals from +;;; RBP-16 on. +(def!constant return-pc-save-offset 0) +(def!constant ocfp-save-offset 1) (def!constant code-save-offset 2) +;;; Let SP be the stack pointer before CALLing, and FP is the frame +;;; pointer after the standard prologue. SP + +;;; FRAME-WORD-OFFSET(SP->FP-OFFSET + I) = FP + FRAME-WORD-OFFSET(I). +(def!constant sp->fp-offset 2) + +(declaim (inline frame-word-offset)) +(defun frame-word-offset (index) + (- (1- index))) + +(declaim (inline frame-byte-offset)) +(defun frame-byte-offset (index) + (* (frame-word-offset index) n-word-bytes)) (def!constant lra-save-offset return-pc-save-offset) ; ? @@ -457,7 +562,7 @@ ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let* ((sc (tn-sc tn)) (sb (sb-name (sc-sb sc))) @@ -497,6 +602,34 @@ (def!constant cfp-offset rbp-offset) ; pfw - needed by stuff in /code -(!def-vm-support-routine combination-implementation-style (node) - (declare (type sb!c::combination node) (ignore node)) - (values :default nil)) +(defun combination-implementation-style (node) + (declare (type sb!c::combination node)) + (flet ((valid-funtype (args result) + (sb!c::valid-fun-use node + (sb!c::specifier-type + `(function ,args ,result))))) + (case (sb!c::combination-fun-source-name node) + (logtest + (cond + ((or (valid-funtype '(fixnum fixnum) '*) + ;; todo: nothing prevents this from testing an unsigned word against + ;; a signed word, except for the mess of VOPs it would demand + (valid-funtype '((signed-byte 64) (signed-byte 64)) '*) + (valid-funtype '((unsigned-byte 64) (unsigned-byte 64)) '*)) + (values :maybe nil)) + (t + (values :default nil)))) + (logbitp + (cond + ((or (and (valid-funtype '#.`((integer 0 ,(- 63 n-fixnum-tag-bits)) + fixnum) '*) + (sb!c::constant-lvar-p + (first (sb!c::basic-combination-args node)))) + (valid-funtype '((integer 0 63) (signed-byte 64)) '*) + (valid-funtype '((integer 0 63) (unsigned-byte 64)) '*)) + (values :transform '(lambda (index integer) + (%logbitp integer index)))) + (t + (values :default nil)))) + (t + (values :default nil)))))