Changeset 16496


Ignore:
Timestamp:
Aug 6, 2015, 10:29:53 PM (4 years ago)
Author:
gb
Message:

work-in-progress.

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

Legend:

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

    r16492 r16496  
    25082508            (x862-absolute-natural seg($ x8664::arg_x) nil (ash $xwrongtype x8664::fixnumshift))
    25092509            (! set-nargs 3)
    2510 o            (! call-subprim-no-return (subprim-name->offset '.SPksignalerr))
     2510            (! call-subprim-no-return (subprim-name->offset '.SPksignalerr))
    25112511            (@ continue-label))))
    25122512        (unless i-known-fixnum
     
    32413241                               (and (all-simple (car arglist))
    32423242                                    (all-simple (cadr arglist))
    3243                                     (setq fn (var-ea lexref)))))))
     3243                                    (setq fn (or (var-lreg lexref) (var-ea lexref))))))))
    32443244           (cstack *x862-cstack*)
    32453245           (vstack *x862-vstack*))
     
    1014710147
    1014810148(defx862 x862-labels labels (seg vreg xfer vars afuncs body p2decls)
    10149   (linear-scan-bailout "LABELS needs work")
    1015010149  (let* ((fwd-refs nil)
    1015110150         (func nil)
     
    1017210171                  (push (list v item) fwd-refs))))
    1017310172            (incf i)))
    10174         (setq togo (%cdr togo))))       
     10173        (setq togo (%cdr togo))))
    1017510174    (if (null fwd-refs)
    1017610175      (x862-seq-fbind seg vreg xfer (nreverse real-vars) (nreverse real-funcs) body p2decls)
    1017710176      (let* ((old-stack (x862-encode-stack)))
     10177        (linear-scan-bailout "LABELS needs more work")
    1017810178        (setq real-vars (nreverse real-vars) real-funcs (nreverse real-funcs))
    1017910179        (with-x86-p2-declarations p2decls
     
    1023910239(defx862 x862-inherited-arg inherited-arg (seg vreg xfer arg)
    1024010240  (when vreg
    10241     (x862-addrspec-to-reg seg (x862-ea-open (var-ea arg)) vreg))
     10241    (if *backend-use-linear-scan*
     10242      (progn
     10243        (if (and (typep arg 'var) (var-lreg arg) (typep vreg 'lreg))
     10244          (x862-copy-register seg vreg (var-lreg arg))
     10245        (break)))
     10246      (x862-addrspec-to-reg seg (x862-ea-open (var-ea arg)) vreg)))
    1024210247  (^))
    1024310248
  • branches/lscan/source/compiler/nx.lisp

    r16415 r16496  
    223223
    224224
     225(defparameter *current-function-name* nil)
    225226
    226227(defun compile-named-function (def &rest args
     
    237238  (handler-case
    238239      (progn
    239   (when (and name *nx-discard-xref-info-hook*)
    240     (funcall *nx-discard-xref-info-hook* name))
    241   (setq
    242    def
    243    (let* ((*load-time-eval-token* load-time-eval-token)
    244           (*backend-use-linear-scan*  (unless force-legacy-backend *backend-use-linear-scan*))
    245           (*force-legacy-backend* force-legacy-backend)
    246           (*nx-source-note-map* source-notes)
    247           (*nx-current-note* function-note)
    248           (*record-pc-mapping* (and source-notes record-pc-mapping))
    249           (*compile-code-coverage* (and source-notes compile-code-coverage))
    250           (*nx-current-code-note* (and *compile-code-coverage*
    251                                        (make-code-note :form def :source-note function-note)))
    252           (env (new-lexical-environment env)))
    253      (setf (lexenv.variables env) 'barrier)
    254      (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
    255             (*nx-target-fixnum-type*
    256              (target-word-size-case
    257               (32 *nx-32-bit-fixnum-type*)
    258               (64 *nx-64-bit-fixnum-type*)))
    259             (*nx-target-half-fixnum-type*
    260              (target-word-size-case
    261               (32 '(signed-byte 29))
    262               (64 '(signed-byte 60))))
    263             (*nx-target-natural-type*
    264              (target-word-size-case
    265               (32 *nx-32-bit-natural-type*)
    266               (64 *nx-64-bit-natural-type*)))
    267             (*nx-in-frontend* t)
    268             (afunc (nx1-compile-lambda
    269                     name
    270                     def
    271                     (make-afunc)
    272                     nil
    273                     env
    274                     (or policy *default-compiler-policy*)
    275                     *load-time-eval-token*)))
    276        (setq *nx-in-frontend* nil)
    277        (if (afunc-lfun afunc)
    278          afunc
    279          (progn
    280            (when (and *nx-rewrite-acode*
    281                       (afunc-acode afunc))
    282              (rewrite-acode-form (afunc-acode afunc) t))
    283            (funcall (backend-p2-compile *target-backend*)
    284                     afunc
    285                     ;; will also bind *nx-lexical-environment*
    286                     (if keep-lambda (if (lambda-expression-p keep-lambda) keep-lambda def))
    287                     keep-symbols))))))
    288   (values (afunc-lfun def) (afunc-warnings def)))
     240        (when (and name *nx-discard-xref-info-hook*)
     241          (funcall *nx-discard-xref-info-hook* name))
     242        (setq
     243         def
     244         (let* ((*load-time-eval-token* load-time-eval-token)
     245                (*current-function-name* (or name "an anonymous funcrion"))
     246                (*backend-use-linear-scan*  (unless force-legacy-backend *backend-use-linear-scan*))
     247                (*force-legacy-backend* force-legacy-backend)
     248                (*nx-source-note-map* source-notes)
     249                (*nx-current-note* function-note)
     250                (*record-pc-mapping* (and source-notes record-pc-mapping))
     251                (*compile-code-coverage* (and source-notes compile-code-coverage))
     252                (*nx-current-code-note* (and *compile-code-coverage*
     253                                             (make-code-note :form def :source-note function-note)))
     254                (env (new-lexical-environment env)))
     255           (setf (lexenv.variables env) 'barrier)
     256           (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
     257                  (*nx-target-fixnum-type*
     258                   (target-word-size-case
     259                    (32 *nx-32-bit-fixnum-type*)
     260                    (64 *nx-64-bit-fixnum-type*)))
     261                  (*nx-target-half-fixnum-type*
     262                   (target-word-size-case
     263                    (32 '(signed-byte 29))
     264                    (64 '(signed-byte 60))))
     265                  (*nx-target-natural-type*
     266                   (target-word-size-case
     267                    (32 *nx-32-bit-natural-type*)
     268                    (64 *nx-64-bit-natural-type*)))
     269                  (*nx-in-frontend* t)
     270                  (afunc (nx1-compile-lambda
     271                          name
     272                          def
     273                          (make-afunc)
     274                          nil
     275                          env
     276                          (or policy *default-compiler-policy*)
     277                          *load-time-eval-token*)))
     278             (setq *nx-in-frontend* nil)
     279             (if (afunc-lfun afunc)
     280               afunc
     281               (progn
     282                 (when (and *nx-rewrite-acode*
     283                            (afunc-acode afunc))
     284                   (rewrite-acode-form (afunc-acode afunc) t))
     285                 (funcall (backend-p2-compile *target-backend*)
     286                          afunc
     287                          ;; will also bind *nx-lexical-environment*
     288                          (if keep-lambda (if (lambda-expression-p keep-lambda) keep-lambda def))
     289                          keep-symbols))))))
     290        (values (afunc-lfun def) (afunc-warnings def)))
    289291    (linear-scan-bailout
    290292     ()
    291        (apply #'compile-named-function def :force-legacy-backend T args))))
     293     (apply #'compile-named-function def :force-legacy-backend T args))))
    292294                         
    293295
  • branches/lscan/source/compiler/vinsn.lisp

    r16490 r16496  
    754754          (insert-dll-node-after
    755755           (aref *backend-labels* (backend-get-next-label))
    756            current)))
     756           current))
     757        (merge-adjacent-labels header))
    757758    (setq currtype (cond ((vinsn-label-p current) :label)
    758759                         ((vinsn-attribute-p current :branch) :branch)
     
    782783             (insert-dll-node-after
    783784              (let* ((jump (select-vinsn "JUMP" *backend-vinsns* (list lab))))
     785
    784786                (push jump (vinsn-label-refs lab))
    785787                jump)
     
    796798       ((eq current vinsns) (values nil nil))
    797799    (declare (fixnum i))
    798     (if (vinsn-label-p current)
     800    (when (vinsn-label-p current)
     801      (when (eql i 1) (break))
    799802      (return (remove-dll-node current i)))))
    800803
     
    973976
    974977(defun branch-target-node (v)
     978  (check-type v vinsn)
    975979  (dll-node-pred (svref (vinsn-variable-parts v) 0)))
    976980
     
    13761380               (ncu (length child-used)))
    13771381          (let* ((defs (lreg-defs lreg)))
    1378             (when (cdr defs) (linear-scan-bailout "not yet - assignment in spilled interval")))
     1382           (when (cdr defs)  (linear-scan-bailout (format nil "not yet - assignment/multiple definitions in spilled interval ~s" defs))))
    13791383         
    13801384
     
    17451749  (when *backend-use-linear-scan*
    17461750    (when (or reason-p *linear-scan-verbose*)
    1747       (format *error-output* "~%~%bailing-out of linear-scan:~&~&~a" reason))
     1751      (format *error-output* "~%~%bailing-out of linear-scan for ~a :~&~&~a" *current-function-name* reason ))
    17481752    (signal 'linear-scan-bailout)))
    17491753
     
    17581762      (dolist (v uses t) (elide-vinsn v)))))
    17591763
    1760 (defun optimize-vinsns (header)
    1761   ;; Delete unreferenced labels that the compiler might have emitted.
    1762   ;; Subsequent operations may cause other labels to become
    1763   ;; unreferenced.
     1764(defun merge-adjacent-labels (header)
     1765 
    17641766  (let* ((labels (collect ((labs))
    17651767                   (do-dll-nodes (v header)
    17661768                     (when (vinsn-label-p v) (labs v)))
    1767                    (labs)))
    1768          (regs (vinsn-list-lregs header)))
    1769     ;; Look for pairs of adjacent, referenced labels.
    1770     ;; Merge them together (so that one of them becomes unreferenced.)
    1771     ;; Repeat the process until no pairs are found.
     1769                   (labs))))
    17721770    (do* ((repeat t))
    17731771         ((not repeat))
     
    17791777            (backend-merge-labels l succ)
    17801778            (setq repeat t)
    1781             (return)))))
     1779            (return)))))))
     1780
     1781(defun optimize-vinsns (header)
     1782  ;; Delete unreferenced labels that the compiler might have emitted.
     1783  ;; Subsequent operations may cause other labels to become
     1784  ;; unreferenced.
     1785  (let* ((regs (vinsn-list-lregs header)))
     1786
     1787    (merge-adjacent-labels header)
     1788    ;; Look for pairs of adjacent, referenced labels.
     1789    ;; Merge them together (so that one of them becomes unreferenced.)
     1790    ;; Repeat the process until no pairs are found.
     1791
    17821792    (maximize-jumps header)
    1783     (delete-unreferenced-labels labels)
    17841793    (eliminate-dead-code header)
    17851794    (cond (*backend-use-linear-scan*
Note: See TracChangeset for help on using the changeset viewer.