Changeset 12257


Ignore:
Timestamp:
Jun 12, 2009, 2:30:32 PM (10 years ago)
Author:
gz
Message:

misc compiler fixes from trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r12256 r12257  
    206206
    207207(defvar *x862-result-reg* x8664::arg_z)
     208
     209(defvar *x8664-nvrs*
     210  `(,x8664::save0 ,x8664::save1 ,x8664::save2 ,x8664::save3))
     211
     212(defvar *reduced-x8664-nvrs*
     213  `(,x8664::save0 ,x8664::save1 ,x8664::save2))
     214
     215(defvar *x8632-nvrs* ())
     216
    208217
    209218(defvar *x862-arg-z* nil)
     
    870879(defun x862-digest-symbols ()
    871880  (when *x862-recorded-symbols*
     881    (setq *x862-recorded-symbols* (nx2-recorded-symbols-in-arglist-order *x862-recorded-symbols* *x862-cur-afunc*))
    872882    (let* ((symlist *x862-recorded-symbols*)
    873883           (len (length symlist))
     
    898908            *x862-reckless* (neq 0 (%ilogand2 $decl_unsafe decls))
    899909            *x862-trust-declarations* (neq 0 (%ilogand2 $decl_trustdecls decls))))))
    900 
    901 
    902 (defun %x862-bigger-cdr-than (x y)
    903   (declare (cons x y))
    904   (> (the fixnum (cdr x)) (the fixnum (cdr y))))
    905 
    906 ;;; Return an unordered list of "varsets": each var in a varset can be
    907 ;;; assigned a register and all vars in a varset can be assigned the
    908 ;;; same register (e.g., no scope conflicts.)
    909 
    910 (defun x862-partition-vars (vars)
    911   (labels ((var-weight (var)
    912              (let* ((bits (nx-var-bits var)))
    913                (declare (fixnum bits))
    914                (if (eql 0 (logand bits (logior
    915                                         (ash 1 $vbitpuntable)
    916                                         (ash -1 $vbitspecial)
    917                                         (ash 1 $vbitnoreg))))
    918                  (if (eql (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq))
    919                           (logand bits (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq))))
    920                    0
    921                    (%i+ (%ilogand $vrefmask bits) (%ilsr 8 (%ilogand $vsetqmask bits))))
    922                  0)))
    923            (sum-weights (varlist)
    924              (let ((sum 0))
    925                (dolist (v varlist sum) (incf sum (var-weight v)))))
    926            (vars-disjoint-p (v1 v2)
    927              (if (eq v1 v2)
    928                nil
    929                (if (memq v1 (var-binding-info v2))
    930                  nil
    931                  (if (memq v2 (var-binding-info v1))
    932                    nil
    933                    t)))))
    934     (setq vars (%sort-list-no-key
    935                 ;(delete-if #'(lambda (v) (eql (var-weight v) 0)) vars)
    936                 (do* ((handle (cons nil vars))
    937                       (splice handle))
    938                      ((null (cdr splice)) (cdr handle))                 
    939                   (declare (dynamic-extent handle) (type cons handle splice))
    940                   (if (eql 0 (var-weight (%car (cdr splice))))
    941                     (rplacd splice (%cdr (cdr splice)))
    942                     (setq splice (cdr splice))))
    943                 #'(lambda (v1 v2) (%i> (var-weight v1) (var-weight v2)))))
    944     ;; This isn't optimal.  It partitions all register-allocatable
    945     ;; variables into sets such that
    946     ;; 1) no variable is a member of more than one set and
    947     ;; 2) all variables in a given set are disjoint from each other
    948     ;; A set might have exactly one member.
    949     ;; If a register is allocated for any member of a set, it's
    950     ;; allocated for all members of that set.
    951     (let* ((varsets nil))
    952       (do* ((all vars (cdr all)))
    953            ((null all))
    954         (let* ((var (car all)))
    955           (when (dolist (already varsets t)
    956                   (when (memq var (car already)) (return)))
    957             (let* ((varset (cons var nil)))
    958               (dolist (v (cdr all))
    959                 (when (dolist (already varsets t)
    960                         (when (memq v (car already)) (return)))
    961                   (when (dolist (d varset t)
    962                           (unless (vars-disjoint-p v d) (return)))
    963                     (push v varset))))
    964               (let* ((weight (sum-weights varset)))
    965                 (declare (fixnum weight))
    966                 (if (>= weight 3)
    967                   (push (cons (nreverse varset) weight) varsets)))))))
    968       varsets)))
    969 
    970 ;;; Maybe globally allocate registers to symbols naming functions & variables,
    971 ;;; and to simple lexical variables.
    972 (defun x862-allocate-global-registers (fcells vcells all-vars no-regs)
    973   (if (or no-regs (target-arch-case (:x8632 t)))
    974     (progn
    975       (dolist (c fcells) (%rplacd c nil))
    976       (dolist (c vcells) (%rplacd c nil))
    977       (values 0 nil))
    978     (let* ((maybe (x862-partition-vars all-vars)))
    979       (dolist (c fcells)
    980         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    981       (dolist (c vcells)
    982         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    983       (do* ((things (%sort-list-no-key maybe #'%x862-bigger-cdr-than) (cdr things))
    984             (n 0 (1+ n))
    985             (registers (target-arch-case
    986                         (:x8632 (error "no nvrs on x8632"))
    987                         (:x8664
    988                          (if (= (backend-lisp-context-register *target-backend*) x8664::save3)
    989                            (list x8664::save0 x8664::save1 x8664::save2)
    990                            (list x8664::save0 x8664::save1 x8664::save2 x8664::save3)))))
    991             (regno (pop registers) (pop registers))
    992             (constant-alist ()))
    993            ((or (null things) (null regno))
    994             (dolist (cell fcells) (%rplacd cell nil))
    995             (dolist (cell vcells) (%rplacd cell nil))
    996             (values n constant-alist))
    997         (declare (list things)
    998                  (fixnum n #|regno|#))
    999         (let* ((thing (car things)))
    1000           (if (or (memq thing fcells)
    1001                   (memq thing vcells))
    1002             (push (cons thing regno) constant-alist)
    1003             (dolist (var (car thing))
    1004               (nx-set-var-bits var
    1005                                (%ilogior (%ilogand (%ilognot $vrefmask) (nx-var-bits var))
    1006                                  regno
    1007                                  (%ilsl $vbitreg 1))))))))))
    1008910
    1009911
     
    1069971      (x862-set-var-ea seg arg (var-ea arg))
    1070972      (let* ((lcell (pop lcells)))
    1071         (if (setq reg (x862-assign-register-var arg))
     973        (if (setq reg (nx2-assign-register-var arg))
    1072974          (x862-init-regvar seg arg reg (x862-vloc-ea vloc))
    1073975          (x862-bind-var seg arg vloc lcell))
     
    1077979      (x862-set-var-ea seg arg (var-ea arg))
    1078980      (let* ((lcell (pop lcells)))
    1079         (if (setq reg (x862-assign-register-var arg))
     981        (if (setq reg (nx2-assign-register-var arg))
    1080982          (x862-init-regvar seg arg reg (x862-vloc-ea vloc))
    1081983          (x862-bind-var seg arg vloc lcell))
     
    1090992          (x862-set-var-ea seg var (var-ea var))
    1091993          (let* ((lcell (pop lcells)))
    1092             (if (setq reg (x862-assign-register-var var))
     994            (if (setq reg (nx2-assign-register-var var))
    1093995              (x862-init-regvar seg var reg (x862-vloc-ea vloc))
    1094996              (x862-bind-var seg var vloc lcell))
     
    10981000    (if lexpr
    10991001      (progn
    1100         (if (setq reg (x862-assign-register-var rest))
     1002        (if (setq reg (nx2-assign-register-var rest))
    11011003          (progn
    11021004            (x862-copy-register seg reg *x862-arg-z*)
     
    11071009              (x862-bind-var seg rest loc *x862-top-vstack-lcell*))))
    11081010      (let* ((rvloc (+ vloc (* 2 *x862-target-node-size* nkeys))))
    1109         (if (setq reg (x862-assign-register-var rest))
     1011        (if (setq reg (nx2-assign-register-var rest))
    11101012          (x862-init-regvar seg rest reg (x862-vloc-ea rvloc))
    11111013          (x862-bind-var seg rest rvloc (pop lcells))))))
     
    11221024             (lcell (pop lcells))
    11231025             (splcell (pop splcells))
    1124              (reg (x862-assign-register-var var))
     1026             (reg (nx2-assign-register-var var))
    11251027             (regloadedlabel (if reg (backend-get-next-label))))
    11261028        (unless (nx-null initform)
     
    11381040          (x862-bind-var seg var vloc lcell))
    11391041        (when spvar
    1140           (if (setq reg (x862-assign-register-var spvar))
     1042          (if (setq reg (nx2-assign-register-var spvar))
    11411043            (x862-init-regvar seg spvar reg (x862-vloc-ea spvloc))
    11421044            (x862-bind-var seg spvar spvloc splcell))))
     
    11501052      (let* ((spvar (pop keysupp))
    11511053             (initform (pop keyinits))
    1152              (reg (x862-assign-register-var var))
     1054             (reg (nx2-assign-register-var var))
    11531055             (regloadedlabel (if reg (backend-get-next-label)))
    11541056             (var-lcell (pop lcells))
     
    11691071          (x862-bind-var seg var vloc var-lcell))
    11701072        (when spvar
    1171           (if (setq reg (x862-assign-register-var spvar))
     1073          (if (setq reg (nx2-assign-register-var spvar))
    11721074            (x862-init-regvar seg spvar reg (x862-vloc-ea sploc))
    11731075            (x862-bind-var seg spvar sploc sp-lcell))))
     
    11781080(defun x862-vpush-arg-register (seg reg var)
    11791081  (when var
    1180     (let* ((bits (nx-var-bits var)))
    1181       (declare (fixnum bits))
    1182       (if (logbitp $vbitreg bits)
    1183         var
    1184         (progn
    1185           (x862-vpush-register seg reg :reserved)
    1186           nil)))))
     1082    (if (var-nvr var)
     1083      var
     1084      (progn
     1085        (x862-vpush-register seg reg :reserved)
     1086        nil))))
    11871087
    11881088
     
    13271227    n))
    13281228
     1229
     1230(defun x862-acode-operator-function (form)
     1231  (or (and (acode-p form)
     1232           (svref *x862-specials* (%ilogand #.operator-id-mask (acode-operator form))))
     1233      (compiler-bug "x862-form ? ~s" form)))
     1234
    13291235(defun x862-form (seg vreg xfer form &aux (note (acode-note form)))
    13301236  (flet ((main (seg vreg xfer form)
     
    13331239             (if (nx-t form)
    13341240               (x862-t seg vreg xfer)
    1335                (let* ((op nil)
    1336                       (fn nil))
    1337                  (if (and (consp form)
    1338                           (setq fn (svref *x862-specials* (%ilogand #.operator-id-mask (setq op (acode-operator form))))))
    1339                    (if (and (null vreg)
    1340                             (%ilogbitp operator-acode-subforms-bit op)
    1341                             (%ilogbitp operator-assignment-free-bit op))
    1342                      (dolist (f (%cdr form) (x862-branch seg xfer))
    1343                        (x862-form seg nil nil f ))
    1344                      (apply fn seg vreg xfer (%cdr form)))
    1345                    (compiler-bug "x862-form ? ~s" form)))))))
     1241               (let* ((fn (x862-acode-operator-function form))  ;; also typechecks
     1242                      (op (acode-operator form)))
     1243                 (if (and (null vreg)
     1244                          (%ilogbitp operator-acode-subforms-bit op)
     1245                          (%ilogbitp operator-assignment-free-bit op))
     1246                   (dolist (f (%cdr form) (x862-branch seg xfer))
     1247                     (x862-form seg nil nil f ))
     1248                   (apply fn seg vreg xfer (%cdr form))))))))
    13461249    (if note
    13471250      (let* ((start (x862-emit-note seg :source-location-begin note))
     
    13621265    ;; kind of screwy - encoding the source type in the dest register spec
    13631266    (set-node-regspec-type-modes freg hard-reg-class-fpr-type-double))
    1364   (let* ((fn nil))
    1365     (if (and (consp form)
    1366              (setq fn (svref *x862-specials* (%ilogand #.operator-id-mask (acode-operator form)))))     
    1367       (apply fn seg freg nil (%cdr form))
    1368       (compiler-bug "x862-form ? ~s" form))))
    1369 
     1267  (let* ((fn (x862-acode-operator-function form)))
     1268    (apply fn seg freg nil (%cdr form))))
    13701269
    13711270
     
    13811280  (apply (svref *x862-specials* (%ilogand operator-id-mask op)) seg vreg xfer forms))
    13821281
    1383 ;;; Returns true iff lexical variable VAR isn't setq'ed in FORM.
    1384 ;;; Punts a lot ...
    1385 (defun x862-var-not-set-by-form-p (var form)
    1386   (or (not (%ilogbitp $vbitsetq (nx-var-bits var)))
    1387       (x862-setqed-var-not-set-by-form-p var form)))
    1388 
    1389 (defun x862-setqed-var-not-set-by-form-p (var form)
    1390   (setq form (acode-unwrapped-form form))
    1391   (or (atom form)
    1392       (x86-constant-form-p form)
    1393       (x862-lexical-reference-p form)
    1394       (let ((op (acode-operator form))
    1395             (subforms nil))
    1396         (if (eq op (%nx1-operator setq-lexical))
    1397           (and (neq var (cadr form))
    1398                (x862-setqed-var-not-set-by-form-p var (caddr form)))
    1399           (and (%ilogbitp operator-side-effect-free-bit op)
    1400                (flet ((not-set-in-formlist (formlist)
    1401                         (dolist (subform formlist t)
    1402                           (unless (x862-setqed-var-not-set-by-form-p var subform) (return)))))
    1403                  (if
    1404                    (cond ((%ilogbitp operator-acode-subforms-bit op) (setq subforms (%cdr form)))
    1405                          ((%ilogbitp operator-acode-list-bit op) (setq subforms (cadr form))))
    1406                    (not-set-in-formlist subforms)
    1407                    (and (or (eq op (%nx1-operator call))
    1408                             (eq op (%nx1-operator lexical-function-call)))
    1409                         (x862-setqed-var-not-set-by-form-p var (cadr form))
    1410                         (setq subforms (caddr form))
    1411                         (not-set-in-formlist (car subforms))
    1412                         (not-set-in-formlist (cadr subforms))))))))))
    14131282
    14141283(defun x862-check-fixnum-overflow (seg target &optional labelno)
     
    15201389      (! set-nargs n))))
    15211390
    1522 (defun x862-assign-register-var (v)
    1523   (let ((bits (nx-var-bits v)))
    1524     (when (%ilogbitp $vbitreg bits)
    1525       (%ilogand bits $vrefmask))))
     1391
    15261392
    15271393(defun x862-single-float-bits (the-sf)
     
    17291595             (vreg-class (and (not (eq vreg :push)) (hard-regspec-class vreg)))
    17301596             (vreg-mode
    1731               (if (eql vreg-class hard-reg-class-gpr)
     1597              (if (or (eql vreg-class hard-reg-class-gpr)
     1598                      (eql vreg-class hard-reg-class-fpr))
    17321599                (get-regspec-mode vreg)
    17331600                hard-reg-class-gpr-mode-invalid)))
     
    17411608               (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch)))
    17421609                 (! misc-ref-c-node target src index-known-fixnum)
    1743                  (! misc-ref-node target src unscaled-idx)))))
     1610                 (if unscaled-idx
     1611                   (! misc-ref-node target src unscaled-idx)
     1612                   (with-node-target (src) unscaled-idx
     1613                     (x862-absolute-natural seg unscaled-idx  nil (ash index-known-fixnum *x862-target-fixnum-shift*))
     1614                     (! misc-ref-node target src unscaled-idx)))))))
    17441615          (is-32-bit
    17451616           (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch)))
     
    17741645             (with-imm-target () idx-reg
    17751646               (if index-known-fixnum
    1776                  (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     1647                 (x862-absolute-natural seg idx-reg nil (ash index-known-fixnum 2))
    17771648                 (! scale-32bit-misc-index idx-reg unscaled-idx))
    17781649               (cond ((eq type-keyword :single-float-vector)
     
    18411712          ;; Down to the dregs.
    18421713          (is-64-bit
     1714           (with-node-target (src) extra
     1715             (unless unscaled-idx (setq unscaled-idx extra)))
    18431716           (case type-keyword
    18441717             (:double-float-vector
     
    26442517                                                  value result-reg)))
    26452518                (:x8664
    2646                  (x862-three-targeted-reg-forms seg
    2647                                                 vector src
    2648                                                 index unscaled-idx
    2649                                                 value result-reg)))))
     2519                 (multiple-value-setq (src unscaled-idx result-reg)
     2520                   (x862-three-untargeted-reg-forms seg
     2521                                                  vector src
     2522                                                  index unscaled-idx
     2523                                                  value result-reg))))))
    26502524        (when safe
    26512525          (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     
    26932567            (destructuring-bind (fn-form (stack-args reg-args) &optional spread-p) (%cdr body)
    26942568               (unless (and (eq spread-p t)
    2695                            (eq (x862-lexical-reference-p (%car reg-args)) rest))
     2569                           (eq (nx2-lexical-reference-p (%car reg-args)) rest))
    26962570                (return nil))
    26972571              (flet ((independent-of-all-values (form)       
    26982572                       (setq form (acode-unwrapped-form-value form))
    26992573                       (or (x86-constant-form-p form)
    2700                            (let* ((lexref (x862-lexical-reference-p form)))
     2574                           (let* ((lexref (nx2-lexical-reference-p form)))
    27012575                             (and lexref
    27022576                                  (neq lexref rest)
    27032577                                  (dolist (val rest-values t)
    2704                                     (unless (x862-var-not-set-by-form-p lexref val)
     2578                                    (unless (nx2-var-not-set-by-form-p lexref val)
    27052579                                      (return))))))))
    27062580                (unless (or (eq op (%nx1-operator lexical-function-call))
     
    27232597              (setq body (%cadr body))
    27242598              (if (and (eq op (%nx1-operator if))
    2725                        (eq (x862-lexical-reference-p (%cadr body)) rest))
     2599                       (eq (nx2-lexical-reference-p (%cadr body)) rest))
    27262600                (setq body (%caddr body))
    27272601                (return nil)))))))))
     
    27392613              (setq arglist (list nil (reverse stack-args)))
    27402614              (setq arglist (list (butlast stack-args *x862-target-num-arg-regs*) (reverse (last stack-args *x862-target-num-arg-regs*)))))))))
    2741     (let* ((lexref (x862-lexical-reference-p fn))
     2615    (let* ((lexref (nx2-lexical-reference-p fn))
    27422616           (simple-case (or (fixnump fn)
    27432617                            (typep fn 'lreg)
     
    27482622                             (flet ((all-simple (args)
    27492623                                      (dolist (arg args t)
    2750                                         (when (and arg (not (x862-var-not-set-by-form-p lexref arg)))
     2624                                        (when (and arg (not (nx2-var-not-set-by-form-p lexref arg)))
    27512625                                          (return)))))
    27522626                               (and (all-simple (car arglist))
     
    32283102             
    32293103
     3104
     3105
    32303106(defun x862-push-register (seg areg)
    32313107  (let* ((a-float (= (hard-regspec-class areg) hard-reg-class-fpr))
     
    32403116           (:x8632
    32413117            (setq vinsn (! temp-push-single-float areg))
    3242             (incf *x862-cstack* *x862-target-dnode-size*))
     3118            (x862-open-undo $undo-x86-c-frame))
    32433119           (:x8664
    32443120            (setq vinsn (! vpush-single-float areg))
     
    32503126              (progn
    32513127                (setq vinsn (! temp-push-double-float areg))
    3252                 (incf *x862-cstack* 16))
     3128                (x862-open-undo $undo-x86-c-frame))
    32533129              (progn
    32543130                (setq vinsn (! temp-push-unboxed-word areg))
    3255                 (incf *x862-cstack* *x862-target-dnode-size*))))
     3131                (x862-open-undo $undo-x86-c-frame))))
    32563132           (:x8664
    32573133            (setq vinsn
     
    32593135                    (! temp-push-double-float areg)
    32603136                    (! temp-push-unboxed-word areg)))
    3261             (setq *x862-cstack* (+ *x862-cstack* 16))))))
     3137            (x862-open-undo $undo-x86-c-frame)))))
    32623138      vinsn)))
     3139
     3140
    32633141
    32643142(defun x862-pop-register (seg areg)
     
    32743152           (:x8632
    32753153            (setq vinsn (! temp-pop-single-float areg))
    3276             (decf *x862-cstack* *x862-target-dnode-size*))
     3154            (x862-close-undo))
    32773155           (:x8664
    32783156            (setq vinsn (! vpop-single-float areg))
     
    32843162              (progn
    32853163                (setq vinsn (! temp-pop-double-float areg))
    3286                 (decf *x862-cstack* 16))
     3164                (x862-close-undo))
    32873165              (progn
    32883166                (setq vinsn (! temp-pop-unboxed-word areg))
    3289                 (decf *x862-cstack* *x862-target-dnode-size*))))
     3167                (x862-close-undo))))
    32903168           (:x8664
    32913169            (setq vinsn
     
    32933171                    (! temp-pop-double-float areg)
    32943172                    (! temp-pop-unboxed-word areg)))
    3295             (setq *x862-cstack* (- *x862-cstack* 16))))))
     3173            (x862-close-undo)))))
    32963174      vinsn)))
    32973175
     3176;;; If reg is a GPR and of mode node, use arg_z, otherwise, just return
     3177;;; reg.
    32983178(defun x862-acc-reg-for (reg)
    32993179  (with-x86-local-vinsn-macros (seg)
    3300     (let* ((class (hard-regspec-class reg))
    3301            (mode (get-regspec-mode reg)))
    3302       (declare (fixnum class mode))
    3303       (cond ((= class hard-reg-class-fpr)
    3304              (make-wired-lreg *x862-fp1* :class class :mode mode))
    3305             ((= class hard-reg-class-gpr)
    3306              (if (= mode hard-reg-class-gpr-mode-node)
    3307                ($ *x862-arg-z*)
    3308                (make-wired-lreg *x862-imm0* :mode mode)))
    3309             (t (compiler-bug "Unknown register class for reg ~s" reg))))))
     3180    (if (and (eql (hard-regspec-class reg) hard-reg-class-gpr)
     3181           (eql (get-regspec-mode reg) hard-reg-class-gpr-mode-node))
     3182      ($ *x862-arg-z*)
     3183      reg)))
    33103184
    33113185;;; The compiler often generates superfluous pushes & pops.  Try to
     
    33463220;;; would vpop the first argument out of line.)
    33473221(defun x862-two-targeted-reg-forms (seg aform areg bform breg)
    3348   (let* ((avar (x862-lexical-reference-p aform))
     3222  (let* ((avar (nx2-lexical-reference-p aform))
    33493223         (atriv (and (x862-trivial-p bform) (nx2-node-gpr-p breg)))
    33503224         (aconst (and (not atriv) (or (x86-side-effect-free-form-p aform)
    3351                                       (if avar (x862-var-not-set-by-form-p avar bform)))))
     3225                                      (if avar (nx2-var-not-set-by-form-p avar bform)))))
    33523226         apushed)
    33533227    (progn
     
    33663240(defun x862-two-untargeted-reg-forms (seg aform areg bform breg)
    33673241  (with-x86-local-vinsn-macros (seg)
    3368     (let* ((avar (x862-lexical-reference-p aform))
     3242    (let* ((avar (nx2-lexical-reference-p aform))
    33693243           (adest areg)
    33703244           (bdest breg)
    33713245           (atriv (and (x862-trivial-p bform) (nx2-node-gpr-p breg)))
    33723246           (aconst (and (not atriv) (or (x86-side-effect-free-form-p aform)
    3373                                         (if avar (x862-var-not-set-by-form-p avar bform)))))
     3247                                        (if avar (nx2-var-not-set-by-form-p avar bform)))))
    33743248           (apushed (not (or atriv aconst))))
    33753249      (progn
     
    33993273         (aconst (and (not atriv)
    34003274                      (or (x86-side-effect-free-form-p aform)
    3401                           (let ((avar (x862-lexical-reference-p aform)))
     3275                          (let ((avar (nx2-lexical-reference-p aform)))
    34023276                            (and avar
    3403                                  (x862-var-not-set-by-form-p avar bform)
    3404                                  (x862-var-not-set-by-form-p avar cform))))))
     3277                                 (nx2-var-not-set-by-form-p avar bform)
     3278                                 (nx2-var-not-set-by-form-p avar cform))))))
    34053279         (bconst (and (not btriv)
    34063280                      (or
    34073281                       (x86-side-effect-free-form-p bform)
    3408                        (let ((bvar (x862-lexical-reference-p bform)))
    3409                          (and bvar (x862-var-not-set-by-form-p bvar cform))))))
     3282                       (let ((bvar (nx2-lexical-reference-p bform)))
     3283                         (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
    34103284         (apushed nil)
    34113285         (bpushed nil))
     
    34503324         (aconst (and (not atriv)
    34513325                      (or (x86-side-effect-free-form-p aform)
    3452                           (let ((avar (x862-lexical-reference-p aform)))
     3326                          (let ((avar (nx2-lexical-reference-p aform)))
    34533327                            (and avar
    3454                                  (x862-var-not-set-by-form-p avar bform)
    3455                                  (x862-var-not-set-by-form-p avar cform)
    3456                                  (x862-var-not-set-by-form-p avar dform))))))
     3328                                 (nx2-var-not-set-by-form-p avar bform)
     3329                                 (nx2-var-not-set-by-form-p avar cform)
     3330                                 (nx2-var-not-set-by-form-p avar dform))))))
    34573331         (bconst (and (not btriv)
    34583332                      (or
    34593333                       (x86-side-effect-free-form-p bform)
    3460                        (let ((bvar (x862-lexical-reference-p bform)))
     3334                       (let ((bvar (nx2-lexical-reference-p bform)))
    34613335                         (and bvar
    3462                               (x862-var-not-set-by-form-p bvar cform)
    3463                               (x862-var-not-set-by-form-p bvar dform))))))
     3336                              (nx2-var-not-set-by-form-p bvar cform)
     3337                              (nx2-var-not-set-by-form-p bvar dform))))))
    34643338         (cconst (and (not ctriv)
    34653339                      (or
    34663340                       (x86-side-effect-free-form-p cform)
    3467                        (let ((cvar (x862-lexical-reference-p cform)))
    3468                          (and cvar (x862-var-not-set-by-form-p cvar dform))))))
     3341                       (let ((cvar (nx2-lexical-reference-p cform)))
     3342                         (and cvar (nx2-var-not-set-by-form-p cvar dform))))))
    34693343         (apushed nil)
    34703344         (bpushed nil)
     
    35113385           (aconst (and (not atriv)
    35123386                        (or (x86-side-effect-free-form-p aform)
    3513                             (let ((avar (x862-lexical-reference-p aform)))
     3387                            (let ((avar (nx2-lexical-reference-p aform)))
    35143388                              (and avar
    3515                                    (x862-var-not-set-by-form-p avar bform)
    3516                                    (x862-var-not-set-by-form-p avar cform))))))
     3389                                   (nx2-var-not-set-by-form-p avar bform)
     3390                                   (nx2-var-not-set-by-form-p avar cform))))))
    35173391           (bconst (and (not btriv)
    35183392                        (or
    35193393                         (x86-side-effect-free-form-p bform)
    3520                          (let ((bvar (x862-lexical-reference-p bform)))
    3521                            (and bvar (x862-var-not-set-by-form-p bvar cform))))))
     3394                         (let ((bvar (nx2-lexical-reference-p bform)))
     3395                           (and bvar (nx2-var-not-set-by-form-p bvar cform))))))
    35223396           (adest areg)
    35233397           (bdest breg)
     
    35643438         (aconst (and (not atriv)
    35653439                      (or (x86-side-effect-free-form-p aform)
    3566                           (let ((avar (x862-lexical-reference-p aform)))
     3440                          (let ((avar (nx2-lexical-reference-p aform)))
    35673441                            (and avar
    3568                                  (x862-var-not-set-by-form-p avar bform)
    3569                                  (x862-var-not-set-by-form-p avar cform)
    3570                                  (x862-var-not-set-by-form-p avar dform))))))
     3442                                 (nx2-var-not-set-by-form-p avar bform)
     3443                                 (nx2-var-not-set-by-form-p avar cform)
     3444                                 (nx2-var-not-set-by-form-p avar dform))))))
    35713445         (bconst (and (not btriv)
    35723446                      (or
    35733447                       (x86-side-effect-free-form-p bform)
    3574                        (let ((bvar (x862-lexical-reference-p bform)))
     3448                       (let ((bvar (nx2-lexical-reference-p bform)))
    35753449                         (and bvar
    3576                               (x862-var-not-set-by-form-p bvar cform)
    3577                               (x862-var-not-set-by-form-p bvar dform))))))
     3450                              (nx2-var-not-set-by-form-p bvar cform)
     3451                              (nx2-var-not-set-by-form-p bvar dform))))))
    35783452         (cconst (and (not ctriv)
    35793453                      (or
    35803454                       (x86-side-effect-free-form-p cform)
    3581                        (let ((cvar (x862-lexical-reference-p cform)))
     3455                       (let ((cvar (nx2-lexical-reference-p cform)))
    35823456                         (and cvar
    3583                               (x862-var-not-set-by-form-p cvar dform))))))
     3457                              (nx2-var-not-set-by-form-p cvar dform))))))
    35843458         (adest areg)
    35853459         (bdest breg)
     
    37653639            (! compare-u31-constant reg (if ju31 jconstant iconstant))
    37663640            (unless (or ju31 (eq cr-bit x86::x86-e-bits))
    3767                 (setq cr-bit (x862-reverse-cr-bit cr-bit)))
     3641              (setq cr-bit (x862-reverse-cr-bit cr-bit)))
     3642            (setq cr-bit (x862-cr-bit-for-unsigned-comparison cr-bit))
    37683643            (^ cr-bit true-p))
    3769         (with-imm-target () (ireg :natural)
    3770           (with-additional-imm-reg ()
    3771             (with-imm-target
    3772                 (ireg) (jreg :natural)
    3773                 (x862-two-targeted-reg-forms seg i ireg j jreg)
    3774                 (x862-compare-natural-registers seg vreg xfer ireg jreg cr-bit true-p))))))))
    3775 
    3776 
    3777 (defun x862-cr-bit-for-logical-comparison (cr-bit true-p)
    3778   (declare (fixnum cr-bit))
    3779   (let* ((unsigned
    3780           (case cr-bit
    3781             (#.x86::x86-l-bits x86::x86-b-bits)
    3782             (#.x86::x86-le-bits x86::x86-be-bits )
    3783             (#.x86::x86-g-bits x86::x86-a-bits)
    3784             (#.x86::x86-ge-bits x86::x86-ae-bits)
    3785             (t cr-bit))))
    3786     (declare (fixnum unsigned))
    3787     (if true-p
    3788       unsigned
    3789       (logxor unsigned 1))))
     3644        (target-arch-case
     3645         (:x8664
     3646          (with-imm-target () (ireg :natural)
     3647            (with-imm-target (ireg) (jreg :natural)
     3648              (x862-two-targeted-reg-forms seg i ireg j jreg)
     3649              (x862-compare-natural-registers seg vreg xfer ireg jreg cr-bit true-p))))
     3650         (:x8632
     3651          (with-imm-target () (jreg :natural)
     3652            (x862-one-targeted-reg-form seg i jreg)
     3653            (x862-push-register seg jreg)
     3654            (x862-one-targeted-reg-form seg j jreg)
     3655            (! temp-pop-temp1-as-unboxed-word)
     3656            (x862-close-undo)
     3657            (x862-compare-natural-registers seg vreg xfer ($ x8632::temp1) jreg cr-bit true-p))))))))
     3658
     3659
     3660
    37903661                 
    37913662(defun x862-compare-natural-registers (seg vreg xfer ireg jreg cr-bit true-p)
     
    37933664    (if vreg
    37943665      (progn
    3795         (setq cr-bit (x862-cr-bit-for-logical-comparison cr-bit true-p))
     3666        (setq cr-bit (x862-cr-bit-for-unsigned-comparison cr-bit))
    37963667        (! compare ireg jreg)
     3668        (target-arch-case
     3669         (:x8664)
     3670         (:x8632 (! mark-temp1-as-node-preserving-flags)))
    37973671        (regspec-crf-gpr-case
    37983672         (vreg dest)
     
    38003674         (progn
    38013675           (ensuring-node-target (target dest)
     3676             (if (not true-p)
     3677               (setq cr-bit (logxor 1 cr-bit)))
    38023678             (! cr-bit->boolean target cr-bit))
    38033679           (^))))
     
    45324408              (progn
    45334409                (let* ((vloc *x862-vstack*)
    4534                        (reg (let* ((r (x862-assign-register-var var)))
     4410                       (reg (let* ((r (nx2-assign-register-var var)))
    45354411                              (if r ($ r)))))
    45364412                  (if (x862-load-ea-p val)
     
    49974873                  (%ilogand (%ilogior (%ilsl $vbitclosed 1) (%ilsl $vbitsetq 1)) bits)))))))
    49984874
    4999 (defun x862-lexical-reference-p (form)
    5000   (when (acode-p form)
    5001     (let ((op (acode-operator (setq form (acode-unwrapped-form-value form)))))
    5002       (when (or (eq op (%nx1-operator lexical-reference))
    5003                 (eq op (%nx1-operator inherited-arg)))
    5004         (%cadr form)))))
     4875
    50054876
    50064877(defun x862-ref-symbol-value (seg vreg xfer sym check-boundp)
     
    55185389(defun x862-bind-structured-var (seg var vloc lcell &optional context)
    55195390  (if (not (x862-structured-var-p var))
    5520     (let* ((reg (x862-assign-register-var var)))
     5391    (let* ((reg (nx2-assign-register-var var)))
    55215392      (if reg
    55225393        (x862-init-regvar seg var reg (x862-vloc-ea vloc))
     
    61846055              (setq no-regs (%ilogbitp $fbitnoregs fbits)))
    61856056        (multiple-value-setq (pregs reglocatives)
    6186           (x862-allocate-global-registers *x862-fcells* *x862-vcells* (afunc-all-vars afunc) no-regs))
     6057          (nx2-allocate-global-registers
     6058           *x862-fcells*
     6059           *x862-vcells*
     6060           (afunc-all-vars afunc)
     6061           inherited-vars
     6062           (unless no-regs
     6063             (target-arch-case
     6064              (:x8664
     6065               (if (= (backend-lisp-context-register *target-backend*) x8664::save3)
     6066                 *reduced-x8664-nvrs*
     6067                 *x8664-nvrs*))
     6068              (:x8632
     6069               *x8632-nvrs*)))))
    61876070        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    61886071        (! establish-fn)
     
    63506233              (let* ((var (car vars)))
    63516234                (when var
    6352                   (let* ((reg (x862-assign-register-var var)))
     6235                  (let* ((reg (nx2-assign-register-var var)))
    63536236                    (x862-copy-register seg reg arg-reg-num)
    63546237                    (setf (var-ea var) reg))))))
     
    76077490         (keyword (if (and atype
    76087491                           (let* ((dims (array-ctype-dimensions atype)))
    7609                              (and (not (atom dims))
    7610                                   (= (length dims) 1)))
     7492                             (or (eq dims '*)
     7493                                 (and (not (atom dims))
     7494                                      (= (length dims) 1))))
    76117495                           (not (array-ctype-complexp atype)))
    76127496                    (funcall
     
    76247508         (keyword (if (and atype
    76257509                           (let* ((dims (array-ctype-dimensions atype)))
    7626                              (and (not (atom dims))
    7627                                  (= (length dims) 1)))
     7510                             (or (eq dims '*)
     7511                                 (and (not (atom dims))
     7512                                      (= (length dims) 1))))
    76287513                           (not (array-ctype-complexp atype)))
    76297514                    (funcall
     
    78307715        (dolist (var vars)
    78317716          (let* ((lcell (pop lcells))
    7832                  (reg (x862-assign-register-var var)))
     7717                 (reg (nx2-assign-register-var var)))
    78337718            (if reg
    78347719              (x862-init-regvar seg var reg (x862-vloc-ea vloc))
     
    84018286        (setq val (%car valcopy))
    84028287        (cond ((or (%ilogbitp $vbitspecial (setq bits (nx-var-bits var)))
    8403                    (and (%ilogbitp $vbitreg bits)
     8288                   (and (var-nvr var)
    84048289                        (dolist (val (%cdr valcopy))
    84058290                          (unless (x862-trivial-p val) (return t)))))
     
    86758560         (ctype (if atype0 (specifier-type atype0)))
    86768561         (atype (if (array-ctype-p ctype) ctype))
     8562         (dims (and atype (array-ctype-dimensions atype)))
    86778563         (keyword (and atype
    8678                        (let* ((dims (array-ctype-dimensions atype)))
    8679                          (and (typep dims 'list)
    8680                               (= 2 (length dims))))
     8564                       (or (eq dims '*)
     8565                           (and (typep dims 'list)
     8566                                (= 2 (length dims))))
    86818567                       (not (array-ctype-complexp atype))
    86828568                       (funcall
     
    86858571                        atype))))
    86868572    (cond (keyword
    8687            (let* ((dims (array-ctype-dimensions atype))
    8688                   (dim0 (car dims))
     8573           (when (eq dims '*)
     8574             (setq dims nil))
     8575           (let* ((dim0 (car dims))
    86898576                  (dim1 (cadr dims)))
    86908577             (x862-aref2 seg
     
    87308617         (ctype (if atype0 (specifier-type atype0)))
    87318618         (atype (if (array-ctype-p ctype) ctype))
     8619         (dims (and atype (array-ctype-dimensions atype)))
    87328620         (keyword (and atype
    8733                        (let* ((dims (array-ctype-dimensions atype)))
    8734                          (and (typep dims 'list)
    8735                            (= 3 (length dims))))
     8621                       (or (eq dims '*)
     8622                           (and (typep dims 'list)
     8623                                (= 3 (length dims))))
    87368624                       (not (array-ctype-complexp atype))
    87378625                       (funcall
     
    87408628                        atype))))
    87418629    (cond (keyword
    8742            (let* ((dims (array-ctype-dimensions atype))
    8743                   (dim0 (car dims))
     8630           (when (eq dims '*)
     8631             (setq dims nil))
     8632           (let* ((dim0 (car dims))
    87448633                  (dim1 (cadr dims))
    87458634                  (dim2 (caddr dims)))
     
    87728661         (ctype (if atype0 (specifier-type atype0)))
    87738662         (atype (if (array-ctype-p ctype) ctype))
     8663         (dims (and atype (array-ctype-dimensions atype)))
    87748664         (keyword (and atype
    8775                        (let* ((dims (array-ctype-dimensions atype)))
    8776                          (and (typep dims 'list)
    8777                               (= 2 (length dims))))
     8665                       (or (eq dims '*)
     8666                           (and (typep dims 'list)
     8667                                (= 2 (length dims))))
    87788668                       (not (array-ctype-complexp atype))
    87798669                       (funcall
     
    87828672                        atype))))
    87838673    (cond (keyword
    8784            (let* ((dims (array-ctype-dimensions atype))
    8785                   (dim0 (car dims))
     8674           (when (eq dims '*)
     8675             (setq dims nil))
     8676           (let* ((dim0 (car dims))
    87868677                  (dim1 (cadr dims)))
    87878678             (x862-aset2 seg
     
    88118702         (ctype (if atype0 (specifier-type atype0)))
    88128703         (atype (if (array-ctype-p ctype) ctype))
     8704         (dims (and atype (array-ctype-dimensions atype)))
    88138705         (keyword (and atype
    8814                        (let* ((dims (array-ctype-dimensions atype)))
    8815                          (unless (atom dims)
    8816                            (= 3 (length dims))))
     8706                       (or (eq dims '*)
     8707                           (unless (atom dims)
     8708                             (= 3 (length dims))))
    88178709                       (not (array-ctype-complexp atype))
    88188710                       (funcall
     
    88218713                        atype))))
    88228714    (cond (keyword
    8823            (let* ((dims (array-ctype-dimensions atype))
    8824                   (dim0 (car dims))
     8715           (when (eq dims '*)
     8716             (setq dims nil))
     8717           (let* ((dim0 (car dims))
    88258718                  (dim1 (cadr dims))
    88268719                  (dim2 (caddr dims)))
     
    95559448        ((:double-float :unsigned-doubleword :signed-doubleword)
    95569449         (incf nwords 2))
    9557         (t (incf nwords))))
     9450        (t
     9451         (if (typep argspec 'unsigned-byte)
     9452           (incf nwords argspec)
     9453           (incf nwords)))))
    95589454    (when (null argspecs)
    95599455      (setq simple-foreign-args t))
     
    96059501                 (x862-one-targeted-reg-form seg valform ptr)
    96069502                 (with-additional-imm-reg (ptr)
    9607                    (with-imm-target (ptr) (r :natural)
     9503                   (with-imm-temps (ptr) (r)
    96089504                     (dotimes (i spec)
    96099505                       (! mem-ref-c-fullword r ptr (ash i x8632::word-shift))
    9610                        (! set-c-arg r offset)))))
     9506                       (! set-c-arg r (+ offset i))))))
    96119507               (incf offset spec))
    96129508             (with-imm-target () (valreg :natural)
Note: See TracChangeset for help on using the changeset viewer.