From: Matt Birkholz <matt@birkholz.chandler.az.us>
Date: Tue, 31 May 2011 01:29:29 +0000 (-0700)
Subject: Gerroff the global TRACE binding; use %trace instead.
X-Git-Tag: 20110609-Gtk~10
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=87915a6e43b09518636da36fbc5fc2d89450bd3f;p=mit-scheme.git

Gerroff the global TRACE binding; use %trace instead.
---

diff --git a/src/runtime/ffi.scm b/src/runtime/ffi.scm
index 489ddca42..220e810a8 100644
--- a/src/runtime/ffi.scm
+++ b/src/runtime/ffi.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-Copyright (C) 2006, 2007, 2008, 2009, 2010 Matthew Birkholz
+Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Matthew Birkholz
 
 This file is part of MIT/GNU Scheme.
 
@@ -322,13 +322,13 @@ USA.
 
 (define (call-alien* alien-function args)
   (let ((old-top calloutback-stack))
-    (if-tracing
+    (%if-tracing
      (outf-console ";"(tindent)"=> "alien-function" "args"\n")
      (set! calloutback-stack (cons (cons* alien-function args) old-top)))
     (let ((value (apply (ucode-primitive c-call -1) alien-function args)))
-      (if-tracing
-       (assert (eq? old-top (cdr calloutback-stack))
-	       "call-alien: freak stack "calloutback-stack"\n")
+      (%if-tracing
+       (%assert (eq? old-top (cdr calloutback-stack))
+		"call-alien: freak stack "calloutback-stack"\n")
        (set! calloutback-stack old-top)
        (outf-console ";"(tindent)"<= "value"\n"))
       value)))
@@ -469,14 +469,14 @@ USA.
 	(error:bad-range-argument id 'apply-callback))
     (normalize-aliens! args)
     (let ((old-top calloutback-stack))
-      (if-tracing
+      (%if-tracing
        (outf-console ";"(tindent)"=>> "procedure" "args"\n")
        (set! calloutback-stack (cons (cons procedure args) old-top)))
       (let ((value (apply-callback-proc procedure args)))
-	(if-tracing
-	 (assert (and (pair? calloutback-stack)
-		      (eq? old-top (cdr calloutback-stack)))
-		 "callback-handler: freak stack "calloutback-stack"\n")
+	(%if-tracing
+	 (%assert (and (pair? calloutback-stack)
+		       (eq? old-top (cdr calloutback-stack)))
+		  "callback-handler: freak stack "calloutback-stack"\n")
 	 (set! calloutback-stack old-top)
 	 (outf-console ";"(tindent)"<<= "value"\n"))
 	value))))
@@ -514,14 +514,14 @@ USA.
 
 (define calloutback-stack '())
 
-(define trace? #f)
+(define %trace? #f)
 
 (define (reset-package!)
   (reset-alien-functions!)
   (reset-malloced-aliens!)
   (reset-callbacks!)
   (set! %radix (if (fix:fixnum? #x100000000) #x100000000 #x10000))
-  (set! trace? #f)
+  (set! %trace? #f)
   (set! calloutback-stack '()))
 
 (define (initialize-package!)
@@ -531,20 +531,20 @@ USA.
   (add-gc-daemon! free-malloced-aliens)
   unspecific)
 
-(define-syntax if-tracing
+(define-syntax %if-tracing
   (syntax-rules ()
     ((_ . BODY)
-     (if trace? ((lambda () . BODY))))))
+     (if %trace? ((lambda () . BODY))))))
 
-(define-syntax assert
+(define-syntax %assert
   (syntax-rules ()
     ((_ TEST . MSG)
      (if (not TEST) (error "Failed assert:" . MSG)))))
 
-(define-syntax trace
+(define-syntax %trace
   (syntax-rules ()
     ((_ . MSG)
-     (if trace? ((lambda () (outf-console . MSG)))))))
+     (if %trace? ((lambda () (outf-console . MSG)))))))
 
 (define (tindent)
   (make-string (* 2 (length calloutback-stack)) #\space))
\ No newline at end of file