Index: /trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp =================================================================== --- /trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp (revision 5355) +++ /trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp (revision 5356) @@ -3798,10 +3798,80 @@ (define-ppc32-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0) +(define-ppc32-vinsn bind-interrupt-level-0-inline (() + () + ((tlb :imm) + (value :imm) + (link :imm) + (temp :imm))) + (lwz tlb ppc32::tcr.tlb-pointer ppc32::rcontext) + (lwz value ppc32::interrupt-level-binding-index tlb) + (lwz link ppc32::tcr.db-link ppc32::rcontext) + (cmpwi value 0) + (li temp ppc32::interrupt-level-binding-index) + (stwu value -4 ppc::vsp) + (stwu temp -4 ppc::vsp) + (stwu link -4 ppc::vsp) + (stw ppc::rzero ppc32::interrupt-level-binding-index tlb) + (stw ppc::vsp ppc32::tcr.db-link ppc32::rcontext) + (beq+ :done) + (mr ppc::nargs value) + (bgt :do-trap) + (lwz ppc::nargs ppc32::tcr.interrupt-pending ppc32::rcontext) + :do-trap + (twgti ppc::nargs 0) + :done) + + + (define-ppc32-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1) +(define-ppc32-vinsn bind-interrupt-level-m1-inline (() + () + ((tlb :imm) + (oldvalue :imm) + (link :imm) + (newvalue :imm) + (idx :imm))) + (li newvalue (ash -1 ppc32::fixnumshift)) + (li idx ppc32::interrupt-level-binding-index) + (lwz tlb ppc32::tcr.tlb-pointer ppc32::rcontext) + (lwz oldvalue ppc32::interrupt-level-binding-index tlb) + (lwz link ppc32::tcr.db-link ppc32::rcontext) + (stwu oldvalue -4 ppc::vsp) + (stwu idx -4 ppc::vsp) + (stwu link -4 ppc::vsp) + (stw newvalue ppc32::interrupt-level-binding-index tlb) + (stw ppc::vsp ppc32::tcr.db-link ppc32::rcontext) + :done) + (define-ppc32-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level) (define-ppc32-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level) +(define-ppc32-vinsn unbind-interrupt-level-inline (() + () + ((tlb :imm) + (link :imm) + (value :imm) + (save-nargs :u32) + (crf0 :crf) + (crf1 :crf))) + (lwz tlb ppc32::tcr.tlb-pointer ppc32::rcontext) + (lwz value ppc32::interrupt-level-binding-index tlb) + (lwz link ppc32::tcr.db-link ppc32::rcontext) + (cmpwi crf1 value 0) + (lwz value 8 link) + (lwz link 0 link) + (cmpwi crf0 value 0) + (stw value ppc32::interrupt-level-binding-index tlb) + (stw link ppc32::tcr.db-link ppc32::rcontext) + (bge crf1 :done) + (blt crf0 :done) + (mr save-nargs ppc::nargs) + (lwz ppc::nargs ppc32::tcr.interrupt-pending ppc32::rcontext) + (twgti ppc::nargs 0) + (mr ppc::nargs save-nargs) + :done) + Index: /trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp =================================================================== --- /trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp (revision 5355) +++ /trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp (revision 5356) @@ -3778,9 +3778,77 @@ (define-ppc64-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0) +(define-ppc64-vinsn bind-interrupt-level-0-inline (() + () + ((tlb :imm) + (value :imm) + (link :imm) + (temp :imm))) + (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext) + (ld value ppc64::interrupt-level-binding-index tlb) + (ld link ppc64::tcr.db-link ppc64::rcontext) + (cmpdi value 0) + (li temp ppc64::interrupt-level-binding-index) + (stdu value -8 ppc::vsp) + (stdu temp -8 ppc::vsp) + (stdu link -8 ppc::vsp) + (std ppc::rzero ppc64::interrupt-level-binding-index tlb) + (std ppc::vsp ppc64::tcr.db-link ppc64::rcontext) + (beq+ :done) + (mr ppc::nargs value) + (bgt :do-trap) + (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext) + :do-trap + (tdgti ppc::nargs 0) + :done) + (define-ppc64-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1) +(define-ppc64-vinsn bind-interrupt-level-m1-inline (() + () + ((tlb :imm) + (oldvalue :imm) + (link :imm) + (newvalue :imm) + (idx :imm))) + (li newvalue (ash -1 ppc64::fixnumshift)) + (li idx ppc64::interrupt-level-binding-index) + (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext) + (ld oldvalue ppc64::interrupt-level-binding-index tlb) + (ld link ppc64::tcr.db-link ppc64::rcontext) + (stdu oldvalue -8 ppc::vsp) + (stdu idx -8 ppc::vsp) + (stdu link -8 ppc::vsp) + (std newvalue ppc64::interrupt-level-binding-index tlb) + (std ppc::vsp ppc64::tcr.db-link ppc64::rcontext) + :done) + (define-ppc64-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level) (define-ppc64-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level) + +(define-ppc64-vinsn unbind-interrupt-level-inline (() + () + ((tlb :imm) + (link :imm) + (value :imm) + (save-nargs :u32) + (crf0 :crf) + (crf1 :crf))) + (ld tlb ppc64::tcr.tlb-pointer ppc64::rcontext) + (ld value ppc64::interrupt-level-binding-index tlb) + (ld link ppc64::tcr.db-link ppc64::rcontext) + (cmpdi crf1 value 0) + (ld value 16 link) + (ld link 0 link) + (cmpdi crf0 value 0) + (std value ppc64::interrupt-level-binding-index tlb) + (std link ppc64::tcr.db-link ppc64::rcontext) + (bge crf1 :done) + (blt crf0 :done) + (mr save-nargs ppc::nargs) + (ld ppc::nargs ppc64::tcr.interrupt-pending ppc64::rcontext) + (tdgti ppc::nargs 0) + (mr ppc::nargs save-nargs) + :done) (define-ppc64-vinsn fixnum->fpr (((f :double-float)) Index: /trunk/ccl/compiler/PPC/ppc2.lisp =================================================================== --- /trunk/ccl/compiler/PPC/ppc2.lisp (revision 5355) +++ /trunk/ccl/compiler/PPC/ppc2.lisp (revision 5356) @@ -3679,6 +3679,10 @@ (cond ((eq sym '*interrupt-level*) (let* ((fixval (acode-fixnum-form-p value))) - (cond ((eql fixval 0) (! bind-interrupt-level-0)) - ((eql fixval -1) (! bind-interrupt-level-m1)) + (cond ((eql fixval 0) (if *ppc2-open-code-inline* + (! bind-interrupt-level-0-inline) + (! bind-interrupt-level-0))) + ((eql fixval -1) (if *ppc2-open-code-inline* + (! bind-interrupt-level-m1-inline) + (! bind-interrupt-level-m1))) (t (if ea-p @@ -4906,5 +4910,7 @@ (! dpayback n) (setq n 0)) - (! unbind-interrupt-level)) + (if *ppc2-open-code-inline* + (! unbind-interrupt-level-inline) + (! unbind-interrupt-level))) (nx-error "unknown payback token ~s" r)))))))