Ignore:
Timestamp:
Jul 12, 2010, 12:49:43 PM (9 years ago)
Author:
gb
Message:

arm-misc.lisp: Need xchgl for ARM (used in futex-based locking.)
l0-misc.lisp: ROOM and aux functions: no tsp on ARM
vinsn.lisp: rename :conditional attribute to :predicatable.
arm-vinsns.lisp, arm2.lisp: replace COPY-FPR with all 4 single/double
variants. Use :predicatable attribute to avoid some conditional branches.
arm-asm.lisp, arm-disassemble.lisp: add, fix some instruction definitions.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/compiler/ARM/arm2.lisp

    r13897 r13955  
    3535(defparameter *arm2-half-fixnum-type* '(signed-byte 29))
    3636(defparameter *arm2-target-half-fixnum-type* nil)
     37(defparameter *arm2-operator-supports-u8-target* ())
     38
    3739
    3840
     
    4951     ,@body))
    5052
     53
     54(defun arm2-emit-vinsn (vlist name vinsn-table &rest vregs)
     55  (arm2-update-regmap (apply #'%emit-vinsn vlist name vinsn-table vregs)))
    5156
    5257(defmacro with-arm-local-vinsn-macros ((segvar &optional vreg-var xfer-var) &body body)
     
    6267                    (unless ,template-temp
    6368                      (warn "VINSN \"~A\" not defined" ,template-name-var))
    64                     `(arm2-update-regmap (%emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var)))))
     69                    `(arm2-emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var))))
    6570       (macrolet ((<- (,retvreg-var)
    6671                    `(arm2-copy-register ,',segvar ,',vreg-var ,,retvreg-var))
     
    513518
    514519(defun arm2-update-regmap (vinsn)
    515   (if (vinsn-attribute-p vinsn :call :jump)
     520  (if (vinsn-attribute-p vinsn :call)
    516521    (arm2-invalidate-regmap)
    517522    (setq *arm2-gpr-locations-valid-mask* (logandc2 *arm2-gpr-locations-valid-mask* (vinsn-gprs-set vinsn))))
     
    560565              (setq mask (logandc2 mask (ash 1 i)))))))))))
    561566
     567(defun arm2-copy-regmap (mask from to)
     568  (dotimes (i 16)
     569    (when (logbitp i mask)
     570      (setf (svref to i) (copy-list (svref from i))))))
     571
     572(defmacro with-arm2-saved-regmap ((mask map) &body body)
     573  `(let* ((,mask *arm2-gpr-locations-valid-mask*)
     574          (,map (make-array 16 :initial-element nil)))
     575    (declare (dynamic-extent ,map))
     576    (arm2-copy-regmap ,mask *arm2-gpr-locations* ,map)
     577    ,@body))
    562578
    563579(defun arm2-generate-pc-source-map (debug-info)
     
    27462762                (let* ((copy (if (eq (hard-regspec-class pushed-reg)
    27472763                                     hard-reg-class-fpr)
    2748                                (! copy-fpr popped-reg pushed-reg)
     2764                               (if (eql (get-regspec-mode pushed-reg)
     2765                                        hard-reg-class-fpr-mode-single)
     2766                                 (! single-to-single popped-reg pushed-reg)
     2767                                 (! double-to-double popped-reg pushed-reg))
    27492768                               (! copy-gpr popped-reg pushed-reg))))
    27502769                  (remove-dll-node copy)
     
    30903109            arm::slot-unbound-marker))))))
    30913110
     3111(defun arm2-acode-operator-supports-u8 (form)
     3112  (setq form (acode-unwrapped-form-value form))
     3113  (when (acode-p form)
     3114    (let* ((operator (acode-operator form)))
     3115      (if (member operator *arm2-operator-supports-u8-target*)
     3116        (values operator (acode-operand 1 form))))))
     3117
     3118(defun arm2-compare-u8 (seg vreg xfer form u8constant cr-bit true-p u8-operator)
     3119  (with-arm-local-vinsn-macros (seg vreg xfer)
     3120    (with-imm-target () (u8 :u8)
     3121      (with-crf-target () crf
     3122        (if (and (eql u8-operator (%nx1-operator lisptag))
     3123                 (eql 0 u8constant)
     3124                 (eql cr-bit arm::arm-cond-eq))
     3125          (let* ((formreg (arm2-one-untargeted-reg-form seg form arm::arg_z)))
     3126            (! test-fixnum crf formreg))
     3127          (progn
     3128           (arm2-use-operator u8-operator seg u8 nil form)
     3129           (! compare-immediate crf u8 u8constant))))
     3130      ;; Flags set.  Branch or return a boolean value ?
     3131      (regspec-crf-gpr-case
     3132       (vreg dest)
     3133       (^ cr-bit true-p)
     3134       (progn
     3135         (ensuring-node-target (target dest)
     3136           (if (not true-p)
     3137             (setq cr-bit (logxor 1 cr-bit)))
     3138           (! cond->boolean target cr-bit))
     3139         (^))))))
    30923140
    30933141;;; There are other cases involving constants that are worth exploiting.
    30943142(defun arm2-compare (seg vreg xfer i j cr-bit true-p)
    30953143  (with-arm-local-vinsn-macros (seg vreg xfer)
    3096     (let* ((jconst (arm2-constant-for-compare-p j))
     3144    (let* ((iu8 (let* ((i-fixnum (acode-fixnum-form-p i)))
     3145                  (if (typep i-fixnum '(unsigned-byte 8))
     3146                    i-fixnum)))
     3147           (ju8 (let* ((j-fixnum (acode-fixnum-form-p j)))
     3148                  (if (typep j-fixnum '(unsigned-byte 8))
     3149                    j-fixnum)))
     3150           (u8 (or iu8 ju8))
     3151           (other-u8 (if iu8 j (if ju8 i)))
     3152           (jconst (arm2-constant-for-compare-p j))
    30973153           (iconst (arm2-constant-for-compare-p i))
    30983154           (boolean (backend-crf-p vreg)))
    3099       (if (and boolean (or iconst jconst))
    3100         (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) arm::arg_z)))
    3101           (! compare-immediate vreg reg (or jconst iconst))
    3102           (unless (or jconst (eq cr-bit arm::arm-cond-eq))
    3103             (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
    3104           (^ cr-bit true-p))
    3105         (if (and (eq cr-bit arm::arm-cond-eq)
    3106                  (or jconst iconst))
    3107           (arm2-test-reg-%izerop
    3108            seg
    3109            vreg
    3110            xfer
    3111            (arm2-one-untargeted-reg-form
    3112             seg
    3113             (if jconst i j)
    3114             arm::arg_z)
    3115            cr-bit
    3116            true-p
    3117            (or jconst iconst))
    3118           (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
    3119             (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
     3155      (multiple-value-bind (u8-operator u8-operand) (if other-u8 (arm2-acode-operator-supports-u8 other-u8))
     3156        (if u8-operator
     3157          (arm2-compare-u8 seg vreg xfer u8-operand u8 (if (and iu8 (not (eq cr-bit arm::arm-cond-eq))) (logxor 1 cr-bit) cr-bit) true-p u8-operator)
     3158          (if (and boolean (or iconst jconst))
     3159            (let* ((reg (arm2-one-untargeted-reg-form seg (if jconst i j) arm::arg_z)))
     3160              (! compare-immediate vreg reg (or jconst iconst))
     3161              (unless (or jconst (eq cr-bit arm::arm-cond-eq))
     3162                (setq cr-bit (arm2-cr-bit-for-reversed-comparison cr-bit)))
     3163              (^ cr-bit true-p))
     3164            (if (and (eq cr-bit arm::arm-cond-eq)
     3165                     (or jconst iconst))
     3166              (arm2-test-reg-%izerop
     3167               seg
     3168               vreg
     3169               xfer
     3170               (arm2-one-untargeted-reg-form
     3171                seg
     3172                (if jconst i j)
     3173                arm::arg_z)
     3174               cr-bit
     3175               true-p
     3176               (or jconst iconst))
     3177              (multiple-value-bind (ireg jreg) (arm2-two-untargeted-reg-forms seg i arm::arg_y j arm::arg_z)
     3178                (arm2-compare-registers seg vreg xfer ireg jreg cr-bit true-p)))))))))
    31203179
    31213180
     
    33923451                  (if (and src-fpr dest-fpr)
    33933452                    (unless (eql dest-fpr src-fpr)
    3394                       (! copy-fpr dest src))))))))))))
     3453                      (case src-mode
     3454                        (#.hard-reg-class-fpr-mode-single
     3455                         (case dest-mode
     3456                           (#.hard-reg-class-fpr-mode-single
     3457                            (! single-to-single dest src))
     3458                           (#.hard-reg-class-fpr-mode-double
     3459                            (! single-to-double dest src))))
     3460                        (#.hard-reg-class-fpr-mode-double
     3461                         (case dest-mode
     3462                           (#.hard-reg-class-fpr-mode-single
     3463                            (! double-to-single dest src))
     3464                           (#.hard-reg-class-fpr-mode-double
     3465                            (! double-to-double dest src))))))))))))))))
    33953466 
    33963467(defun arm2-unreachable-store (&optional vreg)
     
    47864857         (vp (vinsn-variable-parts vinsn))
    47874858         (nvp (vinsn-template-nvp template))
     4859         (predicate (vinsn-annotation vinsn))
    47884860         (unique-labels ())
    47894861         (operand-insert-functions arm::*arm-vinsn-insert-functions*))
     
    48264898                         (operands (cdr f)))
    48274899                    (setf (arm::lap-instruction-opcode insn) (car f))
     4900                    (when predicate
     4901                      (funcall (svref operand-insert-functions
     4902                                      (arm::encode-vinsn-field-type :cond))
     4903                               insn
     4904                               predicate))
    48284905                    (dolist (op operands (append-dll-node insn current))
    48294906                      (let* ((insert-function (svref operand-insert-functions (car op))))
     
    53965473        (arm2-test-reg-%izerop seg vreg xfer target cr-bit true-p 0)))))
    53975474
    5398 
     5475(pushnew (%nx1-operator lisptag) *arm2-operator-supports-u8-target*)
    53995476(defarm2 arm2-lisptag lisptag (seg vreg xfer node)
    54005477  (if (null vreg)
    54015478    (arm2-form seg vreg xfer node)
    5402     (progn
    5403       (ensuring-node-target (target vreg)
    5404         (! extract-tag-fixnum target (arm2-one-untargeted-reg-form seg node arm::arg_z)))
     5479    (let* ((reg (arm2-one-untargeted-reg-form seg node arm::arg_z)))
     5480      (unboxed-other-case (vreg :u8)
     5481        (! extract-tag vreg reg)
     5482        (ensuring-node-target (target vreg)
     5483          (! extract-tag-fixnum target reg)))
    54055484      (^))))
    54065485
     5486(pushnew (%nx1-operator fulltag) *arm2-operator-supports-u8-target*)
    54075487(defarm2 arm2-fulltag fulltag (seg vreg xfer node)
    54085488  (if (null vreg)
    54095489    (arm2-form seg vreg xfer node)
    5410     (progn
     5490    (let* ((reg (arm2-one-untargeted-reg-form seg node arm::arg_z)))
     5491      (unboxed-other-case (vreg :u8)
     5492       (! extract-fulltag vreg reg)
    54115493      (ensuring-node-target (target vreg)
    5412         (! extract-fulltag-fixnum target (arm2-one-untargeted-reg-form seg node arm::arg_z)))
     5494        (! extract-fulltag-fixnum target reg)))
    54135495      (^))))
    54145496
     5497
     5498(pushnew (%nx1-operator typecode) *arm2-operator-supports-u8-target*)
    54155499(defarm2 arm2-typecode typecode (seg vreg xfer node)
    54165500  (if (null vreg)
    54175501    (arm2-form seg vreg xfer node)
    5418     (let* ((reg (arm2-one-untargeted-reg-form seg node (if (eq (hard-regspec-value vreg) arm::arg_z)
    5419                                                          arm::arg_y arm::arg_z))))
     5502    (let* ((reg (arm2-one-untargeted-reg-form seg node arm::arg_z)))
     5503      (unboxed-other-case (vreg :u8)
     5504      (! extract-typecode vreg reg)                         
    54205505      (ensuring-node-target (target vreg)
    5421         (! extract-typecode-fixnum target reg ))
     5506        (! extract-typecode-fixnum target reg )))
    54225507      (^))))
    54235508
     
    58145899        (<- arm::arg_z)
    58155900        (^)))))
    5816      
     5901
     5902;;; If exactly one vinsn references LAB and that vinsn is a conditional
     5903;;; branch, it's a forward branch.  If every vinsn between the branch
     5904;;; and label can be predicated, do so and remove both the branch and
     5905;;; the label.
     5906;;; "predicate" is being used as a verb here - "to make predicated".
     5907(defun arm2-predicate-block (labelnum)
     5908  (let* ((lab (aref *backend-labels* labelnum))
     5909         (refs (vinsn-label-refs lab))
     5910         (branch (car refs)))
     5911    (if (and (vinsn-attribute-p branch :branch)
     5912             (null (cdr refs)))
     5913      (when (do* ((next (dll-node-succ branch) (dll-node-succ next))
     5914                  (vinsn-p nil))
     5915                 ((eq next lab) (return vinsn-p))
     5916              (if (typep next 'vinsn-label)
     5917                (unless (typep (vinsn-label-id next) 'vinsn-note)
     5918                  (return))
     5919                (progn
     5920                  (unless (and (typep next 'vinsn)
     5921                               (null (vinsn-annotation next))
     5922                               (vinsn-attribute-p next :predicatable)
     5923                               (or (eq lab (dll-node-succ next))
     5924                                   (not (vinsn-attribute-p next :jump :call :subprim-call :jumpLR))))
     5925                    (return))
     5926                  (setq vinsn-p t))))
     5927        (multiple-value-bind (branch-true-p branch-condition cond-operand-index)
     5928            (let* ((branch-instr (car (vinsn-template-body (vinsn-template branch))))
     5929                   (values (vinsn-variable-parts branch))
     5930                   (operands (cdr branch-instr)))
     5931              (dolist (op operands (values nil nil nil))
     5932                (cond ((eql (car op) (arm::encode-vinsn-field-type :cond))
     5933                       (return (values t (svref values (cadr op)) (cadr op))))
     5934                      ((eql (car op) (arm::encode-vinsn-field-type :negated-cond))
     5935                       (return (values nil (svref values (cadr op)) (cadr op)))))))
     5936          (when branch-condition
     5937            (let* ((condition (if branch-true-p (logxor 1 branch-condition) branch-condition)))
     5938              (do* ((next (dll-node-succ branch) (dll-node-succ next)))
     5939                   ((eq next lab)
     5940                    (remove-dll-node branch)
     5941                    (remove-dll-node lab)
     5942                    t)
     5943                (cond ((typep next 'vinsn-label))
     5944                      ((vinsn-attribute-p next :jump)
     5945                       (setf (vinsn-template next)
     5946                             (need-vinsn-template 'cbranch-true
     5947                                                  (backend-p2-vinsn-templates
     5948                                                   *target-backend*))
     5949                             (svref (vinsn-variable-parts next) cond-operand-index)
     5950                             condition))
     5951                      (t (setf (vinsn-annotation next) condition)))))))))))
     5952
    58175953
    58185954(defarm2 arm2-if if (seg vreg xfer testform true false &aux test-val)
     
    58375973                                    need-else
    58385974                                    (arm2-single-valued-form-p true)
    5839                                     (arm2-single-valued-form-p false))))
     5975                                    (arm2-single-valued-form-p false)))
     5976           (saved-reg-mask 0)
     5977           (saved-reg-map (make-array 16 :initial-element nil)))
     5978      (declare (dynamic-extent saved-reg-map))
    58405979      (if (eq 0 xfer)
    58415980        (setq xfer nil))
     
    58445983          (let ((merge-else-branch-label (if (nx-null false) (arm2-find-nilret-label))))
    58455984            (arm2-conditional-form seg (arm2-make-compound-cd 0 falselabel) testform)
     5985            (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
     5986                              *arm2-gpr-locations*
     5987                              saved-reg-map)
    58465988            (arm2-form seg result endlabel true)
    58475989            (if (and merge-else-branch-label (neq -1 (aref *backend-labels* merge-else-branch-label)))
     
    58495991              (progn
    58505992                (@ falselabel)
     5993                (arm2-predicate-block falselabel)
    58515994                (if (nx-null false) (@ (arm2-record-nilret-label)))
    5852                 (arm2-form seg result nil false)))
     5995                (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
     5996                       (*arm2-gpr-locations* saved-reg-map))
     5997                  (arm2-form seg result nil false))))
    58535998            (@ endlabel)
     5999            (arm2-predicate-block endlabel)
    58546000            (<- result)
    58556001            (^)))
     
    58656011                  (if true-is-goto 0 falselabel)
    58666012                  (if true-is-goto xfer (arm2-cd-merge xfer falselabel)))))
    5867            testform) 
     6013           testform)
     6014          (arm2-copy-regmap (setq saved-reg-mask *arm2-gpr-locations-valid-mask*)
     6015                            *arm2-gpr-locations*
     6016                            saved-reg-map)
    58686017          (if true-is-goto
    58696018            (arm2-unreachable-store)
     
    58836032              (progn
    58846033                (@ falselabel)
     6034                (arm2-predicate-block falselabel)
    58856035                (when need-else
    58866036                  (if true-cleanup-label
    58876037                    (arm2-mvpass seg false)
    5888                     (arm2-form seg vreg xfer false))
     6038                    (let* ((*arm2-gpr-locations-valid-mask* saved-reg-mask)
     6039                           (*arm2-gpr-locations* saved-reg-map))
     6040                      (arm2-form seg vreg xfer false)))
    58896041                  (setq false-stack (arm2-encode-stack))))))
    58906042          (when true-cleanup-label
     
    59046056            (multiple-value-setq (*arm2-undo-count* *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*)
    59056057              (arm2-decode-stack entry-stack)))
    5906           (@ endlabel))))))
     6058          (@ endlabel)
     6059          (arm2-predicate-block endlabel))))))
    59076060
    59086061(defarm2 arm2-or or (seg vreg xfer forms)
Note: See TracChangeset for help on using the changeset viewer.