New function registration stuff.

Basically can register functions which return void CCTK_INT or CCTK_REAL
and take up to CCTK_MAX_ARGS (currently 255) void * arguments.

The CCTK_FunctionCall function can then be used to call this function, timing
its execution.

Tom


git-svn-id: http://svn.cactuscode.org/flesh/trunk@1279 17b73243-c579-4c4c-a9d2-2d5706c11dac

1 files changed, 122 insertions, 0 deletions

diff --git a/lib/sbin/Create_cctki_Functions_h.pl b/lib/sbin/Create_cctki_Functions_h.pl
new file mode 100644
index 00000000..9a8f14d2
--- /dev/null
+++ b/lib/sbin/Create_cctki_Functions_h.pl
@@ -0,0 +1,122 @@
+#! /usr/bin/perl -s
+# /*@@
+#   @header    Create_cctki_Functions_h.pl
+#   @date      Sat Dec  4 14:11:35 1999
+#   @author    Tom Goodale
+#   @desc 
+#   Perl script to generate cctki_Functions.h
+#   Takes one argument
+#      -max_args
+#   which is the maximum number of arguments a function may take.
+#   @enddesc
+#   @version $Header$
+# @@*/
+
+# Set the default number of arguments if it isn't defined.
+if(!defined $max_args)
+{
+  $max_args = 255;
+}
+
+# Make a copy of the STDOUT file descriptor (allows us to change things later).
+*OUTSTREAM = STDOUT;
+
+# Print the GRDOC header.
+print OUTSTREAM " /*\@\@
+   \@header    cctki_Functions.h
+   \@date      Sat Dec  4 14:11:35 1999
+   \@author    Tom Goodale
+   \@desc 
+   Header file for calling functions.
+   This was generated by a perl script - please don't edit by hand !
+   \@enddesc
+   \@version \$Header\$
+ \@\@*/
+";
+
+print OUTSTREAM "\n";
+
+print OUTSTREAM "#define CCTK_MAX_ARGS $max_args\n";
+
+print OUTSTREAM "\n";
+
+# Define the types of functions.
+for($i = 0; $i <= $max_args; $i++)
+{
+  print OUTSTREAM "#define CCTK_FUNCTION_$i(xtype) xtype (*)(";
+
+  if($i == 0)
+  {
+    print OUTSTREAM "void";
+  }
+  else
+  {
+    $sep = "";
+    for($arg = 0 ; $arg < $i; $arg++)
+    {
+      print OUTSTREAM "$sep void *";
+
+      $sep = ",";
+    }
+  }
+
+  print OUTSTREAM ")\n";
+}
+
+print OUTSTREAM "\n";
+
+# switch/case statement for functions which return nothing. 
+print OUTSTREAM "#define CCTK_CALLVOIDFUNC(xcount, xarray, xfunction) \\\n";
+print OUTSTREAM "  switch(xcount)                 \\\n";
+print OUTSTREAM "  {                              \\\n";
+
+for($i = 0; $i <= $max_args; $i++)
+{
+  print OUTSTREAM "     case $i: ((CCTK_FUNCTION_$i(void))(xfunction))(";
+
+  if($i > 0)
+  {
+    $sep = "";
+    for($arg = 0 ; $arg < $i; $arg++)
+    {
+      print OUTSTREAM "$sep"."(xarray)[$arg]";
+    
+      $sep = ", ";
+    }
+  }
+
+  print OUTSTREAM "); break; \\\n";
+}
+
+print OUTSTREAM "     default: fprintf(stderr, \"Internal error:  %d functions unsupported\\n\", xcount);\\\n";
+
+print OUTSTREAM "  }\n";
+
+print OUTSTREAM "\n";
+
+# switch/case statement for functions which return xtype
+print OUTSTREAM "#define CCTK_CALLRETFUNC(xret, xtype, xcount, xarray, xfunction) \\\n";
+print OUTSTREAM "  switch(xcount)                 \\\n";
+print OUTSTREAM "  {                              \\\n";
+
+for($i = 0; $i <= $max_args; $i++)
+{
+  print OUTSTREAM "     case $i: xret = ((CCTK_FUNCTION_$i(xtype))(xfunction))(";
+
+  if($i > 0)
+  {
+    $sep = "";
+    for($arg = 0 ; $arg < $i; $arg++)
+    {
+      print OUTSTREAM "$sep"."(xarray)[$arg]";
+    
+      $sep = ", ";
+    }
+  }
+
+  print OUTSTREAM "); break; \\\n";
+}
+
+print OUTSTREAM "     default: fprintf(stderr, \"Internal error:  %d functions unsupported\\n\", xcount);\\\n";
+
+print OUTSTREAM "  }\n";