Implement calls to SET-INTERRUPT-ENABLES! by jumping to

assembly-language hook in compiled code interface.

diff --git a/v7/src/compiler/machines/bobcat/lapgen.scm b/v7/src/compiler/machines/bobcat/lapgen.scm
index e2a7bab4717c3cd71757239c3e9f79ddfea0a777..5f3a99b9fe7f38c80b8cfbf6854d4e64b3fc2a80 100644 (file)
--- a/v7/src/compiler/machines/bobcat/lapgen.scm
+++ b/v7/src/compiler/machines/bobcat/lapgen.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: lapgen.scm,v 4.46 1992/09/25 01:18:08 cph Exp $
+$Id: lapgen.scm,v 4.47 1993/01/13 00:18:46 cph Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -1144,17 +1144,17 @@ MIT in each case. |#
     stack-and-interrupt-check-18 ; This doesn't have a code: counterpart.
     stack-and-interrupt-check-22 ; This doesn't have a code: counterpart.
     stack-and-interrupt-check-24 ; This doesn't have a code: counterpart.
+    set-interrupt-enables      ; This doesn't have a code: counterpart.
     ))
 
 (define-integrable (invoke-interface code)
   (LAP (MOVEQ (& ,code) (D 0))
        (JMP ,entry:compiler-scheme-to-interface)))
 
-#|
 ;; If the entry point scheme-to-interface-jsr were not available,
 ;; this code should replace the definition below.
 ;; The others can be handled similarly.
-
+#|
 (define-integrable (invoke-interface-jsr code)
   (LAP (MOVEQ (& ,code) (D 0))
        (LEA (@PCO 12) (A 0))

diff --git a/v7/src/compiler/machines/bobcat/rules3.scm b/v7/src/compiler/machines/bobcat/rules3.scm
index d4f45874fcc68d725dd7a34c82f443de8a16086b..a61bc7dd8574561e3a72830994f8f3f5929fc22b 100644 (file)
--- a/v7/src/compiler/machines/bobcat/rules3.scm
+++ b/v7/src/compiler/machines/bobcat/rules3.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: rules3.scm,v 4.36 1992/09/30 21:06:02 cph Exp $
+$Id: rules3.scm,v 4.37 1993/01/13 00:18:40 cph Exp $
 
-Copyright (c) 1988-92 Massachusetts Institute of Technology
+Copyright (c) 1988-93 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -153,23 +153,26 @@ MIT in each case. |#
   (INVOCATION:PRIMITIVE (? frame-size) (? continuation) (? primitive))
   continuation
   (LAP ,@(clear-map!)
-       ,@(if (eq? primitive compiled-error-procedure)
-            (LAP ,@(load-dnl frame-size 1)
-                 (JMP ,entry:compiler-error))
-            (let ((arity (primitive-procedure-arity primitive)))
-              (cond ((not (negative? arity))
-                     (LAP (MOV L (@PCR ,(constant->label primitive)) (D 1))
-                          (JMP ,entry:compiler-primitive-apply)))
-                    ((= arity -1)
-                     (LAP (MOV L (& ,(-1+ frame-size))
-                               ,reg:lexpr-primitive-arity)
-                          (MOV L (@PCR ,(constant->label primitive)) (D 1))
-                          (JMP ,entry:compiler-primitive-lexpr-apply)))
-                    (else
-                     ;; Unknown primitive arity.  Go through apply.
-                     (LAP ,@(load-dnl frame-size 2)
-                          (MOV L (@PCR ,(constant->label primitive)) (D 1))
-                          ,@(invoke-interface code:compiler-apply))))))))
+       ,@(cond ((eq? primitive compiled-error-procedure)
+               (LAP ,@(load-dnl frame-size 1)
+                    (JMP ,entry:compiler-error)))
+              ((eq? primitive (ucode-primitive set-interrupt-enables! 1))
+               (LAP (JMP ,entry:set-interrupt-enables)))
+              (else
+               (let ((arity (primitive-procedure-arity primitive)))
+                 (cond ((not (negative? arity))
+                        (LAP (MOV L (@PCR ,(constant->label primitive)) (D 1))
+                             (JMP ,entry:compiler-primitive-apply)))
+                       ((= arity -1)
+                        (LAP (MOV L (& ,(-1+ frame-size))
+                                  ,reg:lexpr-primitive-arity)
+                             (MOV L (@PCR ,(constant->label primitive)) (D 1))
+                             (JMP ,entry:compiler-primitive-lexpr-apply)))
+                       (else
+                        ;; Unknown primitive arity.  Go through apply.
+                        (LAP ,@(load-dnl frame-size 2)
+                             (MOV L (@PCR ,(constant->label primitive)) (D 1))
+                             ,@(invoke-interface code:compiler-apply)))))))))
 \f
 (let-syntax
     ((define-special-primitive-invocation