#| -*-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
(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)
;; 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)
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?)
#| -*-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
interrupt-bit/timer
interrupt-mask/all
interrupt-mask/gc-ok
- interrupt-mask/no-background
interrupt-mask/none
interrupt-mask/timer-ok
object-constant?
unparser-method?
unparser/standard-method
with-absolutely-no-interrupts
- without-background-interrupts
without-interrupts))
(define-package (runtime equality)