From 09bd3946db970d3db05f1a1b094e4684cc2aaf45 Mon Sep 17 00:00:00 2001 From: Dave Beazley Date: Tue, 11 Jan 2000 21:15:54 +0000 Subject: [PATCH] Added files git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@39 626c5289-ae23-0410-ae9c-e8d60b6d4f22 --- SWIG/Lib/array.i | 401 ++++++++++++++++++++ SWIG/Lib/autodoc.i | 101 +++++ SWIG/Lib/carray.i | 175 +++++++++ SWIG/Lib/constraints.i | 208 +++++++++++ SWIG/Lib/ctype.i | 64 ++++ SWIG/Lib/exception.i | 146 ++++++++ SWIG/Lib/guile/Makefile | 4 + SWIG/Lib/guile/guile.swg | 15 + SWIG/Lib/guile/guilemain.i | 21 ++ SWIG/Lib/guile/interpreter.i | 71 ++++ SWIG/Lib/malloc.i | 57 +++ SWIG/Lib/math.i | 113 ++++++ SWIG/Lib/memory.i | 39 ++ SWIG/Lib/objc.i | 56 +++ SWIG/Lib/perl5/Makefile.in | 139 +++++++ SWIG/Lib/perl5/Makefile.pl | 21 ++ SWIG/Lib/perl5/headers.swg | 24 ++ SWIG/Lib/perl5/perl5.swg | 366 ++++++++++++++++++ SWIG/Lib/perl5/perl5mg.swg | 19 + SWIG/Lib/perl5/perlmain.i | 80 ++++ SWIG/Lib/perl5/ptrlang.i | 650 ++++++++++++++++++++++++++++++++ SWIG/Lib/perl5/typemaps.i | 475 ++++++++++++++++++++++++ SWIG/Lib/pointer.i | 58 +++ SWIG/Lib/stdlib.i | 43 +++ SWIG/Lib/swigptr.swg | 326 ++++++++++++++++ SWIG/Lib/tcl/Makefile.in | 134 +++++++ SWIG/Lib/tcl/constarray.i | 108 ++++++ SWIG/Lib/tcl/consthash.i | 223 +++++++++++ SWIG/Lib/tcl/mactclinit.c | 86 +++++ SWIG/Lib/tcl/mactkinit.c | 229 ++++++++++++ SWIG/Lib/tcl/object.swg | 229 ++++++++++++ SWIG/Lib/tcl/ptrlang.i | 695 +++++++++++++++++++++++++++++++++++ SWIG/Lib/tcl/swigtcl8.swg | 300 +++++++++++++++ SWIG/Lib/tcl/tclsh.i | 86 +++++ SWIG/Lib/tcl/typemaps.i | 555 ++++++++++++++++++++++++++++ SWIG/Lib/tcl/wish.i | 163 ++++++++ SWIG/Lib/timers.i | 173 +++++++++ 37 files changed, 6653 insertions(+) create mode 100644 SWIG/Lib/array.i create mode 100644 SWIG/Lib/autodoc.i create mode 100644 SWIG/Lib/carray.i create mode 100644 SWIG/Lib/constraints.i create mode 100644 SWIG/Lib/ctype.i create mode 100644 SWIG/Lib/exception.i create mode 100644 SWIG/Lib/guile/Makefile create mode 100644 SWIG/Lib/guile/guile.swg create mode 100644 SWIG/Lib/guile/guilemain.i create mode 100644 SWIG/Lib/guile/interpreter.i create mode 100644 SWIG/Lib/malloc.i create mode 100644 SWIG/Lib/math.i create mode 100644 SWIG/Lib/memory.i create mode 100644 SWIG/Lib/objc.i create mode 100644 SWIG/Lib/perl5/Makefile.in create mode 100644 SWIG/Lib/perl5/Makefile.pl create mode 100644 SWIG/Lib/perl5/headers.swg create mode 100644 SWIG/Lib/perl5/perl5.swg create mode 100644 SWIG/Lib/perl5/perl5mg.swg create mode 100644 SWIG/Lib/perl5/perlmain.i create mode 100644 SWIG/Lib/perl5/ptrlang.i create mode 100644 SWIG/Lib/perl5/typemaps.i create mode 100644 SWIG/Lib/pointer.i create mode 100644 SWIG/Lib/stdlib.i create mode 100644 SWIG/Lib/swigptr.swg create mode 100644 SWIG/Lib/tcl/Makefile.in create mode 100644 SWIG/Lib/tcl/constarray.i create mode 100644 SWIG/Lib/tcl/consthash.i create mode 100644 SWIG/Lib/tcl/mactclinit.c create mode 100644 SWIG/Lib/tcl/mactkinit.c create mode 100644 SWIG/Lib/tcl/object.swg create mode 100644 SWIG/Lib/tcl/ptrlang.i create mode 100644 SWIG/Lib/tcl/swigtcl8.swg create mode 100644 SWIG/Lib/tcl/tclsh.i create mode 100644 SWIG/Lib/tcl/typemaps.i create mode 100644 SWIG/Lib/tcl/wish.i create mode 100644 SWIG/Lib/timers.i diff --git a/SWIG/Lib/array.i b/SWIG/Lib/array.i new file mode 100644 index 000000000..3ae8a8c4d --- /dev/null +++ b/SWIG/Lib/array.i @@ -0,0 +1,401 @@ +// +// array.i +// Dave Beazley +// November 30, 1996 +// +// This SWIG library file provides access to C arrays. + +%module carray + +%section "SWIG C Array Module",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0 + +%text %{ +%include array.i + +This module provides scripting language access to various kinds of C/C++ +arrays. For each datatype, a collection of four functions are created : + + _array(size) : Create a new array of given size + _get(array, index) : Get an element from the array + _set(array, index, value) : Set an element in the array + _destroy(array) : Destroy an array + +The functions in this library are only low-level accessor functions +designed to directly access C arrays. Like C, no bounds checking is +performed so use at your own peril. +%} + +// Grab the SWIG exception library + +#ifndef AUTODOC +%include exception.i +#endif + +// A Typemap used to check input arguments. + +%typemap(check) int *, double *, float *, char **, short *, long * { + if (!$target) { + SWIG_exception(SWIG_ValueError,"Received a NULL Pointer"); + } +} + +%typemap(ret) int *, double *, float *, char **, short *, long * { + if (!$source) { + SWIG_exception(SWIG_MemoryError,"Out of memory."); + } +} + +// ----------------------------------------------------------------------- +// Integer array support +// ----------------------------------------------------------------------- + +%subsection "Integer Arrays" +%text %{ +The following functions provide access to integer arrays (mapped +onto the C 'int' datatype. +%} + +%{ +#include + +/* Create a new integer array */ + + static int *int_array(int size) { +#ifdef __cplusplus + return new int[size]; +#else + return (int *) malloc(size*sizeof(int)); +#endif + } + + /* Destroy an integer array */ + + static void int_destroy(int *array) { + if (array) { +#ifdef __cplusplus + delete array; +#else + free(array); +#endif + } + } + + /* Return an element */ + + static int int_get(int *array, int index) { + if (array) { + return array[index]; + } else { + return INT_MIN; + } + } + + /* Set an element */ + + static int int_set(int *array, int index, int value) { + if (array) { + return (array[index] = value); + } else { + return INT_MIN; + } + } + +%} + +int *int_array(int nitems); +/* Creates a new array of integers. nitems specifies the number of elements. + The array is created using malloc() in C and new() in C++. */ + +void int_destroy(int *array); +/* Destroys the given array. */ + +int int_get(int *array, int index); +/* Returns the value of array[index]. */ + +int int_set(int *array, int index, int value); +/* Sets array[index] = value. Returns value. */ + + +// ----------------------------------------------------------------------- +// Floating point +// ----------------------------------------------------------------------- + +%subsection "Floating Point Arrays" +/* The following functions provide access to arrays of floats and doubles. */ + + +%{ + #include + + /* Create a new float array */ + + static float *float_array(int size) { +#ifdef __cplusplus + return new float[size]; +#else + return (float *) malloc(size*sizeof(float)); +#endif + } + + /* Destroy an array */ + + static void float_destroy(float *array) { + if (array) { +#ifdef __cplusplus + delete array; +#else + free(array); +#endif + } + } + + /* Return an element */ + + static float float_get(float *array, int index) { + if (array) { + return array[index]; + } else { + return FLT_MIN; + } + } + + /* Set an element */ + + static float float_set(float *array, int index, float value) { + if (array) { + return (array[index] = value); + } else { + return FLT_MIN; + } + } + + /* Create a new double array */ + + static double *double_array(int size) { +#ifdef __cplusplus + return new double[size]; +#else + return (double *) malloc(size*sizeof(double)); +#endif + } + + /* Destroy an array */ + + static void double_destroy(double *array) { + if (array) { +#ifdef __cplusplus + delete array; +#else + free(array); +#endif + } + } + + /* Return an element */ + + static double double_get(double *array, int index) { + if (array) { + return array[index]; + } else { + return FLT_MIN; + } + } + + /* Set an element */ + + static double double_set(double *array, int index, double value) { + if (array) { + return (array[index] = value); + } else { + return FLT_MIN; + } + } + +%} + +double *double_array(int nitems); +/* Creates a new array of doubles. nitems specifies the number of elements. + The array is created using malloc() in C and new() in C++. */ + +void double_destroy(double *array); +/* Destroys the given array. */ + +double double_get(double *array, int index); +/* Returns the value of array[index]. */ + +double double_set(double *array, int index, double value); +/* Sets array[index] = value. Returns value. */ + +float *float_array(int nitems); +/* Creates a new array of floats. nitems specifies the number of elements. + The array is created using malloc() in C and new() in C++. */ + +void float_destroy(float *array); +/* Destroys the given array. */ + +float float_get(float *array, int index); +/* Returns the value of array[index]. */ + +float float_set(float *array, int index, float value); +/* Sets array[index] = value. Returns value. */ + +// ----------------------------------------------------------------------- +// Character strings +// ----------------------------------------------------------------------- + +%subsection "String Arrays" + +%text %{ +The following functions provide support for the 'char **' datatype. This +is primarily used to handle argument lists and other similar structures that +need to be passed to a C/C++ function. +%} + +#if defined(SWIGTCL) +%text %{ +To convert from a Tcl list into a 'char **', the following code can be used : + + # $list is a list + set args [string_array expr {[llength $list] + 1}] + set i 0 + foreach a $list { + string_set $args $i $a + incr i 1 + } + string_set $i "" + # $args is now a char ** type +%} +#elif defined(SWIGPERL) + +%text %{ +To convert from a Perl list into a 'char **', code similar to the following +can be used : + + # @list is a list + my $l = scalar(@list); + my $args = string_array($l+1); + my $i = 0; + foreach $arg (@list) { + string_set($args,$i,$arg); + $i++; + } + string_set($args,$i,""); + +(of course, there is always more than one way to do it) +%} +#elif defined(SWIGPYTHON) + +%text %{ +To convert from a Python list to a 'char **', code similar to the following +can be used : + + # 'list' is a list + args = string_array(len(list)+1) + for i in range(0,len(list)): + string_set(args,i,list[i]) + string_set(args,len(list),"") +%} + +#endif + +%{ +/* Create character string arrays */ + +static char **string_array(int size) { + char **a; + int i; +#ifdef __cplusplus + a = new char *[size]; +#else + a = (char **) malloc(size*sizeof(char *)); +#endif + for (i = 0; i < size; i++) + a[i] = 0; + return a; +} + +/* Destroy a string array */ + +static void string_destroy(char **array) { + int i = 0; + if (array) { + while (array[i]) { +#ifdef __cplusplus + delete array[i]; +#else + free(array[i]); +#endif + i++; + } +#ifdef __cplusplus + delete array; +#else + free(array); +#endif + } +} + +/* Get an element */ + +static char *string_get(char **array_string, int index) { + if (array_string) + if (array_string[index]) return (array_string[index]); + else return ""; + else + return ""; +} + +/* Set an element */ + +static char *string_set(char **array_string, int index, char * val) { + if (array_string) { + if (array_string[index]) { +#ifdef __cplusplus + delete array_string[index]; +#else + free(array_string[index]); +#endif + } + if (strlen(val) > 0) { +#ifdef __cplusplus + array_string[index] = new char[strlen(val)+1]; +#else + array_string[index] = (char *) malloc(strlen(val)+1); +#endif + strcpy(array_string[index],val); + return array_string[index]; + } else { + array_string[index] = 0; + return val; + } + } else return val; +} + +%} + +char **string_array(int nitems); +/* Creates a new array of strings. nitems specifies the number of elements. + The array is created using malloc() in C and new() in C++. Each element + of the array is set to NULL upon initialization. */ + +void string_destroy(char **array); +/* Destroys the given array. Each element of the array is assumed to be + a NULL-terminated string allocated with malloc() or new(). All of + these strings will be destroyed as well. (It is probably only safe to + use this function on an array created by string_array) */ + +char *string_get(char **array, int index); +/* Returns the value of array[index]. Returns a string of zero length + if the corresponding element is NULL. */ + +char *string_set(char **array, int index, char *value); +/* Sets array[index] = value. value is assumed to be a NULL-terminated + string. A string of zero length is mapped into a NULL value. When + setting the value, the value will be copied into a new string allocated + with malloc() or new(). Any previous value in the array will be + destroyed. */ + + +%typemap(check) int *, double *, float *, char **, short *, long * = PREVIOUS; +%typemap(out) int *, double *, float *, char **, short *, long * = PREVIOUS; + diff --git a/SWIG/Lib/autodoc.i b/SWIG/Lib/autodoc.i new file mode 100644 index 000000000..0ef408da7 --- /dev/null +++ b/SWIG/Lib/autodoc.i @@ -0,0 +1,101 @@ +// This file automatically generates the SWIG library documentation +%doconly +%style latex_section="\\newpage \\section{:}" +%title "SWIG Library Reference",pre,sort,chop_left = 0,noinfo +/* +Version 1.1p4 +January, 1998 + +Copyright (C) 1996-1998 +Dave Beazley + +(This file was automatically generated by SWIG) +*/ +%style html_contents="

:

