Changeset 10205


Ignore:
Timestamp:
Jul 25, 2008, 5:17:51 AM (11 years ago)
Author:
rme
Message:

Merge changes for x8632 from ia32 branch.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r10180 r10205  
    1919(eval-when (:compile-toplevel :execute)
    2020  (require "NXENV")
     21  (require "X8632ENV")
    2122  (require "X8664ENV"))
    2223
     
    4243(defparameter *x862-tos-reg* ())
    4344
    44 
     45;; probably should be elsewhere
     46
     47(defmacro with-additional-imm-reg ((&rest reserved) &body body)
     48  (let ((node (gensym))
     49        (bit (gensym)))
     50    `(target-arch-case
     51      (:x8632
     52       (with-node-target (,@reserved) ,node
     53         (let* ((,bit (ash 1 (hard-regspec-value ,node)))
     54                (*backend-node-temps* (logandc2 *backend-node-temps* ,bit))
     55                (*available-backend-node-temps* (logandc2 *available-backend-node-temps* ,bit))
     56                (*backend-imm-temps* (logior *backend-imm-temps* ,bit))
     57                (*available-backend-imm-temps* (logior *available-backend-imm-temps* ,bit)))
     58           (! mark-as-imm ,node)
     59           ,@body
     60           (! mark-as-node ,node))))
     61      (:x8664
     62       (progn
     63         ,@body)))))
    4564
    4665 
     
    91110                             (:fpr hard-reg-class-fpr)
    92111                             (:crf hard-reg-class-crf)))
    93                           (mode-val
     112                          (mode-val-or-form
    94113                           (if (eq class :gpr)
    95                              (gpr-mode-name-value mode)
     114                             (if (member mode '(:natural :signed-natural))
     115                               `(gpr-mode-name-value ,mode)
     116                               (gpr-mode-name-value mode))
    96117                             (if (eq class :fpr)
    97118                               (if (eq mode :single-float)
     
    101122                     `(make-unwired-lreg nil
    102123                       :class ,class-val
    103                        :mode ,mode-val)))
     124                       :mode ,mode-val-or-form)))
    104125                  ($ (reg &key (class :gpr) (mode :lisp))
    105126                   (let* ((class-val
     
    108129                             (:fpr hard-reg-class-fpr)
    109130                             (:crf hard-reg-class-crf)))
    110                           (mode-val
     131                          (mode-val-or-form
    111132                           (if (eq class :gpr)
    112                              (gpr-mode-name-value mode)
     133                             (if (member mode '(:natural :signed-natural))
     134                               `(gpr-mode-name-value ,mode)
     135                               (gpr-mode-name-value mode))
    113136                             (if (eq class :fpr)
    114137                               (if (eq mode :single-float)
     
    118141                     `(make-wired-lreg ,reg
    119142                       :class ,class-val
    120                        :mode ,mode-val))))
     143                       :mode ,mode-val-or-form))))
    121144         ,@body))))
    122145
     
    310333          ((addrspec-vcell-p ea)     ; closed-over vcell
    311334           (x862-copy-register seg *x862-arg-z* valreg)
    312            (x862-stack-to-register seg ea x8664::arg_x)
    313            (x862-lri seg *x862-arg-y* 0)
    314            (! call-subprim-3 *x862-arg-z* (subprim-name->offset '.SPgvset) x8664::arg_x *x862-arg-y* *x862-arg-z*))
     335           (let* ((gvector (target-arch-case (:x8632 x8632::temp0)
     336                                             (:x8664 x8664::arg_x))))
     337             (x862-stack-to-register seg ea gvector)
     338             (x862-lri seg *x862-arg-y* 0)
     339             (! call-subprim-3 *x862-arg-z* (subprim-name->offset '.SPgvset) gvector *x862-arg-y* *x862-arg-z*)))
    315340          ((memory-spec-p ea)    ; vstack slot
    316341           (x862-register-to-stack seg valreg ea))
     
    466491           (*x862-vstack* 0)
    467492           (*x862-cstack* 0)
    468            (*x86-lap-entry-offset* x8664::fulltag-function)
    469            (*x862-result-reg* x8664::arg_z)
    470            (*x862-imm0* x8664::imm0)
    471            (*x862-arg-z* x8664::arg_z)
    472            (*x862-arg-y* x8664::arg_y)
    473            (*x862-temp0* x8664::temp0)
    474            (*x862-temp1* x8664::temp1)
    475            (*x862-fn* x8664::fn)
    476            (*x862-fname* x8664::fname)
    477            (*x862-ra0* x8664::ra0)
    478            (*x862-allocptr* x8664::allocptr)
    479            (*x862-fp0* x8664::fp0)
    480            (*x862-fp1* x8664::fp1)
    481            (*x862-target-num-arg-regs* $numx8664argregs)
    482            (*x862-target-num-save-regs* $numx8664saveregs)
     493           (*x86-lap-entry-offset* (target-arch-case
     494                                    (:x8632 x8632::fulltag-misc)
     495                                    (:x8664 x8664::fulltag-function)))
     496           (*x862-result-reg* (target-arch-case
     497                               (:x8632 x8632::arg_z)
     498                               (:x8664 x8664::arg_z)))
     499           (*x862-imm0* (target-arch-case (:x8632 x8632::imm0)
     500                                          (:x8664 x8664::imm0)))
     501           (*x862-arg-z* (target-arch-case (:x8632 x8632::arg_z)
     502                                           (:x8664 x8664::arg_z)))
     503           (*x862-arg-y* (target-arch-case (:x8632 x8632::arg_y)
     504                                           (:x8664 x8664::arg_y)))
     505           (*x862-temp0* (target-arch-case (:x8632 x8632::temp0)
     506                                           (:x8664 x8664::temp0)))
     507           (*x862-temp1* (target-arch-case (:x8632 x8632::temp1)
     508                                           (:x8664 x8664::temp1)))
     509           (*x862-fn* (target-arch-case (:x8632 x8632::fn)
     510                                        (:x8664 x8664::fn)))
     511           (*x862-fname* (target-arch-case (:x8632 x8632::fname)
     512                                           (:x8664 x8664::fname)))
     513           (*x862-ra0* (target-arch-case (:x8632 x8632::ra0)
     514                                         (:x8664 x8664::ra0)))
     515           (*x862-allocptr* (target-arch-case (:x8632 x8632::allocptr)
     516                                              (:x8664 x8664::allocptr)))
     517           (*x862-fp0* (target-arch-case (:x8632 x8632::fp0)
     518                                         (:x8664 x8664::fp0)))
     519           (*x862-fp1* (target-arch-case (:x8632 x8632::fp1)
     520                                         (:x8664 x8664::fp1)))
     521           (*x862-target-num-arg-regs* (target-arch-case
     522                                        (:x8632 $numx8632argregs)
     523                                        (:x8664  $numx8664argregs)))
     524           (*x862-target-num-save-regs* (target-arch-case
     525                                         (:x8632 $numx8632saveregs)
     526                                         (:x8664  $numx8664saveregs)))
    483527           (*x862-target-lcell-size* (arch::target-lisp-node-size (backend-target-arch *target-backend*)))
    484528           (*x862-target-fixnum-shift* (arch::target-fixnum-shift (backend-target-arch *target-backend*)))
     
    495539           (*x862-var-cells* nil)
    496540           (*backend-vinsns* (backend-p2-vinsn-templates *target-backend*))
    497            (*backend-node-regs* x8664-node-regs)
    498            (*backend-node-temps* x8664-temp-node-regs)
    499            (*available-backend-node-temps* x8664-temp-node-regs)
    500            (*backend-imm-temps* x8664-imm-regs)
    501            (*available-backend-imm-temps* x8664-imm-regs)
    502            (*backend-crf-temps* x8664-cr-fields)
    503            (*available-backend-crf-temps* x8664-cr-fields)
    504            (*backend-fp-temps* x8664-temp-fp-regs)
    505            (*available-backend-fp-temps* x8664-temp-fp-regs)
     541           (*backend-node-regs* (target-arch-case
     542                                 (:x8632 x8632-node-regs)
     543                                 (:x8664 x8664-node-regs)))
     544           (*backend-node-temps* (target-arch-case
     545                                  (:x8632 x8632-temp-node-regs)
     546                                  (:x8664 x8664-temp-node-regs)))
     547           (*available-backend-node-temps* (target-arch-case
     548                                            (:x8632 x8632-temp-node-regs)
     549                                            (:x8664 x8664-temp-node-regs)))
     550           (*backend-imm-temps* (target-arch-case
     551                                 (:x8632 x8632-imm-regs)
     552                                 (:x8664 x8664-imm-regs)))
     553           (*available-backend-imm-temps* (target-arch-case
     554                                           (:x8632 x8632-imm-regs)
     555                                           (:x8664 x8664-imm-regs)))
     556           (*backend-crf-temps* (target-arch-case
     557                                 (:x8632 x8632-cr-fields)
     558                                 (:x8664 x8664-cr-fields)))
     559           (*available-backend-crf-temps* (target-arch-case
     560                                           (:x8632 x8632-cr-fields)
     561                                           (:x8664 x8664-cr-fields)))
     562           (*backend-fp-temps* (target-arch-case
     563                                (:x8632 x8632-temp-fp-regs)
     564                                (:x8664 x8664-temp-fp-regs)))
     565           (*available-backend-fp-temps* (target-arch-case
     566                                          (:x8632 x8632-temp-fp-regs)
     567                                          (:x8664 x8664-temp-fp-regs)))
    506568           (bits 0)
    507569           (*logical-register-counter* -1)
     
    559621                        (instruction (x86::make-x86-instruction))
    560622                        (end-code-tag (gensym))
     623                        (start-tag (gensym))
     624                        (srt-tag (gensym))
    561625                        debug-info)
    562626                   (make-x86-lap-label end-code-tag)
    563                    (x86-lap-directive frag-list :long `(ash (+ (- (:^ ,end-code-tag ) 8)
    564                                                              *x86-lap-entry-offset*) -3))
    565                    (x86-lap-directive frag-list :byte 0) ;regsave PC
    566                    (x86-lap-directive frag-list :byte 0) ;regsave ea
    567                    (x86-lap-directive frag-list :byte 0) ;regsave mask
    568 
     627                   (target-arch-case
     628                    (:x8664
     629                     (x86-lap-directive frag-list :long `(ash (+ (- (:^ ,end-code-tag ) 8)
     630                                                                 *x86-lap-entry-offset*) -3))
     631                     (x86-lap-directive frag-list :byte 0) ;regsave PC
     632                     (x86-lap-directive frag-list :byte 0) ;regsave ea
     633                     (x86-lap-directive frag-list :byte 0)) ;regsave mask
     634                    (:x8632
     635                     (make-x86-lap-label start-tag)
     636                     (make-x86-lap-label srt-tag)
     637                     (x86-lap-directive frag-list :short `(ash (+ (- (:^ ,end-code-tag) 4)
     638                                                                  *x86-lap-entry-offset*) -2))
     639                     (emit-x86-lap-label frag-list start-tag)))
    569640                   (x862-expand-vinsns vinsns frag-list instruction uuo-frag-list)
    570641                   (when (or *x862-double-float-constant-alist*
     
    583654                         (let* ((val (single-float-bits sfloat)))
    584655                           (x86-lap-directive frag-list :long val)))))
    585                    (x86-lap-directive frag-list :align 3)
    586                    (x86-lap-directive frag-list :quad x8664::function-boundary-marker)
     656                   (target-arch-case
     657                    (:x8632
     658                     (x86-lap-directive frag-list :align 2)
     659                     ;; start of self reference table
     660                     (x86-lap-directive frag-list :long 0)
     661                     (emit-x86-lap-label frag-list srt-tag)
     662                     ;; make space for self-reference offsets
     663                     (do-dll-nodes (frag frag-list)
     664                       (dolist (reloc (frag-relocs frag))
     665                         (when (eq (reloc-type reloc) :self)
     666                           (x86-lap-directive frag-list :long 0))))
     667                     (x86-lap-directive frag-list :long x8632::function-boundary-marker))
     668                    (:x8664
     669                     (x86-lap-directive frag-list :align 3)
     670                     (x86-lap-directive frag-list :quad x8664::function-boundary-marker)))
     671                   
    587672                   (emit-x86-lap-label frag-list end-code-tag)
     673                   
    588674                   (dolist (c (reverse *x862-constant-alist*))
    589675                     (let* ((vinsn-label (cdr c)))
     
    593679                                  vinsn-label)))
    594680                       (emit-x86-lap-label frag-list vinsn-label)
    595                        (x86-lap-directive frag-list :quad 0)))
    596                  
     681                       (target-arch-case
     682                        (:x8632
     683                         (x86-lap-directive frag-list :long 0))
     684                        (:x8664
     685                         (x86-lap-directive frag-list :quad 0)))))
     686                   
    597687                   (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc)))
    598688                     (setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit))))
     
    619709                                                           *x862-register-restore-ea*
    620710                                                           *x862-register-restore-count*))))
    621                      (when debug-info
    622                        (x86-lap-directive frag-list :quad 0))
    623                      (when fname
    624                        (x86-lap-directive frag-list :quad 0))
    625                      (x86-lap-directive frag-list :quad 0)
    626                      (relax-frag-list frag-list)
     711                     (target-arch-case
     712                      (:x8632
     713                       (when debug-info
     714                         (x86-lap-directive frag-list :long 0))
     715                       (when fname
     716                         (x86-lap-directive frag-list :long 0))
     717                       (x86-lap-directive frag-list :long 0))
     718                      (:x8664
     719                       (when debug-info
     720                         (x86-lap-directive frag-list :quad 0))
     721                       (when fname
     722                         (x86-lap-directive frag-list :quad 0))
     723                       (x86-lap-directive frag-list :quad 0)))
     724                     
     725                     (relax-frag-list frag-list)
    627726                     (apply-relocs frag-list)
    628727                     (fill-for-alignment frag-list)
    629                      (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr)
    630                      (setf (afunc-lfun afunc)
    631                            #+x86-target
    632                            (if (eq *host-backend* *target-backend*)
    633                              (create-x86-function fname frag-list *x862-constant-alist* bits debug-info)
    634                              (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info))
    635                            #-x86-target
    636                            (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)))
     728                     (target-arch-case
     729                      (:x8632
     730                       (let* ((label (find-x86-lap-label srt-tag))
     731                              (srt-frag (x86-lap-label-frag label))
     732                              (srt-index (x86-lap-label-offset label)))
     733                         ;; fill in self-reference offsets
     734                         (do-dll-nodes (frag frag-list)
     735                           (dolist (reloc (frag-relocs frag))
     736                             (when (eq (reloc-type reloc) :self)
     737                               (setf (frag-ref-32 srt-frag srt-index)
     738                                     (+ (frag-address frag) (reloc-pos reloc)))
     739                               (incf srt-index 4)))))
     740                       ;;(show-frag-bytes frag-list)
     741                       ))
     742                     
     743                     (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr)
     744                     (setf (afunc-lfun afunc)
     745                           #+x86-target
     746                           (if (eq *host-backend* *target-backend*)
     747                             (create-x86-function fname frag-list *x862-constant-alist* bits debug-info)
     748                             (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info))
     749                           #-x86-target
     750                           (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)))
    637751                   (x862-digest-symbols)))))
    638752          (backend-remove-labels))))
     
    650764  (let ((fwd-refs (afunc-fwd-refs afunc)))
    651765    (when fwd-refs
    652       (let* ((native-x8664-functions #-x8664-target nil
    653                                      #+x8664-target (eq *target-backend*
    654                                                         *host-backend*))
    655              (v (if native-x8664-functions
     766      (let* ((native-x86-functions #-x86-target nil
     767                                   #+x86-target (eq *target-backend*
     768                                                    *host-backend*))
     769             (v (if native-x86-functions
    656770                  (function-to-function-vector (afunc-lfun afunc))
    657771                  (afunc-lfun afunc)))
     
    660774        (dolist (ref fwd-refs)
    661775          (let* ((ref-fun (afunc-lfun ref)))
    662             (do* ((i (if native-x8664-functions
     776            (do* ((i (if native-x86-functions
    663777                       (%function-code-words
    664                         (%function-vector-to-function v))
     778                        (function-vector-to-function v))
    665779                       1)
    666780                     (1+ i)))
     
    689803                      (compiler-bug "Missing or bad ~s label: ~s"
    690804                                    (if start-p 'start 'end) sym)))
    691                   x8664::fulltag-function)))
     805                  (target-arch-case
     806                   (:x8632 x8632::fulltag-misc) ;xxx?
     807                   (:x8664 x8664::fulltag-function)))))
    692808          (destructuring-bind (var sym startlab endlab) info
    693809            (let* ((ea (var-ea var))
     
    780896;;; and to simple lexical variables.
    781897(defun x862-allocate-global-registers (fcells vcells all-vars no-regs)
    782   (if no-regs
     898  (if (or no-regs (target-arch-case (:x8632 t)))
    783899    (progn
    784900      (dolist (c fcells) (%rplacd c nil))
     
    792908      (do* ((things (%sort-list-no-key maybe #'%x862-bigger-cdr-than) (cdr things))
    793909            (n 0 (1+ n))
    794             (registers (target-arch-case (:x8664
    795                                           (list x8664::save0 x8664::save1 x8664::save2 x8664::save3))))
     910            (registers (target-arch-case
     911                        (:x8632 (error "no nvrs on x8632"))
     912                        (:x8664
     913                         (list x8664::save0 x8664::save1 x8664::save2 x8664::save3))))
    796914            (regno (pop registers) (pop registers))
    797915            (constant-alist ()))
     
    817935(defun x862-save-nvrs (seg n)
    818936  (declare (fixnum n))
    819   (when (> n 0)
    820     (setq *x862-compiler-register-save-label* (x862-emit-note seg :regsave))
    821     (with-x86-local-vinsn-macros (seg)
    822       (let* ((mask (target-arch-case (:x8664 x8664-nonvolatile-node-regs))))
    823         (dotimes (i n)
    824           (let* ((reg (1- (integer-length mask))))
    825             (x862-vpush-register seg reg :regsave reg 0)
    826             (setq mask (logandc2 mask (ash 1 reg)))))))
    827     (setq *x862-register-restore-ea* *x862-vstack*
    828           *x862-register-restore-count* n)))
     937  (target-arch-case
     938   ;; no nvrs on x8632
     939   (:x8664
     940    (when (> n 0)
     941      (setq *x862-compiler-register-save-label* (x862-emit-note seg :regsave))
     942      (with-x86-local-vinsn-macros (seg)
     943        (let* ((mask x8664-nonvolatile-node-regs))
     944          (dotimes (i n)
     945            (let* ((reg (1- (integer-length mask))))
     946              (x862-vpush-register seg reg :regsave reg 0)
     947              (setq mask (logandc2 mask (ash 1 reg)))))))
     948      (setq *x862-register-restore-ea* *x862-vstack*
     949            *x862-register-restore-count* n)))))
    829950
    830951
     
    837958
    838959(defun x862-restore-nvrs (seg ea nregs &optional (can-pop t))
    839   (when (and ea nregs)
    840     (with-x86-local-vinsn-macros (seg)
    841       (let* ((mask (target-arch-case (:x8664 x8664-nonvolatile-node-regs)))
    842              (regs ()))
    843         (dotimes (i nregs)
    844           (let* ((reg (1- (integer-length mask))))
    845             (push reg regs)
    846             (setq mask (logandc2 mask (ash 1 reg)))))
    847         (cond (can-pop
    848                (let* ((diff-in-bytes (- *x862-vstack* ea)))
    849                  (unless (zerop diff-in-bytes)
    850                    (x862-adjust-vstack diff-in-bytes)
    851                    (! vstack-discard (floor diff-in-bytes *x862-target-node-size*)))
    852                  (dolist (reg regs)
    853                    (! vpop-register reg))))
    854               (t
    855                (dolist (reg regs)
    856                  (! vframe-load reg (- ea *x862-target-node-size*) ea)
    857                  (decf ea *x862-target-node-size*))))))))
     960  (target-arch-case
     961   ;; no nvrs on x8632
     962   (:x8664
     963    (when (and ea nregs)
     964      (with-x86-local-vinsn-macros (seg)
     965        (let* ((mask x8664-nonvolatile-node-regs)
     966               (regs ()))
     967          (dotimes (i nregs)
     968            (let* ((reg (1- (integer-length mask))))
     969              (push reg regs)
     970              (setq mask (logandc2 mask (ash 1 reg)))))
     971          (cond (can-pop
     972                 (let* ((diff-in-bytes (- *x862-vstack* ea)))
     973                   (unless (zerop diff-in-bytes)
     974                     (x862-adjust-vstack diff-in-bytes)
     975                     (! vstack-discard (floor diff-in-bytes *x862-target-node-size*)))
     976                   (dolist (reg regs)
     977                     (! vpop-register reg))))
     978                (t
     979                 (dolist (reg regs)
     980                   (! vframe-load reg (- ea *x862-target-node-size*) ea)
     981                   (decf ea *x862-target-node-size*))))))))))
    858982
    859983
     
    10021126            (declare (fixnum offset))
    10031127            (! save-lisp-context-offset offset))))
    1004       (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
    1005         (let* ((nstackargs (length stack-args)))
    1006           (x862-set-vstack (* nstackargs *x862-target-node-size*))
    1007           (dotimes (i nstackargs)
    1008             (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil))
    1009           (if (>= nargs 3)
    1010             (push (x862-vpush-arg-register seg ($ x8664::arg_x) xvar) reg-vars))
    1011           (if (>= nargs 2)
    1012             (push (x862-vpush-arg-register seg ($ *x862-arg-y*) yvar) reg-vars))
    1013           (if (>= nargs 1)
    1014             (push (x862-vpush-arg-register seg ($ *x862-arg-z*) zvar) reg-vars))))
     1128      (target-arch-case
     1129       (:x8632
     1130        (destructuring-bind (&optional zvar yvar &rest stack-args) revargs
     1131          (let* ((nstackargs (length stack-args)))
     1132            (x862-set-vstack (* nstackargs *x862-target-node-size*))
     1133            (dotimes (i nstackargs)
     1134              (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil))
     1135            (if (>= nargs 2)
     1136              (push (x862-vpush-arg-register seg ($ *x862-arg-y*) yvar) reg-vars))
     1137            (if (>= nargs 1)
     1138              (push (x862-vpush-arg-register seg ($ *x862-arg-z*) zvar) reg-vars)))))
     1139       (:x8664
     1140        (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs
     1141          (let* ((nstackargs (length stack-args)))
     1142            (x862-set-vstack (* nstackargs *x862-target-node-size*))
     1143            (dotimes (i nstackargs)
     1144              (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil))
     1145            (if (>= nargs 3)
     1146              (push (x862-vpush-arg-register seg ($ x8664::arg_x) xvar) reg-vars))
     1147            (if (>= nargs 2)
     1148              (push (x862-vpush-arg-register seg ($ *x862-arg-y*) yvar) reg-vars))
     1149            (if (>= nargs 1)
     1150              (push (x862-vpush-arg-register seg ($ *x862-arg-z*) zvar) reg-vars))))))
    10151151      reg-vars)))
    10161152
     
    10381174          (! check-min-max-nargs min max)
    10391175          (! check-max-nargs max)))
    1040       (if (> min $numx8664argregs)
     1176      (if (> min *x862-target-num-arg-regs*)
    10411177        (! save-lisp-context-in-frame)
    10421178        (if (<= max *x862-target-num-arg-regs*)
     
    11291265            (dolist (f (%cdr form) (x862-branch seg xfer))
    11301266              (x862-form seg nil nil f ))
    1131             (apply fn seg vreg xfer (%cdr form)))
     1267            (apply fn seg vreg xfer (%cdr form)))
    11321268          (compiler-bug "x862-form ? ~s" form))))))
    11331269
     
    12081344    (if (eq vreg :push)
    12091345      (progn
    1210         (! vpush-fixnum x8664::nil-value)
     1346        (! vpush-fixnum (target-arch-case
     1347                         (:x8632 x8632::nil-value)
     1348                         (:x8664 x8664::nil-value)))
    12111349        (^))
    12121350      (progn
     
    12201358    (if (eq vreg :push)
    12211359      (progn
    1222         (! vpush-fixnum x8664::t-value)
     1360        (! vpush-fixnum (target-arch-case
     1361                         (:x8632 x8632::t-value)
     1362                         (:x8664 x8664::t-value)))
    12231363        (^))
    12241364      (progn
     
    13121452  (with-x86-local-vinsn-macros (seg)
    13131453    (if (typep form 'character)
    1314       (! vpush-fixnum (logior (ash (char-code form) 8) x8664::subtag-character))
     1454      (! vpush-fixnum (logior (ash (char-code form) 8)
     1455                              (arch::target-subtag-char (backend-target-arch *target-backend*))))
    13151456      (let* ((reg (x862-register-constant-p form)))
    13161457        (if reg
     
    13391480              (let* ((lab (x86-double-float-constant-label form)))
    13401481                (! load-double-float-constant vreg lab))))
    1341           (if (and (typep form '(unsigned-byte 32))
    1342                    (= (hard-regspec-class vreg) hard-reg-class-gpr)
    1343                    (= (get-regspec-mode vreg)
    1344                       hard-reg-class-gpr-mode-u32))
    1345             (x862-lri seg vreg form)
    1346             (ensuring-node-target
    1347                 (target vreg)
    1348               (if (characterp form)
    1349                 (! load-character-constant target (char-code form))
    1350                 (x862-store-immediate seg form target)))))
     1482          (target-arch-case
     1483           (:x8632
     1484            (if (and (= (hard-regspec-class vreg) hard-reg-class-gpr)
     1485                     (member (get-regspec-mode vreg)
     1486                             '(hard-reg-class-gpr-mode-u32
     1487                               hard-reg-class-gpr-mode-s32
     1488                               hard-reg-class-gpr-mode-address))
     1489                     (or (typep form '(unsigned-byte 32))
     1490                         (typep form '(signed-byte 32))))
     1491              ;; The bits fit.  Get them in the register somehow.
     1492              (if (typep form '(signed-byte 32))
     1493                (x862-lri seg vreg form)
     1494                (x862-lriu seg vreg form))
     1495              (ensuring-node-target (target vreg)
     1496                (if (characterp form)
     1497                  (! load-character-constant target (char-code form))
     1498                  (x862-store-immediate seg form target)))))
     1499           (:x8664
     1500            (if (and (typep form '(unsigned-byte 32))
     1501                     (= (hard-regspec-class vreg) hard-reg-class-gpr)
     1502                     (= (get-regspec-mode vreg)
     1503                        hard-reg-class-gpr-mode-u32))
     1504              (x862-lri seg vreg form)
     1505              (ensuring-node-target
     1506                  (target vreg)
     1507                (if (characterp form)
     1508                  (! load-character-constant target (char-code form))
     1509                  (x862-store-immediate seg form target)))))))
    13511510        (if (and (listp form) *load-time-eval-token* (eq (car form) *load-time-eval-token*))
    13521511          (x862-store-immediate seg form ($ *x862-temp0*))))
     
    14011560              )))))
    14021561
    1403 
    14041562(defun x862-box-s32 (seg node-dest s32-src)
    14051563  (with-x86-local-vinsn-macros (seg)
    14061564    (if (target-arch-case
    1407          
     1565         (:x8632 nil)
    14081566         (:x8664 t))
    14091567      (! box-fixnum node-dest s32-src)
     
    14171575  (with-x86-local-vinsn-macros (seg)
    14181576    (if (target-arch-case
     1577         (:x8632 (error "bug"))
    14191578         (:x8664 *x862-open-code-inline*))
    14201579      (let* ((no-overflow (backend-get-next-label)))
     
    14331592(defun x862-box-u32 (seg node-dest u32-src)
    14341593  (with-x86-local-vinsn-macros (seg)
    1435     (if (target-arch-case
    1436          
    1437          (:x8664 t))
    1438       (! box-fixnum node-dest u32-src)
     1594    (target-arch-case
     1595     (:x8632
    14391596      (let* ((arg_z ($ *x862-arg-z*))
    1440              (imm0 ($ *x862-imm0* :mode :u32)))
    1441         (x862-copy-register seg imm0 u32-src)
    1442         (! call-subprim (subprim-name->offset '.SPmakeu32))
    1443         (x862-copy-register seg node-dest arg_z)))))
     1597             (imm0 ($ *x862-imm0* :mode :u32)))
     1598        (x862-copy-register seg imm0 u32-src)
     1599        (! call-subprim (subprim-name->offset '.SPmakeu32))
     1600        (x862-copy-register seg node-dest arg_z)))
     1601     (:x8664
     1602      (! box-fixnum node-dest u32-src)))))
    14441603
    14451604(defun x862-box-u64 (seg node-dest u64-src)
    14461605  (with-x86-local-vinsn-macros (seg)
    14471606    (if (target-arch-case
    1448          
     1607         (:x8632 (error "bug"))
    14491608         (:x8664 *x862-open-code-inline*))
    14501609      (let* ((no-overflow (backend-get-next-label)))
     
    14601619        (! call-subprim (subprim-name->offset '.SPmakeu64))
    14611620        (x862-copy-register seg node-dest arg_z)))))
     1621
     1622(defun x862-single->heap (seg dest src)
     1623  (with-x86-local-vinsn-macros (seg)
     1624    (! setup-single-float-allocation)
     1625    (! %allocate-uvector dest)
     1626    (! set-single-float-value dest src)))
    14621627
    14631628(defun x862-double->heap (seg dest src)
     
    15081673                          (! single->node target fp-val)))))
    15091674                   (t
    1510                     (with-imm-target () temp
    1511                       (if is-signed
    1512                         (! misc-ref-c-s32 temp src index-known-fixnum)
    1513                         (! misc-ref-c-u32 temp src index-known-fixnum))
    1514                       (ensuring-node-target (target vreg)
    1515                         (if (eq type-keyword :simple-string)
    1516                           (! u32->char target temp)
    1517                           (! box-fixnum target temp))))))
    1518              (with-imm-target () idx-reg
    1519                (if index-known-fixnum
    1520                  (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    1521                  (! scale-32bit-misc-index idx-reg unscaled-idx))
    1522                (cond ((eq type-keyword :single-float-vector)
    1523                       (with-fp-target () (fp-val :single-float)
    1524                         (if (and (eql vreg-class hard-reg-class-fpr)
    1525                                  (eql vreg-mode hard-reg-class-fpr-mode-single))
    1526                           (setq fp-val vreg))
    1527                         (! misc-ref-single-float fp-val src idx-reg)
    1528                         (if (eq vreg-class hard-reg-class-fpr)
    1529                           (<- fp-val)
    1530                           (ensuring-node-target (target vreg)
    1531                             (! single->node target fp-val)))))
    1532                      (t (with-imm-target () temp
    1533                           (if is-signed
    1534                             (! misc-ref-s32 temp src idx-reg)
    1535                             (! misc-ref-u32 temp src idx-reg))
    1536                           (ensuring-node-target (target vreg)
    1537                             (if (eq type-keyword :simple-string)
    1538                               (! u32->char target temp)
    1539                               (! box-fixnum target temp)))))))))
     1675                    (with-additional-imm-reg ()
     1676                      (with-imm-target () temp
     1677                        (if is-signed
     1678                          (! misc-ref-c-s32 temp src index-known-fixnum)
     1679                          (! misc-ref-c-u32 temp src index-known-fixnum))
     1680                        (ensuring-node-target (target vreg)
     1681                          (if (eq type-keyword :simple-string)
     1682                            (! u32->char target temp)
     1683                            (target-arch-case
     1684                             (:x8632
     1685                              (if is-signed
     1686                                (x862-box-s32 seg target temp)
     1687                                (x862-box-u32 seg target temp)))
     1688                             (:x8664
     1689                              (! box-fixnum target temp)))))))))
     1690             (with-imm-target () idx-reg
     1691               (if index-known-fixnum
     1692                 (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     1693                 (! scale-32bit-misc-index idx-reg unscaled-idx))
     1694               (cond ((eq type-keyword :single-float-vector)
     1695                      (with-fp-target () (fp-val :single-float)
     1696                        (if (and (eql vreg-class hard-reg-class-fpr)
     1697                                 (eql vreg-mode hard-reg-class-fpr-mode-single))
     1698                          (setq fp-val vreg))
     1699                        (! misc-ref-single-float fp-val src idx-reg)
     1700                        (if (eq vreg-class hard-reg-class-fpr)
     1701                          (<- fp-val)
     1702                          (ensuring-node-target (target vreg)
     1703                            (! single->node target fp-val)))))
     1704                     (t
     1705                      (with-imm-target () temp
     1706                        (if is-signed
     1707                          (! misc-ref-s32 temp src idx-reg)
     1708                          (! misc-ref-u32 temp src idx-reg))
     1709                        (ensuring-node-target (target vreg)
     1710                          (if (eq type-keyword :simple-string)
     1711                            (! u32->char target temp)
     1712                            (target-arch-case
     1713                             (:x8632 (if is-signed
     1714                                       (x862-box-s32 seg target temp)
     1715                                       (x862-box-u32 seg target temp)))
     1716                             (:x8664 (! box-fixnum target temp)))))))))))
    15401717          (is-8-bit
    15411718           (with-imm-target () temp
     
    15441721                 (! misc-ref-c-s8 temp src index-known-fixnum)
    15451722                 (! misc-ref-c-u8 temp src index-known-fixnum))
    1546                (with-imm-target () idx-reg
    1547                  (if index-known-fixnum
    1548                    (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
    1549                    (! scale-8bit-misc-index idx-reg unscaled-idx))
    1550                  (if is-signed
    1551                    (! misc-ref-s8 temp src idx-reg)
    1552                    (! misc-ref-u8 temp src idx-reg))))
     1723               (with-additional-imm-reg ()
     1724                 (with-imm-target () idx-reg
     1725                   (if index-known-fixnum
     1726                     (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     1727                     (! scale-8bit-misc-index idx-reg unscaled-idx))
     1728                   (if is-signed
     1729                     (! misc-ref-s8 temp src idx-reg)
     1730                     (! misc-ref-u8 temp src idx-reg)))))
    15531731             (if (eq type-keyword :simple-string)
    15541732               (ensuring-node-target (target vreg)
     
    15671745                   (! misc-ref-c-s16 temp src index-known-fixnum)
    15681746                   (! misc-ref-c-u16 temp src index-known-fixnum))
    1569                 (with-imm-target () idx-reg
    1570                    (if index-known-fixnum
    1571                      (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
    1572                      (! scale-16bit-misc-index idx-reg unscaled-idx))
    1573                    (if is-signed
    1574                      (! misc-ref-s16 temp src idx-reg)
    1575                      (! misc-ref-u16 temp src idx-reg))))
     1747                (with-imm-target () idx-reg
     1748                   (if index-known-fixnum
     1749                     (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     1750                     (! scale-16bit-misc-index idx-reg unscaled-idx))
     1751                   (if is-signed
     1752                     (! misc-ref-s16 temp src idx-reg)
     1753                     (! misc-ref-u16 temp src idx-reg))))
    15761754               (! box-fixnum target temp))))
    15771755          ;; Down to the dregs.
     
    16621840
    16631841(defun x862-aset2 (seg vreg xfer  array i j new safe type-keyword  dim0 dim1)
     1842  (target-arch-case
     1843   (:x8632 (error "not for x8632 yet")))
    16641844  (with-x86-local-vinsn-macros (seg target)
    16651845    (let* ((i-known-fixnum (acode-fixnum-form-p i))
     
    17301910
    17311911(defun x862-aset3 (seg vreg xfer  array i j k new safe type-keyword  dim0 dim1 dim2)
     1912  (target-arch-case
     1913   (:x8632 (error "not for x8632 yet")))
    17321914  (with-x86-local-vinsn-macros (seg target)
    17331915    (let* ((i-known-fixnum (acode-fixnum-form-p i))
     
    17571939        (if constidx
    17581940          (multiple-value-setq (src val-reg)
    1759             (x862-two-targeted-reg-forms seg array ($ x8664::temp0) new val-reg))
     1941            (x862-two-targeted-reg-forms seg array ($ *x862-temp0*) new val-reg))
    17601942          (progn
    17611943            (setq src ($ x8664::temp1)
     
    18081990
    18091991(defun x862-aref2 (seg vreg xfer array i j safe typekeyword &optional dim0 dim1)
     1992  (target-arch-case
     1993   (:x8632 (error "not for x8632 yet")))
    18101994  (with-x86-local-vinsn-macros (seg vreg xfer)
    18111995    (let* ((i-known-fixnum (acode-fixnum-form-p i))
     
    18512035
    18522036(defun x862-aref3 (seg vreg xfer array i j k safe typekeyword &optional dim0 dim1 dim2)
     2037  (target-arch-case
     2038   (:x8632 (error "not for x8632 yet")))
    18532039  (with-x86-local-vinsn-macros (seg vreg xfer)
    18542040    (let* ((i-known-fixnum (acode-fixnum-form-p i))
     
    21372323                            (x862-lri seg reg constval)
    21382324                            (if *x862-reckless*
    2139                               (! %unbox-u32 reg result-reg)
     2325                              (target-arch-case
     2326                               (:x8632 (! unbox-u32 reg result-reg))
     2327                               (:x8664 (! %unbox-u32 reg result-reg)))
    21402328                              (! unbox-u32 reg result-reg)))))
    21412329                   reg)))
     
    21792367                   reg)))))))
    21802368
     2369
     2370;;; xxx
    21812371(defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization)
    21822372  (with-x86-local-vinsn-macros (seg vreg xfer)
     
    21902380           (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :signed-64-bit-vector :fixnum-vector))))
    21912381      (cond ((and is-node node-value-needs-memoization)
    2192              (unless (and (eql (hard-regspec-value src) x8664::arg_x)
     2382             (unless (and (eql (hard-regspec-value src) (target-arch-case
     2383                                                         (:x8632 x8632::temp0)
     2384                                                         (:x8664 x8664::arg_x)))
    21932385                          (eql (hard-regspec-value unscaled-idx) *x862-arg-y*)
    21942386                          (eql (hard-regspec-value val-reg) *x862-arg-z*))
     
    22102402                   (! misc-set-node val-reg src unscaled-idx)))))
    22112403            (t
    2212              (with-imm-target (unboxed-val-reg) scaled-idx
    2213                (cond
    2214                  (is-64-bit
    2215                   (if (and index-known-fixnum
    2216                            (<= index-known-fixnum
    2217                                (arch::target-max-64-bit-constant-index arch)))
    2218                     (if (eq type-keyword :double-float-vector)
    2219                       (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
    2220                       (if is-signed
    2221                         (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
    2222                         (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
    2223                     (progn
    2224                       (if index-known-fixnum
    2225                         (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
    2226                       (if (eq type-keyword :double-float-vector)
    2227                         (! misc-set-double-float unboxed-val-reg src unscaled-idx)
    2228                         (if is-signed
    2229                           (! misc-set-s64 unboxed-val-reg src unscaled-idx)
    2230                           (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
    2231                  (is-32-bit
    2232                   (if (and index-known-fixnum
    2233                            (<= index-known-fixnum
    2234                                (arch::target-max-32-bit-constant-index arch)))
    2235                     (if (eq type-keyword :single-float-vector)
    2236                       (if (eq (hard-regspec-class unboxed-val-reg)
    2237                               hard-reg-class-fpr)
    2238                         (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
    2239                         (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
    2240                       (if is-signed
    2241                         (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
    2242                         (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
    2243                     (progn
    2244                       (if index-known-fixnum
    2245                         (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    2246                         (! scale-32bit-misc-index scaled-idx unscaled-idx))
    2247                       (if (and (eq type-keyword :single-float-vector)
    2248                                (eql (hard-regspec-class unboxed-val-reg)
    2249                                     hard-reg-class-fpr))
    2250                         (! misc-set-single-float unboxed-val-reg src scaled-idx)
    2251                         (if is-signed
    2252                           (! misc-set-s32 unboxed-val-reg src scaled-idx)
    2253                           (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
    2254                  (is-16-bit
    2255                   (if (and index-known-fixnum
    2256                            (<= index-known-fixnum
    2257                                (arch::target-max-16-bit-constant-index arch)))
    2258                     (if is-signed
    2259                       (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
    2260                       (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
    2261                     (progn
    2262                       (if index-known-fixnum
    2263                         (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
    2264                         (! scale-16bit-misc-index scaled-idx unscaled-idx))
    2265                       (if is-signed
    2266                         (! misc-set-s16 unboxed-val-reg src scaled-idx)
    2267                         (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
    2268                  (is-8-bit
    2269                   (if (and index-known-fixnum
    2270                            (<= index-known-fixnum
    2271                                (arch::target-max-8-bit-constant-index arch)))
    2272                     (if is-signed
    2273                       (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
    2274                       (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
    2275                     (progn
    2276                       (if index-known-fixnum
    2277                         (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
    2278                         (! scale-8bit-misc-index scaled-idx unscaled-idx))
    2279                       (if is-signed
    2280                         (! misc-set-s8 unboxed-val-reg src scaled-idx)
    2281                         (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
    2282                  (is-1-bit
    2283                   (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    2284                     (if constval
    2285                       (if (zerop constval)
    2286                         (! set-constant-bit-to-zero src index-known-fixnum)
    2287                         (! set-constant-bit-to-one src index-known-fixnum))
    2288                       (progn
    2289                         (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
    2290                     (progn
    2291                       (if index-known-fixnum
    2292                         (x862-lri seg scaled-idx index-known-fixnum)
    2293                         (! scale-1bit-misc-index scaled-idx unscaled-idx))
     2404             (with-additional-imm-reg (src unscaled-idx val-reg)
     2405               (with-imm-target (unboxed-val-reg) scaled-idx
     2406                 (cond
     2407                   (is-64-bit
     2408                    (if (and index-known-fixnum
     2409                             (<= index-known-fixnum
     2410                                 (arch::target-max-64-bit-constant-index arch)))
     2411                      (if (eq type-keyword :double-float-vector)
     2412                        (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
     2413                        (if is-signed
     2414                          (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
     2415                          (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
     2416                      (progn
     2417                        (if index-known-fixnum
     2418                          (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
     2419                        (if (eq type-keyword :double-float-vector)
     2420                          (! misc-set-double-float unboxed-val-reg src unscaled-idx)
     2421                          (if is-signed
     2422                            (! misc-set-s64 unboxed-val-reg src unscaled-idx)
     2423                            (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
     2424                   (is-32-bit
     2425                    (if (and index-known-fixnum
     2426                             (<= index-known-fixnum
     2427                                 (arch::target-max-32-bit-constant-index arch)))
     2428                      (if (eq type-keyword :single-float-vector)
     2429                        (if (eq (hard-regspec-class unboxed-val-reg)
     2430                                hard-reg-class-fpr)
     2431                          (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
     2432                          (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
     2433                        (if is-signed
     2434                          (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
     2435                          (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
     2436                      (progn
     2437                        (if index-known-fixnum
     2438                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     2439                          (! scale-32bit-misc-index scaled-idx unscaled-idx))
     2440                        (if (and (eq type-keyword :single-float-vector)
     2441                                 (eql (hard-regspec-class unboxed-val-reg)
     2442                                      hard-reg-class-fpr))
     2443                          (! misc-set-single-float unboxed-val-reg src scaled-idx)
     2444                          (if is-signed
     2445                            (! misc-set-s32 unboxed-val-reg src scaled-idx)
     2446                            (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
     2447                   (is-16-bit
     2448                    (if (and index-known-fixnum
     2449                             (<= index-known-fixnum
     2450                                 (arch::target-max-16-bit-constant-index arch)))
     2451                      (if is-signed
     2452                        (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
     2453                        (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
     2454                      (progn
     2455                        (if index-known-fixnum
     2456                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     2457                          (! scale-16bit-misc-index scaled-idx unscaled-idx))
     2458                        (if is-signed
     2459                          (! misc-set-s16 unboxed-val-reg src scaled-idx)
     2460                          (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
     2461                   (is-8-bit
     2462                    (if (and index-known-fixnum
     2463                             (<= index-known-fixnum
     2464                                 (arch::target-max-8-bit-constant-index arch)))
     2465                      (if is-signed
     2466                        (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
     2467                        (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
     2468                      (progn
     2469                        (if index-known-fixnum
     2470                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     2471                          (! scale-8bit-misc-index scaled-idx unscaled-idx))
     2472                        (if is-signed
     2473                          (! misc-set-s8 unboxed-val-reg src scaled-idx)
     2474                          (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
     2475                   (is-1-bit
     2476                    (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    22942477                      (if constval
    22952478                        (if (zerop constval)
    2296                           (! nset-variable-bit-to-zero src scaled-idx)
    2297                           (! nset-variable-bit-to-one src scaled-idx))
     2479                          (! set-constant-bit-to-zero src index-known-fixnum)
     2480                          (! set-constant-bit-to-one src index-known-fixnum))
    22982481                        (progn
    2299                           (! nset-variable-bit-to-variable-value src scaled-idx val-reg))))))))))
     2482                          (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
     2483                      (progn
     2484                        (if index-known-fixnum
     2485                          (x862-lri seg scaled-idx index-known-fixnum)
     2486                          (! scale-1bit-misc-index scaled-idx unscaled-idx))
     2487                        (if constval
     2488                          (if (zerop constval)
     2489                            (! nset-variable-bit-to-zero src scaled-idx)
     2490                            (! nset-variable-bit-to-one src scaled-idx))
     2491                          (progn
     2492                            (! nset-variable-bit-to-variable-value src scaled-idx val-reg)))))))))))
    23002493      (when (and vreg val-reg) (<- val-reg))
    23012494      (^))))
     
    23102503           (needs-memoization (and is-node (x862-acode-needs-memoization value)))
    23112504           (index-known-fixnum (acode-fixnum-form-p index)))
    2312       (let* ((src ($ x8664::arg_x))
     2505      (let* ((src (target-arch-case
     2506                   (:x8632 ($ x8632::temp0))
     2507                   (:x8664 ($ x8664::arg_x))))
    23132508             (unscaled-idx ($ *x862-arg-y*))
    23142509             (result-reg ($ *x862-arg-z*)))
     
    23202515              (t
    23212516               (setq result-reg (x862-target-reg-for-aset vreg type-keyword))
    2322                (x862-three-targeted-reg-forms seg
    2323                                               vector src
    2324                                               index unscaled-idx
    2325                                               value result-reg)))
     2517               (target-arch-case
     2518                (:x8632
     2519                 (with-node-temps (src) ()
     2520                   (x862-three-targeted-reg-forms seg
     2521                                                  vector src
     2522                                                  index unscaled-idx
     2523                                                  value result-reg)))
     2524                (:x8664
     2525                 (x862-three-targeted-reg-forms seg
     2526                                                vector src
     2527                                                index unscaled-idx
     2528                                                value result-reg)))))
    23262529        (when safe
    2327           (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
    2328                  (value (if (eql (hard-regspec-class result-reg)
    2329                                  hard-reg-class-gpr)
    2330                           (hard-regspec-value result-reg))))
    2331             (when (and value (logbitp value *available-backend-imm-temps*))
    2332               (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*)))
    2333             (if (typep safe 'fixnum)
    2334               (! trap-unless-typecode= src safe))
    2335             (unless index-known-fixnum
    2336               (! trap-unless-fixnum unscaled-idx))
    2337             (! check-misc-bound unscaled-idx src)))
     2530          (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     2531                 (value (if (eql (hard-regspec-class result-reg)
     2532                                 hard-reg-class-gpr)
     2533                          (hard-regspec-value result-reg)))
     2534                 (result-is-imm nil))
     2535            (when (and value (logbitp value *available-backend-imm-temps*))
     2536              (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))
     2537              (setq result-is-imm t))
     2538            (if (typep safe 'fixnum)
     2539              (if result-is-imm
     2540                (with-additional-imm-reg (src safe)
     2541                  (! trap-unless-typecode= src safe))
     2542                (! trap-unless-typecode= src safe)))
     2543            (unless index-known-fixnum
     2544              (! trap-unless-fixnum unscaled-idx))
     2545            (if result-is-imm
     2546              (with-additional-imm-reg (unscaled-idx src)
     2547                (! check-misc-bound unscaled-idx src))
     2548              (! check-misc-bound unscaled-idx src))))
    23382549        (x862-vset1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum result-reg (x862-unboxed-reg-for-aset seg type-keyword result-reg safe constval) constval needs-memoization)))))
    23392550
     
    24712682    (! emit-aligned-label (aref *backend-labels* labelnum))
    24722683    (@ labelnum)
    2473     (! recover-fn-from-rip)))
     2684    (target-arch-case
     2685     (:x8632
     2686      (! recover-fn))
     2687     (:x8664
     2688      (! recover-fn-from-rip)))))
    24742689
    24752690 
     
    25222737          (x862-set-nargs seg (%i- nargs 1))
    25232738                                        ; .SPspread-lexpr-z & .SPspreadargz preserve temp1
     2739          (target-arch-case
     2740           (:x8632
     2741            (! save-node-register-to-spill-area *x862-temp0*)))
    25242742          (if (eq spread-p 0)
    2525             (! spread-lexpr)
     2743            (! spread-lexpr)
    25262744            (! spread-list))
     2745          (target-arch-case
     2746           (:x8632
     2747            (! load-node-register-from-spill-area *x862-temp0*)))
     2748
    25272749          (when (and tail-p *x862-register-restore-count*)
    25282750            (x862-restore-nvrs seg *x862-register-restore-ea* *x862-register-restore-count* nil)))
     
    25332755        (if (not tail-p)
    25342756          (if (x862-mvpass-p xfer)
    2535             (let* ((call-reg (if symp ($ x8664::fname) ($ x8664::temp0))))
     2757            (let* ((call-reg (if symp ($ *x862-fname*) ($ *x862-temp0*))))
    25362758              (unless mvpass-label (compiler-bug "no label for mvpass"))
    25372759              (if label-p
     
    26482870             (arch (backend-target-arch *target-backend*))
    26492871             (dest ($ *x862-arg-z*))
    2650              (vsize (+ (length inherited-vars)
    2651                        5                ; %closure-code%, afunc
     2872             (vsize (+ (length inherited-vars)
     2873                       (target-arch-case
     2874                        (:x8632 7)
     2875                        (:x8664 5))     ; %closure-code%, afunc
    26522876                       1)))             ; lfun-bits
    26532877        (declare (list inherited-vars))
    2654         (let* ((cell 4))
     2878        (let* ((cell (target-arch-case (:x8632 6)
     2879                                       (:x8664 4))))
    26552880          (declare (fixnum cell))
    26562881          (if downward-p
     
    26652890                        *x862-imm0*
    26662891                        (arch::make-vheader vsize (nx-lookup-target-uvector-subtag :function)))
    2667               (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) (target-arch-case  (:x8664 x8664::fulltag-misc))))
     2892              (target-arch-case
     2893               (:x8632
     2894                (! setup-uvector-allocation *x862-imm0*)
     2895                (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
     2896               (:x8664
     2897                (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
    26682898              (! %allocate-uvector dest)))
    26692899          (! init-nclosure *x862-arg-z*)
    2670           (x862-store-immediate seg (x862-afunc-lfun-ref afunc) x8664::ra0)
    2671           (with-node-temps (*x862-arg-z*) (t0 t1 t2 t3)
    2672             (do* ((func x8664::ra0 nil))
    2673                  ((null inherited-vars))
    2674               (let* ((t0r (or func (if inherited-vars (var-to-reg (pop inherited-vars) t0))))
    2675                      (t1r (if inherited-vars (var-to-reg (pop inherited-vars) t1)))
    2676                      (t2r (if inherited-vars (var-to-reg (pop inherited-vars) t2)))
    2677                      (t3r (if inherited-vars (var-to-reg (pop inherited-vars) t3))))
    2678                 (setq cell (set-some-cells dest cell t0r t1r t2r t3r)))))
    2679           (x862-lri seg *x862-arg-y* (ash (logior (ash 1 $lfbits-noname-bit) (ash 1 $lfbits-trampoline-bit)) *x862-target-fixnum-shift*))
     2900          ;;; xxx --- x8632 likely to have register conflicts with *x862-ra0*
     2901          (x862-store-immediate seg (x862-afunc-lfun-ref afunc) *x862-ra0*)
     2902          (target-arch-case
     2903           (:x8632
     2904            (with-node-temps (*x862-arg-z*) (t0)
     2905              (do* ((func *x862-ra0* nil))
     2906                   ((null inherited-vars))
     2907                (let* ((t0r (or func (if inherited-vars
     2908                                       (var-to-reg (pop inherited-vars) t0)))))
     2909                  (! misc-set-c-node t0r dest cell)
     2910                  (incf cell)))))
     2911           (:x8664
     2912            (with-node-temps (*x862-arg-z*) (t0 t1 t2 t3)
     2913              (do* ((func *x862-ra0* nil))
     2914                   ((null inherited-vars))
     2915                (let* ((t0r (or func (if inherited-vars (var-to-reg (pop inherited-vars) t0))))
     2916                       (t1r (if inherited-vars (var-to-reg (pop inherited-vars) t1)))
     2917                       (t2r (if inherited-vars (var-to-reg (pop inherited-vars) t2)))
     2918                       (t3r (if inherited-vars (var-to-reg (pop inherited-vars) t3))))
     2919                  (setq cell (set-some-cells dest cell t0r t1r t2r t3r)))))))
     2920          (x862-lri seg *x862-arg-y* (ash (logior (ash -1 $lfbits-noname-bit) (ash 1 $lfbits-trampoline-bit)) *x862-target-fixnum-shift*))
    26802921          (! misc-set-c-node *x862-arg-y* dest cell))
    26812922        (! finalize-closure dest)
     
    27643005               (yform (%cadr revregargs))
    27653006               (xform (%caddr revregargs)))
    2766           (if (eq 3 nregs)
    2767             (x862-three-targeted-reg-forms seg xform ($ x8664::arg_x) yform ($ *x862-arg-y*) zform ($ *x862-arg-z*))
    2768             (if (eq 2 nregs)
    2769               (x862-two-targeted-reg-forms seg yform ($ *x862-arg-y*) zform ($ *x862-arg-z*))
    2770               (x862-one-targeted-reg-form seg zform ($ *x862-arg-z*))))))
     3007          (if (eq 3 nregs)
     3008            (progn
     3009              (target-arch-case (:x8632 (compiler-bug "3 reg args on x8632?")))
     3010              (x862-three-targeted-reg-forms seg xform ($ x8664::arg_x)
     3011                                             yform ($ *x862-arg-y*)
     3012                                             zform ($ *x862-arg-z*)))
     3013            (if (eq 2 nregs)
     3014              (x862-two-targeted-reg-forms seg yform ($ *x862-arg-y*) zform ($ *x862-arg-z*))
     3015              (x862-one-targeted-reg-form seg zform ($ *x862-arg-z*))))))
    27713016      n)))
    27723017
     
    27773022    (when (car args)
    27783023      (! reserve-outgoing-frame)
    2779       (x862-new-vstack-lcell :reserverd *x862-target-lcell-size* 0 nil)
    2780       (x862-new-vstack-lcell :reserverd *x862-target-lcell-size* 0 nil)
     3024      (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil)
     3025      (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil)
    27813026      (setq *x862-vstack* (+  *x862-vstack* (* 2 *x862-target-node-size*))))
    27823027    (x862-formlist seg (car args) (cadr args))))
     
    28623107        (setq vinsn (x862-vpush-register seg areg :node-temp))
    28633108        (if a-single
    2864           (progn
    2865             (setq vinsn (! vpush-single-float areg))
    2866             (x862-new-vstack-lcell :single-float *x862-target-lcell-size* 0 nil)
    2867             (x862-adjust-vstack *x862-target-node-size*))
    2868           (progn
     3109          (target-arch-case
     3110           (:x8632
     3111            (setq vinsn (! temp-push-single-float areg))
     3112            (incf *x862-cstack* *x862-target-dnode-size*))
     3113           (:x8664
     3114            (setq vinsn (! vpush-single-float areg))
     3115            (x862-new-vstack-lcell :single-float *x862-target-lcell-size* 0 nil)
     3116            (x862-adjust-vstack *x862-target-node-size*)))
     3117          (target-arch-case
     3118           (:x8632
     3119            (if a-float
     3120              (progn
     3121                (setq vinsn (! temp-push-double-float areg))
     3122                (incf *x862-cstack* 16))
     3123              (progn
     3124                (setq vinsn (! temp-push-unboxed-word areg))
     3125                (incf *x862-cstack* *x862-target-dnode-size*))))
     3126           (:x8664
    28693127            (setq vinsn
    28703128                  (if a-float
    28713129                    (! temp-push-double-float areg)
    28723130                    (! temp-push-unboxed-word areg)))
    2873             (setq *x862-cstack* (+ *x862-cstack* 16)))))
     3131            (setq *x862-cstack* (+ *x862-cstack* 16))))))
    28743132      vinsn)))
    28753133
     
    28833141        (setq vinsn (x862-vpop-register seg areg))
    28843142        (if a-single
    2885           (progn
     3143          (target-arch-case
     3144           (:x8632
     3145            (setq vinsn (! temp-pop-single-float areg))
     3146            (decf *x862-cstack* *x862-target-dnode-size*))
     3147           (:x8664
    28863148            (setq vinsn (! vpop-single-float areg))
    28873149            (setq *x862-top-vstack-lcell* (lcell-parent *x862-top-vstack-lcell*))
    2888             (x862-adjust-vstack (- *x862-target-node-size*)))
    2889           (progn
     3150            (x862-adjust-vstack (- *x862-target-node-size*))))
     3151          (target-arch-case
     3152           (:x8632
     3153            (if a-float
     3154              (progn
     3155                (setq vinsn (! temp-pop-double-float areg))
     3156                (decf *x862-cstack* 16))
     3157              (progn
     3158                (setq vinsn (! temp-pop-unboxed-word areg))
     3159                (decf *x862-cstack* *x862-target-dnode-size*))))
     3160           (:x8664
    28903161            (setq vinsn
    28913162                  (if a-float
    28923163                    (! temp-pop-double-float areg)
    28933164                    (! temp-pop-unboxed-word areg)))
    2894             (setq *x862-cstack* (- *x862-cstack* 16)))))
     3165            (setq *x862-cstack* (- *x862-cstack* 16))))))
    28953166      vinsn)))
    28963167
     
    29053176             (if (= mode hard-reg-class-gpr-mode-node)
    29063177               ($ *x862-arg-z*)
    2907                (make-wired-lreg x8664::imm0 :mode mode)))
     3178               (make-wired-lreg *x862-imm0* :mode mode)))
    29083179            (t (compiler-bug "Unknown register class for reg ~s" reg))))))
    29093180
     
    32093480    (! lri reg value)))
    32103481
     3482;;; unsigned variant
     3483(defun x862-lriu (seg reg value)
     3484  (with-x86-local-vinsn-macros (seg)
     3485    (! lriu reg value)))
    32113486
    32123487(defun x862-multiple-value-body (seg form)
     
    33523627                (setq cr-bit (x862-reverse-cr-bit cr-bit)))
    33533628            (^ cr-bit true-p))
    3354         (with-imm-target ()
    3355           (ireg :natural)
    3356             (with-imm-target 
     3629        (with-imm-target () (ireg :natural)
     3630          (with-additional-imm-reg ()
     3631            (with-imm-target
    33573632                (ireg) (jreg :natural)
    33583633                (x862-two-targeted-reg-forms seg i ireg j jreg)
    3359                 (x862-compare-natural-registers seg vreg xfer ireg jreg cr-bit true-p)))))))
     3634                (x862-compare-natural-registers seg vreg xfer ireg jreg cr-bit true-p))))))))
    33603635
    33613636
     
    36153890                ;; lots of redundancy here.
    36163891                (target-arch-case
     3892                 (:x8632
     3893                  (ecase dest-mode
     3894                    (#.hard-reg-class-gpr-mode-node ; boxed result.
     3895                     (case src-mode
     3896                       (#.hard-reg-class-gpr-mode-node
     3897                        (unless (eql  dest-gpr src-gpr)
     3898                          (! copy-gpr dest src)))
     3899                       (#.hard-reg-class-gpr-mode-u32
     3900                        (x862-box-u32 seg dest src))
     3901                       (#.hard-reg-class-gpr-mode-s32
     3902                        (x862-box-s32 seg dest src))
     3903                       (#.hard-reg-class-gpr-mode-u16
     3904                        (! box-fixnum dest src))
     3905                       (#.hard-reg-class-gpr-mode-s16
     3906                        (! box-fixnum dest src))
     3907                       (#.hard-reg-class-gpr-mode-u8
     3908                        (! box-fixnum dest src))
     3909                       (#.hard-reg-class-gpr-mode-s8
     3910                        (! box-fixnum dest src))
     3911                       (#.hard-reg-class-gpr-mode-address
     3912                        (x862-macptr->heap seg dest src))))
     3913                    ((#.hard-reg-class-gpr-mode-u32
     3914                      #.hard-reg-class-gpr-mode-address)
     3915                     (case src-mode
     3916                       (#.hard-reg-class-gpr-mode-node
     3917                        (let* ((src-type (get-node-regspec-type-modes src)))
     3918                          (declare (fixnum src-type))
     3919                          (case dest-mode
     3920                            (#.hard-reg-class-gpr-mode-u32
     3921                             (! unbox-u32 dest src))
     3922                            (#.hard-reg-class-gpr-mode-address
     3923                             (unless (or (logbitp #.hard-reg-class-gpr-mode-address src-type)
     3924                                         *x862-reckless*)
     3925                               (! trap-unless-macptr src))
     3926                             (! deref-macptr dest src)))))
     3927                       ((#.hard-reg-class-gpr-mode-u32
     3928                         #.hard-reg-class-gpr-mode-s32
     3929                         #.hard-reg-class-gpr-mode-address)
     3930                        (unless (eql  dest-gpr src-gpr)
     3931                          (! copy-gpr dest src)))
     3932                       (#.hard-reg-class-gpr-mode-u16
     3933                        (! u16->u32 dest src))                 
     3934                       (#.hard-reg-class-gpr-mode-s16
     3935                        (! s16->s32 dest src))
     3936                       (#.hard-reg-class-gpr-mode-u8
     3937                        (! u8->u32 dest src))
     3938                       (#.hard-reg-class-gpr-mode-s8
     3939                        (! s8->s32 dest src))))
     3940                    (#.hard-reg-class-gpr-mode-s32
     3941                     (case src-mode
     3942                       (#.hard-reg-class-gpr-mode-node
     3943                        (! unbox-s32 dest src))
     3944                       ((#.hard-reg-class-gpr-mode-u32
     3945                         #.hard-reg-class-gpr-mode-s32
     3946                         #.hard-reg-class-gpr-mode-address)
     3947                        (unless (eql  dest-gpr src-gpr)
     3948                          (! copy-gpr dest src)))
     3949                       (#.hard-reg-class-gpr-mode-u16
     3950                        (! u16->u32 dest src))                 
     3951                       (#.hard-reg-class-gpr-mode-s16
     3952                        (! s16->s32 dest src))
     3953                       (#.hard-reg-class-gpr-mode-u8
     3954                        (! u8->u32 dest src))
     3955                       (#.hard-reg-class-gpr-mode-s8
     3956                        (! s8->s32 dest src))))
     3957                    (#.hard-reg-class-gpr-mode-u16
     3958                     (case src-mode
     3959                       (#.hard-reg-class-gpr-mode-node
     3960                        (! unbox-u16 dest src))
     3961                       ((#.hard-reg-class-gpr-mode-u8
     3962                         #.hard-reg-class-gpr-mode-s8)
     3963                        (! u8->u32 dest src))
     3964                       (t
     3965                        (unless (eql dest-gpr src-gpr)
     3966                          (! copy-gpr dest src)))))
     3967                    (#.hard-reg-class-gpr-mode-s16
     3968                     (case src-mode
     3969                       (#.hard-reg-class-gpr-mode-node
     3970                        (! unbox-s16 dest src))
     3971                       (#.hard-reg-class-gpr-mode-s8
     3972                        (! s8->s32 dest src))
     3973                       (#.hard-reg-class-gpr-mode-u8
     3974                        (! u8->u32 dest src))
     3975                       (t
     3976                        (unless (eql dest-gpr src-gpr)
     3977                          (! copy-gpr dest src)))))
     3978                    (#.hard-reg-class-gpr-mode-u8
     3979                     (case src-mode
     3980                       (#.hard-reg-class-gpr-mode-node
     3981                        (if *x862-reckless*
     3982                          (! %unbox-u8 dest src)
     3983                          (! unbox-u8 dest src)))
     3984                       (t
     3985                        (unless (eql dest-gpr src-gpr)
     3986                          (! copy-gpr dest src)))))
     3987                    (#.hard-reg-class-gpr-mode-s8
     3988                     (case src-mode
     3989                       (#.hard-reg-class-gpr-mode-node
     3990                        (! unbox-s8 dest src))
     3991                       (t
     3992                        (unless (eql dest-gpr src-gpr)
     3993                          (! copy-gpr dest src)))))))
    36173994                 (:x8664
    36183995                  (ecase dest-mode
     
    37764153                        (x862-double->heap seg dest src))
    37774154                       (#.hard-reg-class-fpr-mode-single
    3778                         (! single->node dest src)))))
     4155                        (target-arch-case
     4156                         (:x8632
     4157                          (x862-single->heap seg dest src))
     4158                         (:x8664
     4159                          (! single->node dest src)))))))
    37794160                  (if (and src-fpr dest-fpr)
    37804161                    (unless (eql dest-fpr src-fpr)
     
    38064187  (when subtag
    38074188    (target-arch-case
     4189     (:x8632
     4190      (let* ((masked (logand subtag x8632::fulltagmask)))
     4191        (declare (fixnum masked))
     4192        (= masked x8632::fulltag-immheader)))
    38084193     (:x8664
    38094194      (let* ((masked (logand subtag x8664::fulltagmask)))
     
    38164201  (when subtag
    38174202    (target-arch-case
     4203     (:x8632
     4204      (let* ((masked (logand subtag x8632::fulltagmask)))
     4205        (declare (fixnum masked))
     4206        (= masked x8632::fulltag-nodeheader)))
    38184207     (:x8664
    38194208      (let* ((masked (logand subtag x8664::fulltagmask)))
     
    39164305                     (if init-p
    39174306                       (progn
    3918                          (x862-three-targeted-reg-forms seg element-count ($ x8664::arg_x) subtag ($ *x862-arg-y*) init ($ *x862-arg-z*))
     4307                         (x862-three-targeted-reg-forms seg element-count
     4308                                                        (target-arch-case
     4309                                                         (:x8632
     4310                                                          ($ x8632::temp1))
     4311                                                         (:x8664
     4312                                                          ($ x8664::arg_x)))
     4313                                                        subtag ($ *x862-arg-y*)
     4314                                                        init ($ *x862-arg-z*))
    39194315                         (! stack-misc-alloc-init))
    39204316                       (progn
     
    41504546
    41514547
    4152 
     4548;; xxx imm regs
    41534549(defun x862-%immediate-set-ptr (seg vreg xfer  ptr offset val)
    41544550  (with-x86-local-vinsn-macros (seg vreg xfer)
     
    41764572                                                                      ptr
    41774573                                                                      ptr-reg)))
    4178                           (! mem-set-c-constant-doubleword intval ptr-reg offval))))
     4574                          (target-word-size-case
     4575                           (32
     4576                            (! mem-set-c-constant-fullword intval ptr-reg offval))
     4577                           (64
     4578                            (! mem-set-c-constant-doubleword intval ptr-reg offval))))))
    41794579                     (t
    4180                       (with-imm-target () (ptr-reg :address)
    4181                         (with-imm-target (ptr-reg) (offsetreg :signed-natural)
    4182                           (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    4183                           (! fixnum->signed-natural offsetreg *x862-arg-z*)
    4184                           (! mem-set-constant-doubleword intval ptr-reg offsetreg)))))
     4580                      (with-additional-imm-reg ()
     4581                        (with-imm-target () (ptr-reg :address)
     4582                          (with-imm-target (ptr-reg) (offsetreg :signed-natural)
     4583                            (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4584                            (! fixnum->signed-natural offsetreg *x862-arg-z*)
     4585                            (target-word-size-case
     4586                             (32 (! mem-set-constant-fullword intval ptr-reg offsetreg))
     4587                             (64 (! mem-set-constant-doubleword intval ptr-reg offsetreg))))))))
    41854588               (if for-value
    4186                  (with-imm-target () (val-reg :s64)
     4589                 (with-imm-target () (val-reg (target-word-size-case (32 :s32) (64 :s64)))
    41874590                   (x862-lri seg val-reg intval)
    41884591                   (<- (set-regspec-mode val-reg (gpr-mode-name-value :address))))))
     
    41944597               (multiple-value-bind (address node)
    41954598                   (address-and-node-regs)
    4196                  (with-imm-target (address) (ptr-reg :address)
    4197                    (x862-pop-register seg ptr-reg)
    4198                    (! mem-set-c-doubleword address ptr-reg offval))
     4599                 (with-additional-imm-reg ()
     4600                   (with-imm-target (address) (ptr-reg :address)
     4601                     (x862-pop-register seg ptr-reg)
     4602                     (target-word-size-case
     4603                      (32 (! mem-set-c-fullword address ptr-reg offval))
     4604                      (64 (! mem-set-c-doubleword address ptr-reg offval)))))
    41994605                 (if for-value
    42004606                   (<- node))))
    42014607              (t
    42024608               (with-imm-target () (ptr-reg :address)
    4203                  (with-imm-target (ptr-reg) (offset-reg :address)
    4204                    (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    4205                    (! fixnum->signed-natural offset-reg *x862-arg-z*)
    4206                    (! fixnum-add2 ptr-reg offset-reg)
    4207                    (x862-push-register seg ptr-reg)))
     4609                 (with-additional-imm-reg ()
     4610                   (with-imm-target (ptr-reg) (offset-reg :address)
     4611                     (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4612                     (! fixnum->signed-natural offset-reg *x862-arg-z*)
     4613                     (! fixnum-add2 ptr-reg offset-reg)
     4614                     (x862-push-register seg ptr-reg))))
    42084615               (multiple-value-bind (address node)
    42094616                   (address-and-node-regs)
    4210                  (with-imm-target (address) (ptr-reg :address)
    4211                    (x862-pop-register seg ptr-reg)
    4212                    (! mem-set-c-doubleword address ptr-reg 0))
     4617                 (with-additional-imm-reg ()
     4618                   (with-imm-target (address) (ptr-reg :address)
     4619                     (x862-pop-register seg ptr-reg)
     4620                     (target-word-size-case
     4621                      (32 (! mem-set-c-fullword address ptr-reg 0))
     4622                      (64 (! mem-set-c-doubleword address ptr-reg 0)))))
    42134623                 (if for-value
    42144624                   (<- node))))))
     
    42414651                     (! gets64)
    42424652                     (! getu64))
    4243                    (! fixnum->signed-natural x8664::imm0 *x862-arg-z*))))
     4653                   (if (and (eq size 4)
     4654                            (target-arch-case
     4655                             (:x8632 t)
     4656                             (:x8664 nil)))
     4657                     (if signed
     4658                       (! gets32)
     4659                       (! getu32))
     4660                     (! fixnum->signed-natural *x862-imm0* *x862-arg-z*)))))
    42444661
    42454662          (and offval (%i> (integer-length offval) 31) (setq offval nil))
     
    42514668                 (1
    42524669                  (if (>= intval 128) (setq intval (- intval 256))))))
    4253           (cond (intval
    4254                  (cond (offval
    4255                         (with-imm-target () (ptr-reg :address)
    4256                          (let* ((ptr-reg (x862-one-untargeted-reg-form seg
    4257                                                                        ptr
    4258                                                                        ptr-reg)))
    4259                            (case size
    4260                              (8 (! mem-set-c-constant-doubleword signed-intval ptr-reg offval))
    4261                              (4 (! mem-set-c-constant-fullword signed-intval ptr-reg offval))
    4262                              (2 (! mem-set-c-constant-halfword signed-intval ptr-reg offval))
    4263                              (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
    4264                        (t
    4265                         (with-imm-target () (ptr-reg :address)
    4266                           (with-imm-target (ptr-reg) (offsetreg :signed-natural)
    4267                             (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    4268                             (! fixnum->signed-natural offsetreg *x862-arg-z*)
    4269                             (case size
    4270                               (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg))
    4271                               (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
    4272                               (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
    4273                               (1 (! mem-set-constant-byte intval ptr-reg offsetreg)))))))
    4274                  (if for-value
    4275                    (ensuring-node-target (target vreg)
    4276                     (x862-lri seg vreg (ash intval *x862-target-fixnum-shift*)))))
    4277                 (offval
    4278                  ;; simpler thant the general case
    4279                  (with-imm-target () (ptr-reg :address)
    4280                    (x862-push-register seg
    4281                                        (x862-one-untargeted-reg-form seg ptr ptr-reg)))
    4282                  (val-to-argz-and-imm0)
    4283                  (with-imm-target (x8664::imm0) (ptr-reg :address)
    4284                    (x862-pop-register seg ptr-reg)
    4285                    (case size
    4286                      (8 (! mem-set-c-doubleword x8664::imm0 ptr-reg offval))
    4287                      (4 (! mem-set-c-fullword x8664::imm0 ptr-reg offval))
    4288                      (2 (! mem-set-c-halfword x8664::imm0 ptr-reg offval))
    4289                      (1 (! mem-set-c-byte x8664::imm0 ptr-reg offval))))
    4290                  (if for-value
    4291                    (<- *x862-arg-z*)))
    4292                 (t
    4293                  (with-imm-target () (ptr-reg :address)
    4294                    (with-imm-target (ptr-reg) (offset-reg :address)
    4295                      (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    4296                      (! fixnum->signed-natural offset-reg *x862-arg-z*)
    4297                      (! fixnum-add2 ptr-reg offset-reg)
    4298                      (x862-push-register seg ptr-reg)))
    4299                  (val-to-argz-and-imm0)
    4300                  (with-imm-target (x8664::imm0) (ptr-reg :address)
    4301                    (x862-pop-register seg ptr-reg)
    4302                    (case size
    4303                      (8 (! mem-set-c-doubleword x8664::imm0 ptr-reg 0))
    4304                      (4 (! mem-set-c-fullword x8664::imm0 ptr-reg 0))
    4305                      (2 (! mem-set-c-halfword x8664::imm0 ptr-reg 0))
    4306                      (1 (! mem-set-c-byte x8664::imm0 ptr-reg 0))))
    4307                  (if for-value
    4308                    (< *x862-arg-z*))))
     4670          (cond (intval
     4671                 (cond (offval
     4672                        (with-imm-target () (ptr-reg :address)
     4673                          (let* ((ptr-reg (x862-one-untargeted-reg-form seg
     4674                                                                        ptr
     4675                                                                        ptr-reg)))
     4676                            (case size
     4677                              (8 (! mem-set-c-constant-doubleword signed-intval ptr-reg offval))
     4678                              (4 (! mem-set-c-constant-fullword signed-intval ptr-reg offval))
     4679                              (2 (! mem-set-c-constant-halfword signed-intval ptr-reg offval))
     4680                              (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
     4681                       (t
     4682                        (with-imm-target () (ptr-reg :address)
     4683                          (with-additional-imm-reg (*x862-arg-z*)
     4684                            (with-imm-target (ptr-reg) (offsetreg :signed-natural)
     4685                              (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4686                              (! fixnum->signed-natural offsetreg *x862-arg-z*)
     4687                              (case size
     4688                                (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg))
     4689                                (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
     4690                                (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
     4691                                (1 (! mem-set-constant-byte intval ptr-reg offsetreg))))))))
     4692                 (if for-value
     4693                   (ensuring-node-target (target vreg)
     4694                     (x862-lri seg vreg (ash intval *x862-target-fixnum-shift*)))))
     4695                (offval
     4696                 ;; simpler than the general case
     4697                 (with-imm-target () (ptr-reg :address)
     4698                   (x862-push-register seg
     4699                                       (x862-one-untargeted-reg-form seg ptr ptr-reg)))
     4700                 (val-to-argz-and-imm0)
     4701                 (target-arch-case
     4702                  (:x8632
     4703                   (with-additional-imm-reg (*x862-arg-z*)
     4704                     (with-imm-temps (x8632::imm0) (ptr-reg)
     4705                       (x862-pop-register seg ptr-reg)
     4706                       (case size
     4707                         (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg offval))
     4708                         (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval))
     4709                         (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval))
     4710                         (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))))
     4711                  (:x8664
     4712                   (with-imm-target (x8664::imm0) (ptr-reg :address)
     4713                     (x862-pop-register seg ptr-reg)
     4714                     (case size
     4715                       (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg offval))
     4716                       (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval))
     4717                       (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval))
     4718                       (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))))
     4719                 (if for-value
     4720                   (<- *x862-arg-z*)))
     4721                (t
     4722                 (with-imm-target () (ptr-reg :address)
     4723                   (with-additional-imm-reg (*x862-arg-z* ptr-reg)
     4724                     (with-imm-target (ptr-reg) (offset-reg :address)
     4725                       (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4726                       (! fixnum->signed-natural offset-reg *x862-arg-z*)
     4727                       (! fixnum-add2 ptr-reg offset-reg)
     4728                       (x862-push-register seg ptr-reg))))
     4729                 (val-to-argz-and-imm0)
     4730                 (target-arch-case
     4731                  (:x8632
     4732                     ;; Ensure imm0 is marked as in use so that some
     4733                     ;; vinsn doesn't decide to use it a temp.
     4734                     (with-additional-imm-reg ()
     4735                       (with-imm-temps (x8632::imm0) (ptr-reg)
     4736                         (x862-pop-register seg ptr-reg)
     4737                         (case size
     4738                           (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg 0))
     4739                           (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0))
     4740                           (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0))
     4741                           (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))))
     4742                  (:x8664
     4743                   (with-imm-target (x8664::imm0) (ptr-reg :address)
     4744                     (x862-pop-register seg ptr-reg)
     4745                     (case size
     4746                       (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg 0))
     4747                       (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0))
     4748                       (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0))
     4749                       (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))))
     4750                 (if for-value
     4751                   (< *x862-arg-z*))))
    43094752
    43104753          (^))))))
     
    44854928        (cond ((or *x862-open-code-inline* (> nntriv 3))
    44864929               (x862-formlist seg initforms nil)
    4487                (x862-lri seg x8664::imm0 header)
    4488                (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) (target-arch-case  (:x8664 x8664::fulltag-misc))))
     4930               (target-arch-case
     4931                (:x8632
     4932                 (x862-lri seg *x862-imm0* header)
     4933                 (! setup-uvector-allocation *x862-imm0*)
     4934                 (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
     4935                (:x8664
     4936                 (x862-lri seg *x862-imm0* header)
     4937                 (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
    44894938               (! %allocate-uvector vreg)
    44904939               (unless (eql n 0)
     
    45004949                       (push nil pending)
    45014950                       (x862-vpush-register seg (x862-one-untargeted-reg-form seg form *x862-arg-z*)))))
    4502                  (x862-lri seg x8664::imm0 header)
    4503                  (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) (target-arch-case  (:x8664 x8664::fulltag-misc))))
     4951                 (target-arch-case
     4952                  (:x8632
     4953                   (x862-lri seg *x862-imm0* header)
     4954                   (! setup-uvector-allocation *x862-imm0*)
     4955                   (x862-lri seg *x862-imm0* (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8632::fulltag-misc)))
     4956                  (:x8664
     4957                   (x862-lri seg *x862-imm0* header)
     4958                   (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ n 2) 1) (arch::target-word-shift arch)) x8664::fulltag-misc))))
    45044959                 (ensuring-node-target (target vreg)
    45054960                   (! %allocate-uvector target)
     
    50155470                  (push reason unbind))))
    50165471            (if unbind
    5017               (let* ((*available-backend-imm-temps* *available-backend-imm-temps*))
    5018                 (when retval (use-imm-temp x8664::nargs.q))
    5019                 (x862-dpayback-list seg (nreverse unbind))))
     5472              (target-arch-case
     5473               (:x8632
     5474                (let* ((*available-backend-node-temps* *available-backend-node-temps*))
     5475                  (when retval (use-node-temp x8632::nargs))
     5476                  (x862-dpayback-list seg (nreverse unbind))))
     5477               (:x8664
     5478                (let* ((*available-backend-imm-temps* *available-backend-imm-temps*))
     5479                  (when retval (use-imm-temp x8664::nargs.q))
     5480                  (x862-dpayback-list seg (nreverse unbind))))))
    50205481            (when (and (neq lastcatch dest)
    50215482                       (%i>
     
    50505511                (! dpayback n)
    50515512                (setq n 0))
    5052               (if *x862-open-code-inline*
     5513              (if (and *x862-open-code-inline*
     5514                       (target-arch-case
     5515                        (:x8632 nil)
     5516                        (:x8664 t)))
    50535517                (let* ((*available-backend-node-temps* (bitclr *x862-arg-z* (bitclr x8664::rcx *available-backend-node-temps*))))
    50545518                  (! unbind-interrupt-level-inline))
     
    50645528           (vtotal numreq)
    50655529           (old-top *x862-top-vstack-lcell*)
    5066            (argreg ($ x8664::temp0))
    5067            (keyvectreg ($ x8664::arg_x))
     5530           (argreg ($ (target-arch-case
     5531                       (:x8632 ($ x8632::temp1))
     5532                       (:x8664 ($ x8664::temp0)))))
     5533           (keyvectreg (target-arch-case
     5534                        (:x8632 ($ x8632::arg_y))
     5535                        (:x8664 ($ x8664::arg_x))))
    50685536           (doadlword (dpb nkeys (byte 8 16) (dpb numopt (byte 8 8) (dpb numreq (byte 8 0) 0 )))))
    50695537      (declare (fixnum numopt nkeys numreq vtotal doadlword))
     
    51295597                          opcode-template))
    51305598         (register-table (target-arch-case
     5599                          (:x8632 x86::*x8632-register-entries*)
    51315600                          (:x8664 x86::*x8664-register-entries*))))
    51325601    (dotimes (i (length operand-classes))
     
    51355604             (type (svref operand-types i))
    51365605             (insert-keyword (svref x86::*x86-operand-insert-function-keywords*
    5137                                     insert-function)))
     5606                                    insert-function)))
    51385607        #+debug
    51395608        (format t "~& insert-function = ~s, operand = ~s"
     
    52595728          (:insert-mmx-rm
    52605729           (x86::insert-mmx-rm-entry instruction
    5261                                      (svref register-table operand))))))
     5730                                     (svref register-table operand)))
     5731          (:insert-self
     5732           (setf (x86::x86-immediate-operand-type immediate-operand)
     5733                 (x86::encode-operand-type :self)
     5734                 (x86::x86-immediate-operand-value immediate-operand)
     5735                 (parse-x86-lap-expression operand)
     5736                 (x86::x86-instruction-imm instruction)
     5737                 immediate-operand)))))
    52625738    (x86-generate-instruction-code frag-list instruction)))
    52635739         
     
    53435819                   (setq tail (cdr tail)))
    53445820                 (x86-emit-instruction-from-vinsn
    5345                   (svref (target-arch-case
    5346                           (:x8664 x86::*x86-opcode-templates*)) (car f))
     5821                  (svref x86::*x86-opcode-templates* (car f))
    53475822                  head
    53485823                  frag-list
     
    54325907                         (expand-form subform))))))))
    54335908      (declare (dynamic-extent #'expand-form #'parse-operand-form #'expand-insn-form #'eval-predicate))
    5434                                         ;(format t "~& vinsn = ~s" vinsn)
     5909      ;;(format t "~& vinsn = ~s" vinsn)
    54355910      (dolist (form (vinsn-template-body template))
     5911        ;;(format t "~&form = ~s" form)
    54365912        (expand-form form ))
    54375913      (setf (vinsn-variable-parts vinsn) nil)
     
    54835959(defun x862-ternary-builtin (seg vreg xfer name form1 form2 form3)
    54845960  (with-x86-local-vinsn-macros (seg)
    5485     (x862-three-targeted-reg-forms seg form1 ($ x8664::arg_x) form2 ($ *x862-arg-y*) form3 ($ *x862-arg-z*))
     5961    (x862-three-targeted-reg-forms seg form1 (target-arch-case
     5962                                              (:x8632 ($ x8632::temp0))
     5963                                              (:x8664 ($ x8664::arg_x)))
     5964                                   form2 ($ *x862-arg-y*)
     5965                                   form3 ($ *x862-arg-z*))
    54865966    (x862-fixed-call-builtin seg vreg xfer name (subprim-name->offset '.SPcallbuiltin3))))
    54875967
     
    55876067                    (dotimes (i (the fixnum (+ nkeys nkeys)))
    55886068                      (x862-new-vstack-lcell :reserved *x862-target-lcell-size* 0 nil))
    5589                     (x862-lri seg x8664::temp1 (ash flags *x862-target-fixnum-shift*))
     6069                    (target-arch-case
     6070                     ;; xxx hack alert (see SPkeyword_bind in x86-spentry32.s)
     6071                     (:x8632
     6072                      (! set-high-halfword *x862-temp1* flags))
     6073                     (:x8664
     6074                      (x862-lri seg *x862-temp1* (ash flags *x862-target-fixnum-shift*))))
    55906075                    (unless (= nprev 0)
    55916076                      (x862-lri seg *x862-imm0* (ash nprev *x862-target-fixnum-shift*)))
     
    56686153            (@ (setq *x862-tail-label* (backend-get-next-label))))
    56696154          (when method-var
    5670             (x862-seq-bind-var seg method-var x8664::next-method-context)
    5671             (when *x862-recorded-symbols*
     6155            (target-arch-case
     6156             (:x8632
     6157              (with-node-target () next-method-context
     6158                (! load-next-method-context next-method-context)
     6159                (x862-seq-bind-var seg method-var next-method-context)))
     6160             (:x8664
     6161              (x862-seq-bind-var seg method-var x8664::next-method-context)))
     6162            (when *x862-recorded-symbols*
    56726163              (setq next-method-var-scope-info (pop *x862-recorded-symbols*))))
     6164
    56736165          ;; If any arguments are still in arg_x, arg_y, arg_z, that's
    56746166          ;; because they weren't vpushed in a "simple" entry case and
     
    56806172            (do* ((vars arg-regs (cdr vars))
    56816173                  (arg-reg-numbers (target-arch-case
    5682                                     (:x8664 (list x8664::arg_z x8664::arg_y x8664::arg_x))))
     6174                                    (:x8632 (list *x862-arg-z* *x862-arg-y*))
     6175                                    (:x8664 (list *x862-arg-z* *x862-arg-y* x8664::arg_x))))
    56836176                  (arg-reg-num (pop arg-reg-numbers) (pop arg-reg-numbers)))
    56846177                 ((null vars))
     
    58196312  (if (null vreg)
    58206313    (x862-form seg vreg xfer form)
    5821     (let* ((tagreg x8664::imm0))
    5822       (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
    5823         (! extract-fulltag tagreg (x862-one-untargeted-reg-form seg form *x862-arg-z*))
    5824         (! compare-u8-constant tagreg x8664::fulltag-cons)
    5825         (regspec-crf-gpr-case
    5826          (vreg dest)
    5827          (^ cr-bit true-p)
    5828          (progn
    5829            (ensuring-node-target (target dest)
    5830              (if (not true-p)
    5831                (setq cr-bit (logxor 1 cr-bit)))
    5832              (! cr-bit->boolean target cr-bit))
    5833            (^)))))))
     6314    (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
     6315      (! set-z-flag-if-consp (x862-one-untargeted-reg-form seg form *x862-arg-z*))
     6316      (regspec-crf-gpr-case
     6317       (vreg dest)
     6318       (^ cr-bit true-p)
     6319       (progn
     6320         (ensuring-node-target (target dest)
     6321           (if (not true-p)
     6322             (setq cr-bit (logxor 1 cr-bit)))
     6323           (! cr-bit->boolean target cr-bit))
     6324         (^))))))
    58346325     
    58356326(defx862 x862-cons cons (seg vreg xfer y z)
     
    61096600      (x862-form seg nil xfer form2))
    61106601    (let* ((const (acode-fixnum-form-p form1))
    6111            (max (target-arch-case (:x8664 63))))
     6602           (max (target-arch-case (:x8632 31) (:x8664 63))))
    61126603      (ensuring-node-target (target vreg)
    61136604        (if const
     
    61506641  (multiple-value-bind (src unscaled-idx char)
    61516642      (x862-three-untargeted-reg-forms seg
    6152                                        str x8664::arg_x
     6643                                       str (target-arch-case
     6644                                            (:x8632 x8632::temp0)
     6645                                            (:x8664 x8664::arg_x))
    61536646                                       idx *x862-arg-y*
    61546647                                       char *x862-arg-z*)
     
    61616654(defx862 x862-%set-scharcode %set-scharcode (seg vreg xfer str idx char)
    61626655  (multiple-value-bind (src unscaled-idx char)
    6163       (x862-three-untargeted-reg-forms seg str x8664::arg_x idx *x862-arg-y*
     6656      (x862-three-untargeted-reg-forms seg str (target-arch-case
     6657                                                (:x8632 x8632::temp0)
     6658                                                (:x8664 x8664::arg_x))
     6659                                       idx *x862-arg-y*
    61646660                                       char *x862-arg-z*)
    61656661    (case (arch::target-char-code-limit (backend-target-arch *target-backend*))
    6166       (256 (! %set-scharcode8 src unscaled-idx char))
    6167       (t (! %set-scharcode32 src unscaled-idx char)))
     6662      (256
     6663       (! %set-scharcode8 src unscaled-idx char))
     6664      (t
     6665       (! %set-scharcode32 src unscaled-idx char)))
    61686666    (when vreg (<- char))
    61696667    (^)))
     
    64096907
    64106908(defx862 x862-uvset uvset (seg vreg xfer vector index value)
    6411   (x862-three-targeted-reg-forms seg vector ($ x8664::arg_x) index ($ *x862-arg-y*) value ($ *x862-arg-z*))
     6909  (x862-three-targeted-reg-forms seg
     6910                                 vector (target-arch-case
     6911                                         (:x8632 ($ x8632::temp0))
     6912                                         (:x8664 ($ x8664::arg_x)))
     6913                                 index ($ *x862-arg-y*)
     6914                                 value ($ *x862-arg-z*))
    64126915  (! misc-set)
    64136916  (<- ($ *x862-arg-z*))
     
    64216924
    64226925(defx862 x862-%err-disp %err-disp (seg vreg xfer arglist)
    6423   (x862-set-nargs seg (x862-arglist seg arglist))
    6424   (! ksignalerr)
     6926  (let* ((*x862-vstack* *x862-vstack*))
     6927    (x862-set-nargs seg (x862-arglist seg arglist))
     6928    (! ksignalerr))
    64256929  (x862-nil seg vreg xfer))
    64266930
     
    66677171  (with-x86-local-vinsn-macros (seg vreg xfer)
    66687172    (let* ((fix1 (acode-fixnum-form-p form1))
    6669            (fix2 (acode-fixnum-form-p form2))
    6670            (otherform (if (and fix1
    6671                                (typep (ash fix1 *x862-target-fixnum-shift*)
    6672                                       '(signed-byte 32)))
    6673                         form2
    6674                         (if (and fix2
    6675                                 (typep (ash fix2 *x862-target-fixnum-shift*)
    6676                                         '(signed-byte 32)))
    6677                           form1))))
     7173           (fix2 (acode-fixnum-form-p form2))
     7174           (otherform (if (and fix1
     7175                               (typep (ash fix1 *x862-target-fixnum-shift*)
     7176                                      '(signed-byte 32)))
     7177                        form2
     7178                        (if (and fix2
     7179                                (typep (ash fix2 *x862-target-fixnum-shift*)
     7180                                        '(signed-byte 32)))
     7181                          form1))))
    66787182      (if otherform
    66797183        (x862-one-targeted-reg-form seg otherform ($ *x862-arg-z*))
     
    69547458    (if keyword
    69557459      (x862-vset seg vreg xfer keyword v i n (not *x862-reckless*))
    6956       (x862-ternary-builtin seg vreg xfer '%aset1 v i n))))
     7460      (target-arch-case
     7461       (:x8632
     7462        (with-x86-local-vinsn-macros (seg vreg xfer)
     7463          (let* ((subprim (subprim-name->offset '.SPaset1))
     7464                 (tail-p (x862-tailcallok xfer)))
     7465            (x862-three-targeted-reg-forms seg
     7466                                           v ($ x8632::temp0)
     7467                                           i ($ x8632::arg_y)
     7468                                           n ($ x8632::arg_z))
     7469            (if tail-p
     7470              (progn
     7471                (x862-restore-full-lisp-context seg)
     7472                (! jump-subprim subprim))
     7473              (progn
     7474                (! call-subprim subprim)
     7475                (when vreg
     7476                  (<- ($ x8632::arg_z)))
     7477                (^))))))
     7478       (:x8664
     7479        (x862-ternary-builtin seg vreg xfer '%aset1 v i n))))))
    69577480
    69587481(defx862 x862-%i+ %i+ (seg vreg xfer form1 form2 &optional overflow)
     
    70947617  (with-x86-local-vinsn-macros (seg vreg xfer)
    70957618    (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
    7096       (! compare-u8-constant (x862-one-untargeted-reg-form seg form *x862-arg-z*)
    7097          (target-arch-case
    7098           (:x8664 x8664::subtag-character)))
    7099       (setq cr-bit (x862-cr-bit-for-unsigned-comparison cr-bit))
    7100       (regspec-crf-gpr-case
    7101        (vreg dest)
    7102        (^ cr-bit true-p)
    7103        (progn
    7104          (ensuring-node-target (target dest)
    7105            (if (not true-p)
    7106              (setq cr-bit (logxor 1 cr-bit)))
    7107            (! cr-bit->boolean target cr-bit))
    7108          (^))))))
     7619      (! mask-base-char *x862-imm0* (x862-one-untargeted-reg-form seg form *x862-arg-z*))
     7620      (x862-test-reg-%izerop seg vreg xfer *x862-imm0* cr-bit true-p
     7621                             (target-arch-case
     7622                              (:x8632 x8632::subtag-character)
     7623                              (:x8664 x8664::subtag-character))))))
    71097624
    71107625
     
    72037718                    (+ nbytes *x862-target-node-size*
    72047719                       (1- *x862-target-dnode-size*))) #x8000))
    7205         (let* ((header x8664::imm0)
    7206                (physsize x8664::imm1))
    7207           (x862-lri seg header (arch::make-vheader nelements subtag))
    7208           (x862-lri seg physsize (- (* (ceiling (+ nbytes *x862-target-node-size*) *x862-target-dnode-size*) *x862-target-dnode-size*) (target-arch-case (:x8664 x8664::fulltag-misc))))
     7720        (let* ((header *x862-imm0*)
     7721               (n (- (* (ceiling (+ nbytes *x862-target-node-size*) *x862-target-dnode-size*) *x862-target-dnode-size*)
     7722                     (target-arch-case
     7723                      (:x8632 x8632::fulltag-misc)
     7724                      (:x8664 x8664::fulltag-misc)))))
     7725          (x862-lri seg header (arch::make-vheader nelements subtag))
     7726          (target-arch-case
     7727           (:x8632
     7728            (! setup-uvector-allocation header)
     7729            (x862-lri seg x8632::imm0 n))
     7730           (:x8664
     7731            (x862-lri seg x8664::imm1 n)))
    72097732          (ensuring-node-target (target vreg)
    72107733            (! %allocate-uvector target)))
     
    72127735          (if initval
    72137736            (progn
    7214               (x862-three-targeted-reg-forms seg element-count ($ x8664::arg_x) st ($ *x862-arg-y*) initval ($ *x862-arg-z*))
     7737              (x862-three-targeted-reg-forms seg element-count
     7738                                             (target-arch-case
     7739                                              (:x8632 ($ x8632::temp0))
     7740                                              (:x8664 ($ x8664::arg_x)))
     7741                                             st ($ *x862-arg-y*)
     7742                                             initval ($ *x862-arg-z*))
    72157743              (! misc-alloc-init)
    72167744              (<- ($ *x862-arg-z*)))
     
    72277755      (x862-form seg vreg xfer form2))
    72287756    (let* ((count (acode-fixnum-form-p form1))
    7229            (max (target-arch-case (:x8664 63))))
     7757           (max (target-arch-case (:x8632 31) (:x8664 63))))
    72307758      (declare (fixnum max))
    72317759      (ensuring-node-target (target vreg)
     
    73507878                   (! mem-ref-c-single-float fp-reg ptrreg fixoffset)))
    73517879               (with-imm-target () (ptrreg :address)
    7352                  (with-imm-target (ptrreg) (offsetreg :s64)
    7353                    (x862-two-targeted-reg-forms seg
    7354                                                 ptr ptrreg
    7355                                                 offset ($ *x862-arg-z*))
    7356                    (! fixnum->signed-natural offsetreg *x862-arg-z*)
    7357                    (if double-p
    7358                      (! mem-ref-double-float fp-reg ptrreg offsetreg)
    7359                      (! mem-ref-single-float fp-reg ptrreg offsetreg)))))
     7880                 (with-additional-imm-reg ()
     7881                   (with-imm-target (ptrreg) (offsetreg :signed-natural)
     7882                     (x862-two-targeted-reg-forms seg
     7883                                                  ptr ptrreg
     7884                                                  offset ($ *x862-arg-z*))
     7885                     (! fixnum->signed-natural offsetreg *x862-arg-z*)
     7886                     (if double-p
     7887                       (! mem-ref-double-float fp-reg ptrreg offsetreg)
     7888                       (! mem-ref-single-float fp-reg ptrreg offsetreg))))))
    73607889             (<- fp-reg))
    73617890           (^)))))
     
    73897918                        (! mem-set-c-single-float fp-reg ptr-reg fixoffset)))
    73907919                     (t
    7391                       (with-imm-target (ptr-reg) (offset-reg :s32)
    7392                         (x862-push-register
    7393                          seg
    7394                          (x862-one-untargeted-reg-form seg
    7395                                                        ptr
    7396                                                        ptr-reg))
    7397                         (x862-push-register
    7398                          seg
    7399                          (x862-one-untargeted-reg-form seg
    7400                                                        offset
    7401                                                        *x862-arg-z*))
    7402                         (x862-one-targeted-reg-form seg newval fp-reg)
    7403                         (x862-pop-register seg *x862-arg-z*)
    7404                         (x862-pop-register seg ptr-reg)
    7405                         (! fixnum->signed-natural offset-reg *x862-arg-z*)
    7406                         (if double-p
    7407                           (! mem-set-double-float fp-reg ptr-reg offset-reg)
    7408                           (! mem-set-single-float fp-reg ptr-reg offset-reg)))))
     7920                      (with-additional-imm-reg ()
     7921                        (with-imm-target (ptr-reg) (offset-reg :s32)
     7922                          (x862-push-register
     7923                           seg
     7924                           (x862-one-untargeted-reg-form seg
     7925                                                         ptr
     7926                                                         ptr-reg))
     7927                          (x862-push-register
     7928                           seg
     7929                           (x862-one-untargeted-reg-form seg
     7930                                                         offset
     7931                                                         *x862-arg-z*))
     7932                          (x862-one-targeted-reg-form seg newval fp-reg)
     7933                          (x862-pop-register seg *x862-arg-z*)
     7934                          (x862-pop-register seg ptr-reg)
     7935                          (! fixnum->signed-natural offset-reg *x862-arg-z*)
     7936                          (if double-p
     7937                            (! mem-set-double-float fp-reg ptr-reg offset-reg)
     7938                            (! mem-set-single-float fp-reg ptr-reg offset-reg))))))
    74097939               (<- fp-reg))
    74107940              (t
     
    74187948                        (x862-one-targeted-reg-form seg newval rnew)
    74197949                        (x862-pop-register seg ptr-reg)
    7420                         (with-imm-temps (ptr-reg) ()
    7421                           (x862-copy-register seg fp-reg rnew)
    7422                           (if double-p
    7423                             (! mem-set-c-double-float fp-reg ptr-reg fixoffset)
    7424                             (! mem-set-c-single-float fp-reg ptr-reg fixoffset)))))
     7950                        (with-additional-imm-reg ()
     7951                          (with-imm-temps (ptr-reg) ()
     7952                            (x862-copy-register seg fp-reg rnew)
     7953                            (if double-p
     7954                              (! mem-set-c-double-float fp-reg ptr-reg fixoffset)
     7955                              (! mem-set-c-single-float fp-reg ptr-reg fixoffset))))))
    74257956                     (t
    74267957                      (let* ((roffset ($ *x862-arg-y*))
     
    74357966                                                   newval rnew)
    74367967                        (x862-pop-register seg ptr-reg)
    7437                         (with-imm-target (ptr-reg) (offset-reg :s32)
    7438                           (with-imm-temps (ptr-reg) ()
    7439                             (x862-copy-register seg fp-reg rnew)
    7440                             (! fixnum->signed-natural offset-reg roffset))
    7441                         (if double-p
    7442                           (! mem-set-double-float fp-reg ptr-reg offset-reg)
    7443                           (! mem-set-single-float fp-reg ptr-reg offset-reg))))))
     7968                        (with-additional-imm-reg ()
     7969                          (with-imm-target (ptr-reg) (offset-reg :s32)
     7970                            (with-imm-temps (ptr-reg) ()
     7971                              (x862-copy-register seg fp-reg rnew)
     7972                              (! fixnum->signed-natural offset-reg roffset))
     7973                            (if double-p
     7974                              (! mem-set-double-float fp-reg ptr-reg offset-reg)
     7975                              (! mem-set-single-float fp-reg ptr-reg offset-reg)))))))
    74447976               (<- *x862-arg-z*)))
    74457977        (^)))))
     
    74657997             (setq absptr (+ absptr offval) offval 0)
    74667998             (setq absptr nil))
    7467            (and offval (%i> (integer-length offval) 15) (setq offval nil))
    7468            (and absptr (%i> (integer-length absptr) 15) (setq absptr nil))
    7469            (target-arch-case
    7470            
    7471             (:x8664 (progn
    7472                       (and offval (logtest 3 offval) (setq offval nil))
    7473                       (and absptr (logtest 3 absptr) (setq absptr nil)))))
     7999           (and offval (%i> (integer-length offval) 31) (setq offval nil))
     8000           (and absptr (%i> (integer-length absptr) 31) (setq absptr nil))
    74748001           (if absptr
    74758002             (! mem-ref-c-absolute-natural dest absptr)
     
    74798006               (let* ((src (x862-macptr-arg-to-reg seg ptr ($ *x862-imm0* :mode :address))))
    74808007                 (if triv-p
    7481                    (with-imm-temps (src) (x)
    7482                      (if (acode-fixnum-form-p offset)
    7483                        (x862-lri seg x (acode-fixnum-form-p offset))
    7484                        (! fixnum->signed-natural x (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7485                      (! mem-ref-natural dest src x))
     8008                   (with-additional-imm-reg ()
     8009                     (with-imm-temps (src) (x)
     8010                       (if (acode-fixnum-form-p offset)
     8011                         (x862-lri seg x (acode-fixnum-form-p offset))
     8012                         (! fixnum->signed-natural x (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     8013                       (! mem-ref-natural dest src x)))
    74868014                   (progn
    74878015                     (! temp-push-unboxed-word src)
    74888016                     (x862-open-undo $undostkblk)
    74898017                     (let* ((oreg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7490                        (with-imm-temps () (src x)
    7491                          (! temp-pop-unboxed-word src)
    7492                          (x862-close-undo)
    7493                          (! fixnum->signed-natural x oreg)
    7494                          (! mem-ref-natural dest src x))))))))
     8018                       (with-additional-imm-reg (*x862-arg-z*)
     8019                         (with-imm-temps () (src x)
     8020                           (! temp-pop-unboxed-word src)
     8021                           (x862-close-undo)
     8022                           (! fixnum->signed-natural x oreg)
     8023                           (! mem-ref-natural dest src x)))))))))
    74958024           (^)))))
    74968025
     
    75058034            (x862-one-targeted-reg-form seg ptr src-reg)
    75068035          (if (node-reg-p vreg)
    7507             (! mem-ref-c-bit-fixnum vreg src-reg offval)
    7508             (with-imm-target ()           ;OK if src-reg & dest overlap
    7509                 (dest :u8)
    7510               (! mem-ref-c-bit dest src-reg offval)
    7511               (<- dest))))
     8036            (! mem-ref-c-bit-fixnum vreg src-reg offval)
     8037            (with-imm-target ()           ;OK if src-reg & dest overlap
     8038                (dest :u8)
     8039              (! mem-ref-c-bit dest src-reg offval)
     8040              (<- dest))))
    75128041        (with-imm-target () (src-reg :address)
    75138042          (x862-two-targeted-reg-forms seg ptr src-reg offset ($ *x862-arg-z*))
     
    75228051   
    75238052     
    7524                                      
     8053;;; gonna run out of imm regs here                                     
    75258054;;; This returns an unboxed object, unless the caller wants to box it.
    75268055(defx862 x862-immediate-get-xxx immediate-get-xxx (seg vreg xfer bits ptr offset)
     
    75428071           (and offval (%i> (integer-length offval) 31) (setq offval nil))
    75438072           (and absptr (%i> (integer-length absptr) 31) (setq absptr nil))
     8073           ;;; huh?
    75448074           (target-arch-case
    7545            
     8075            (:x8632 (when (or fixnump (eql size 4) (and (eql size 4) signed))
     8076                      (and offval (logtest 2 offval) (setq offval nil))
     8077                      (and absptr (logtest 2 absptr) (setq absptr nil))))
    75468078            (:x8664 (when (or fixnump (eql size 8) (and (eql size 8) signed))
    75478079                      (and offval (logtest 3 offval) (setq offval nil))
    75488080                      (and absptr (logtest 3 absptr) (setq absptr nil)))))
    7549            (cond
    7550              (fixnump
    7551               (with-imm-target () (dest :signed-natural)
    7552                 (cond
    7553                   (absptr                             
    7554                    (target-arch-case
    7555                    
    7556                     (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
    7557                   (offval
    7558                     (with-imm-target () (src-reg :address)
    7559                       (x862-one-targeted-reg-form seg ptr src-reg)
    7560                       (target-arch-case
    7561                        
    7562                        (:x8664 (! mem-ref-c-doubleword dest src-reg offval)))))
    7563                   (t
    7564                    (with-imm-target () (src-reg :address)
    7565                      (with-imm-target (src-reg) (offset-reg :signed-natural)
    7566                        (x862-one-targeted-reg-form seg ptr src-reg)
    7567                        (if triv-p
    7568                          (if (acode-fixnum-form-p offset)
    7569                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7570                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7571                          (progn
    7572                            (! temp-push-unboxed-word src-reg)
    7573                            (x862-open-undo $undostkblk)
    7574                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7575                            (! temp-pop-unboxed-word src-reg)
    7576                            (x862-close-undo)))
    7577                        (target-arch-case
    7578                        
    7579                         (:x8664 (! mem-ref-doubleword dest src-reg offset-reg)))))))
    7580                 (if (node-reg-p vreg)
    7581                   (! box-fixnum vreg dest)
    7582                   (<- dest))))
    7583              (signed
    7584               (with-imm-target () (dest :signed-natural)
    7585                (cond
    7586                  (absptr
    7587                   (case size
    7588                     (8 (! mem-ref-c-absolute-signed-doubleword dest absptr))
    7589                     (4 (! mem-ref-c-absolute-signed-fullword dest  absptr))
    7590                     (2 (! mem-ref-c-absolute-s16 dest absptr))
    7591                     (1 (! mem-ref-c-absolute-s8 dest absptr))))
    7592                  (offval
    7593                   (with-imm-target (dest) (src-reg :address)
    7594                    (x862-one-targeted-reg-form seg ptr src-reg)
    7595                      (case size
    7596                        (8 (! mem-ref-c-signed-doubleword dest src-reg offval))
    7597                        (4 (! mem-ref-c-signed-fullword dest src-reg offval))
    7598                        (2 (! mem-ref-c-s16 dest src-reg offval))
    7599                        (1 (! mem-ref-c-s8 dest src-reg offval)))))
    7600                  (t
    7601                   (with-imm-target () (src-reg :address)
    7602                     (with-imm-target (src-reg) (offset-reg :signed-natural)
    7603                      (x862-one-targeted-reg-form seg ptr src-reg)
    7604                      (if triv-p
    7605                        (if (acode-fixnum-form-p offset)
    7606                          (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7607                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7608                        (progn
    7609                          (! temp-push-unboxed-word src-reg)
    7610                          (x862-open-undo $undostkblk)
    7611                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7612                          (! temp-pop-unboxed-word src-reg)
    7613                          (x862-close-undo)))
    7614                   (case size
    7615                     (8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
    7616                     (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
    7617                     (2 (! mem-ref-s16 dest src-reg offset-reg))
    7618                     (1 (! mem-ref-s8 dest src-reg offset-reg)))))))
    7619                (if (node-reg-p vreg)
    7620                  (case size
    7621                    ((1 2) (! box-fixnum vreg dest))
    7622                    (4 (target-arch-case
    7623                        
    7624                        (:x8664 (! box-fixnum vreg dest))))
    7625                    (8 (<- dest)))
    7626                  (<- dest))))
    7627              (t
    7628               (with-imm-target () (dest :natural)
    7629                (cond
    7630                  (absptr
    7631                   (case size
    7632                     (8 (! mem-ref-c-absolute-doubleword dest absptr))
    7633                     (4 (! mem-ref-c-absolute-fullword dest absptr))
    7634                     (2 (! mem-ref-c-absolute-u16 dest absptr))
    7635                     (1 (! mem-ref-c-absolute-u8 dest absptr))))
    7636                  (offval
    7637                   (with-imm-target (dest) (src-reg :address)
    7638                     (x862-one-targeted-reg-form seg ptr src-reg)
    7639                     (case size
    7640                       (8 (! mem-ref-c-doubleword dest src-reg offval))
    7641                       (4 (! mem-ref-c-fullword dest src-reg offval))
    7642                       (2 (! mem-ref-c-u16 dest src-reg offval))
    7643                       (1 (! mem-ref-c-u8 dest src-reg offval)))))
    7644                  (t
    7645                   (with-imm-target () (src-reg :address)
    7646                     (with-imm-target (src-reg) (offset-reg :signed-natural)
    7647                      (x862-one-targeted-reg-form seg ptr src-reg)
    7648                      (if triv-p
    7649                        (if (acode-fixnum-form-p offset)
    7650                          (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7651                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7652                        (progn
    7653                          (! temp-push-unboxed-word src-reg)
    7654                          (x862-open-undo $undostkblk)
    7655                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7656                          (! temp-pop-unboxed-word src-reg)
    7657                          (x862-close-undo)))
    7658                   (case size
    7659                     (8 (! mem-ref-doubleword dest src-reg offset-reg))
    7660                     (4 (! mem-ref-fullword dest src-reg offset-reg))
    7661                     (2 (! mem-ref-u16 dest src-reg offset-reg))
    7662                     (1 (! mem-ref-u8 dest src-reg offset-reg)))))))
    7663                   (<- (set-regspec-mode
    7664                        dest
    7665                        (gpr-mode-name-value
    7666                         (case size
    7667                           (8 :u64)
    7668                           (4 :u32)
    7669                           (2 :u16)
    7670                           (1 :u8))))))))
     8081           (cond
     8082             (fixnump
     8083              (with-imm-target () (dest :signed-natural)
     8084                (cond
     8085                  (absptr                             
     8086                   (target-arch-case
     8087                    (:x8632 (! mem-ref-c-absolute-fullword dest absptr))
     8088                    (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
     8089                  (offval
     8090                   (with-imm-target () (src-reg :address)
     8091                     (x862-one-targeted-reg-form seg ptr src-reg)
     8092                     (target-arch-case
     8093                      (:x8632 (! mem-ref-c-fullword dest src-reg offval))
     8094                      (:x8664 (! mem-ref-c-doubleword dest src-reg offval)))))
     8095                  (t
     8096                   (with-imm-target () (src-reg :address)
     8097                     (with-additional-imm-reg ()
     8098                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     8099                         (x862-one-targeted-reg-form seg ptr src-reg)
     8100                         (if triv-p
     8101                           (if (acode-fixnum-form-p offset)
     8102                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     8103                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     8104                           (progn
     8105                             (! temp-push-unboxed-word src-reg)
     8106                             (x862-open-undo $undostkblk)
     8107                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     8108                             (! temp-pop-unboxed-word src-reg)
     8109                             (x862-close-undo)))
     8110                         (target-arch-case
     8111                          (:x8632 (! mem-ref-fullword dest src-reg offset-reg))
     8112                          (:x8664 (! mem-ref-doubleword dest src-reg offset-reg))))))))
     8113                (if (node-reg-p vreg)
     8114                  (! box-fixnum vreg dest)
     8115                  (<- dest))))
     8116             (signed
     8117              (with-imm-target () (dest :signed-natural)
     8118                (cond
     8119                  (absptr
     8120                   (case size
     8121                     (8 (! mem-ref-c-absolute-signed-doubleword dest absptr))
     8122                     (4 (! mem-ref-c-absolute-signed-fullword dest  absptr))
     8123                     (2 (! mem-ref-c-absolute-s16 dest absptr))
     8124                     (1 (! mem-ref-c-absolute-s8 dest absptr))))
     8125                  (offval
     8126                   (with-additional-imm-reg ()
     8127                     (with-imm-target (dest) (src-reg :address)
     8128                       (x862-one-targeted-reg-form seg ptr src-reg)
     8129                       (case size
     8130                         (8 (! mem-ref-c-signed-doubleword dest src-reg offval))
     8131                         (4 (! mem-ref-c-signed-fullword dest src-reg offval))
     8132                         (2 (! mem-ref-c-s16 dest src-reg offval))
     8133                         (1 (! mem-ref-c-s8 dest src-reg offval))))))
     8134                  (t
     8135                   (with-imm-target () (src-reg :address)
     8136                     (with-additional-imm-reg ()
     8137                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     8138                         (x862-one-targeted-reg-form seg ptr src-reg)
     8139                         (if triv-p
     8140                           (if (acode-fixnum-form-p offset)
     8141                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     8142                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     8143                           (progn
     8144                             (! temp-push-unboxed-word src-reg)
     8145                             (x862-open-undo $undostkblk)
     8146                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     8147                             (! temp-pop-unboxed-word src-reg)
     8148                             (x862-close-undo)))
     8149                         (case size
     8150                           (8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
     8151                           (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
     8152                           (2 (! mem-ref-s16 dest src-reg offset-reg))
     8153                           (1 (! mem-ref-s8 dest src-reg offset-reg))))))))
     8154                (if (node-reg-p vreg)
     8155                  (case size
     8156                    ((1 2) (! box-fixnum vreg dest))
     8157                    (4 (target-arch-case
     8158                        (:x8632 (<- dest))
     8159                        (:x8664 (! box-fixnum vreg dest))))
     8160                    (8 (<- dest)))
     8161                  (<- dest))))
     8162             (t
     8163              (with-imm-target () (dest :natural)
     8164                (cond
     8165                  (absptr
     8166                   (case size
     8167                     (8 (! mem-ref-c-absolute-doubleword dest absptr))
     8168                     (4 (! mem-ref-c-absolute-fullword dest absptr))
     8169                     (2 (! mem-ref-c-absolute-u16 dest absptr))
     8170                     (1 (! mem-ref-c-absolute-u8 dest absptr))))
     8171                  (offval
     8172                   (with-additional-imm-reg ()
     8173                     (with-imm-target (dest) (src-reg :address)
     8174                       (x862-one-targeted-reg-form seg ptr src-reg)
     8175                       (case size
     8176                         (8 (! mem-ref-c-doubleword dest src-reg offval))
     8177                         (4 (! mem-ref-c-fullword dest src-reg offval))
     8178                         (2 (! mem-ref-c-u16 dest src-reg offval))
     8179                         (1 (! mem-ref-c-u8 dest src-reg offval))))))
     8180                  (t
     8181                   (with-additional-imm-reg ()
     8182                     (with-imm-target () (src-reg :address)
     8183                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     8184                         (x862-one-targeted-reg-form seg ptr src-reg)
     8185                         (if triv-p
     8186                           (if (acode-fixnum-form-p offset)
     8187                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     8188                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     8189                           (progn
     8190                             (! temp-push-unboxed-word src-reg)
     8191                             (x862-open-undo $undostkblk)
     8192                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     8193                             (! temp-pop-unboxed-word src-reg)
     8194                             (x862-close-undo)))
     8195                         (case size
     8196                           (8 (! mem-ref-doubleword dest src-reg offset-reg))
     8197                           (4 (! mem-ref-fullword dest src-reg offset-reg))
     8198                           (2 (! mem-ref-u16 dest src-reg offset-reg))
     8199                           (1 (! mem-ref-u8 dest src-reg offset-reg))))))))
     8200                (<- (set-regspec-mode
     8201                     dest
     8202                     (gpr-mode-name-value
     8203                      (case size
     8204                        (8 :u64)
     8205                        (4 :u32)
     8206                        (2 :u16)
     8207                        (1 :u8))))))))
    76718208           (^)))))
    76728209
     
    77308267        (push v real-vars)
    77318268        (push func real-funcs)
    7732         (let* ((i 5)                    ; skip 4 words of code, inner function
     8269        (let* ((i (target-arch-case
     8270                   (:x8632 7)
     8271                   (:x8664 5))) ; skip 4 words of code, inner function
    77338272               (our-var nil)
    77348273               (item nil))
     
    78218360  (^))
    78228361
    7823 
    78248362(defx862 x862-%lisp-word-ref %lisp-word-ref (seg vreg xfer base offset)
    78258363  (let* ((fixoffset (acode-fixnum-form-p offset)))
     
    78288366           (x862-form seg nil xfer offset))
    78298367          ((target-arch-case
    7830            
    7831             (:x8664 (typep fixoffset '(signed-byte 13))))
     8368            (:x8632 (typep fixoffset '(signed-byte 30)))
     8369            (:x8664 (typep fixoffset '(signed-byte 13)))) ;xxx needlessly small
    78328370           (ensuring-node-target (target vreg)
    78338371             (! lisp-word-ref-c target
     
    78768414               (with-imm-target () (otemp :s32)
    78778415                 (! fixnum->signed-natural otemp oreg)
    7878                 (with-imm-target () (val :natural)
    7879                    (! lisp-word-ref val breg otemp)
    7880                    (<- val)))
     8416                (with-imm-target () (val :natural)
     8417                   (! lisp-word-ref val breg otemp)
     8418                   (<- val)))
    78818419               (^))))))
    78828420
     
    79488486
    79498487(defx862 x862-generic-aref2 general-aref2 (seg vreg xfer arr i j)
     8488  (target-arch-case
     8489   (:x8632 (error "not for x8632 yet")))
    79508490  (let* ((atype0 (acode-form-type arr t))
    79518491         (ctype (if atype0 (specifier-type atype0)))
     
    79778517          (t
    79788518           (x862-three-targeted-reg-forms seg
    7979                                           arr ($ x8664::arg_x)
     8519                                          arr (target-arch-case
     8520                                               (:x8632 ($ x8632::temp0))
     8521                                               (:x8664 ($ x8664::arg_x)))
    79808522                                          i ($ *x862-arg-y*)
    79818523                                          j ($ *x862-arg-z*))
     
    79998541
    80008542(defx862 x862-general-aref3 general-aref3 (seg vreg xfer arr i j k)
     8543  (target-arch-case
     8544   (:x8632 (error "not for x8632 yet")))
    80018545  (let* ((atype0 (acode-form-type arr t))
    80028546         (ctype (if atype0 (specifier-type atype0)))
     
    80398583                                         
    80408584(defx862 x862-general-aset2 general-aset2 (seg vreg xfer arr i j new)
     8585  (target-arch-case
     8586   (:x8632 (error "not for x8632 yet")))
    80418587  (let* ((atype0 (acode-form-type arr t))
    80428588         (ctype (if atype0 (specifier-type atype0)))
     
    80768622
    80778623(defx862 x862-general-aset3 general-aset3 (seg vreg xfer arr i j k new)
     8624  (target-arch-case
     8625   (:x8632 (error "not for x8632 yet")))
    80788626  (let* ((atype0 (acode-form-type arr t))
    80798627         (ctype (if atype0 (specifier-type atype0)))
     
    81458693      (x862-vref seg vreg xfer type-keyword uvector index (unless *x862-reckless* (nx-lookup-target-uvector-subtag type-keyword)))
    81468694      (progn
    8147         (x862-three-targeted-reg-forms seg subtag ($ x8664::arg_x) uvector ($ *x862-arg-y*) index ($ *x862-arg-z*))
     8695        (x862-three-targeted-reg-forms seg
     8696                                       subtag (target-arch-case
     8697                                               (:x8632 ($ x8632::temp0))
     8698                                               (:x8664 ($ x8664::arg_x)))
     8699                                       uvector ($ *x862-arg-y*)
     8700                                       index ($ *x862-arg-z*))
    81488701        (! subtag-misc-ref)
    81498702        (when vreg (<- ($ *x862-arg-z*)))
     
    81598712      (x862-vset seg vreg xfer type-keyword uvector index newval (unless *x862-reckless* (nx-lookup-target-uvector-subtag type-keyword)))
    81608713      (progn
    8161         (x862-four-targeted-reg-forms seg subtag ($ x8664::temp0) uvector ($ x8664::arg_x) index ($ *x862-arg-y*) newval ($ *x862-arg-z*))
     8714        (target-arch-case
     8715         (:x8632
     8716          (x862-four-targeted-reg-forms seg subtag ($ x8632::temp1) uvector ($ x8632::temp0) index ($ x8632::arg_y) newval ($ x8632::arg_z)))
     8717         (:x8664
     8718          (x862-four-targeted-reg-forms seg subtag ($ x8664::temp0) uvector ($ x8664::arg_x) index ($ x8664::arg_y) newval ($ x8664::arg_z))))
    81628719        (! subtag-misc-set)
    81638720        (when vreg (<- ($ *x862-arg-z*)))
     
    82148771    (ensuring-node-target (target vreg)
    82158772      (x862-lri seg target (target-arch-case
    8216                            
     8773                            (:x8632 x8632::unbound-marker)
    82178774                            (:x8664 x8664::unbound-marker)))))
    82188775  (^))
     
    82228779    (ensuring-node-target (target vreg)
    82238780      (x862-lri seg target (target-arch-case
     8781                            (:x8632 x8632::slot-unbound-marker)
    82248782                            (:x8664 x8664::slot-unbound-marker)))))
    82258783  (^))
     
    82298787    (ensuring-node-target (target vreg)
    82308788      (x862-lri seg target (target-arch-case
     8789                            (:x8632 x8632::illegal-marker)
    82318790                            (:x8664 x8664::illegal-marker)))))
    82328791  (^))
     
    83648923(defx862 x862-%badarg2 %badarg2 (seg vreg xfer badthing goodthing)
    83658924  (x862-two-targeted-reg-forms seg badthing ($ *x862-arg-y*) goodthing ($ *x862-arg-z*))
    8366   (x862-lri seg ($ x8664::arg_x) (ash $XWRONGTYPE *x862-target-fixnum-shift*))
    8367   (x862-set-nargs seg 3)
    8368   (! ksignalerr)
    8369   (<- nil)
    8370   (^)) 
     8925  (target-arch-case
     8926   (:x8632
     8927    (let* ((*x862-vstack* *x862-vstack*)
     8928           (*x862-top-vstack-lcell* *x862-top-vstack-lcell*))
     8929      (! reserve-outgoing-frame)
     8930      (incf *x862-vstack* (* 2 *x862-target-node-size*))
     8931      (! vpush-fixnum (ash $XWRONGTYPE *x862-target-fixnum-shift*))
     8932      (x862-set-nargs seg 3)
     8933      (! ksignalerr))
     8934    (<- nil)
     8935    (^))
     8936   (:x8664
     8937    (x862-lri seg ($ x8664::arg_x) (ash $XWRONGTYPE *x862-target-fixnum-shift*))
     8938    (x862-set-nargs seg 3)
     8939    (! ksignalerr)
     8940    (<- nil)
     8941    (^))))
    83718942         
    83728943(defx862 x862-%set-sbchar %set-sbchar (seg vreg xfer string index value)
     
    83858956
    83868957(defx862 x862-make-list make-list (seg vreg xfer size initial-element)
    8387   (x862-form seg vreg xfer (make-acode (%nx1-operator call)
    8388                                        (make-acode (%nx1-operator immediate) 'make-list)
    8389                                        (list nil
    8390                                              (list initial-element
    8391                                                    (make-acode (%nx1-operator immediate)
    8392                                                                :initial-element)
    8393                                                    size)))))
    8394 
     8958  (let* ((args (list size
     8959                     (make-acode (%nx1-operator immediate) :initial-element)
     8960                     initial-element)))
     8961    (x862-form seg vreg xfer
     8962               (make-acode (%nx1-operator call)
     8963                           (make-acode (%nx1-operator immediate) 'make-list)
     8964                           (if (<= (length args) *x862-target-num-arg-regs*)
     8965                             (list nil (reverse args))
     8966                             (list (butlast args *x862-target-num-arg-regs*)
     8967                                   (reverse (last args *x862-target-num-arg-regs*))))))))
    83958968
    83968969(defx862 x862-setq-free setq-free (seg vreg xfer sym val)
     
    84098982    (x862-vpop-register seg *x862-arg-z*)
    84108983    (unless (or *x862-reckless* (x862-form-typep x 'macptr))
    8411       (with-imm-temps (src-reg) ()
    8412         (! trap-unless-macptr *x862-arg-z*)))
     8984      (with-additional-imm-reg (*x862-arg-z*)
     8985        (with-imm-temps (src-reg) ()
     8986          (! trap-unless-macptr *x862-arg-z*))))
    84138987    (! set-macptr-address src-reg *x862-arg-z*)
    84148988    (<- *x862-arg-z*)
     8989    (^)))
     8990
     8991;; used for x8632 only
     8992(defx862 x862-%setf-short-float %setf-short-float (seg vref xfer fnode fval)
     8993  (target-arch-case
     8994   (:x8664 (error "%setf-short-float makes no sense on x8664")))
     8995  (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*))
     8996  (let* ((target ($ *x862-fp1* :class :fpr :mode :single-float))
     8997         (node ($ *x862-arg-z*)))
     8998    (x862-one-targeted-reg-form seg fval target)
     8999    (x862-vpop-register seg node)
     9000    (unless (or *x862-reckless* (x862-form-typep fnode 'single-float))
     9001      (! trap-unless-single-float node))
     9002    (! store-single node target)
     9003    (<- node)
    84159004    (^)))
    84169005
     
    84919080            (if (typep abs '(signed-byte 16))             
    84929081              (x862-test-reg-%izerop seg vreg xfer other-target cr-bit true-p abs)
    8493               (with-imm-temps (other-target) ((abs-target :address))
    8494                 (use-imm-temp other-target)
    8495                 (x862-lri seg abs-target abs)
    8496                 (x862-compare-registers seg vreg xfer other-target abs-target cr-bit true-p))))
     9082              (with-additional-imm-reg ()
     9083                (with-imm-temps (other-target) ((abs-target :address))
     9084                  (use-imm-temp other-target)
     9085                  (x862-lri seg abs-target abs)
     9086                  (x862-compare-registers seg vreg xfer other-target abs-target cr-bit true-p)))))
    84979087          ;; Neither expression is obviously a constant-valued macptr.
    84989088          (with-imm-target () (target-a :address)
     
    85019091            (x862-open-undo $undostkblk)
    85029092            (x862-one-targeted-reg-form seg y target-a)
    8503             (with-imm-target (target-a) (target-b :address)
    8504               (! temp-pop-unboxed-word target-b)
    8505               (x862-close-undo)
    8506               (x862-compare-registers seg vreg xfer target-b target-a cr-bit true-p))))))))
     9093            (with-additional-imm-reg ()
     9094              (with-imm-target (target-a) (target-b :address)
     9095                (! temp-pop-unboxed-word target-b)
     9096                (x862-close-undo)
     9097                (x862-compare-registers seg vreg xfer target-b target-a cr-bit true-p)))))))))
    85079098
    85089099(defx862 x862-set-bit %set-bit (seg vreg xfer ptr offset newval)
     
    85599150                (unless triv-by
    85609151                  (x862-pop-register seg ptr-reg))
    8561                 (with-imm-target (ptr-reg) (by-reg :signed-natural)
    8562                   (! fixnum->signed-natural by-reg boxed-by)
    8563                   (let* ((result ptr-reg))
    8564                     (! fixnum-add2 result by-reg)
    8565                     (<- result))))))
     9152                (with-additional-imm-reg ()
     9153                  (with-imm-target (ptr-reg) (by-reg :signed-natural)
     9154                    (! fixnum->signed-natural by-reg boxed-by)
     9155                    (let* ((result ptr-reg))
     9156                      (! fixnum-add2 result by-reg)
     9157                      (<- result)))))))
    85669158        (^)))))
    85679159
     
    85719163  (x862-mvcall seg vreg xfer fn arglist))
    85729164
     9165(defx862 x862-i386-syscall i386-syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports)
     9166  (declare (ignore monitor-exception-ports))
     9167  (let* ((*x862-vstack* *x862-vstack*)
     9168         (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
     9169         (*x862-cstack* *x862-cstack*)
     9170         (offset 0)
     9171         (nwords 0))
     9172    (dolist (argspec argspecs)
     9173      (case argspec
     9174        ((:unsigned-doubleword :signed-doubleword)
     9175         (incf nwords 2))
     9176        (t (incf nwords))))
     9177    (! alloc-c-frame nwords)
     9178    (x862-open-undo $undo-x86-c-frame)
     9179    (x862-vpush-register seg (x862-one-untargeted-reg-form seg idx x8632::arg_z))
     9180    ;; Evaluate each form into the C frame, according to the
     9181    ;; matching argspec.
     9182    (do* ((specs argspecs (cdr specs))
     9183          (vals argvals (cdr vals)))
     9184         ((null specs))
     9185      (declare (list specs vals))
     9186      (let* ((valform (car vals))
     9187             (spec (car specs))
     9188             (absptr (acode-absolute-ptr-p valform)))
     9189        (case spec
     9190          ((:unsigned-doubleword :signed-doubleword)
     9191           (x862-one-targeted-reg-form seg valform ($ x8632::arg_z))
     9192           (if (eq spec :signed-doubleword)
     9193             (! gets64)
     9194             (! getu64))
     9195           (! set-c-arg-from-mm0 offset)
     9196           (incf offset 2))
     9197          (:address
     9198           (with-imm-target () (ptr :address)
     9199             (if absptr
     9200               (x862-lri seg ptr absptr)
     9201               (x862-form seg ptr nil valform))
     9202             (! set-c-arg ptr offset))
     9203           (incf offset))
     9204          (t
     9205           (with-imm-target () (valreg :natural)
     9206             (let* ((reg (x862-unboxed-integer-arg-to-reg seg valform valreg spec)))
     9207               (! set-c-arg reg offset)
     9208               (incf offset)))))))
     9209    (x862-vpop-register seg ($ x8632::arg_z))
     9210    (case resultspec
     9211      ((:unsigned-doubleword :signed-doubleword)
     9212       (! syscall2))                    ;copies doubleword result into %mm0
     9213      (t
     9214       (! syscall)))
     9215    (x862-close-undo)
     9216    (when vreg
     9217      (cond ((eq resultspec :void) (<- nil))
     9218            ((eq resultspec :unsigned-doubleword)
     9219             (ensuring-node-target (target vreg)
     9220               (! makeu64)
     9221               (x862-copy-register seg target ($ *x862-arg-z*))))
     9222            ((eq resultspec :signed-doubleword)
     9223             (ensuring-node-target (target vreg)
     9224               (! makes64)
     9225               (x862-copy-register seg target ($ *x862-arg-z*))))
     9226            (t
     9227             (case resultspec
     9228               (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*))
     9229               (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*))
     9230               (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*))
     9231               (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*)))
     9232             (<- (make-wired-lreg x8632::imm0
     9233                                  :mode
     9234                                  (gpr-mode-name-value
     9235                                   (case resultspec
     9236                                     (:address :address)
     9237                                     (:signed-byte :s8)
     9238                                     (:unsigned-byte :u8)
     9239                                     (:signed-halfword :s16)
     9240                                     (:unsigned-halfword :u16)
     9241                                     (:signed-fullword :s32)
     9242                                     (t :u32))))))))
     9243    (^)))
    85739244
    85749245
     
    86659336      (^)))
    86669337
     9338(defx862 x862-i386-ff-call i386-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
     9339  (declare (ignore monitor))
     9340  #+debug
     9341  (format t "~&~%i386-ff-call: argspecs = ~s, argvals = ~s, resultspec = ~s"
     9342          argspecs argvals resultspec)
     9343  (let* ((*x862-vstack* *x862-vstack*)
     9344         (*x862-top-vstack-lcell* *x862-top-vstack-lcell*)
     9345         (*x862-cstack* *x862-cstack*)
     9346         (offset 0)
     9347         (simple-foreign-args nil)
     9348         (nwords 0))
     9349    (dolist (argspec argspecs)
     9350      (case argspec
     9351        ((:double-float :unsigned-doubleword :signed-doubleword)
     9352         (incf nwords 2))
     9353        (t (incf nwords))))
     9354    (when (null argspecs)
     9355      (setq simple-foreign-args t))
     9356    (! alloc-c-frame nwords)
     9357    (x862-open-undo $undo-x86-c-frame)
     9358    (unless simple-foreign-args
     9359      (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8632::arg_z)))
     9360    ;; Evaluate each form into the C frame, according to the
     9361    ;; matching argspec.
     9362    (do* ((specs argspecs (cdr specs))
     9363          (vals argvals (cdr vals)))
     9364         ((null specs))
     9365      (declare (list specs vals))
     9366      (let* ((valform (car vals))
     9367             (spec (car specs))
     9368             (absptr (acode-absolute-ptr-p valform)))
     9369        (case spec
     9370          (:registers
     9371           (error "don't know what to do with argspec ~s" spec))
     9372          (:double-float
     9373           (let* ((df ($ x8632::fp0 :class :fpr :mode :double-float)))
     9374             (x862-one-targeted-reg-form seg valform df)
     9375             (! set-double-c-arg df offset))
     9376           (incf offset 2))
     9377          (:single-float
     9378           (let* ((sf ($ x8632::fp0 :class :fpr :mode :single-float)))
     9379             (x862-one-targeted-reg-form seg valform sf)
     9380             (! set-single-c-arg sf offset))
     9381           (incf offset))
     9382          (:address
     9383           (with-imm-target () (ptr :address)
     9384             (if absptr
     9385               (x862-lri seg ptr absptr)
     9386               (x862-form seg ptr nil valform))
     9387             (! set-c-arg ptr offset))
     9388           (incf offset))
     9389          (t
     9390           (if (typep spec 'unsigned-byte)
     9391             (progn
     9392               (with-imm-target () (ptr :address)
     9393                 (x862-one-targeted-reg-form seg valform ptr)
     9394                 (with-additional-imm-reg (ptr)
     9395                   (with-imm-target (ptr) (r :natural)
     9396                     (dotimes (i spec)
     9397                       (! mem-ref-c-fullword r ptr (ash i x8632::word-shift))
     9398                       (! set-c-arg r offset)))))
     9399               (incf offset spec))
     9400             (with-imm-target () (valreg :natural)
     9401               (let* ((reg (x862-unboxed-integer-arg-to-reg seg valform valreg spec)))
     9402                 (! set-c-arg reg offset)
     9403                 (incf offset))))))))
     9404    (if simple-foreign-args
     9405      (x862-one-targeted-reg-form seg address x8632::arg_z)
     9406      (x862-vpop-register seg ($ x8632::arg_z)))
     9407    (! ff-call)
     9408    (x862-close-undo)
     9409    (when vreg
     9410      (cond ((eq resultspec :void) (<- nil))
     9411            ;; Floating-point results are returned on the x87 stack.
     9412            ((eq resultspec :double-float)
     9413             (let ((fpreg ($ x8632::fp0 :class :fpr :mode :double-float)))
     9414               (! fp-stack-to-double fpreg)
     9415               (<- fpreg)))
     9416            ((eq resultspec :single-float)
     9417             (let ((fpreg ($ x8632::fp0 :class :fpr :mode :single-float)))
     9418               (! fp-stack-to-single fpreg)
     9419               (<- fpreg)))
     9420            ((eq resultspec :unsigned-doubleword)
     9421             (ensuring-node-target (target vreg)
     9422               ;; xxx -- need to ensure that edx is marked as an imm reg
     9423               (! makeu64)
     9424               (x862-copy-register seg target ($ *x862-arg-z*))))
     9425            ((eq resultspec :signed-doubleword)
     9426             (ensuring-node-target (target vreg)
     9427               ;; xxx -- need to ensure that edx is marked as an imm reg
     9428               (! makes64)
     9429               (x862-copy-register seg target ($ *x862-arg-z*))))
     9430            (t
     9431             (case resultspec
     9432               (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*))
     9433               (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*))
     9434               (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*))
     9435               (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*)))
     9436             (<- (make-wired-lreg x8632::imm0
     9437                                  :mode
     9438                                  (gpr-mode-name-value
     9439                                   (case resultspec
     9440                                     (:address :address)
     9441                                     (:signed-byte :s8)
     9442                                     (:unsigned-byte :u8)
     9443                                     (:signed-halfword :s16)
     9444                                     (:unsigned-halfword :u16)
     9445                                     (:signed-fullword :s32)
     9446                                     (t :u32))))))))
     9447    (^)))
    86679448
    86689449(defx862 x862-ff-call ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
     
    88809661          (if (not (or u31x u31y))
    88819662            (with-imm-target () (xreg :natural)
    8882               (with-imm-target (xreg) (yreg :natural)
    8883                 (x862-two-targeted-reg-forms seg x xreg y yreg)
    8884                 (! %natural+ xreg yreg))
     9663              (with-additional-imm-reg ()
     9664                (with-imm-target (xreg) (yreg :natural)
     9665                  (x862-two-targeted-reg-forms seg x xreg y yreg)
     9666                  (! %natural+ xreg yreg)))
    88859667              (<- xreg))
    88869668            (let* ((other (if u31x y x)))
     
    89029684        (let* ((u31y (and (typep fix-y '(unsigned-byte 31)) fix-y)))
    89039685          (if (not u31y)
    8904             (with-imm-target () (xreg :natural)
    8905               (with-imm-target (xreg) (yreg :natural)
    8906                 (x862-two-targeted-reg-forms seg x xreg y yreg)
    8907                 (! %natural- xreg  yreg))
    8908               (<- xreg))
     9686            (with-imm-target () (xreg :natural)
     9687              (with-additional-imm-reg ()
     9688                (with-imm-target (xreg) (yreg :natural)
     9689                  (x862-two-targeted-reg-forms seg x xreg y yreg)
     9690                  (! %natural- xreg yreg))
     9691                (<- xreg)))
    89099692            (progn
    89109693              (with-imm-target () (xreg :natural)
     
    89289711          (if (not constant)
    89299712            (with-imm-target () (xreg :natural)
    8930               (with-imm-target (xreg) (yreg :natural)
    8931                 (x862-two-targeted-reg-forms seg x xreg y yreg)
    8932                 (! %natural-logior xreg yreg))
     9713              (with-additional-imm-reg ()
     9714                (with-imm-target (xreg) (yreg :natural)
     9715                  (x862-two-targeted-reg-forms seg x xreg y yreg)
     9716                  (! %natural-logior xreg yreg)))
    89339717              (<- xreg))
    89349718            (let* ((other (if u31x y x)))
     
    89539737          (if (not constant)
    89549738            (with-imm-target () (xreg :natural)
    8955               (with-imm-target (xreg) (yreg :natural)
    8956                 (x862-two-targeted-reg-forms seg x xreg y yreg)
    8957                 (! %natural-logxor xreg yreg))
     9739              (with-additional-imm-reg ()
     9740                (with-imm-target (xreg) (yreg :natural)
     9741                  (x862-two-targeted-reg-forms seg x xreg y yreg)
     9742                  (! %natural-logxor xreg yreg)))
    89589743              (<- xreg))
    89599744            (let* ((other (if u32x y x)))
     
    89789763          (if (not constant)
    89799764            (with-imm-target () (xreg :natural)
    8980               (with-imm-target (xreg) (yreg :natural)
    8981                 (x862-two-targeted-reg-forms seg x xreg y yreg)
    8982                 (! %natural-logand xreg yreg))
     9765              (with-additional-imm-reg ()
     9766                (with-imm-target (xreg) (yreg :natural)
     9767                  (x862-two-targeted-reg-forms seg x xreg y yreg)
     9768                  (! %natural-logand xreg yreg)))
    89839769              (<- xreg))
    89849770            (let* ((other (if u31x y x)))
     
    90119797                         (x862-store-immediate seg sym symreg)))
    90129798        (! symbol-ref target symreg (target-arch-case
    9013                                         (:x8664 x8664::symbol.vcell-cell))))))
     9799                                     (:x8632 x8632::symbol.vcell-cell)
     9800                                     (:x8664 x8664::symbol.vcell-cell))))))
    90149801  (^))
    90159802
     
    90239810             (make-acode (%nx1-operator fixnum)
    90249811                         (target-arch-case
     9812                          (:x8632 x8632::symbol.vcell-cell)
    90259813                          (:x8664 x8664::symbol.vcell-cell)))
    90269814             val
     
    924110029#-x86-target
    924210030(defun x8664-xcompile-lambda (def &key show-vinsns (symbolic-names t)
    9243                                   (target :linuxx8664)
     10031                                  (target :darwinx8664)
    924410032                                  (disassemble t))
    924510033  (let* ((*x862-debug-mask* (if show-vinsns
     
    926010048      xlfun)))
    926110049
    9262 
    9263 
    9264 
     10050#-x8632-target
     10051(defun x8632-xcompile-lambda (def &key show-vinsns (symbolic-names t)
     10052                                  (target :darwinx8632)
     10053                                  (disassemble t))
     10054  (let* ((*x862-debug-mask* (if show-vinsns
     10055                              (ash 1 x862-debug-vinsns-bit)
     10056                              0))
     10057         (backend (find-backend target))
     10058         (*target-ftd* (if backend
     10059                         (backend-target-foreign-type-data backend)
     10060                         *target-ftd*)))
     10061    (multiple-value-bind (xlfun warnings)
     10062        (compile-named-function def nil
     10063                                nil
     10064                                nil
     10065                                nil
     10066                                nil
     10067                                nil
     10068                                target)
     10069      (signal-or-defer-warnings warnings nil)
     10070      (when disassemble
     10071        (let ((*target-backend* backend))
     10072          (format t "~%~%")
     10073          (apply #'x8632-disassemble-xfunction
     10074                 xlfun
     10075                 (unless symbolic-names (list nil)))))
     10076      xlfun)))
     10077
     10078
     10079
     10080
Note: See TracChangeset for help on using the changeset viewer.