Changeset 5359

Timestamp:

Oct 17, 2006, 12:45:25 PM (18 years ago)

Author:

Gary Byers

Message:

bind/unbind *interrupt-level* inline.

Location:

trunk/ccl/compiler/X86

Files:

• X8664/x8664-vinsns.lisp (modified) (1 diff)
• x862.lisp (modified) (2 diffs)

trunk/ccl/compiler/X86/X8664/x8664-vinsns.lisp

@@ -1654 +1654 @@
 (define-x8664-subprim-call-vinsn (bind-interrupt-level-0) .SPbind-interrupt-level-0)
 
+(define-x8664-vinsn bind-interrupt-level-0-inline (()
+                                                   ()
+                                                   ((temp :imm)))
+  (movq (:@ (:%seg :rcontext) x8664::tcr.tlb-pointer) (:%q temp))
+  (cmpq (:$b 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
+  (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
+  (pushq (:$b x8664::interrupt-level-binding-index))
+  (pushq (:@ (:%seg :rcontext) x8664::tcr.db-link))
+  (movq (:$l 0) (:@ x8664::interrupt-level-binding-index (:%q temp)))
+  (movq (:%q x8664::rsp) (:@ (:%seg :rcontext) x8664::tcr.db-link))
+  (jns.pt :done)
+  (btrq (:$ub 63) (:@ (:%seg :rcontext) x8664::tcr.interrupt-pending))
+  (jae.pt :done)
+  (ud2a)
+  (:byte 2)
+  :done)
+  
+  
+
 (define-x8664-subprim-call-vinsn (bind-interrupt-level-m1) .SPbind-interrupt-level-m1)
 
+(define-x8664-vinsn bind-interrupt-level-m1-inline (()
+                                                   ()
+                                                   ((temp :imm)))
+  (movq (:@ (:%seg :rcontext) x8664::tcr.tlb-pointer) (:%q temp))
+  (pushq (:@ x8664::interrupt-level-binding-index (:%q temp)))
+  (pushq (:$b x8664::interrupt-level-binding-index))
+  (pushq (:@ (:%seg :rcontext) x8664::tcr.db-link))
+  (movq (:$l (ash -1 x8664::fixnumshift)) (:@ x8664::interrupt-level-binding-index (:%q temp)))
+  (movq (:%q x8664::rsp) (:@ (:%seg :rcontext) x8664::tcr.db-link)))
+
 (define-x8664-subprim-call-vinsn (bind-interrupt-level) .SPbind-interrupt-level)
 
 (define-x8664-subprim-call-vinsn (unbind-interrupt-level) .SPunbind-interrupt-level)
+
+(define-x8664-vinsn unbind-interrupt-level-inline (()
+                                                   ()
+                                                   ((link :imm)
+                                                    (curval :imm)
+                                                    (oldval :imm)
+                                                    (tlb :imm)))
+  (movq (:@ (:%seg :rcontext) x8664::tcr.tlb-pointer) (:%q tlb))
+  (movq (:@ (:%seg :rcontext) x8664::tcr.db-link) (:%q link))
+  (movq (:@ x8664::interrupt-level-binding-index (:%q tlb)) (:%q curval))
+  (testq (:%q curval) (:%q curval))
+  (movq (:@ 8 #|binding.val|# (:%q link)) (:%q oldval))
+  (movq (:@ #|binding.link|# (:%q link)) (:%q link))
+  (movq (:%q oldval) (:@ x8664::interrupt-level-binding-index (:%q tlb)))
+  (movq (:%q link) (:@ (:%seg :rcontext) x8664::tcr.db-link))
+  (jns.pt :done)
+  (testq (:%q oldval) (:%q oldval))
+  (js.pt :done)
+  (btrq (:$ub 63) (:@ (:%seg :rcontext) x8664::tcr.interrupt-pending))
+  (jae.pt :done)
+  (ud2a)
+  (:byte 2)
+  :done)  
 
 (define-x8664-vinsn (jump-return-pc :jumpLR)

trunk/ccl/compiler/X86/x862.lisp

@@ -3764 +3764 @@
       (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 *x862-open-code-inline*
+                        (! bind-interrupt-level-0-inline)
+                        (! bind-interrupt-level-0)))
+                     ((eql fixval -1)
+                      (if *x862-open-code-inline*
+                        (! bind-interrupt-level-m1-inline)
+                        (! bind-interrupt-level-m1)))
                      (t
                       (if ea-p 
@@ -4803 +4809 @@
                 (! dpayback n)
                 (setq n 0))
-              (! unbind-interrupt-level))
+              (if *x862-open-code-inline*
+                (! unbind-interrupt-level-inline)
+                (! unbind-interrupt-level)))
             (nx-error "unknown payback token ~s" r)))))))