Changeset 5356

Timestamp:

Oct 17, 2006, 12:39:09 PM (18 years ago)

Author:

Gary Byers

Message:

bind/unbind *interrupt-level* inline.

Location:

trunk/ccl/compiler/PPC

Files:

• PPC32/ppc32-vinsns.lisp (modified) (1 diff)
• PPC64/ppc64-vinsns.lisp (modified) (1 diff)
• ppc2.lisp (modified) (2 diffs)

trunk/ccl/compiler/PPC/PPC32/ppc32-vinsns.lisp

@@ -3798 +3798 @@
 (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)
+  
 
 

trunk/ccl/compiler/PPC/PPC64/ppc64-vinsns.lisp

@@ -3778 +3778 @@
 (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))

trunk/ccl/compiler/PPC/ppc2.lisp

@@ -3679 +3679 @@
       (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 +4910 @@
                 (! 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)))))))