Merge remote-tracking branch 'upstream/master' into memleak

# Conflicts:
#	CHANGES.current
This commit is contained in:
Andrew Rogers 2021-05-17 22:44:56 +01:00
commit 04a0b526eb
192 changed files with 44 additions and 23275 deletions

View file

@ -1,615 +0,0 @@
/* Define a C preprocessor symbol that can be used in interface files
to distinguish between the SWIG language modules. */
#define SWIG_ALLEGRO_CL
#define %ffargs(...) %feature("ffargs", "1", ##__VA_ARGS__)
%ffargs(strings_convert="t");
/* typemaps for argument and result type conversions. */
%typemap(lin,numinputs=1) SWIGTYPE "(cl::let (($out $in))\n $body)";
%typemap(lout) bool, char, unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
float, double, long double, char *, void *,
enum SWIGTYPE "(cl::setq ACL_ffresult $body)";
%typemap(lout) void "$body";
#ifdef __cplusplus
%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&
%{ (cl:let* ((address $body)
(new-inst (cl:make-instance '$lclass :foreign-address address)))
(cl:when (cl:and $owner (cl:not (cl:zerop address)))
(excl:schedule-finalization new-inst #'$ldestructor))
(cl:setq ACL_ffresult new-inst)) %}
%typemap(lout) SWIGTYPE "(cl::let* ((address $body)\n (new-inst (cl::make-instance '$lclass :foreign-address address)))\n (cl::unless (cl::zerop address)\n (excl:schedule-finalization new-inst #'$ldestructor))\n (cl::setq ACL_ffresult new-inst))";
#else
%typemap(lout) SWIGTYPE[ANY], SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE
%{ (cl:let* ((address $body)
(new-inst (cl:make-instance '$lclass :foreign-address address)))
(cl:setq ACL_ffresult new-inst)) %}
#endif
%typemap(lisptype) bool, const bool "cl:boolean";
%typemap(lisptype) char, const char "cl:character";
%typemap(lisptype) unsigned char, const unsigned char "cl:integer";
%typemap(lisptype) signed char, const signed char "cl:integer";
%typemap(ffitype) bool, const bool ":int";
%typemap(ffitype) char, const char,
signed char, const signed char ":char";
%typemap(ffitype) unsigned char, const unsigned char ":unsigned-char";
%typemap(ffitype) short, const short,
signed short, const signed short ":short";
%typemap(ffitype) unsigned short, const unsigned short ":unsigned-short";
%typemap(ffitype) int, const int, signed int, const signed int ":int";
%typemap(ffitype) unsigned int, const unsigned int ":unsigned-int";
%typemap(ffitype) long, const long, signed long, const signed long ":long";
%typemap(ffitype) unsigned long, const unsigned long ":unsigned-long";
%typemap(ffitype) float, const float ":float";
%typemap(ffitype) double, const double ":double";
%typemap(ffitype) char *, const char *, signed char *,
const signed char *, signed char &,
const signed char & "(* :char)";
%typemap(ffitype) unsigned char *, const unsigned char *,
unsigned char &, const unsigned char & "(* :unsigned-char)";
%typemap(ffitype) short *, const short *, short &,
const short & "(* :short)";
%typemap(ffitype) unsigned short *, const unsigned short *,
unsigned short &, const unsigned short & "(* :unsigned-short)";
%typemap(ffitype) int *, const int *, int &, const int & "(* :int)";
%typemap(ffitype) unsigned int *, const unsigned int *,
unsigned int &, const unsigned int & "(* :unsigned-int)";
%typemap(ffitype) void * "(* :void)";
%typemap(ffitype) void ":void";
%typemap(ffitype) enum SWIGTYPE ":int";
%typemap(ffitype) SWIGTYPE & "(* :void)";
%typemap(ffitype) SWIGTYPE && "(* :void)";
/* const typemaps
idea: marshall all primitive c types to their respective lisp types
to maintain const corretness. For pointers/references, all bets
are off if you try to modify them.
idea: add a constant-p slot to the base foreign-pointer class. For
constant pointer/references check this value when setting (around method?)
and error if a setf operation is performed on the address of this object.
*/
/*
%exception %{
try {
$action
} catch (...) {
return $null;
}
%}
*/
// %typemap(throws) SWIGTYPE {
// (void)$1;
// SWIG_fail;
// }
%typemap(ctype) bool, const bool "int";
%typemap(ctype) char, unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
float, double, long double, char *, void *, void,
enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[],
SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE &&, const SWIGTYPE "$1_ltype";
%typemap(ctype) SWIGTYPE "$&1_type";
%typemap(in) bool "$1 = (bool)$input;";
%typemap(in) char, unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
float, double, long double, char *, void *, void,
enum SWIGTYPE, SWIGTYPE *, SWIGTYPE[],
SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$1 = $input;";
%typemap(in) SWIGTYPE "$1 = *$input;";
/* We don't need to do any actual C-side typechecking, but need to
use the precedence values to choose which overloaded function
interfaces to generate when conflicts arise. */
/* predefined precedence values
Symbolic Name Precedence Value
------------------------------ ------------------
SWIG_TYPECHECK_POINTER 0
SWIG_TYPECHECK_VOIDPTR 10
SWIG_TYPECHECK_BOOL 15
SWIG_TYPECHECK_UINT8 20
SWIG_TYPECHECK_INT8 25
SWIG_TYPECHECK_UINT16 30
SWIG_TYPECHECK_INT16 35
SWIG_TYPECHECK_UINT32 40
SWIG_TYPECHECK_INT32 45
SWIG_TYPECHECK_UINT64 50
SWIG_TYPECHECK_INT64 55
SWIG_TYPECHECK_UINT128 60
SWIG_TYPECHECK_INT128 65
SWIG_TYPECHECK_INTEGER 70
SWIG_TYPECHECK_FLOAT 80
SWIG_TYPECHECK_DOUBLE 90
SWIG_TYPECHECK_COMPLEX 100
SWIG_TYPECHECK_UNICHAR 110
SWIG_TYPECHECK_UNISTRING 120
SWIG_TYPECHECK_CHAR 130
SWIG_TYPECHECK_STRING 140
SWIG_TYPECHECK_BOOL_ARRAY 1015
SWIG_TYPECHECK_INT8_ARRAY 1025
SWIG_TYPECHECK_INT16_ARRAY 1035
SWIG_TYPECHECK_INT32_ARRAY 1045
SWIG_TYPECHECK_INT64_ARRAY 1055
SWIG_TYPECHECK_INT128_ARRAY 1065
SWIG_TYPECHECK_FLOAT_ARRAY 1080
SWIG_TYPECHECK_DOUBLE_ARRAY 1090
SWIG_TYPECHECK_CHAR_ARRAY 1130
SWIG_TYPECHECK_STRING_ARRAY 1140
*/
%typecheck(SWIG_TYPECHECK_BOOL) bool { $1 = 1; };
%typecheck(SWIG_TYPECHECK_CHAR) char { $1 = 1; };
%typecheck(SWIG_TYPECHECK_FLOAT) float { $1 = 1; };
%typecheck(SWIG_TYPECHECK_DOUBLE) double { $1 = 1; };
%typecheck(SWIG_TYPECHECK_STRING) char * { $1 = 1; };
%typecheck(SWIG_TYPECHECK_INTEGER)
unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
enum SWIGTYPE { $1 = 1; };
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&,
SWIGTYPE[], SWIGTYPE[ANY],
SWIGTYPE { $1 = 1; };
/* This maps C/C++ types to Lisp classes for overload dispatch */
%typemap(lispclass) bool "t";
%typemap(lispclass) char "cl:character";
%typemap(lispclass) unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
enum SWIGTYPE "cl:integer";
%typemap(lispclass) float "cl:single-float";
%typemap(lispclass) double "cl:double-float";
%typemap(lispclass) char * "cl:string";
%typemap(out) void "";
%typemap(out) bool "$result = (int)$1;";
%typemap(out) char, unsigned char, signed char,
short, signed short, unsigned short,
int, signed int, unsigned int,
long, signed long, unsigned long,
float, double, long double, char *, void *,
enum SWIGTYPE, SWIGTYPE *,
SWIGTYPE[ANY], SWIGTYPE &, SWIGTYPE && "$result = $1;";
#ifdef __cplusplus
%typemap(out) SWIGTYPE "$result = new $1_ltype($1);";
#else
%typemap(out) SWIGTYPE {
$result = ($&1_ltype) malloc(sizeof($1_type));
memmove($result, &$1, sizeof($1_type));
}
#endif
//////////////////////////////////////////////////////////////
// UCS-2 string conversion
// should this be SWIG_TYPECHECK_CHAR?
%typecheck(SWIG_TYPECHECK_UNICHAR) wchar_t { $1 = 1; };
%typemap(in) wchar_t "$1 = $input;";
%typemap(lin,numinputs=1) wchar_t "(cl::let (($out (cl:char-code $in)))\n $body)";
%typemap(lin,numinputs=1) wchar_t * "(excl:with-native-string ($out $in
:external-format #+little-endian :fat-le #-little-endian :fat)\n
$body)"
%typemap(out) wchar_t "$result = $1;";
%typemap(lout) wchar_t "(cl::setq ACL_ffresult (cl::code-char $body))";
%typemap(lout) wchar_t * "(cl::setq ACL_ffresult (excl:native-to-string $body
:external-format #+little-endian :fat-le #-little-endian :fat))";
%typemap(ffitype) wchar_t ":unsigned-short";
%typemap(lisptype) wchar_t "";
%typemap(ctype) wchar_t "wchar_t";
%typemap(lispclass) wchar_t "cl:character";
%typemap(lispclass) wchar_t * "cl:string";
//////////////////////////////////////////////////////////////
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }
/* name conversion for overloaded operators. */
#ifdef __cplusplus
%rename(__add__) *::operator+;
%rename(__pos__) *::operator+();
%rename(__pos__) *::operator+() const;
%rename(__sub__) *::operator-;
%rename(__neg__) *::operator-() const;
%rename(__neg__) *::operator-();
%rename(__mul__) *::operator*;
%rename(__deref__) *::operator*();
%rename(__deref__) *::operator*() const;
%rename(__div__) *::operator/;
%rename(__mod__) *::operator%;
%rename(__logxor__) *::operator^;
%rename(__logand__) *::operator&;
%rename(__logior__) *::operator|;
%rename(__lognot__) *::operator~();
%rename(__lognot__) *::operator~() const;
%rename(__not__) *::operator!();
%rename(__not__) *::operator!() const;
%rename(__assign__) *::operator=;
%rename(__add_assign__) *::operator+=;
%rename(__sub_assign__) *::operator-=;
%rename(__mul_assign__) *::operator*=;
%rename(__div_assign__) *::operator/=;
%rename(__mod_assign__) *::operator%=;
%rename(__logxor_assign__) *::operator^=;
%rename(__logand_assign__) *::operator&=;
%rename(__logior_assign__) *::operator|=;
%rename(__lshift__) *::operator<<;
%rename(__lshift_assign__) *::operator<<=;
%rename(__rshift__) *::operator>>;
%rename(__rshift_assign__) *::operator>>=;
%rename(__eq__) *::operator==;
%rename(__ne__) *::operator!=;
%rename(__lt__) *::operator<;
%rename(__gt__) *::operator>;
%rename(__lte__) *::operator<=;
%rename(__gte__) *::operator>=;
%rename(__and__) *::operator&&;
%rename(__or__) *::operator||;
%rename(__preincr__) *::operator++();
%rename(__postincr__) *::operator++(int);
%rename(__predecr__) *::operator--();
%rename(__postdecr__) *::operator--(int);
%rename(__comma__) *::operator,();
%rename(__comma__) *::operator,() const;
%rename(__member_ref__) *::operator->;
%rename(__member_func_ref__) *::operator->*;
%rename(__funcall__) *::operator();
%rename(__aref__) *::operator[];
%rename(__bool__) *::operator bool();
%rename(__bool__) *::operator bool() const;
#endif
%insert("lisphead") %{
(eval-when (:compile-toplevel :load-toplevel :execute)
;; avoid compiling ef-templates at runtime
(excl:find-external-format :fat)
(excl:find-external-format :fat-le)
;;; You can define your own identifier converter if you want.
;;; Use the -identifier-converter command line argument to
;;; specify its name.
(eval-when (:compile-toplevel :load-toplevel :execute)
(cl::defparameter *swig-export-list* nil))
(cl::defconstant *void* :..void..)
;; parsers to aid in finding SWIG definitions in files.
(cl::defun scm-p1 (form)
(let* ((info (cl::second form))
(id (car info))
(id-args (if (eq (cl::car form) 'swig-dispatcher)
(cl::cdr info)
(cl::cddr info))))
(cl::apply *swig-identifier-converter* id
(cl::progn (cl::when (cl::eq (cl::car form) 'swig-dispatcher)
(cl::remf id-args :arities))
id-args))))
(cl::defmacro defswig1 (name (&rest args) &body body)
`(cl::progn (cl::defmacro ,name ,args
,@body)
(excl::define-simple-parser ,name scm-p1)) )
(cl::defmacro defswig2 (name (&rest args) &body body)
`(cl::progn (cl::defmacro ,name ,args
,@body)
(excl::define-simple-parser ,name second)))
(defun read-symbol-from-string (string)
(cl::multiple-value-bind (result position)
(cl::read-from-string string nil "eof" :preserve-whitespace t)
(cl::if (cl::and (cl::symbolp result)
(cl::eql position (cl::length string)))
result
(cl::multiple-value-bind (sym)
(cl::intern string)
sym))))
(cl::defun full-name (id type arity class)
; We need some kind of a hack here to handle template classes
; and other synonym types right. We need the original name.
(let*( (sym (read-symbol-from-string
(if (eq *swig-identifier-converter* 'identifier-convert-lispify)
(string-lispify id)
id)))
(sym-class (find-class sym nil))
(id (cond ( (not sym-class)
id )
( (and sym-class
(not (eq (class-name sym-class)
sym)))
(class-name sym-class) )
( t
id ))) )
(cl::case type
(:getter (cl::format nil "~@[~A_~]~A" class id))
(:constructor (cl::format nil "new_~A~@[~A~]" id arity))
(:destructor (cl::format nil "delete_~A" id))
(:type (cl::format nil "ff_~A" id))
(:slot id)
(:ff-operator (cl::format nil "ffi_~A" id))
(otherwise (cl::format nil "~@[~A_~]~A~@[~A~]"
class id arity)))))
(cl::defun identifier-convert-null (id &key type class arity)
(cl::if (cl::eq type :setter)
`(cl::setf ,(identifier-convert-null
id :type :getter :class class :arity arity))
(read-symbol-from-string (full-name id type arity class))))
(cl::defun string-lispify (str)
(cl::let ( (cname (excl::replace-regexp str "_" "-"))
(lastcase :other)
newcase char res )
(cl::dotimes (n (cl::length cname))
(cl::setf char (cl::schar cname n))
(excl::if* (cl::alpha-char-p char)
then
(cl::setf newcase (cl::if (cl::upper-case-p char) :upper :lower))
(cl::when (cl::and (cl::eq lastcase :lower)
(cl::eq newcase :upper))
;; case change... add a dash
(cl::push #\- res)
(cl::setf newcase :other))
(cl::push (cl::char-downcase char) res)
(cl::setf lastcase newcase)
else
(cl::push char res)
(cl::setf lastcase :other)))
(cl::coerce (cl::nreverse res) 'string)))
(cl::defun identifier-convert-lispify (cname &key type class arity)
(cl::assert (cl::stringp cname))
(cl::when (cl::eq type :setter)
(cl::return-from identifier-convert-lispify
`(cl::setf ,(identifier-convert-lispify
cname :type :getter :class class :arity arity))))
(cl::setq cname (full-name cname type arity class))
(cl::if (cl::eq type :constant)
(cl::setf cname (cl::format nil "*~A*" cname)))
(read-symbol-from-string (string-lispify cname)))
(cl::defun id-convert-and-export (name &rest kwargs)
(cl::multiple-value-bind (symbol package)
(cl::apply *swig-identifier-converter* name kwargs)
(cl::let ((args (cl::list (cl::if (cl::consp symbol)
(cl::cadr symbol) symbol)
(cl::or package cl::*package*))))
(cl::apply #'cl::export args)
(cl::pushnew args *swig-export-list*))
symbol))
(cl::defmacro swig-insert-id (name namespace &key (type :type) class)
`(cl::let ((cl::*package* (cl::find-package ,(package-name-for-namespace namespace))))
(id-convert-and-export ,name :type ,type :class ,class)))
(defswig2 swig-defconstant (string value)
(cl::let ((symbol (id-convert-and-export string :type :constant)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(cl::defconstant ,symbol ,value))))
(cl::defun maybe-reorder-args (funcname arglist)
;; in the foreign setter function the new value will be the last argument
;; in Lisp it needs to be the first
(cl::if (cl::consp funcname)
(cl::append (cl::last arglist) (cl::butlast arglist))
arglist))
(cl::defun maybe-return-value (funcname arglist)
;; setf functions should return the new value
(cl::when (cl::consp funcname)
`(,(cl::if (cl::consp (cl::car arglist))
(cl::caar arglist)
(cl::car arglist)))))
(cl::defun swig-anyvarargs-p (arglist)
(cl::member :SWIG__varargs_ arglist))
(defswig1 swig-defun ((name &optional (mangled-name name)
&key (type :operator) class arity)
arglist kwargs
&body body)
(cl::let* ((symbol (id-convert-and-export name :type type
:arity arity :class class))
(mangle (excl::if* (cl::string-equal name mangled-name)
then (id-convert-and-export
(cl::cond
((cl::eq type :setter) (cl::format nil "~A-set" name))
((cl::eq type :getter) (cl::format nil "~A-get" name))
(t name))
:type :ff-operator :arity arity :class class)
else (cl::intern mangled-name)))
(defun-args (maybe-reorder-args
symbol
(cl::mapcar #'cl::car (cl::and (cl::not (cl::equal arglist '(:void)))
(cl::loop as i in arglist
when (cl::eq (cl::car i) :p+)
collect (cl::cdr i))))))
(ffargs (cl::if (cl::equal arglist '(:void))
arglist
(cl::mapcar #'cl::cdr arglist)))
)
(cl::when (swig-anyvarargs-p ffargs)
(cl::setq ffargs '()))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(excl::compiler-let ((*record-xref-info* nil))
(ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
(cl::macrolet ((swig-ff-call (&rest args)
(cl::cons ',mangle args)))
(cl::defun ,symbol ,defun-args
,@body
,@(maybe-return-value symbol defun-args))))))
(defswig1 swig-defmethod ((name &optional (mangled-name name)
&key (type :operator) class arity)
ffargs kwargs
&body body)
(cl::let* ((symbol (id-convert-and-export name :type type
:arity arity :class class))
(mangle (cl::intern mangled-name))
(defmethod-args (maybe-reorder-args
symbol
(cl::unless (cl::equal ffargs '(:void))
(cl::loop for (lisparg name dispatch) in ffargs
when (eq lisparg :p+)
collect `(,name ,dispatch)))))
(ffargs (cl::if (cl::equal ffargs '(:void))
ffargs
(cl::loop for (nil name nil . ffi) in ffargs
collect `(,name ,@ffi)))))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(excl::compiler-let ((*record-xref-info* nil))
(ff:def-foreign-call (,mangle ,mangled-name) ,ffargs ,@kwargs))
(cl::macrolet ((swig-ff-call (&rest args)
(cl::cons ',mangle args)))
(cl::defmethod ,symbol ,defmethod-args
,@body
,@(maybe-return-value symbol defmethod-args))))))
(defswig1 swig-dispatcher ((name &key (type :operator) class arities))
(cl::let ((symbol (id-convert-and-export name
:type type :class class)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(cl::defun ,symbol (&rest args)
(cl::case (cl::length args)
,@(cl::loop for arity in arities
for symbol-n = (id-convert-and-export name
:type type :class class :arity arity)
collect `(,arity (cl::apply #',symbol-n args)))
(t (cl::error "No applicable wrapper-methods for foreign call ~a with args ~a of classes ~a" ',symbol args (cl::mapcar #'(cl::lambda (x) (cl::class-name (cl::class-of x))) args)))
)))))
(defswig2 swig-def-foreign-stub (name)
(cl::let ((lsymbol (id-convert-and-export name :type :class))
(symbol (id-convert-and-export name :type :type)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(ff:def-foreign-type ,symbol (:class ))
(cl::defclass ,lsymbol (ff:foreign-pointer) ()))))
(defswig2 swig-def-foreign-class (name supers &rest rest)
(cl::let ((lsymbol (id-convert-and-export name :type :class))
(symbol (id-convert-and-export name :type :type)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(ff:def-foreign-type ,symbol ,@rest)
(cl::defclass ,lsymbol ,supers
((foreign-type :initform ',symbol :initarg :foreign-type
:accessor foreign-pointer-type))))))
(defswig2 swig-def-foreign-type (name &rest rest)
(cl::let ((symbol (id-convert-and-export name :type :type)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(ff:def-foreign-type ,symbol ,@rest))))
(defswig2 swig-def-synonym-type (synonym of ff-synonym)
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(cl::setf (cl::find-class ',synonym) (cl::find-class ',of))
(ff:def-foreign-type ,ff-synonym (:struct ))))
(cl::defun package-name-for-namespace (namespace)
(excl::list-to-delimited-string
(cl::cons *swig-module-name*
(cl::mapcar #'(cl::lambda (name)
(cl::string
(cl::funcall *swig-identifier-converter*
name
:type :namespace)))
namespace))
"."))
(cl::defmacro swig-defpackage (namespace)
(cl::let* ((parent-namespaces (cl::maplist #'cl::reverse (cl::cdr (cl::reverse namespace))))
(parent-strings (cl::mapcar #'package-name-for-namespace
parent-namespaces))
(string (package-name-for-namespace namespace)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(cl::defpackage ,string
(:use :swig :ff #+ignore '(:common-lisp :ff :excl)
,@parent-strings ,*swig-module-name*)
(:import-from :cl :* :nil :t)))))
(cl::defmacro swig-in-package (namespace)
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(cl::in-package ,(package-name-for-namespace namespace))))
(defswig2 swig-defvar (name mangled-name &key type (ftype :unsigned-natural))
(cl::let ((symbol (id-convert-and-export name :type type)))
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
(ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype))))
) ;; eval-when
(cl::eval-when (:compile-toplevel :execute)
(cl::flet ((starts-with-p (str prefix)
(cl::and (cl::>= (cl::length str) (cl::length prefix))
(cl::string= str prefix :end1 (cl::length prefix)))))
(cl::export (cl::loop for sym being each present-symbol of cl::*package*
when (cl::or (starts-with-p (cl::symbol-name sym) (cl::symbol-name :swig-))
(starts-with-p (cl::symbol-name sym) (cl::symbol-name :identifier-convert-)))
collect sym))))
%}
typedef void *__SWIGACL_FwdReference;
%{
#ifdef __cplusplus
# define EXTERN extern "C"
#else
# define EXTERN extern
#endif
#define EXPORT EXTERN SWIGEXPORT
typedef void *__SWIGACL_FwdReference;
#include <string.h>
#include <stdlib.h>
%}

View file

@ -1,111 +0,0 @@
/* inout_typemaps.i
Support for INPUT, OUTPUT, and INOUT typemaps. OUTPUT variables are returned
as multiple values.
*/
/* Note that this macro automatically adds a pointer to the type passed in.
As a result, INOUT typemaps for char are for 'char *'. The definition
of typemaps for 'char' takes advantage of this, believing that it's more
likely to see an INOUT argument for strings, than a single char. */
%define INOUT_TYPEMAP(type_, OUTresult_, INbind_)
// OUTPUT map.
%typemap(lin,numinputs=0) type_ *OUTPUT, type_ &OUTPUT
%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
$body
OUTresult_
(ff:free-fobject $out)) %}
// INPUT map.
%typemap(in) type_ *INPUT, type_ &INPUT
%{ $1 = &$input; %}
%typemap(ctype) type_ *INPUT, type_ &INPUT "$*1_ltype";
// INOUT map.
// careful here. the input string is converted to a C string
// with length equal to the input string. This should be large
// enough to contain whatever OUTPUT value will be stored in it.
%typemap(lin,numinputs=1) type_ *INOUT, type_ &INOUT
%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
INbind_
$body
OUTresult_
(ff:free-fobject $out)) %}
%enddef
// $in, $out, $lclass,
// $in_fftype, $*in_fftype
INOUT_TYPEMAP(int,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(short,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(long,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(unsigned int,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(unsigned short,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(unsigned long,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
// char * mapping for passing strings. didn't quite work
// INOUT_TYPEMAP(char,
// (cl::push (excl:native-to-string $out) ACL_result),
// (cl::setf (ff:fslot-value-typed (cl::quote $in_fftype) :c $out)
// (excl:string-to-native $in)))
INOUT_TYPEMAP(float,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(double,
(cl::push (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));
INOUT_TYPEMAP(bool,
(cl::push (not (zerop (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out)))
ACL_result),
(cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) (if $in 1 0)));
%typemap(lisptype) bool *INPUT, bool &INPUT "boolean";
// long long support not yet complete
// INOUT_TYPEMAP(long long);
// INOUT_TYPEMAP(unsigned long long);
// char *OUTPUT map.
// for this to work, swig needs to know how large an array to allocate.
// you can fake this by
// %typemap(ffitype) char *myarg "(:array :char 30)";
// %apply char *OUTPUT { char *myarg };
%typemap(lin,numinputs=0) char *OUTPUT, char &OUTPUT
%{(cl::let (($out (ff:allocate-fobject '$*in_fftype :c)))
$body
(cl::push (excl:native-to-string $out) ACL_result)
(ff:free-fobject $out)) %}
// char *INPUT map.
%typemap(in) char *INPUT, char &INPUT
%{ $1 = &$input; %}
%typemap(ctype) char *INPUT, char &INPUT "$*1_ltype";
// char *INOUT map.
%typemap(lin,numinputs=1) char *INOUT, char &INOUT
%{(cl::let (($out (excl:string-to-native $in)))
$body
(cl::push (excl:native-to-string $out) ACL_result)
(ff:free-fobject $out)) %}
// uncomment this if you want INOUT mappings for chars instead of strings.
// INOUT_TYPEMAP(char,
// (cl::push (code-char (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out))
// ACL_result),
// (cl::setf (ff:fslot-value-typed (cl::quote $*in_fftype) :c $out) $in));

View file

@ -1,49 +0,0 @@
/* -----------------------------------------------------------------------------
* longlongs.i
*
* Typemap addition for support of 'long long' type and 'unsigned long long
* Makes use of swig-def-foreign-class, so this header should be loaded
* after allegrocl.swg and after any custom user identifier-conversion
* functions have been defined.
* ----------------------------------------------------------------------------- */
#ifdef Acl64Bit
%typemap(ctype) long long, unsigned long long "$1_ltype";
%typemap(out) long long, unsigned long long "$result = $1;";
%typemap(ffitype) long long ":nat";
%typemap(ffitype) unsigned long long ":unsigned-nat";
%typemap(lout) long long, unsigned long long " #+64bit (cl::setq ACL_ffresult $body)";
#else
%typemap(out) long long, unsigned long long "$result = &$1;";
%typemap(ffitype) long long "(:struct (l1 :long) (l2 :long))";
%typemap(ffitype) unsigned long long "(:struct (l1 :unsigned-long) (l2 :unsigned-long))";
%typemap(lout) long long
" (cl::setq ACL_ffresult (make-instance '#.(swig-insert-id \"longlong\" () :type :class)
:foreign-address $body))";
%typemap(lout) unsigned long long
" (cl:setq ACL_ffresult (make-instance '#.(swig-insert-id \"ulonglong\" () :type :class)
:foreign-address $body))";
#endif
%typemap(in) long long, unsigned long long "$1 = $input;";
%insert("lisphead") %{
#-64bit
(swig-def-foreign-class "longlong"
(ff:foreign-pointer)
(:struct (l1 :long) (l2 :long)))
#-64bit
(swig-def-foreign-class "ulonglong"
(ff:foreign-pointer)
(:struct (l1 :unsigned-long) (l2 :unsigned-long)))
%}

View file

@ -1,230 +0,0 @@
/* -----------------------------------------------------------------------------
* std_list.i
*
* SWIG typemaps for std::list types
*
* To use, add:
*
* %include "std_list.i"
*
* to your interface file. You will also need to include a template directive
* for each instance of the list container you want to use in your application.
* e.g.
*
* %template (intlist) std::list<int>;
* %template (floatlist) std::list<float>;
* ----------------------------------------------------------------------------- */
%module std_list
%warnfilter(468) std::list;
%{
#include <list>
#include <stdexcept>
%}
namespace std{
template<class T> class list
{
public:
typedef size_t size_type;
typedef ptrdiff_t difference_type;
typedef T value_type;
typedef value_type* pointer;
typedef const value_type* const_pointer;
typedef value_type& reference;
typedef const value_type& const_reference;
typedef T &iterator;
typedef const T& const_iterator;
list();
list(unsigned int size, const T& value = T());
list(const list& other);
void assign(unsigned int n, const T& value);
void swap(list<T> &x);
const_reference front();
const_reference back();
const_iterator begin();
const_iterator end();
void resize(unsigned int n, T c = T());
bool empty() const;
void push_front(const T& INPUT);
void push_back(const T& INPUT);
void pop_front();
void pop_back();
void clear();
unsigned int size() const;
unsigned int max_size() const;
void resize(unsigned int n, const T& INPUT);
void remove(const T& INPUT);
void unique();
void reverse();
void sort();
%extend
{
%typemap(lout) T &__getitem__ "(cl::setq ACL_ffresult (ff:fslot-value-typed '$*out_fftype :c $body))";
%typemap(lout) T *__getitem__ "(cl::setq ACL_ffresult (make-instance '$lclass :foreign-address $body))";
const_reference __getitem__(int i) throw (std::out_of_range)
{
std::list<T>::iterator first = self->begin();
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
{
for (int k=0;k<i;k++)
{
first++;
}
return *first;
}
else throw std::out_of_range("list index out of range");
}
void __setitem__(int i, const T& INPUT) throw (std::out_of_range)
{
std::list<T>::iterator first = self->begin();
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
{
for (int k=0;k<i;k++)
{
first++;
}
*first = INPUT;
}
else throw std::out_of_range("list index out of range");
}
void __delitem__(int i) throw (std::out_of_range)
{
std::list<T>::iterator first = self->begin();
int size = int(self->size());
if (i<0) i += size;
if (i>=0 && i<size)
{
for (int k=0;k<i;k++)
{
first++;
}
self->erase(first);
}
else throw std::out_of_range("list index out of range");
}
std::list<T> __getslice__(int i,int j)
{
std::list<T>::iterator first = self->begin();
std::list<T>::iterator end = self->end();
int size = int(self->size());
if (i<0) i += size;
if (j<0) j += size;
if (i<0) i = 0;
if (j>size) j = size;
if (i>=j) i=j;
if (i>=0 && i<size && j>=0)
{
for (int k=0;k<i;k++)
{
first++;
}
for (int m=0;m<j;m++)
{
end++;
}
std::list<T> tmp(j-i);
if (j>i) std::copy(first,end,tmp.begin());
return tmp;
}
else throw std::out_of_range("list index out of range");
}
void __delslice__(int i,int j)
{
std::list<T>::iterator first = self->begin();
std::list<T>::iterator end = self->end();
int size = int(self->size());
if (i<0) i += size;
if (j<0) j += size;
if (i<0) i = 0;
if (j>size) j = size;
for (int k=0;k<i;k++)
{
first++;
}
for (int m=0;m<=j;m++)
{
end++;
}
self->erase(first,end);
}
void __setslice__(int i,int j, const std::list<T>& v)
{
std::list<T>::iterator first = self->begin();
std::list<T>::iterator end = self->end();
int size = int(self->size());
if (i<0) i += size;
if (j<0) j += size;
if (i<0) i = 0;
if (j>size) j = size;
for (int k=0;k<i;k++)
{
first++;
}
for (int m=0;m<=j;m++)
{
end++;
}
if (int(v.size()) == j-i)
{
std::copy(v.begin(),v.end(),first);
}
else {
self->erase(first,end);
if (i+1 <= int(self->size()))
{
first = self->begin();
for (int k=0;k<i;k++)
{
first++;
}
self->insert(first,v.begin(),v.end());
}
else self->insert(self->end(),v.begin(),v.end());
}
}
unsigned int __len__()
{
return self->size();
}
bool __nonzero__()
{
return !(self->empty());
}
void append(const T& INPUT)
{
self->push_back(INPUT);
}
void pop()
{
self->pop_back();
}
}
};
}

View file

@ -1,209 +0,0 @@
/* -----------------------------------------------------------------------------
* std_string.i
*
* SWIG typemaps for std::string
* ----------------------------------------------------------------------------- */
// ------------------------------------------------------------------------
// std::string is typemapped by value
// This can prevent exporting methods which return a string
// in order for the user to modify it.
// However, I think I'll wait until someone asks for it...
// ------------------------------------------------------------------------
// %include <exception.i>
%warnfilter(404) std::string;
%warnfilter(404) std::wstring;
%{
#include <string>
%}
// %include <std_vector.i>
// %naturalvar std::string;
// %naturalvar std::wstring;
namespace std {
typedef unsigned long size_t;
typedef signed long ptrdiff_t;
template <class charT> class basic_string {
public:
typedef charT *pointer;
typedef charT &reference;
typedef const charT &const_reference;
typedef size_t size_type;
typedef ptrdiff_t difference_type;
basic_string();
basic_string( charT *str );
size_type size();
charT operator []( int pos ) const;
charT *c_str() const;
basic_string<charT> &operator = ( const basic_string &ws );
basic_string<charT> &operator = ( const charT *str );
basic_string<charT> &append( const basic_string<charT> &other );
basic_string<charT> &append( const charT *str );
void push_back( charT c );
void clear();
void reserve( size_type t );
void resize( size_type n, charT c = charT() );
int compare( const basic_string<charT> &other ) const;
int compare( const charT *str ) const;
basic_string<charT> &insert( size_type pos,
const basic_string<charT> &str );
size_type find( const basic_string<charT> &other, int pos = 0 ) const;
size_type find( charT c, int pos = 0 ) const;
%extend {
bool operator == ( const basic_string<charT> &other ) const {
return self->compare( other ) == 0;
}
bool operator != ( const basic_string<charT> &other ) const {
return self->compare( other ) != 0;
}
bool operator < ( const basic_string<charT> &other ) const {
return self->compare( other ) == -1;
}
bool operator > ( const basic_string<charT> &other ) const {
return self->compare( other ) == 1;
}
bool operator <= ( const basic_string<charT> &other ) const {
return self->compare( other ) != 1;
}
bool operator >= ( const basic_string<charT> &other ) const {
return self->compare( other ) != -1;
}
}
};
%template(string) basic_string<char>;
%template(wstring) basic_string<wchar_t>;
%apply char * { string };
%apply wchar_t * { wstring };
typedef basic_string<char> string;
typedef basic_string<wchar_t> wstring;
// automatically convert constant std::strings to cl:strings
%typemap(ctype) string "char *";
%typemap(in) string "$1.assign($input);";
%typemap(out) string "$result = (char *)(&$1)->c_str();";
%typemap(lisptype) string "cl:string";
%typemap(lout) string "(cl::setq ACL_ffresult $body)";
%typemap(ctype) const string *"char *";
%typemap(in) const string * "$1.assign($input);";
%typemap(out) const string * "$result = (char *)($1)->c_str();";
%typemap(lisptype) const string * "cl:string";
%typemap(lout) const string * "(cl::setq ACL_ffresult $body)";
%typemap(ctype) wstring "wchar_t *";
%typemap(in) wstring "$1.assign($input);";
%typemap(out) wstring "$result = (wchar_t *)(&$1)->c_str();";
%typemap(lisptype) wstring "cl:string";
%typemap(lout) wstring "(cl::setq ACL_ffresult (excl:native-to-string $body
:external-format #+little-endian :fat-le #-little-endian :fat))";
%typemap(ctype) const wstring *"char *";
%typemap(in) const wstring * "$1.assign($input);";
%typemap(out) const wstring * "$result = (char *)($1)->c_str();";
%typemap(lisptype) const wstring * "cl:string";
%typemap(lout) const wstring * "(cl::setq ACL_ffresult $body)";
/* Overloading check */
// %typemap(in) string {
// if (caml_ptr_check($input))
// $1.assign((char *)caml_ptr_val($input,0),
// caml_string_len($input));
// else
// SWIG_exception(SWIG_TypeError, "string expected");
// }
// %typemap(in) const string & ($*1_ltype temp) {
// if (caml_ptr_check($input)) {
// temp.assign((char *)caml_ptr_val($input,0),
// caml_string_len($input));
// $1 = &temp;
// } else {
// SWIG_exception(SWIG_TypeError, "string expected");
// }
// }
// %typemap(in) string & ($*1_ltype temp) {
// if (caml_ptr_check($input)) {
// temp.assign((char *)caml_ptr_val($input,0),
// caml_string_len($input));
// $1 = &temp;
// } else {
// SWIG_exception(SWIG_TypeError, "string expected");
// }
// }
// %typemap(in) string * ($*1_ltype *temp) {
// if (caml_ptr_check($input)) {
// temp = new $*1_ltype((char *)caml_ptr_val($input,0),
// caml_string_len($input));
// $1 = temp;
// } else {
// SWIG_exception(SWIG_TypeError, "string expected");
// }
// }
// %typemap(free) string * ($*1_ltype *temp) {
// delete temp;
// }
// %typemap(argout) string & {
// caml_list_append(swig_result,caml_val_string_len((*$1).c_str(),
// (*$1).size()));
// }
// %typemap(directorout) string {
// $result.assign((char *)caml_ptr_val($input,0),
// caml_string_len($input));
// }
// %typemap(out) string {
// $result = caml_val_string_len($1.c_str(),$1.size());
// }
// %typemap(out) string * {
// $result = caml_val_string_len((*$1).c_str(),(*$1).size());
// }
}
// #ifdef ENABLE_CHARPTR_ARRAY
// char **c_charptr_array( const std::vector <string > &str_v );
// %{
// SWIGEXT char **c_charptr_array( const std::vector <string > &str_v ) {
// char **out = new char *[str_v.size() + 1];
// out[str_v.size()] = 0;
// for( int i = 0; i < str_v.size(); i++ ) {
// out[i] = (char *)str_v[i].c_str();
// }
// return out;
// }
// %}
// #endif
// #ifdef ENABLE_STRING_VECTOR
// %template (StringVector) std::vector<string >;
// %insert(ml) %{
// (* Some STL convenience items *)
// let string_array_to_vector sa =
// let nv = _new_StringVector C_void in
// array_to_vector nv (fun x -> C_string x) sa ; nv
// let c_string_array ar =
// _c_charptr_array (string_array_to_vector ar)
// %}
// %insert(mli) %{
// val c_string_array: string array -> c_obj
// %}
// #endif

View file

@ -1,4 +0,0 @@
/* Unused for Allegro CL module */
%include "inout_typemaps.i"
%include "longlongs.i"

View file

@ -1,809 +0,0 @@
/* -----------------------------------------------------------------------------
* chicken.swg
*
* CHICKEN configuration module.
* ----------------------------------------------------------------------------- */
/* chicken.h has to appear first. */
%insert(runtime) %{
#include <assert.h>
#include <chicken.h>
%}
%insert(runtime) "swigrun.swg" // Common C API type-checking code
%insert(runtime) "swigerrors.swg" // SWIG errors
%insert(runtime) "chickenrun.swg" // CHICKEN run-time code
/* -----------------------------------------------------------------------------
* standard typemaps
* ----------------------------------------------------------------------------- */
/*
CHICKEN: C
----------
fixnum: int, short, unsigned int, unsigned short, unsigned char,
signed char
char: char
bool: bool
flonum: float, double, long, long long, unsigned long, unsigned long
long
*/
/* --- Primitive types --- */
%define SIMPLE_TYPEMAP(type_, from_scheme, to_scheme, checker, convtype, storage_)
%typemap(in) type_
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'type_'");
}
$1 = ($1_ltype) from_scheme ($input); %}
/* Const primitive references. Passed by value */
%typemap(in) const type_ & ($*1_ltype temp)
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'type_'");
}
temp = ($*1_ltype) from_scheme ($input);
$1 = &temp; %}
/* --- Variable input --- */
%typemap(varin) type_
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Cannot use '$1_ltype' for variable '$name' of type 'type_'");
}
$1 = ($1_ltype) from_scheme ($input); %}
#if "storage_" == "0"
%typemap(out) type_
%{
$result = to_scheme (convtype ($1));
%}
/* References to primitive types. Return by value */
%typemap(out) const type_ &
%{
$result = to_scheme (convtype (*$1));
%}
/* --- Variable output --- */
%typemap(varout) type_
%{
$result = to_scheme (convtype ($varname));
%}
%typemap(throws) type_
%{
SWIG_Chicken_ThrowException(to_scheme ( convtype ($1)));
%}
#else
%typemap(out) type_
%{
{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype ($1));
}
%}
/* References to primitive types. Return by value */
%typemap(out) const type_ &
%{
{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype (*$1));
}
%}
/* --- Variable output --- */
%typemap(varout) type_
%{
{
C_word *space = C_alloc(storage_);
$result = to_scheme (&space, convtype ($varname));
}
%}
%typemap(throws) type_
%{
{
C_word *space = C_alloc(storage_);
SWIG_Chicken_ThrowException(to_scheme (&space, convtype ($1)));
}
%}
#endif
/* --- Constants --- */
%typemap(constcode) type_
"static const $1_type $result = $value;"
%enddef
SIMPLE_TYPEMAP(int, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
//SIMPLE_TYPEMAP(enum SWIGTYPE, C_unfix, C_fix, C_swig_is_fixnum, (int), 0);
SIMPLE_TYPEMAP(short, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
SIMPLE_TYPEMAP(long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(long long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned int, C_num_to_unsigned_int, C_unsigned_int_to_num, C_swig_is_number, (unsigned int), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned short, C_num_to_unsigned_int, C_fix, C_swig_is_number, (unsigned int), 0);
SIMPLE_TYPEMAP(unsigned long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned long long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(unsigned char, C_character_code, C_make_character, C_swig_is_char, (unsigned int), 0);
SIMPLE_TYPEMAP(signed char, C_character_code, C_make_character, C_swig_is_char, (int), 0);
SIMPLE_TYPEMAP(char, C_character_code, C_make_character, C_swig_is_char, (char), 0);
SIMPLE_TYPEMAP(bool, C_truep, C_mk_bool, C_swig_is_bool, (bool), 0);
SIMPLE_TYPEMAP(float, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
SIMPLE_TYPEMAP(double, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
/* enum SWIGTYPE */
%apply int { enum SWIGTYPE };
%apply const int& { const enum SWIGTYPE& };
%apply const int& { const enum SWIGTYPE&& };
%typemap(varin) enum SWIGTYPE
{
if (!C_swig_is_fixnum($input) && sizeof(int) != sizeof($1)) {
swig_barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, "enum variable '$name' can not be set");
}
*((int *)(void *)&$1) = C_unfix($input);
}
/* --- Input arguments --- */
/* Strings */
%typemap(in) char *
{ if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else {
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'char *'");
}
$1 = ($ltype) SWIG_MakeString ($input);
}
}
%typemap(freearg) char * "if ($1 != NULL) { free ($1); }"
/* Pointers, references, and arrays */
%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE *, SWIGTYPE [], SWIGTYPE &, SWIGTYPE && {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, $disown);
}
%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE *DISOWN {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, $argnum, SWIG_POINTER_DISOWN);
}
/* Void pointer. Accepts any kind of pointer */
%typemap(in) void * {
$1 = ($1_ltype)SWIG_MustGetPtr($input, NULL, $argnum, 0);
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") SWIGTYPE * {
$1 = ($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, SWIG_POINTER_DISOWN);
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") SWIGTYPE & {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") SWIGTYPE && {
$1 = *(($1_ltype)SWIG_MustGetPtr($input, $descriptor, 1, 0));
}
%typemap(varin) SWIGTYPE [] {
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, "Type error");
}
%typemap(varin) SWIGTYPE [ANY] {
void *temp;
int ii;
$1_basetype *b = 0;
temp = SWIG_MustGetPtr($input, $1_descriptor, 1, 0);
b = ($1_basetype *) $1;
for (ii = 0; ii < $1_size; ii++) b[ii] = *(($1_basetype *) temp + ii);
}
%typemap(varin) void * {
$1 = SWIG_MustGetPtr($input, NULL, 1, 0);
}
%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [] {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj($1, $descriptor, $owner);
}
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
swig_type_info *ty = SWIG_TypeDynamicCast($1_descriptor,(void **) &$1);
$result = SWIG_NewPointerObj($1, ty, $owner);
}
%typemap(varout) SWIGTYPE *, SWIGTYPE [] {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj($varname, $descriptor, 0);
}
%typemap(varout) SWIGTYPE & {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj((void *) &$varname, $1_descriptor, 0);
}
%typemap(varout) SWIGTYPE && {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
$result = SWIG_NewPointerObj((void *) &$varname, $1_descriptor, 0);
}
/* special typemaps for class pointers */
%typemap(in) SWIGTYPE (CLASS::*) {
char err_msg[256];
if (C_swig_is_pair($input)) {
/* try and convert pointer object */
void *result;
if (!SWIG_ConvertPtr(C_block_item($input,1), &result, $descriptor, 0)) {
C_word ptr = C_block_item($input,0);
if (C_swig_is_string(ptr)) {
SWIG_UnpackData(C_c_string(ptr), (void *) &$1, sizeof($1));
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", $argnum, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", $argnum, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", $argnum, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
}
%typemap(out) SWIGTYPE (CLASS::*) {
size_t ptr_size = sizeof($type);
C_word *known_space = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(2*ptr_size) + C_SIZEOF_SWIG_POINTER);
char *temp = (char *)malloc(2*ptr_size);
C_word ptr = SWIG_NewPointerObj((void *) known_space, $descriptor, 0);
SWIG_PackData(temp, (void *) &$1, ptr_size);
$result = C_pair(&known_space, C_string(&known_space, 2*ptr_size, temp), ptr);
free(temp);
}
%typemap(varin) SWIGTYPE (CLASS::*) {
char err_msg[256];
if (C_swig_is_pair($input)) {
/* try and convert pointer object */
void *result;
if (!SWIG_ConvertPtr(C_block_item($input,1), &result, $descriptor, 0)) {
C_word ptr = C_block_item($input,0);
if (C_swig_is_string(ptr)) {
SWIG_UnpackData(C_c_string(ptr), (void *) &$1, sizeof($1));
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
} else {
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", 1, ($descriptor->str ? $descriptor->str : $descriptor->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
}
%typemap(varout) SWIGTYPE (CLASS::*) {
size_t ptr_size = sizeof($type);
C_word *known_space = C_alloc(C_SIZEOF_PAIR + C_SIZEOF_STRING(2*ptr_size) + C_SIZEOF_SWIG_POINTER);
char *temp = (char *)malloc(2*ptr_size);
C_word ptr = SWIG_NewPointerObj((void *) known_space, $descriptor, 0);
SWIG_PackData(temp, (void *) &$varname, ptr_size);
$result = C_pair(&known_space, C_string(&known_space, 2*ptr_size, temp), ptr);
free(temp);
}
/* Pass-by-value */
%typemap(in,closcode="(slot-ref $input 'swig-this)") SWIGTYPE($&1_ltype argp) {
argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, $argnum, 0);
$1 = *argp;
}
%typemap(varin,closcode="(slot-ref $input 'swig-this)") SWIGTYPE {
$&1_ltype argp;
argp = ($&1_ltype)SWIG_MustGetPtr($input, $&1_descriptor, 1, 0);
$1 = *argp;
}
%typemap(out) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = new $1_ltype((const $1_ltype &) $1);
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1);
}
#else
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 1);
}
#endif
%typemap(varout) SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = new $1_ltype((const $1_ltype&) $1);
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0);
}
#else
{
$&1_ltype resultptr;
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
$result = SWIG_NewPointerObj(resultptr, $&1_descriptor, 0);
}
#endif
/* --- Output values --- */
/* Strings */
%typemap(out)
char *
{ char *s = (char*) $1;
if ($1 == NULL) {
$result = C_SCHEME_FALSE;
}
else {
int string_len = strlen ((char *) ($1));
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, s);
}
}
%typemap(varout)
char *
{ char *s = (char*) $varname;
if ($varname == NULL) {
$result = C_SCHEME_FALSE;
}
else {
int string_len = strlen ($varname);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, s);
}
}
%typemap(throws) char *
{
if ($1 == NULL) {
SWIG_Chicken_ThrowException(C_SCHEME_FALSE);
} else {
int string_len = strlen($1);
C_word *string_space = C_alloc(C_SIZEOF_STRING(string_len));
SWIG_Chicken_ThrowException(C_string(&string_space, string_len, (char *) $1));
}
}
/* Void */
%typemap(out) void
%{
$result = C_SCHEME_UNDEFINED;
%}
/* Special typemap for character array return values */
%typemap(out)
char [ANY], const char [ANY]
%{ if ($1 == NULL) {
$result = C_SCHEME_FALSE;
}
else {
const int string_len = strlen ($1);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, $1);
} %}
/* Primitive types--return by value */
/* --- Variable input --- */
/* A string */
#ifdef __cplusplus
%typemap(varin) char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
if ($1) delete [] $1;
$1 = ($type) new char[len+1];
strncpy((char*)$1, temp, len);
((char*)$1) [len] = 0;
}
}
%typemap(varin,warning="451:Setting const char * variable may leak memory") const char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
$1 = ($type) new char[len+1];
strncpy((char*)$1,temp,len);
((char*)$1) [len] = 0;
}
}
#else
%typemap(varin) char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
if ($1) free((char*) $1);
$1 = ($type) malloc(len+1);
strncpy((char*)$1,temp,len);
((char*)$1) [len] = 0;
}
}
%typemap(varin,warning="451:Setting const char * variable may leak memory") const char * {
if ($input == C_SCHEME_FALSE) {
$1 = NULL;
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
int len = C_header_size ($input);
$1 = ($type) malloc(len+1);
strncpy((char*)$1,temp,len);
((char*)$1) [len] = 0;
}
}
#endif
%typemap(varin) char [] {
swig_barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, "C/C++ variable '$name' is read-only");
}
/* Special case for string array variables */
%typemap(varin) char [ANY] {
if ($input == C_SCHEME_FALSE) {
memset($1,0,$1_dim0*sizeof(char));
}
else if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "C variable '$name ($1_ltype)'");
}
else {
char *temp = C_c_string ($input);
strncpy($1,temp,$1_dim0*sizeof(char));
}
}
/* --- Variable output --- */
/* Void */
%typemap(varout) void "$result = C_SCHEME_UNDEFINED;";
/* Special typemap for character array return values */
%typemap(varout) char [ANY], const char [ANY]
%{ if ($varname == NULL) {
$result = C_SCHEME_FALSE;
}
else {
const int string_len = strlen ($varname);
C_word *string_space = C_alloc (C_SIZEOF_STRING (string_len));
$result = C_string (&string_space, string_len, (char *) $varname);
}
%}
/* --- Constants --- */
%typemap(constcode) char *
"static const char *$result = $value;"
%typemap(constcode) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE []
"static const void *$result = (void*) $value;"
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) {
if ($input == C_SCHEME_FALSE) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Cannot use a null/#f string for a char*, int arguments");
}
else if (C_swig_is_string ($input)) {
$1 = ($1_ltype) C_c_string ($input);
$2 = ($2_ltype) C_header_size ($input);
}
else {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'string'");
}
}
/* ------------------------------------------------------------
* CHICKEN types
* ------------------------------------------------------------ */
%typemap(in) C_word "$1 = $input;";
%typemap(out) C_word "$result = $1;";
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%typecheck(SWIG_TYPECHECK_INTEGER)
bool, const bool &
{
$1 = C_swig_is_bool ($input);
}
%typecheck(SWIG_TYPECHECK_INTEGER)
int, short,
unsigned int, unsigned short,
signed char, unsigned char,
const int &, const short &,
const unsigned int &, const unsigned short &,
enum SWIGTYPE
{
$1 = C_swig_is_fixnum ($input);
}
%typecheck(SWIG_TYPECHECK_INTEGER)
long,
unsigned long,
long long, unsigned long long,
const long &,
const unsigned long &,
const long long &, const unsigned long long &
{
$1 = (C_swig_is_bool ($input) ||
C_swig_is_fixnum ($input) ||
C_swig_is_flonum ($input)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
$1 = C_swig_is_flonum ($input);
}
%typecheck(SWIG_TYPECHECK_CHAR) char {
$1 = C_swig_is_string ($input);
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = C_swig_is_string ($input);
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE [] {
void *ptr;
$1 = !SWIG_ConvertPtr($input, &ptr, $1_descriptor, 0);
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
$1 = !SWIG_ConvertPtr($input, &ptr, 0, 0);
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE &
{
void *ptr = 0;
if (SWIG_ConvertPtr($input, &ptr, $descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE &&
{
void *ptr = 0;
if (SWIG_ConvertPtr($input, &ptr, $descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE
{
void *ptr = 0;
if (SWIG_ConvertPtr($input, &ptr, $&descriptor, SWIG_POINTER_NO_NULL)) {
$1 = 0;
} else {
$1 = 1;
}
}
/* ------------------------------------------------------------
* Exception handling
* ------------------------------------------------------------ */
/* ------------------------------------------------------------
* --- Exception handling ---
* ------------------------------------------------------------ */
%typemap(throws) SWIGTYPE {
$&ltype temp = new $ltype($1);
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj(temp, $&descriptor,1);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE * {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *) $1, $descriptor, 0);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE [ANY] {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *) $1, $descriptor, 0);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE & {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *)&($1),$descriptor,0);
SWIG_Chicken_ThrowException(ptr);
}
%typemap(throws) SWIGTYPE && {
C_word *known_space = C_alloc(C_SIZEOF_SWIG_POINTER);
C_word ptr = SWIG_NewPointerObj((void *)&($1),$descriptor,0);
SWIG_Chicken_ThrowException(ptr);
}
/* ------------------------------------------------------------
* ANSI C typemaps
* ------------------------------------------------------------ */
%apply unsigned long { size_t };
/* ------------------------------------------------------------
* Various
* ------------------------------------------------------------ */
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }
/* ------------------------------------------------------------
* Overloaded operator support
* ------------------------------------------------------------ */
#ifdef __cplusplus
%rename(__add__) *::operator+;
%rename(__pos__) *::operator+();
%rename(__pos__) *::operator+() const;
%rename(__sub__) *::operator-;
%rename(__neg__) *::operator-();
%rename(__neg__) *::operator-() const;
%rename(__mul__) *::operator*;
%rename(__div__) *::operator/;
%rename(__mod__) *::operator%;
%rename(__lshift__) *::operator<<;
%rename(__rshift__) *::operator>>;
%rename(__and__) *::operator&;
%rename(__or__) *::operator|;
%rename(__xor__) *::operator^;
%rename(__invert__) *::operator~;
%rename(__iadd__) *::operator+=;
%rename(__isub__) *::operator-=;
%rename(__imul__) *::operator*=;
%rename(__idiv__) *::operator/=;
%rename(__imod__) *::operator%=;
%rename(__ilshift__) *::operator<<=;
%rename(__irshift__) *::operator>>=;
%rename(__iand__) *::operator&=;
%rename(__ior__) *::operator|=;
%rename(__ixor__) *::operator^=;
%rename(__lt__) *::operator<;
%rename(__le__) *::operator<=;
%rename(__gt__) *::operator>;
%rename(__ge__) *::operator>=;
%rename(__eq__) *::operator==;
%rename(__ne__) *::operator!=;
/* Special cases */
%rename(__call__) *::operator();
#endif
/* Warnings for certain CHICKEN keywords */
%include <chickenkw.swg>
/* TinyCLOS <--> Low-level CHICKEN */
%typemap("clos_in") SIMPLE_CLOS_OBJECT * "(slot-ref $input (quote this))"
%typemap("clos_out") SIMPLE_CLOS_OBJECT * "(make $class (quote this) $1)"
%insert(header) %{
#ifdef __cplusplus
extern "C" {
#endif
/* Chicken initialization function */
SWIGEXPORT void SWIG_init(C_word, C_word, C_word) C_noret;
#ifdef __cplusplus
}
#endif
%}
%insert(closprefix) "swigclosprefix.scm"
%insert(init) "swiginit.swg"
%insert(init) %{
/* CHICKEN initialization function */
#ifdef __cplusplus
extern "C" {
#endif
SWIGEXPORT void SWIG_init(C_word argc, C_word closure, C_word continuation) {
int i;
C_word sym;
C_word tmp;
C_word *a;
C_word ret;
C_word *return_vec;
SWIG_InitializeModule(0);
SWIG_PropagateClientData();
ret = C_SCHEME_TRUE;
#if $veclength
return_vec = C_alloc(C_SIZEOF_VECTOR($veclength));
ret = (C_word) return_vec;
*(return_vec++) = C_VECTOR_TYPE | $veclength;
#endif
a = C_alloc(2*$nummethods$symsize);
%}

View file

@ -1,31 +0,0 @@
#ifndef CHICKEN_CHICKENKW_SWG_
#define CHICKEN_CHICKENKW_SWG_
/* Warnings for certain CHICKEN keywords. From Section 7.1.1 of
Revised^5 Report on the Algorithmic Language Scheme */
#define CHICKENKW(x) %namewarn("314: '" #x "' is a R^5RS syntatic keyword") #x
CHICKENKW(else);
CHICKENKW(=>);
CHICKENKW(define);
CHICKENKW(unquote);
CHICKENKW(unquote-splicing);
CHICKENKW(quote);
CHICKENKW(lambda);
CHICKENKW(if);
CHICKENKW(set!);
CHICKENKW(begin);
CHICKENKW(cond);
CHICKENKW(and);
CHICKENKW(or);
CHICKENKW(case);
CHICKENKW(let);
CHICKENKW(let*);
CHICKENKW(letrec);
CHICKENKW(do);
CHICKENKW(delay);
CHICKENKW(quasiquote);
#undef CHICKENKW
#endif //CHICKEN_CHICKENKW_SWG_

View file

@ -1,375 +0,0 @@
/* -----------------------------------------------------------------------------
* chickenrun.swg
* ----------------------------------------------------------------------------- */
#include <chicken.h>
#include <assert.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#if (defined(_MSC_VER) && (_MSC_VER < 1900)) || defined(__BORLANDC__) || defined(_WATCOM)
# ifndef snprintf
# define snprintf _snprintf
# endif
#endif
#ifdef __cplusplus
extern "C" {
#endif
#define SWIG_malloc(size) \
malloc(size)
#define SWIG_free(mem) \
free(mem)
#define SWIG_MakeString(c) \
SWIG_Chicken_MakeString(c)
#define SWIG_ConvertPtr(s, result, type, flags) \
SWIG_Chicken_ConvertPtr(s, result, type, flags)
#define SWIG_MustGetPtr(s, type, argnum, flags) \
SWIG_Chicken_MustGetPtr(s, type, argnum, flags)
#define SWIG_NewPointerObj(ptr, type, owner) \
SWIG_Chicken_NewPointerObj((void*)ptr, type, owner, &known_space)
#define swig_barf SWIG_Chicken_Barf
#define SWIG_ThrowException(val) SWIG_Chicken_ThrowException(val)
#define SWIG_contract_assert(expr, message) if (!(expr)) { \
SWIG_Chicken_Barf(SWIG_BARF1_CONTRACT_ASSERT, C_text(message)); } else
/* Runtime API */
#define SWIG_GetModule(clientdata) SWIG_Chicken_GetModule(clientdata)
#define SWIG_SetModule(clientdata, pointer) SWIG_Chicken_SetModule(pointer)
#define C_swig_is_bool(x) C_truep (C_booleanp (x))
#define C_swig_is_char(x) C_truep (C_charp (x))
#define C_swig_is_fixnum(x) C_truep (C_fixnump (x))
#define C_swig_is_flonum(x) (C_truep (C_blockp (x)) && C_truep (C_flonump (x)))
#define C_swig_is_string(x) (C_truep (C_blockp (x)) && C_truep (C_stringp (x)))
#define C_swig_is_vector(x) (C_truep (C_blockp (x)) && C_truep (C_vectorp (x)))
#define C_swig_is_list(x) (C_truep (C_i_listp (x)))
#define C_swig_is_pair(x) (C_truep (C_blockp(x)) && C_truep (C_pairp(x)))
#define C_swig_is_ptr(x) (C_truep (C_blockp (x)) && C_truep (C_pointerp (x)))
#define C_swig_is_swigpointer(x) (C_truep (C_blockp(x)) && C_truep (C_swigpointerp(x)))
#define C_swig_is_closurep(x) (C_truep (C_blockp(x)) && C_truep(C_closurep(x)))
#define C_swig_is_number(x) (C_swig_is_fixnum(x) || C_swig_is_flonum(x))
#define C_swig_is_long(x) C_swig_is_number(x)
#define C_swig_sizeof_closure(num) (num+1)
#define SWIG_Chicken_SetupArgout { \
C_word *a = C_alloc(C_swig_sizeof_closure(2)); \
C_word *closure = a; \
*(a++)=C_CLOSURE_TYPE|2; \
*(a++)=(C_word)SWIG_Chicken_ApplyResults; \
*(a++)=continuation; \
continuation=(C_word)closure; \
}
#define SWIG_APPEND_VALUE(obj) { \
C_word val = (C_word)(obj); \
if (val != C_SCHEME_UNDEFINED) { \
C_word *a = C_alloc(C_swig_sizeof_closure(3)); \
C_word *closure = a; \
*(a++)=C_CLOSURE_TYPE|3; \
*(a++)=(C_word)SWIG_Chicken_MultiResultBuild; \
*(a++)=(C_word)continuation; \
*(a++)=val; \
continuation=(C_word)closure; \
} }
#define SWIG_Chicken_FindCreateProxy(func,obj) \
if (C_swig_is_swigpointer(obj)) { \
swig_type_info *t = (swig_type_info *) C_block_item(obj, 1); \
if (t && t->clientdata && ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create) { \
func = CHICKEN_gc_root_ref( ((swig_chicken_clientdata *)t->clientdata)->gc_proxy_create); \
} else { \
func = C_SCHEME_FALSE; \
} \
} else { \
func = C_SCHEME_FALSE; \
}
enum {
SWIG_BARF1_BAD_ARGUMENT_TYPE /* 1 arg */,
SWIG_BARF1_ARGUMENT_NULL /* 1 arg */,
SWIG_BARF1_CONTRACT_ASSERT /* 1 arg */,
};
typedef C_word (*swig_chicken_destructor)(C_word,C_word,C_word,C_word);
typedef struct swig_chicken_clientdata {
void *gc_proxy_create;
swig_chicken_destructor destroy;
} swig_chicken_clientdata;
static char *
SWIG_Chicken_MakeString(C_word str) {
char *ret;
size_t l;
l = C_header_size(str);
ret = (char *) SWIG_malloc( (l + 1) * sizeof(char));
if (!ret) return NULL;
memcpy(ret, C_c_string(str), l);
ret[l] = '\0';
return ret;
}
static C_word SWIG_Chicken_LookupSymbol(char *name, C_SYMBOL_TABLE *stable) {
C_word *a = C_alloc(C_SIZEOF_STRING (strlen (name)));
C_word n = C_string2(&a, name);
C_word sym = C_find_symbol(n, stable);
if (C_truep(sym)) {
return C_symbol_value(sym);
} else {
return C_SCHEME_FALSE;
}
}
/* Just a helper function. Do not export it */
static void SWIG_Chicken_Panic (C_char *) C_noret;
static void SWIG_Chicken_Panic (C_char *msg)
{
C_word *a = C_alloc (C_SIZEOF_STRING (strlen (msg)));
C_word scmmsg = C_string2 (&a, msg);
C_halt (scmmsg);
exit (5); /* should never get here */
}
static void
SWIG_Chicken_Barf(int code, C_char *msg, ...) C_noret;
static void
SWIG_Chicken_Barf(int code, C_char *msg, ...)
{
char *errorhook = C_text("\003syserror-hook");
C_word *a = C_alloc (C_SIZEOF_STRING (strlen (errorhook)));
C_word err = C_intern2 (&a, errorhook);
int c = -1;
int i, barfval;
va_list v;
C_temporary_stack = C_temporary_stack_bottom;
err = C_block_item(err, 0);
if(C_immediatep (err))
SWIG_Chicken_Panic (C_text ("`##sys#error-hook' is not defined"));
switch (code) {
case SWIG_BARF1_BAD_ARGUMENT_TYPE:
barfval = C_BAD_ARGUMENT_TYPE_ERROR;
c = 1;
break;
case SWIG_BARF1_ARGUMENT_NULL:
barfval = C_BAD_ARGUMENT_TYPE_ERROR;
c = 1;
break;
case SWIG_BARF1_CONTRACT_ASSERT:
barfval = C_BAD_ARGUMENT_TYPE_ERROR;
c = 1;
break;
default:
SWIG_Chicken_Panic (C_text (msg));
};
if(c > 0 && !C_immediatep (err)) {
C_save (C_fix (barfval));
i = c;
if (i) {
C_word *b = C_alloc (C_SIZEOF_STRING (strlen (msg)));
C_word scmmsg = C_string2 (&b, msg);
C_save (scmmsg);
i--;
}
va_start (v, msg);
while(i--)
C_save (va_arg (v, C_word));
va_end (v);
C_do_apply (c + 1, err,
C_SCHEME_UNDEFINED); /* <- no continuation is passed:
'##sys#error-hook' may not
return! */
}
else if (msg) {
SWIG_Chicken_Panic (msg);
}
else {
SWIG_Chicken_Panic (C_text ("unspecified panic"));
}
}
static void SWIG_Chicken_ThrowException(C_word value) C_noret;
static void SWIG_Chicken_ThrowException(C_word value)
{
char *aborthook = C_text("\003sysabort");
C_word *a = C_alloc(C_SIZEOF_STRING(strlen(aborthook)));
C_word abort = C_intern2(&a, aborthook);
abort = C_block_item(abort, 0);
if (C_immediatep(abort))
SWIG_Chicken_Panic(C_text("`##sys#abort' is not defined"));
C_save(value);
C_do_apply(1, abort, C_SCHEME_UNDEFINED);
}
static void
SWIG_Chicken_Finalizer(C_word argc, C_word closure, C_word continuation, C_word s)
{
swig_type_info *type;
swig_chicken_clientdata *cdata;
if (argc == 3 && s != C_SCHEME_FALSE && C_swig_is_swigpointer(s)) {
type = (swig_type_info *) C_block_item(s, 1);
if (type) {
cdata = (swig_chicken_clientdata *) type->clientdata;
if (cdata && cdata->destroy) {
/* this will not return, but will continue correctly */
cdata->destroy(3,closure,continuation,s);
}
}
}
C_kontinue(continuation, C_SCHEME_UNDEFINED);
}
static C_word finalizer_obj[2] = {(C_word) (C_CLOSURE_TYPE|1), (C_word) SWIG_Chicken_Finalizer};
static C_word
SWIG_Chicken_NewPointerObj(void *ptr, swig_type_info *type, int owner, C_word **data)
{
swig_chicken_clientdata *cdata = (swig_chicken_clientdata *) type->clientdata;
if (ptr == NULL)
return C_SCHEME_FALSE;
else {
C_word cptr = C_swigmpointer(data, ptr, type);
/* add finalizer to object */
#ifndef SWIG_CHICKEN_NO_COLLECTION
if (owner)
C_do_register_finalizer(cptr, (C_word) finalizer_obj);
#endif
return cptr;
}
}
/* Return 0 if successful. */
static int
SWIG_Chicken_ConvertPtr(C_word s, void **result, swig_type_info *type, int flags)
{
swig_cast_info *cast;
swig_type_info *from;
if (s == C_SCHEME_FALSE) {
*result = NULL;
return (flags & SWIG_POINTER_NO_NULL) ? SWIG_NullReferenceError : SWIG_OK;
} else if (C_swig_is_swigpointer(s)) {
/* try and convert type */
from = (swig_type_info *) C_block_item(s, 1);
if (!from) return 1;
if (type) {
cast = SWIG_TypeCheckStruct(from, type);
if (cast) {
int newmemory = 0;
*result = SWIG_TypeCast(cast, (void *) C_block_item(s, 0), &newmemory);
assert(!newmemory); /* newmemory handling not yet implemented */
} else {
return 1;
}
} else {
*result = (void *) C_block_item(s, 0);
}
/* check if we are disowning this object */
if (flags & SWIG_POINTER_DISOWN) {
C_do_unregister_finalizer(s);
}
} else {
return 1;
}
return 0;
}
static SWIGINLINE void *
SWIG_Chicken_MustGetPtr (C_word s, swig_type_info *type, int argnum, int flags)
{
void *result;
char err_msg[256];
if (SWIG_Chicken_ConvertPtr(s, &result, type, flags)) {
/* type mismatch */
snprintf(err_msg, sizeof(err_msg), "Type error in argument #%i: expected %s", argnum, (type->str ? type->str : type->name));
SWIG_Chicken_Barf(SWIG_BARF1_BAD_ARGUMENT_TYPE, err_msg);
}
return result;
}
static char *chicken_runtimevar_name = "type_pointer" SWIG_TYPE_TABLE_NAME;
static swig_module_info *
SWIG_Chicken_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
swig_module_info *ret = 0;
C_word sym;
/* lookup the type pointer... it is stored in its own symbol table */
C_SYMBOL_TABLE *stable = C_find_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION);
if (stable != NULL) {
sym = SWIG_Chicken_LookupSymbol(chicken_runtimevar_name, stable);
if (C_truep(sym) && C_swig_is_ptr(sym)) {
ret = (swig_module_info *) C_block_item(sym, 0);
}
}
return ret;
}
static void
SWIG_Chicken_SetModule(swig_module_info *module) {
C_word *a;
C_SYMBOL_TABLE *stable;
C_word sym;
C_word pointer;
static C_word *space = 0;
/* type pointer is stored in its own symbol table */
stable = C_find_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION);
if (stable == NULL) {
stable = C_new_symbol_table("swig_runtime_data" SWIG_RUNTIME_VERSION, 16);
}
if (!space) {
space = (C_word *) C_malloc((C_SIZEOF_POINTER + C_SIZEOF_INTERNED_SYMBOL(C_strlen(chicken_runtimevar_name))) * sizeof(C_word));
}
a = space;
pointer = C_mpointer(&a, (void *) module);
sym = C_intern_in(&a, C_strlen(chicken_runtimevar_name), chicken_runtimevar_name, stable);
C_set_block_item(sym, 0, pointer);
}
static C_word SWIG_Chicken_MultiResultBuild(C_word num, C_word closure, C_word lst) {
C_word cont = C_block_item(closure,1);
C_word obj = C_block_item(closure,2);
C_word func;
SWIG_Chicken_FindCreateProxy(func,obj);
if (C_swig_is_closurep(func)) {
((C_proc4)(void *)C_block_item(func, 0))(4,func,cont,obj,lst);
} else {
C_word *a = C_alloc(C_SIZEOF_PAIR);
C_kontinue(cont,C_pair(&a,obj,lst));
}
return C_SCHEME_UNDEFINED; /* never reached */
}
static C_word SWIG_Chicken_ApplyResults(C_word num, C_word closure, C_word result) {
C_apply_values(3,C_SCHEME_UNDEFINED,C_block_item(closure,1),result);
return C_SCHEME_UNDEFINED; /* never reached */
}
#ifdef __cplusplus
}
#endif

View file

@ -1,3 +0,0 @@
swigclosprefix.scm
multi-generic.scm
tinyclos-multi-generic.patch

View file

@ -1,152 +0,0 @@
;; This file is no longer necessary with Chicken versions above 1.92
;;
;; This file overrides two functions inside TinyCLOS to provide support
;; for multi-argument generics. There are many ways of linking this file
;; into your code... all that needs to happen is this file must be
;; executed after loading TinyCLOS but before any SWIG modules are loaded
;;
;; something like the following
;; (require 'tinyclos)
;; (load "multi-generic")
;; (declare (uses swigmod))
;;
;; An alternative to loading this scheme code directly is to add a
;; (declare (unit multi-generic)) to the top of this file, and then
;; compile this into the final executable or something. Or compile
;; this into an extension.
;; Lastly, to override TinyCLOS method creation, two functions are
;; overridden: see the end of this file for which two are overridden.
;; You might want to remove those two lines and then exert more control over
;; which functions are used when.
;; Comments, bugs, suggestions: send either to chicken-users@nongnu.org or to
;; Most code copied from TinyCLOS
(define <multi-generic> (make <entity-class>
'name "multi-generic"
'direct-supers (list <generic>)
'direct-slots '()))
(letrec ([applicable?
(lambda (c arg)
(memq c (class-cpl (class-of arg))))]
[more-specific?
(lambda (c1 c2 arg)
(memq c2 (memq c1 (class-cpl (class-of arg)))))]
[filter-in
(lambda (f l)
(if (null? l)
'()
(let ([h (##sys#slot l 0)]
[r (##sys#slot l 1)] )
(if (f h)
(cons h (filter-in f r))
(filter-in f r) ) ) ) )])
(add-method compute-apply-generic
(make-method (list <multi-generic>)
(lambda (call-next-method generic)
(lambda args
(let ([cam (let ([x (compute-apply-methods generic)]
[y ((compute-methods generic) args)] )
(lambda (args) (x y args)) ) ] )
(cam args) ) ) ) ) )
(add-method compute-methods
(make-method (list <multi-generic>)
(lambda (call-next-method generic)
(lambda (args)
(let ([applicable
(filter-in (lambda (method)
(let check-applicable ([list1 (method-specializers method)]
[list2 args])
(cond ((null? list1) #t)
((null? list2) #f)
(else
(and (applicable? (##sys#slot list1 0) (##sys#slot list2 0))
(check-applicable (##sys#slot list1 1) (##sys#slot list2 1)))))))
(generic-methods generic) ) ] )
(if (or (null? applicable) (null? (##sys#slot applicable 1)))
applicable
(let ([cmms (compute-method-more-specific? generic)])
(sort applicable (lambda (m1 m2) (cmms m1 m2 args))) ) ) ) ) ) ) )
(add-method compute-method-more-specific?
(make-method (list <multi-generic>)
(lambda (call-next-method generic)
(lambda (m1 m2 args)
(let loop ((specls1 (method-specializers m1))
(specls2 (method-specializers m2))
(args args))
(cond-expand
[unsafe
(let ((c1 (##sys#slot specls1 0))
(c2 (##sys#slot specls2 0))
(arg (##sys#slot args 0)))
(if (eq? c1 c2)
(loop (##sys#slot specls1 1)
(##sys#slot specls2 1)
(##sys#slot args 1))
(more-specific? c1 c2 arg))) ]
[else
(cond ((and (null? specls1) (null? specls2))
(##sys#error "two methods are equally specific" generic))
;((or (null? specls1) (null? specls2))
; (##sys#error "two methods have different number of specializers" generic))
((null? specls1) #f)
((null? specls2) #t)
((null? args)
(##sys#error "fewer arguments than specializers" generic))
(else
(let ((c1 (##sys#slot specls1 0))
(c2 (##sys#slot specls2 0))
(arg (##sys#slot args 0)))
(if (eq? c1 c2)
(loop (##sys#slot specls1 1)
(##sys#slot specls2 1)
(##sys#slot args 1))
(more-specific? c1 c2 arg)))) ) ] ) ) ) ) ) )
) ;; end of letrec
(define multi-add-method
(lambda (generic method)
(slot-set!
generic
'methods
(let filter-in-method ([methods (slot-ref generic 'methods)])
(if (null? methods)
(list method)
(let ([l1 (length (method-specializers method))]
[l2 (length (method-specializers (##sys#slot methods 0)))])
(cond ((> l1 l2)
(cons (##sys#slot methods 0) (filter-in-method (##sys#slot methods 1))))
((< l1 l2)
(cons method methods))
(else
(let check-method ([ms1 (method-specializers method)]
[ms2 (method-specializers (##sys#slot methods 0))])
(cond ((and (null? ms1) (null? ms2))
(cons method (##sys#slot methods 1))) ;; skip the method already in the generic
((eq? (##sys#slot ms1 0) (##sys#slot ms2 0))
(check-method (##sys#slot ms1 1) (##sys#slot ms2 1)))
(else
(cons (##sys#slot methods 0) (filter-in-method (##sys#slot methods 1))))))))))))
(##sys#setslot (##sys#slot generic (- (##sys#size generic) 2)) 1 (compute-apply-generic generic)) ))
(define (multi-add-global-method val sym specializers proc)
(let ((generic (if (procedure? val) val (make <multi-generic> 'name (##sys#symbol->string sym)))))
(multi-add-method generic (make-method specializers proc))
generic))
;; Might want to remove these, or perhaps do something like
;; (define old-add-method ##tinyclos#add-method)
;; and then you can switch between creating multi-generics and TinyCLOS generics.
(set! ##tinyclos#add-method multi-add-method)
(set! ##tinyclos#add-global-method multi-add-global-method)

View file

@ -1,96 +0,0 @@
/* -----------------------------------------------------------------------------
* std_string.i
*
* SWIG typemaps for std::string
* ----------------------------------------------------------------------------- */
%{
#include <string>
%}
namespace std {
%naturalvar string;
%insert(closprefix) %{ (declare (hide <std-string>)) %}
%nodefault string;
%rename("std-string") string;
class string {
public:
~string() {}
};
%extend string {
char *str;
}
%{
#define std_string_str_get(s) ((char *)((s)->c_str()))
#define std_string_str_set(s,v) (s->assign((char *)(v)))
%}
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in) string (char * tempptr) {
if ($input == C_SCHEME_FALSE) {
$1.resize(0);
} else {
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,
"Argument #$argnum is not a string");
}
tempptr = SWIG_MakeString($input);
$1.assign(tempptr);
if (tempptr) SWIG_free(tempptr);
}
}
%typemap(in) const string& ($*1_ltype temp, char *tempptr) {
if ($input == C_SCHEME_FALSE) {
temp.resize(0);
$1 = &temp;
} else {
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,
"Argument #$argnum is not a string");
}
tempptr = SWIG_MakeString($input);
temp.assign(tempptr);
if (tempptr) SWIG_free(tempptr);
$1 = &temp;
}
}
%typemap(out) string {
int size = $1.size();
C_word *space = C_alloc (C_SIZEOF_STRING (size));
$result = C_string (&space, size, (char *) $1.c_str());
}
%typemap(out) const string& {
int size = $1->size();
C_word *space = C_alloc (C_SIZEOF_STRING (size));
$result = C_string (&space, size, (char *) $1->c_str());
}
%typemap(varin) string {
if ($input == C_SCHEME_FALSE) {
$1.resize(0);
} else {
char *tempptr;
if (!C_swig_is_string ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE,
"Argument #$argnum is not a string");
}
tempptr = SWIG_MakeString($input);
$1.assign(tempptr);
if (tempptr) SWIG_free(tempptr);
}
}
%typemap(varout) string {
int size = $1.size();
C_word *space = C_alloc (C_SIZEOF_STRING (size));
$result = C_string (&space, size, (char *) $1.c_str());
}
}

View file

@ -1,31 +0,0 @@
(declare (hide swig-initialize))
(define (swig-initialize obj initargs create)
(slot-set! obj 'swig-this
(if (memq 'swig-this initargs)
(cadr initargs)
(let ((ret (apply create initargs)))
(if (instance? ret)
(slot-ref ret 'swig-this)
ret)))))
(define-class <swig-metaclass-$module> (<class>) (void))
(define-method (compute-getter-and-setter (class <swig-metaclass-$module>) slot allocator)
(if (not (memq ':swig-virtual slot))
(call-next-method)
(let ((getter (let search-get ((lst slot))
(if (null? lst)
#f
(if (eq? (car lst) ':swig-get)
(cadr lst)
(search-get (cdr lst))))))
(setter (let search-set ((lst slot))
(if (null? lst)
#f
(if (eq? (car lst) ':swig-set)
(cadr lst)
(search-set (cdr lst)))))))
(values
(lambda (o) (getter (slot-ref o 'swig-this)))
(lambda (o new) (setter (slot-ref o 'swig-this) new) new)))))

View file

@ -1,150 +0,0 @@
# This patch is against chicken 1.92, but it should work just fine
# with older versions of chicken. It adds support for mulit-argument
# generics, that is, generics now correctly handle adding methods
# with different lengths of specializer lists
# This patch has been committed into the CHICKEN darcs repository,
# so chicken versions above 1.92 work fine.
# Comments, bugs, suggestions send to chicken-users@nongnu.org
# Patch written by John Lenz <lenz@cs.wisc.edu>
--- tinyclos.scm.old 2005-04-05 01:13:56.000000000 -0500
+++ tinyclos.scm 2005-04-11 16:37:23.746181489 -0500
@@ -37,8 +37,10 @@
(include "parameters")
+(cond-expand [(not chicken-compile-shared) (declare (unit tinyclos))]
+ [else] )
+
(declare
- (unit tinyclos)
(uses extras)
(usual-integrations)
(fixnum)
@@ -234,7 +236,10 @@
y = C_block_item(y, 1);
}
}
- return(C_block_item(v, i + 1));
+ if (x == C_SCHEME_END_OF_LIST && y == C_SCHEME_END_OF_LIST)
+ return(C_block_item(v, i + 1));
+ else
+ goto mismatch;
}
else if(free_index == -1) free_index = i;
mismatch:
@@ -438,7 +443,7 @@
(define hash-arg-list
(foreign-lambda* unsigned-int ((scheme-object args) (scheme-object svector)) "
C_word tag, h, x;
- int n, i, j;
+ int n, i, j, len = 0;
for(i = 0; args != C_SCHEME_END_OF_LIST; args = C_block_item(args, 1)) {
x = C_block_item(args, 0);
if(C_immediatep(x)) {
@@ -481,8 +486,9 @@
default: i += 255;
}
}
+ ++len;
}
- return(i & (C_METHOD_CACHE_SIZE - 1));") )
+ return((i + len) & (C_METHOD_CACHE_SIZE - 1));") )
;
@@ -868,13 +874,27 @@
(##tinyclos#slot-set!
generic
'methods
- (cons method
- (filter-in
- (lambda (m)
- (let ([ms1 (method-specializers m)]
- [ms2 (method-specializers method)] )
- (not (every2 (lambda (x y) (eq? x y)) ms1 ms2) ) ) )
- (##tinyclos#slot-ref generic 'methods))))
+ (let* ([ms1 (method-specializers method)]
+ [l1 (length ms1)] )
+ (let filter-in-method ([methods (##tinyclos#slot-ref generic 'methods)])
+ (if (null? methods)
+ (list method)
+ (let* ([mm (##sys#slot methods 0)]
+ [ms2 (method-specializers mm)]
+ [l2 (length ms2)])
+ (cond ((> l1 l2)
+ (cons mm (filter-in-method (##sys#slot methods 1))))
+ ((< l1 l2)
+ (cons method methods))
+ (else
+ (let check-method ([ms1 ms1]
+ [ms2 ms2])
+ (cond ((and (null? ms1) (null? ms2))
+ (cons method (##sys#slot methods 1))) ;; skip the method already in the generic
+ ((eq? (##sys#slot ms1 0) (##sys#slot ms2 0))
+ (check-method (##sys#slot ms1 1) (##sys#slot ms2 1)))
+ (else
+ (cons mm (filter-in-method (##sys#slot methods 1)))))))))))))
(if (memq generic generic-invocation-generics)
(set! method-cache-tag (vector))
(%entity-cache-set! generic #f) )
@@ -925,11 +945,13 @@
(memq (car args) generic-invocation-generics))
(let ([proc
(method-procedure
+ ; select the first method of one argument
(let lp ([lis (generic-methods generic)])
- (let ([tail (##sys#slot lis 1)])
- (if (null? tail)
- (##sys#slot lis 0)
- (lp tail)) ) ) ) ] )
+ (if (null? lis)
+ (##sys#error "Unable to find original compute-apply-generic")
+ (if (= (length (method-specializers (##sys#slot lis 0))) 1)
+ (##sys#slot lis 0)
+ (lp (##sys#slot lis 1)))))) ] )
(lambda (args) (apply proc #f args)) )
(let ([x (compute-apply-methods generic)]
[y ((compute-methods generic) args)] )
@@ -946,9 +968,13 @@
(lambda (args)
(let ([applicable
(filter-in (lambda (method)
- (every2 applicable?
- (method-specializers method)
- args))
+ (let check-applicable ([list1 (method-specializers method)]
+ [list2 args])
+ (cond ((null? list1) #t)
+ ((null? list2) #f)
+ (else
+ (and (applicable? (##sys#slot list1 0) (##sys#slot list2 0))
+ (check-applicable (##sys#slot list1 1) (##sys#slot list2 1)))))))
(generic-methods generic) ) ] )
(if (or (null? applicable) (null? (##sys#slot applicable 1)))
applicable
@@ -975,8 +1001,10 @@
[else
(cond ((and (null? specls1) (null? specls2))
(##sys#error "two methods are equally specific" generic))
- ((or (null? specls1) (null? specls2))
- (##sys#error "two methods have different number of specializers" generic))
+ ;((or (null? specls1) (null? specls2))
+ ; (##sys#error "two methods have different number of specializers" generic))
+ ((null? specls1) #f)
+ ((null? specls2) #t)
((null? args)
(##sys#error "fewer arguments than specializers" generic))
(else
@@ -1210,7 +1238,7 @@
(define <structure> (make-primitive-class "structure"))
(define <procedure> (make-primitive-class "procedure" <procedure-class>))
(define <end-of-file> (make-primitive-class "end-of-file"))
-(define <environment> (make-primitive-class "environment" <structure>)) ; (Benedikt insisted on this)
+(define <environment> (make-primitive-class "environment" <structure>))
(define <hash-table> (make-primitive-class "hash-table" <structure>))
(define <promise> (make-primitive-class "promise" <structure>))
(define <queue> (make-primitive-class "queue" <structure>))

View file

@ -1,314 +0,0 @@
/* -----------------------------------------------------------------------------
* typemaps.i
*
* Pointer handling
*
* These mappings provide support for input/output arguments and
* common uses for C/C++ pointers. INOUT mappings allow for C/C++
* pointer variables in addition to input/output arguments.
* ----------------------------------------------------------------------------- */
// INPUT typemaps.
// These remap a C pointer to be an "INPUT" value which is passed by value
// instead of reference.
/*
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
long long *INPUT
unsigned int *INPUT
unsigned short *INPUT
unsigned long *INPUT
unsigned long long *INPUT
unsigned char *INPUT
char *INPUT
bool *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);
*/
// OUTPUT typemaps. These typemaps are used for parameters that
// are output only. The output value is appended to the result as
// a list element.
/*
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 Scheme list.
int *OUTPUT
short *OUTPUT
long *OUTPUT
long long *OUTPUT
unsigned int *OUTPUT
unsigned short *OUTPUT
unsigned long *OUTPUT
unsigned long long *OUTPUT
unsigned char *OUTPUT
char *OUTPUT
bool *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);
*/
//----------------------------------------------------------------------
//
// T_OUTPUT typemap (and helper function) to return multiple argouts as
// a tuple instead of a list.
//
//----------------------------------------------------------------------
// Simple types
%define INOUT_TYPEMAP(type_, from_scheme, to_scheme, checker, convtype, storage_)
%typemap(in) type_ *INPUT($*1_ltype temp), type_ &INPUT($*1_ltype temp)
%{ if (!checker ($input)) {
swig_barf (SWIG_BARF1_BAD_ARGUMENT_TYPE, "Argument #$argnum is not of type 'type_'");
}
temp = ($*1_ltype) from_scheme ($input);
$1 = &temp; %}
%typemap(typecheck) type_ *INPUT = type_;
%typemap(typecheck) type_ &INPUT = type_;
%typemap(in, numinputs=0) type_ *OUTPUT($*1_ltype temp), type_ &OUTPUT($*1_ltype temp)
" $1 = &temp;"
#if "storage_" == "0"
%typemap(argout) type_ *OUTPUT, type_ &OUTPUT
%{
if ($1 == NULL) {
swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Argument #$argnum must be non-null");
}
SWIG_APPEND_VALUE(to_scheme (convtype (*$1)));
%}
#else
%typemap(argout) type_ *OUTPUT, type_ &OUTPUT
%{
{
C_word *known_space = C_alloc(storage_);
if ($1 == NULL) {
swig_barf (SWIG_BARF1_ARGUMENT_NULL, "Variable '$1' must be non-null");
}
SWIG_APPEND_VALUE(to_scheme (&known_space, convtype (*$1)));
}
%}
#endif
%enddef
INOUT_TYPEMAP(int, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
INOUT_TYPEMAP(enum SWIGTYPE, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
INOUT_TYPEMAP(short, C_num_to_int, C_fix, C_swig_is_number, (int), 0);
INOUT_TYPEMAP(long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(long long, C_num_to_long, C_long_to_num, C_swig_is_long, (long), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned int, C_num_to_unsigned_int, C_unsigned_int_to_num, C_swig_is_number, (int), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned short, C_num_to_unsigned_int, C_fix, C_swig_is_number, (unsigned int), 0);
INOUT_TYPEMAP(unsigned long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned long long, C_num_to_unsigned_long, C_unsigned_long_to_num, C_swig_is_long, (unsigned long), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(unsigned char, C_character_code, C_make_character, C_swig_is_char, (unsigned int), 0);
INOUT_TYPEMAP(signed char, C_character_code, C_make_character, C_swig_is_char, (int), 0);
INOUT_TYPEMAP(char, C_character_code, C_make_character, C_swig_is_char, (char), 0);
INOUT_TYPEMAP(bool, C_truep, C_mk_bool, C_swig_is_bool, (bool), 0);
INOUT_TYPEMAP(float, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
INOUT_TYPEMAP(double, C_c_double, C_flonum, C_swig_is_number, (double), C_SIZEOF_FLONUM);
// INOUT
// Mappings for an argument that is both an input and output
// parameter
/*
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 CHICKEN tuple.
int *INOUT
short *INOUT
long *INOUT
long long *INOUT
unsigned int *INOUT
unsigned short *INOUT
unsigned long *INOUT
unsigned long long *INOUT
unsigned char *INOUT
char *INOUT
bool *INOUT
float *INOUT
double *INOUT
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 *INOUT);
or you can use the %apply directive :
%include <typemaps.i>
%apply double *INOUT { double *x };
void neg(double *x);
As well, you can wrap variables with :
%include <typemaps.i>
%apply double *INOUT { double *y };
extern double *y;
Unlike C, this mapping does not directly modify the input value (since
this makes no sense in CHICKEN). Rather, the modified input value shows
up as the return value of the function. Thus, to apply this function
to a CHICKEN variable you might do this :
x = neg(x)
Note : previous versions of SWIG used the symbol 'BOTH' to mark
input/output arguments. This is still supported, but will be slowly
phased out in future releases.
*/
%typemap(in) int *INOUT = int *INPUT;
%typemap(in) enum SWIGTYPE *INOUT = enum SWIGTYPE *INPUT;
%typemap(in) short *INOUT = short *INPUT;
%typemap(in) long *INOUT = long *INPUT;
%typemap(in) long long *INOUT = long long *INPUT;
%typemap(in) unsigned *INOUT = unsigned *INPUT;
%typemap(in) unsigned short *INOUT = unsigned short *INPUT;
%typemap(in) unsigned long *INOUT = unsigned long *INPUT;
%typemap(in) unsigned long long *INOUT = unsigned long long *INPUT;
%typemap(in) unsigned char *INOUT = unsigned char *INPUT;
%typemap(in) char *INOUT = char *INPUT;
%typemap(in) bool *INOUT = bool *INPUT;
%typemap(in) float *INOUT = float *INPUT;
%typemap(in) double *INOUT = double *INPUT;
%typemap(in) int &INOUT = int &INPUT;
%typemap(in) enum SWIGTYPE &INOUT = enum SWIGTYPE &INPUT;
%typemap(in) short &INOUT = short &INPUT;
%typemap(in) long &INOUT = long &INPUT;
%typemap(in) long long &INOUT = long long &INPUT;
%typemap(in) unsigned &INOUT = unsigned &INPUT;
%typemap(in) unsigned short &INOUT = unsigned short &INPUT;
%typemap(in) unsigned long &INOUT = unsigned long &INPUT;
%typemap(in) unsigned long long &INOUT = unsigned long long &INPUT;
%typemap(in) unsigned char &INOUT = unsigned char &INPUT;
%typemap(in) char &INOUT = char &INPUT;
%typemap(in) bool &INOUT = bool &INPUT;
%typemap(in) float &INOUT = float &INPUT;
%typemap(in) double &INOUT = double &INPUT;
%typemap(argout) int *INOUT = int *OUTPUT;
%typemap(argout) enum SWIGTYPE *INOUT = enum SWIGTYPE *OUTPUT;
%typemap(argout) short *INOUT = short *OUTPUT;
%typemap(argout) long *INOUT = long *OUTPUT;
%typemap(argout) long long *INOUT = long long *OUTPUT;
%typemap(argout) unsigned *INOUT = unsigned *OUTPUT;
%typemap(argout) unsigned short *INOUT = unsigned short *OUTPUT;
%typemap(argout) unsigned long *INOUT = unsigned long *OUTPUT;
%typemap(argout) unsigned long long *INOUT = unsigned long long *OUTPUT;
%typemap(argout) unsigned char *INOUT = unsigned char *OUTPUT;
%typemap(argout) bool *INOUT = bool *OUTPUT;
%typemap(argout) float *INOUT = float *OUTPUT;
%typemap(argout) double *INOUT = double *OUTPUT;
%typemap(argout) int &INOUT = int &OUTPUT;
%typemap(argout) enum SWIGTYPE &INOUT = enum SWIGTYPE &OUTPUT;
%typemap(argout) short &INOUT = short &OUTPUT;
%typemap(argout) long &INOUT = long &OUTPUT;
%typemap(argout) long long &INOUT = long long &OUTPUT;
%typemap(argout) unsigned &INOUT = unsigned &OUTPUT;
%typemap(argout) unsigned short &INOUT = unsigned short &OUTPUT;
%typemap(argout) unsigned long &INOUT = unsigned long &OUTPUT;
%typemap(argout) unsigned long long &INOUT = unsigned long long &OUTPUT;
%typemap(argout) unsigned char &INOUT = unsigned char &OUTPUT;
%typemap(argout) char &INOUT = char &OUTPUT;
%typemap(argout) bool &INOUT = bool &OUTPUT;
%typemap(argout) float &INOUT = float &OUTPUT;
%typemap(argout) double &INOUT = double &OUTPUT;
/* Overloading information */
%typemap(typecheck) double *INOUT = double;
%typemap(typecheck) bool *INOUT = bool;
%typemap(typecheck) char *INOUT = char;
%typemap(typecheck) signed char *INOUT = signed char;
%typemap(typecheck) unsigned char *INOUT = unsigned char;
%typemap(typecheck) unsigned long *INOUT = unsigned long;
%typemap(typecheck) unsigned long long *INOUT = unsigned long long;
%typemap(typecheck) unsigned short *INOUT = unsigned short;
%typemap(typecheck) unsigned int *INOUT = unsigned int;
%typemap(typecheck) long *INOUT = long;
%typemap(typecheck) long long *INOUT = long long;
%typemap(typecheck) short *INOUT = short;
%typemap(typecheck) int *INOUT = int;
%typemap(typecheck) enum SWIGTYPE *INOUT = enum SWIGTYPE;
%typemap(typecheck) float *INOUT = float;
%typemap(typecheck) double &INOUT = double;
%typemap(typecheck) bool &INOUT = bool;
%typemap(typecheck) char &INOUT = char;
%typemap(typecheck) signed char &INOUT = signed char;
%typemap(typecheck) unsigned char &INOUT = unsigned char;
%typemap(typecheck) unsigned long &INOUT = unsigned long;
%typemap(typecheck) unsigned long long &INOUT = unsigned long long;
%typemap(typecheck) unsigned short &INOUT = unsigned short;
%typemap(typecheck) unsigned int &INOUT = unsigned int;
%typemap(typecheck) long &INOUT = long;
%typemap(typecheck) long long &INOUT = long long;
%typemap(typecheck) short &INOUT = short;
%typemap(typecheck) int &INOUT = int;
%typemap(typecheck) enum SWIGTYPE &INOUT = enum SWIGTYPE;
%typemap(typecheck) float &INOUT = float;

View file

@ -1,32 +0,0 @@
/* -----------------------------------------------------------------------------
* clisp.swg
* ----------------------------------------------------------------------------- */
/* Define a C preprocessor symbol that can be used in interface files
to distinguish between the SWIG language modules. */
#define SWIG_CLISP
/* Typespecs for basic types. */
%typemap(in) void "NIL";
%typemap(in) char "character";
%typemap(in) char * "ffi:c-string";
%typemap(in) unsigned char "ffi:uchar";
%typemap(in) signed char "ffi:char";
%typemap(in) short "ffi:short";
%typemap(in) signed short "ffi:short";
%typemap(in) unsigned short "ffi:ushort";
%typemap(in) int "ffi:int";
%typemap(in) signed int "ffi:int";
%typemap(in) unsigned int "ffi:uint";
%typemap(in) long "ffi:long";
%typemap(in) signed long "ffi:long";
%typemap(in) unsigned long "ffi:ulong";
%typemap(in) float "SINGLE-FLOAT";
%typemap(in) double "DOUBLE-FLOAT";

View file

@ -1,787 +0,0 @@
/* -----------------------------------------------------------------------------
* modula3.swg
*
* Modula3 typemaps
* ----------------------------------------------------------------------------- */
%include <modula3head.swg>
/* The ctype, m3rawtype and m3wraptype typemaps work together and so there should be one of each.
* The ctype typemap contains the C type used in the signature of C wrappers for C++ functions.
* The m3rawtype typemap contains the M3 type used in the raw interface.
* The m3rawintype typemap contains the M3 type used as function argument.
* The m3rawrettype typemap contains the M3 type used as return value.
* The m3wraptype typemap contains the M3 type used in the M3 type wrapper classes and module class. */
/* Primitive types */
%typemap(ctype) bool, const bool & "bool"
%typemap(ctype) char, const char & "char"
%typemap(ctype) signed char, const signed char & "signed char"
%typemap(ctype) unsigned char, const unsigned char & "unsigned short"
%typemap(ctype) short, const short & "short"
%typemap(ctype) unsigned short, const unsigned short & "unsigned short"
%typemap(ctype) int, const int & "int"
%typemap(ctype) unsigned int, const unsigned int & "unsigned int"
%typemap(ctype) long, const long & "long"
%typemap(ctype) unsigned long, const unsigned long & "unsigned long"
%typemap(ctype) long long, const long long & "long long"
%typemap(ctype) unsigned long long, const unsigned long long & "unsigned long long"
%typemap(ctype) float, const float & "float"
%typemap(ctype) double, const double & "double"
%typemap(ctype) char * "char *"
%typemap(ctype) void "void"
%typemap(m3rawtype) bool, const bool & "BOOLEAN"
%typemap(m3rawtype) char, const char & "C.char"
%typemap(m3rawtype) signed char, const signed char & "C.signed_char"
%typemap(m3rawtype) unsigned char, const unsigned char & "C.unsigned_char"
%typemap(m3rawtype) short, const short & "C.short"
%typemap(m3rawtype) unsigned short, const unsigned short & "C.unsigned_short"
%typemap(m3rawtype) int, const int & "C.int"
%typemap(m3rawtype) unsigned int, const unsigned int & "C.unsigned_int"
%typemap(m3rawtype) long, const long & "C.long"
%typemap(m3rawtype) unsigned long, const unsigned long & "C.unsigned_long"
%typemap(m3rawtype) long long, const long long & "C.long_long"
%typemap(m3rawtype) unsigned long long, const unsigned long long & "C.unsigned_long_long"
%typemap(m3rawtype) float, const float & "C.float"
%typemap(m3rawtype) double, const double & "C.double"
%typemap(m3rawtype) long double, const long double & "C.long_double"
%typemap(m3rawtype) char * "C.char_star"
%typemap(m3rawtype) void ""
%typemap(m3rawtype) FILE "Cstdio.FILE";
%typemap(m3rawtype) FILE * "Cstdio.FILE_star";
%typemap(m3rawintype) bool *, bool &, bool "BOOLEAN"
%typemap(m3rawintype) char *, char &, char "C.char"
%typemap(m3rawintype) signed char *, signed char &, signed char "C.signed_char"
%typemap(m3rawintype) unsigned char *, unsigned char &, unsigned char "C.unsigned_char"
%typemap(m3rawintype) short *, short &, short "C.short"
%typemap(m3rawintype) unsigned short *, unsigned short &, unsigned short "C.unsigned_short"
%typemap(m3rawintype) int *, int &, int "C.int"
%typemap(m3rawintype) unsigned int *, unsigned int &, unsigned int "C.unsigned_int"
%typemap(m3rawintype) long *, long &, long "C.long"
%typemap(m3rawintype) unsigned long *, unsigned long &, unsigned long "C.unsigned_long"
%typemap(m3rawintype) long long *, long long &, long long "C.long_long"
%typemap(m3rawintype) unsigned long long *, unsigned long long &, unsigned long long "C.unsigned_long_long"
%typemap(m3rawintype) float *, float &, float "C.float"
%typemap(m3rawintype) double *, double &, double "C.double"
%typemap(m3rawintype) long double *, long double &, long double "C.long_double"
%typemap(m3rawintype) char * "C.char_star"
%typemap(m3rawintype) void ""
%typemap(m3rawintype) void * "ADDRESS"
%typemap(m3rawintype) FILE "Cstdio.FILE";
%typemap(m3rawintype) FILE * "Cstdio.FILE_star";
%typemap(m3rawinmode) char *, void *, FILE * ""
%typemap(m3rawrettype) bool, const bool & "BOOLEAN"
%typemap(m3rawrettype) char, const char & "C.char"
%typemap(m3rawrettype) signed char, const signed char & "C.signed_char"
%typemap(m3rawrettype) unsigned char, const unsigned char & "C.unsigned_char"
%typemap(m3rawrettype) short, const short & "C.short"
%typemap(m3rawrettype) unsigned short, const unsigned short & "C.unsigned_short"
%typemap(m3rawrettype) int, const int & "C.int"
%typemap(m3rawrettype) unsigned int, const unsigned int & "C.unsigned_int"
%typemap(m3rawrettype) long, const long & "C.long"
%typemap(m3rawrettype) unsigned long, const unsigned long & "C.unsigned_long"
%typemap(m3rawrettype) long long, const long long & "C.long_long"
%typemap(m3rawrettype) unsigned long long, const unsigned long long & "C.unsigned_long_long"
%typemap(m3rawrettype) float, const float & "C.float"
%typemap(m3rawrettype) double, const double & "C.double"
%typemap(m3rawrettype) long double, const long double & "C.long_double"
%typemap(m3rawrettype) char * "C.char_star"
%typemap(m3rawrettype) void ""
%typemap(m3rawrettype) void * "ADDRESS"
%typemap(m3rawrettype) FILE "Cstdio.FILE";
%typemap(m3rawrettype) FILE * "Cstdio.FILE_star";
%typemap("m3rawtype:import")
char, const char &,
signed char, const signed char &,
unsigned char, const unsigned char &,
short, const short &,
unsigned short, const unsigned short &,
int, const int &,
unsigned int, const unsigned int &,
long, const long &,
unsigned long, const unsigned long &,
long long, const long long &,
unsigned long long, const unsigned long long &,
float, const float &,
double, const double &,
long double, const long double &,
char *
"Ctypes AS C"
%typemap("m3rawintype:import")
char, const char &,
signed char, const signed char &,
unsigned char, const unsigned char &,
short, const short &,
unsigned short, const unsigned short &,
int, const int &,
unsigned int, const unsigned int &,
long, const long &,
unsigned long, const unsigned long &,
long long, const long long &,
unsigned long long, const unsigned long long &,
float, const float &,
double, const double &,
long double, const long double &,
char *
"Ctypes AS C"
%typemap("m3rawrettype:import")
char, const char &,
signed char, const signed char &,
unsigned char, const unsigned char &,
short, const short &,
unsigned short, const unsigned short &,
int, const int &,
unsigned int, const unsigned int &,
long, const long &,
unsigned long, const unsigned long &,
long long, const long long &,
unsigned long long, const unsigned long long &,
float, const float &,
double, const double &,
long double, const long double &,
char *
"Ctypes AS C"
%typemap("m3rawtype:import")
FILE, FILE *
"Cstdio";
%typemap("m3rawintype:import")
FILE, FILE *
"Cstdio";
%typemap("m3rawrettype:import")
FILE, FILE *
"Cstdio";
%typemap(m3wraptype) bool, const bool & "BOOLEAN"
%typemap(m3wraptype) char, const char & "CHAR"
%typemap(m3wraptype) signed char, const signed char & "CHAR"
%typemap(m3wraptype) unsigned char, const unsigned char & "CHAR"
%typemap(m3wraptype) short, const short & "Integer16.T"
%typemap(m3wraptype) unsigned short, const unsigned short & "Cardinal16.T"
%typemap(m3wraptype) int, const int & "INTEGER"
%typemap(m3wraptype) unsigned int, const unsigned int & "CARDINAL"
%typemap(m3wraptype) long, const long & "Integer32.T"
%typemap(m3wraptype) unsigned long, const unsigned long & "Cardinal32.T"
%typemap(m3wraptype) long long, const long long & "Integer64.T"
%typemap(m3wraptype) unsigned long long, const unsigned long long & "Cardinal64.T"
%typemap(m3wraptype) float, const float & "REAL"
%typemap(m3wraptype) double, const double & "LONGREAL"
%typemap(m3wraptype) long double, const long double & "EXTENDED"
%typemap(m3wraptype) char * "TEXT"
%typemap(m3wraptype) void ""
%typemap(m3wraptype) FILE "Cstdio.FILE";
%typemap(m3wraptype) FILE * "Cstdio.FILE_star";
%typemap(m3wrapintype) bool, const bool *, const bool & "BOOLEAN"
%typemap(m3wrapintype) char, const char *, const char & "CHAR"
%typemap(m3wrapintype) signed char, const signed char *, const signed char & "CHAR"
%typemap(m3wrapintype) unsigned char, const unsigned char *, const unsigned char & "CHAR"
%typemap(m3wrapintype) short, const short *, const short & "INTEGER"
%typemap(m3wrapintype) unsigned short, const unsigned short *, const unsigned short & "CARDINAL"
%typemap(m3wrapintype) int, const int *, const int & "INTEGER"
%typemap(m3wrapintype) unsigned int, const unsigned int *, const unsigned int & "CARDINAL"
%typemap(m3wrapintype) long, const long *, const long & "INTEGER"
%typemap(m3wrapintype) unsigned long, const unsigned long *, const unsigned long & "CARDINAL"
%typemap(m3wrapintype) long long, const long long *, const long long & "INTEGER"
%typemap(m3wrapintype) unsigned long long, const unsigned long long *, const unsigned long long & "CARDINAL"
%typemap(m3wrapintype) float, const float *, const float & "REAL"
%typemap(m3wrapintype) double, const double *, const double & "LONGREAL"
%typemap(m3wrapintype) long double, const long double *, const long double & "EXTENDED"
%typemap(m3wrapintype) const char *, const char [] "TEXT"
%typemap(m3wrapintype,numinputs=0) void ""
%typemap(m3wrapintype) FILE "Cstdio.FILE";
%typemap(m3wrapintype) FILE * "Cstdio.FILE_star";
%typemap(m3wrapouttype) bool, bool *, bool & "BOOLEAN"
%typemap(m3wrapouttype) char, char *, char & "CHAR"
%typemap(m3wrapouttype) signed char, signed char *, signed char & "CHAR"
%typemap(m3wrapouttype) unsigned char, unsigned char *, unsigned char & "CHAR"
%typemap(m3wrapouttype) short, short *, short & "INTEGER"
%typemap(m3wrapouttype) unsigned short, unsigned short *, unsigned short & "CARDINAL"
%typemap(m3wrapouttype) int, int *, int & "INTEGER"
%typemap(m3wrapouttype) unsigned int, unsigned int *, unsigned int & "CARDINAL"
%typemap(m3wrapouttype) long, long *, long & "INTEGER"
%typemap(m3wrapouttype) unsigned long, unsigned long *, unsigned long & "CARDINAL"
%typemap(m3wrapouttype) long long, long long *, long long & "INTEGER"
%typemap(m3wrapouttype) unsigned long long, unsigned long long *, unsigned long long & "CARDINAL"
%typemap(m3wrapouttype) float, float *, float & "REAL"
%typemap(m3wrapouttype) double, double *, double & "LONGREAL"
%typemap(m3wrapouttype) long double, long double *, long double & "EXTENDED"
%typemap(m3wrapouttype) char *, char [] "TEXT"
%typemap(m3wrapouttype,numinputs=0) void ""
%typemap(m3wraprettype) bool, const bool & "BOOLEAN"
%typemap(m3wraprettype) char, const char & "CHAR"
%typemap(m3wraprettype) signed char, const signed char & "CHAR"
%typemap(m3wraprettype) unsigned char, const unsigned char & "CHAR"
%typemap(m3wraprettype) short, const short & "INTEGER"
%typemap(m3wraprettype) unsigned short, const unsigned short & "CARDINAL"
%typemap(m3wraprettype) int, const int & "INTEGER"
%typemap(m3wraprettype) unsigned int, const unsigned int & "CARDINAL"
%typemap(m3wraprettype) long, const long & "INTEGER"
%typemap(m3wraprettype) unsigned long, const unsigned long & "CARDINAL"
%typemap(m3wraprettype) long long, const long long & "INTEGER"
%typemap(m3wraprettype) unsigned long long, const unsigned long long & "CARDINAL"
%typemap(m3wraprettype) float, const float & "REAL"
%typemap(m3wraprettype) double, const double & "LONGREAL"
%typemap(m3wraprettype) long double, const long double & "EXTENDED"
%typemap(m3wraprettype) char * "TEXT"
%typemap(m3wraprettype) void ""
%typemap(m3wraprettype) FILE "Cstdio.FILE";
%typemap(m3wraprettype) FILE * "Cstdio.FILE_star";
%typemap(ctype) char[ANY] "char *"
%typemap(m3rawtype) char[ANY] "C.char_star"
%typemap(m3rawintype) char[ANY] "C.char_star"
%typemap(m3rawrettype) char[ANY] "C.char_star"
%typemap(m3wraptype) char[ANY] "TEXT"
%typemap(m3wrapintype) char[ANY] "TEXT"
%typemap(m3wrapouttype) char[ANY] "TEXT"
%typemap(m3wraprettype) char[ANY] "TEXT"
%typemap(m3wrapinmode) const char * %{%}
%typemap(m3wrapargvar) const char * %{$1 : C.char_star;%}
%typemap(m3wrapinconv) const char * %{$1 := M3toC.SharedTtoS($1_name);%}
%typemap(m3wrapfreearg) const char * %{M3toC.FreeSharedS($1_name,$1);%}
%typemap(m3wrapargraw) const char * %{$1%}
%typemap("m3wrapargvar:import") const char * "Ctypes AS C"
%typemap("m3wrapinconv:import") const char * "M3toC"
%typemap("m3wrapfreearg:import") const char * "M3toC"
%typemap(m3wrapretvar) char * %{result : C.char_star;%}
%typemap(m3wrapretraw) char * %{result%}
%typemap(m3wrapretconv) char * %{M3toC.CopyStoT(result)%}
%typemap("m3wrapretvar:import") char * "Ctypes AS C"
%typemap("m3wrapretconv:import") char * "M3toC"
%typemap(m3wrapinmode) FILE * %{%}
%typemap("m3wraptype:import")
FILE, FILE *
"Cstdio";
%typemap("m3wrapintype:import")
FILE, FILE *
"Cstdio";
%typemap("m3wraprettype:import")
FILE, FILE *
"Cstdio";
/* Composed types */
%typemap(ctype) SWIGTYPE "$1_type"
%typemap(m3rawtype) SWIGTYPE "$1_basetype"
%typemap(m3rawrettype) SWIGTYPE "UNTRACED REF $1_basetype"
%typemap(m3wraptype) SWIGTYPE "$1_basetype"
%typemap(m3wrapintype) SWIGTYPE "$1_basetype"
%typemap(m3wrapouttype) SWIGTYPE "$1_basetype"
%typemap(m3wraprettype) SWIGTYPE "$1_basetype"
%typemap(ctype) SWIGTYPE [] "$1_type"
%typemap(m3rawtype) const SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
%typemap(m3rawtype) SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
%typemap(m3rawintype) const SWIGTYPE [] "(*ARRAY OF*) $1_basetype"
%typemap(m3rawinmode) const SWIGTYPE [] "READONLY"
%typemap(m3rawintype) SWIGTYPE [] "(*ARRAY OF*) $1_basetype"
%typemap(m3rawinmode) SWIGTYPE [] "VAR"
%typemap(m3rawrettype) const SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
%typemap(m3rawrettype) SWIGTYPE [] "UNTRACED REF ARRAY INTEGER OF $1_basetype"
%typemap(m3wraptype) SWIGTYPE [] "$1_basetype"
%typemap(m3wrapintype) const SWIGTYPE [] "ARRAY OF $1_basetype"
%typemap(m3wrapinmode) const SWIGTYPE [] "READONLY"
%typemap(m3wrapintype) SWIGTYPE [] "ARRAY OF $1_basetype"
%typemap(m3wrapinmode) SWIGTYPE [] "VAR"
%typemap(m3wrapouttype) SWIGTYPE [] "ARRAY OF $1_basetype"
%typemap(m3wraprettype) SWIGTYPE [] "REF ARRAY OF $1_basetype"
%typemap(ctype) SWIGTYPE * "$1_type"
%typemap(m3rawtype) const SWIGTYPE * "UNTRACED REF $1_basetype"
%typemap(m3rawtype) SWIGTYPE * "UNTRACED REF $1_basetype"
%typemap(m3rawintype) const SWIGTYPE * "$1_basetype"
%typemap(m3rawinmode) const SWIGTYPE * "READONLY"
%typemap(m3rawintype) SWIGTYPE * "$1_basetype"
%typemap(m3rawinmode) SWIGTYPE * "VAR"
%typemap(m3rawrettype) const SWIGTYPE * "UNTRACED REF $1_basetype"
%typemap(m3rawrettype) SWIGTYPE * "UNTRACED REF $1_basetype"
%typemap(m3wraptype) SWIGTYPE * "$1_basetype"
%typemap(m3wrapintype) const SWIGTYPE * "$1_basetype"
%typemap(m3wrapinmode) const SWIGTYPE * "READONLY"
%typemap(m3wrapintype) SWIGTYPE * "$1_basetype"
%typemap(m3wrapinmode) SWIGTYPE * "VAR"
%typemap(m3wrapouttype) SWIGTYPE * "$1_basetype"
%typemap(m3wraprettype) SWIGTYPE * "UNTRACED REF $1_basetype"
%typemap(ctype) SWIGTYPE & "$1_type"
%typemap(m3rawtype) const SWIGTYPE & "UNTRACED REF $1_basetype"
%typemap(m3rawtype) SWIGTYPE & "UNTRACED REF $1_basetype"
%typemap(m3rawintype) const SWIGTYPE & "$1_basetype"
%typemap(m3rawinmode) const SWIGTYPE & "READONLY"
%typemap(m3rawintype) SWIGTYPE & "$1_basetype"
%typemap(m3rawinmode) SWIGTYPE & "VAR"
%typemap(m3rawrettype) const SWIGTYPE & "UNTRACED REF $1_basetype"
%typemap(m3rawrettype) SWIGTYPE & "UNTRACED REF $1_basetype"
%typemap(m3wraptype) SWIGTYPE & "$1_basetype"
%typemap(m3wrapintype) const SWIGTYPE & "$1_basetype"
%typemap(m3wrapinmode) const SWIGTYPE & "READONLY"
%typemap(m3wrapintype) SWIGTYPE & "$1_basetype"
%typemap(m3wrapinmode) SWIGTYPE & "VAR"
%typemap(m3wrapouttype) SWIGTYPE & "$1_basetype"
%typemap(m3wraprettype) SWIGTYPE & "UNTRACED REF $1_basetype"
%typemap(ctype) SWIGTYPE && "$1_type"
%typemap(m3rawtype) const SWIGTYPE && "UNTRACED REF $1_basetype"
%typemap(m3rawtype) SWIGTYPE && "UNTRACED REF $1_basetype"
%typemap(m3rawintype) const SWIGTYPE && "$1_basetype"
%typemap(m3rawinmode) const SWIGTYPE && "READONLY"
%typemap(m3rawintype) SWIGTYPE && "$1_basetype"
%typemap(m3rawinmode) SWIGTYPE && "VAR"
%typemap(m3rawrettype) const SWIGTYPE && "UNTRACED REF $1_basetype"
%typemap(m3rawrettype) SWIGTYPE && "UNTRACED REF $1_basetype"
%typemap(m3wraptype) SWIGTYPE && "$1_basetype"
%typemap(m3wrapintype) const SWIGTYPE && "$1_basetype"
%typemap(m3wrapinmode) const SWIGTYPE && "READONLY"
%typemap(m3wrapintype) SWIGTYPE && "$1_basetype"
%typemap(m3wrapinmode) SWIGTYPE && "VAR"
%typemap(m3wrapouttype) SWIGTYPE && "$1_basetype"
%typemap(m3wraprettype) SWIGTYPE && "UNTRACED REF $1_basetype"
%typemap(ctype) enum SWIGTYPE "$1_type"
%typemap(m3rawtype) enum SWIGTYPE "C.int"
%typemap(m3rawintype) enum SWIGTYPE "C.int (* $1_type *)"
%typemap(m3rawrettype) enum SWIGTYPE "C.int"
%typemap(m3wraptype) enum SWIGTYPE "$*1_type"
%typemap(m3wrapintype) enum SWIGTYPE "$1_type"
%typemap(m3wrapouttype) enum SWIGTYPE "$1_type"
%typemap(m3wraprettype) enum SWIGTYPE "$*1_type"
/* pointer to a class member */
%typemap(ctype) SWIGTYPE (CLASS::*) "$1_type"
%typemap(m3rawtype) SWIGTYPE (CLASS::*) "REFANY"
%typemap(m3wraptype) SWIGTYPE (CLASS::*) "$1_basetype"
/* The following are the in, out, freearg, argout typemaps.
These are the PInvoke code generating typemaps for converting from C# to C and visa versa. */
/* primitive types */
%typemap(in) bool
%{ $1 = $input ? true : false; %}
%typemap(in) char,
signed char,
unsigned char,
short,
unsigned short,
int,
unsigned int,
long,
unsigned long,
long long,
unsigned long long,
float,
double,
enum SWIGTYPE
%{ $1 = ($1_ltype)$input; %}
%typemap(out) bool %{ $result = $1; %}
%typemap(out) char %{ $result = $1; %}
%typemap(out) signed char %{ $result = $1; %}
%typemap(out) unsigned char %{ $result = $1; %}
%typemap(out) short %{ $result = $1; %}
%typemap(out) unsigned short %{ $result = $1; %}
%typemap(out) int %{ $result = $1; %}
%typemap(out) unsigned int %{ $result = $1; %}
%typemap(out) long %{ $result = $1; %}
%typemap(out) unsigned long %{ $result = $1; %}
%typemap(out) long long %{ $result = $1; %}
%typemap(out) unsigned long long %{ $result = $1; %}
%typemap(out) float %{ $result = $1; %}
%typemap(out) double %{ $result = $1; %}
%typemap(out) enum SWIGTYPE %{ $result = $1; %}
/* char * - treat as String */
%typemap(in) char * {
$1 = $input;
}
//%typemap(freearg) char * { if ($1) JCALL2(ReleaseStringUTFChars, jenv, $input, $1); }
//%typemap(out) char * { if($1) $result = JCALL1(NewStringUTF, jenv, $1); }
%typemap(out) void ""
/* primitive types by const reference */
%typemap(in) const bool & (bool temp)
%{ temp = $input ? true : false;
$1 = &temp; %}
%typemap(in) const char & (char temp),
const signed char & (signed char temp),
const unsigned char & (unsigned char temp),
const short & (short temp),
const unsigned short & (unsigned short temp),
const int & (int temp),
const unsigned int & (unsigned int temp),
const long & (long temp),
const unsigned long & (unsigned long temp),
const long long & ($*1_ltype temp),
const unsigned long long & ($*1_ltype temp),
const float & (float temp),
const double & (double temp)
%{ temp = ($*1_ltype)$input;
$1 = &temp; %}
%typemap(out) const bool & %{ $result = *$1; %}
%typemap(out) const char & %{ $result = *$1; %}
%typemap(out) const signed char & %{ $result = *$1; %}
%typemap(out) const unsigned char & %{ $result = *$1; %}
%typemap(out) const short & %{ $result = *$1; %}
%typemap(out) const unsigned short & %{ $result = *$1; %}
%typemap(out) const int & %{ $result = *$1; %}
%typemap(out) const unsigned int & %{ $result = *$1; %}
%typemap(out) const long & %{ $result = *$1; %}
%typemap(out) const unsigned long & %{ $result = *$1; %}
%typemap(out) const long long & %{ $result = *$1; %}
%typemap(out) const unsigned long long & %{ $result = *$1; %}
%typemap(out) const float & %{ $result = *$1; %}
%typemap(out) const double & %{ $result = *$1; %}
/* Default handling. Object passed by value. Convert to a pointer */
%typemap(in) SWIGTYPE ($&1_type argp)
%{ argp = *($&1_ltype*)&$input;
if (!argp) {
// SWIG_JavaThrowException(jenv, SWIG_JavaNullPointerException, "Attempt to dereference null $1_type");
RETURN $null;
}
$1 = *argp; %}
%typemap(out) SWIGTYPE
#ifdef __cplusplus
%{*($&1_ltype*)&$result = new $1_ltype((const $1_ltype &)$1); %}
#else
{
$&1_ltype $1ptr = ($&1_ltype) malloc(sizeof($1_ltype));
memmove($1ptr, &$1, sizeof($1_type));
*($&1_ltype*)&$result = $1ptr;
}
#endif
/* Generic pointers and references */
%typemap(in) SWIGTYPE *, SWIGTYPE (CLASS::*) %{ $1 = *($&1_ltype)&$input; %}
%typemap(in) SWIGTYPE & %{ $1 = *($&1_ltype)&$input;
if(!$1) {
//SWIG_JavaThrowException(jenv, SWIG_JavaNullPointerException, "$1_type reference is null");
RETURN $null;
} %}
%typemap(in) SWIGTYPE && %{ $1 = *($&1_ltype)&$input;
if(!$1) {
//SWIG_JavaThrowException(jenv, SWIG_JavaNullPointerException, "$1_type reference is null");
RETURN $null;
} %}
%typemap(out) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE (CLASS::*) %{ *($&1_ltype)&$result = $1; %}
/* Default array handling */
%typemap(in) SWIGTYPE [] %{ $1 = *($&1_ltype)&$input; %}
%typemap(out) SWIGTYPE [] %{ *($&1_ltype)&$result = $1; %}
/* char[ANY] - treat as String */
%typemap(in) char[ANY] {
$1 = $input;
}
%typemap(argout) char[ANY] ""
%typemap(freearg) char[ANY] ""//{ if ($1) JCALL2(ReleaseStringUTFChars, jenv, $input, $1); }
%typemap(out) char[ANY] { if($1) $result = $1; }
/* Typecheck typemaps - The purpose of these is merely to issue a warning for overloaded C++ functions
* that cannot be overloaded in C# as more than one C++ type maps to a single C# type */
%typecheck(SWIG_TYPECHECK_BOOL) /* Java boolean */
bool,
const bool &
""
%typecheck(SWIG_TYPECHECK_CHAR) /* Java char */
char,
const char &
""
%typecheck(SWIG_TYPECHECK_INT8) /* Java byte */
signed char,
const signed char &
""
%typecheck(SWIG_TYPECHECK_INT16) /* Java short */
unsigned char,
short,
const unsigned char &,
const short &
""
%typecheck(SWIG_TYPECHECK_INT32) /* Java int */
unsigned short,
int,
long,
const unsigned short &,
const int &,
const long &,
enum SWIGTYPE
""
%typecheck(SWIG_TYPECHECK_INT64) /* Java long */
unsigned int,
unsigned long,
long long,
const unsigned int &,
const unsigned long &,
const long long &
""
%typecheck(SWIG_TYPECHECK_INT128) /* Java BigInteger */
unsigned long long
""
%typecheck(SWIG_TYPECHECK_FLOAT) /* Java float */
float,
const float &
""
%typecheck(SWIG_TYPECHECK_DOUBLE) /* Java double */
double,
const double &
""
%typecheck(SWIG_TYPECHECK_STRING) /* Java String */
char *,
char[ANY]
""
%typecheck(SWIG_TYPECHECK_POINTER) /* Default */
SWIGTYPE,
SWIGTYPE *,
SWIGTYPE &,
SWIGTYPE &&,
SWIGTYPE [],
SWIGTYPE (CLASS::*)
""
/* Exception handling */
%typemap(throws) int,
long,
short,
unsigned int,
unsigned long,
unsigned short {
char error_msg[256];
sprintf(error_msg, "C++ $1_type exception thrown, value: %d", $1);
SWIG_JavaThrowException(jenv, SWIG_JavaRuntimeException, error_msg);
RETURN $null;
}
%typemap(throws) SWIGTYPE {
(void)$1;
SWIG_JavaThrowException(jenv, SWIG_JavaRuntimeException, "C++ $1_type exception thrown");
RETURN $null;
}
%typemap(throws) char * {
SWIG_JavaThrowException(jenv, SWIG_JavaRuntimeException, $1);
RETURN $null;
}
/* Typemaps for code generation in proxy classes and C# type wrapper classes */
/* The in typemap is used for converting function parameter types from the type
* used in the proxy, module or type wrapper class to the type used in the PInvoke class. */
%typemap(m3in) bool, const bool &,
char, const char &,
signed char, const signed char &,
unsigned char, const unsigned char &,
short, const short &,
unsigned short, const unsigned short &,
int, const int &,
unsigned int, const unsigned int &,
long, const long &,
unsigned long, const unsigned long &,
long long, const long long &,
unsigned long long, const unsigned long long &,
float, const float &,
double, const double &,
char *,
char[ANY],
enum SWIGTYPE
"$input"
%typemap(m3in) SWIGTYPE "$&*1_type.getCPtr($input)"
%typemap(m3in) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "$1_basetype.getCPtr($input)"
/* The m3out typemap is used for converting function return types from the return type
* used in the PInvoke class to the type returned by the proxy, module or type wrapper class. */
%typemap(m3out) bool, const bool &,
char, const char &,
signed char, const signed char &,
unsigned char, const unsigned char &,
short, const short &,
unsigned short, const unsigned short &,
int, const int &,
unsigned int, const unsigned int &,
long, const long &,
unsigned long, const unsigned long &,
long long, const long long &,
unsigned long long, const unsigned long long &,
float, const float &,
double, const double &,
char *,
char[ANY],
enum SWIGTYPE
%{$imcall%}
%typemap(m3out) void %{$imcall%}
%typemap(m3out) SWIGTYPE %{
RETURN NEW(REF $1_basetype, $imcall);
%}
%typemap(m3out) SWIGTYPE & %{
RETURN NEW($1_basetype, $imcall, $owner);
%}
%typemap(m3out) SWIGTYPE && %{
RETURN NEW($1_basetype, $imcall, $owner);
%}
%typemap(m3out) SWIGTYPE *, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
cPtr := $imcall;
RETURN (cPtr = IntPtr.Zero) ? null : NEW($1_basetype, cPtr, $owner);
%}
/* Properties */
%typemap(m3varin) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
PROCEDURE Set$var (value: $vartype) =
BEGIN
$imcall;
END Set$var;
%}
%typemap(m3varout) bool, const bool &,
char, const char &,
signed char, const signed char &,
unsigned char, const unsigned char &,
short, const short &,
unsigned short, const unsigned short &,
int, const int &,
unsigned int, const unsigned int &,
long, const long &,
unsigned long, const unsigned long &,
long long, const long long &,
unsigned long long, const unsigned long long &,
float, const float &,
double, const double &,
char *,
char[ANY],
enum SWIGTYPE %{
PROCEDURE Get$var (): $vartype =
BEGIN
RETURN $imcall;
END Get$var;
%}
%typemap(m3varout) void %{
get {
$imcall;
} %}
%typemap(m3varout) SWIGTYPE %{
get {
RETURN new $&*1_mangle($imcall, true);
} %}
%typemap(m3varout) SWIGTYPE & %{
get {
RETURN new $1_basetype($imcall, $owner);
} %}
%typemap(m3varout) SWIGTYPE && %{
get {
RETURN new $1_basetype($imcall, $owner);
} %}
%typemap(m3varout) SWIGTYPE *, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
get {
IntPtr cPtr = $imcall;
RETURN (cPtr == IntPtr.Zero) ? null : new $1_basetype(cPtr, $owner);
} %}
/* Typemaps used for the generation of proxy and type wrapper class code */
%typemap(m3base) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) ""
%typemap(m3classmodifiers) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "public"
%typemap(m3code) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) ""
%typemap(m3imports) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "using System;"
%typemap(m3interfaces) SWIGTYPE "IDisposable"
%typemap(m3interfaces_derived) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) ""
%typemap(m3ptrconstructormodifiers) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) "internal"
%typemap(m3finalize) SWIGTYPE %{
~$1_basetype() {
Dispose();
}
%}
%typemap(m3destruct, methodname="Dispose") SWIGTYPE {
if(swigCPtr != IntPtr.Zero && swigCMemOwn) {
$imcall;
swigCMemOwn = false;
}
swigCPtr = IntPtr.Zero;
GC.SuppressFinalize(this);
}
%typemap(m3destruct_derived, methodname="Dispose") SWIGTYPE {
if(swigCPtr != IntPtr.Zero && swigCMemOwn) {
$imcall;
swigCMemOwn = false;
}
swigCPtr = IntPtr.Zero;
GC.SuppressFinalize(this);
base.Dispose();
}
%typemap(m3getcptr) SWIGTYPE, SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [], SWIGTYPE (CLASS::*) %{
internal static IntPtr getCPtr($1_basetype obj) {
RETURN (obj == null) ? IntPtr.Zero : obj.swigCPtr;
}
%}
/* M3 specific directives */
#define %m3multiretval %feature("modula3:multiretval")
#define %constnumeric(num) %feature("constnumeric","num")
%pragma(modula3) moduleimports=%{
IMPORT BlaBla;
%}
%pragma(modula3) imclassimports=%{
FROM BlaBla IMPORT Bla;
%}
/* Some ANSI C typemaps */
%apply unsigned long { size_t };
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }

View file

@ -1,64 +0,0 @@
/* -----------------------------------------------------------------------------
* modula3head.swg
*
* Modula3 support code
* ----------------------------------------------------------------------------- */
%insert(runtime) %{
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
%}
#if 0
%insert(runtime) %{
/* Support for throwing Modula3 exceptions */
typedef enum {
SWIG_JavaOutOfMemoryError = 1,
SWIG_JavaIOException,
SWIG_JavaRuntimeException,
SWIG_JavaIndexOutOfBoundsException,
SWIG_JavaArithmeticException,
SWIG_JavaIllegalArgumentException,
SWIG_JavaNullPointerException,
SWIG_JavaUnknownError
} SWIG_JavaExceptionCodes;
typedef struct {
SWIG_JavaExceptionCodes code;
const char *java_exception;
} SWIG_JavaExceptions_t;
#if defined(SWIG_NOINCLUDE)
void SWIG_JavaThrowException(JNIEnv *jenv, SWIG_JavaExceptionCodes code, const char *msg);
#else
%}
%insert(runtime) {
void SWIG_JavaThrowException(JNIEnv *jenv, SWIG_JavaExceptionCodes code, const char *msg) {
jclass excep;
static const SWIG_JavaExceptions_t java_exceptions[] = {
{ SWIG_JavaOutOfMemoryError, "java/lang/OutOfMemoryError" },
{ SWIG_JavaIOException, "java/io/IOException" },
{ SWIG_JavaRuntimeException, "java/lang/RuntimeException" },
{ SWIG_JavaIndexOutOfBoundsException, "java/lang/IndexOutOfBoundsException" },
{ SWIG_JavaArithmeticException, "java/lang/ArithmeticException" },
{ SWIG_JavaIllegalArgumentException, "java/lang/IllegalArgumentException" },
{ SWIG_JavaNullPointerException, "java/lang/NullPointerException" },
{ SWIG_JavaUnknownError, "java/lang/UnknownError" },
{ (SWIG_JavaExceptionCodes)0, "java/lang/UnknownError" } };
const SWIG_JavaExceptions_t *except_ptr = java_exceptions;
while (except_ptr->code != code && except_ptr->code)
except_ptr++;
JCALL0(ExceptionClear, jenv);
excep = JCALL1(FindClass, jenv, except_ptr->java_exception);
if (excep)
JCALL2(ThrowNew, jenv, excep, msg);
}
}
%insert(runtime) %{
#endif
%}
#endif

View file

@ -1,74 +0,0 @@
/* -----------------------------------------------------------------------------
* typemaps.i
*
* Pointer and reference handling typemap library
*
* These mappings provide support for input/output arguments and common
* uses for C/C++ pointers and C++ references.
* ----------------------------------------------------------------------------- */
/* These typemaps will eventually probably maybe make their way into named typemaps
* OUTPUT * and OUTPUT & as they currently break functions that return a pointer or
* reference. */
%typemap(ctype) bool *, bool & "bool *"
%typemap(ctype) char & "char *"
%typemap(ctype) signed char *, signed char & "signed char *"
%typemap(ctype) unsigned char *, unsigned char & "unsigned short *"
%typemap(ctype) short *, short & "short *"
%typemap(ctype) unsigned short *, unsigned short & "unsigned short *"
%typemap(ctype) int *, int & "int *"
%typemap(ctype) unsigned int *, unsigned int & "unsigned int *"
%typemap(ctype) long *, long & "long *"
%typemap(ctype) unsigned long *, unsigned long & "unsigned long *"
%typemap(ctype) long long *, long long & "long long *"
%typemap(ctype) unsigned long long *, unsigned long long & "unsigned long long *"
%typemap(ctype) float *, float & "float *"
%typemap(ctype) double *, double & "double *"
%typemap(imtype) bool *, bool & "ref bool"
%typemap(imtype) char & "ref char"
%typemap(imtype) signed char *, signed char & "ref sbyte"
%typemap(imtype) unsigned char *, unsigned char & "ref byte"
%typemap(imtype) short *, short & "ref short"
%typemap(imtype) unsigned short *, unsigned short & "ref ushort"
%typemap(imtype) int *, int & "ref int"
%typemap(imtype) unsigned int *, unsigned int & "ref uint"
%typemap(imtype) long *, long & "ref int"
%typemap(imtype) unsigned long *, unsigned long & "ref uint"
%typemap(imtype) long long *, long long & "ref long"
%typemap(imtype) unsigned long long *, unsigned long long & "ref ulong"
%typemap(imtype) float *, float & "ref float"
%typemap(imtype) double *, double & "ref double"
%typemap(cstype) bool *, bool & "ref bool"
%typemap(cstype) char & "ref char"
%typemap(cstype) signed char *, signed char & "ref sbyte"
%typemap(cstype) unsigned char *, unsigned char & "ref byte"
%typemap(cstype) short *, short & "ref short"
%typemap(cstype) unsigned short *, unsigned short & "ref ushort"
%typemap(cstype) int *, int & "ref int"
%typemap(cstype) unsigned int *, unsigned int & "ref uint"
%typemap(cstype) long *, long & "ref int"
%typemap(cstype) unsigned long *, unsigned long & "ref uint"
%typemap(cstype) long long *, long long & "ref long"
%typemap(cstype) unsigned long long *, unsigned long long & "ref ulong"
%typemap(cstype) float *, float & "ref float"
%typemap(cstype) double *, double & "ref double"
%typemap(csin) bool *, bool &,
char &,
signed char *, signed char &,
unsigned char *, unsigned char &,
short *, short &,
unsigned short *, unsigned short &,
int *, int &,
unsigned int *, unsigned int &,
long *, long &,
unsigned long *, unsigned long &,
long long *, long long &,
unsigned long long *, unsigned long long &,
float *, float &,
double *, double &
"ref $csinput"

View file

@ -1,326 +0,0 @@
/* -----------------------------------------------------------------------------
* pike.swg
*
* Pike configuration module.
* ----------------------------------------------------------------------------- */
%insert(runtime) "swigrun.swg"; // Common C API type-checking code
%insert(runtime) "pikerun.swg"; // Pike run-time code
%insert(runtime) %{
#ifdef __cplusplus
extern "C" {
#endif
#include <pike/global.h>
#include <pike/module.h>
#include <pike/interpret.h>
#ifdef __cplusplus
}
#endif
%}
/* -----------------------------------------------------------------------------
* standard typemaps
* ----------------------------------------------------------------------------- */
/* --- Input arguments --- */
/* Primitive datatypes. */
%typemap(in, pikedesc="tInt")
int, unsigned int, short, unsigned short,
long, unsigned long, char, signed char, unsigned char,
bool, enum SWIGTYPE, long long, unsigned long long
{
if ($input.type != T_INT)
Pike_error("Bad argument: Expected an integer.\n");
$1 = ($1_ltype) $input.u.integer;
}
%typemap(in, pikedesc="tFloat") float, double {
if ($input.type != T_FLOAT)
Pike_error("Bad argument: Expected a float.\n");
$1 = ($1_ltype) $input.u.float_number;
}
%typemap(in, pikedesc="tStr") char *, char [ANY] {
if ($input.type != T_STRING)
Pike_error("Bad argument: Expected a string.\n");
$1 = ($1_ltype) STR0($input.u.string);
}
/* Pointers, references and arrays */
%typemap(in) SWIGTYPE *,
SWIGTYPE &,
SWIGTYPE &&,
SWIGTYPE []
"SWIG_ConvertPtr($input.u.object, (void **) &$1, $1_descriptor, 1);"
/* Void pointer. Accepts any kind of pointer */
%typemap(in) void * "/* FIXME */";
/* Object passed by value. Convert to a pointer */
%typemap(in) SWIGTYPE ($&1_ltype argp) "/* FIXME */";
/* Pointer to a class member */
%typemap(in) SWIGTYPE (CLASS::*) "/* FIXME */";
/* Const primitive references. Passed by value */
%typemap(in, pikedesc="tInt") const int & (int temp),
const short & (short temp),
const long & (long temp),
const unsigned int & (unsigned int temp),
const unsigned short & (unsigned short temp),
const unsigned long & (unsigned long temp),
const char & (char temp),
const signed char & (signed char temp),
const unsigned char & (unsigned char temp),
const bool & (bool temp),
const long long & ($*1_ltype temp),
const unsigned long long & ($*1_ltype temp),
const enum SWIGTYPE & ($*1_ltype temp),
const enum SWIGTYPE && ($*1_ltype temp)
{
if ($input.type != T_INT)
Pike_error("Bad argument: Expected an integer.\n");
temp = ($*1_ltype) $input.u.integer;
$1 = &temp;
}
%typemap(in, pikedesc="tFloat") const float & (float temp),
const double & (double temp)
{
if ($input.type != T_FLOAT)
Pike_error("Bad argument: Expected a float.\n");
temp = ($*1_ltype) $input.u.float_number;
$1 = &temp;
}
/* -----------------------------------------------------------------------------
* Output Typemaps
* ----------------------------------------------------------------------------- */
%typemap(out, pikedesc="tInt")
int, unsigned int,
short, unsigned short,
long, unsigned long,
char, signed char, unsigned char,
bool, enum SWIGTYPE
"push_int($1);";
%typemap(out, pikedesc="tInt") long long "push_int64($1);";
%typemap(out, pikedesc="tInt") unsigned long long "push_int64($1);";
%typemap(out, pikedesc="tFloat") float, double "push_float($1);";
%typemap(out, pikedesc="tStr") char * "push_text($1);";
/* Pointers, references, and arrays */
%typemap(out, pikedesc="tObj") SWIGTYPE*, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [] "push_object(SWIG_NewPointerObj((void *) $1, $1_descriptor, $owner));";
/* Void return value; don't push anything */
%typemap(out, pikedesc="tVoid") void "";
/* Dynamic casts */
%typemap(out) SWIGTYPE *DYNAMIC, SWIGTYPE &DYNAMIC "/* FIXME */";
/* Member pointer */
%typemap(out) SWIGTYPE (CLASS::*) "/* FIXME */";
/* Special typemap for character array return values */
%typemap(out, pikedesc="tStr") char [ANY], const char [ANY] "push_text($1);";
/* Primitive types--return by value */
%typemap(out, pikedesc="tObj") SWIGTYPE
#ifdef __cplusplus
{
$&1_ltype resultptr;
resultptr = new $1_ltype((const $1_ltype &) $1);
push_object(SWIG_NewPointerObj((void *) resultptr, $&1_descriptor, 1));
}
#else
{
$&1_ltype resultptr;
resultptr = ($&1_ltype) malloc(sizeof($1_type));
memmove(resultptr, &$1, sizeof($1_type));
push_object(SWIG_NewPointerObj((void *) resultptr, $&1_descriptor, 1));
}
#endif
/* References to primitive types. Return by value */
%typemap(out, pikedesc="tInt") const int &, const unsigned int &,
const short &, const unsigned short &,
const long &, const unsigned long &,
const char &, const signed char &, const unsigned char &,
const bool &,
const long long &, const unsigned long long &,
const enum SWIGTYPE & ($*1_ltype temp),
const enum SWIGTYPE && ($*1_ltype temp)
"push_int(*($1));";
%typemap(out, pikedesc="tFloat") const float &, const double & "push_float(*($1));";
/************************ Constant Typemaps *****************************/
%typemap(constant)
int, unsigned int,
short, unsigned short,
long, unsigned long,
signed char, unsigned char,
bool, enum SWIGTYPE,
long long, unsigned long long
"add_integer_constant(\"$symname\", $1, 0);";
%typemap(constant) char
"add_integer_constant(\"$symname\", '$1', 0);";
%typemap(constant) long long, unsigned long long
"add_integer_constant(\"$symname\", $1, 0);";
%typemap(constant) float, double
"add_float_constant(\"$symname\", $1, 0);";
%typemap(constant) char *
"add_string_constant(\"$symname\", \"$1\", 0);";
/* ------------------------------------------------------------
* String & length
* ------------------------------------------------------------ */
%typemap(in) (char *STRING, int LENGTH), (char *STRING, size_t LENGTH) {
if ($input.type != T_STRING)
Pike_error("Bad argument: Expected a string.\n");
$1 = ($1_ltype) STR0($input.u.string);
$2 = ($2_ltype) $input.u.string->length;
}
/* ------------------------------------------------------------
* ANSI C typemaps
* ------------------------------------------------------------ */
%typemap(in, pikedesc="tInt") size_t {
if ($input.type != T_INT)
Pike_error("Bad argument: Expected an integer.\n");
$1 = ($1_ltype) $input.u.integer;
}
%typemap(out) size_t = long;
/* ------------------------------------------------------------
* Typechecking rules
* ------------------------------------------------------------ */
%typecheck(SWIG_TYPECHECK_INTEGER)
int, short, long,
unsigned int, unsigned short, unsigned long,
signed char, unsigned char,
long long, unsigned long long,
const int &, const short &, const long &,
const unsigned int &, const unsigned short &, const unsigned long &,
const long long &, const unsigned long long &,
enum SWIGTYPE, enum SWIGTYPE &, SWIGTYPE &&,
bool, const bool &
{
$1 = ($input.type == T_INT) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_DOUBLE)
float, double,
const float &, const double &
{
$1 = (($input.type == T_FLOAT) || ($input.type == T_INT)) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_CHAR) char {
$1 = ($input.type == T_INT) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_STRING) char * {
$1 = ($input.type == T_STRING) ? 1 : 0;
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE *, SWIGTYPE &, SWIGTYPE &&, SWIGTYPE [] {
void *ptr;
if (SWIG_ConvertPtr($input.u.object, (void **) &ptr, $1_descriptor, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_POINTER) SWIGTYPE {
void *ptr;
if (SWIG_ConvertPtr($input.u.object, (void **) &ptr, $&1_descriptor, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
%typecheck(SWIG_TYPECHECK_VOIDPTR) void * {
void *ptr;
if (SWIG_ConvertPtr($input.u.object, (void **) &ptr, 0, 0) == -1) {
$1 = 0;
} else {
$1 = 1;
}
}
/* Array reference typemaps */
%apply SWIGTYPE & { SWIGTYPE ((&)[ANY]) }
%apply SWIGTYPE && { SWIGTYPE ((&&)[ANY]) }
/* const pointers */
%apply SWIGTYPE * { SWIGTYPE *const }
%apply SWIGTYPE (CLASS::*) { SWIGTYPE (CLASS::*const) }
%apply SWIGTYPE & { SWIGTYPE (CLASS::*const&) }
/* ------------------------------------------------------------
* Overloaded operator support
* ------------------------------------------------------------ */
#ifdef __cplusplus
%rename("`+") *::operator+;
%rename("`-") *::operator-;
%rename("`*") *::operator*;
%rename("`/") *::operator/;
%rename("`%") *::operator%;
%rename("`<<") *::operator<<;
%rename("`>>") *::operator>>;
%rename("`&") *::operator&;
%rename("`|") *::operator|;
%rename("`^") *::operator^;
%rename("`~") *::operator~;
%rename("`<") *::operator<;
%rename("`>") *::operator>;
%rename("`==") *::operator==;
/* Special cases */
%rename("`()") *::operator();
#endif
/* ------------------------------------------------------------
* The start of the Pike initialization function
* ------------------------------------------------------------ */
%init "swiginit.swg"
%init %{
#ifdef __cplusplus
extern "C"
#endif
PIKE_MODULE_EXIT {}
#ifdef __cplusplus
extern "C"
#endif
PIKE_MODULE_INIT
{
struct program *pr;
SWIG_InitializeModule(0);
%}
/* pike keywords */
%include <pikekw.swg>

View file

@ -1,55 +0,0 @@
#ifndef PIKE_PIKEKW_SWG_
#define PIKE_PIKEKW_SWG_
/* Warnings for Pike keywords */
#define PIKEKW(x) %namewarn("314: '" #x "' is a pike keyword") #x
/*
from
http://www.http://docs.linux.cz/pike/tutorial_C.html
*/
PIKEKW(array);
PIKEKW(break);
PIKEKW(case);
PIKEKW(catch);
PIKEKW(continue);
PIKEKW(default);
PIKEKW(do);
PIKEKW(else);
PIKEKW(float);
PIKEKW(for);
PIKEKW(foreach);
PIKEKW(function);
PIKEKW(gauge);
PIKEKW(if);
PIKEKW(inherit);
PIKEKW(inline);
PIKEKW(int);
PIKEKW(lambda);
PIKEKW(mapping);
PIKEKW(mixed);
PIKEKW(multiset);
PIKEKW(nomask);
PIKEKW(object);
PIKEKW(predef);
PIKEKW(private);
PIKEKW(program);
PIKEKW(protected);
PIKEKW(public);
PIKEKW(return);
PIKEKW(sscanf);
PIKEKW(static);
PIKEKW(string);
PIKEKW(switch);
PIKEKW(typeof);
PIKEKW(varargs);
PIKEKW(void);
PIKEKW(while);
#undef PIKEKW
#endif //PIKE_PIKEKW_SWG_

View file

@ -1,71 +0,0 @@
/* -----------------------------------------------------------------------------
* pikerun.swg
*
* This file contains the runtime support for Pike modules
* and includes code for managing global variables and pointer
* type checking.
* ----------------------------------------------------------------------------- */
#ifdef __cplusplus
extern "C" {
#endif
#include "pike/object.h"
#include "pike/program.h"
#ifdef __cplusplus
}
#endif
#include <assert.h>
/* Stores information about a wrapped object */
typedef struct swig_object_wrapper {
void *self;
swig_type_info *type;
} swig_object_wrapper;
#ifdef THIS
#undef THIS
#endif
#define THIS (((swig_object_wrapper *) Pike_fp->current_storage)->self)
#define SWIG_ConvertPtr SWIG_Pike_ConvertPtr
#define SWIG_NewPointerObj SWIG_Pike_NewPointerObj
#define SWIG_GetModule(clientdata) SWIG_Pike_GetModule(clientdata)
#define SWIG_SetModule(clientdata, pointer) SWIG_Pike_SetModule(pointer)
/* These need to be filled in before type sharing between modules will work */
static swig_module_info *SWIG_Pike_GetModule(void *SWIGUNUSEDPARM(clientdata)) {
return 0;
}
static void SWIG_Pike_SetModule(swig_module_info *pointer) {
}
/* Convert a pointer value */
static int
SWIG_Pike_ConvertPtr(struct object *obj, void **ptr, swig_type_info *ty, int flags) {
struct program *pr;
swig_cast_info *tc;
swig_object_wrapper *obj_wrapper;
if (ty) {
pr = (struct program *) ty->clientdata;
obj_wrapper = (swig_object_wrapper *) get_storage(obj, pr);
if (obj_wrapper && obj_wrapper->type) {
tc = SWIG_TypeCheckStruct(obj_wrapper->type, ty);
if (tc) {
int newmemory = 0;
*ptr = SWIG_TypeCast(tc, obj_wrapper->self, &newmemory);
assert(!newmemory); /* newmemory handling not yet implemented */
return 0;
}
}
}
return -1;
}
/* Create a new pointer object */
static struct object *
SWIG_Pike_NewPointerObj(void *ptr, swig_type_info *type, int own) {
return 0;
}

View file

@ -1,60 +0,0 @@
/* -----------------------------------------------------------------------------
* std_string.i
*
* SWIG typemaps for std::string
* ----------------------------------------------------------------------------- */
%{
#include <string>
%}
namespace std {
%naturalvar string;
class string;
/* Overloading check */
%typemap(typecheck) string = char *;
%typemap(typecheck) const string & = char *;
%typemap(in, pikedesc="tStr") string {
if ($input.type != T_STRING)
Pike_error("Bad argument: Expected a string.\n");
$1.assign(STR0($input.u.string));
}
%typemap(in, pikedesc="tStr") const string & ($*1_ltype temp) {
if ($input.type != T_STRING)
Pike_error("Bad argument: Expected a string.\n");
temp.assign(STR0($input.u.string));
$1 = &temp;
}
%typemap(out, pikedesc="tStr") string "push_text($1.c_str());";
%typemap(out, pikedesc="tStr") const string & "push_text($1->c_str());";
%typemap(directorin) string, const string &, string & "$1.c_str()";
%typemap(directorin) string *, const string * "$1->c_str()";
%typemap(directorout) string {
if ($input.type == T_STRING)
$result.assign(STR0($input.u.string));
else
throw Swig::DirectorTypeMismatchException("string expected");
}
%typemap(directorout) const string & ($*1_ltype temp) {
if ($input.type == T_STRING) {
temp.assign(STR0($input.u.string));
$result = &temp;
} else {
throw Swig::DirectorTypeMismatchException("string expected");
}
}
}

View file

@ -1,101 +0,0 @@
/* Define a C preprocessor symbol that can be used in interface files
to distinguish between the SWIG language modules. */
#define SWIG_UFFI
/* Typespecs for basic types. */
%typemap(ffitype) char ":char";
%typemap(ffitype) unsigned char ":unsigned-char";
%typemap(ffitype) signed char ":char";
%typemap(ffitype) short ":short";
%typemap(ffitype) signed short ":short";
%typemap(ffitype) unsigned short ":unsigned-short";
%typemap(ffitype) int ":int";
%typemap(ffitype) signed int ":int";
%typemap(ffitype) unsigned int ":unsigned-int";
%typemap(ffitype) long ":long";
%typemap(ffitype) signed long ":long";
%typemap(ffitype) unsigned long ":unsigned-long";
%typemap(ffitype) float ":float";
%typemap(ffitype) double ":double";
%typemap(ffitype) char * ":cstring";
%typemap(ffitype) void * ":pointer-void";
%typemap(ffitype) void ":void";
// FIXME: This is guesswork
typedef long size_t;
%wrapper %{
(eval-when (compile eval)
;;; You can define your own identifier converter if you want.
;;; Use the -identifier-converter command line argument to
;;; specify its name.
(defun identifier-convert-null (id &key type)
(declare (ignore type))
(read-from-string id))
(defun identifier-convert-lispify (cname &key type)
(assert (stringp cname))
(if (eq type :constant)
(setf cname (format nil "*~A*" cname)))
(setf cname (replace-regexp cname "_" "-"))
(let ((lastcase :other)
newcase char res)
(dotimes (n (length cname))
(setf char (schar cname n))
(if* (alpha-char-p char)
then
(setf newcase (if (upper-case-p char) :upper :lower))
(when (or (and (eq lastcase :upper) (eq newcase :lower))
(and (eq lastcase :lower) (eq newcase :upper)))
;; case change... add a dash
(push #\- res)
(setf newcase :other))
(push (char-downcase char) res)
(setf lastcase newcase)
else
(push char res)
(setf lastcase :other)))
(read-from-string (coerce (nreverse res) 'string))))
(defun identifier-convert-low-level (cname &key type)
(assert (stringp cname))
(if (eq type :constant)
(setf cname (format nil "+~A+" cname)))
(setf cname (substitute #\- #\_ cname))
(if (eq type :operator)
(setf cname (format nil "%~A" cname)))
(if (eq type :constant-function)
nil)
(read-from-string cname))
(defmacro swig-defconstant (string value &key (export T))
(let ((symbol (funcall *swig-identifier-converter* string :type :constant)))
`(eval-when (compile load eval)
(uffi:def-constant ,symbol ,value ,export))))
(defmacro swig-defun (name &rest rest)
(let ((symbol (funcall *swig-identifier-converter* name :type :operator)))
`(eval-when (compile load eval)
(uffi:def-function (,name ,symbol) ,@rest)
(export (quote ,symbol)))))
(defmacro swig-def-struct (name &rest fields)
"Declare a struct object"
(let ((symbol (funcall *swig-identifier-converter* name :type :type)))
`(eval-when (compile load eval)
(uffi:def-struct ,symbol ,@fields)
(export (quote ,symbol)))))
) ;; eval-when
%}