Changeset 16448


Ignore:
Timestamp:
Jul 6, 2015, 8:43:04 AM (4 years ago)
Author:
gb
Message:

Mostly moving forward.
Still problems with com[lex lambda lists, and with interval spillng/splitting.

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

Legend:

Unmodified
Added
Removed
  • branches/lscan/source/compiler/X86/X8664/x8664-vinsns.lisp

    r16440 r16448  
    20332033  (jae :push-more)
    20342034  (movslq (:%l imm) (:%q imm))
    2035   (subq (:%q imm) (:%q x8664::rsp))
     2035  (subq (:%q imm) (:%q x8664::rsp))    ; sic.  "imm" ia negative here
    20362036  (jmp :done)
    20372037  :push-loop
     2038
    20382039  (pushq (:$l (:apply target-nil-value)))
    20392040  (addl (:$b x8664::node-size) (:%l x8664::nargs))
     
    20772078
    20782079;;; %ra0 is pointing into %fn, so no need to copy %fn here.
    2079 (define-x8664-vinsn (pass-multiple-values-symbol :jumplr) (()
    2080                                                          ())
    2081   (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
    2082   (jmp (:@ x8664::symbol.fcell (:% x8664::fname))))
     2080(define-x8664-vinsn (xpass-multiple-values-symbol :call  :extended-call :jumplr)
     2081    (()
     2082     ((lab :label))
     2083     ())                                                               
     2084  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
     2085  (jmp (:@ x8664::symbol.fcell (:% x8664::fname)))
     2086
     2087  )
     2088
     2089(define-x8664-vinsn (pass-multiple-values-symbol :call  :extended-call :jumplr)
     2090    (()
     2091     ()
     2092     ())                                                               
     2093  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
     2094  (jmp (:@ x8664::symbol.fcell (:% x8664::fname)))
     2095
     2096  )
    20832097
    20842098;;; It'd be good to have a variant that deals with a known function
    20852099;;; as well as this.
    2086 (define-x8664-vinsn (pass-multiple-values :jumplr) (()
     2100(define-x8664-vinsn (xpass-multiple-values :call :extended-call :jumplr) (()
     2101                                                    ((lab :label))
     2102                                                    ((tag :u8)))
     2103  :resume
     2104  (movl (:%l x8664::temp0) (:%l tag))
     2105  (andl (:$b x8664::fulltagmask) (:%l tag))
     2106  (cmpl (:$b x8664::fulltag-symbol) (:%l tag))
     2107  (cmovgq (:%q x8664::temp0) (:%q x8664::fn))
     2108  (jl :bad)
     2109  (cmoveq (:@ x8664::symbol.fcell (:%q x8664::fname)) (:%q x8664::fn))
     2110  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
     2111  (jmp (:%q x8664::fn))
     2112
     2113  (:anchored-uuo-section :resume)
     2114  :bad
     2115  (:anchored-uuo (uuo-error-not-callable)))
     2116
     2117(define-x8664-vinsn (pass-multiple-values :call :extended-call :jumplr) (()
    20872118                                                    ()
    20882119                                                    ((tag :u8)))
     
    21012132  (:anchored-uuo (uuo-error-not-callable)))
    21022133
    2103 (define-x8664-vinsn (pass-multiple-values-known-function :jumplr) (((fnreg :lisp))
    2104                                                                     ())
     2134(define-x8664-vinsn (xpass-multiple-values-known-function :call :extended-call :jumplr)
     2135    (() ((lab :label) (fnreg :lisp)))
    21052136  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
    21062137  (jmp (:%q fnreg)))
    21072138
     2139(define-x8664-vinsn (pass-multiple-values-known-function :call :extended-call :jumplr)
     2140    (() ((fnreg :lisp)))
     2141  (pushq (:@ (:apply + (:apply target-nil-value) (x8664::%kernel-global 'x86::ret1valaddr))))
     2142  (jmp (:%q fnreg)))
    21082143
    21092144(define-x8664-vinsn reserve-outgoing-frame (()
     
    43164351(define-x8664-subprim-lea-jmp-vinsn (bind)  .SPbind)
    43174352
     4353
     4354(define-x8664-vinsn bind-inline (()
     4355                                 ((sym :lisp)
     4356                                  (val :lisp))
     4357                                 ((idx :lisp)
     4358                                  (tlb-pointer :lisp)))
     4359  (movq (:@ x8664::symbol.binding-index (:%q sym)) (:%q idx))
     4360  (cmpq (:rcontext x8664::tcr.tlb-limit) (:%q idx))
     4361  (jb :tlb-ok)
     4362  (pushq (:%q idx))
     4363  (ud2a)
     4364  (:byte 1)
     4365  :tlb-ok
     4366  (movq (:rcontext target::tcr.tlb-pointer) (:%q tlb-pointer))
     4367  (pushq (:@ (:%q tlb-pointer) (:%q idx)))
     4368  (pushq (:%q idx))
     4369  (pushq (:rcontext target::tcr.db-link))
     4370  (movq (:%q target::rsp)(:rcontext target::tcr.db-link))
     4371  (movq (:%q val) (:@ (:%q tlb-pointer) (:%q idx))))
     4372
     4373
     4374(define-x8664-vinsn unbind-inline (()
     4375                                   ()
     4376                                   ((link :lisp)
     4377                                    (tlb-pointer :lisp)
     4378                                    (idx :lisp)
     4379                                    (val :lisp)))
     4380 
     4381  (movq (:rcontext target::tcr.db-link) (:%q link))
     4382  (movq (:rcontext target::tcr.tlb-pointer) (:%q tlb-pointer))
     4383  (movq (:@  8 (:%q link)) (:%q idx))
     4384  (movq (:@ 16 (:%q link)) (:%q val))
     4385  (movq (:@ link) (:%q link))
     4386  (movq (:% val) (:@ (:%q tlb-pointer) (:% idx)))
     4387  (movq (:%q link) (:rcontext target::tcr.db-link)))
     4388       
    43184389 
    43194390
  • branches/lscan/source/compiler/X86/x862.lisp

    r16444 r16448  
    1 ;[;;-*-Mode: LISP; Package: CCL -*-
     1;;-*-Mode: LISP; Package: CCL -*-
    22;;;
    33;;;   Copyright (C) 2005-2009 Clozure Associates
     
    12361236
    12371237(defun x862-initopt (seg vloc spvloc vars inits spvars)
    1238   ;(when *backend-use-linear-scan* "we may need to move this to the body")
     1238  ;;(when *backend-use-linear-scan* "we may need to move this to the body")
    12391239  (with-x86-local-vinsn-macros (seg)
    12401240    (dolist (var vars vloc)
     
    12641264                  (@ skipinitlabel)))))
    12651265        (x862-bind-var seg var vloc)
    1266         (when spvar
    1267           (x862-bind-var seg spvar spvloc))
     1266        (when spvar (x862-bind-var seg spvar   spvloc)))
    12681267      (setq vloc (%i+ vloc *x862-target-node-size*))
    1269       (if spvloc (setq spvloc (%i+ spvloc *x862-target-node-size*)))))))
     1268      (if spvloc (setq spvloc (%i+ spvloc *x862-target-node-size*))))))
    12701269
    12711270(defun x862-init-keys (seg vloc  allow-others keyvars keysupp keyinits keykeys)
     
    12751274      (let* ((spvar (pop keysupp))
    12761275             (initform (pop keyinits))
    1277              (reg (nx2-assign-register-var var))
    1278              (regloadedlabel (if reg (backend-get-next-label)))
    12791276             (sploc (%i+ vloc *x862-target-node-size*)))
    12801277        (unless (nx-null initform)
    12811278          (let ((skipinitlabel (backend-get-next-label)))
    12821279            (with-crf-target () crf
    1283               (x862-compare-ea-to-nil seg crf (x862-make-compound-cd 0 skipinitlabel) (x862-vloc-ea sploc)  x86::x86-e-bits t))
    1284             (if reg
    1285               (x862-form seg reg regloadedlabel initform)
    1286               (x862-register-to-stack seg (x862-one-untargeted-reg-form seg initform ($ *x862-arg-z*)) (x862-vloc-ea vloc)))
     1280                             (x862-compare-ea-to-nil seg crf (x862-make-compound-cd 0 skipinitlabel) (x862-vloc-ea sploc)  x86::x86-e-bits t))
     1281            (x862-register-to-stack seg (x862-one-untargeted-reg-form seg initform ($ *x862-arg-z*)) (x862-vloc-ea vloc))
    12871282            (@ skipinitlabel)))
    1288         (if reg
    1289           (progn
    1290             (x862-init-regvar seg var reg (x862-vloc-ea vloc))
    1291             (@ regloadedlabel))
    1292           (x862-bind-var seg var vloc))
    1293         (when spvar
    1294           (if (setq reg (nx2-assign-register-var spvar))
    1295             (x862-init-regvar seg spvar reg (x862-vloc-ea sploc))
    1296             (x862-bind-var seg spvar sploc))))
     1283        (x862-bind-var seg var vloc)
     1284        (when spvar (x862-bind-var seg spvar  sploc)))
    12971285      (setq vloc (%i+ vloc (* 2 *x862-target-node-size*))))))
    12981286
     
    13571345                       (logior lreg-flag-spill lreg-flag-pre-spill)))
    13581346                ((= nargs 3)
    1359                  (! copy-gpr! reg ($ x8664::arg_x)))
     1347                 (! copy-gpr reg ($ x8664::arg_x)))
    13601348
    13611349                ((= nargs 2)
    1362                  (! copy-gpr! reg  ($ x8664::arg_y)))
     1350                 (! copy-gpr reg  ($ x8664::arg_y)))
    13631351
    13641352                ((= nargs 1)
    1365                  (! copy-gpr! reg ($ x8664::arg_z))))
     1353                 (! copy-gpr reg ($ x8664::arg_z))))
    13661354            (setf (var-lreg var) reg)))
    13671355      ())))
     
    34023390                        (x862-copy-register seg call-reg  a-reg)
    34033391                        (x862-store-immediate seg func call-reg)))
    3404                     (if label-p
    3405                       (! pass-multiple-values-known-function call-reg)
    3406                       (if symp
    3407                         (! pass-multiple-values-symbol)
    3408                         (! pass-multiple-values)))
     3392                    (let* ((cont (aref *backend-labels* mvpass-label)))
     3393                      (if label-p
     3394                        (! xpass-multiple-values-known-function cont call-reg)
     3395                        (if symp
     3396                          (! xpass-multiple-values-symbol cont)
     3397                          (! xpass-multiple-values cont))))
    34093398                    (when mvpass-label
    34103399                      (@= mvpass-label)))
     
    37493738  (with-x86-local-vinsn-macros (seg)
    37503739    (when mv-label
     3740      (if *backend-use-linear-scan*
     3741
     3742        (warn "multiple-values"))
    37513743      (x862-vpush-label seg (aref *backend-labels* mv-label)))
    37523744    (when (and (car args) (not suppress-frame-reservation))
     
    41144106      (multiple-value-bind (atemp btemp ctemp)
    41154107          (x862-three-untargeted-reg-forms seg aform areg bform breg cform creg)
    4116         (! copy-gpr! areg areg)
    4117         (! copy-gpr! breg breg)
    4118         (! copy-gpr! creg ctemp)
    4119         (! copy-gpr! areg atemp)
    4120         (! copy-gpr! breg btemp))
     4108        (! copy-gpr areg areg)
     4109        (! copy-gpr breg breg)
     4110        (! copy-gpr creg ctemp)
     4111        (! copy-gpr areg atemp)
     4112        (! copy-gpr breg btemp))
    41214113      (values areg breg creg)    ) 
    41224114
     
    56775669                     ;
    56785670                     (logbitp $vbitdynamicextent bits))
    5679                (linear-scan-bailout)
     5671               (linear-scan-bailout "dynamic-extent")
    56805672               (cond ((logbitp $vbitspecial bits)
    56815673                      (x862-dbind seg val sym))
     
    57975789(defun x862-set-var-ea (seg var ea)
    57985790  (setf (var-ea var) ea)
    5799   (when (and *x862-record-symbols* (or (typep ea 'lreg) (typep ea 'fixnum)))
     5791  (when (and *x862-record-symbols* (not *backend-use-linear-scan*) (or (typep ea 'lreg) (typep ea 'fixnum)))
    58005792    (let* ((start (enqueue-vinsn-note seg :begin-variable-scope var)))
    58015793      (push (list var (var-name var) start nil)
     
    58065798  (let ((bits (nx-var-bits var)))
    58075799    (when (and *x862-record-symbols*
     5800               (not *backend-use-linear-scan*)
    58085801               (var-ea var)
    58095802               (or (logbitp $vbitspecial bits)
     
    58195812(defun x862-dbind (seg value sym)
    58205813  (with-x86-local-vinsn-macros (seg)
     5814    (cond ((and nil *backend-use-linear-scan*)
     5815     
     5816           (let*  ((rval (x862-one-untargeted-reg-form seg value (?)))
     5817                   (rsym (?)))
     5818             (x862-store-immediate seg (x862-symbol-value-cell sym) rsym)
     5819             (! bind-inline rsym rval)
     5820             (x862-open-undo $undospecial)))
     5821          (t
     5822
     5823
     5824   
    58215825    (let* ((ea-p (x862-load-ea-p value))
    58225826           (nil-p (unless ea-p (nx-null (setq value (nx-untyped-form value)))))
     
    58575861                 (! bind)))
    58585862             (x862-open-undo $undospecial)))
    5859       (x862-adjust-vstack (* 3 *x862-target-node-size*)))))
     5863      (x862-adjust-vstack (* 3 *x862-target-node-size*)))))))
    58605864
    58615865;;; Store the contents of EA - which denotes either a vframe location
     
    67276731   (dolist (x (%caddr opts))
    67286732     (when x (return t)))))
     6733
     6734
    67296735
    67306736(defun x862-close-lambda (seg req opt rest keys auxen)
     
    73957401  (with-x86-local-vinsn-macros (seg vreg xfer)
    73967402    (let* ((stack-consed-rest nil)
     7403           (handled-lambda nil)
    73977404           (next-method-var-scope-info nil)
    73987405           (lexprp (if (consp rest) (progn (setq rest (car rest)) t)))
     
    74647471            ;;(setq arg-regs (x862-req-nargs-entry seg rev-fixed))
    74657472            (if *backend-use-linear-scan*
    7466               (x862-simple-args-entry seg rev-fixed num-fixed num-fixed)
     7473              (progn
     7474                (setq handled-lambda t)
     7475                (x862-simple-args-entry seg rev-fixed num-fixed num-fixed))
    74677476              (setq arg-regs (x862-req-nargs-entry seg rev-fixed)))
    74687477            (if (and (not (or hardopt rest keys))
    7469                      (<= num-opt *x862-target-num-arg-regs*))
     7478                     (<= (+ num-fixed num-opt) *x862-target-num-arg-regs*))
    74707479              (if *backend-use-linear-scan*
    7471                 (x862-simple-args-entry seg (append rev-opt rev-fixed) num-fixed max-args)
     7480                (progn
     7481                  (setq handled-lambda t)
     7482                  (x862-simple-args-entry seg (append rev-opt rev-fixed) num-fixed max-args))
    74727483                (setq arg-regs (x862-simple-opt-entry seg rev-opt rev-fixed)))
    74737484              (progn
     7485                (when *backend-use-linear-scan*
     7486                  (warn "lambda-list too complex for now? handled = ~s" handled-lambda))
    74747487                ;; From now on, the runtime assumes that all
    74757488                ;; incoming arguments are on the stack, either because
     
    74927505                ;; If there were &optional args, initialize their values
    74937506                ;; to NIL.  All of the argregs get vpushed as a result of this.
    7494                 (when opt
     7507                (when (and opt (not handled-lambda))
    74957508                  (if max-args
    74967509                    (! push-max-argregs max-args)
     
    81138126              (!  lri target 0)))
    81148127          (multiple-value-bind (count src) (x862-two-untargeted-reg-forms seg form1 *x862-arg-y* form2 *x862-arg-z* *x862-variable-shift-count-mask*)
     8128            (if *backend-use-linear-scan*
     8129              (! %ilsl target count src)
    81158130            (if (= (ash 1 (hard-regspec-value target))
    81168131                   *x862-variable-shift-count-mask*)
     
    81188133                (! %ilsl src count src)
    81198134                (! copy-gpr target src))
    8120               (! %ilsl target count src)))))
     8135              (! %ilsl target count src))))))
    81218136      (^))))
    81228137
     
    1063010645    (when apply-body (setq rest nil body apply-body))
    1063110646    (let*
    10632       ((vloc *x862-vstack*)
    10633        (restloc vloc)
    10634        (nvloc (progn (if (or rest keys-p) (x862-formlist seg rest-arg)) *x862-vstack*)))
     10647        ((vloc *x862-vstack*)
     10648         (restloc vloc)
     10649         (nvloc (progn (if (or rest keys-p) (x862-formlist seg rest-arg)) *x862-vstack*)))
    1063510650      (with-x86-p2-declarations p2decls
    1063610651        (when rest
  • branches/lscan/source/compiler/nx0.lisp

    r16444 r16448  
    17571757            (push (nx1-typed-var-initform pending sym initform) optinits)
    17581758            (push (nx-new-var pending sym t) optvars)
    1759             (push (let* ((var (nx-new-var pending (or spvar (make-symbol (concatenate 'string (symbol-name sym) "-P")))  t)))
    1760                         (unless spvar (nx-set-var-bits var (%ilogior (%ilsl $vbitignoreunused 1))))
    1761                         var)
    1762                               optsuppliedp)))
     1759            (push (if spvar (nx-new-var pending spvar t)) optsuppliedp)))
    17631760        (if optvars
    17641761          (setq opt (list (nreverse optvars) (nreverse optinits) (nreverse optsuppliedp)))
     
    17951792            (push kkey keykeys)
    17961793            (push kinit keyinits)
    1797             (push (let* ((var (nx-new-var pending (or ksupp (make-symbol (concatenate 'string (symbol-name kvar) "-P")))  t)))
    1798                         (unless ksupp (nx-set-var-bits var (%ilogior (%ilsl $vbitignoreunused 1))))
    1799                         var) keysupp)))
     1794            (push (if ksupp (nx-new-var pending ksupp t)) keysupp)))
    18001795        (setq
    18011796         keys
     
    23162311      (setq result-type (type-specifier (single-value-type (function-ctype-returns ctype)))))
    23172312    (values arglist (nx-target-type result-type) errors-p)))
     2313
    23182314
    23192315
  • branches/lscan/source/compiler/optimizers.lisp

    r16303 r16448  
    506506
    507507
    508 
     508#+no-more
    509509(define-compiler-macro cons (&whole call &environment env x y &aux dcall ddcall)
    510510  (if (nx-open-code-in-line env)
  • branches/lscan/source/compiler/reg.lisp

    r16085 r16448  
    173173    (the fixnum (ldb *encoded-reg-value-byte* (the fixnum regspec)))
    174174    (if (typep regspec 'lreg)
    175       (lreg-value regspec)
     175      (or (lreg-value regspec) )
    176176      (error "bad regspec: ~s" regspec))))
    177177
  • branches/lscan/source/compiler/vinsn.lisp

    r16444 r16448  
    279279    :subprim                            ; first argument is a subprim address
    280280    :jumpLR                             ; Jumps to the LR, possibly stopping off at a function along the way.
    281     :lrsave                             ; saves LR in LOC-PC
     281    :extended-call                      ; extend call interval
    282282    :lrrestore                          ; restores LR from LOC-PC
    283283    :lispcontext                        ; references lisp frame LOC-PC, FN, and entry VSP
     
    10161016          (aref masks interval-regtype-cr) crfs)))
    10171017
     1018(defun find-end-of-extended-call (seg call-vinsn)
     1019  (declare (ignorable seg))
     1020  ;; cheat
     1021  (let* ((label (svref (vinsn-variable-parts call-vinsn) 0)))
     1022    (vinsn-label-succ label)))
     1023 
     1024
    10181025(defun build-interval-list (seg)
    10191026  (let* ((list (vinsn-list-intervals seg))
     
    10311038          (unless (eq start-vinsn (callnode-mycall block))
    10321039            (break "bad callnode ~s" block))
     1040          (when (vinsn-attribute-p start-vinsn :extended-call)
     1041            (setq high (vinsn-sequence (find-end-of-extended-call seg start-vinsn))))
    10331042          (registers-killed-by-call start-vinsn killed)
    10341043          (let* ((interval (make-interval nil low high nil nil)))
     
    11881197
    11891198
    1190 (defun spill-and-split-interval (seg parent new-end vector list)
    1191 
     1199(defun spill-and-split-interval (seg why parent new-end vector list)
     1200  (declare (ignorable why))
    11921201
    11931202  (let* ((lreg (interval-lreg parent)))
     
    12241233                 (spill-vinsn (select-vinsn (spill-vinsn-for-interval parent) templates (list lreg offset))))
    12251234            ;;(push spill-vinsn (lreg-refs lreg))
     1235            (format t "~&spill ~s before ~a" spill-vinsn spill-point)
    12261236            (insert-vinsn-before spill-vinsn spill-point)
    12271237            (let* ((min (vinsn-list-max-seq seg))
     
    12381248                    (unless parent-is-child
    12391249                      (let* ((reload-vinsn (select-vinsn (reload-vinsn-for-interval parent) templates (list lreg offset))))
    1240 
     1250                        (format t "~&reload ~s before ~a" reload-vinsn ref)
    12411251                        (insert-vinsn-before reload-vinsn ref)
    12421252                        (push reload-vinsn reloads)
     
    13541364 
    13551365
    1356 
    1357 
     1366(defun find-spill-candidate (intervals at)
     1367  (declare (ignorable at))
     1368  (let*  ((max at) (best nil))
     1369    (declare (ignorable max best))
     1370  (do-dll-nodes (x intervals (or best (error "no interval to spill")))
     1371    (let* ((lreg (interval-lreg x)))
     1372      (unless (or (lreg-wired lreg) (lreg-local-p lreg))
     1373       (return x)
     1374       
     1375       '(let* ((all (append (lreg-refs lreg) (lreg-refs lreg))))
     1376          (dolist (use all)
     1377            (let* ((seq (vinsn-sequence use)))
     1378              (when (>= seq at)
     1379                (when (> seq max)
     1380                  (setq max seq best x)))))))))))
    13581381
    13591382(defun linear-scan (seg )
     
    14021425              (let* ((caller-save ())
    14031426                     (call-vinsn (find-vinsn seg begin))
     1427                     (end-vinsn (if (vinsn-attribute-p call-vinsn :extended-call) (find-vinsn seg (interval-end i)) call-vinsn))
    14041428                     (templates (backend-p2-vinsn-templates *target-backend*)))
    14051429                (do-dll-nodes (a active)
     
    14071431                    ;; should see if preg is in the killed set
    14081432                    (push a caller-save)))
     1433                (warn "caller-save = ~s, call = ~s" caller-save call-vinsn)
    14091434                (dolist (cs caller-save)
    14101435                  (let* ((offset (spill-offset-for-interval seg cs))
     
    14121437                         (spill-vinsn (select-vinsn (spill-vinsn-for-interval cs) templates (list cs-lreg offset)))
    14131438                         (reload-vinsn (select-vinsn (reload-vinsn-for-interval cs) templates (list cs-lreg offset))))
     1439                    (when (lreg-wired cs-lreg) )
    14141440                    (insert-vinsn-before spill-vinsn call-vinsn)
    1415                     (insert-vinsn-after reload-vinsn call-vinsn)))
     1441                    (insert-vinsn-after reload-vinsn end-vinsn)))
    14161442                 
    14171443                         
     
    14271453                               (interval-lreg victim)
    14281454                               (> (interval-end victim) begin))
    1429                       (return (progn (spill-and-split-interval   seg victim begin intervals unhandled) (expire-interval seg victim expired) (setq mask (svref avail regtype)) (when (eql mask 0) (break "mask is still 0 after spilling ~s" victim)))))))
     1455                      (return (progn (spill-and-split-interval   seg 'pressure victim begin intervals unhandled) (expire-interval seg victim expired) (setq mask (svref avail regtype)) (when (eql mask 0) (break "mask is still 0 after spilling ~s" victim)))))))
    14301456                                 
    14311457
     
    14491475                                     
    14501476                                        (return x)))))
    1451                         (spill-and-split-interval seg other begin intervals unhandled)))
     1477                        (spill-and-split-interval seg 'conflict other begin intervals unhandled)))
    14521478
    14531479                    (when (and targeted (not (eql targeted preg)))
     
    14931519                                           (when (find rival-lreg begin-vp)
    14941520                                             (break "surprise! ~s" begin-vinsn)))
    1495                                                                                
    1496                                          (spill-and-split-interval seg rival begin intervals unhandled))
     1521
     1522                                         (spill-and-split-interval seg 'conflict2 rival begin intervals unhandled))
    14971523                                       (let*  ((other-preg (select-available-register-high rival-avail)))
    14981524                                         ;;(ls-format t "should have used ~d" other-preg)
     
    15201546
    15211547(defun linear-scan-bailout (&optional (reason "generic failure"))
    1522   (format *error-output* "~%~%bailing-out of linear-scan:~&~&~a" reason)
    1523   (signal 'linear-scan-bailout))
     1548  (when *backend-use-linear-scan*
     1549    (format *error-output* "~%~%bailing-out of linear-scan:~&~&~a" reason)
     1550    (signal 'linear-scan-bailout)))
    15241551
    15251552(defun optimize-vinsns (header)
     
    15661593             (build-interval-list header)
    15671594             (when *linear-scan-verbose*
     1595               (ls-format t "~&**********************************************~s" (afunc-name *x862-cur-afunc*))
    15681596               (dolist (n fg )
    15691597                 (terpri)
    15701598                 (show-fgn n (vinsn-list-lregs header))))
    15711599             (unless (linear-scan header )
    1572                (linear-scan-bailout))
     1600               (linear-scan-bailout "register allocation failed"))
    15731601
    15741602             (when *linear-scan-verbose*
     
    16041632
    16051633(defun show-fgn (node regs)
     1634  (declare (ignorable regs))
    16061635 (format t "~&~s (~d) {~a}" (type-of node) (fgn-id node) (mapcar #'fgn-id (fgn-inedges node)))
    16071636 (show-vinsns node 2)
    1608  (show-live-set "live-kill" (fgn-live-kill node) regs)
    1609  (show-live-set "live-gen " (fgn-live-gen node) regs)
    1610  (show-live-set "live-in " (fgn-live-in node) regs)
    1611  (show-live-set "live-out " (fgn-live-out node) regs)
     1637; (show-live-set "live-kill" (fgn-live-kill node) regs)
     1638; (show-live-set "live-gen " (fgn-live-gen node) regs)
     1639; (show-live-set "live-in " (fgn-live-in node) regs)
     1640; (show-live-set "live-out " (fgn-live-out node) regs)
    16121641 (terpri)
    16131642 (terpri))
Note: See TracChangeset for help on using the changeset viewer.