From 87915a6e43b09518636da36fbc5fc2d89450bd3f Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Mon, 30 May 2011 18:29:29 -0700 Subject: [PATCH] Gerroff the global TRACE binding; use %trace instead. --- src/runtime/ffi.scm | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) 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 -- 2.25.1