Gerroff the global TRACE binding; use %trace instead.
authorMatt Birkholz <matt@birkholz.chandler.az.us>
Tue, 31 May 2011 01:29:29 +0000 (18:29 -0700)
committerMatt Birkholz <matt@birkholz.chandler.az.us>
Tue, 31 May 2011 01:29:29 +0000 (18:29 -0700)
src/runtime/ffi.scm

index 489ddca424bd2239c2d5ddaa49a817dbacb1c0cd..220e810a8998600926b5e48ebc6040b677895169 100644 (file)
@@ -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