Eliminate unused WITHOUT-BACKGROUND-INTERRUPTS.
authorChris Hanson <org/chris-hanson/cph>
Fri, 1 Oct 2004 02:32:03 +0000 (02:32 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 1 Oct 2004 02:32:03 +0000 (02:32 +0000)
v7/src/runtime/boot.scm
v7/src/runtime/runtime.pkg

index 8b88ff1d4798effb75ddbff5eb242516c5e46b7f..0b23d565065906117903dac69b67ac65ccc7a539 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: boot.scm,v 14.16 2004/10/01 02:26:55 cph Exp $
+$Id: boot.scm,v 14.17 2004/10/01 02:31:51 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1992 Massachusetts Institute of Technology
 Copyright 1993,1996,2001,2004 Massachusetts Institute of Technology
@@ -29,44 +29,41 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define standard-unparser-method)
-(define unparser/standard-method)
-(let ((make-method
-       (lambda (name unparser)
-        (lambda (state object)
-          (let ((port (unparser-state/port state))
-                (hash-string (number->string (hash object))))
-            (if *unparse-with-maximum-readability?*
-                (begin
-                  (write-string "#@" port)
-                  (write-string hash-string port))
-                (begin
-                  (write-string "#[" port)
-                  (if (string? name)
-                      (write-string name port)
-                      (with-current-unparser-state state
-                        (lambda (port)
-                          (write name port))))
-                  (write-char #\space port)
-                  (write-string hash-string port)
-                  (if unparser (unparser state object))
-                  (write-char #\] port))))))))
-  (set! standard-unparser-method
-       (lambda (name unparser)
-         (make-method name
-                      (and unparser
-                           (lambda (state object)
-                             (with-current-unparser-state state
-                               (lambda (port)
-                                 (unparser object port))))))))
-  (set! unparser/standard-method
-       (lambda (name #!optional unparser)
-         (make-method name
-                      (and (not (default-object? unparser))
-                           unparser
-                           (lambda (state object)
-                             (unparse-char state #\space)
-                             (unparser state object)))))))
+(define (standard-unparser-method name unparser)
+  (make-method name
+              (and unparser
+                   (lambda (state object)
+                     (with-current-unparser-state state
+                       (lambda (port)
+                         (unparser object port)))))))
+
+(define (unparser/standard-method name #!optional unparser)
+  (make-method name
+              (and (not (default-object? unparser))
+                   unparser
+                   (lambda (state object)
+                     (unparse-char state #\space)
+                     (unparser state object)))))
+
+(define (make-method name unparser)
+  (lambda (state object)
+    (let ((port (unparser-state/port state))
+         (hash-string (number->string (hash object))))
+      (if *unparse-with-maximum-readability?*
+         (begin
+           (write-string "#@" port)
+           (write-string hash-string port))
+         (begin
+           (write-string "#[" port)
+           (if (string? name)
+               (write-string name port)
+               (with-current-unparser-state state
+                 (lambda (port)
+                   (write name port))))
+           (write-char #\space port)
+           (write-string hash-string port)
+           (if unparser (unparser state object))
+           (write-char #\] port))))))
 
 (define (unparser-method? object)
   (and (procedure? object)
@@ -87,9 +84,6 @@ USA.
 ;; GC & stack overflow only
 (define-integrable interrupt-mask/gc-ok    #x0007)
 
-;; GC, stack overflow, and keyboard only
-(define-integrable interrupt-mask/no-background #x0017)
-
 ;; GC, stack overflow, and timer only
 (define-integrable interrupt-mask/timer-ok #x0047)
 
@@ -111,12 +105,6 @@ USA.
       interrupt-mask
       (thunk))))
 
-(define (without-background-interrupts thunk)
-  (with-limited-interrupts interrupt-mask/no-background
-    (lambda (interrupt-mask)
-      interrupt-mask
-      (thunk))))
-
 (define-primitives
   (object-pure? pure?)
   (object-constant? constant?)
index 8d0c5bbddfed0e93170c2de3e42395bdfc3dda2a..9db67879a31a628efad7d4d161a671cd797c3f39 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.495 2004/10/01 02:16:49 cph Exp $
+$Id: runtime.pkg,v 14.496 2004/10/01 02:32:03 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -150,7 +150,6 @@ USA.
          interrupt-bit/timer
          interrupt-mask/all
          interrupt-mask/gc-ok
-         interrupt-mask/no-background
          interrupt-mask/none
          interrupt-mask/timer-ok
          object-constant?
@@ -159,7 +158,6 @@ USA.
          unparser-method?
          unparser/standard-method
          with-absolutely-no-interrupts
-         without-background-interrupts
          without-interrupts))
 
 (define-package (runtime equality)