X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fvm.lisp;h=ce601981181090f9fc909f21eab9ae0ff7ad8648;hb=c4b30c86e3dd1d1cc70c572a6cfffe8b84e9c34a;hp=ed057033404c2943aa6829b7be14355e41f2c5ee;hpb=b6e9c116826f9461e2660d87c031fd1c4488e776;p=sbcl.git diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index ed05703..ce60198 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -208,7 +208,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 +217,13 @@ (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) (immediate immediate-constant) @@ -229,13 +236,13 @@ ;; the non-descriptor stacks ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries - (signed-stack stack) ; (signed-byte 32) - (unsigned-stack stack) ; (unsigned-byte 32) + (signed-stack stack) ; (signed-byte 64) + (unsigned-stack stack) ; (unsigned-byte 64) (character-stack stack) ; non-descriptor characters. (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 @@ -276,6 +283,8 @@ (character-reg registers :locations #!-sb-unicode #.*byte-regs* #!+sb-unicode #.*qword-regs* + #!+sb-unicode #!+sb-unicode + :element-size 2 #!-sb-unicode #!-sb-unicode :reserve-locations (#.al-offset) :constant-scs (immediate) @@ -323,29 +332,27 @@ ;; 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)) @@ -367,6 +374,8 @@ ;;; 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)) ) ; EVAL-WHEN ;;;; miscellaneous TNs for the various registers @@ -411,42 +420,57 @@ (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) (typecase value ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) - #-sb-xc-host system-area-pointer character) + character) (sc-number-or-lose 'immediate)) (symbol (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))))) ;;;; 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) ; ? @@ -495,3 +519,6 @@ (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))