diff options
Diffstat (limited to 'devtools/swigwin-1.3.34/Lib/allegrocl')
| -rw-r--r-- | devtools/swigwin-1.3.34/Lib/allegrocl/allegrocl.swg | 543 | ||||
| -rw-r--r-- | devtools/swigwin-1.3.34/Lib/allegrocl/inout_typemaps.i | 111 | ||||
| -rw-r--r-- | devtools/swigwin-1.3.34/Lib/allegrocl/longlongs.i | 36 | ||||
| -rw-r--r-- | devtools/swigwin-1.3.34/Lib/allegrocl/std_list.i | 233 | ||||
| -rw-r--r-- | devtools/swigwin-1.3.34/Lib/allegrocl/std_string.i | 218 | ||||
| -rw-r--r-- | devtools/swigwin-1.3.34/Lib/allegrocl/typemaps.i | 4 |
6 files changed, 1145 insertions, 0 deletions
diff --git a/devtools/swigwin-1.3.34/Lib/allegrocl/allegrocl.swg b/devtools/swigwin-1.3.34/Lib/allegrocl/allegrocl.swg new file mode 100644 index 0000000..f656fae --- /dev/null +++ b/devtools/swigwin-1.3.34/Lib/allegrocl/allegrocl.swg @@ -0,0 +1,543 @@ +/* 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"; +%typemap(lout) SWIGTYPE[ANY], 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))"; + +%typemap(lisptype) bool "cl:boolean"; +%typemap(lisptype) char "cl:character"; +%typemap(lisptype) unsigned char "cl:integer"; +%typemap(lisptype) signed char "cl:integer"; + +%typemap(ffitype) bool ":int"; +%typemap(ffitype) char ":char"; +%typemap(ffitype) unsigned char ":unsigned-char"; +%typemap(ffitype) signed char ":char"; +%typemap(ffitype) short, signed short ":short"; +%typemap(ffitype) unsigned short ":unsigned-short"; +%typemap(ffitype) int, signed int ":int"; +%typemap(ffitype) unsigned int ":unsigned-int"; +%typemap(ffitype) long, signed long ":long"; +%typemap(ffitype) unsigned long ":unsigned-long"; +%typemap(ffitype) float ":float"; +%typemap(ffitype) double ":double"; +%typemap(ffitype) char * "(* :char)"; +%typemap(ffitype) void * "(* :void)"; +%typemap(ffitype) void ":void"; +%typemap(ffitype) enum SWIGTYPE ":int"; +%typemap(ffitype) SWIGTYPE & "(* :void)"; + +%typemap(ctype) 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[ANY], 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[ANY], 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[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) 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 *, void, + enum SWIGTYPE, SWIGTYPE *, + SWIGTYPE[ANY], SWIGTYPE & "$result = $1;"; +#ifdef __cplusplus +%typemap(out) SWIGTYPE "$result = new $1_type($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"; +////////////////////////////////////////////////////////////// + +/* 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[]; +#endif + +%insert("lisphead") %{ +;; $Id: allegrocl.swg 9901 2007-08-16 18:39:50Z mutandiz $ + +(eval-when (compile load eval) + + ;; 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) + (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 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))) + (cl::setf cname (excl::replace-regexp cname "_" "-")) + (cl::let ((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::or (cl::and (cl::eq lastcase :upper) + (cl::eq newcase :lower)) + (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))) + (read-symbol-from-string (cl::coerce (cl::nreverse res) 'string)))) + +(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 load eval) + (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 load eval) + (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 load eval) + (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 load eval) + (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 load eval) + (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 load eval) + (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 load eval) + (ff:def-foreign-type ,symbol ,@rest)))) + +(defswig2 swig-def-synonym-type (synonym of ff-synonym) + `(cl::eval-when (compile load eval) + (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 load eval) + (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 load eval) + (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 load eval) + (ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype)))) + +) ;; eval-when + +(cl::eval-when (compile eval) + (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)))) + +%} + + + +%{ + +#ifdef __cplusplus +# define EXTERN extern "C" +#else +# define EXTERN extern +#endif + +#define EXPORT EXTERN SWIGEXPORT + +#include <string.h> +#include <stdlib.h> +%} diff --git a/devtools/swigwin-1.3.34/Lib/allegrocl/inout_typemaps.i b/devtools/swigwin-1.3.34/Lib/allegrocl/inout_typemaps.i new file mode 100644 index 0000000..d8d61fe --- /dev/null +++ b/devtools/swigwin-1.3.34/Lib/allegrocl/inout_typemaps.i @@ -0,0 +1,111 @@ +/* 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)); diff --git a/devtools/swigwin-1.3.34/Lib/allegrocl/longlongs.i b/devtools/swigwin-1.3.34/Lib/allegrocl/longlongs.i new file mode 100644 index 0000000..b887a8a --- /dev/null +++ b/devtools/swigwin-1.3.34/Lib/allegrocl/longlongs.i @@ -0,0 +1,36 @@ +/* ----------------------------------------------------------------------------- + * See the LICENSE file for information on copyright, usage and redistribution + * of SWIG, and the README file for authors - http://www.swig.org/release.html. + * + * 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. + * ----------------------------------------------------------------------------- */ + +%typemap(in) long long, unsigned long long "$1 = $input;"; +%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 +" (make-instance #.(swig-insert-id \"longlong\" () :type :class) + :foreign-address $body)"; +%typemap(lout) unsigned long long +" (make-instance #.(swig-insert-id \"ulonglong\" () :type :class) + :foreign-address $body)"; + +%insert("lisphead") %{ + +(swig-def-foreign-class "longlong" + (ff:foreign-pointer) + (:struct (:struct (l1 :long) (l2 :long)))) + +(swig-def-foreign-class "ulonglong" + (ff:foreign-pointer) + (:struct (:struct (l1 :unsigned-long) (l2 :unsigned-long)))) +%} diff --git a/devtools/swigwin-1.3.34/Lib/allegrocl/std_list.i b/devtools/swigwin-1.3.34/Lib/allegrocl/std_list.i new file mode 100644 index 0000000..c8ab456 --- /dev/null +++ b/devtools/swigwin-1.3.34/Lib/allegrocl/std_list.i @@ -0,0 +1,233 @@ +/* ----------------------------------------------------------------------------- + * See the LICENSE file for information on copyright, usage and redistribution + * of SWIG, and the README file for authors - http://www.swig.org/release.html. + * + * 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 T &reference; + typedef const T& const_reference; + typedef T &iterator; + typedef const T& const_iterator; + + list(); + list(unsigned int size, const T& value = T()); + list(const list<T> &); + + ~list(); + 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(); + } + + }; + }; +} + + + + + + diff --git a/devtools/swigwin-1.3.34/Lib/allegrocl/std_string.i b/devtools/swigwin-1.3.34/Lib/allegrocl/std_string.i new file mode 100644 index 0000000..4da0148 --- /dev/null +++ b/devtools/swigwin-1.3.34/Lib/allegrocl/std_string.i @@ -0,0 +1,218 @@ +/* ----------------------------------------------------------------------------- + * See the LICENSE file for information on copyright, usage and redistribution + * of SWIG, and the README file for authors - http://www.swig.org/release.html. + * + * 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 <vector> +// using std::vector; + +using std::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 & (std::string 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 & (std::string 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 * (std::string *temp) { +// if (caml_ptr_check($input)) { +// temp = new std::string((char *)caml_ptr_val($input,0), +// caml_string_len($input)); +// $1 = temp; +// } else { +// SWIG_exception(SWIG_TypeError, "string expected"); +// } +// } + +// %typemap(free) string * (std::string *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 diff --git a/devtools/swigwin-1.3.34/Lib/allegrocl/typemaps.i b/devtools/swigwin-1.3.34/Lib/allegrocl/typemaps.i new file mode 100644 index 0000000..293d1cd --- /dev/null +++ b/devtools/swigwin-1.3.34/Lib/allegrocl/typemaps.i @@ -0,0 +1,4 @@ +/* Unused for Allegro CL module */ + +%include "inout_typemaps.i" +%include "longlongs.i" |