From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Fri, 19 Jul 1996 02:28:32 +0000 (+0000)
Subject: SET-INTERRUPT-ENABLES! is now open-coded as a special primitive unless
X-Git-Tag: 20090517-FFI~5478
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=cbbb6fdd0b5c34199335b345d1a8986bd80bc17a;p=mit-scheme.git

SET-INTERRUPT-ENABLES! is now open-coded as a special primitive unless
'SET-INTERRUPT-ENABLES! is in compiler:primitives-with-no-open-coding.
---

diff --git a/v8/src/compiler/machines/spectrum/lapgen.scm b/v8/src/compiler/machines/spectrum/lapgen.scm
index c7e7654b8..8972c38a9 100644
--- a/v8/src/compiler/machines/spectrum/lapgen.scm
+++ b/v8/src/compiler/machines/spectrum/lapgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 1.5 1995/08/06 19:24:46 adams Exp $
+$Id: lapgen.scm,v 1.6 1996/07/19 02:28:32 adams Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -833,7 +833,8 @@ MIT in each case. |#
     remainder
     interpreter-call
     profile-count
-    profile-count/2))
+    profile-count/2
+    set-interrupt-enables!))
 
 ;; There is a NOP here because otherwise the return address would have 
 ;; to be adjusted by the hook code.  This gives more flexibility to the
diff --git a/v8/src/compiler/machines/spectrum/machin.scm b/v8/src/compiler/machines/spectrum/machin.scm
index 7888edbd9..ec8b675eb 100644
--- a/v8/src/compiler/machines/spectrum/machin.scm
+++ b/v8/src/compiler/machines/spectrum/machin.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: machin.scm,v 1.2 1995/02/28 01:11:46 adams Exp $
+$Id: machin.scm,v 1.3 1996/07/19 02:28:11 adams Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -552,7 +552,9 @@ MIT in each case. |#
   '(DIVIDE-FIXNUM GCD-FIXNUM &/ FLONUM-ROUND->EXACT
 		  FLONUM-TRUNCATE->EXACT FLONUM-FLOOR->EXACT
 		  FLONUM-CEILING->EXACT FLONUM-NORMALIZE
-		  FLONUM-DENORMALIZE FLONUM-EXPT))
+		  FLONUM-DENORMALIZE FLONUM-EXPT
+		  ;; SET-INTERRUPT-ENABLES!
+		  ))
 
 (define (generic->inline-data generic-op)
   (define (generic-additive-test constant)
diff --git a/v8/src/compiler/machines/spectrum/rules3.scm b/v8/src/compiler/machines/spectrum/rules3.scm
index 44e937ad2..a6b83d212 100644
--- a/v8/src/compiler/machines/spectrum/rules3.scm
+++ b/v8/src/compiler/machines/spectrum/rules3.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 1.8 1995/03/13 07:01:27 adams Exp $
+$Id: rules3.scm,v 1.9 1996/07/19 02:27:48 adams Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -250,13 +250,19 @@ MIT in each case. |#
   (define-optimized-primitive-invocation &=)
   (define-optimized-primitive-invocation &<)
   (define-optimized-primitive-invocation &>)
-  (define-old-optimized-primitive-invocation 1+)
-  (define-old-optimized-primitive-invocation -1+)
-  (define-old-optimized-primitive-invocation zero?)
-  (define-old-optimized-primitive-invocation positive?)
-  (define-old-optimized-primitive-invocation negative?)
+
+  ;; Defunct.
+  ;;(define-old-optimized-primitive-invocation 1+)
+  ;;(define-old-optimized-primitive-invocation -1+)
+  ;;(define-old-optimized-primitive-invocation zero?)
+  ;;(define-old-optimized-primitive-invocation positive?)
+  ;;(define-old-optimized-primitive-invocation negative?)
+
   (define-optimized-primitive-invocation quotient)
   (define-optimized-primitive-invocation remainder)
+
+  (define-optimized-primitive-invocation set-interrupt-enables!)
+
   (define-allocation-primitive vector-cons)
   (define-allocation-primitive string-allocate)
   (define-allocation-primitive floating-vector-cons))
diff --git a/v8/src/compiler/midend/fakeprim.scm b/v8/src/compiler/midend/fakeprim.scm
index 87e68581c..ca3523c57 100644
--- a/v8/src/compiler/midend/fakeprim.scm
+++ b/v8/src/compiler/midend/fakeprim.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fakeprim.scm,v 1.25 1996/04/25 04:23:45 cph Exp $
+$Id: fakeprim.scm,v 1.26 1996/07/19 02:27:59 adams Exp $
 
 Copyright (c) 1994-96 Massachusetts Institute of Technology
 
@@ -1099,6 +1099,10 @@ MIT in each case. |#
        (make-primitive-procedure 'PRIMITIVE-GET-FREE)
        (make-primitive-procedure 'PRIMITIVE-OBJECT-REF)))
 
+
+(define-operator-properties (make-primitive-procedure 'SET-INTERRUPT-ENABLES!)
+  (list '(OUT-OF-LINE-HOOK)))
+
 ;;(for-each
 ;; (lambda (simple-operator)
 ;;   (define-operator-properties
diff --git a/v8/src/compiler/midend/rtlgen.scm b/v8/src/compiler/midend/rtlgen.scm
index e38a911f9..f77ec9b68 100644
--- a/v8/src/compiler/midend/rtlgen.scm
+++ b/v8/src/compiler/midend/rtlgen.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: rtlgen.scm,v 1.46 1996/04/26 18:14:04 cph Exp $
+$Id: rtlgen.scm,v 1.47 1996/07/19 02:27:15 adams Exp $
 
 Copyright (c) 1994-96 Massachusetts Institute of Technology
 
@@ -4283,7 +4283,9 @@ MIT in each case. |#
   (define-out-of-line-primitive %> '&> 2)
   (define-out-of-line-primitive %string-allocate 'STRING-ALLOCATE 1)
   (define-out-of-line-primitive %floating-vector-cons 'FLOATING-VECTOR-CONS 1)
-  (define-out-of-line-primitive %vector-cons 'VECTOR-CONS 2))
+  (define-out-of-line-primitive %vector-cons 'VECTOR-CONS 2)
+
+  (define-out-of-line-primitive 'SET-INTERRUPT-ENABLES! 'SET-INTERRUPT-ENABLES! 1))
 
 (let ((define-variable-ref
 	(lambda (operator safe?)