Changeset 16275


Ignore:
Timestamp:
Oct 3, 2014, 1:24:35 AM (7 years ago)
Author:
gb
Message:

Uh, checkpoint THIS.

Location:
branches/pinsn/source/compiler
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/pinsn/source/compiler/ARM/arm-arch.lisp

    r16100 r16275  
    12521252                            :fulltag-misc fulltag-misc
    12531253                            :char-code-limit #x110000
     1254                            :reg-pseudo-types '((:signed . :s32)
     1255                                                (:signed-natural . :s32)
     1256                                                (:unsigned . :u32)
     1257                                                (:unsigned-natural . :u32)
     1258                                                (:scaled-8-bit-index . :s32)
     1259                                                (:scaled-16-bit-index . :s32)
     1260                                                (:scaled-32-bit-index . :s32)
     1261                                                (:scaled-32-bit-index . :lisp)
     1262                                                (:scaled-128-bit-index . :lisp)
     1263                                                (:unboxed-fixnum . :s32))
    12541264                            )))
     1265
    12551266
    12561267;;; arch macros
  • branches/pinsn/source/compiler/ARM/arm-vinsns.lisp

    r16195 r16275  
    4040  (:code))
    4141
     42(define-arm-vinsn noop (()
     43                        ((reg :gpr)))
     44  )
    4245
    4346;;; Index "scaling" and constant-offset misc-ref vinsns.
  • branches/pinsn/source/compiler/ARM/arm2.lisp

    r16195 r16275  
    195195            (unless (and (eql vreg-class hard-reg-class-gpr)
    196196                         (eql vreg-mode hard-reg-class-gpr-mode-u32))
    197               (setq reg (available-imm-temp
    198                          *available-backend-imm-temps*
    199                          :u32)))
     197              (setq reg (? :mode :u32))
    200198            (setq vinsn
    201199                  (if nested
     
    205203            (unless (and (eql vreg-class hard-reg-class-fpr)
    206204                         (eql vreg-mode hard-reg-class-fpr-mode-double))
    207               (setq reg (available-fp-temp
    208                          *available-backend-fp-temps*
    209                          :double-float)))
     205              (setq reg (? :class :fpr :mode :double-float)))
    210206            (setq vinsn
    211207                  (if nested
     
    215211            (unless (and (eql vreg-class hard-reg-class-fpr)
    216212                         (eql vreg-mode hard-reg-class-fpr-mode-single))
    217               (setq reg (available-fp-temp
    218                          *available-backend-fp-temps*
    219                          :single-float)))
     213              (setq reg (? :class :fpr :mode :single-float)))
    220214            (setq vinsn
    221215                  (if nested
     
    225219            (unless (and (eql vreg-class hard-reg-class-fpr)
    226220                         (eql vreg-mode hard-reg-class-fpr-mode-complex-double-float))
    227               (setq reg (available-fp-temp
    228                          *available-backend-fp-temps*
    229                          :complex-double-float)))
     221              (setq reg (? :class :fpr :mode :complex-double-float)))
    230222            (setq vinsn
    231223                  (if nested
     
    235227            (unless (and (eql vreg-class hard-reg-class-fpr)
    236228                         (eql vreg-mode hard-reg-class-fpr-mode-complex-single-float))
    237               (setq reg (available-fp-temp
    238                          *available-backend-fp-temps*
    239                          :complex-single-float)))
     229              (setq reg (? :class :fpr :mode :complex-single-float)))
    240230            (setq vinsn
    241231                  (if nested
     
    328318                    NIL
    329319                    (not (subtypep type '(signed-byte 30))))
    330                (setq reg (available-imm-temp
    331                           *available-backend-imm-temps* :u32)
     320               (setq reg (? :mode :natural)
    332321                     nfp-bits memspec-nfp-type-natural))
    333322              ((subtypep type 'single-float)
    334                (setq reg (available-fp-temp *available-backend-fp-temps*
    335                                             :single-float)
     323               (setq reg (? :class :fpr :mode :single-float)
    336324                     nfp-bits memspec-nfp-type-single-float))
    337325              ((subtypep type 'double-float)
    338                (setq reg (available-fp-temp *available-backend-fp-temps*
    339                                             :double-float)
     326               (setq reg (? :class :fpr :mode :double-float)
    340327                     nfp-bits memspec-nfp-type-double-float))
    341328              ((subtypep type 'complex-single-float)
    342                (setq reg (available-fp-temp *available-backend-fp-temps*
    343                                             :complex-single-float)
     329               (setq reg (? :class :fpr :mode :complex-single-float)
    344330                     nfp-bits memspec-nfp-type-complex-single-float))
    345331              ((subtypep type 'complex-douuble-float)
    346                (setq reg (available-fp-temp *available-backend-fp-temps*
    347                                             :complex-double-float)
     332               (setq reg (? :class :fpr :mode :complex-double-float)
    348333                     nfp-bits memspec-nfp-type-complex-double-float)))
    349334        (when reg
    350335          (let* ((vinsn (arm2-push-register
    351336                         seg
    352                          (arm2-one-untargeted-reg-form seg initform reg))))
     337                         (p2-form seg initform reg))))
    353338            (when vinsn
    354339              (push (cons vinsn var) *arm2-nfp-vars*)
     
    390375  (with-arm2-local-pinsn-macros (seg vreg)
    391376    (cond ((typep ea 'lreg)
    392             (arm2-copy-register seg ea valreg))
    393           ((addrspec-vcell-p ea)     ; closed-over vcell
    394            (arm2-copy-register seg arm::arg_z valreg)
    395            (arm2-stack-to-register seg ea arm::arg_x)
    396            (arm2-lri seg arm::arg_y 0)
    397            (! call-subprim-3 arm::arg_z (arm::arm-subprimitive-offset  '.SPgvset) arm::arg_x arm::arg_y arm::arg_z)
    398            (setq valreg arm::arg_z))
    399           ((memory-spec-p ea)    ; vstack slot or fp offset
     377           (arm2-copy-register seg ea valreg))
     378          ((addrspec-vcell-p ea)        ; closed-over vcell
     379           (let* ((vector ($ arm::arg_x))
     380                  (index ($ arm::arg_y))
     381                  (value ($ arm::arg_z)))
     382             (arm2-copy-register seg value valreg)
     383             (arm2-stack-to-register seg ea vector)
     384             (arm2-lri seg index 0)
     385             (! call-subprim-3 arm::arg_z (arm::arm-subprimitive-offset  '.SPgvset) vector index value)
     386             (setq valreg value)))
     387          ((memory-spec-p ea)           ; vstack slot or fp offset
    400388           (arm2-register-to-stack seg valreg ea))
    401389          (t
     
    550538          *backend-immediates* 0)))
    551539
    552        (let* ((seg (p2-init-block)))
     540       (let* ((seg (p2-init-block))
     541              (*p2-specials* *arm2-specials*))
    553542        (unwind-protect
    554543             (progn
     
    819808  (with-arm2-local-pinsn-macros (seg)
    820809    (let* ((no-overflow (p2-get-next-label seg))
    821            (label (if labelno (aref *backend-labels* labelno))))
    822       (! cbranch-false (or label (aref *backend-labels* no-overflow)) crf arm::arm-cond-vs)
     810           (label (if labelno (p2-block-for-label seg labelno))))
     811      (! cbranch-false (or label (p2-block-for-label seg no-overflow)) crf arm::arm-cond-vs)
    823812      (if *arm2-open-code-inline*
    824813        (! handle-fixnum-overflow-inline target target)
     
    11951184         (arm-with-note-body (gensym "ARM-WITH-NOTE-BODY")))
    11961185    `(flet ((,arm-with-note-body (,form-var ,seg-var ,@other-vars) ,@body))
    1197        (let ((,note (acode-note ,form-var)))
    1198          (if ,note
    1199            (let* ((,code-note (and ,note (code-note-p ,note) ,note))
    1200                   (,source-note (if ,code-note
    1201                                   (code-note-source-note ,note)
    1202                                   ,note))
    1203                   (,start (and ,source-note
    1204                                (enqueue-vinsn-note ,seg-var :source-location-begin ,source-note))))
    1205              (prog2
    1206                  (when ,code-note
    1207                    (with-arm2-local-pinsn-macros (,seg-var)
    1208                      (arm2-store-immediate ,seg-var ,code-note arm::temp0)
    1209                      (with-node-temps (arm::temp0) (zero)
    1210                        (! lri zero 0)
    1211                        (! misc-set-c-node ($ zero) ($ arm::temp0) 1))))
    1212                  (,arm-with-note-body ,form-var ,seg-var ,@other-vars)
    1213                (when ,source-note
    1214                  (close-vinsn-note ,seg-var ,start))))
    1215            (,arm-with-note-body ,form-var ,seg-var ,@other-vars))))))
     1186      (let ((,note (acode-note ,form-var)))
     1187        (if ,note
     1188          (let* ((,code-note (and ,note (code-note-p ,note) ,note))
     1189                 (,source-note (if ,code-note
     1190                                 (code-note-source-note ,note)
     1191                                 ,note))
     1192                 (,start (and ,source-note
     1193                              (enqueue-vinsn-note ,seg-var :source-location-begin ,source-note))))
     1194            (prog2
     1195                (when ,code-note
     1196                  (with-arm2-local-pinsn-macros (,seg-var)
     1197                    (let* ((temp0 ($ arm::temp0))
     1198                           (zero (?)))
     1199                      (arm2-store-immediate ,seg-var ,code-note temp0)
     1200                      (! lri zero 0)
     1201                      (! misc-set-c-node zero temp0 1))))
     1202                (,arm-with-note-body ,form-var ,seg-var ,@other-vars)
     1203              (when ,source-note
     1204                (close-vinsn-note ,seg-var ,start))))
     1205          (,arm-with-note-body ,form-var ,seg-var ,@other-vars))))))
    12161206
    12171207(defun arm2-toplevel-form (seg vreg xfer form)
     
    13731363    (let* ((offset (memspec-frame-address-offset memspec)))
    13741364      (if (eql (hard-regspec-class reg) hard-reg-class-fpr)
    1375         (with-node-target () temp
     1365        (let* ((temp (?)))
    13761366          (arm2-stack-to-register seg memspec temp)
    13771367          (arm2-copy-register seg reg temp))
     
    18741864           (unscaled-j ($ arm::arg_y))
    18751865           (val-reg ($ arm::arg_z)))
    1876       (arm2-four-targeted-reg-forms seg
    1877                                     array src
    1878                                     i unscaled-i
    1879                                     j unscaled-j
    1880                                     new val-reg)
     1866      (p2-four-reg-forms seg
     1867                         array src
     1868                         i unscaled-i
     1869                         j unscaled-j
     1870                         new val-reg)
    18811871      (when safe
    18821872        (when (typep safe 'fixnum)
    1883           (with-node-target (src unscaled-i unscaled-j val-reg) expected
     1873          (let* ((expected (?)))
    18841874            (if simple
    18851875              (progn
     
    18941884        (unless j-known-fixnum
    18951885          (arm2-trap-unless-fixnum seg unscaled-j)))
    1896       (with-imm-target () dim1
     1886      (let* ((dim1 (? :mode :u32)))
    18971887        (let* ((idx-reg ($ arm::arg_y)))
    18981888          (progn
     
    19011891              (! 2d-dim1 dim1 src))
    19021892            (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
    1903           (let* ((v ($ arm::arg_x)))
     1893          (let* ((v src))
    19041894            (if simple
    19051895              (! array-data-vector-ref v src)
    19061896              (progn
    1907                 (arm2-copy-register seg v src)
    1908                 (! deref-vector-header v idx-reg)))
     1897                (! deref-vector-header v idx-reg v idx-reg)))
    19091898            (arm2-vset1 seg vreg xfer type-keyword v idx-reg nil val-reg (arm2-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval t)))))))
    19101899     
     
    19291918                     (+ (* i-known-fixnum dim1) j-known-fixnum)))
    19301919               (val-reg (arm2-target-reg-for-aset vreg type-keyword))
    1931                (node-val (if (node-reg-p val-reg) val-reg))
    19321920               (imm-val (if (imm-reg-p val-reg) val-reg)))
    1933           (with-node-target (node-val) src
    1934             (with-node-target (node-val src) unscaled-i
    1935               (with-node-target (node-val src unscaled-i) unscaled-j
     1921          (let*  ((src (?)))
     1922            (let* (( unscaled-i (?)))
     1923              (let* (( unscaled-j (?)))
    19361924                (if constidx
    19371925                  (multiple-value-setq (src val-reg)
    19381926                    (arm2-two-untargeted-reg-forms seg array ($ arm::temp0) new val-reg))
    19391927                  (multiple-value-setq (src unscaled-i unscaled-j val-reg)
    1940                     (arm2-four-untargeted-reg-forms seg
     1928                    (p2-four-reg-forms seg
    19411929                                                    array src
    19421930                                                    i unscaled-i
    19431931                                                    j unscaled-j
    19441932                                                    new val-reg)))
    1945                 (if (node-reg-p val-reg) (setq node-val val-reg))
    19461933                (if (imm-reg-p val-reg) (setq imm-val val-reg))
    19471934                (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     
    19531940                  (when safe     
    19541941                    (when (typep safe 'fixnum)
    1955                       (with-node-target (src node-val unscaled-i unscaled-j) expected
     1942                      (let* (( expected (?)))
    19561943                        (if simple
    19571944                          (progn
     
    19671954                      (arm2-trap-unless-fixnum seg unscaled-j)))
    19681955                  (with-imm-target (imm-val) dim1
    1969                     (with-node-target (src node-val) idx-reg
     1956                    (let* (( idx-reg (?)))
    19701957                      (unless constidx
    19711958                        (if safe                 
     
    19731960                          (! 2d-dim1 dim1 src))
    19741961                        (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
    1975                       (with-node-target (idx-reg node-val) v
     1962                      (let* (( v (?)))
    19761963                        (if safe
    19771964                          (! array-data-vector-ref v src)
     
    20382025                (let* ((expected (if constidx
    20392026                                   
    2040                                    (with-node-target (src val-reg) expected
     2027                                   (let* (( expected (?)))
    20412028                                     expected)
    2042                                    (with-node-target (src unscaled-i unscaled-j unscaled-k val-reg) expected
     2029                                   (let* (( expected (?)))
    20432030                                     expected))))
    20442031                  (! lri expected (ash (dpb safe target::arrayH.flags-cell-subtag-byte
     
    21022089              (setq *available-backend-node-temps* (logandc2 *available-backend-node-temps*
    21032090                                                             (ash 1 (hard-regspec-value unscaled-j)))))
    2104             (with-node-target (src) expected
     2091            (let* (( expected (?)))
    21052092              (if simple
    21062093                (progn
     
    21142101        (unless j-known-fixnum
    21152102          (arm2-trap-unless-fixnum seg unscaled-j)))
    2116       (with-node-target (src) idx-reg
     2103      (let* (( idx-reg (?)))
    21172104        (with-imm-target () dim1
    21182105          (unless constidx
     
    21212108              (! 2d-dim1 dim1 src))
    21222109            (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j))
    2123           (with-node-target (idx-reg src) v
     2110          (let* (( v (?)))
    21242111            (if simple
    21252112              (! array-data-vector-ref v src)
     
    21562143        (multiple-value-setq (src unscaled-i unscaled-j unscaled-k)
    21572144          (arm2-four-untargeted-reg-forms seg
    2158                                            array arm::temp0
    2159                                            i arm::arg_x
    2160                                            j arm::arg_y
    2161                                            k arm::arg_z)))
     2145                                           array (?)
     2146                                           i (?)
     2147                                           j (?)
     2148                                           k (?))))
    21622149      (when safe       
    21632150        (when (typep safe 'fixnum)
    21642151          (if simple
    2165             (let* ((expected (if constidx
    2166                                (with-node-target (src) expected
    2167                                  expected)
    2168                                (with-node-target (src unscaled-i unscaled-j unscaled-k) expected
    2169                                  expected))))
     2152            (let* ((expected (?)))
    21702153              (! lri expected (ash (dpb safe target::arrayH.flags-cell-subtag-byte
    21712154                                        (ash 1 $arh_simple_bit))
     
    21792162        (unless k-known-fixnum
    21802163          (arm2-trap-unless-fixnum seg unscaled-k)))
    2181       (with-node-target (src) idx-reg
     2164      (let* (( idx-reg (?)))
    21822165        (with-imm-target () dim1
    21832166          (with-imm-target (dim1) dim2
     
    21872170                (! 3d-dims dim1 dim2 src))
    21882171              (! 3d-unscaled-index idx-reg dim1 dim2 unscaled-i unscaled-j unscaled-k))))
    2189         (with-node-target (idx-reg) v
     2172        (let* (( v (?)))
    21902173          (if simple
    21912174            (! array-data-vector-ref v src)
     
    25652548      (let* ((ccreg ($ arm::temp0)))
    25662549        (arm2-store-immediate seg note ccreg)
    2567         (with-node-temps (ccreg) (zero)
     2550        (let* ((zero (?)))
    25682551          (! lri zero 0)
    25692552          (! misc-set-c-node zero ccreg 1))))))
     
    28712854                (progn
    28722855                  (arm2-copy-register seg ($ arm::nfn) ($  arm::fn))
    2873                   (! call-label (aref *backend-labels* label)))
     2856                  (! call-label (p2-block-for-label seg label)))
    28742857                (progn
    28752858                  (if a-reg
     
    28902873                  (arm2-restore-full-lisp-context seg))
    28912874                (if label-p
    2892                   (! jump (aref *backend-labels* label))
     2875                  (! jump (p2-block-for-label seg label))
    28932876                  (progn
    28942877                    (if symp
     
    40774060               (arm::encode-arm-immediate (- zero)))
    40784061         (! compare-immediate dest reg zero)
    4079          (with-node-target (reg) other
     4062         (let* (( other (?)))
    40804063           (arm2-lri seg other zero)
    40814064           (! compare dest reg other)))
     
    40854068               (arm::encode-arm-immediate (- zero)))
    40864069         (! compare-immediate crf reg (logand #xffffffff zero))
    4087          (with-node-target (reg) other
     4070         (let* (( other (?)))
    40884071           (arm2-lri seg other zero)
    40894072           (! compare crf reg other)))
     
    44004383                           (arm2-two-targeted-reg-forms seg (car operands) rval clear-form rclear)
    44014384                           (! compare-to-nil crf rclear)
    4402                            (! cbranch-false (aref *backend-labels* stack-block-0-label) crf arm::arm-cond-eq)
     4385                           (! cbranch-false (p2-block-for-label seg stack-block-0-label) crf arm::arm-cond-eq)
    44034386                           (! make-stack-block)
    44044387                           (-> done-label)
     
    50024985          (if *arm2-open-code-inline*
    50034986            (ensuring-node-target (target vreg)
    5004               (with-node-target (target) src
     4987              (let* (( src (?)))
    50054988                (let* ((vcell (arm2-symbol-value-cell sym))
    50064989                       (reg (arm2-register-constant-p vcell)))
     
    52125195                   (nn0 (neq 0 nbranch))
    52135196                   (nnret (neq $backend-return nbranch))
    5214                    (tlabel (if (and tnret tn0) (aref *backend-labels* tbranch)))
    5215                    (nlabel (if (and nnret nn0) (aref *backend-labels* nbranch))))
     5197                   (tlabel (if (and tnret tn0) (p2-block-for-label seg tbranch)))
     5198                   (nlabel (if (and nnret nn0) (p2-block-for-label seg nbranch))))
    52165199              (unless cr-bit (setq cr-bit arm::arm-cond-eq))
    52175200              (if (and tn0 tnret nn0 nnret)
     
    52245207                    (! cbranch-true tlabel crf cr-bit))
    52255208                  (let* ((aux-label (p2-get-next-label seg))
    5226                          (auxl (aref *backend-labels* aux-label)))
     5209                         (auxl (p2-block-for-label seg aux-label)))
    52275210                    (if tn0
    52285211                      (! cbranch-true auxl crf cr-bit)
     
    55585541
    55595542
    5560 (defun arm2-expand-vinsns (header current &optional sections)
     5543(defun arm2-expand-pinsns (header current &optional sections)
    55615544  (declare (ignorable sections))
    5562   (do-dll-nodes (v header)
    5563     (if (%vinsn-label-p v)
    5564       (let* ((id (vinsn-label-id v)))
    5565         (if (or (typep id 'fixnum) (null id))
    5566           (when (or t (vinsn-label-refs v) (null id))
    5567             (setf (vinsn-label-info v) (arm::emit-lap-label current v)))))
    5568       (arm2-expand-vinsn v current sections)))
    5569   ;;; This doesn't have too much to do with anything else that's
    5570   ;;; going on here, but it needs to happen before the lregs
    5571   ;;; are freed.  There really shouldn't be such a thing as a
    5572   ;;; var-ea, of course ...
    5573   (dolist (s *arm2-recorded-symbols*)
    5574     (let* ((var (car s))
    5575            (ea (var-ea var)))
    5576       (when (typep ea 'lreg)
    5577         (setf (var-ea var) (lreg-value ea)))))
    5578   (free-logical-registers))
     5545  (do-dll-nodes (block (block-list-blocks header))
     5546    (setf (p2-block-info block) (arm::emit-lap-label current block))
     5547    (do-dll-nodes (pinsn (p2-block-pinsns block))
     5548      (arm2-expand-pinsn pinsn current sections))))
    55795549
    55805550;;; It's not clear whether or not predicates, etc. want to look
     
    55865556;;; on entry, but it might be reasonable to make PARSE-OPERAND-FORM
    55875557;;; deal with lregs ...
    5588 (defun arm2-expand-vinsn (vinsn current &optional sections)
     5558(defun arm2-expand-pinsn (pinsn current &optional sections)
    55895559  (declare (ignorable sections))
    5590   (let* ((template (vinsn-template vinsn))
     5560  (let* ((template (pinsn-template pinsn))
    55915561         (code (svref sections 0))
    55925562         (data (svref sections 1))
    5593          (vp (vinsn-variable-parts vinsn))
    5594          (nvp (vinsn-template-nvp template))
    5595          (predicate (getf (vinsn-annotation vinsn) :predicate))
     5563         (vp (pinsn-values pinsn))
     5564         (nvp (pinsn-template-nval template))
     5565         (predicate (getf (pinsn-annotation pinsn) :predicate))
    55965566         (unique-labels ())
    5597          (notes (vinsn-notes vinsn))
     5567         (notes (pinsn-notes pinsn))
    55985568         (operand-insert-functions arm::*arm-vinsn-insert-functions*))
    55995569    (declare (fixnum nvp))
     
    56025572        (when (typep val 'lreg)
    56035573          (setf (svref vp i) (lreg-value val)))))                       
    5604     (dolist (name (vinsn-template-local-labels template))
     5574    (dolist (name (pinsn-template-local-labels template))
    56055575      (let* ((unique (cons name nil)))
    56065576        (push unique unique-labels)
     
    56105580               (cond ((typep valform 'keyword)
    56115581                      (or (assq valform unique-labels)
    5612                           (compiler-bug "unknown vinsn label ~s" valform)))
     5582                          (compiler-bug "unknown pinsn label ~s" valform)))
    56135583                     ((atom valform) valform)
    56145584                     ((and (atom (cdr valform))
     
    56875657                 (arm::emit-lap-label current (assq f unique-labels))
    56885658                 (if (atom f)
    5689                    (compiler-bug "Invalid form in vinsn body: ~s" f)
     5659                   (compiler-bug "Invalid form in pinsn body: ~s" f)
    56905660                   (if (or (atom (car f))
    56915661                           (typep (caar f) 'fixnum))
     
    56955665                         (expand-form subform))))))))
    56965666      (declare (dynamic-extent #'expand-form #'parse-operand-form #'expand-insn-form #'eval-predicate))
    5697                                         ;(format t "~& vinsn = ~s" vinsn)
     5667                                        ;(format t "~& pinsn = ~s" pinsn)
    56985668      (when notes
    56995669        (let* ((lab ()))
    57005670          (dolist (note notes)
    5701             (unless (eq :close (vinsn-note-class note))
     5671            (unless (eq :close (pinsn-note-class note))
    57025672              (when (eq :source-location-begin
    5703                         (vinsn-note-class note))
     5673                        (pinsn-note-class note))
    57045674                (push note *arm2-emitted-source-notes*))
    57055675              (when (null lab)
    57065676                (setq lab (arm::make-lap-label note))
    57075677                (arm::emit-lap-label current note))
    5708               (setf (vinsn-note-address note) lab)))))
    5709       (dolist (form (vinsn-template-body template))
     5678              (setf (pinsn-note-address note) lab)))))
     5679      (dolist (form (pinsn-template-body template))
    57105680        (expand-form form ))
    57115681      (when notes
    57125682        (let* ((lab ()))
    57135683          (dolist (note notes)
    5714             (when (eq :close (vinsn-note-class note))
     5684            (when (eq :close (pinsn-note-class note))
    57155685              (when (null lab)
    57165686                (setq lab (arm::make-lap-label note))
    57175687                (arm::emit-lap-label current note))
    5718               (setf (vinsn-note-address note) lab)))))
    5719       (setf (vinsn-variable-parts vinsn) nil)
    5720       (when vp
    5721         (free-varparts-vector vp))))
     5688              (setf (pinsn-note-address note) lab)))))))
    57225689  current)
    57235690
     
    65696536          (if otherform
    65706537            (unless (acode-fixnum-form-p otherform)
    6571               (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line)))
     6538              (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line)))
    65726539            (if (acode-fixnum-form-p form1)
    6573               (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line))
     6540              (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line))
    65746541              (if (acode-fixnum-form-p form2)
    6575                 (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (aref *backend-labels* out-of-line)) 
    6576                 (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line)))))
     6542                (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (p2-block-for-label seg out-of-line)) 
     6543                (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (p2-block-for-label seg out-of-line)))))
    65776544          (with-crf-target () crf
    65786545                           (if otherform
     
    67966763;;; "predicate" is being used as a verb here - "to make predicated".
    67976764(defun arm2-predicate-block (labelnum)
    6798   (let* ((lab (aref *backend-labels* labelnum))
     6765  (let* ((lab (p2-block-for-label seg labelnum))
    67996766         (refs (vinsn-label-refs lab))
    68006767         (branch (car refs)))
     
    68836850                    (with-imm-target () (idx :u32)
    68846851                      (with-crf-target () flags
    6885                         (arm2-branch-unless-arg-fixnum seg reg (aref *backend-labels* defaultlabel))
     6852                        (arm2-branch-unless-arg-fixnum seg reg (p2-block-for-label seg defaultlabel))
    68866853                        (! set-carry-if-fixnum-in-range idx flags reg min span)
    6887                         (! cbranch-false (aref *backend-labels* defaultlabel) flags arm::arm-cond-lo)
     6854                        (! cbranch-false (p2-block-for-label seg defaultlabel) flags arm::arm-cond-lo)
    68886855                        (unless single-clause
    68896856                          (! ijmp idx)
     
    68926859                            (declare (fixnum val))
    68936860                            (let* ((info (assoc val all)))
    6894                               (! non-barrier-jump (aref *backend-labels* (if info (cadr info) defaultlabel)))))))
     6861                              (! non-barrier-jump (p2-block-for-label seg (if info (cadr info) defaultlabel)))))))
    68956862                      (! unlock-constant-pool)
    68966863                      (let* ((target (if (arm2-mvpass-p xfer)
     
    70076974                (if false-is-goto (arm2-unreachable-store))
    70086975                (progn
    7009                   (if (and (not need-else) nil)
    7010                     (@+ falselabel)
    7011                     (@ falselabel))
     6976                  (@ falselabel)
    70126977                  (arm2-predicate-block falselabel)
    70136978                  (when need-else
     
    70367001                  (multiple-value-setq (*arm2-undo-count* *arm2-cstack* *arm2-vstack*)
    70377002                    (arm2-decode-stack entry-stack)))
    7038                 (if (and (not need-else) (backend-crf-p vreg) nil)
    7039                   (@+ endlabel)
    7040                   (@ endlabel))
     7003                (@ endlabel)
    70417004                (arm2-predicate-block endlabel))))))))
    70427005
     
    71337096      (ensuring-node-target (target vreg)
    71347097        (if (acode-fixnum-form-p form1)
    7135           (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line))
     7098          (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line))
    71367099          (if (acode-fixnum-form-p form2)
    7137             (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (aref *backend-labels* out-of-line)) 
    7138             (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line))))
     7100            (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (p2-block-for-label seg out-of-line)) 
     7101            (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (p2-block-for-label seg out-of-line))))
    71397102        (with-crf-target () flags
    71407103          (! fixnum-add-set-flags ($ arm::arg_z) flags ($ arm::arg_y) ($ arm::arg_z))
     
    71537116      (ensuring-node-target (target vreg)
    71547117        (if (acode-fixnum-form-p form1)
    7155           (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line))
     7118          (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line))
    71567119          (if (acode-fixnum-form-p form2)
    7157             (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (aref *backend-labels* out-of-line)) 
    7158             (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line))))
     7120            (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (p2-block-for-label seg out-of-line)) 
     7121            (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (p2-block-for-label seg out-of-line))))
    71597122        (with-crf-target () flags
    71607123          (! fixnum-sub-set-flags ($ arm::arg_z) flags ($ arm::arg_y) ($ arm::arg_z))
     
    72197182            (if otherform
    72207183              (unless (acode-fixnum-form-p otherform)
    7221                 (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line)))
     7184                (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line)))
    72227185              (if (acode-fixnum-form-p form1)
    7223                 (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line))
     7186                (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line))
    72247187                (if (acode-fixnum-form-p form2)
    7225                   (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (aref *backend-labels* out-of-line)) 
    7226                   (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line)))))
     7188                  (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (p2-block-for-label seg out-of-line)) 
     7189                  (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (p2-block-for-label seg out-of-line)))))
    72277190            (if otherform
    72287191              (! logior-immediate ($ arm::arg_z) ($ arm::arg_z) (logand #xffffffff unboxed-fixval))
     
    72667229            (if otherform
    72677230              (unless (acode-fixnum-form-p otherform)
    7268                 (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line)))
     7231                (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line)))
    72697232              (if (acode-fixnum-form-p form1)
    7270                 (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (aref *backend-labels* out-of-line))
     7233                (arm2-branch-unless-arg-fixnum seg ($ arm::arg_z) (p2-block-for-label seg out-of-line))
    72717234                (if (acode-fixnum-form-p form2)
    7272                   (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (aref *backend-labels* out-of-line)) 
    7273                   (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* out-of-line)))))
     7235                  (arm2-branch-unless-arg-fixnum seg ($ arm::arg_y) (p2-block-for-label seg out-of-line)) 
     7236                  (arm2-branch-unless-both-args-fixnums seg ($ arm::arg_y) ($ arm::arg_z) (p2-block-for-label seg out-of-line)))))
    72747237            (if otherform
    72757238              (! logand-immediate ($ arm::arg_z) ($ arm::arg_z) (logand #xffffffff unboxed-fixval))
     
    77747737                   (! mem-ref-c-single-float fp-reg ptrreg fixoffset)))
    77757738               (with-imm-target () (ptrreg :address)
    7776                  (with-node-target (ptrreg) offsetreg
     7739                 (let* (( offsetreg (?)))
    77777740                   (multiple-value-setq (ptrreg offsetreg)
    77787741                     (arm2-two-untargeted-reg-forms seg
     
    83038266      (! mkcatchmv)
    83048267      (! mkcatch1v))
    8305     (! non-barrier-jump (aref *backend-labels* tag-label))
     8268    (! non-barrier-jump (p2-block-for-label seg tag-label))
    83068269    (! unlock-constant-pool)
    83078270    (arm2-open-undo)
     
    86208583      (with-node-temps (vreg symreg) (val)
    86218584        (! symbol-function val symreg)
     8585        (! noop symreg)
    86228586        (<- val))))
    86238587  (^))
     
    89148878               (! compare-to-nil crf ($ arm::arg_z))
    89158879               (arm2-vpop-register seg ($ arm::arg_y))
    8916                (! cbranch-false (aref *backend-labels* ok) crf arm::arm-cond-eq))
     8880               (! cbranch-false (p2-block-for-label seg ok) crf arm::arm-cond-eq))
    89178881            (arm2-lri seg ($ arm::arg_x) (ash $XWRONGTYPE *arm2-target-fixnum-shift*))
    89188882            (arm2-store-immediate seg typespec ($ arm::arg_z))
     
    90108974    (arm2-open-undo $undointerruptlevel)
    90118975    (arm2-adjust-vstack (* 3 *arm2-target-node-size*))   
    9012     (! non-barrier-jump (aref *backend-labels* cleanup-label))
     8976    (! non-barrier-jump (p2-block-for-label seg cleanup-label))
    90138977    (-> protform-label)
    90148978    (! unlock-constant-pool)
     
    90399003    (! progvsave)                       ;creates an unwind-protect
    90409004    (arm2-open-undo $undostkblk)
    9041     (! non-barrier-jump (aref *backend-labels* cleanup-label))
     9005    (! non-barrier-jump (p2-block-for-label seg cleanup-label))
    90429006    (-> protform-label)
    90439007    (! unlock-constant-pool)
     
    94039367        (arm2-natural-constant seg vreg xfer (+ fix-x fix-y))
    94049368        (let* ((u15x (and (typep fix-x '(unsigned-byte 15)) fix-x))
    9405                (u15y (and (typep fix-y '(unsigned-byte 15)) fix-y)))
     9369               (u15y (and (typep fix-y '(unsigned-byte 15)) fix-y))
     9370               (xreg (? :mode :natural))
     9371               (yreg (? :mode :natural))
     9372               (zreg (? :mode :natural)))
    94069373          (if (not (or u15x u15y))
    9407             (with-imm-target () (xreg :natural)
    9408               (with-imm-target (xreg) (yreg :natural)
    9409                 (arm2-two-targeted-reg-forms seg x xreg y yreg)
    9410                 (! %natural+ xreg xreg yreg))
    9411               (<- xreg))
     9374            (progn
     9375              (multiple-value-setq (xreg yreg)
     9376                (p2-two-reg-forms seg x xreg y yreg))
     9377              (! %natural+ zreg xreg yreg)
     9378              (<- zreg))
    94129379            (let* ((other (if u15x y x)))
    94139380              (with-imm-target () (other-reg :natural)
     
    94529419                           (when c
    94539420                             (if (arm::encode-arm-immediate c)
    9454                                c)))))
     9421                               c))))
     9422               (xreg (? :mode :natural))
     9423               (yreg (? :mode :natural))
     9424               (zreg (? :mode :natural)))
    94559425          (if (not constant)
    9456             (with-imm-target () (xreg :natural)
    9457               (with-imm-target (xreg) (yreg :natural)
    9458                 (arm2-two-targeted-reg-forms seg x xreg y yreg)
    9459                 (! %natural-logior xreg xreg yreg))
    9460               (<- xreg))
     9426            (progn             
     9427              (multiple-value-setq (xreg yreg)
     9428                (p2-two-reg-forms seg x xreg y yreg))
     9429              (! %natural-logior zreg xreg yreg)
     9430              (<- zreg))
    94619431            (let* ((other (if naturalx y x)))
    9462               (with-imm-target () (other-reg :natural)
    9463                 (arm2-one-targeted-reg-form seg other other-reg)
    9464                 (! logior-immediate other-reg other-reg (logand constant #xffffffff))
    9465                 (<- other-reg))))
     9432              (setq xreg (p2-form seg xreg nil other))
     9433              (! logior-immediate zreg xreg (logand constant #xffffffff))
     9434              (<- zreg)))
    94669435          (^))))))
    94679436
     
    94789447                           (when c
    94799448                             (if (arm::encode-arm-immediate c)
    9480                                c)))))
     9449                               c))))
     9450               (xreg (? :mode :natural))
     9451               (yreg (? :mode :natural))
     9452               (zreg (? :mode :natural)))
    94819453          (if (not constant)
    9482             (with-imm-target () (xreg :natural)
    9483               (with-imm-target (xreg) (yreg :natural)
    9484                 (arm2-two-targeted-reg-forms seg x xreg y yreg)
    9485                 (! %natural-logxor xreg xreg yreg))
    9486               (<- xreg))
     9454            (progn             
     9455              (multiple-value-setq (xreg yreg)
     9456                (p2-two-reg-forms seg x xreg y yreg))
     9457              (! %natural-logxor zreg xreg yreg)
     9458              (<- zreg))
    94879459            (let* ((other (if naturalx y x)))
    9488               (with-imm-target () (other-reg :natural)
    9489                 (arm2-one-targeted-reg-form seg other other-reg)
    9490                 (! logxor-immediate other-reg other-reg (logand constant #xffffffff))
    9491                 (<- other-reg))))
     9460              (setq xreg (p2-form seg xreg nil other))
     9461              (! logxor-immediate zreg xreg (logand constant #xffffffff))
     9462              (<- zreg)))
    94929463          (^))))))
    94939464
     
    95079478                               c)))))
    95089479          (if (not constant)
    9509             (with-imm-target () (xreg :natural)
    9510               (with-imm-target (xreg) (yreg :natural)
    9511                 (arm2-two-targeted-reg-forms seg x xreg y yreg)
    9512                 (! %natural-logand xreg xreg yreg))
    9513               (<- xreg))
     9480            (let* ((zreg (? :mode :natural)))
     9481              (multiple-value-bind (xreg yreg)
     9482                  (p2-two-reg-forms seg x (? :mode :natural)
     9483                                    y (? :mode :natural))
     9484                                           
     9485                (! %natural-logand zreg xreg yreg))
     9486              (<- zreg))
    95149487            (let* ((other (if naturalx y x)))
    9515               (with-imm-target () (other-reg :natural)
    9516                 (arm2-one-targeted-reg-form seg other other-reg)
    9517                 (! logand-immediate other-reg other-reg (logand constant #xffffffff))
     9488              (let* ((other-reg (p2-form seg (? :mode :natural) nil other))
     9489                     (zreg (? :mode :natural)))
     9490                (! logand-immediate zreg other-reg (logand constant #xffffffff))
    95189491                (if (and (typep constant '(unsigned-byte 29))
    95199492                         (node-reg-p vreg))
    9520                   (! box-fixnum vreg other-reg)
    9521                   (<- other-reg)))))
     9493                  (! box-fixnum vreg zreg)
     9494                  (<- zreg)))))
    95229495          (^))))))
    95239496
    95249497(defarm2 arm2-natural-shift-right natural-shift-right (seg vreg xfer num amt)
    9525   (with-imm-target () (dest :natural)
    9526     (arm2-one-targeted-reg-form seg num dest)
     9498  (let* ((dest (p2-form seg (? :mode :natural) nil num)))
    95279499    (! natural-shift-right dest dest (acode-fixnum-form-p amt))
    95289500    (<- dest)
     
    95309502
    95319503(defarm2 arm2-natural-shift-left natural-shift-left (seg vreg xfer num amt)
    9532   (with-imm-target () (dest :natural)
    9533     (arm2-one-targeted-reg-form seg num dest)
     9504  (let* ((dest (p2-form seg (? :mode :natural) nil num)))
    95349505    (! natural-shift-left dest dest (acode-fixnum-form-p amt))
    95359506    (<- dest)
     
    95399510(defarm2 arm2-global-ref global-ref (seg vreg xfer sym)
    95409511  (when vreg
    9541     (ensuring-node-target (target vreg)
    9542       (with-node-temps () (symreg)
     9512    (p2-ensuring-node-target (target vreg)
     9513      (let* ((symreg (?)))
    95439514        (setq symreg (or (arm2-register-constant-p sym)
    95449515                         (arm2-store-immediate seg sym symreg)))
  • branches/pinsn/source/compiler/pinsn.lisp

    r16195 r16275  
    3838  (phi-assignments ())                  ;for SSA
    3939  (pending-notes ())
     40  info                                  ;for LAP
    4041  )
    4142
     
    7980           ((= i nval))
    8081        (format stream " ~s" (svref vals i))))))
     82
     83(defstruct (pinsn-note (:include vinsn-note)))
    8184             
    8285   
     
    139142                                (class (if value (hard-regspec-class value) 0))
    140143                                (mode (if value (get-regspec-mode value) 0))
    141                                 (type (if value (get-node-regspec-type-modes value) 0)))
     144                                (type (if value (get-node-regspec-type-modes value) 0))
     145                                (wired nil))
    142146  (let* ((lreg (%make-lreg :id (length (block-list-lregs seg))
    143147                           :value (if value (hard-regspec-value value))
     
    145149                           :mode mode
    146150                           :type type
    147                            :wired (not (null value)))))
     151                           :wired wired)))
    148152    (vector-push-extend lreg (block-list-lregs seg))
    149153    lreg))
     
    414418    (setf (pinsn-block pinsn) block)
    415419    (append-dll-node  pinsn (p2-block-pinsns block))
    416     (when (pinsn-attribute-p pinsn :call :branch :jump :return)
     420    (when (pinsn-attribute-p pinsn :call :branch :jump :return :jump-unknown)
    417421      (let* ((new (p2-define-label seg (p2-get-next-label seg))))
    418422        (when (pinsn-attribute-p pinsn :branch :call)
     
    603607                     `(p2-make-lreg ,',segvar ,value
    604608                       :class ,class-val
    605                        :mode ,mode-val-or-form)))
     609                       :mode ,mode-val-or-form
     610                       :wired t)))
    606611                 )
    607612        ,@body))))
Note: See TracChangeset for help on using the changeset viewer.