[Gd-chatter] r11483 - in trunk/fundev/sources: dfmc/c-ffi lib/c-ffi
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Wed Nov 7 00:47:37 CET 2007
Author: hannes
Date: Wed Nov 7 00:47:36 2007
New Revision: 11483
Modified:
trunk/fundev/sources/dfmc/c-ffi/c-function-macro.dylan
trunk/fundev/sources/lib/c-ffi/memory-functions.dylan
trunk/fundev/sources/lib/c-ffi/unix-c-ffi-library.dylan
trunk/fundev/sources/lib/c-ffi/win32-c-ffi-library.dylan
Log:
Job: fd
build a simple tracer for C-FFI calls. Feature description is in
memory-functions.dylan... which is actually a bad place for it.
Modified: trunk/fundev/sources/dfmc/c-ffi/c-function-macro.dylan
==============================================================================
--- trunk/fundev/sources/dfmc/c-ffi/c-function-macro.dylan (original)
+++ trunk/fundev/sources/dfmc/c-ffi/c-function-macro.dylan Wed Nov 7 00:47:36 2007
@@ -91,20 +91,41 @@
let (arg-specs, result-spec, c-name, options)
= parse-c-function-spec(dylan-name, spec);
let (arg-fragments, result-fragment, parameter-list-fragment,
- return-values-fragment, define-gf?)
+ return-values-fragment, define-gf?, parameter-names-fragment)
= parse-early-options(arg-specs, result-spec, options, dylan-name);
let inline-policy = mods;
- let body = #{ c-function-body
- ?dylan-name
- (c-name ?c-name),
- (options ??options, ...),
- ?result-fragment,
- ??arg-fragments, ...
- end };
+ let body = #{ begin
+ if (?=$trace-ffi-calls)
+ // we depend on folding one of the branches for
+ // performance reasons, so $trace-ffi-calls better be
+ // a constant. apply(values, ...)
+ // isn't optimized, that's why the whole c-function-body
+ // code segment is duplicated here.
+ ?=log-entry(?c-name, ?parameter-names-fragment);
+ let (#rest results) = c-function-body
+ ?dylan-name
+ (c-name ?c-name),
+ (options ??options, ...),
+ ?result-fragment,
+ ??arg-fragments, ...
+ end;
+ ?=log-exit(?c-name, results);
+ apply(values, results)
+ else
+ c-function-body
+ ?dylan-name
+ (c-name ?c-name),
+ (options ??options, ...),
+ ?result-fragment,
+ ??arg-fragments, ...
+ end
+ end
+ end
+ };
if (define-gf?)
#{ define ?inline-policy method ?dylan-name ?parameter-list-fragment
=> ?return-values-fragment;
- ?body
+ ?body
end }
else
#{ define ?inline-policy function ?dylan-name ?parameter-list-fragment
@@ -132,9 +153,10 @@
result-fragment :: <template>,
parameter-list-fragment :: <template>,
return-values-fragment :: <template>,
- function-generic? :: <boolean>);
+ function-generic? :: <boolean>,
+ parameter-names-fragment :: <template>);
- collecting (return-values, arg-fragments, parameters)
+ collecting (return-values, arg-fragments, parameters, parameter-names)
let result-fragment = #f;
let vname = result-spec.name;
let type = ~void?(result-spec) & result-spec.designator-name;
@@ -182,10 +204,12 @@
#{ ?nn :: import-type-for-reference(?type) });
if (call-discipline(arg) = #"in-out")
// parameter to the dylan function
+ collect-into(parameter-names, #{ ?nn });
collect-into(parameters,
#{ ?nn :: export-type-for-reference(?type) })
end;
else
+ collect-into(parameter-names, #{ ?nn });
collect-into(parameters, #{ ?nn :: export-type-for(?type) })
end;
@@ -203,12 +227,14 @@
end unless;
let params = collected(parameters);
+ let param-names = collected(parameter-names);
let returns = collected(return-values);
values(collected(arg-fragments),
result-fragment,
#{ (??params, ...) },
#{ (??returns, ...) },
- gf-method?);
+ gf-method?,
+ #{ ??param-names, ... });
end collecting;
end method;
Modified: trunk/fundev/sources/lib/c-ffi/memory-functions.dylan
==============================================================================
--- trunk/fundev/sources/lib/c-ffi/memory-functions.dylan (original)
+++ trunk/fundev/sources/lib/c-ffi/memory-functions.dylan Wed Nov 7 00:47:36 2007
@@ -56,3 +56,28 @@
let raw-size = primitive-unwrap-machine-word(as(<machine-word>, size));
primitive-fill!(raw-pointer, raw-zero, raw-zero, raw-size, raw-zero);
end function;
+
+// If this is set to #t, all calls to foreign functions are traced.
+// This is done by calling a function log-entry(c-function-name, #rest
+// args) on function entry, and log-exit(c-function-name, #rest
+// results) on function exit. You need to provide these functions in
+// the lexical scope of the "define C-function". Empty stubs are
+// provided here, in case you don't want to trace all your FFI
+// libraries.
+//
+//You can easily use those definitions in a client library and
+//exclude log-entry and log-exit from c-ffi.
+/*
+define inline-only function log-entry(c-function-name, #rest args) => ();
+ format-out("entering %s %=", c-function-name, args);
+end;
+define inline-only function log-exit(c-function-name, #rest results) => ();
+ format-out(" => %=\n", results);
+end;
+*/
+
+define constant $trace-ffi-calls = #f;
+
+define inline-only function log-entry(c-function-name, #rest args) => (); end;
+define inline-only function log-exit(c-function-name, #rest results) => (); end;
+
Modified: trunk/fundev/sources/lib/c-ffi/unix-c-ffi-library.dylan
==============================================================================
--- trunk/fundev/sources/lib/c-ffi/unix-c-ffi-library.dylan (original)
+++ trunk/fundev/sources/lib/c-ffi/unix-c-ffi-library.dylan Wed Nov 7 00:47:36 2007
@@ -166,6 +166,10 @@
equal-memory?,
clear-memory!,
+ $trace-ffi-calls,
+ log-entry,
+ log-exit,
+
<ffi-integer>
;
end module;
Modified: trunk/fundev/sources/lib/c-ffi/win32-c-ffi-library.dylan
==============================================================================
--- trunk/fundev/sources/lib/c-ffi/win32-c-ffi-library.dylan (original)
+++ trunk/fundev/sources/lib/c-ffi/win32-c-ffi-library.dylan Wed Nov 7 00:47:36 2007
@@ -167,6 +167,10 @@
equal-memory?,
clear-memory!,
+ $trace-ffi-calls,
+ log-entry,
+ log-exit,
+
<ffi-integer>
;
end module;
More information about the chatter
mailing list