Changeset 16506


Ignore:
Timestamp:
Aug 17, 2015, 2:14:37 AM (4 years ago)
Author:
gb
Message:

current code.

Location:
branches/lscan/source/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/lscan/source/compiler/X86/x862.lisp

    r16502 r16506  
    13131313        (progn
    13141314          (setq *x862-incoming-args-on-stack* 0)
    1315          (if (eql min 0)
    1316            (! check-max-nargs max)
    1317            (! check-min-max-nargs min max))
    1318          (! save-lisp-context-no-stack-args)
    1319          (! default-1-arg min)
    1320          (let*  ((nspilled 0))
    1321            (setq *x862-vstack* (ash nspilled 3)))
    1322          (! reserve-spill-area)
    1323          (! save-nfp)
    1324          (do* ((nargs (length args) (1- nargs)))
     1315          (if (eql min 0)
     1316            (! check-max-nargs max)
     1317            (! check-min-max-nargs min max))
     1318          (! save-lisp-context-no-stack-args)
     1319          (! default-1-arg min)
     1320          (let*  ((nspilled 0))
     1321
     1322
     1323
     1324            (setq *x862-vstack* (ash nspilled 3)))
     1325          (! reserve-spill-area)
     1326          (! save-nfp)
     1327          (do* ((nargs (length args) (1- nargs)))
    13251328             
    1326               ((null args) ())
    1327            (declare (type (signed-byte 16) nargs ))
    1328            (let* ((var (pop args))
    1329                   (reg (?)))
    1330              (cond ((= nargs 3)
    1331                     (! copy-gpr reg ($ x8664::arg_x)))
     1329               ((null args) ())
     1330            (declare (type (signed-byte 16) nargs ))
     1331            (let* ((var (pop args))
     1332                   (reg (?)))
     1333              (cond ((= nargs 3)
     1334                     (! copy-gpr reg ($ x8664::arg_x)))
    13321335                   
    1333                    ((= nargs 2)
    1334                     (! copy-gpr reg  ($ x8664::arg_y)))
    1335                    
    1336                    ((= nargs 1)
    1337                     (! copy-gpr reg ($ x8664::arg_z))))
    1338              (setf (var-lreg var) reg)))
     1336                    ((= nargs 2)
     1337                     (! copy-gpr reg  ($ x8664::arg_y)))
     1338               
     1339   
     1340                    ((= nargs 1)
     1341                     (! copy-gpr reg ($ x8664::arg_z))))
     1342              (setf (var-lreg var) reg)))
    13391343
    13401344         
    1341          t)))))
     1345          t)))))
    13421346         
    13431347(defun x862-fixed-args-entry (seg rev-fixed-args)
     
    13591363               (setq *x862-vstack* (ash nspilled 3)))
    13601364     
    1361              (@ (setq *x862-fixed-self-tail-call-label* (backend-get-next-label)))
    13621365
    13631366             (! reserve-spill-area)
    13641367             (! save-nfp)
     1368             (@ (setq *x862-fixed-self-tail-call-label* (backend-get-next-label)))
     1369             
    13651370             (do* ((nargs (length args) (1- nargs)))
    13661371
     
    86008605
    86018606(defx862 x862-self-call self-call (seg vreg xfer arglist &optional spread-p)
    8602   (progn
    8603     (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
    8604     (let* ((nargs *x862-tail-nargs*))
    8605       (if (and nargs (x862-tailcallok xfer) (not spread-p)
    8606                (eql nargs (+ 17  (length (car arglist))
    8607                              (length (cadr arglist)))))
    8608         (let* ((forms (append (car arglist) (reverse (cadr arglist))))
    8609                (vars *x862-tail-arg-vars*)
    8610                (regs (ecase nargs
    8611                        (0 ())
    8612                        (1 (list ($ *x862-arg-z*)))
    8613                        (2 (list ($ *x862-arg-y*) ($ *x862-arg-z*)))
    8614                        (3 (list (target-arch-case
    8615                                  (:x8632 ($ x8632::temp0))
    8616                                  (:x8664 ($ x8664::arg_x)))
    8617                                 ($ *x862-arg-y*) ($ *x862-arg-z*)))
    8618                        (4 (target-arch-case
    8619                            (:x8632 (compiler-bug "4 tail-call args on x8632"))
    8620                            (:x8664 (list ($ x8664::temp0)
    8621                                          ($ x8664::arg_x)
    8622                                          ($ x8664::arg_y)
    8623                                          ($ x8664::arg_z))))))))
    8624           ;; A form that's a lexical reference to X that's ultimately going
    8625           ;; to be stored in X is a noop.
    8626           (collect ((new-forms)
    8627                     (new-vars)
    8628                     (new-regs))
    8629             (do* ((xforms forms (cdr xforms))
    8630                   (xvars vars (cdr xvars))
    8631                   (xregs regs (cdr xregs))
    8632                   (new-nargs 0))
    8633                  ((null xforms)
    8634                   (setq nargs new-nargs
    8635                         forms (new-forms)
    8636                         vars (new-vars)
    8637                         regs (new-regs)))
    8638               (declare (fixnum new-nargs))
    8639               (let* ((var (car xvars))
    8640                      (form (car xforms)))
    8641                 (unless (and (eq var (nx2-lexical-reference-p form))
    8642                              (not (logbitp $vbitsetq (nx-var-bits var)))
    8643                              (var-nvr var))
    8644                   (incf new-nargs)
    8645                   (new-vars var)
    8646                   (new-forms form)
    8647                   (new-regs (car xregs))))))
    8648           (dotimes (i nargs)
    8649             (let* ((var (nth i vars))
    8650                    (nvr (var-nvr var)))
    8651               (when nvr
    8652                 (when (dotimes (j nargs t)
    8653                         (unless (= i j)
    8654                           (let* ((form (nth j forms)))
    8655                             (unless (and (nx2-var-not-set-by-form-p var form)
    8656                                          (nx2-var-not-reffed-by-form-p var form))
    8657                               (return)))))
    8658                   (setf (nth i regs) nvr)))))
    8659           (case nargs
    8660             (1 (x862-one-targeted-reg-form seg (car forms) (car regs)))
    8661             (2 (x862-two-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)))
    8662             (3 (x862-three-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs) (caddr forms) (caddr regs)))
    8663             (4 (x862-four-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)  (caddr forms) (caddr regs) (cadddr forms) (cadddr regs))))
    8664           (do* ((vars vars (cdr vars))
    8665                 (forms forms (cdr forms))
    8666                 (regs regs (cdr regs)))
    8667                ((null vars))
    8668             (let* ((var (car vars))
    8669                    (reg (car regs)))
    8670               (unless (and (eq var (nx2-lexical-reference-p (car forms)))
    8671                            (not (logbitp $vbitsetq (nx-var-bits var))))
    8672                 (x862-do-lexical-setq seg nil (var-ea var) reg))))
    8673           (let* ((diff (- *x862-vstack* *x862-tail-vsp*)))
    8674             (unless (eql 0 diff)
    8675               (! adjust-vsp diff))
    8676             (! jump (aref *backend-labels* *x862-tail-label*))))
    8677         (x862-call-fn seg vreg xfer -2 arglist spread-p)))))
     8607  (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
     8608  (with-x86-local-vinsn-macros (seg)
     8609
     8610    (cond (*backend-use-linear-scan*
     8611           (let* ((nargs (+ (length (car arglist)) (length (cadr arglist))))
     8612                  (tail-p (x862-tailcallok xfer)))
     8613             (declare (fixnum nargs))
     8614             (if (and (eql nargs *x862-tail-nargs*) tail-p (not spread-p))
     8615               (let ((args (append (car arglist) (reverse (cadr arglist)))))
     8616                 (ecase nargs
     8617                   (0)
     8618                   (1 (x862-one-lreg-form seg (car args) ($ x8664::arg_z)))
     8619                   (2 (x862-two-targeted-reg-forms seg (car args) ($ x8664::arg_y) (cadr args) ($ x8664::arg_z)))
     8620                   (3 (x862-three-targeted-reg-forms seg (car args) ($ x8664::arg_x) (cadr args) ($ x8664::arg_y) (caddr args) ($ x8664::arg_z)))
     8621                   (4 (x862-four-targeted-reg-forms seg  (car args) ($ x8664::arg_w) (cadr args) ($ x8664::arg_x) (caddr args) ($ x8664::arg_y) (cadddr args) ($ x8664::arg_z))))
     8622                 (let* ((depth *x862-vstack*))
     8623                   (unless (eql 0 depth)
     8624                     (! adjust-vsp depth)))
     8625                 (-> *x862-fixed-self-tail-call-label*))
     8626               (break)))
     8627                   
     8628       
     8629               
     8630         
     8631
     8632           )
     8633          (t
     8634           (progn
     8635   
     8636             (let* ((nargs *x862-tail-nargs*))
     8637               (if (and nargs (x862-tailcallok xfer) (not spread-p)
     8638                        (eql nargs (+ 17  (length (car arglist))
     8639                                      (length (cadr arglist)))))
     8640                 (let* ((forms (append (car arglist) (reverse (cadr arglist))))
     8641                        (vars *x862-tail-arg-vars*)
     8642                        (regs (ecase nargs
     8643                                (0 ())
     8644                                (1 (list ($ *x862-arg-z*)))
     8645                                (2 (list ($ *x862-arg-y*) ($ *x862-arg-z*)))
     8646                                (3 (list (target-arch-case
     8647                                          (:x8632 ($ x8632::temp0))
     8648                                          (:x8664 ($ x8664::arg_x)))
     8649                                         ($ *x862-arg-y*) ($ *x862-arg-z*)))
     8650                                (4 (target-arch-case
     8651                                    (:x8632 (compiler-bug "4 tail-call args on x8632"))
     8652                                    (:x8664 (list ($ x8664::temp0)
     8653                                                  ($ x8664::arg_x)
     8654                                                  ($ x8664::arg_y)
     8655                                                  ($ x8664::arg_z))))))))
     8656                   ;; A form that's a lexical reference to X that's ultimately going
     8657                   ;; to be stored in X is a noop.
     8658                   (collect ((new-forms)
     8659                             (new-vars)
     8660                             (new-regs))
     8661                     (do* ((xforms forms (cdr xforms))
     8662                           (xvars vars (cdr xvars))
     8663                           (xregs regs (cdr xregs))
     8664                           (new-nargs 0))
     8665                          ((null xforms)
     8666                           (setq nargs new-nargs
     8667                                 forms (new-forms)
     8668                                 vars (new-vars)
     8669                                 regs (new-regs)))
     8670                       (declare (fixnum new-nargs))
     8671                       (let* ((var (car xvars))
     8672                              (form (car xforms)))
     8673                         (unless (and (eq var (nx2-lexical-reference-p form))
     8674                                      (not (logbitp $vbitsetq (nx-var-bits var)))
     8675                                      (var-nvr var))
     8676                           (incf new-nargs)
     8677                           (new-vars var)
     8678                           (new-forms form)
     8679                           (new-regs (car xregs))))))
     8680                   (dotimes (i nargs)
     8681                     (let* ((var (nth i vars))
     8682                            (nvr (var-nvr var)))
     8683                       (when nvr
     8684                         (when (dotimes (j nargs t)
     8685                                 (unless (= i j)
     8686                                   (let* ((form (nth j forms)))
     8687                                     (unless (and (nx2-var-not-set-by-form-p var form)
     8688                                                  (nx2-var-not-reffed-by-form-p var form))
     8689                                       (return)))))
     8690                           (setf (nth i regs) nvr)))))
     8691                   (case nargs
     8692                     (1 (x862-one-targeted-reg-form seg (car forms) (car regs)))
     8693                     (2 (x862-two-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)))
     8694                     (3 (x862-three-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs) (caddr forms) (caddr regs)))
     8695                     (4 (x862-four-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)  (caddr forms) (caddr regs) (cadddr forms) (cadddr regs))))
     8696                   (do* ((vars vars (cdr vars))
     8697                         (forms forms (cdr forms))
     8698                         (regs regs (cdr regs)))
     8699                        ((null vars))
     8700                     (let* ((var (car vars))
     8701                            (reg (car regs)))
     8702                       (unless (and (eq var (nx2-lexical-reference-p (car forms)))
     8703                                    (not (logbitp $vbitsetq (nx-var-bits var))))
     8704                         (x862-do-lexical-setq seg nil (var-ea var) reg))))
     8705                   (let* ((diff (- *x862-vstack* *x862-tail-vsp*)))
     8706                     (unless (eql 0 diff)
     8707                       (! adjust-vsp diff))
     8708                     (! jump (aref *backend-labels* *x862-tail-label*))))
     8709                 (x862-call-fn seg vreg xfer -2 arglist spread-p))))))))
    86788710
    86798711
  • branches/lscan/source/compiler/nx.lisp

    r16502 r16506  
    224224
    225225(defparameter *current-function-name* nil)
     226(defparameter *nx-current-function* nil)
    226227
    227228(defun compile-named-function (def &rest args
     
    282283                 (when (and *nx-rewrite-acode*
    283284                            (afunc-acode afunc))
    284                    (rewrite-acode-form (afunc-acode afunc) t))
     285                   (let* ((*nx-current-function* afunc))
     286                     (rewrite-acode-form (afunc-acode afunc) t)))
    285287                 (funcall (backend-p2-compile *target-backend*)
    286288                          afunc
Note: See TracChangeset for help on using the changeset viewer.