" +%module swig_lib + +%section " Introduction" +%text %{ +This file describes all of the functions in the generic SWIG library. +The SWIG library is a collection of generally useful functions that +can be used to supplement an interface file. These include functions +to manipulate arrays, functions from the C library, and interesting +modules. + +This document is automatically generated by SWIG from the file +"swig_lib/autodoc.i". Some modules may supply additional documentation +for a particular target language. To recreate the documentation for +a particular target language, simply run SWIG on the file 'autodoc.i' +with the appropriate target language option. +%} + +#if defined(SWIGTCL) +%text %{ +This document has been generated for Tcl. +%} +#elif defined(SWIGPERL) +%text %{ +This document has been generated for Perl. +%} +#elif defined(SWIGPYTHON) +%text %{ +This document has been generated for Python. +%} +#endif + +%subsection "Call for contributions" +%text %{ +My long-term goal is for the SWIG library to be a collection of useful +modules that can be used to quickly put together interesting programs. +To contribute new modules send e-mail to beazley@cs.utah.edu and I +will include them here. +%} + +#define AUTODOC + +%include array.i +%include math.i +%include timers.i +%include malloc.i +%include memory.i +%include exception.i +%include pointer.i +%include constraints.i +%include typemaps.i + +#ifdef SWIGTCL +%section "Tcl Library Files",nosort +%text %{ +The following library modules are available when using the Tcl +language module. +%} +%include "tcl/consthash.i" +%include "tcl/constarray.i" +%include "tcl/tclsh.i" +%include "tcl/wish.i" +#endif + +#ifdef SWIGPYTHON +%section "Python Library Files",nosort +%text %{ +The following modules are available when using the Python language +module. +%} +%include "python/embed.i" +%include "python/embed14.i" +%include "python/embed13.i" + +#endif + +#ifdef SWIGPERL +%section "Perl Library Files",nosort + +%text %{ +The following modules are available when using the Perl5 language +module. +%} + +%include "perl5/perlmain.i" +#endif + + diff --git a/SWIG/Lib/carray.i b/SWIG/Lib/carray.i new file mode 100644 index 000000000..5bcdea528 --- /dev/null +++ b/SWIG/Lib/carray.i @@ -0,0 +1,175 @@ +// +// $Header$ +// carray.i +// Dave Beazley +// March 24, 1996 +// +// This SWIG library file supports C arrays of various datatypes. +// These arrays are probably *not* compatible with scripting languages +// but they are compatible with C functions. +// +/* Revision History + * -- $Log$ + * -- Revision 1.1 2000/01/11 21:15:47 beazley + * -- Added files + * -- + * -- Revision 1.1.1.1 1999/02/28 02:00:53 beazley + * -- Swig1.1 + * -- + * -- Revision 1.1 1996/05/22 17:23:48 beazley + * -- Initial revision + * -- + */ + +%module carray +%{ + +#include + +/* Create an integer array of given size */ + +static int *array_int(int size) { + return (int *) malloc(size*sizeof(int)); +} + +static int get_int(int *array_int, int index) { + if (array_int) + return (array_int[index]); + else + return 0; +} + +static int set_int(int *array_int, int index, int val) { + if (array_int) + return (array_int[index] = val); + else + return 0; +} + +/* Create double precision arrays */ + +static double *array_double(int size) { + return (double *) malloc(size*sizeof(double)); +} + +static double get_double(double *array_double, int index) { + if (array_double) + return (array_double[index]); + else + return 0; +} + +static double set_double(double *array_double, int index, double val) { + if (array_double) + return (array_double[index] = val); + else + return 0; +} + +/* Create byte arrays */ + +typedef unsigned char byte; + +static byte *array_byte(int size) { + return (byte *) malloc(size*sizeof(byte)); +} + +static byte get_byte(byte *array_byte, int index) { + if (array_byte) + return (array_byte[index]); + else + return 0; +} + +static byte set_byte(byte *array_byte, int index, byte val) { + if (array_byte) + return (array_byte[index] = val); + else + return 0; +} + +/* Create character string arrays */ + +static char **array_string(int size) { + char **a; + int i; + + a = (char **) malloc(size*sizeof(char *)); + for (i = 0; i < size; i++) + a[i] = 0; + return a; +} + +static char *get_string(char **array_string, int index) { + if (array_string) + return (array_string[index]); + else + return ""; +} + +static char *set_string(char **array_string, int index, char * val) { + if (array_string) { + if (array_string[index]) free(array_string[index]); + if (strlen(val) > 0) { + array_string[index] = (char *) malloc(strlen(val)+1); + strcpy(array_string[index],val); + return array_string[index]; + } else { + array_string[index] = 0; + return val; + } + } + else + return val; + } + +%} + +%section "Array Operations" + +int *array_int(int size); +/* Creates an integer array of size elements. Integers are the same +size as the C int type. */ + +int get_int(int *array_int, int index) ; +/* Return the integer in array_int[index] */ + +int set_int(int *array_int, int index, int ival); +/* Sets array_int[index] = ival. Returns it's value so you +can use this function in an expression. */ + +/* Create double precision arrays */ + +double *array_double(int size); +/* Creates an array of double precision floats. */ + +double get_double(double *array_double, int index); +/* Return the double in array_double[index] */ + +double set_double(double *array_double, int index, double dval); +/* Sets array_double[index] = dval. Returns it's value */ + +typedef unsigned char byte; + +byte *array_byte(int nbytes); +/* Creates a byte array. A byte is defined as an unsigned char. */ + +byte get_byte(byte *array_byte, int index); +/* Returns array_byte[index] */ + +byte set_byte(byte *array_byte, int index, byte val); +/* Sets array_byte[index] = val. Returns it's new value */ + +char **array_string(int size); +/* Creates a string array. A string is array is the same as char ** in C */ + +char *get_string(char **array_string, int index); +/* Returns character string in array_string[index]. If that entry is +NULL, returns an empty string */ + +char *set_string(char **array_string, int index, char * string); +/* Sets array_string[index] = string. string must be a 0-terminated +ASCII string. If string is "" then this will create a NULL pointer. */ + + + diff --git a/SWIG/Lib/constraints.i b/SWIG/Lib/constraints.i new file mode 100644 index 000000000..07ce32208 --- /dev/null +++ b/SWIG/Lib/constraints.i @@ -0,0 +1,208 @@ +// +// SWIG constraint library +// Dave Beazley +// May 4, 1997 +// +// This library file contains typemaps for implementing various kinds of +// constraints. Depends upon the SWIG exception library for generating +// errors in a language-independent manner. + +#ifdef AUTODOC +%section "Constraint Library",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0 + +%text %{ +%include constraints.i + +This library provides support for applying constraints to function +arguments. Using a constraint, you can restrict arguments to be +positive numbers, non-NULL pointers, and so on. The following +constraints are available : + + Number POSITIVE - Positive number (not zero) + Number NEGATIVE - Negative number (not zero) + Number NONZERO - Nonzero number + Number NONNEGATIVE - Positive number (including zero) + Number NONPOSITIVE - Negative number (including zero) + Pointer NONNULL - Non-NULL pointer + Pointer ALIGN8 - 8-byte aligned pointer + Pointer ALIGN4 - 4-byte aligned pointer + Pointer ALIGN2 - 2-byte aligned pointer + +To use the constraints, you need to "apply" them to specific +function arguments in your code. This is done using the %apply +directive. For example : + + %apply Number NONNEGATIVE { double nonneg }; + double sqrt(double nonneg); // Name of argument must match + + %apply Pointer NONNULL { void *ptr }; + void *malloc(int POSITIVE); // May return a NULL pointer + void free(void *ptr); // May not accept a NULL pointer + +Any function argument of the type you specify with the %apply directive +will be checked with the appropriate constraint. Multiple types may +be specified as follows : + + %apply Pointer NONNULL { void *, Vector *, List *, double *}; + +In this case, all of the types listed would be checked for non-NULL +pointers. + +The common datatypes of int, short, long, unsigned int, unsigned long, +unsigned short, unsigned char, signed char, float, and double can be +checked without using the %apply directive by simply using the +constraint name as the parameter name. For example : + + double sqrt(double NONNEGATIVE); + double log(double POSITIVE); + +If you have used typedef to change type-names, you can also do this : + + %apply double { Real }; // Make everything defined for doubles + // work for Reals. + Real sqrt(Real NONNEGATIVE); + Real log(Real POSITIVE); + +%} +#endif + +%include exception.i + +// Positive numbers + +%typemap(check) int POSITIVE, + short POSITIVE, + long POSITIVE, + unsigned int POSITIVE, + unsigned short POSITIVE, + unsigned long POSITIVE, + signed char POSITIVE, + unsigned char POSITIVE, + float POSITIVE, + double POSITIVE, + Number POSITIVE +{ + if ($target <= 0) { + SWIG_exception(SWIG_ValueError,"Expected a positive value."); + } +} + +// Negative numbers + +%typemap(check) int NEGATIVE, + short NEGATIVE, + long NEGATIVE, + unsigned int NEGATIVE, + unsigned short NEGATIVE, + unsigned long NEGATIVE, + signed char NEGATIVE, + unsigned char NEGATIVE, + float NEGATIVE, + double NEGATIVE, + Number NEGATIVE +{ + if ($target >= 0) { + SWIG_exception(SWIG_ValueError,"Expected a negative value."); + } +} + +// Nonzero numbers + +%typemap(check) int NONZERO, + short NONZERO, + long NONZERO, + unsigned int NONZERO, + unsigned short NONZERO, + unsigned long NONZERO, + signed char NONZERO, + unsigned char NONZERO, + float NONZERO, + double NONZERO, + Number NONZERO +{ + if ($target == 0) { + SWIG_exception(SWIG_ValueError,"Expected a nonzero value."); + } +} + +// Nonnegative numbers + +%typemap(check) int NONNEGATIVE, + short NONNEGATIVE, + long NONNEGATIVE, + unsigned int NONNEGATIVE, + unsigned short NONNEGATIVE, + unsigned long NONNEGATIVE, + signed char NONNEGATIVE, + unsigned char NONNEGATIVE, + float NONNEGATIVE, + double NONNEGATIVE, + Number NONNEGATIVE +{ + if ($target < 0) { + SWIG_exception(SWIG_ValueError,"Expected a non-negative value."); + } +} + +// Nonpositive numbers + +%typemap(check) int NONPOSITIVE, + short NONPOSITIVE, + long NONPOSITIVE, + unsigned int NONPOSITIVE, + unsigned short NONPOSITIVE, + unsigned long NONPOSITIVE, + signed char NONPOSITIVE, + unsigned char NONPOSITIVE, + float NONPOSITIVE, + double NONPOSITIVE, + Number NONPOSITIVE +{ + if ($target < 0) { + SWIG_exception(SWIG_ValueError,"Expected a non-positive value."); + } +} + +// Non-NULL pointer + +%typemap(check) void * NONNULL, + Pointer NONNULL +{ + if (!$target) { + SWIG_exception(SWIG_ValueError,"Received a NULL pointer."); + } +} + +// Aligned pointers + +%typemap(check) void * ALIGN8, + Pointer ALIGN8 +{ + long tmp; + tmp = (long) $target; + if (tmp & 7) { + SWIG_exception(SWIG_ValueError,"Pointer must be 8-byte aligned."); + } +} + +%typemap(check) void * ALIGN4, + Pointer ALIGN4 +{ + long tmp; + tmp = (long) $target; + if (tmp & 3) { + SWIG_exception(SWIG_ValueError,"Pointer must be 4-byte aligned."); + } +} + +%typemap(check) void * ALIGN2, + Pointer ALIGN2 +{ + long tmp; + tmp = (long) $target; + if (tmp & 1) { + SWIG_exception(SWIG_ValueError,"Pointer must be 2-byte aligned."); + } +} + + diff --git a/SWIG/Lib/ctype.i b/SWIG/Lib/ctype.i new file mode 100644 index 000000000..5b4ac54e8 --- /dev/null +++ b/SWIG/Lib/ctype.i @@ -0,0 +1,64 @@ +// +// ctype.i +// Dave Beazley +// November 30, 1996 +// SWIG file for character tests +// + +%module ctype +%{ +#include +%} + +%section "Character Class Testing Module",after,info,nosort,pre,chop_left=3,chop_bottom=0,chop_top=0,chop_right=0,skip=1 + +%text %{ +%include ctype.i + +This module provides access to a number of functions for testing +characters. These functions are in the C library. +Most scripting languages already provide much of this functionality, +but just in case you want to use one of the built-in C functions, +you can use this module. +%} + +int isalnum(char c); +/* Returns 1 if isalpha(c) or isdigit(c) is true. */ + +int isalpha(char c); +/* Returns 1 if isupper(c) or islower(c) is true. */ + +int iscntrl(char c); +/* Returns 1 if c is a control character. */ + +int isdigit(char c); +/* Returns 1 if c is a decimal digit. */ + +int isgraph(char c); +/* Returns 1 if c is a printing character except space. */ + +int islower(char c); +/* Returns 1 if c is a lower-case letter. */ + +int isprint(char c); +/* Returns 1 if c is a printing character including space. */ + +int ispunct(char c); +/* Returns 1 if c is a printing character except space or letter + or digit. */ + +int isspace(char c); +/* Returns 1 if c is a space, formfeed, newline, carriage return, + tab, or vertical tab. */ + +int isupper(char c); +/* Returns 1 if c is an upper case letter. */ + +int isxdigit(char c); +/* Returns 1 if c is a hexadecimal digit. */ + +char tolower(char c); +/* Converts c to lower case */ + +char toupper(char c); +/* Converts c to upper case */ diff --git a/SWIG/Lib/exception.i b/SWIG/Lib/exception.i new file mode 100644 index 000000000..8759c4e44 --- /dev/null +++ b/SWIG/Lib/exception.i @@ -0,0 +1,146 @@ +// +// except.i +// Dave Beazley +// April 14, 1997 +// +// This SWIG library file provides language independent exception handling + +#ifdef AUTODOC +%section "Exception Handling Library",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0 + +%text %{ +%include exception.i + +This library provides language independent support for raising scripting +language exceptions in SWIG generated wrapper code. Normally, this is +used in conjunction with the %except directive. + +To raise an exception, use the following function call : + + SWIG_exception(int exctype, char *msg); + +'exctype' is an exception type code and may be one of the following : + + SWIG_MemoryError + SWIG_IOError + SWIG_RuntimeError + SWIG_IndexError + SWIG_TypeError + SWIG_DivisionByZero + SWIG_OverflowError + SWIG_SyntaxError + SWIG_ValueError + SWIG_SystemError + SWIG_UnknownError + +'msg' is an error string that should be reported to the user. + +The library is normally used in conjunction with the %except directive +as follows : + +%except { + try { + $function + } catch RangeError { + SWIG_exception(SWIG_IndexError,"Array index out of bounds"); + } catch(...) { + SWIG_exception(SWIG_UnknownError,"Uncaught exception"); + } +} + +It is important to note that the SWIG_exception() function is only available +to the C code generated by SWIG. It is not available in the scripting language +interface itself. +%} + +#endif + +%{ +#define SWIG_MemoryError 1 +#define SWIG_IOError 2 +#define SWIG_RuntimeError 3 +#define SWIG_IndexError 4 +#define SWIG_TypeError 5 +#define SWIG_DivisionByZero 6 +#define SWIG_OverflowError 7 +#define SWIG_SyntaxError 8 +#define SWIG_ValueError 9 +#define SWIG_SystemError 10 +#define SWIG_UnknownError 99 +%} + +#ifdef SWIGTCL8 +%{ +#define SWIG_exception(a,b) Tcl_SetResult(interp,b,TCL_VOLATILE); return TCL_ERROR +%} +#else +#ifdef SWIGTCL +%{ +#define SWIG_exception(a,b) Tcl_SetResult(interp,b,TCL_VOLATILE); return TCL_ERROR +%} +#endif +#endif + +#ifdef SWIGPERL5 +%{ +#define SWIG_exception(a,b) croak(b) +%} +#endif + +#ifdef SWIGPERL4 +%{ +#define SWIG_exception(a,b) fatal(b) +%} +#endif + +#ifdef SWIGPYTHON +%{ +static void _SWIG_exception(int code, char *msg) { + switch(code) { + case SWIG_MemoryError: + PyErr_SetString(PyExc_MemoryError,msg); + break; + case SWIG_IOError: + PyErr_SetString(PyExc_IOError,msg); + break; + case SWIG_RuntimeError: + PyErr_SetString(PyExc_RuntimeError,msg); + break; + case SWIG_IndexError: + PyErr_SetString(PyExc_IndexError,msg); + break; + case SWIG_TypeError: + PyErr_SetString(PyExc_TypeError,msg); + break; + case SWIG_DivisionByZero: + PyErr_SetString(PyExc_ZeroDivisionError,msg); + break; + case SWIG_OverflowError: + PyErr_SetString(PyExc_OverflowError,msg); + break; + case SWIG_SyntaxError: + PyErr_SetString(PyExc_SyntaxError,msg); + break; + case SWIG_ValueError: + PyErr_SetString(PyExc_ValueError,msg); + break; + case SWIG_SystemError: + PyErr_SetString(PyExc_SystemError,msg); + break; + default: + PyErr_SetString(PyExc_RuntimeError,msg); + break; + } +} + +#define SWIG_exception(a,b) _SWIG_exception(a,b); return NULL +%} +#endif + +#ifdef SWIGGUILE +%echo %{ +exception.i : Guile not currently supported. +%} +#endif + + diff --git a/SWIG/Lib/guile/Makefile b/SWIG/Lib/guile/Makefile new file mode 100644 index 000000000..ff66f9efa --- /dev/null +++ b/SWIG/Lib/guile/Makefile @@ -0,0 +1,4 @@ + +co:: + co RCS/*.i* RCS/*.swg* + diff --git a/SWIG/Lib/guile/guile.swg b/SWIG/Lib/guile/guile.swg new file mode 100644 index 000000000..35649e441 --- /dev/null +++ b/SWIG/Lib/guile/guile.swg @@ -0,0 +1,15 @@ +/* ----------------------------------------------------------------------- + * swig_lib/guile/guile.swg + * + * Guile configuration file. This file assumes FSF Guile 1.0. It may not + * work with other versions + * ----------------------------------------------------------------------- */ + +#include "guile/gh.h" + +/* Since GUILE seems to be somewhat incomplete, these bindings + are used in the SWIG generated code. To change the Guile + interface, simply change this file */ + +#define GH_NOT_PASSED SCM_UNDEFINED + diff --git a/SWIG/Lib/guile/guilemain.i b/SWIG/Lib/guile/guilemain.i new file mode 100644 index 000000000..88988e9bb --- /dev/null +++ b/SWIG/Lib/guile/guilemain.i @@ -0,0 +1,21 @@ +%{ +void guile_main(void *closure, int argc, char **argv) { + char buffer[1024]; + void SWIG_init(); + SWIG_init(); + printf("starting Guile...\n"); + printf("guile >"); + while (fgets(buffer,1024,stdin)) { + gh_eval_str(buffer); + printf("guile >"); + } +} + +void main(int argc, char **argv) { + gh_enter(argc,argv, guile_main); +} +%} + + + + diff --git a/SWIG/Lib/guile/interpreter.i b/SWIG/Lib/guile/interpreter.i new file mode 100644 index 000000000..d17a721e9 --- /dev/null +++ b/SWIG/Lib/guile/interpreter.i @@ -0,0 +1,71 @@ +// +// $Header$ +// +// SWIG file for a simple Guile interpreter +// +/* Revision History + * $Log$ + * Revision 1.1 2000/01/11 21:15:50 beazley + * Added files + * + * Revision 1.1.1.1 1999/02/28 02:00:54 beazley + * Swig1.1 + * + * Revision 1.1 1996/05/22 20:02:10 beazley + * Initial revision + * + */ + +%{ + +#include +GSCM_status guile_init(); + +int main(int argc, char **argv) { + GSCM_status status; + GSCM_top_level toplev; + char *eval_answer; + char input_str[16384]; + int done; + + /* start a scheme interpreter */ + status = gscm_run_scm(argc, argv, 0, stdout, stderr, guile_init, 0, "#t"); + if (status != GSCM_OK) { + fputs(gscm_error_msg(status), stderr); + fputc('\n', stderr); + printf("Error in startup.\n"); + exit(1); + } + + /* create the top level environment */ + status = gscm_create_top_level(&toplev); + if (status != GSCM_OK) { + fputs(gscm_error_msg(status), stderr); + fputc('\n', stderr); + exit(1); + } + + /* now sit in a scheme eval loop: I input the expressions, have guile + * evaluate them, and then get another expression. + */ + done = 0; + fprintf(stdout,"Guile > "); + while (!done) { + if (fgets(input_str,16384,stdin) == NULL) { + exit(1); + } else { + if (strncmp(input_str,"quit",4) == 0) exit(1); + status = gscm_eval_str(&eval_answer, toplev, input_str); + fprintf(stdout,"%s\n", eval_answer); + fprintf(stdout,"Guile > "); + } + } + + /* now clean up and quit */ + gscm_destroy_top_level(toplev); +} + +%} + + + diff --git a/SWIG/Lib/malloc.i b/SWIG/Lib/malloc.i new file mode 100644 index 000000000..b81f9a617 --- /dev/null +++ b/SWIG/Lib/malloc.i @@ -0,0 +1,57 @@ +// +// $Header$ +// +// malloc.i +// Dave Beazley +// March 24, 1996 +// SWIG file for memory management functions +// (also contained in stdlib.i) +// +/* Revision History + * $Log$ + * Revision 1.1 2000/01/11 21:15:48 beazley + * Added files + * + * Revision 1.1.1.1 1999/02/28 02:00:53 beazley + * Swig1.1 + * + * Revision 1.1 1996/05/22 17:27:01 beazley + * Initial revision + * + */ + +%module malloc +%{ +#include +%} + +%section "Memory Allocation Module", + pre,info,after,nosort,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0,skip=1 + +%text %{ +%include malloc.i + +This module provides access to a few basic C memory management functions. +All functions return void pointers, but realloc() and free() will operate +on any sort of pointer. Sizes should be specified in bytes. +%} + +void *calloc(unsigned nobj, unsigned size); +/* Returns a pointer to a space for an array of nobj objects, each with + size bytes. Returns NULL if the request can't be satisfied. + Initializes the space to zero bytes. */ + +void *malloc(unsigned size); +/* Returns a pointer to space for an object of size bytes. Returns NULL + upon failure. */ + +void *realloc(void *ptr, unsigned size); +/* Changes the size of the object pointed to by ptr to size bytes. + The contents will be unchanged up the minimum of the old and new + sizes. Returns a pointer to the new space of NULL upon failure, + in which case *ptr is unchanged. */ + +void free(void *ptr); +/* Deallocates the space pointed to by ptr. Does nothing if ptr is NULL. + ptr must be a space previously allocated by calloc, malloc, or realloc. */ + diff --git a/SWIG/Lib/math.i b/SWIG/Lib/math.i new file mode 100644 index 000000000..bdec05e12 --- /dev/null +++ b/SWIG/Lib/math.i @@ -0,0 +1,113 @@ +// +// $Header$ +// +// math.i +// Dave Beazley +// March 24, 1996 +// SWIG file for floating point operations +// +/* Revision history + * $Log$ + * Revision 1.1 2000/01/11 21:15:48 beazley + * Added files + * + * Revision 1.1.1.1 1999/02/28 02:00:53 beazley + * Swig1.1 + * + * Revision 1.1 1996/05/22 17:27:01 beazley + * Initial revision + * + */ + +%module math +%{ +#include +%} + +%section "SWIG Math Module",after,info,nosort,pre,chop_left=3,chop_bottom=0,chop_top=0,chop_right=0,skip=1 + +%text %{ +%include math.i + +This module provides access to the C math library and contains most +of the functions in . Most scripting languages already provide +math support, but in certain cases, this module can provide more +direct access. +%} + +%subsection "Functions" + + +extern double cos(double x); +/* Cosine of x */ + +extern double sin(double x); +/* Sine of x */ + +extern double tan(double x); +/* Tangent of x */ + +extern double acos(double x); +/* Inverse cosine in range [-PI/2,PI/2], x in [-1,1]. */ + +extern double asin(double x); +/* Inverse sine in range [0,PI], x in [-1,1]. */ + +extern double atan(double x); +/* Inverse tangent in range [-PI/2,PI/2]. */ + +extern double atan2(double y, double x); +/* Inverse tangent of y/x in range [-PI,PI]. */ + +extern double cosh(double x); +/* Hyperbolic cosine of x */ + +extern double sinh(double x); +/* Hyperbolic sine of x */ + +extern double tanh(double x); +/* Hyperbolic tangent of x */ + +extern double exp(double x); +/* Natural exponential function e^x */ + +extern double log(double x); +/* Natural logarithm ln(x), x > 0 */ + +extern double log10(double x); +/* Base 10 logarithm, x > 0 */ + +extern double pow(double x, double y); +/* Power function x^y. */ + +extern double sqrt(double x); +/* Square root. x >= 0 */ + +extern double fabs(double x); +/* Absolute value of x */ + +extern double ceil(double x); +/* Smallest integer not less than x, as a double */ + +extern double floor(double x); +/* Largest integer not greater than x, as a double */ + +extern double fmod(double x, double y); +/* Floating-point remainder of x/y, with the same sign as x. */ + +%subsection "Mathematical constants",noinfo + +#define M_E 2.7182818284590452354 +#define M_LOG2E 1.4426950408889634074 +#define M_LOG10E 0.43429448190325182765 +#define M_LN2 0.69314718055994530942 +#define M_LN10 2.30258509299404568402 +#define M_PI 3.14159265358979323846 +#define M_PI_2 1.57079632679489661923 +#define M_PI_4 0.78539816339744830962 +#define M_1_PI 0.31830988618379067154 +#define M_2_PI 0.63661977236758134308 +#define M_2_SQRTPI 1.12837916709551257390 +#define M_SQRT2 1.41421356237309504880 +#define M_SQRT1_2 0.70710678118654752440 + diff --git a/SWIG/Lib/memory.i b/SWIG/Lib/memory.i new file mode 100644 index 000000000..e656325a0 --- /dev/null +++ b/SWIG/Lib/memory.i @@ -0,0 +1,39 @@ +// +// memory.i +// Dave Beazley +// November 30, 1996 +// SWIG file for memory operations +// + +%module memory +%{ +#include +%} + +%section "Memory Manipulation Module",after,info,nosort,pre,chop_left=3,chop_bottom=0,chop_top=0,chop_right=0,skip=1 + +%text %{ +%include memory.i + +This module provides support for a few memory operations from the C + library. These functions can be used to manipulate binary +data. s and t are of type void *, cs and ct are both of type const void *. +%} + +void *memcpy(void *s, const void *ct, int n); +/* Copy n characters from ct to s, and return s */ + +void *memmove(void *s, const void *ct, int n); +/* Same as memcpy except that it works even if the objects overlap. */ + +int memcmp(const void *cs, const void *ct, int n); +/* Compare the first n characters of cs with ct. Returns 0 if + they are equal, <0 if cs < ct, and >0 if cs > ct. */ + +void *memchr(const void *cs, char c, int n); +/* Returns pointer to the first occurrence of character c in cs. */ + +void *memset(void *s, char c, int n); +/* Place character c into first n characters of s, return s */ + + diff --git a/SWIG/Lib/objc.i b/SWIG/Lib/objc.i new file mode 100644 index 000000000..2655fb896 --- /dev/null +++ b/SWIG/Lib/objc.i @@ -0,0 +1,56 @@ +// SWIG Objective-C configuration file +// Dave Beazley +// Copyright (C) 1997 + +// This file provides support to Objective-C parsing and +// should be included with just about any Objective-C module + +// Base Object class + +@interface Object { } + +-(char *) name; // Get object name + +@end + +typedef Object *id; // Make 'id' behave like any other "Object" + +// Typemaps to make *id work like kind of like a void pointer + +%typemap(python,in) id { + char *temp; + if (!PyString_Check($source)) { + PyErr_SetString(PyExc_TypeError,"Expecting an 'id' in argument $argnum of $name"); + return NULL; + } + temp = PyString_AsString($source); + if (SWIG_GetPtr(temp, (void **) &$target, 0)) { + PyErr_SetString(PyExc_TypeError,"Expecting an 'id' in argument $argnum of $name"); + return NULL; + } +} + +%typemap(tcl,in) id { + if (SWIG_GetPtr($source,(void **) &$target, 0)) { + Tcl_SetResult(interp,"Expecting an 'id' in argument $argnum of $name",TCL_STATIC); + return TCL_ERROR; + } +} + +%typemap(tcl8,in) id { + if (SWIG_GetPointerObj(interp, $source, (void **) &$target, 0)) { + Tcl_SetStringObj(result_obj, "Expecting an 'id' in argument $argnum of $name"); + } +} + +%typemap(perl5,in) id { + if (SWIG_GetPtr($source, (void **) &$target, 0)) { + croak("Expecting an 'id' in argument $argnum of $name"); + } +} + + + + + + diff --git a/SWIG/Lib/perl5/Makefile.in b/SWIG/Lib/perl5/Makefile.in new file mode 100644 index 000000000..7501aeca3 --- /dev/null +++ b/SWIG/Lib/perl5/Makefile.in @@ -0,0 +1,139 @@ +# --------------------------------------------------------------- +# $Header$ +# SWIG Perl5 Makefile +# +# This file can be used to build various Perl5 extensions with SWIG. +# By default this file is set up for dynamic loading, but it can +# be easily customized for static extensions by modifying various +# portions of the file. +# +# SRCS = C source files +# CXXSRCS = C++ source files +# OBJCSRCS = Objective-C source files +# OBJS = Additional .o files (compiled previously) +# INTERFACE = SWIG interface file +# TARGET = Name of target module or executable +# +# Many portions of this file were created by the SWIG configure +# script and should already reflect your machine. +#---------------------------------------------------------------- + +SRCS = +CXXSRCS = +OBJCSRCS = +OBJS = +INTERFACE = +WRAPFILE = $(INTERFACE:.i=_wrap.c) +WRAPOBJ = $(INTERFACE:.i=_wrap.o) +TARGET = module@SO@ # Use this kind of target for dynamic loading +#TARGET = myperl # Use this target for static linking + +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +CC = @CC@ +CXX = @CXX@ +OBJC = @CC@ -Wno-import # -Wno-import needed for gcc +CFLAGS = +INCLUDE = +LIBS = + +# SWIG Options +# SWIG = location of the SWIG executable +# SWIGOPT = SWIG compiler options +# SWIGCC = Compiler used to compile the wrapper file + +SWIG = $(exec_prefix)/bin/swig +SWIGOPT = -perl5 +SWIGCC = $(CC) + +# SWIG Library files. Uncomment this to staticly rebuild Perl +#SWIGLIB = -static -lperlmain.i + +# Rules for creating .o files from source. + +COBJS = $(SRCS:.c=.o) +CXXOBJS = $(CXXSRCS:.cxx=.o) +OBJCOBJS = $(OBJCSRCS:.m=.o) +ALLOBJS = $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(OBJS) + +# Command that will be used to build the final extension. +BUILD = $(SWIGCC) + +# Uncomment the following if you are using dynamic loading +CCSHARED = @CCSHARED@ +BUILD = @LDSHARED@ + +# Uncomment the following if you are using dynamic loading with C++ and +# need to provide additional link libraries (this is not always required). + +#DLL_LIBS = -L/usr/local/lib/gcc-lib/sparc-sun-solaris2.5.1/2.7.2 \ + -L/usr/local/lib -lg++ -lstdc++ -lgcc + +# X11 installation (possibly needed if using Perl-Tk) + +XLIB = @XLIBSW@ +XINCLUDE = @XINCLUDES@ + +# Perl installation + +PERL_INCLUDE = -I@PERL5EXT@ +PERL_LIB = -L@PERL5EXT@ -lperl +PERL_FLAGS = -Dbool=char -Dexplicit= + +# Tcl installation. If using Tk you might need this + +TCL_INCLUDE = @TCLINCLUDE@ +TCL_LIB = @TCLLIB@ + +# Build libraries (needed for static builds) + +LIBM = @LIBM@ +LIBC = @LIBC@ +SYSLIBS = $(LIBM) $(LIBC) @LIBS@ + +# Build options (uncomment only one these) + +#TK_LIB = $(TCL_LIB) -ltcl -ltk $(XLIB) +BUILD_LIBS = $(LIBS) # Dynamic loading +#BUILD_LIBS = $(PERL_LIB) $(TK_LIB) $(LIBS) $(SYSLIBS) # Static linking + +# Compilation rules for non-SWIG components + +.SUFFIXES: .c .cxx .m + +.c.o: + $(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $< + +.cxx.o: + $(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $< + +.m.o: + $(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $< + + +# ---------------------------------------------------------------------- +# Rules for building the extension +# ---------------------------------------------------------------------- + +all: $(TARGET) + +# Convert the wrapper file into an object file + +$(WRAPOBJ) : $(WRAPFILE) + $(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(INCLUDE) $(PERL_INCLUDE) $(PERL_FLAGS) $(WRAPFILE) + +$(WRAPFILE) : $(INTERFACE) + $(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE) + +$(TARGET): $(WRAPOBJ) $(ALLOBJS) + $(BUILD) $(WRAPOBJ) $(ALLOBJS) $(BUILD_LIBS) -o $(TARGET) + +clean: + rm -f $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(WRAPOBJ) $(WRAPFILE) $(TARGET) + + + + + + diff --git a/SWIG/Lib/perl5/Makefile.pl b/SWIG/Lib/perl5/Makefile.pl new file mode 100644 index 000000000..05240f1e9 --- /dev/null +++ b/SWIG/Lib/perl5/Makefile.pl @@ -0,0 +1,21 @@ +# File : Makefile.pl +# MakeMaker file for a SWIG module. Use this file if you are +# producing a module for general use or distribution. +# +# 1. Modify the file as appropriate. Replace $module with the +# real name of your module and wrapper file. +# 2. Run perl as 'perl Makefile.pl' +# 3. Type 'make' to build your module +# 4. Type 'make install' to install your module. +# +# See "Programming Perl", 2nd. Ed, for more gory details than +# you ever wanted to know. + +use ExtUtils::MakeMaker; +WriteMakefile( + 'NAME' => '$module', # Name of your module + 'LIBS' => [''], # Custom libraries (if any) + 'OBJECT' => '$module_wrap.o' # Object files +); + + diff --git a/SWIG/Lib/perl5/headers.swg b/SWIG/Lib/perl5/headers.swg new file mode 100644 index 000000000..3ae8f6a9e --- /dev/null +++ b/SWIG/Lib/perl5/headers.swg @@ -0,0 +1,24 @@ +/* $Header$ */ +/* Implementation : PERL 5 */ + +#define SWIGPERL +#define SWIGPERL5 +#ifdef __cplusplus +/* Needed on some windows machines---since MS plays funny + games with the header files under C++ */ +#include +#include +extern "C" { +#endif +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +/* Get rid of free and malloc defined by perl */ +#undef free +#undef malloc + +#include +#ifdef __cplusplus +} +#endif diff --git a/SWIG/Lib/perl5/perl5.swg b/SWIG/Lib/perl5/perl5.swg new file mode 100644 index 000000000..fff1b277f --- /dev/null +++ b/SWIG/Lib/perl5/perl5.swg @@ -0,0 +1,366 @@ +/* Definitions for compiling Perl extensions on a variety of machines */ + + +#if defined(WIN32) || defined(_WIN32) || defined(__WIN32__) +# if defined(_MSC_VER) +# if defined(STATIC_LINKED) +# define SWIGEXPORT(a) a +# else +# define SWIGEXPORT(a) __declspec(dllexport) a +# endif +# else +# if defined(__BORLANDC__) +# define SWIGEXPORT(a) a _export +# else +# define SWIGEXPORT(a) a +# endif +#endif +#else +# define SWIGEXPORT(a) a +#endif + +#ifdef PERL_OBJECT +#define MAGIC_PPERL CPerlObj *pPerl = (CPerlObj *) this; +#define MAGIC_CAST (int (CPerlObj::*)(SV *, MAGIC *)) +#define SWIGCLASS_STATIC +#else +#define MAGIC_PPERL +#define MAGIC_CAST +#define SWIGCLASS_STATIC static +#endif + +#if defined(WIN32) && defined(PERL_OBJECT) && !defined(PerlIO_exportFILE) +#define PerlIO_exportFILE(fh,fl) (FILE*)(fh) +#endif + +/* Modifications for newer Perl 5.005 releases */ + +#if !defined(PERL_REVISION) || ((PERL_REVISION >= 5) && ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 50)))) +#ifndef PL_sv_yes +#define PL_sv_yes sv_yes +#endif +#ifndef PL_sv_undef +#define PL_sv_undef sv_undef +#endif +#ifndef PL_na +#define PL_na na +#endif +#endif + +/****************************************************************************** + * Pointer type-checking code + *****************************************************************************/ + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef SWIG_NOINCLUDE +extern void SWIG_MakePtr(char *, void *, char *); +#ifndef PERL_OBJECT +extern void SWIG_RegisterMapping(char *, char *, void *(*)(void *)); +#else +#define SWIG_RegisterMapping(a,b,c) _SWIG_RegisterMapping(pPerl,a,b,c); +extern void _SWIG_RegisterMapping(CPerlObj *,char *, char *, void *(*)(void *),int); +#endif +#ifndef PERL_OBJECT +extern char *SWIG_GetPtr(SV *, void **, char *); +#else +extern char *_SWIG_GetPtr(CPerlObj *, SV *, void **, char *); +#define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(pPerl,a,b,c) +#endif + +#else + +#ifdef SWIG_GLOBAL +#define SWIGSTATICRUNTIME(a) SWIGEXPORT(a) +#else +#define SWIGSTATICRUNTIME(a) static a +#endif + +/* These are internal variables. Should be static */ + +typedef struct SwigPtrType { + char *name; + int len; + void *(*cast)(void *); + struct SwigPtrType *next; +} SwigPtrType; + +/* Pointer cache structure */ + +typedef struct { + int stat; /* Status (valid) bit */ + SwigPtrType *tp; /* Pointer to type structure */ + char name[256]; /* Given datatype name */ + char mapped[256]; /* Equivalent name */ +} SwigCacheType; + +static int SwigPtrMax = 64; /* Max entries that can be currently held */ +static int SwigPtrN = 0; /* Current number of entries */ +static int SwigPtrSort = 0; /* Status flag indicating sort */ +static SwigPtrType *SwigPtrTable = 0; /* Table containing pointer equivalences */ +static int SwigStart[256]; /* Table containing starting positions */ + +/* Cached values */ + +#define SWIG_CACHESIZE 8 +#define SWIG_CACHEMASK 0x7 +static SwigCacheType SwigCache[SWIG_CACHESIZE]; +static int SwigCacheIndex = 0; +static int SwigLastCache = 0; + +/* Sort comparison function */ +static int swigsort(const void *data1, const void *data2) { + SwigPtrType *d1 = (SwigPtrType *) data1; + SwigPtrType *d2 = (SwigPtrType *) data2; + return strcmp(d1->name,d2->name); +} + +/* Binary Search function */ +static int swigcmp(const void *key, const void *data) { + char *k = (char *) key; + SwigPtrType *d = (SwigPtrType *) data; + return strncmp(k,d->name,d->len); +} + +/* Register a new datatype with the type-checker */ + +#ifndef PERL_OBJECT +SWIGSTATICRUNTIME(void) +SWIG_RegisterMapping(char *origtype, char *newtype, void *(*cast)(void *)) { +#else +#define SWIG_RegisterMapping(a,b,c) _SWIG_RegisterMapping(pPerl, a,b,c) +SWIGSTATICRUNTIME(void) +_SWIG_RegisterMapping(CPerlObj *pPerl, char *origtype, char *newtype, void *(*cast)(void *)) { +#endif + + int i; + SwigPtrType *t = 0, *t1; + + if (!SwigPtrTable) { + SwigPtrTable = (SwigPtrType *) malloc(SwigPtrMax*sizeof(SwigPtrType)); + SwigPtrN = 0; + } + if (SwigPtrN >= SwigPtrMax) { + SwigPtrMax = 2*SwigPtrMax; + SwigPtrTable = (SwigPtrType *) realloc(SwigPtrTable,SwigPtrMax*sizeof(SwigPtrType)); + } + for (i = 0; i < SwigPtrN; i++) + if (strcmp(SwigPtrTable[i].name,origtype) == 0) { + t = &SwigPtrTable[i]; + break; + } + if (!t) { + t = &SwigPtrTable[SwigPtrN]; + t->name = origtype; + t->len = strlen(t->name); + t->cast = 0; + t->next = 0; + SwigPtrN++; + } + while (t->next) { + if (strcmp(t->name,newtype) == 0) { + if (cast) t->cast = cast; + return; + } + t = t->next; + } + t1 = (SwigPtrType *) malloc(sizeof(SwigPtrType)); + t1->name = newtype; + t1->len = strlen(t1->name); + t1->cast = cast; + t1->next = 0; + t->next = t1; + SwigPtrSort = 0; +} + +/* Make a pointer value string */ + +SWIGSTATICRUNTIME(void) +SWIG_MakePtr(char *_c, const void *_ptr, char *type) { + static char _hex[16] = + {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', + 'a', 'b', 'c', 'd', 'e', 'f'}; + unsigned long _p, _s; + char _result[20], *_r; /* Note : a 64-bit hex number = 16 digits */ + _r = _result; + _p = (unsigned long) _ptr; + if (_p > 0) { + while (_p > 0) { + _s = _p & 0xf; + *(_r++) = _hex[_s]; + _p = _p >> 4; + } + *_r = '_'; + while (_r >= _result) + *(_c++) = *(_r--); + } else { + strcpy (_c, "NULL"); + } + if (_ptr) + strcpy (_c, type); +} + +/* Function for getting a pointer value */ + +#ifndef PERL_OBJECT +SWIGSTATICRUNTIME(char *) +SWIG_GetPtr(SV *sv, void **ptr, char *_t) +#else +#define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(pPerl,a,b,c) +SWIGSTATICRUNTIME(char *) +_SWIG_GetPtr(CPerlObj *pPerl, SV *sv, void **ptr, char *_t) +#endif +{ + char temp_type[256]; + char *name,*_c; + int len,i,start,end; + IV tmp; + SwigPtrType *sp,*tp; + SwigCacheType *cache; + + /* If magical, apply more magic */ + + if (SvGMAGICAL(sv)) + mg_get(sv); + + /* Check to see if this is an object */ + if (sv_isobject(sv)) { + SV *tsv = (SV*) SvRV(sv); + if ((SvTYPE(tsv) == SVt_PVHV)) { + MAGIC *mg; + if (SvMAGICAL(tsv)) { + mg = mg_find(tsv,'P'); + if (mg) { + SV *rsv = mg->mg_obj; + if (sv_isobject(rsv)) { + tmp = SvIV((SV*)SvRV(rsv)); + } + } + } else { + return "Not a valid pointer value"; + } + } else { + tmp = SvIV((SV*)SvRV(sv)); + } + if (!_t) { + *(ptr) = (void *) tmp; + return (char *) 0; + } + } else if (! SvOK(sv)) { /* Check for undef */ + *(ptr) = (void *) 0; + return (char *) 0; + } else if (SvTYPE(sv) == SVt_RV) { /* Check for NULL pointer */ + *(ptr) = (void *) 0; + if (!SvROK(sv)) + return (char *) 0; + else + return "Not a valid pointer value"; + } else { /* Don't know what it is */ + *(ptr) = (void *) 0; + return "Not a valid pointer value"; + } + if (_t) { + /* Now see if the types match */ + + if (!sv_isa(sv,_t)) { + _c = HvNAME(SvSTASH(SvRV(sv))); + if (!SwigPtrSort) { + qsort((void *) SwigPtrTable, SwigPtrN, sizeof(SwigPtrType), swigsort); + for (i = 0; i < 256; i++) { + SwigStart[i] = SwigPtrN; + } + for (i = SwigPtrN-1; i >= 0; i--) { + SwigStart[SwigPtrTable[i].name[0]] = i; + } + for (i = 255; i >= 1; i--) { + if (SwigStart[i-1] > SwigStart[i]) + SwigStart[i-1] = SwigStart[i]; + } + SwigPtrSort = 1; + for (i = 0; i < SWIG_CACHESIZE; i++) + SwigCache[i].stat = 0; + } + /* First check cache for matches. Uses last cache value as starting point */ + cache = &SwigCache[SwigLastCache]; + for (i = 0; i < SWIG_CACHESIZE; i++) { + if (cache->stat) { + if (strcmp(_t,cache->name) == 0) { + if (strcmp(_c,cache->mapped) == 0) { + cache->stat++; + *ptr = (void *) tmp; + if (cache->tp->cast) *ptr = (*(cache->tp->cast))(*ptr); + return (char *) 0; + } + } + } + SwigLastCache = (SwigLastCache+1) & SWIG_CACHEMASK; + if (!SwigLastCache) cache = SwigCache; + else cache++; + } + + start = SwigStart[_t[0]]; + end = SwigStart[_t[0]+1]; + sp = &SwigPtrTable[start]; + while (start < end) { + if (swigcmp(_t,sp) == 0) break; + sp++; + start++; + } + if (start > end) sp = 0; + while (start <= end) { + if (swigcmp(_t,sp) == 0) { + name = sp->name; + len = sp->len; + tp = sp->next; + while(tp) { + if (tp->len >= 255) { + return _c; + } + strcpy(temp_type,tp->name); + strncat(temp_type,_t+len,255-tp->len); + if (sv_isa(sv,temp_type)) { + /* Get pointer value */ + *ptr = (void *) tmp; + if (tp->cast) *ptr = (*(tp->cast))(*ptr); + + strcpy(SwigCache[SwigCacheIndex].mapped,_c); + strcpy(SwigCache[SwigCacheIndex].name,_t); + SwigCache[SwigCacheIndex].stat = 1; + SwigCache[SwigCacheIndex].tp = tp; + SwigCacheIndex = SwigCacheIndex & SWIG_CACHEMASK; + return (char *) 0; + } + tp = tp->next; + } + } + sp++; + start++; + } + /* Didn't find any sort of match for this data. + Get the pointer value and return the received type */ + *ptr = (void *) tmp; + return _c; + } else { + /* Found a match on the first try. Return pointer value */ + *ptr = (void *) tmp; + return (char *) 0; + } + } + *ptr = (void *) tmp; + return (char *) 0; +} + +#endif +#ifdef __cplusplus +} +#endif + + + + + + diff --git a/SWIG/Lib/perl5/perl5mg.swg b/SWIG/Lib/perl5/perl5mg.swg new file mode 100644 index 000000000..d5a0cfbc1 --- /dev/null +++ b/SWIG/Lib/perl5/perl5mg.swg @@ -0,0 +1,19 @@ +/* Magic variable code */ +#ifndef PERL_OBJECT +#define swig_create_magic(s,a,b,c) _swig_create_magic(s,a,b,c) +static void _swig_create_magic(SV *sv, char *name, int (*set)(SV *, MAGIC *), int (*get)(SV *,MAGIC *)) { +#else +#define swig_create_magic(s,a,b,c) _swig_create_magic(pPerl,s,a,b,c) +static void _swig_create_magic(CPerlObj *pPerl, SV *sv, char *name, int (CPerlObj::*set)(SV *, MAGIC *), int (CPerlObj::*get)(SV *, MAGIC *)) { +#endif + MAGIC *mg; + sv_magic(sv,sv,'U',name,strlen(name)); + mg = mg_find(sv,'U'); + mg->mg_virtual = (MGVTBL *) malloc(sizeof(MGVTBL)); + mg->mg_virtual->svt_get = get; + mg->mg_virtual->svt_set = set; + mg->mg_virtual->svt_len = 0; + mg->mg_virtual->svt_clear = 0; + mg->mg_virtual->svt_free = 0; +} + diff --git a/SWIG/Lib/perl5/perlmain.i b/SWIG/Lib/perl5/perlmain.i new file mode 100644 index 000000000..b6f88b926 --- /dev/null +++ b/SWIG/Lib/perl5/perlmain.i @@ -0,0 +1,80 @@ +// $Header$ +// Code to statically rebuild perl5. +// + +#ifdef AUTODOC +%subsection "perlmain.i" +%text %{ +This module provides support for building a new version of the +Perl executable. This will be necessary on systems that do +not support shared libraries and may be necessary with C++ +extensions. + +This module may only build a stripped down version of the +Perl executable. Thus, it may be necessary (or desirable) +to hand-edit this file for your particular application. To +do this, simply copy this file from swig_lib/perl5/perlmain.i +to your working directory and make the appropriate modifications. + +This library file works with Perl 5.003. It may work with earlier +versions, but it hasn't been tested. As far as I know, this +library is C++ safe. +%} +#endif + +%{ + +static void xs_init _((void)); +static PerlInterpreter *my_perl; + +int perl_eval(char *string) { + char *argv[2]; + argv[0] = string; + argv[1] = (char *) 0; + return perl_call_argv("eval",0,argv); +} + +int +main(int argc, char **argv, char **env) +{ + int exitstatus; + + my_perl = perl_alloc(); + if (!my_perl) + exit(1); + perl_construct( my_perl ); + + exitstatus = perl_parse( my_perl, xs_init, argc, argv, (char **) NULL ); + if (exitstatus) + exit( exitstatus ); + + /* Initialize all of the module variables */ + + exitstatus = perl_run( my_perl ); + + perl_destruct( my_perl ); + perl_free( my_perl ); + + exit( exitstatus ); +} + +/* Register any extra external extensions */ + +/* Do not delete this line--writemain depends on it */ +/* EXTERN_C void boot_DynaLoader _((CV* cv)); */ + +static void +xs_init() +{ +/* dXSUB_SYS; */ + char *file = __FILE__; + { + /* newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); */ + newXS(SWIG_name, SWIG_init, file); +#ifdef SWIGMODINIT + SWIGMODINIT +#endif + } +} + +%} diff --git a/SWIG/Lib/perl5/ptrlang.i b/SWIG/Lib/perl5/ptrlang.i new file mode 100644 index 000000000..a1bc88e8d --- /dev/null +++ b/SWIG/Lib/perl5/ptrlang.i @@ -0,0 +1,650 @@ +// +// SWIG pointer conversion and utility library +// +// Dave Beazley +// April 19, 1997 +// +// Perl5 specific implementation. This file is included +// by the file ../pointer.i + +%{ + +#ifdef WIN32 +#undef isspace +#define isspace(c) (c == ' ') +#endif + +/*------------------------------------------------------------------ + ptrcast(value,type) + + Constructs a new pointer value. Value may either be a string + or an integer. Type is a string corresponding to either the + C datatype or mangled datatype. + + ptrcast(0,"Vector *") + or + ptrcast(0,"Vector_p") + ------------------------------------------------------------------ */ +#ifdef PERL_OBJECT +static SV *_ptrcast(CPerlObj *pPerl, SV *_PTRVALUE, char *type) { +#define ptrcast(a,b) _ptrcast(pPerl,a,b) +#else +static SV *_ptrcast(SV *_PTRVALUE, char *type) { +#define ptrcast(a,b) _ptrcast(a,b) +#endif + char *r,*s; + void *ptr; + SV *obj; + char *typestr,*c; + + /* Produce a "mangled" version of the type string. */ + + typestr = (char *) malloc(strlen(type)+20); + + /* Go through and munge the typestring */ + + r = typestr; + c = type; + while (*c) { + if (!isspace(*c)) { + if ((*c == '*') || (*c == '&')) { + strcpy(r,"Ptr"); + r+=3; + } else *(r++) = *c; + } + c++; + } + *(r++) = 0; + + /* Check to see if the input value is an integer */ + if (SvIOK(_PTRVALUE)) { + ptr = (void *) SvIV(_PTRVALUE); + /* Received a numerical value. Make a pointer out of it */ + obj = sv_newmortal(); + sv_setref_pv(obj,typestr,ptr); + } else if (sv_isobject(_PTRVALUE)) { + /* Have a real pointer value now. Try to strip out the pointer value */ + /* Now extract the pointer value */ + if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) { + obj = sv_newmortal(); + sv_setref_pv(obj,typestr,ptr); + } + } else { + croak("ptrcast(). Not a reference."); + } + free(typestr); + return obj; +} + + + +/*------------------------------------------------------------------ + ptrvalue(ptr,type = 0) + + Attempts to dereference a pointer value. If type is given, it + will try to use that type. Otherwise, this function will attempt + to "guess" the proper datatype by checking against all of the + builtin C datatypes. + ------------------------------------------------------------------ */ + +#ifdef PERL_OBJECT +static SV *_ptrvalue(CPerlObj *pPerl,SV *_PTRVALUE, int index, char *type) { +#define ptrvalue(a,b,c) _ptrvalue(pPerl,a,b,c) +#else +static SV *_ptrvalue(SV *_PTRVALUE, int index, char *type) { +#define ptrvalue(a,b,c) _ptrvalue(a,b,c) +#endif + + void *ptr; + SV *obj = 0; + + + if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) { + croak("Type error it ptrvalue. Argument is not a valid pointer value."); + } else { + /* If no datatype was passed, try a few common datatypes first */ + if (!type) { + + /* No datatype was passed. Type to figure out if it's a common one */ + + if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) { + type = "int"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) { + type = "double"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) { + type = "short"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) { + type = "long"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) { + type = "float"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) { + type = "char"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) { + type = "char *"; + } else { + type = "unknown"; + } + } + + if (!ptr) { + croak("Unable to dereference NULL pointer."); + return 0; + } + + /* Now we have a datatype. Try to figure out what to do about it */ + if (strcmp(type,"int") == 0) { + obj = sv_newmortal(); + sv_setiv(obj,(IV) *(((int *) ptr) + index)); + } else if (strcmp(type,"double") == 0) { + obj = sv_newmortal(); + sv_setnv(obj,(double) *(((double *) ptr)+index)); + } else if (strcmp(type,"short") == 0) { + obj = sv_newmortal(); + sv_setiv(obj,(IV) *(((short *) ptr) + index)); + } else if (strcmp(type,"long") == 0) { + obj = sv_newmortal(); + sv_setiv(obj,(IV) *(((long *) ptr) + index)); + } else if (strcmp(type,"float") == 0) { + obj = sv_newmortal(); + sv_setnv(obj,(double) *(((float *) ptr)+index)); + } else if (strcmp(type,"char") == 0) { + obj = sv_newmortal(); + sv_setpv(obj,((char *) ptr)+index); + } else if (strcmp(type,"char *") == 0) { + char *c = *(((char **) ptr)+index); + obj = sv_newmortal(); + if (c) + sv_setpv(obj,c); + else + sv_setpv(obj,"NULL"); + } else { + croak("Unable to dereference unsupported datatype."); + obj = 0; + } + } + return obj; +} + +/*------------------------------------------------------------------ + ptrcreate(type,value = 0,numelements = 1) + + Attempts to create a new object of given type. Type must be + a basic C datatype. Will not create complex objects. + ------------------------------------------------------------------ */ +#ifdef PERL_OBJECT +static SV *_ptrcreate(CPerlObj *pPerl, char *type, SV *value, int numelements) { +#define ptrcreate(a,b,c) _ptrcreate(pPerl,a,b,c) +#else +static SV *_ptrcreate(char *type, SV *value, int numelements) { +#define ptrcreate(a,b,c) _ptrcreate(a,b,c) +#endif + + void *ptr; + SV *obj; + int sz; + char *cast; + char temp[40]; + + /* Check the type string against a variety of possibilities */ + + if (strcmp(type,"int") == 0) { + sz = sizeof(int)*numelements; + cast = "intPtr"; + } else if (strcmp(type,"short") == 0) { + sz = sizeof(short)*numelements; + cast = "shortPtr"; + } else if (strcmp(type,"long") == 0) { + sz = sizeof(long)*numelements; + cast = "longPtr"; + } else if (strcmp(type,"double") == 0) { + sz = sizeof(double)*numelements; + cast = "doublePtr"; + } else if (strcmp(type,"float") == 0) { + sz = sizeof(float)*numelements; + cast = "floatPtr"; + } else if (strcmp(type,"char") == 0) { + sz = sizeof(char)*numelements; + cast = "charPtr"; + } else if (strcmp(type,"char *") == 0) { + sz = sizeof(char *)*(numelements+1); + cast = "charPtrPtr"; + } else if (strcmp(type,"void") == 0) { + sz = numelements; + cast = "voidPtr"; + } else { + croak("Unable to create unknown datatype."); + return 0; + } + + /* Create the new object */ + + ptr = (void *) malloc(sz); + if (!ptr) { + croak("Out of memory in ptrcreate."); + return 0; + } + + /* Now try to set its default value */ + + if (value) { + if (strcmp(type,"int") == 0) { + int *ip,i,ivalue; + ivalue = (int) SvIV(value); + ip = (int *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"short") == 0) { + short *ip,ivalue; + int i; + ivalue = (short) SvIV(value); + ip = (short *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"long") == 0) { + long *ip,ivalue; + int i; + ivalue = (long) SvIV(value); + ip = (long *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"double") == 0) { + double *ip,ivalue; + int i; + ivalue = (double) SvNV(value); + ip = (double *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"float") == 0) { + float *ip,ivalue; + int i; + ivalue = (float) SvNV(value); + ip = (float *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"char") == 0) { + char *ip,*ivalue; + ivalue = (char *) SvPV(value,PL_na); + ip = (char *) ptr; + strncpy(ip,ivalue,numelements-1); + } else if (strcmp(type,"char *") == 0) { + char **ip, *ivalue; + int i; + ivalue = (char *) SvPV(value,PL_na); + ip = (char **) ptr; + for (i = 0; i < numelements; i++) { + if (ivalue) { + ip[i] = (char *) malloc(strlen(ivalue)+1); + strcpy(ip[i],ivalue); + } else { + ip[i] = 0; + } + } + ip[numelements] = 0; + } + } + /* Create the pointer value */ + + SWIG_MakePtr(temp,ptr,cast); + obj = sv_newmortal(); + sv_setref_pv(obj,cast,ptr); + return obj; +} + +/*------------------------------------------------------------------ + ptrset(ptr,value,index = 0,type = 0) + + Attempts to set the value of a pointer variable. If type is + given, we will use that type. Otherwise, we'll guess the datatype. + ------------------------------------------------------------------ */ + +#ifdef PERL_OBJECT +static void _ptrset(CPerlObj *pPerl,SV *_PTRVALUE, SV *value, int index, char *type) { +#define ptrset(a,b,c,d) _ptrset(pPerl,a,b,c,d) +#else +static void _ptrset(SV *_PTRVALUE, SV *value, int index, char *type) { +#define ptrset(a,b,c,d) _ptrset(a,b,c,d) +#endif + void *ptr; + SV *obj; + + if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) { + croak("Type error in ptrset. Argument is not a valid pointer value."); + return; + } + + /* If no datatype was passed, try a few common datatypes first */ + + if (!type) { + + /* No datatype was passed. Type to figure out if it's a common one */ + + if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) { + type = "int"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) { + type = "double"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) { + type = "short"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) { + type = "long"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) { + type = "float"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) { + type = "char"; + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtrPtr")) { + type = "char *"; + } else { + type = "unknown"; + } + } + + if (!ptr) { + croak("Unable to set NULL pointer."); + return; + } + + /* Now we have a datatype. Try to figure out what to do about it */ + if (strcmp(type,"int") == 0) { + *(((int *) ptr)+index) = (int) SvIV(value); + } else if (strcmp(type,"double") == 0) { + *(((double *) ptr)+index) = (double) SvNV(value); + } else if (strcmp(type,"short") == 0) { + *(((short *) ptr)+index) = (short) SvIV(value); + } else if (strcmp(type,"long") == 0) { + *(((long *) ptr)+index) = (long) SvIV(value); + } else if (strcmp(type,"float") == 0) { + *(((float *) ptr)+index) = (float) SvNV(value); + } else if (strcmp(type,"char") == 0) { + char *c = SvPV(value,PL_na); + strcpy(((char *) ptr)+index, c); + } else if (strcmp(type,"char *") == 0) { + char *c = SvPV(value,PL_na); + char **ca = (char **) ptr; + if (ca[index]) free(ca[index]); + if (strcmp(c,"NULL") == 0) { + ca[index] = 0; + } else { + ca[index] = (char *) malloc(strlen(c)+1); + strcpy(ca[index],c); + } + } else { + croak("Unable to set unsupported datatype."); + return; + } +} + +/*------------------------------------------------------------------ + ptradd(ptr,offset) + + Adds a value to an existing pointer value. Will do a type-dependent + add for basic datatypes. For other datatypes, will do a byte-add. + ------------------------------------------------------------------ */ + +#ifdef PERL_OBJECT +static SV *_ptradd(CPerlObj *pPerl, SV *_PTRVALUE, int offset) { +#define ptradd(a,b) _ptradd(pPerl,a,b) +#else +static SV *_ptradd(SV *_PTRVALUE, int offset) { +#define ptradd(a,b) _ptradd(a,b) +#endif + + void *ptr,*junk; + SV *obj; + char *type; + + /* Try to handle a few common datatypes first */ + + if (!SWIG_GetPtr(_PTRVALUE,&ptr,"intPtr")) { + ptr = (void *) (((int *) ptr) + offset); + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"doublePtr")) { + ptr = (void *) (((double *) ptr) + offset); + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"shortPtr")) { + ptr = (void *) (((short *) ptr) + offset); + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"longPtr")) { + ptr = (void *) (((long *) ptr) + offset); + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"floatPtr")) { + ptr = (void *) (((float *) ptr) + offset); + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,"charPtr")) { + ptr = (void *) (((char *) ptr) + offset); + } else if (!SWIG_GetPtr(_PTRVALUE,&ptr,0)) { + ptr = (void *) (((char *) ptr) + offset); + } else { + croak("Type error in ptradd. Argument is not a valid pointer value."); + return 0; + } + type = SWIG_GetPtr(_PTRVALUE,&junk,"INVALID POINTER"); + obj = sv_newmortal(); + sv_setref_pv(obj,type,ptr); + return obj; +} + +/*------------------------------------------------------------------ + ptrmap(type1,type2) + + Allows a mapping between type1 and type2. (Like a typedef) + ------------------------------------------------------------------ */ + +#ifdef PERL_OBJECT +static void _ptrmap(CPerlObj *pPerl,char *type1, char *type2) { +#define ptrmap(a,b) _ptrmap(pPerl,a,b) +#else +static void _ptrmap(char *type1, char *type2) { +#define ptrmap(a,b) _ptrmap(a,b) +#endif + char *typestr1,*typestr2,*c,*r; + /* Produce a "mangled" version of the type string. */ + + typestr1 = (char *) malloc(strlen(type1)+20); + + + /* Go through and munge the typestring */ + + r = typestr1; + *(r++) = '_'; + c = type1; + + while (*c) { + if (!isspace(*c)) { + if ((*c == '*') || (*c == '&')) { + strcpy(r,"Ptr"); + r+=3; + } + else *(r++) = *c; + } + c++; + } + *(r++) = 0; + + typestr2 = (char *) malloc(strlen(type2)+20); + + /* Go through and munge the typestring */ + + r = typestr2; + *(r++) = '_'; + c = type2; + while (*c) { + if (!isspace(*c)) { + if ((*c == '*') || (*c == '&')) { + strcpy(r,"Ptr"); + r+=3; + } + else *(r++) = *c; + } + c++; + } + *(r++) = 0; + SWIG_RegisterMapping(typestr1,typestr2,0); + SWIG_RegisterMapping(typestr2,typestr1,0); +} + +/*------------------------------------------------------------------ + ptrfree(ptr) + + Destroys a pointer value + ------------------------------------------------------------------ */ +#ifdef PERL_OBJECT +void _ptrfree(CPerlObj *pPerl, SV *_PTRVALUE) { +#define ptrfree(a) _ptrfree(pPerl, a) +#else +void _ptrfree(SV *_PTRVALUE) { +#define ptrfree(a) _ptrfree(a) +#endif + + void *ptr, *junk; + + if (SWIG_GetPtr(_PTRVALUE,&ptr,0)) { + croak("Type error in ptrfree. Argument is not a valid pointer value."); + return; + } + + /* Check to see if this pointer is a char ** */ + if (!SWIG_GetPtr(_PTRVALUE,&junk,"charPtrPtr")) { + char **c = (char **) ptr; + if (c) { + int i = 0; + while (c[i]) { + free(c[i]); + i++; + } + } + } + if (ptr) + free((char *) ptr); +} + +%} + +%typemap(perl5,in) SV *ptr, SV *value { + $target = $source; +} + + +%typemap(perl5,out) SV *ptrcast, + SV *ptrvalue, + SV *ptrcreate, + SV *ptradd +{ + $target = $source; + argvi++; +} + +%typemap(perl5,ret) int ptrset { + if ($source == -1) return NULL; +} + +SV *ptrcast(SV *ptr, char *type); +// Casts a pointer ptr to a new datatype given by the string type. +// type may be either the SWIG generated representation of a datatype +// or the C representation. For example : +// +// ptrcast($ptr,"doublePtr"); # Perl5 representation +// ptrcast($ptr,"double *"); # C representation +// +// A new pointer value is returned. ptr may also be an integer +// value in which case the value will be used to set the pointer +// value. For example : +// +// $a = ptrcast(0,"VectorPtr"); +// +// Will create a NULL pointer of type "VectorPtr" +// +// The casting operation is sensitive to formatting. As a result, +// "double *" is different than "double*". As a result of thumb, +// there should always be exactly one space between the C datatype +// and any pointer specifiers (*). + +SV *ptrvalue(SV *ptr, int index = 0, char *type = 0); +// Returns the value that a pointer is pointing to (ie. dereferencing). +// The type is automatically inferred by the pointer type--thus, an +// integer pointer will return an integer, a double will return a double, +// and so on. The index and type fields are optional parameters. When +// an index is specified, this function returns the value of ptr[index]. +// This allows array access. When a type is specified, it overrides +// the given pointer type. Examples : +// +// ptrvalue($a) # Returns the value *a +// ptrvalue($a,10) # Returns the value a[10] +// ptrvalue($a,10,"double") # Returns a[10] assuming a is a double * + + +void ptrset(SV *ptr, SV *value, int index = 0, char *type = 0); +// Sets the value pointed to by a pointer. The type is automatically +// inferred from the pointer type so this function will work for +// integers, floats, doubles, etc... The index and type fields are +// optional. When an index is given, it provides array access. When +// type is specified, it overrides the given pointer type. Examples : +// +// ptrset($a,3) # Sets the value *a = 3 +// ptrset($a,3,10) # Sets a[10] = 3 +// ptrset($a,3,10,"int") # Sets a[10] = 3 assuming a is a int * + + +SV *ptrcreate(char *type, SV *value = 0, int nitems = 1); +// Creates a new object and returns a pointer to it. This function +// can be used to create various kinds of objects for use in C functions. +// type specifies the basic C datatype to create and value is an +// optional parameter that can be used to set the initial value of the +// object. nitems is an optional parameter that can be used to create +// an array. This function results in a memory allocation using +// malloc(). Examples : +// +// $a = ptrcreate("double") # Create a new double, return pointer +// $a = ptrcreate("int",7) # Create an integer, set value to 7 +// $a = ptrcreate("int",0,1000) # Create an integer array with initial +// # values all set to zero +// +// This function only recognizes a few common C datatypes as listed below : +// +// int, short, long, float, double, char, char *, void +// +// All other datatypes will result in an error. However, other +// datatypes can be created by using the ptrcast function. For +// example: +// +// $a = ptrcast(ptrcreate("int",0,100),"unsigned int *") + + +void ptrfree(SV *ptr); +// Destroys the memory pointed to by ptr. This function calls free() +// and should only be used with objects created by ptrcreate(). Since +// this function calls free, it may work with other objects, but this +// is generally discouraged unless you absolutely know what you're +// doing. + +SV *ptradd(SV *ptr, int offset); +// Adds a value to the current pointer value. For the C datatypes of +// int, short, long, float, double, and char, the offset value is the +// number of objects and works in exactly the same manner as in C. For +// example, the following code steps through the elements of an array +// +// $a = ptrcreate("double",0,100); # Create an array double a[100] +// $b = $a; +// for ($i = 0; $i < 100; $i++) { +// ptrset($b,0.0025*$i); # set *b = 0.0025*i +// $b = ptradd($b,1); # b++ (go to next double) +// } +// +// In this case, adding one to b goes to the next double. +// +// For all other datatypes (including all complex datatypes), the +// offset corresponds to bytes. This function does not perform any +// bounds checking and negative offsets are perfectly legal. + +void ptrmap(char *type1, char *type2); +// This is a rarely used function that performs essentially the same +// operation as a C typedef. To manage datatypes at run-time, SWIG +// modules manage an internal symbol table of type mappings. This +// table keeps track of which types are equivalent to each other. The +// ptrmap() function provides a mechanism for scripts to add symbols +// to this table. For example : +// +// ptrmap("doublePtr","RealPtr"); +// +// would make the types "doublePtr" and "RealPtr" equivalent to each +// other. Pointers of either type could now be used interchangably. +// +// Normally this function is not needed, but it can be used to +// circumvent SWIG's normal type-checking behavior or to work around +// weird type-handling problems. + + + diff --git a/SWIG/Lib/perl5/typemaps.i b/SWIG/Lib/perl5/typemaps.i new file mode 100644 index 000000000..ff0b5ae39 --- /dev/null +++ b/SWIG/Lib/perl5/typemaps.i @@ -0,0 +1,475 @@ +// +// SWIG Typemap library +// Dave Beazley +// May 5, 1997 +// +// Perl5 implementation +// +// This library provides standard typemaps for modifying SWIG's behavior. +// With enough entries in this file, I hope that very few people actually +// ever need to write a typemap. +// + +#ifdef AUTODOC +%section "Typemap Library (Perl 5)",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0 +%text %{ +%include typemaps.i + +The SWIG typemap library provides a language independent mechanism for +supporting output arguments, input values, and other C function +calling mechanisms. The primary use of the library is to provide a +better interface to certain C function--especially those involving +pointers. +%} + +#endif + +// ------------------------------------------------------------------------ +// Pointer handling +// +// These mappings provide support for input/output arguments and common +// uses for C/C++ pointers. +// ------------------------------------------------------------------------ + +// INPUT typemaps. +// These remap a C pointer to be an "INPUT" value which is passed by value +// instead of reference. + + +#ifdef AUTODOC +%subsection "Input Methods" + +%text %{ +The following methods can be applied to turn a pointer into a simple +"input" value. That is, instead of passing a pointer to an object, +you would use a real value instead. + + int *INPUT + short *INPUT + long *INPUT + unsigned int *INPUT + unsigned short *INPUT + unsigned long *INPUT + unsigned char *INPUT + float *INPUT + double *INPUT + +To use these, suppose you had a C function like this : + + double fadd(double *a, double *b) { + return *a+*b; + } + +You could wrap it with SWIG as follows : + + %include typemaps.i + double fadd(double *INPUT, double *INPUT); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *INPUT { double *a, double *b }; + double fadd(double *a, double *b); + +%} +#endif + +%typemap(perl5,in) double *INPUT(double temp) +{ + temp = (double) SvNV($source); + $target = &temp; +} + +%typemap(perl5,in) float *INPUT(float temp) +{ + temp = (float) SvNV($source); + $target = &temp; +} + +%typemap(perl5,in) int *INPUT(int temp) +{ + temp = (int) SvIV($source); + $target = &temp; +} + +%typemap(perl5,in) short *INPUT(short temp) +{ + temp = (short) SvIV($source); + $target = &temp; +} + +%typemap(perl5,in) long *INPUT(long temp) +{ + temp = (long) SvIV($source); + $target = &temp; +} +%typemap(perl5,in) unsigned int *INPUT(unsigned int temp) +{ + temp = (unsigned int) SvIV($source); + $target = &temp; +} +%typemap(perl5,in) unsigned short *INPUT(unsigned short temp) +{ + temp = (unsigned short) SvIV($source); + $target = &temp; +} +%typemap(perl5,in) unsigned long *INPUT(unsigned long temp) +{ + temp = (unsigned long) SvIV($source); + $target = &temp; +} +%typemap(perl5,in) unsigned char *INPUT(unsigned char temp) +{ + temp = (unsigned char) SvIV($source); + $target = &temp; +} + +// OUTPUT typemaps. These typemaps are used for parameters that +// are output only. The output value is appended to the result as +// a list element. + + +#ifdef AUTODOC +%subsection "Output Methods" + +%text %{ +The following methods can be applied to turn a pointer into an "output" +value. When calling a function, no input value would be given for +a parameter, but an output value would be returned. In the case of +multiple output values, functions will return a Perl array. + + int *OUTPUT + short *OUTPUT + long *OUTPUT + unsigned int *OUTPUT + unsigned short *OUTPUT + unsigned long *OUTPUT + unsigned char *OUTPUT + float *OUTPUT + double *OUTPUT + +For example, suppose you were trying to wrap the modf() function in the +C math library which splits x into integral and fractional parts (and +returns the integer part in one of its parameters).K: + + double modf(double x, double *ip); + +You could wrap it with SWIG as follows : + + %include typemaps.i + double modf(double x, double *OUTPUT); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *OUTPUT { double *ip }; + double modf(double x, double *ip); + +The Perl output of the function would be an array containing both +output values. + +%} + +#endif + +// Force the argument to be ignored. + +%typemap(perl5,ignore) int *OUTPUT(int temp), + short *OUTPUT(short temp), + long *OUTPUT(long temp), + unsigned int *OUTPUT(unsigned int temp), + unsigned short *OUTPUT(unsigned short temp), + unsigned long *OUTPUT(unsigned long temp), + unsigned char *OUTPUT(unsigned char temp), + float *OUTPUT(float temp), + double *OUTPUT(double temp) +{ + $target = &temp; +} + +%typemap(perl5,argout) int *OUTPUT, + short *OUTPUT, + long *OUTPUT, + unsigned int *OUTPUT, + unsigned short *OUTPUT, + unsigned long *OUTPUT, + unsigned char *OUTPUT +{ + if (argvi >= items) { + EXTEND(sp,1); + } + $target = sv_newmortal(); + sv_setiv($target,(IV) *($source)); + argvi++; +} + +%typemap(perl5,argout) float *OUTPUT, + double *OUTPUT +{ + if (argvi >= items) { + EXTEND(sp,1); + } + $target = sv_newmortal(); + sv_setnv($target,(double) *($source)); + argvi++; +} + +// BOTH +// Mappings for an argument that is both an input and output +// parameter + + +#ifdef AUTODOC +%subsection "Input/Output Methods" + +%text %{ +The following methods can be applied to make a function parameter both +an input and output value. This combines the behavior of both the +"INPUT" and "OUTPUT" methods described earlier. Output values are +returned in the form of a Tcl list. + + int *BOTH + short *BOTH + long *BOTH + unsigned int *BOTH + unsigned short *BOTH + unsigned long *BOTH + unsigned char *BOTH + float *BOTH + double *BOTH + +For example, suppose you were trying to wrap the following function : + + void neg(double *x) { + *x = -(*x); + } + +You could wrap it with SWIG as follows : + + %include typemaps.i + void neg(double *BOTH); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *BOTH { double *x }; + void neg(double *x); + +Unlike C, this mapping does not directly modify the input value. +Rather, the modified input value shows up as the return value of the +function. Thus, to apply this function to a Perl variable you might +do this : + + $x = neg($x); + +%} + +#endif + +%typemap(perl5,in) int *BOTH = int *INPUT; +%typemap(perl5,in) short *BOTH = short *INPUT; +%typemap(perl5,in) long *BOTH = long *INPUT; +%typemap(perl5,in) unsigned *BOTH = unsigned *INPUT; +%typemap(perl5,in) unsigned short *BOTH = unsigned short *INPUT; +%typemap(perl5,in) unsigned long *BOTH = unsigned long *INPUT; +%typemap(perl5,in) unsigned char *BOTH = unsigned char *INPUT; +%typemap(perl5,in) float *BOTH = float *INPUT; +%typemap(perl5,in) double *BOTH = double *INPUT; + +%typemap(perl5,argout) int *BOTH = int *OUTPUT; +%typemap(perl5,argout) short *BOTH = short *OUTPUT; +%typemap(perl5,argout) long *BOTH = long *OUTPUT; +%typemap(perl5,argout) unsigned *BOTH = unsigned *OUTPUT; +%typemap(perl5,argout) unsigned short *BOTH = unsigned short *OUTPUT; +%typemap(perl5,argout) unsigned long *BOTH = unsigned long *OUTPUT; +%typemap(perl5,argout) unsigned char *BOTH = unsigned char *OUTPUT; +%typemap(perl5,argout) float *BOTH = float *OUTPUT; +%typemap(perl5,argout) double *BOTH = double *OUTPUT; + +// REFERENCE +// Accept Perl references as pointers + + +#ifdef AUTODOC +%subsection "Reference Methods" + +%text %{ +The following methods make Perl references work like simple C +pointers. References can only be used for simple input/output +values, not C arrays however. It should also be noted that +REFERENCES are specific to Perl and not supported in other +scripting languages at this time. + + int *REFERENCE + short *REFERENCE + long *REFERENCE + unsigned int *REFERENCE + unsigned short *REFERENCE + unsigned long *REFERENCE + unsigned char *REFERENCE + float *REFERENCE + double *REFERENCE + +For example, suppose you were trying to wrap the following function : + + void neg(double *x) { + *x = -(*x); + } + +You could wrap it with SWIG as follows : + + %include typemaps.i + void neg(double *REFERENCE); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *REFERENCE { double *x }; + void neg(double *x); + +Unlike the BOTH mapping described previous, this approach directly +modifies the value of a Perl reference. Thus, you could use it +as follows : + + $x = 3; + neg(\$x); + print "$x\n"; # Should print out -3. +%} + +#endif + +%typemap(perl5,in) double *REFERENCE (double dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if ((!SvNOK(tempsv)) && (!SvIOK(tempsv))) { + printf("Received %d\n", SvTYPE(tempsv)); + croak("Expected a double reference."); + } + dvalue = SvNV(tempsv); + $target = &dvalue; +} + +%typemap(perl5,in) float *REFERENCE (float dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if ((!SvNOK(tempsv)) && (!SvIOK(tempsv))) { + croak("expected a double reference"); + } + dvalue = (float) SvNV(tempsv); + $target = &dvalue; +} + +%typemap(perl5,in) int *REFERENCE (int dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if (!SvIOK(tempsv)) { + croak("expected a integer reference"); + } + dvalue = SvIV(tempsv); + $target = &dvalue; +} + +%typemap(perl5,in) short *REFERENCE (short dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if (!SvIOK(tempsv)) { + croak("expected a integer reference"); + } + dvalue = (short) SvIV(tempsv); + $target = &dvalue; +} +%typemap(perl5,in) long *REFERENCE (long dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if (!SvIOK(tempsv)) { + croak("expected a integer reference"); + } + dvalue = (long) SvIV(tempsv); + $target = &dvalue; +} +%typemap(perl5,in) unsigned int *REFERENCE (unsigned int dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if (!SvIOK(tempsv)) { + croak("expected a integer reference"); + } + dvalue = (unsigned int) SvIV(tempsv); + $target = &dvalue; +} +%typemap(perl5,in) unsigned short *REFERENCE (unsigned short dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if (!SvIOK(tempsv)) { + croak("expected a integer reference"); + } + dvalue = (unsigned short) SvIV(tempsv); + $target = &dvalue; +} +%typemap(perl5,in) unsigned long *REFERENCE (unsigned long dvalue) +{ + SV *tempsv; + if (!SvROK($source)) { + croak("expected a reference"); + } + tempsv = SvRV($source); + if (!SvIOK(tempsv)) { + croak("expected a integer reference"); + } + dvalue = (unsigned long) SvIV(tempsv); + $target = &dvalue; +} + +%typemap(perl5,argout) double *REFERENCE, + float *REFERENCE +{ + SV *tempsv; + tempsv = SvRV($arg); + sv_setnv(tempsv, (double) *$source); +} + +%typemap(perl5,argout) int *REFERENCE, + short *REFERENCE, + long *REFERENCE, + unsigned int *REFERENCE, + unsigned short *REFERENCE, + unsigned long *REFERENCE +{ + SV *tempsv; + tempsv = SvRV($arg); + sv_setiv(tempsv, (int) *$source); +} + +// -------------------------------------------------------------------- +// Special types +// +// -------------------------------------------------------------------- + + diff --git a/SWIG/Lib/pointer.i b/SWIG/Lib/pointer.i new file mode 100644 index 000000000..04ad28844 --- /dev/null +++ b/SWIG/Lib/pointer.i @@ -0,0 +1,58 @@ +// +// SWIG Pointer manipulation library +// +// This library can be used to manipulate C pointers. +%title "SWIG Pointer Library" + +%module pointer + + +%section "Pointer Handling Library",noinfo,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0 + +%text %{ +%include pointer.i + +The pointer.i library provides run-time support for managing and +manipulating a variety of C/C++ pointer values. In particular, +you can create various kinds of objects and dereference common +pointer types. This is done through a common set of functions: + + ptrcast - Casts a pointer to a new type + ptrvalue - Dereferences a pointer + ptrset - Set the value of an object referenced by + a pointer. + ptrcreate - Create a new object and return a pointer. + ptrfree - Free the memory allocated by ptrcreate. + ptradd - Increment/decrement a pointer value. + ptrmap - Make two datatypes equivalent to each other. + (Is a runtime equivalent of typedef). + +When creating, dereferencing, or setting the value of pointer +variable, only the common C datatypes of int, short, long, float, +double, char, and char * are currently supported. Other +datatypes may generate an error. + +One of the more interesting aspects of this library is that +it operates with a wide range of datatypes. For example, +the "ptrvalue" function can dereference "double *", "int *", +"long *", "char *", and other datatypes. Since SWIG encodes +pointers with type information, this can be done transparently +and in most cases, you can dereference a pointer without +ever knowing what type it actually is. + +This library is primarily designed for utility, not high +performance (the dynamic determination of pointer types takes +more work than most normal wrapper functions). As a result, +you may achieve better performance by writing customized +"helper" functions if you're making lots of calls to these +functions in inner loops or other intensive operations. +%} + +// This library is a pretty hideous mess of language dependent code. +// Grab the implementation from the appropriate libray + +%include ptrlang.i + + + + diff --git a/SWIG/Lib/stdlib.i b/SWIG/Lib/stdlib.i new file mode 100644 index 000000000..41137060a --- /dev/null +++ b/SWIG/Lib/stdlib.i @@ -0,0 +1,43 @@ +// +// $Header$ +// +// stdlib.i +// Dave Beazley +// March 24, 1996 +// SWIG file for some C stdlib functions +// +/* Revision history + * $Log$ + * Revision 1.1 2000/01/11 21:15:49 beazley + * Added files + * + * Revision 1.1.1.1 1999/02/28 02:00:53 beazley + * Swig1.1 + * + * Revision 1.1 1996/05/22 17:27:01 beazley + * Initial revision + * + */ + +%module stdlib +%{ +#include +%} + +typedef unsigned int size_t; + +double atof(const char *s); +int atoi(const char *s); +long atol(const char *s); +int rand(); +void srand(unsigned int seed); +void *calloc(size_t nobj, size_t size); +void *malloc(size_t size); +void *realloc(void *ptr, size_t size); +void free(void *ptr); +void abort(void); +int system(const char *s); +char *getenv(const char *name); +int abs(int n); +long labs(long n); + diff --git a/SWIG/Lib/swigptr.swg b/SWIG/Lib/swigptr.swg new file mode 100644 index 000000000..ed8de62d7 --- /dev/null +++ b/SWIG/Lib/swigptr.swg @@ -0,0 +1,326 @@ +/***************************************************************************** + * $Header$ + * + * swigptr.swg + * + * This file contains supporting code for the SWIG run-time type checking + * mechanism. The following functions are available : + * + * SWIG_RegisterMapping(char *origtype, char *newtype, void *(*cast)(void *)); + * + * Registers a new type-mapping with the type-checker. origtype is the + * original datatype and newtype is an equivalent type. cast is optional + * pointer to a function to cast pointer values between types (this + * is typically used to cast pointers from derived classes to base classes in C++) + * + * SWIG_MakePtr(char *buffer, void *ptr, char *typestring); + * + * Makes a pointer string from a pointer and typestring. The result is returned + * in buffer which is assumed to hold enough space for the result. + * + * char * SWIG_GetPtr(char *buffer, void **ptr, char *type) + * + * Gets a pointer value from a string. If there is a type-mismatch, returns + * a character string to the received type. On success, returns NULL. + * + * + * You can remap these functions by making a file called "swigptr.swg" in + * your the same directory as the interface file you are wrapping. + * + * These functions are normally declared static, but this file can be + * can be used in a multi-module environment by redefining the symbol + * SWIGSTATIC. + *****************************************************************************/ + +#include + +#ifdef __cplusplus +extern "C" { +#endif + +#ifdef SWIG_GLOBAL +#define SWIGSTATIC +#endif + +#ifndef SWIGSTATIC +#define SWIGSTATIC static +#endif + + + +/* SWIG pointer structure */ + +typedef struct SwigPtrType { + char *name; /* Datatype name */ + int len; /* Length (used for optimization) */ + void *(*cast)(void *); /* Pointer casting function */ + struct SwigPtrType *next; /* Linked list pointer */ +} SwigPtrType; + +/* Pointer cache structure */ + +typedef struct { + int stat; /* Status (valid) bit */ + SwigPtrType *tp; /* Pointer to type structure */ + char name[256]; /* Given datatype name */ + char mapped[256]; /* Equivalent name */ +} SwigCacheType; + +/* Some variables */ + +static int SwigPtrMax = 64; /* Max entries that can be currently held */ + /* This value may be adjusted dynamically */ +static int SwigPtrN = 0; /* Current number of entries */ +static int SwigPtrSort = 0; /* Status flag indicating sort */ +static int SwigStart[256]; /* Starting positions of types */ + +/* Pointer table */ +static SwigPtrType *SwigPtrTable = 0; /* Table containing pointer equivalences */ + +/* Cached values */ + +#define SWIG_CACHESIZE 8 +#define SWIG_CACHEMASK 0x7 +static SwigCacheType SwigCache[SWIG_CACHESIZE]; +static int SwigCacheIndex = 0; +static int SwigLastCache = 0; + +/* Sort comparison function */ +static int swigsort(const void *data1, const void *data2) { + SwigPtrType *d1 = (SwigPtrType *) data1; + SwigPtrType *d2 = (SwigPtrType *) data2; + return strcmp(d1->name,d2->name); +} + +/* Binary Search function */ +static int swigcmp(const void *key, const void *data) { + char *k = (char *) key; + SwigPtrType *d = (SwigPtrType *) data; + return strncmp(k,d->name,d->len); +} + +/* Register a new datatype with the type-checker */ + +SWIGSTATIC +void SWIG_RegisterMapping(char *origtype, char *newtype, void *(*cast)(void *)) { + + int i; + SwigPtrType *t = 0,*t1; + + /* Allocate the pointer table if necessary */ + + if (!SwigPtrTable) { + SwigPtrTable = (SwigPtrType *) malloc(SwigPtrMax*sizeof(SwigPtrType)); + SwigPtrN = 0; + } + /* Grow the table */ + if (SwigPtrN >= SwigPtrMax) { + SwigPtrMax = 2*SwigPtrMax; + SwigPtrTable = (SwigPtrType *) realloc((char *) SwigPtrTable,SwigPtrMax*sizeof(SwigPtrType)); + } + for (i = 0; i < SwigPtrN; i++) + if (strcmp(SwigPtrTable[i].name,origtype) == 0) { + t = &SwigPtrTable[i]; + break; + } + if (!t) { + t = &SwigPtrTable[SwigPtrN]; + t->name = origtype; + t->len = strlen(t->name); + t->cast = 0; + t->next = 0; + SwigPtrN++; + } + + /* Check for existing entry */ + + while (t->next) { + if ((strcmp(t->name,newtype) == 0)) { + if (cast) t->cast = cast; + return; + } + t = t->next; + } + + /* Now place entry (in sorted order) */ + + t1 = (SwigPtrType *) malloc(sizeof(SwigPtrType)); + t1->name = newtype; + t1->len = strlen(t1->name); + t1->cast = cast; + t1->next = 0; + t->next = t1; + SwigPtrSort = 0; +} + +/* Make a pointer value string */ + +SWIGSTATIC +void SWIG_MakePtr(char *_c, const void *_ptr, char *type) { + static char _hex[16] = + {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', + 'a', 'b', 'c', 'd', 'e', 'f'}; + unsigned long _p, _s; + char _result[20], *_r; /* Note : a 64-bit hex number = 16 digits */ + _r = _result; + _p = (unsigned long) _ptr; + if (_p > 0) { + while (_p > 0) { + _s = _p & 0xf; + *(_r++) = _hex[_s]; + _p = _p >> 4; + } + *_r = '_'; + while (_r >= _result) + *(_c++) = *(_r--); + } else { + strcpy (_c, "NULL"); + } + if (_ptr) + strcpy (_c, type); +} + +/* Define for backwards compatibility */ + +#define _swig_make_hex SWIG_MakePtr + +/* Function for getting a pointer value */ + +SWIGSTATIC +char *SWIG_GetPtr(char *_c, void **ptr, char *_t) +{ + unsigned long _p; + char temp_type[256]; + char *name; + int i, len; + SwigPtrType *sp,*tp; + SwigCacheType *cache; + int start, end; + _p = 0; + + /* Pointer values must start with leading underscore */ + if (*_c == '_') { + _c++; + /* Extract hex value from pointer */ + while (*_c) { + if ((*_c >= '0') && (*_c <= '9')) + _p = (_p << 4) + (*_c - '0'); + else if ((*_c >= 'a') && (*_c <= 'f')) + _p = (_p << 4) + ((*_c - 'a') + 10); + else + break; + _c++; + } + + if (_t) { + if (strcmp(_t,_c)) { + if (!SwigPtrSort) { + qsort((void *) SwigPtrTable, SwigPtrN, sizeof(SwigPtrType), swigsort); + for (i = 0; i < 256; i++) { + SwigStart[i] = SwigPtrN; + } + for (i = SwigPtrN-1; i >= 0; i--) { + SwigStart[(int) (SwigPtrTable[i].name[1])] = i; + } + for (i = 255; i >= 1; i--) { + if (SwigStart[i-1] > SwigStart[i]) + SwigStart[i-1] = SwigStart[i]; + } + SwigPtrSort = 1; + for (i = 0; i < SWIG_CACHESIZE; i++) + SwigCache[i].stat = 0; + } + + /* First check cache for matches. Uses last cache value as starting point */ + cache = &SwigCache[SwigLastCache]; + for (i = 0; i < SWIG_CACHESIZE; i++) { + if (cache->stat) { + if (strcmp(_t,cache->name) == 0) { + if (strcmp(_c,cache->mapped) == 0) { + cache->stat++; + *ptr = (void *) _p; + if (cache->tp->cast) *ptr = (*(cache->tp->cast))(*ptr); + return (char *) 0; + } + } + } + SwigLastCache = (SwigLastCache+1) & SWIG_CACHEMASK; + if (!SwigLastCache) cache = SwigCache; + else cache++; + } + /* We have a type mismatch. Will have to look through our type + mapping table to figure out whether or not we can accept this datatype */ + + start = SwigStart[(int) _t[1]]; + end = SwigStart[(int) _t[1]+1]; + sp = &SwigPtrTable[start]; + while (start < end) { + if (swigcmp(_t,sp) == 0) break; + sp++; + start++; + } + if (start > end) sp = 0; + /* Try to find a match for this */ + while (start <= end) { + if (swigcmp(_t,sp) == 0) { + name = sp->name; + len = sp->len; + tp = sp->next; + /* Try to find entry for our given datatype */ + while(tp) { + if (tp->len >= 255) { + return _c; + } + strcpy(temp_type,tp->name); + strncat(temp_type,_t+len,255-tp->len); + if (strcmp(_c,temp_type) == 0) { + + strcpy(SwigCache[SwigCacheIndex].mapped,_c); + strcpy(SwigCache[SwigCacheIndex].name,_t); + SwigCache[SwigCacheIndex].stat = 1; + SwigCache[SwigCacheIndex].tp = tp; + SwigCacheIndex = SwigCacheIndex & SWIG_CACHEMASK; + + /* Get pointer value */ + *ptr = (void *) _p; + if (tp->cast) *ptr = (*(tp->cast))(*ptr); + return (char *) 0; + } + tp = tp->next; + } + } + sp++; + start++; + } + /* Didn't find any sort of match for this data. + Get the pointer value and return the received type */ + *ptr = (void *) _p; + return _c; + } else { + /* Found a match on the first try. Return pointer value */ + *ptr = (void *) _p; + return (char *) 0; + } + } else { + /* No type specified. Good luck */ + *ptr = (void *) _p; + return (char *) 0; + } + } else { + if (strcmp (_c, "NULL") == 0) { + *ptr = (void *) 0; + return (char *) 0; + } + *ptr = (void *) 0; + return _c; + } +} + +/* Compatibility mode */ + +#define _swig_get_hex SWIG_GetPtr + +#ifdef __cplusplus +} +#endif + diff --git a/SWIG/Lib/tcl/Makefile.in b/SWIG/Lib/tcl/Makefile.in new file mode 100644 index 000000000..3ba07d4a3 --- /dev/null +++ b/SWIG/Lib/tcl/Makefile.in @@ -0,0 +1,134 @@ +# --------------------------------------------------------------- +# $Header$ +# SWIG Tcl/Tk Makefile +# +# This file can be used to build various Tcl extensions with SWIG. +# By default this file is set up for dynamic loading, but it can +# be easily customized for static extensions by modifying various +# portions of the file. +# +# SRCS = C source files +# CXXSRCS = C++ source files +# OBJCSRCS = Objective-C source files +# OBJS = Additional .o files (compiled previously) +# INTERFACE = SWIG interface file +# TARGET = Name of target module or executable +# +# Many portions of this file were created by the SWIG configure +# script and should already reflect your machine. However, you +# may need to modify the Makefile to reflect your specific +# application. +#---------------------------------------------------------------- + +SRCS = +CXXSRCS = +OBJCSRCS = +OBJS = +INTERFACE = +WRAPFILE = $(INTERFACE:.i=_wrap.c) +WRAPOBJ = $(INTERFACE:.i=_wrap.o) +TARGET = module@SO@ # Use this kind of target for dynamic loading +#TARGET = my_tclsh # Use this target for static linking + +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +CC = @CC@ +CXX = @CXX@ +OBJC = @CC@ -Wno-import # -Wno-import needed for gcc +CFLAGS = +INCLUDE = +LIBS = + +# SWIG Options +# SWIG = location of the SWIG executable +# SWIGOPT = SWIG compiler options +# SWIGCC = Compiler used to compile the wrapper file + +SWIG = $(exec_prefix)/bin/swig +SWIGOPT = -tcl # use -tcl8 for Tcl 8.0 +SWIGCC = $(CC) + +# SWIG Library files. Uncomment one of these for rebuilding tclsh or wish +#SWIGLIB = -ltclsh.i +#SWIGLIB = -lwish.i + +# Rules for creating .o files from source. + +COBJS = $(SRCS:.c=.o) +CXXOBJS = $(CXXSRCS:.cxx=.o) +OBJCOBJS = $(OBJCSRCS:.m=.o) +ALLOBJS = $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(OBJS) + +# Command that will be used to build the final extension. +BUILD = $(SWIGCC) + +# Uncomment the following if you are using dynamic loading +CCSHARED = @CCSHARED@ +BUILD = @LDSHARED@ + +# Uncomment the following if you are using dynamic loading with C++ and +# need to provide additional link libraries (this is not always required). + +#DLL_LIBS = -L/usr/local/lib/gcc-lib/sparc-sun-solaris2.5.1/2.7.2 \ + -L/usr/local/lib -lg++ -lstdc++ -lgcc + +# X11 installation (needed to rebuild Tk extensions) + +XLIB = @XLIBSW@ +XINCLUDE = @XINCLUDES@ + +# Tcl installation (where is Tcl/Tk located) + +TCL_INCLUDE = @TCLINCLUDE@ +TCL_LIB = @TCLLIB@ + +# Build libraries (needed for static builds) + +LIBM = @LIBM@ +LIBC = @LIBC@ +SYSLIBS = $(LIBM) $(LIBC) @LIBS@ + +# Build options (uncomment only one these) + +BUILD_LIBS = $(LIBS) # Dynamic loading +#BUILD_LIBS = $(TCL_LIB) -ltcl $(LIBS) $(SYSLIBS) # tclsh +#BUILD_LIBS = $(TCL_LIB) -ltk -ltcl $(XLIB) $(LIBS) $(SYSLIBS) # wish + +# Compilation rules for non-SWIG components + +.SUFFIXES: .c .cxx .m + +.c.o: + $(CC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $< + +.cxx.o: + $(CXX) $(CCSHARED) $(CXXFLAGS) $(INCLUDE) -c $< + +.m.o: + $(OBJC) $(CCSHARED) $(CFLAGS) $(INCLUDE) -c $< + + +# ---------------------------------------------------------------------- +# Rules for building the extension +# ---------------------------------------------------------------------- + +all: $(TARGET) + +# Convert the wrapper file into an object file + +$(WRAPOBJ) : $(WRAPFILE) + $(SWIGCC) -c $(CCSHARED) $(CFLAGS) $(WRAPFILE) $(INCLUDE) $(TCL_INCLUDE) + +$(WRAPFILE) : $(INTERFACE) + $(SWIG) $(SWIGOPT) -o $(WRAPFILE) $(SWIGLIB) $(INTERFACE) + +$(TARGET): $(WRAPOBJ) $(ALLOBJS) + $(BUILD) $(WRAPOBJ) $(ALLOBJS) $(BUILD_LIBS) -o $(TARGET) + +clean: + rm -f $(COBJS) $(CXXOBJS) $(OBJCOBJS) $(WRAPOBJ) $(WRAPFILE) $(TARGET) + + + + diff --git a/SWIG/Lib/tcl/constarray.i b/SWIG/Lib/tcl/constarray.i new file mode 100644 index 000000000..d9a4dc290 --- /dev/null +++ b/SWIG/Lib/tcl/constarray.i @@ -0,0 +1,108 @@ +// constarray.i +// +// This module changes SWIG to place constant values into a Tcl array + + +#ifdef AUTODOC +%subsection "Array Constants",pre +%text %{ +%include constarray.i + +This module changes SWIG so that constant values are placed into a Tcl +array instead of global variables. The array is given the same name as +the SWIG module (specified with the %module directive). + +This module should generally be included at the top of an interface +file before any declarations appear. Furthermore, this module changes +the default handling of basic datatypes including integers, floats, +and character strings. + +When this module is used, constants are simply accessed through the +module name. For example : + + %module example + ... + #define FOO 42 + +would be accessed as '$example(FOO)' + +Note : This module replaces the existing mechanism for creating constants. +The method used by this module is based on a set of typemaps supplied +by Tim Medley. +%} +#endif + +%typemap(tcl,const) int SWIG_DEFAULT_TYPE, + unsigned int SWIG_DEFAULT_TYPE, + long SWIG_DEFAULT_TYPE, + unsigned long SWIG_DEFAULT_TYPE, + short SWIG_DEFAULT_TYPE, + unsigned short SWIG_DEFAULT_TYPE, + unsigned char SWIG_DEFAULT_TYPE, + signed char SWIG_DEFAULT_TYPE +{ + static int ivalue = (int) $source; + Tcl_LinkVar(interp,SWIG_name "($target)",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY); +} + +%typemap(tcl,const) float SWIG_DEFAULT_TYPE, + double SWIG_DEFAULT_TYPE +{ + static double dvalue = (double) $source; + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY); +} + +%typemap(tcl,const) char *SWIG_DEFAULT_TYPE +{ + static char *cvalue = $source; + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY); +} + +%typemap(tcl,const) Pointer *SWIG_DEFAULT_TYPE +{ + static char *pvalue; + pvalue = (char *) malloc(20+strlen("$mangle")); + SWIG_MakePtr(pvalue, (void *) ($source), "$mangle"); + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &pvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY); +} + +// ---------------------------------------------------------------------------------- +// Tcl 8 Object versions +// ---------------------------------------------------------------------------------- + +%typemap(tcl8,const) int SWIG_DEFAULT_TYPE, + unsigned int SWIG_DEFAULT_TYPE, + long SWIG_DEFAULT_TYPE, + unsigned long SWIG_DEFAULT_TYPE, + short SWIG_DEFAULT_TYPE, + unsigned short SWIG_DEFAULT_TYPE, + unsigned char SWIG_DEFAULT_TYPE, + signed char SWIG_DEFAULT_TYPE +{ + static int ivalue = (int) $source; + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY); +} + +%typemap(tcl8,const) float SWIG_DEFAULT_TYPE, + double SWIG_DEFAULT_TYPE +{ + static double dvalue = (double) $source; + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY); +} + +%typemap(tcl8,const) char *SWIG_DEFAULT_TYPE +{ + static char *cvalue = $source; + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY); +} + +%typemap(tcl8,const) Pointer *SWIG_DEFAULT_TYPE +{ + static char *pvalue; + pvalue = (char *) malloc(20+strlen("$mangle")); + SWIG_MakePtr(pvalue, (void *) ($source), "$mangle"); + Tcl_LinkVar(interp, SWIG_prefix SWIG_name "($target)",(char *) &pvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY); +} + + + diff --git a/SWIG/Lib/tcl/consthash.i b/SWIG/Lib/tcl/consthash.i new file mode 100644 index 000000000..e90f96564 --- /dev/null +++ b/SWIG/Lib/tcl/consthash.i @@ -0,0 +1,223 @@ +// consthash.i +// +// This module changes SWIG to place constant values into a Tcl +// hash table. + + +#ifdef AUTODOC +%subsection "Hash Constants",pre +%text %{ +%include consthash.i + +This module changes SWIG so that constant values are placed into a Tcl +hash table in addition to normal Tcl variables. When working with systems +involving large numbers of constants, the use of a hash table +simplifies use because it is no longer necessary to declare constants +using the 'global' statement. + +This module should generally be included at the top of an interface +file before any declarations appear. Furthermore, this module changes +the default handling of basic datatypes including integers, floats, +and character strings. + +When this module is used, constants are simply accessed by name +without the associated dollar sign. For example : + + #define FOO 42 + +would be accessed as 'FOO' in Tcl, not '$FOO'. + +Note : This module only affects integer, float, and character +constants. Pointer constants are not currently affected. This module +should not break existing Tcl scripts that rely on the normal SWIG +constant mechanism. +%} +#endif + +%{ +static Tcl_HashTable intHash, doubleHash, charHash; +static Tcl_HashEntry *entryPtr; +static int init_dummy; +%} + +%init %{ + Tcl_InitHashTable(&intHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&doubleHash, TCL_STRING_KEYS); + Tcl_InitHashTable(&charHash, TCL_STRING_KEYS); +%} + +%typemap(tcl,const) int SWIG_DEFAULT_TYPE, + unsigned int SWIG_DEFAULT_TYPE, + long SWIG_DEFAULT_TYPE, + unsigned long SWIG_DEFAULT_TYPE, + short SWIG_DEFAULT_TYPE, + unsigned short SWIG_DEFAULT_TYPE, + unsigned char SWIG_DEFAULT_TYPE, + signed char SWIG_DEFAULT_TYPE +{ + static int ivalue = (int) $source; + entryPtr = Tcl_CreateHashEntry(&intHash, "$target", &init_dummy); + Tcl_SetHashValue(entryPtr, &ivalue); + Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY); +} + +%typemap(tcl,const) float SWIG_DEFAULT_TYPE, + double SWIG_DEFAULT_TYPE +{ + static double dvalue = (double) $source; + entryPtr = Tcl_CreateHashEntry(&doubleHash, "$target", &init_dummy); + Tcl_SetHashValue(entryPtr, &dvalue); + Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY); +} + +%typemap(tcl,const) char *SWIG_DEFAULT_TYPE +{ + static char *cvalue = $source; + entryPtr = Tcl_CreateHashEntry(&charHash, "$target", &init_dummy); + Tcl_SetHashValue(entryPtr, &cvalue); + Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY); +} + +// Change input handling to look for names + +%typemap(tcl,in) int SWIG_DEFAULT_TYPE, + unsigned int SWIG_DEFAULT_TYPE, + long SWIG_DEFAULT_TYPE, + unsigned long SWIG_DEFAULT_TYPE, + short SWIG_DEFAULT_TYPE, + unsigned short SWIG_DEFAULT_TYPE, + unsigned char SWIG_DEFAULT_TYPE, + signed char SWIG_DEFAULT_TYPE +{ + Tcl_HashEntry *entry; + entry = Tcl_FindHashEntry(&intHash,$source); + if (entry) { + $target = ($type) (*((int *) Tcl_GetHashValue(entry))); + } else { + int temp; + if (Tcl_GetInt(interp, $source, &temp) == TCL_ERROR) return TCL_ERROR; + $target = ($type) temp; + } +} + +%typemap(tcl,in) float SWIG_DEFAULT_TYPE, + double SWIG_DEFAULT_TYPE +{ + Tcl_HashEntry *entry; + entry = Tcl_FindHashEntry(&doubleHash,$source); + if (entry) { + $target = ($type) (*((double *) Tcl_GetHashValue(entry))); + } else if (entry = Tcl_FindHashEntry(&intHash,$source)) { + $target = ($type) (*((int *) Tcl_GetHashValue(entry))); + } else { + double temp; + if (Tcl_GetDouble(interp,$source,&temp) == TCL_ERROR) return TCL_ERROR; + $target = ($type) temp; + } +} + +%typemap(tcl,in) char *SWIG_DEFAULT_TYPE +{ + Tcl_HashEntry *entry; + entry = Tcl_FindHashEntry(&charHash,$source); + if (entry) { + $target = ($type) (*((char **) Tcl_GetHashValue(entry))); + } else { + $target = $source; + } +} + +// ---------------------------------------------------------------------------------- +// Tcl 8 Object versions +// ---------------------------------------------------------------------------------- + +%typemap(tcl8,const) int SWIG_DEFAULT_TYPE, + unsigned int SWIG_DEFAULT_TYPE, + long SWIG_DEFAULT_TYPE, + unsigned long SWIG_DEFAULT_TYPE, + short SWIG_DEFAULT_TYPE, + unsigned short SWIG_DEFAULT_TYPE, + unsigned char SWIG_DEFAULT_TYPE, + signed char SWIG_DEFAULT_TYPE +{ + static int ivalue = (int) $source; + entryPtr = Tcl_CreateHashEntry(&intHash, "$target", &init_dummy); + Tcl_SetHashValue(entryPtr, &ivalue); + Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &ivalue, TCL_LINK_INT | TCL_LINK_READ_ONLY); +} + +%typemap(tcl8,const) float SWIG_DEFAULT_TYPE, + double SWIG_DEFAULT_TYPE +{ + static double dvalue = (double) $source; + entryPtr = Tcl_CreateHashEntry(&doubleHash, "$target", &init_dummy); + Tcl_SetHashValue(entryPtr, &dvalue); + Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &dvalue, TCL_LINK_DOUBLE | TCL_LINK_READ_ONLY); +} + +%typemap(tcl8,const) char *SWIG_DEFAULT_TYPE +{ + static char *cvalue = $source; + entryPtr = Tcl_CreateHashEntry(&charHash, "$target", &init_dummy); + Tcl_SetHashValue(entryPtr, &cvalue); + Tcl_LinkVar(interp, SWIG_prefix "$target",(char *) &cvalue, TCL_LINK_STRING | TCL_LINK_READ_ONLY); +} + +// Change input handling to look for names + +%typemap(tcl8,in) int SWIG_DEFAULT_TYPE, + unsigned int SWIG_DEFAULT_TYPE, + long SWIG_DEFAULT_TYPE, + unsigned long SWIG_DEFAULT_TYPE, + short SWIG_DEFAULT_TYPE, + unsigned short SWIG_DEFAULT_TYPE, + unsigned char SWIG_DEFAULT_TYPE, + signed char SWIG_DEFAULT_TYPE +{ + Tcl_HashEntry *entry; + int _len; + char *_str = Tcl_GetStringFromObj($source,&_len); + entry = Tcl_FindHashEntry(&intHash,_str); + if (entry) { + $target = ($type) (*((int *) Tcl_GetHashValue(entry))); + } else { + int temp; + if (Tcl_GetIntFromObj(interp, $source, &temp) == TCL_ERROR) return TCL_ERROR; + $target = ($type) temp; + } +} + +%typemap(tcl8,in) float SWIG_DEFAULT_TYPE, + double SWIG_DEFAULT_TYPE +{ + Tcl_HashEntry *entry; + int _len; + char *_str = Tcl_GetStringFromObj($source,&_len); + entry = Tcl_FindHashEntry(&doubleHash,_str); + if (entry) { + $target = ($type) (*((double *) Tcl_GetHashValue(entry))); + } else if (entry = Tcl_FindHashEntry(&intHash,_str)) { + $target = ($type) (*((int *) Tcl_GetHashValue(entry))); + } else { + double temp; + if (Tcl_GetDoubleFromObj(interp,$source,&temp) == TCL_ERROR) return TCL_ERROR; + $target = ($type) temp; + } +} + +%typemap(tcl8,in) char *SWIG_DEFAULT_TYPE +{ + Tcl_HashEntry *entry; + int _len; + char *_str = Tcl_GetStringFromObj($source,&_len); + entry = Tcl_FindHashEntry(&charHash,_str); + if (entry) { + $target = ($type) (*((char **) Tcl_GetHashValue(entry))); + } else { + $target = _str; + } +} + + + + diff --git a/SWIG/Lib/tcl/mactclinit.c b/SWIG/Lib/tcl/mactclinit.c new file mode 100644 index 000000000..de30bdaf5 --- /dev/null +++ b/SWIG/Lib/tcl/mactclinit.c @@ -0,0 +1,86 @@ +/* + * tclMacAppInit.c -- + * + * Provides a version of the Tcl_AppInit procedure for the example shell. + * + * Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center + * Copyright (c) 1995-1997 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * SCCS: @(#) tclMacAppInit.c 1.17 97/01/21 18:13:34 + */ + +#include "tcl.h" +#include "tclInt.h" +#include "tclMacInt.h" + +#if defined(THINK_C) +# include +#elif defined(__MWERKS__) +# include +short InstallConsole _ANSI_ARGS_((short fd)); +#endif + + + +/* + *---------------------------------------------------------------------- + * + * MacintoshInit -- + * + * This procedure calls initalization routines to set up a simple + * console on a Macintosh. This is necessary as the Mac doesn't + * have a stdout & stderr by default. + * + * Results: + * Returns TCL_OK if everything went fine. If it didn't the + * application should probably fail. + * + * Side effects: + * Inits the appropiate console package. + * + *---------------------------------------------------------------------- + */ + +#ifdef __cpluscplus +extern "C" +#endif +extern int +MacintoshInit() +{ +#if defined(THINK_C) + + /* Set options for Think C console package */ + /* The console package calls the Mac init calls */ + console_options.pause_atexit = 0; + console_options.title = "\pTcl Interpreter"; + +#elif defined(__MWERKS__) + + /* Set options for CodeWarrior SIOUX package */ + SIOUXSettings.autocloseonquit = true; + SIOUXSettings.showstatusline = true; + SIOUXSettings.asktosaveonclose = false; + InstallConsole(0); + SIOUXSetTitle("\pTcl Interpreter"); + +#elif defined(applec) + + /* Init packages used by MPW SIOW package */ + InitGraf((Ptr)&qd.thePort); + InitFonts(); + InitWindows(); + InitMenus(); + TEInit(); + InitDialogs(nil); + InitCursor(); + +#endif + + TclMacSetEventProc((TclMacConvertEventPtr) SIOUXHandleOneEvent); + + /* No problems with initialization */ + return TCL_OK; +} diff --git a/SWIG/Lib/tcl/mactkinit.c b/SWIG/Lib/tcl/mactkinit.c new file mode 100644 index 000000000..e728418f4 --- /dev/null +++ b/SWIG/Lib/tcl/mactkinit.c @@ -0,0 +1,229 @@ +/* This is a support file needed to build a new version of Wish + Normally, this capability is found in TkAppInit.c, but this creates + tons of namespace problems for many applications. */ + +#include +#include +#include +#include +#include +#include + +#include "tk.h" +#include "tkInt.h" +#include "tkMacInt.h" + +typedef int (*TclMacConvertEventPtr) _ANSI_ARGS_((EventRecord *eventPtr)); +Tcl_Interp *gStdoutInterp = NULL; + +void TclMacSetEventProc _ANSI_ARGS_((TclMacConvertEventPtr procPtr)); +int TkMacConvertEvent _ANSI_ARGS_((EventRecord *eventPtr)); + +/* + * Prototypes for functions the ANSI library needs to link against. + */ +short InstallConsole _ANSI_ARGS_((short fd)); +void RemoveConsole _ANSI_ARGS_((void)); +long WriteCharsToConsole _ANSI_ARGS_((char *buff, long n)); +long ReadCharsFromConsole _ANSI_ARGS_((char *buff, long n)); +extern char * __ttyname _ANSI_ARGS_((long fildes)); +short SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event)); + +/* + * Forward declarations for procedures defined later in this file: + */ + +/* + *---------------------------------------------------------------------- + * + * MacintoshInit -- + * + * This procedure calls Mac specific initilization calls. Most of + * these calls must be made as soon as possible in the startup + * process. + * + * Results: + * Returns TCL_OK if everything went fine. If it didn't the + * application should probably fail. + * + * Side effects: + * Inits the application. + * + *---------------------------------------------------------------------- + */ + +int +MacintoshInit() +{ + int i; + long result, mask = 0x0700; /* mask = system 7.x */ + + /* + * Tk needs us to set the qd pointer it uses. This is needed + * so Tk doesn't have to assume the availablity of the qd global + * variable. Which in turn allows Tk to be used in code resources. + */ + tcl_macQdPtr = &qd; + + InitGraf(&tcl_macQdPtr->thePort); + InitFonts(); + InitWindows(); + InitMenus(); + InitDialogs((long) NULL); + InitCursor(); + + /* + * Make sure we are running on system 7 or higher + */ + + if ((NGetTrapAddress(_Gestalt, ToolTrap) == + NGetTrapAddress(_Unimplemented, ToolTrap)) + || (((Gestalt(gestaltSystemVersion, &result) != noErr) + || (mask != (result & mask))))) { + panic("Tcl/Tk requires System 7 or higher."); + } + + /* + * Make sure we have color quick draw + * (this means we can't run on 68000 macs) + */ + + if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr) + || (result < gestalt32BitQD13))) { + panic("Tk requires Color QuickDraw."); + } + + + FlushEvents(everyEvent, 0); + SetEventMask(everyEvent); + + /* + * Set up stack & heap sizes + */ + /* TODO: stack size + size = StackSpace(); + SetAppLimit(GetAppLimit() - 8192); + */ + MaxApplZone(); + for (i = 0; i < 4; i++) { + (void) MoreMasters(); + } + + TclMacSetEventProc(TkMacConvertEvent); + TkConsoleCreate(); + + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * SetupMainInterp -- + * + * This procedure calls initalization routines require a Tcl + * interp as an argument. This call effectively makes the passed + * iterpreter the "main" interpreter for the application. + * + * Results: + * Returns TCL_OK if everything went fine. If it didn't the + * application should probably fail. + * + * Side effects: + * More initilization. + * + *---------------------------------------------------------------------- + */ + +int +SetupMainInterp( + Tcl_Interp *interp) +{ + /* + * Initialize the console only if we are running as an interactive + * application. + */ + + TkMacInitAppleEvents(interp); + TkMacInitMenus(interp); + + if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1") + == 0) { + if (TkConsoleInit(interp) == TCL_ERROR) { + goto error; + } + } + + /* + * Attach the global interpreter to tk's expected global console + */ + + gStdoutInterp = interp; + + return TCL_OK; + +error: + panic(interp->result); + return TCL_ERROR; +} + +/* + *---------------------------------------------------------------------- + * + * InstallConsole, RemoveConsole, etc. -- + * + * The following functions provide the UI for the console package. + * Users wishing to replace SIOUX with their own console package + * need only provide the four functions below in a library. + * + * Results: + * See SIOUX documentation for details. + * + * Side effects: + * See SIOUX documentation for details. + * + *---------------------------------------------------------------------- + */ + +short +InstallConsole(short fd) +{ +#pragma unused (fd) + + return 0; +} + +void +RemoveConsole(void) +{ +} + +long +WriteCharsToConsole(char *buffer, long n) +{ + TkConsolePrint(gStdoutInterp, TCL_STDOUT, buffer, n); + return n; +} + +long +ReadCharsFromConsole(char *buffer, long n) +{ + return 0; +} + +extern char * +__ttyname(long fildes) +{ + static char *__devicename = "null device"; + + if (fildes >= 0 && fildes <= 2) { + return (__devicename); + } + + return (0L); +} + +short +SIOUXHandleOneEvent(EventRecord *event) +{ + return 0; +} diff --git a/SWIG/Lib/tcl/object.swg b/SWIG/Lib/tcl/object.swg new file mode 100644 index 000000000..f7ed89cdf --- /dev/null +++ b/SWIG/Lib/tcl/object.swg @@ -0,0 +1,229 @@ +/* object.swg + * + * Tcl8.x - Object oriented runtime functions + */ + +typedef int (*_swig_wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); + +typedef struct _swig_method { + const char *name; + _swig_wrapper method; +} _swig_method; + +typedef struct _swig_attribute { + const char *name; + _swig_wrapper getmethod; + _swig_wrapper setmethod; +} _swig_attribute; + +typedef struct _swig_class { + const char *name; + _swig_type_info **type; + _swig_wrapper constructor; + void (*destructor)(void *); + _swig_method *methods; + _swig_attribute *attributes; +} _swig_class; + +typedef struct _swig_instance { + Tcl_Obj *thisptr; + void *thisvalue; + _swig_class *classptr; + int destroy; +} _swig_instance; + +static void SwigObjectDelete(ClientData clientData) { + _swig_instance *si = (_swig_instance *) clientData; + if (si->destroy) { + if (si->classptr->destructor) { + (si->classptr->destructor)(si->thisvalue); + } + } + Tcl_DecrRefCount(si->thisptr); + free(si); +} + +/* Function to invoke object methods given an instance */ +static int +SwigMethodCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST _objv[]) +{ + char *method, *attrname; + _swig_instance *inst = (_swig_instance *) clientData; + _swig_method *meth; + _swig_attribute *attr; + Tcl_Obj *oldarg; + Tcl_Obj **objv; + int rcode; + + objv = (Tcl_Obj **) _objv; + if (objc < 2) { + Tcl_SetResult(interp,"wrong # args.", TCL_STATIC); + return TCL_ERROR; + } + meth = inst->classptr->methods; + method = Tcl_GetStringFromObj(objv[1],NULL); + + /* Check for methods */ + while (meth && meth->name) { + if (strcmp(meth->name,method) == 0) { + oldarg = objv[1]; + objv[1] = inst->thisptr; + Tcl_IncrRefCount(inst->thisptr); + rcode = (*meth->method)(clientData,interp,objc,objv); + objv[1] = oldarg; + Tcl_DecrRefCount(inst->thisptr); + return rcode; + } + meth++; + } + /* Check class methods for a match */ + if (strcmp(method,"cget") == 0) { + if (objc < 3) { + Tcl_SetResult(interp,"wrong # args.", TCL_STATIC); + return TCL_ERROR; + } + attrname = Tcl_GetStringFromObj(objv[2],NULL); + attr = inst->classptr->attributes; + while (attr && attr->name) { + if ((strcmp(attr->name, attrname) == 0) && (attr->getmethod)) { + oldarg = objv[1]; + objv[1] = inst->thisptr; + Tcl_IncrRefCount(inst->thisptr); + rcode = (*attr->getmethod)(clientData,interp,2, objv); + objv[1] = oldarg; + Tcl_DecrRefCount(inst->thisptr); + return rcode; + } + attr++; + } + if (strcmp(attrname, "-this") == 0) { + Tcl_SetObjResult(interp, Tcl_DuplicateObj(inst->thisptr)); + return TCL_OK; + } + Tcl_SetResult(interp,"Invalid attribute.", TCL_STATIC); + return TCL_ERROR; + } else if (strcmp(method, "configure") == 0) { + int i; + if (objc < 4) { + Tcl_SetResult(interp,"wrong # args.", TCL_STATIC); + return TCL_ERROR; + } + i = 2; + while (i < objc) { + attrname = Tcl_GetStringFromObj(objv[i],NULL); + attr = inst->classptr->attributes; + while (attr && attr->name) { + if ((strcmp(attr->name, attrname) == 0) && (attr->setmethod)) { + oldarg = objv[i]; + objv[i] = inst->thisptr; + Tcl_IncrRefCount(inst->thisptr); + rcode = (*attr->setmethod)(clientData,interp,3, &objv[i-1]); + objv[i] = oldarg; + Tcl_DecrRefCount(inst->thisptr); + if (rcode != TCL_OK) return rcode; + i+=2; + break; + } + attr++; + } + if (inst->classptr->attributes && !(attr->name)) { + Tcl_SetResult(interp,"Invalid attribute name.", TCL_STATIC); + return TCL_ERROR; + } + } + return TCL_OK; + } else { + Tcl_SetResult(interp,"Invalid method. Must be one of: configure cget ", TCL_STATIC); + meth = inst->classptr->methods; + while (meth && meth->name) { + Tcl_AppendElement(interp, meth->name); + meth++; + } + return TCL_ERROR; + } + + +} + +/* Function to create objects */ +static int +SwigObjectCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) +{ + Tcl_Obj *newObj = 0; + void *thisvalue = 0; + _swig_instance *newinst = 0; + _swig_class *classptr = (_swig_class *) clientData; + _swig_wrapper cons = 0; + char *name = 0; + int firstarg = 0; + int thisarg = 0; + int destroy = 1; + Tcl_CmdInfo ci; + + if (!classptr) { + Tcl_SetResult(interp,"swig: internal runtime error. No class object defined.", TCL_STATIC); + return TCL_ERROR; + } + cons = classptr->constructor; + if (objc > 1) { + char *s = Tcl_GetStringFromObj(objv[1],NULL); + if (strcmp(s,"-this") == 0) { + thisarg = 2; + cons = 0; + } else if (strcmp(s,"-args") == 0) { + firstarg = 1; + } else if (objc == 2) { + firstarg = 1; + name = s; + } else if (objc >= 3) { + char *s1; + name = s; + s1 = Tcl_GetStringFromObj(objv[2],NULL); + if (strcmp(s1,"-this") == 0) { + thisarg = 3; + cons = 0; + } else { + firstarg = 1; + } + } + } + if (cons) { + int result; + result = (*cons)(0, interp, objc-firstarg, &objv[firstarg]); + if (result != TCL_OK) { + return result; + } + newObj = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); + if (!name) name = Tcl_GetStringFromObj(newObj,NULL); + } else if (thisarg > 0) { + if (thisarg < objc) { + destroy = 0; + newObj = Tcl_DuplicateObj(objv[thisarg]); + if (!name) name = Tcl_GetStringFromObj(newObj,NULL); + } else { + Tcl_SetResult(interp,"wrong # args.", TCL_STATIC); + return TCL_ERROR; + } + } else { + Tcl_SetResult(interp,"No constructor available.", TCL_STATIC); + return TCL_ERROR; + } + if (!Tcl_GetCommandInfo(interp,name,&ci)) { + if (SWIG_ConvertPtr(interp,newObj, (void **) &thisvalue, *(classptr->type)) == TCL_ERROR) { + Tcl_DecrRefCount(newObj); + return TCL_ERROR; + } + newinst = (_swig_instance *) malloc(sizeof(_swig_instance)); + newinst->thisptr = newObj; + Tcl_IncrRefCount(newObj); + newinst->thisvalue = thisvalue; + newinst->classptr = classptr; + newinst->destroy = destroy; + Tcl_CreateObjCommand(interp,name, SwigMethodCmd, (ClientData) newinst, SwigObjectDelete); + return TCL_OK; + } else { + Tcl_SetResult(interp,"Object name already exists!", TCL_STATIC); + return TCL_ERROR; + } +} + diff --git a/SWIG/Lib/tcl/ptrlang.i b/SWIG/Lib/tcl/ptrlang.i new file mode 100644 index 000000000..977cd6d78 --- /dev/null +++ b/SWIG/Lib/tcl/ptrlang.i @@ -0,0 +1,695 @@ +// +// SWIG pointer conversion and utility library +// +// Dave Beazley +// April 19, 1997 +// +// Tcl specific implementation. This file is included +// by the file ../pointer.i + + +#if defined(SWIGTCL8) + +// ----------------------------------------------------------------- +// Define a hack for GetPtr on Tcl 8 +// +// ----------------------------------------------------------------- + +%{ + +static char *_SWIG_GetPtr(Tcl_Interp *interp, char *s, void **ptr, char *type) { + Tcl_Obj *obj; + char *c; + obj = Tcl_NewStringObj(s, strlen(s)); + c = SWIG_GetPointerObj(interp, obj, ptr, type); + if (c) { + c = strstr(s,c); + } + Tcl_DecrRefCount(obj); + return c; +} + +#define SWIG_GetPtr(a,b,c) _SWIG_GetPtr(interp, a,b,c) + +%} +#endif + +%{ + +#include + +/*------------------------------------------------------------------ + ptrcast(value,type) + + Constructs a new pointer value. Value may either be a string + or an integer. Type is a string corresponding to either the + C datatype or mangled datatype. + + ptrcast(0,"Vector *") + or + ptrcast(0,"Vector_p") + ------------------------------------------------------------------ */ + +static int ptrcast(Tcl_Interp *interp, char *_ptrvalue, char *type) { + + char *r,*s; + void *ptr; + char *typestr,*c; + int pv; + int error = 0; + + /* Produce a "mangled" version of the type string. */ + + typestr = (char *) malloc(strlen(type)+2); + + /* Go through and munge the typestring */ + + r = typestr; + *(r++) = '_'; + c = type; + while (*c) { + if (!isspace(*c)) { + if ((*c == '*') || (*c == '&')) { + *(r++) = 'p'; + } + else *(r++) = *c; + } else { + *(r++) = '_'; + } + c++; + } + *(r++) = 0; + + /* Check to see what kind of object _PTRVALUE is */ + if (Tcl_GetInt(interp,_ptrvalue,&pv) == TCL_OK) { + ptr = (void *) pv; + /* Received a numerical value. Make a pointer out of it */ + r = (char *) malloc(strlen(typestr)+22); + if (ptr) { + SWIG_MakePtr(r, ptr, typestr); + } else { + sprintf(r,"_0%s",typestr); + } + Tcl_SetResult(interp,r,TCL_VOLATILE); + free(r); + } else { + /* Have a string. Try to get the real pointer value */ + s = _ptrvalue; + r = (char *) malloc(strlen(type)+22); + + /* Now extract the pointer value */ + if (!SWIG_GetPtr(s,&ptr,0)) { + if (ptr) { + SWIG_MakePtr(r,ptr,typestr); + } else { + sprintf(r,"_0%s",typestr); + } + Tcl_SetResult(interp,r,TCL_VOLATILE); + } else { + error = 1; + } + free(r); + } + free(typestr); + if (error) { + Tcl_SetResult(interp,"Type error in ptrcast. Argument is not a valid pointer value.",TCL_VOLATILE); + return TCL_ERROR; + } + return TCL_OK; +} + +/*------------------------------------------------------------------ + ptrvalue(ptr,type = 0) + + Attempts to dereference a pointer value. If type is given, it + will try to use that type. Otherwise, this function will attempt + to "guess" the proper datatype by checking against all of the + builtin C datatypes. + ------------------------------------------------------------------ */ + +static int ptrvalue(Tcl_Interp *interp, char *_ptrvalue, int index, char *type) { + void *ptr; + char *s; + int error = 0; + + if (type) { + if (strlen(type) == 0) type = 0; + } + s = _ptrvalue; + if (SWIG_GetPtr(s,&ptr,0)) { + Tcl_SetResult(interp,"Type error in ptrvalue. Argument is not a valid pointer value.", + TCL_STATIC); + return TCL_ERROR; + } + + /* If no datatype was passed, try a few common datatypes first */ + + if (!type) { + + /* No datatype was passed. Type to figure out if it's a common one */ + + if (!SWIG_GetPtr(s,&ptr,"_int_p")) { + type = "int"; + } else if (!SWIG_GetPtr(s,&ptr,"_double_p")) { + type = "double"; + } else if (!SWIG_GetPtr(s,&ptr,"_short_p")) { + type = "short"; + } else if (!SWIG_GetPtr(s,&ptr,"_long_p")) { + type = "long"; + } else if (!SWIG_GetPtr(s,&ptr,"_float_p")) { + type = "float"; + } else if (!SWIG_GetPtr(s,&ptr,"_char_p")) { + type = "char"; + } else if (!SWIG_GetPtr(s,&ptr,"_char_pp")) { + type = "char *"; + } else { + type = "unknown"; + } + } + + if (!ptr) { + Tcl_SetResult(interp,"Unable to dereference NULL pointer.",TCL_STATIC); + return TCL_ERROR; + } + + /* Now we have a datatype. Try to figure out what to do about it */ + if (strcmp(type,"int") == 0) { + sprintf(interp->result,"%ld",(long) *(((int *) ptr) + index)); + } else if (strcmp(type,"double") == 0) { + Tcl_PrintDouble(interp,(double) *(((double *) ptr)+index), interp->result); + } else if (strcmp(type,"short") == 0) { + sprintf(interp->result,"%ld",(long) *(((short *) ptr) + index)); + } else if (strcmp(type,"long") == 0) { + sprintf(interp->result,"%ld",(long) *(((long *) ptr) + index)); + } else if (strcmp(type,"float") == 0) { + Tcl_PrintDouble(interp,(double) *(((float *) ptr)+index), interp->result); + } else if (strcmp(type,"char") == 0) { + Tcl_SetResult(interp,((char *) ptr) + index, TCL_VOLATILE); + } else if (strcmp(type,"char *") == 0) { + char *c = *(((char **) ptr)+index); + if (c) Tcl_SetResult(interp,(char *) c, TCL_VOLATILE); + else Tcl_SetResult(interp,"NULL", TCL_VOLATILE); + } else { + Tcl_SetResult(interp,"Unable to dereference unsupported datatype.",TCL_STATIC); + return TCL_ERROR; + } + return TCL_OK; +} + +/*------------------------------------------------------------------ + ptrcreate(type,value = 0,numelements = 1) + + Attempts to create a new object of given type. Type must be + a basic C datatype. Will not create complex objects. + ------------------------------------------------------------------ */ + +static int ptrcreate(Tcl_Interp *interp, char *type, char *_ptrvalue, int numelements) { + void *ptr; + int sz; + char *cast; + char temp[40]; + + /* Check the type string against a variety of possibilities */ + + if (strcmp(type,"int") == 0) { + sz = sizeof(int)*numelements; + cast = "_int_p"; + } else if (strcmp(type,"short") == 0) { + sz = sizeof(short)*numelements; + cast = "_short_p"; + } else if (strcmp(type,"long") == 0) { + sz = sizeof(long)*numelements; + cast = "_long_p"; + } else if (strcmp(type,"double") == 0) { + sz = sizeof(double)*numelements; + cast = "_double_p"; + } else if (strcmp(type,"float") == 0) { + sz = sizeof(float)*numelements; + cast = "_float_p"; + } else if (strcmp(type,"char") == 0) { + sz = sizeof(char)*numelements; + cast = "_char_p"; + } else if (strcmp(type,"char *") == 0) { + sz = sizeof(char *)*(numelements+1); + cast = "_char_pp"; + } else if (strcmp(type,"void") == 0) { + sz = numelements; + } else { + Tcl_SetResult(interp,"Unable to create unknown datatype.",TCL_STATIC); + return TCL_ERROR; + } + + /* Create the new object */ + + ptr = (void *) malloc(sz); + if (!ptr) { + Tcl_SetResult(interp,"Out of memory in ptrcreate.",TCL_STATIC); + return TCL_ERROR; + } + + /* Now try to set its default value */ + + if (_ptrvalue) { + if (strcmp(type,"int") == 0) { + int *ip,i,ivalue; + Tcl_GetInt(interp,_ptrvalue,&ivalue); + ip = (int *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"short") == 0) { + short *ip; + int i, ivalue; + Tcl_GetInt(interp,_ptrvalue,&ivalue); + ip = (short *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = (short) ivalue; + } else if (strcmp(type,"long") == 0) { + long *ip; + int i, ivalue; + Tcl_GetInt(interp,_ptrvalue,&ivalue); + ip = (long *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = (long) ivalue; + } else if (strcmp(type,"double") == 0) { + double *ip,ivalue; + int i; + Tcl_GetDouble(interp,_ptrvalue,&ivalue); + ip = (double *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = ivalue; + } else if (strcmp(type,"float") == 0) { + float *ip; + double ivalue; + int i; + Tcl_GetDouble(interp,_ptrvalue,&ivalue); + ip = (float *) ptr; + for (i = 0; i < numelements; i++) + ip[i] = (double) ivalue; + } else if (strcmp(type,"char") == 0) { + char *ip,*ivalue; + ivalue = (char *) _ptrvalue; + ip = (char *) ptr; + strncpy(ip,ivalue,numelements-1); + } else if (strcmp(type,"char *") == 0) { + char **ip, *ivalue; + int i; + ivalue = (char *) _ptrvalue; + ip = (char **) ptr; + for (i = 0; i < numelements; i++) { + if (ivalue) { + ip[i] = (char *) malloc(strlen(ivalue)+1); + strcpy(ip[i],ivalue); + } else { + ip[i] = 0; + } + } + ip[numelements] = 0; + } + } + /* Create the pointer value */ + + SWIG_MakePtr(temp,ptr,cast); + Tcl_SetResult(interp,temp,TCL_VOLATILE); + return TCL_OK; +} + +/*------------------------------------------------------------------ + ptrset(ptr,value,index = 0,type = 0) + + Attempts to set the value of a pointer variable. If type is + given, we will use that type. Otherwise, we'll guess the datatype. + ------------------------------------------------------------------ */ + +static int ptrset(Tcl_Interp *interp, char *_PTRVALUE, char *_VALUE, int index, char *type) { + void *ptr; + char *s; + + s = _PTRVALUE; + if (SWIG_GetPtr(s,&ptr,0)) { + Tcl_SetResult(interp,"Type error in ptrset. Argument is not a valid pointer value.", + TCL_STATIC); + return TCL_ERROR; + } + + /* If no datatype was passed, try a few common datatypes first */ + + if (!type) { + + /* No datatype was passed. Type to figure out if it's a common one */ + + if (!SWIG_GetPtr(s,&ptr,"_int_p")) { + type = "int"; + } else if (!SWIG_GetPtr(s,&ptr,"_double_p")) { + type = "double"; + } else if (!SWIG_GetPtr(s,&ptr,"_short_p")) { + type = "short"; + } else if (!SWIG_GetPtr(s,&ptr,"_long_p")) { + type = "long"; + } else if (!SWIG_GetPtr(s,&ptr,"_float_p")) { + type = "float"; + } else if (!SWIG_GetPtr(s,&ptr,"_char_p")) { + type = "char"; + } else if (!SWIG_GetPtr(s,&ptr,"_char_pp")) { + type = "char *"; + } else { + type = "unknown"; + } + } + + if (!ptr) { + Tcl_SetResult(interp,"Unable to set NULL pointer.",TCL_STATIC); + return TCL_ERROR; + } + + /* Now we have a datatype. Try to figure out what to do about it */ + if (strcmp(type,"int") == 0) { + int ivalue; + Tcl_GetInt(interp,_VALUE, &ivalue); + *(((int *) ptr)+index) = ivalue; + } else if (strcmp(type,"double") == 0) { + double ivalue; + Tcl_GetDouble(interp,_VALUE, &ivalue); + *(((double *) ptr)+index) = (double) ivalue; + } else if (strcmp(type,"short") == 0) { + int ivalue; + Tcl_GetInt(interp,_VALUE, &ivalue); + *(((short *) ptr)+index) = (short) ivalue; + } else if (strcmp(type,"long") == 0) { + int ivalue; + Tcl_GetInt(interp,_VALUE, &ivalue); + *(((long *) ptr)+index) = (long) ivalue; + } else if (strcmp(type,"float") == 0) { + double ivalue; + Tcl_GetDouble(interp,_VALUE, &ivalue); + *(((float *) ptr)+index) = (float) ivalue; + } else if (strcmp(type,"char") == 0) { + char *c = _VALUE; + strcpy(((char *) ptr)+index, c); + } else if (strcmp(type,"char *") == 0) { + char *c = _VALUE; + char **ca = (char **) ptr; + if (ca[index]) free(ca[index]); + if (strcmp(c,"NULL") == 0) { + ca[index] = 0; + } else { + ca[index] = (char *) malloc(strlen(c)+1); + strcpy(ca[index],c); + } + } else { + Tcl_SetResult(interp,"Unable to set unsupported datatype.",TCL_STATIC); + return TCL_ERROR; + } + return TCL_OK; +} + +/*------------------------------------------------------------------ + ptradd(ptr,offset) + + Adds a value to an existing pointer value. Will do a type-dependent + add for basic datatypes. For other datatypes, will do a byte-add. + ------------------------------------------------------------------ */ + +static int ptradd(Tcl_Interp *interp, char *_PTRVALUE, int offset) { + + char *r,*s; + void *ptr,*junk; + char *type; + + /* Check to see what kind of object _PTRVALUE is */ + + s = _PTRVALUE; + + /* Try to handle a few common datatypes first */ + + if (!SWIG_GetPtr(s,&ptr,"_int_p")) { + ptr = (void *) (((int *) ptr) + offset); + } else if (!SWIG_GetPtr(s,&ptr,"_double_p")) { + ptr = (void *) (((double *) ptr) + offset); + } else if (!SWIG_GetPtr(s,&ptr,"_short_p")) { + ptr = (void *) (((short *) ptr) + offset); + } else if (!SWIG_GetPtr(s,&ptr,"_long_p")) { + ptr = (void *) (((long *) ptr) + offset); + } else if (!SWIG_GetPtr(s,&ptr,"_float_p")) { + ptr = (void *) (((float *) ptr) + offset); + } else if (!SWIG_GetPtr(s,&ptr,"_char_p")) { + ptr = (void *) (((char *) ptr) + offset); + } else if (!SWIG_GetPtr(s,&ptr,0)) { + ptr = (void *) (((char *) ptr) + offset); + } else { + Tcl_SetResult(interp,"Type error in ptradd. Argument is not a valid pointer value.",TCL_STATIC); + return TCL_ERROR; + } + type = SWIG_GetPtr(s,&junk,"INVALID POINTER"); + r = (char *) malloc(strlen(type)+20); + if (ptr) { + SWIG_MakePtr(r,ptr,type); + } else { + sprintf(r,"_0%s",type); + } + Tcl_SetResult(interp,r,TCL_VOLATILE); + free(r); + return TCL_OK; +} + + +/*------------------------------------------------------------------ + ptrmap(type1,type2) + + Allows a mapping between type1 and type2. (Like a typedef) + ------------------------------------------------------------------ */ + +static void ptrmap(char *type1, char *type2) { + + char *typestr1,*typestr2,*c,*r; + + /* Produce a "mangled" version of the type string. */ + + typestr1 = (char *) malloc(strlen(type1)+2); + + /* Go through and munge the typestring */ + + r = typestr1; + *(r++) = '_'; + c = type1; + while (*c) { + if (!isspace(*c)) { + if ((*c == '*') || (*c == '&')) { + *(r++) = 'p'; + } + else *(r++) = *c; + } else { + *(r++) = '_'; + } + c++; + } + *(r++) = 0; + + typestr2 = (char *) malloc(strlen(type2)+2); + + /* Go through and munge the typestring */ + + r = typestr2; + *(r++) = '_'; + c = type2; + while (*c) { + if (!isspace(*c)) { + if ((*c == '*') || (*c == '&')) { + *(r++) = 'p'; + } + else *(r++) = *c; + } else { + *(r++) = '_'; + } + c++; + } + *(r++) = 0; + SWIG_RegisterMapping(typestr1,typestr2,0); + SWIG_RegisterMapping(typestr2,typestr1,0); +} + +/*------------------------------------------------------------------ + ptrfree(ptr) + + Destroys a pointer value + ------------------------------------------------------------------ */ + +int ptrfree(Tcl_Interp *interp, char *_PTRVALUE) { + void *ptr, *junk; + char *s; + + s = _PTRVALUE; + if (SWIG_GetPtr(s,&ptr,0)) { + Tcl_SetResult(interp,"Type error in ptrfree. Argument is not a valid pointer value.",TCL_STATIC); + return TCL_ERROR; + } + + /* Check to see if this pointer is a char ** */ + if (!SWIG_GetPtr(s,&junk,"_char_pp")) { + char **c = (char **) ptr; + if (c) { + int i = 0; + while (c[i]) { + free(c[i]); + i++; + } + } + } + if (ptr) + free((char *) ptr); + + return TCL_OK; +} +%} + +%typemap(tcl,out) int ptrcast, + int ptrvalue, + int ptrcreate, + int ptrset, + int ptradd, + int ptrfree +{ + return $source; +} +%typemap(tcl8,out) int ptrcast, + int ptrvalue, + int ptrcreate, + int ptrset, + int ptradd, + int ptrfree +{ + return $source; +} + +// Ignore the Tcl_Interp * value, but set it to a value + +%typemap(tcl,ignore) Tcl_Interp * { + $target = interp; +} +%typemap(tcl8,ignore) Tcl_Interp * { + $target = interp; +} + +int ptrcast(Tcl_Interp *interp, char *ptr, char *type); +// Casts a pointer ptr to a new datatype given by the string type. +// type may be either the SWIG generated representation of a datatype +// or the C representation. For example : +// +// ptrcast $ptr double_p # Tcl representation +// ptrcast $ptr "double *" # C representation +// +// A new pointer value is returned. ptr may also be an integer +// value in which case the value will be used to set the pointer +// value. For example : +// +// set a [ptrcast 0 Vector_p] +// +// Will create a NULL pointer of type "Vector_p" +// +// The casting operation is sensitive to formatting. As a result, +// "double *" is different than "double*". As a result of thumb, +// there should always be exactly one space between the C datatype +// and any pointer specifiers (*). + + +int ptrvalue(Tcl_Interp *interp, char *ptr, int index = 0, char *type = 0); +// Returns the value that a pointer is pointing to (ie. dereferencing). +// The type is automatically inferred by the pointer type--thus, an +// integer pointer will return an integer, a double will return a double, +// and so on. The index and type fields are optional parameters. When +// an index is specified, this function returns the value of ptr[index]. +// This allows array access. When a type is specified, it overrides +// the given pointer type. Examples : +// +// ptrvalue $a # Returns the value *a +// ptrvalue $a 10 # Returns the value a[10] +// ptrvalue $a 10 double # Returns a[10] assuming a is a double * + +int ptrset(Tcl_Interp *interp, char *ptr, char *value, int index = 0, char *type = 0); +// Sets the value pointed to by a pointer. The type is automatically +// inferred from the pointer type so this function will work for +// integers, floats, doubles, etc... The index and type fields are +// optional. When an index is given, it provides array access. When +// type is specified, it overrides the given pointer type. Examples : +// +// ptrset $a 3 # Sets the value *a = 3 +// ptrset $a 3 10 # Sets a[10] = 3 +// ptrset $a 3 10 int # Sets a[10] = 3 assuming a is a int * + +int ptrcreate(Tcl_Interp *interp, char *type, char *value = 0, int nitems = 1); +// Creates a new object and returns a pointer to it. This function +// can be used to create various kinds of objects for use in C functions. +// type specifies the basic C datatype to create and value is an +// optional parameter that can be used to set the initial value of the +// object. nitems is an optional parameter that can be used to create +// an array. This function results in a memory allocation using +// malloc(). Examples : +// +// set a [ptrcreate "double"] # Create a new double, return pointer +// set a [ptrcreate int 7] # Create an integer, set value to 7 +// set a [ptrcreate int 0 1000] # Create an integer array with initial +// # values all set to zero +// +// This function only recognizes a few common C datatypes as listed below : +// +// int, short, long, float, double, char, char *, void +// +// All other datatypes will result in an error. However, other +// datatypes can be created by using the ptrcast function. For +// example: +// +// set a [ptrcast [ptrcreate int 0 100],"unsigned int *"] + +int ptrfree(Tcl_Interp *interp, char *ptr); +// Destroys the memory pointed to by ptr. This function calls free() +// and should only be used with objects created by ptrcreate(). Since +// this function calls free, it may work with other objects, but this +// is generally discouraged unless you absolutely know what you're +// doing. + +int ptradd(Tcl_Interp *interp, char *ptr, int offset); +// Adds a value to the current pointer value. For the C datatypes of +// int, short, long, float, double, and char, the offset value is the +// number of objects and works in exactly the same manner as in C. For +// example, the following code steps through the elements of an array +// +// set a [ptrcreate double 0 100] # Create an array double a[100] +// set b $a +// for {set i 0} {$i < 100} {incr i 1} { +// ptrset $b [expr{0.0025*$i}] # set *b = 0.0025*i +// set b [ptradd $b 1] # b++ (go to next double) +// } +// +// In this case, adding one to b goes to the next double. +// +// For all other datatypes (including all complex datatypes), the +// offset corresponds to bytes. This function does not perform any +// bounds checking and negative offsets are perfectly legal. + +void ptrmap(char *type1, char *type2); +// This is a rarely used function that performs essentially the same +// operation as a C typedef. To manage datatypes at run-time, SWIG +// modules manage an internal symbol table of type mappings. This +// table keeps track of which types are equivalent to each other. The +// ptrmap() function provides a mechanism for scripts to add symbols +// to this table. For example : +// +// ptrmap double_p Real_p +// +// would make the types "double_p" and "Real_p" equivalent to each +// other. Pointers of either type could now be used interchangably. +// +// Normally this function is not needed, but it can be used to +// circumvent SWIG's normal type-checking behavior or to work around +// weird type-handling bugs. + +// Clear the ignore typemap + +%typemap(tcl,ignore) Tcl_Interp *; +%typemap(tcl8,ignore) Tcl_Interp *; + + + + + + + diff --git a/SWIG/Lib/tcl/swigtcl8.swg b/SWIG/Lib/tcl/swigtcl8.swg new file mode 100644 index 000000000..26fd7a0db --- /dev/null +++ b/SWIG/Lib/tcl/swigtcl8.swg @@ -0,0 +1,300 @@ +/* + * $Header$ + * + * swigtcl.swg + */ + +#include +#include +#include +#include + +#define SWIGTCL +#define SWIGTCL8 + +#if defined(_WIN32) || defined(__WIN32__) +# if defined(_MSC_VER) +# if defined(STATIC_LINKED) +# define SWIGEXPORT(a) a +# else +# define SWIGEXPORT(a) __declspec(dllexport) a +# endif +# else +# if defined(__BORLANDC__) +# define SWIGEXPORT(a) a _export +# else +# define SWIGEXPORT(a) a +# endif +#endif +#else +# define SWIGEXPORT(a) a +#endif + +#ifdef SWIG_GLOBAL +#define SWIGSTATICRUNTIME(a) SWIGEXPORT(a) +#else +#define SWIGSTATICRUNTIME(a) static a +#endif + +#ifdef __cplusplus +extern "C" { +#endif + +typedef struct _swig_type_info { + char *name; + void *(*converter)(void *); + struct _swig_type_info *next; + struct _swig_type_info *prev; +} _swig_type_info; + +static _swig_type_info *swig_types = 0; + +/* Register type mappings with the type-checker */ +SWIGSTATICRUNTIME(_swig_type_info *) +SWIG_TypeRegister(_swig_type_info *ti) +{ + _swig_type_info *tc, *head, *ret, *next; + /* Check to see if this type has already been registered */ + tc = swig_types; + while (tc) { + if (strcmp(tc->name, ti->name) == 0) { + /* Already exists in the table. Just add additional types to the list */ + head = tc; + next = tc->next; + goto l1; + } + tc = tc->prev; + } + head = ti; + next = 0; + + /* Place in list */ + ti->prev = swig_types; + swig_types = ti; + + /* Build linked lists */ + l1: + ret = head; + tc = ti + 1; + /* Patch up the rest of the links */ + while (tc->name) { + head->next = tc; + tc->prev = head; + head = tc; + tc++; + } + head->next = next; + return ret; +} + +/* Check the typename */ +SWIGSTATICRUNTIME(_swig_type_info *) +SWIG_TypeCheck(char *c, _swig_type_info *ty) +{ + _swig_type_info *s, *temp2; + if (!ty) return 0; /* Void pointer */ + s = ty->next; /* First element always just a name */ + while (s) { + if (strcmp(s->name,c) == 0) { + if (s == ty->next) return s; + /* Move s to the top of the linked list */ + s->prev->next = s->next; + if (s->next) { + s->next->prev = s->prev; + } + /* Insert s as second element in the list */ + s->next = ty->next; + if (ty->next) ty->next->prev = s; + ty->next = s; + return s; + } + s = s->next; + } + return 0; +} + +/* Convert a pointer value */ +SWIGSTATICRUNTIME(int) +SWIG_ConvertPtr(Tcl_Interp *interp, Tcl_Obj *oc, void **ptr, _swig_type_info *ty) +{ + unsigned long p; + register int d; + _swig_type_info *tc; + char *c = Tcl_GetStringFromObj(oc,NULL); + p = 0; + /* Pointer values must start with leading underscore */ + if (*c != '_') { + *ptr = (void *) 0; + if (strcmp(c,"NULL") == 0) return TCL_OK; + } + c++; + /* Extract hex value from pointer */ + while (d = *c) { + if ((d >= '0') && (d <= '9')) + p = (p << 4) + (d - '0'); + else if ((d >= 'a') && (d <= 'f')) + p = (p << 4) + (d - ('a'-10)); + else + break; + c++; + } + *ptr = (void *) p; + if (ty) { + tc = SWIG_TypeCheck(c,ty); + if (!tc) { + Tcl_SetResult(interp,"Type error. Expected ", TCL_STATIC); + Tcl_AppendElement(interp, ty->name); + return TCL_ERROR; + } + if (tc->converter) { + *ptr = (*tc->converter)((void *) p); + } + } + return TCL_OK; +} + +/* Take a pointer and convert it to a string */ +SWIGSTATICRUNTIME(void) +SWIG_MakePtr(char *c, void *ptr, _swig_type_info *ty) { + static char hex[17] = "0123456789abcdef"; + unsigned long p, s; + char result[24], *r; + r = result; + p = (unsigned long) ptr; + if (p > 0) { + while (p > 0) { + s = p & 0xf; + *(r++) = hex[s]; + p = p >> 4; + } + *r = '_'; + while (r >= result) + *(c++) = *(r--); + strcpy (c, ty->name); + } else { + strcpy (c, "NULL"); + } +} + +/* Create a new pointer object */ +SWIGSTATICRUNTIME(Tcl_Obj *) +SWIG_NewPointerObj(void *ptr, _swig_type_info *type) { + char result[256]; + Tcl_Obj *robj; + SWIG_MakePtr(result,ptr,type); + robj = Tcl_NewStringObj(result,-1); + return robj; +} + +/* Get arguments */ +SWIGSTATICRUNTIME(int) +SWIG_GetArgs(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], const char *fmt, ...) +{ + int argno = 0, opt = 0, tempi; + int us = 0; + double tempd; + const char *c; + va_list ap; + void *vptr; + _swig_type_info *ty; + + va_start(ap,fmt); + for (c = fmt; (*c && (*c != ':')); c++,argno++) { + if (*c == '|') { + opt = 1; + c++; + } + if (argno >= (objc-1)) { + if (!opt) { + Tcl_SetResult(interp,"Wrong # args. ", TCL_STATIC); + goto argerror; + } else { + va_end(ap); + return TCL_OK; + } + } + vptr = va_arg(ap,void *); + if (vptr) { + us = 0; + if (*c == 'u') { + us = 1; + c++; + } + switch(*c) { + case 'i': + case 'l': + case 'h': + case 'b': + if (Tcl_GetIntFromObj(interp,objv[argno+1],&tempi) != TCL_OK) goto argerror; + if (*c == 'i') *((int *)vptr) = tempi; + else if (*c == 'l') *((long *)vptr) = tempi; + else if (*c == 'h') *((short*)vptr) = tempi; + else if (*c == 'b') *((unsigned char *)vptr) = tempi; + break; + case 'f': + case 'd': + if (Tcl_GetDoubleFromObj(interp,objv[argno+1],&tempd) != TCL_OK) goto argerror; + if (*c == 'f') *((float *) vptr) = tempd; + else if (*c == 'd') *((double*) vptr) = tempd; + break; + case 's': + if (*(c+1) == '#') { + int *vlptr = (int *) va_arg(ap, void *); + *((char **) vptr) = Tcl_GetStringFromObj(objv[argno+1], vlptr); + c++; + } else { + *((char **)vptr) = Tcl_GetStringFromObj(objv[argno+1],NULL); + } + break; + case 'c': + *((char *)vptr) = *(Tcl_GetStringFromObj(objv[argno+1],NULL)); + break; + case 'p': + ty = (_swig_type_info *) va_arg(ap, void *); + if (SWIG_ConvertPtr(interp, objv[argno+1], (void **) vptr, ty) == TCL_ERROR) goto argerror; + break; + case 'o': + *((Tcl_Obj **)vptr) = objv[argno+1]; + break; + default: + break; + } + } + } + if ((objc-1) > argno) { + Tcl_SetResult(interp,"Wrong # args.", TCL_STATIC); + goto argerror; + } + va_end(ap); + return TCL_OK; + + argerror: + { + char temp[32]; + sprintf(temp,"%d", argno); + Tcl_AppendResult(interp,strchr(fmt,':'), " argument ", temp, NULL); + va_end(ap); + return TCL_ERROR; + } +} + +/* Structure for command table */ +typedef struct { + const char *name; + int (*wrapper)(ClientData, Tcl_Interp *, int, Tcl_Obj *CONST []); + ClientData clientdata; +} _swig_command_info; + +/* Structure for variable linking table */ +typedef struct { + const char *name; + void *addr; + char * (*get)(ClientData, Tcl_Interp *, char *, char *, int); + char * (*set)(ClientData, Tcl_Interp *, char *, char *, int); +} _swig_var_info; + + +#ifdef __cplusplus +} +#endif + diff --git a/SWIG/Lib/tcl/tclsh.i b/SWIG/Lib/tcl/tclsh.i new file mode 100644 index 000000000..839de3be9 --- /dev/null +++ b/SWIG/Lib/tcl/tclsh.i @@ -0,0 +1,86 @@ +// $Header$ +// +// SWIG File for building new tclsh program +// Dave Beazley +// April 25, 1996 +// + +#ifdef AUTODOC +%subsection "tclsh.i" +%text %{ +This module provides the Tcl_AppInit() function needed to build a +new version of the tclsh executable. This file should not be used +when using dynamic loading. To make an interface file work with +both static and dynamic loading, put something like this in your +interface file : + + #ifdef STATIC + %include tclsh.i + #endif +%} +#endif + +%{ + +/* A TCL_AppInit() function that lets you build a new copy + * of tclsh. + * + * The macro SWIG_init contains the name of the initialization + * function in the wrapper file. + */ + +#ifndef SWIG_RcFileName +char *SWIG_RcFileName = "~/.myapprc"; +#endif + + +#ifdef MAC_TCL +extern int MacintoshInit _ANSI_ARGS_((void)); +#endif + +int Tcl_AppInit(Tcl_Interp *interp){ + + if (Tcl_Init(interp) == TCL_ERROR) + return TCL_ERROR; + + /* Now initialize our functions */ + + if (SWIG_init(interp) == TCL_ERROR) + return TCL_ERROR; +#if TCL_MAJOR_VERSION > 7 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 5 + Tcl_SetVar(interp,"tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY); +#else + tcl_RcFileName = SWIG_RcFileName; +#endif +#ifdef SWIG_RcRsrcName + Tcl_SetVar(interp,"tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL); +#endif + + return TCL_OK; +} + +#if TCL_MAJOR_VERSION > 7 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 4 +int main(int argc, char **argv) { +#ifdef MAC_TCL + char *newArgv[2]; + + if (MacintoshInit() != TCL_OK) { + Tcl_Exit(1); + } + + argc = 1; + newArgv[0] = "tclsh"; + newArgv[1] = NULL; + argv = newArgv; +#endif + + Tcl_Main(argc, argv, Tcl_AppInit); + return(0); + +} +#else +extern int main(); +#endif + +%} + diff --git a/SWIG/Lib/tcl/typemaps.i b/SWIG/Lib/tcl/typemaps.i new file mode 100644 index 000000000..071895860 --- /dev/null +++ b/SWIG/Lib/tcl/typemaps.i @@ -0,0 +1,555 @@ +// +// SWIG Typemap library +// Dave Beazley +// May 4, 1997 +// +// Tcl implementation +// +// This library provides standard typemaps for modifying SWIG's behavior. +// With enough entries in this file, I hope that very few people actually +// ever need to write a typemap. + +#ifdef AUTODOC +%section "Typemap Library (Tcl)",info,after,pre,nosort,skip=1,chop_left=3,chop_right=0,chop_top=0,chop_bottom=0 +%text %{ +%include typemaps.i + +The SWIG typemap library provides a language independent mechanism for +supporting output arguments, input values, and other C function +calling mechanisms. The primary use of the library is to provide a +better interface to certain C function--especially those involving +pointers. +%} + +#endif + +// ------------------------------------------------------------------------ +// Pointer handling +// +// These mappings provide support for input/output arguments and common +// uses for C/C++ pointers. +// ------------------------------------------------------------------------ + +// INPUT typemaps. +// These remap a C pointer to be an "INPUT" value which is passed by value +// instead of reference. + +#ifdef AUTODOC +%subsection "Input Methods" + +%text %{ +The following methods can be applied to turn a pointer into a simple +"input" value. That is, instead of passing a pointer to an object, +you would use a real value instead. + + int *INPUT + short *INPUT + long *INPUT + unsigned int *INPUT + unsigned short *INPUT + unsigned long *INPUT + unsigned char *INPUT + float *INPUT + double *INPUT + +To use these, suppose you had a C function like this : + + double fadd(double *a, double *b) { + return *a+*b; + } + +You could wrap it with SWIG as follows : + + %include typemaps.i + double fadd(double *INPUT, double *INPUT); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *INPUT { double *a, double *b }; + double fadd(double *a, double *b); + +%} +#endif + + +%typemap(tcl,in) double *INPUT(double temp) +{ + if (Tcl_GetDouble(interp,$source,&temp) == TCL_ERROR) { + return TCL_ERROR; + } + $target = &temp; +} + +%typemap(tcl,in) float *INPUT(double dvalue, float temp) +{ + if (Tcl_GetDouble(interp,$source,&dvalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (float) dvalue; + $target = &temp; +} + +%typemap(tcl,in) int *INPUT(int temp) +{ + if (Tcl_GetInt(interp,$source,&temp) == TCL_ERROR) { + return TCL_ERROR; + } + $target = &temp; +} + +%typemap(tcl,in) short *INPUT(int ivalue, short temp) +{ + if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (short) ivalue; + $target = &temp; +} + +%typemap(tcl,in) long *INPUT(int ivalue, long temp) +{ + if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (long) ivalue; + $target = &temp; +} + +%typemap(tcl,in) unsigned int *INPUT(int ivalue, unsigned int temp) +{ + if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned int) ivalue; + $target = &temp; +} + +%typemap(tcl,in) unsigned short *INPUT(int ivalue, unsigned short temp) +{ + if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned short) ivalue; + $target = &temp; +} + +%typemap(tcl,in) unsigned long *INPUT(int ivalue, unsigned long temp) +{ + if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned long) ivalue; + $target = &temp; +} + +%typemap(tcl,in) unsigned char *INPUT(int ivalue, unsigned char temp) +{ + if (Tcl_GetInt(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned char) ivalue; + $target = &temp; +} + + + +// OUTPUT typemaps. These typemaps are used for parameters that +// are output only. The output value is appended to the result as +// a list element. + + +#ifdef AUTODOC +%subsection "Output Methods" + +%text %{ +The following methods can be applied to turn a pointer into an "output" +value. When calling a function, no input value would be given for +a parameter, but an output value would be returned. In the case of +multiple output values, they are returned in the form of a Tcl list. + + int *OUTPUT + short *OUTPUT + long *OUTPUT + unsigned int *OUTPUT + unsigned short *OUTPUT + unsigned long *OUTPUT + unsigned char *OUTPUT + float *OUTPUT + double *OUTPUT + +For example, suppose you were trying to wrap the modf() function in the +C math library which splits x into integral and fractional parts (and +returns the integer part in one of its parameters).K: + + double modf(double x, double *ip); + +You could wrap it with SWIG as follows : + + %include typemaps.i + double modf(double x, double *OUTPUT); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *OUTPUT { double *ip }; + double modf(double x, double *ip); + +The Tcl output of the function would be a list containing both +output values. + +%} + +#endif + +// Force the argument to be ignored. + +%typemap(tcl,ignore) int *OUTPUT(int temp), + short *OUTPUT(short temp), + long *OUTPUT(long temp), + unsigned int *OUTPUT(unsigned int temp), + unsigned short *OUTPUT(unsigned short temp), + unsigned long *OUTPUT(unsigned long temp), + unsigned char *OUTPUT(unsigned char temp), + float *OUTPUT(float temp), + double *OUTPUT(double temp) +{ + $target = &temp; +} + +%typemap(tcl,argout) int *OUTPUT, + short *OUTPUT, + long *OUTPUT +{ + char dtemp[64]; + sprintf(dtemp,"%ld",(long) *($source)); + Tcl_AppendElement(interp,dtemp); +} + +%typemap(tcl,argout) unsigned int *OUTPUT, + unsigned short *OUTPUT, + unsigned long *OUTPUT, + unsigned char *OUTPUT +{ + char dtemp[64]; + sprintf(dtemp,"%lu", (unsigned long) *($source)); + Tcl_AppendElement(interp,dtemp); +} + +%typemap(tcl,argout) float *OUTPUT, + double *OUTPUT +{ + char dtemp[TCL_DOUBLE_SPACE]; + Tcl_PrintDouble(interp, (double) *($source), dtemp); + Tcl_AppendElement(interp,dtemp); +} + +// BOTH +// Mappings for an argument that is both an input and output +// parameter + +#ifdef AUTODOC +%subsection "Input/Output Methods" + +%text %{ +The following methods can be applied to make a function parameter both +an input and output value. This combines the behavior of both the +"INPUT" and "OUTPUT" methods described earlier. Output values are +returned in the form of a Tcl list. + + int *BOTH + short *BOTH + long *BOTH + unsigned int *BOTH + unsigned short *BOTH + unsigned long *BOTH + unsigned char *BOTH + float *BOTH + double *BOTH + +For example, suppose you were trying to wrap the following function : + + void neg(double *x) { + *x = -(*x); + } + +You could wrap it with SWIG as follows : + + %include typemaps.i + void neg(double *BOTH); + +or you can use the %apply directive : + + %include typemaps.i + %apply double *BOTH { double *x }; + void neg(double *x); + +Unlike C, this mapping does not directly modify the input value (since +this makes no sense in Tcl). Rather, the modified input value shows +up as the return value of the function. Thus, to apply this function +to a Tcl variable you might do this : + + set x [neg $x] + +%} + +#endif + +%typemap(tcl,in) int *BOTH = int *INPUT; +%typemap(tcl,in) short *BOTH = short *INPUT; +%typemap(tcl,in) long *BOTH = long *INPUT; +%typemap(tcl,in) unsigned int *BOTH = unsigned int *INPUT; +%typemap(tcl,in) unsigned short *BOTH = unsigned short *INPUT; +%typemap(tcl,in) unsigned long *BOTH = unsigned long *INPUT; +%typemap(tcl,in) unsigned char *BOTH = unsigned char *INPUT; +%typemap(tcl,in) float *BOTH = float *INPUT; +%typemap(tcl,in) double *BOTH = double *INPUT; + +%typemap(tcl,argout) int *BOTH = int *OUTPUT; +%typemap(tcl,argout) short *BOTH = short *OUTPUT; +%typemap(tcl,argout) long *BOTH = long *OUTPUT; +%typemap(tcl,argout) unsigned int *BOTH = unsigned int *OUTPUT; +%typemap(tcl,argout) unsigned short *BOTH = unsigned short *OUTPUT; +%typemap(tcl,argout) unsigned long *BOTH = unsigned long *OUTPUT; +%typemap(tcl,argout) unsigned char *BOTH = unsigned char *OUTPUT; +%typemap(tcl,argout) float *BOTH = float *OUTPUT; +%typemap(tcl,argout) double *BOTH = double *OUTPUT; + +// -------------------------------------------------------------------- +// Special types +// +// -------------------------------------------------------------------- + +// If interp * appears as a function argument, we ignore it and get +// it from the wrapper function. + +#ifdef AUTODOC +%subsection "Special Methods" + +%text %{ +The typemaps.i library also provides the following mappings : + +Tcl_Interp *interp + + Passes the current Tcl_Interp value directly to a C function. + This can be used to work with existing wrapper functions or + if you just need the interp value for some reason. When used, + the 'interp' parameter becomes hidden in the Tcl interface--that + is, you don't specify it explicitly. SWIG fills in its value + automatically. + +int Tcl_Result + + Makes the integer return code of a function the return value + of a SWIG generated wrapper function. For example : + + int foo() { + ... do stuff ... + return TCL_OK; + } + + could be wrapped as follows : + + %include typemaps.i + %apply int Tcl_Result { int foo }; + int foo(); + +%} + +#endif + +%typemap(tcl,ignore) Tcl_Interp *interp { + $target = interp; +} + +// If return code is a Tcl_Result, simply pass it on + +%typemap(tcl,out) int Tcl_Result { + interp->result = ""; + return $source; +} + +/*************************************************************************** + * Tcl 8.0 typemaps + ***************************************************************************/ + +// ------------------------------------------------------------------------ +// Pointer handling +// +// These mappings provide support for input/output arguments and common +// uses for C/C++ pointers. +// ------------------------------------------------------------------------ + +// INPUT typemaps. +// These remap a C pointer to be an "INPUT" value which is passed by value +// instead of reference. + +%typemap(tcl8,in) double *INPUT(double temp) +{ + if (Tcl_GetDoubleFromObj(interp,$source,&temp) == TCL_ERROR) { + return TCL_ERROR; + } + $target = &temp; +} + +%typemap(tcl8,in) float *INPUT(double dvalue, float temp) +{ + if (Tcl_GetDoubleFromObj(interp,$source,&dvalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (float) dvalue; + $target = &temp; +} + +%typemap(tcl8,in) int *INPUT(int temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&temp) == TCL_ERROR) { + return TCL_ERROR; + } + $target = &temp; +} + +%typemap(tcl8,in) short *INPUT(int ivalue, short temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (short) ivalue; + $target = &temp; +} + +%typemap(tcl8,in) long *INPUT(int ivalue, long temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (long) ivalue; + $target = &temp; +} + +%typemap(tcl8,in) unsigned int *INPUT(int ivalue, unsigned int temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned int) ivalue; + $target = &temp; +} + +%typemap(tcl8,in) unsigned short *INPUT(int ivalue, unsigned short temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned short) ivalue; + $target = &temp; +} + +%typemap(tcl8,in) unsigned long *INPUT(int ivalue, unsigned long temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned long) ivalue; + $target = &temp; +} + +%typemap(tcl8,in) unsigned char *INPUT(int ivalue, unsigned char temp) +{ + if (Tcl_GetIntFromObj(interp,$source,&ivalue) == TCL_ERROR) { + return TCL_ERROR; + } + temp = (unsigned char) ivalue; + $target = &temp; +} + + +// OUTPUT typemaps. These typemaps are used for parameters that +// are output only. The output value is appended to the result as +// a list element. + +// Force the argument to be ignored. + +%typemap(tcl8,ignore) int *OUTPUT(int temp), + short *OUTPUT(short temp), + long *OUTPUT(long temp), + unsigned int *OUTPUT(unsigned int temp), + unsigned short *OUTPUT(unsigned short temp), + unsigned long *OUTPUT(unsigned long temp), + unsigned char *OUTPUT(unsigned char temp), + float *OUTPUT(float temp), + double *OUTPUT(double temp) +{ + $target = &temp; +} + +%typemap(tcl8,argout) int *OUTPUT, + short *OUTPUT, + long *OUTPUT, + unsigned int *OUTPUT, + unsigned short *OUTPUT, + unsigned long *OUTPUT, + unsigned char *OUTPUT +{ + Tcl_Obj *o; + o = Tcl_NewIntObj((int) *($source)); + Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o); +} + +%typemap(tcl8,argout) float *OUTPUT, + double *OUTPUT +{ + Tcl_Obj *o; + o = Tcl_NewDoubleObj((double) *($source)); + Tcl_ListObjAppendElement(interp,Tcl_GetObjResult(interp),o); +} + +// BOTH +// Mappings for an argument that is both an input and output +// parameter + +%typemap(tcl8,in) int *BOTH = int *INPUT; +%typemap(tcl8,in) short *BOTH = short *INPUT; +%typemap(tcl8,in) long *BOTH = long *INPUT; +%typemap(tcl8,in) unsigned int *BOTH = unsigned int *INPUT; +%typemap(tcl8,in) unsigned short *BOTH = unsigned short *INPUT; +%typemap(tcl8,in) unsigned long *BOTH = unsigned long *INPUT; +%typemap(tcl8,in) unsigned char *BOTH = unsigned char *INPUT; +%typemap(tcl8,in) float *BOTH = float *INPUT; +%typemap(tcl8,in) double *BOTH = double *INPUT; + +%typemap(tcl8,argout) int *BOTH = int *OUTPUT; +%typemap(tcl8,argout) short *BOTH = short *OUTPUT; +%typemap(tcl8,argout) long *BOTH = long *OUTPUT; +%typemap(tcl8,argout) unsigned int *BOTH = unsigned int *OUTPUT; +%typemap(tcl8,argout) unsigned short *BOTH = unsigned short *OUTPUT; +%typemap(tcl8,argout) unsigned long *BOTH = unsigned long *OUTPUT; +%typemap(tcl8,argout) unsigned char *BOTH = unsigned char *OUTPUT; +%typemap(tcl8,argout) float *BOTH = float *OUTPUT; +%typemap(tcl8,argout) double *BOTH = double *OUTPUT; + +// -------------------------------------------------------------------- +// Special types +// +// -------------------------------------------------------------------- + +// If interp * appears as a function argument, we ignore it and get +// it from the wrapper function. + +%typemap(tcl8,ignore) Tcl_Interp *interp { + $target = interp; +} + +// If return code is a Tcl_Result, simply pass it on + +%typemap(tcl8,out) int Tcl_Result { + return $source; +} + + + + + + + + diff --git a/SWIG/Lib/tcl/wish.i b/SWIG/Lib/tcl/wish.i new file mode 100644 index 000000000..201a438b9 --- /dev/null +++ b/SWIG/Lib/tcl/wish.i @@ -0,0 +1,163 @@ +// +// $Header$ +// +// SWIG File for making wish +// Dave Beazley +// April 25, 1996 +// +/* Revision History + * $Log$ + * Revision 1.1 2000/01/11 21:15:54 beazley + * Added files + * + * Revision 1.2 1999/11/05 21:45:14 beazley + * Minor Changes + * + * Revision 1.1.1.1 1999/02/28 02:00:56 beazley + * Swig1.1 + * + * Revision 1.1 1996/05/22 19:47:45 beazley + * Initial revision + * + */ + +#ifdef AUTODOC +%subsection "wish.i" +%text %{ +This module provides the Tk_AppInit() function needed to build a +new version of the wish executable. Like tclsh.i, this file should +not be used with dynamic loading. To make an interface file work with +both static and dynamic loading, put something like this in your +interface file : + + #ifdef STATIC + %include wish.i + #endif + +A startup file may be specified by defining the symbol SWIG_RcFileName +as follows (this should be included in a code-block) : + + #define SWIG_RcFileName "~/.mywishrc" +%} +#endif + +%{ + + +/* Initialization code for wish */ + +#include + +#ifndef SWIG_RcFileName +char *SWIG_RcFileName = "~/.wishrc"; +#endif + +#ifdef MAC_TCL +extern int MacintoshInit _ANSI_ARGS_((void)); +extern int SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp)); +#endif + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppInit -- + * + * This procedure performs application-specific initialization. + * Most applications, especially those that incorporate additional + * packages, will have their own version of this procedure. + * + * Results: + * Returns a standard Tcl completion code, and leaves an error + * message in interp->result if an error occurs. + * + * Side effects: + * Depends on the startup script. + * + *---------------------------------------------------------------------- + */ + +int Tcl_AppInit(Tcl_Interp *interp) +{ +#ifndef MAC_TCL + Tk_Window main; + main = Tk_MainWindow(interp); +#endif + /* + * Call the init procedures for included packages. Each call should + * look like this: + * + * if (Mod_Init(interp) == TCL_ERROR) { + * return TCL_ERROR; + * } + * + * where "Mod" is the name of the module. + */ + + if (Tcl_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + if (Tk_Init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + + /* + * Call Tcl_CreateCommand for application-specific commands, if + * they weren't already created by the init procedures called above. + */ + + if (SWIG_init(interp) == TCL_ERROR) { + return TCL_ERROR; + } + +#ifdef MAC_TCL + SetupMainInterp(interp); +#endif + + /* + * Specify a user-specific startup file to invoke if the application + * is run interactively. Typically the startup file is "~/.apprc" + * where "app" is the name of the application. If this line is deleted + * then no user-specific startup file will be run under any conditions. + */ + +#if TCL_MAJOR_VERSION >= 8 || TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION >= 5 + Tcl_SetVar(interp,"tcl_rcFileName",SWIG_RcFileName,TCL_GLOBAL_ONLY); +#else + tcl_RcFileName = SWIG_RcFileName; +#endif + +/* For Macintosh might also want this */ + +#ifdef MAC_TCL +#ifdef SWIG_RcRsrcName + Tcl_SetVar(interp,"tcl_rcRsrcName",SWIG_RcRsrcName,TCL_GLOBAL_ONLY); +#endif +#endif + return TCL_OK; +} + +#if TK_MAJOR_VERSION >= 4 +int main(int argc, char **argv) { + +#ifdef MAC_TCL + char *newArgv[2]; + if (MacintoshInit() != TCL_OK) { + Tcl_Exit(1); + } + argc = 1; + newArgv[0] = "Wish"; + newArgv[1] = NULL; + argv = newArgv; +#endif + Tk_Main(argc, argv, Tcl_AppInit); + return(0); +} +#else +extern int main(); +#endif + +%} + + + diff --git a/SWIG/Lib/timers.i b/SWIG/Lib/timers.i new file mode 100644 index 000000000..996408c89 --- /dev/null +++ b/SWIG/Lib/timers.i @@ -0,0 +1,173 @@ +// +// $Header$ +// +// timers.i +// A SWIG file for adding various timing functions. +// Really, this is modeled after the timers in the CMMD +// message passing library for the CM-5. +// +// Dave Beazley +// April 2, 1996 +// +/* Revision history + * $Log$ + * Revision 1.1 2000/01/11 21:15:49 beazley + * Added files + * + * Revision 1.1.1.1 1999/02/28 02:00:53 beazley + * Swig1.1 + * + * Revision 1.1 1996/05/22 17:27:01 beazley + * Initial revision + * + */ + +%module timers +%{ + +#include +#define SWIG_NTIMERS 64 + +static clock_t telapsed[SWIG_NTIMERS]; +static clock_t tstart[SWIG_NTIMERS]; +static clock_t tend[SWIG_NTIMERS]; + +/*----------------------------------------------------------------- + * SWIG_timer_clear(int i) + * + * Clears timer i. + *----------------------------------------------------------------- */ + +void +SWIG_timer_clear(int i) +{ + if ((i >= 0) && (i < SWIG_NTIMERS)) + telapsed[i] = 0; +} + + +/*----------------------------------------------------------------- + * SWIG_timer_start(int i) + * + * Starts timer i + *----------------------------------------------------------------- */ + +void +SWIG_timer_start(int i) +{ + if ((i >= 0) && (i < SWIG_NTIMERS)) + tstart[i] = clock(); +} + + +/*----------------------------------------------------------------- + * SWIG_timer_stop(int i) + * + * Stops timer i and accumulates elapsed time + *----------------------------------------------------------------- */ + +void +SWIG_timer_stop(int i) +{ + if ((i >= 0) && (i < SWIG_NTIMERS)) { + tend[i] = clock(); + telapsed[i] += (tend[i] - tstart[i]); + } +} + +/*----------------------------------------------------------------- + * SWIG_timer_elapsed(int i) + * + * Returns the time elapsed on timer i in seconds. + *----------------------------------------------------------------- */ + +double +SWIG_timer_elapsed(int i) +{ + double t; + if ((i >= 0) && (i < SWIG_NTIMERS)) { + t = (double) telapsed[i]/(double) CLOCKS_PER_SEC; + return(t); + } else { + return 0; + } +} + +%} + +%section "Timer Functions",pre,after,chop_left=3,nosort,info,chop_right = 0, chop_top=0,chop_bottom=0 + +%text %{ +%include timers.i + +This module provides a collection of timing functions designed for +performance analysis and benchmarking of different code fragments. + +A total of 64 different timers are available. Each timer can be +managed independently using four functions : + + timer_clear(int n) Clears timer n + timer_start(int n) Start timer n + timer_stop(int n) Stop timer n + timer_elapsed(int n) Return elapsed time (in seconds) + +All timers measure CPU time. + +Since each timer can be accessed independently, it is possible +to use groups of timers for measuring different aspects of code +performance. To use a timer, simply use code like this : +%} + +#if defined(SWIGTCL) +%text %{ + timer_clear 0 + timer_start 0 + .. a bunch of Tcl code ... + timer_stop 0 + puts "[timer_elapsed 0] seconds of CPU time" +%} +#elif defined(SWIGPERL) +%text %{ + timer_clear(0); + timer_start(0); + .. a bunch of Perl code ... + timer_stop(0); + print timer_elapsed(0)," seconds of CPU time\n"; +%} +#elif defined(SWIGPYTHON) +%text %{ + timer_clear(0) + timer_start(0) + ... a bunch of Python code ... + timer_stop(0) + print timer_elapsed(0)," seconds of CPU time" +%} +#endif + +%text %{ +A single timer can be stopped and started repeatedly to provide +a cummulative timing effect. + +As a general performance note, making frequent calls to the timing +functions can severely degrade performance (due to operating system +overhead). The resolution of the timers may be poor for extremely +short code fragments. Therefore, the timers work best for +computationally intensive operations. +%} + + +%name(timer_clear) void SWIG_timer_clear(int n); +/* Clears timer n. */ + +%name(timer_start) void SWIG_timer_start(int n); +/* Starts timer n. */ + +%name(timer_stop) void SWIG_timer_stop(int n); +/* Stops timer n. */ + +%name(timer_elapsed) double SWIG_timer_elapsed(int n); +/* Return the elapsed time (in seconds) of timer n */ + + + +