diff options
| -rw-r--r-- | SWIG/Examples/GIFPlot/Common-Lisp/full/cmap | bin | 768 -> 0 bytes | |||
| -rw-r--r-- | SWIG/Examples/GIFPlot/Common-Lisp/full/gifplot.i | 21 | ||||
| -rw-r--r-- | SWIG/Examples/GIFPlot/Common-Lisp/full/runme.lisp | 59 | ||||
| -rw-r--r-- | SWIG/Examples/java/mpointer/Makefile | 18 | ||||
| -rw-r--r-- | SWIG/Examples/java/mpointer/example.cxx | 45 | ||||
| -rw-r--r-- | SWIG/Examples/java/mpointer/example.h | 50 | ||||
| -rw-r--r-- | SWIG/Examples/java/mpointer/example.i | 16 | ||||
| -rw-r--r-- | SWIG/Examples/java/mpointer/main.java | 61 | ||||
| -rw-r--r-- | SWIG/Examples/s-exp/uffi.lisp | 349 |
9 files changed, 0 insertions, 619 deletions
diff --git a/SWIG/Examples/GIFPlot/Common-Lisp/full/cmap b/SWIG/Examples/GIFPlot/Common-Lisp/full/cmap Binary files differdeleted file mode 100644 index a20c331a9..000000000 --- a/SWIG/Examples/GIFPlot/Common-Lisp/full/cmap +++ /dev/null diff --git a/SWIG/Examples/GIFPlot/Common-Lisp/full/gifplot.i b/SWIG/Examples/GIFPlot/Common-Lisp/full/gifplot.i deleted file mode 100644 index e5c15aa2b..000000000 --- a/SWIG/Examples/GIFPlot/Common-Lisp/full/gifplot.i +++ /dev/null @@ -1,21 +0,0 @@ -/* Oh what the heck, let's just grab the whole darn header file - and see what happens. */ - -%module gifplot -%{ - -/* Note: You still need this part because the %include directive - merely causes SWIG to interpret the contents of a file. It doesn't - include the right include headers for the resulting C code */ - -#include "gifplot.h" - -%} - -/* Pixel is typedef'd to unsigned char, and SWIG will translate this - type into Scheme characters. We would like to translate Pixels to - Scheme integers instead, so: */ - -SIMPLE_MAP(Pixel, gh_scm2int, gh_int2scm, integer); - -%include gifplot.h diff --git a/SWIG/Examples/GIFPlot/Common-Lisp/full/runme.lisp b/SWIG/Examples/GIFPlot/Common-Lisp/full/runme.lisp deleted file mode 100644 index 48f804201..000000000 --- a/SWIG/Examples/GIFPlot/Common-Lisp/full/runme.lisp +++ /dev/null @@ -1,59 +0,0 @@ -;;; Plot a 3D function - -;; Here is the function to plot -(defun func (x y) - (* 5 - (cos (* 2 (sqrt (+ (* x x) (* y y))))) - (exp (* -0.3 (sqrt (+ (* x x) (* y y))))))) - -;; Here are some plotting parameters -(defvar xmin -5D0) -(defvar xmax 5D0) -(defvar ymin -5D0) -(defvar ymax 5D0) -(defvar zmin -5D0) -(defvar zmax 5D0) - -;; Grid resolution -(defvar nxpoints 60) -(defvar nypoints 60) - -(defun drawsolid (p3) - (Plot3D-clear p3 0) - (Plot3D-start p3) - (let ((dx (/ (- xmax xmin) nxpoints)) - (dy (/ (- ymax ymin) nypoints)) - (cscale (/ 240 (- zmax zmin)))) - (loop for x from xmin by dx - repeat nxpoints - do (loop for y from ymin by dy - repeat nypoints - do (let* ((z1 (func x y)) - (z2 (func (+ x dx) y)) - (z3 (func (+ x dx) (+ y dy))) - (z4 (func x (+ y dy))) - (c1 (* cscale (- z1 zmin))) - (c2 (* cscale (- z2 zmin))) - (c3 (* cscale (- z3 zmin))) - (c4 (* cscale (- z4 zmin))) - (cc (/ (+ c1 c2 c3 c4) 4)) - (c (round (max (min cc 239) 0)))) - (Plot3D-solidquad p3 x y z1 (+ x dx) y z2 (+ x dx) (+ y dy) - z3 x (+ y dy) z4 (+ c 16))))))) - -(defun action (cmap-filename) - (let ((cmap (new-ColorMap cmap-filename)) - (frame (new-FrameBuffer 500 500))) - (format t "Making a nice 3D plot...~%") - (FrameBuffer-clear frame 0) - (let ((p3 (new-Plot3D frame xmin ymin zmin xmax ymax zmax))) - (Plot3D-lookat p3 (* 2 (- zmax zmin))) - (Plot3D-autoperspective p3 40D0) - (Plot3D-rotu p3 60D0) - (Plot3D-rotr p3 30D0) - (Plot3D-rotd p3 10D0) - (drawsolid p3)) - (FrameBuffer-writeGIF frame cmap "/tmp/image.gif") - (format t "Wrote image.gif~%"))) - - diff --git a/SWIG/Examples/java/mpointer/Makefile b/SWIG/Examples/java/mpointer/Makefile deleted file mode 100644 index 69fb4e670..000000000 --- a/SWIG/Examples/java/mpointer/Makefile +++ /dev/null @@ -1,18 +0,0 @@ -TOP = ../.. -SWIG = $(TOP)/../swig -CXXSRCS = example.cxx -TARGET = example -INTERFACE = example.i -SWIGOPT = - -all:: java - -java:: - $(MAKE) -f $(TOP)/Makefile CXXSRCS='$(CXXSRCS)' SWIG='$(SWIG)' \ - SWIGOPT='$(SWIGOPT)' TARGET='$(TARGET)' INTERFACE='$(INTERFACE)' java_cpp - javac *.java - -clean:: - $(MAKE) -f $(TOP)/Makefile java_clean - -check: all diff --git a/SWIG/Examples/java/mpointer/example.cxx b/SWIG/Examples/java/mpointer/example.cxx deleted file mode 100644 index 1a6bb666a..000000000 --- a/SWIG/Examples/java/mpointer/example.cxx +++ /dev/null @@ -1,45 +0,0 @@ -/* File : example.c */ - -#include "example.h" -#include <math.h> - -/* Move the shape to a new location */ -void Shape::move(double dx, double dy) { - x += dx; - y += dy; -} - -int Shape::nshapes = 0; - -double Circle::area(void) { - return M_PI*radius*radius; -} - -double Circle::perimeter(void) { - return 2*M_PI*radius; -} - -double Square::area(void) { - return width*width; -} - -double Square::perimeter(void) { - return 4*width; -} - -double do_op(Shape *s, double (Shape::*m)(void)) { - return (s->*m)(); -} - -double (Shape::*areapt())(void) { - return &Shape::area; -} - -double (Shape::*perimeterpt())(void) { - return &Shape::perimeter; -} - -/* Member pointer variables */ -double (Shape::*areavar)(void) = &Shape::area; -double (Shape::*perimetervar)(void) = &Shape::perimeter; - diff --git a/SWIG/Examples/java/mpointer/example.h b/SWIG/Examples/java/mpointer/example.h deleted file mode 100644 index 110fe91c1..000000000 --- a/SWIG/Examples/java/mpointer/example.h +++ /dev/null @@ -1,50 +0,0 @@ -/* File : example.h */ - -class Shape { -public: - Shape() { - nshapes++; - } - virtual ~Shape() { - nshapes--; - }; - double x, y; - double *z; - - void move(double dx, double dy); - virtual double area(void) = 0; - virtual double perimeter(void) = 0; - static int nshapes; -}; - -class Circle : public Shape { -private: - double radius; -public: - Circle(double r) : radius(r) { }; - virtual double area(void); - virtual double perimeter(void); -}; - -class Square : public Shape { -private: - double width; -public: - Square(double w) : width(w) { }; - virtual double area(void); - virtual double perimeter(void); -}; - -extern double do_op(Shape *s, double (Shape::*m)(void)); - -/* Functions that return member pointers */ - -extern double (Shape::*areapt())(void); -extern double (Shape::*perimeterpt())(void); - -/* Global variables that are member pointers */ -extern double (Shape::*areavar)(void); -extern double (Shape::*perimetervar)(void); - - - diff --git a/SWIG/Examples/java/mpointer/example.i b/SWIG/Examples/java/mpointer/example.i deleted file mode 100644 index 238792be8..000000000 --- a/SWIG/Examples/java/mpointer/example.i +++ /dev/null @@ -1,16 +0,0 @@ -/* File : example.i */ -%module example - -%{ -#include "example.h" -%} - -/* Let's just grab the original header file here */ -%include "example.h" - -/* Some constants */ - -%constant double (Shape::*AREAPT)(void) = &Shape::area; -%constant double (Shape::*PERIMPT)(void) = &Shape::perimeter; -%constant double (Shape::*NULLPT)(void) = 0; - diff --git a/SWIG/Examples/java/mpointer/main.java b/SWIG/Examples/java/mpointer/main.java deleted file mode 100644 index ab6cdf159..000000000 --- a/SWIG/Examples/java/mpointer/main.java +++ /dev/null @@ -1,61 +0,0 @@ -// Example using pointers to member functions - -public class main { - static { - try { - System.loadLibrary("example"); - } catch (UnsatisfiedLinkError e) { - System.err.println("Native code library failed to load. See the chapter on Dynamic Linking Problems in the SWIG Java documentation for help.\n" + e); - System.exit(1); - } - } - - public static void main(String argv[]) - { - // Get the pointers - - SWIGTYPE_m_Shape__f_void__double area_pt = example.areapt(); - SWIGTYPE_m_Shape__f_void__double perim_pt = example.perimeterpt(); - - System.out.println( "area_pt =" + area_pt ); - System.out.println( "perim_pt = " + perim_pt ); - - // Create some objects - - Circle c = new Circle(4); - Square s = new Square(10); - - // Do some calculations - - System.out.println( "Circle area = " + example.do_op(c,area_pt) ); - System.out.println( "Circle perim = " + example.do_op(c,perim_pt) ); - System.out.println( "Square area = " + example.do_op(s,area_pt) ); - System.out.println( "Square perim = " + example.do_op(s,perim_pt) ); - - System.out.println( "areavar = " + example.getAreavar() ); - System.out.println( "perimetervar = " + example.getPerimetervar() ); - - // Try the variables - System.out.println( "Circle area = " + example.do_op(c,example.getAreavar()) ); - System.out.println( "Circle perim = " + example.do_op(c,example.getPerimetervar()) ); - System.out.println( "Square area = " + example.do_op(s,example.getAreavar()) ); - System.out.println( "Square perim = " + example.do_op(s,example.getPerimetervar()) ); - - // Modify one of the variables - example.setAreavar(perim_pt); - - System.out.println( "Circle perimeter = " + example.do_op(c,example.getAreavar()) ); - - // Try the constants - - System.out.println( "example.AREAPT =" + example.AREAPT ); - System.out.println( "example.PERIMPT=" + example.PERIMPT ); - System.out.println( "example.NULLPT =" + example.NULLPT ); - - System.out.println( "Circle area = " + example.do_op(c,example.AREAPT) ); - System.out.println( "Circle perim = " + example.do_op(c,example.PERIMPT) ); - System.out.println( "Square area = " + example.do_op(s,example.AREAPT) ); - System.out.println( "Square perim = " + example.do_op(s,example.PERIMPT) ); - - } -} diff --git a/SWIG/Examples/s-exp/uffi.lisp b/SWIG/Examples/s-exp/uffi.lisp deleted file mode 100644 index 3869f10e4..000000000 --- a/SWIG/Examples/s-exp/uffi.lisp +++ /dev/null @@ -1,349 +0,0 @@ -;;; This is experimental code that uses the s-expression -;;; representation of a C/C++ library interface to generate Foreign -;;; Function Interface definitions for use with Kevin Rosenberg's -;;; UFFI. -;;; -;;; Written by Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> - -(require 'port) ; from CLOCC - -(in-package :cl-user) - -(require 'uffi) - -;; Interaction with the SWIG binary - -(defvar *swig-source-directory* #p"/home/mkoeppe/s/swig1.3/") - -(defvar *swig-program* (merge-pathnames "swig-1.3" *swig-source-directory*)) - -(defun run-swig (swig-interface-file-name &key directory-search-list module - ignore-errors) - (setf (port:getenv :SWIG_LIB) - (namestring (merge-pathnames "Lib" *swig-source-directory*))) - (let ((temp-file-name "/tmp/swig.lsp")) - (let ((process - (port:run-prog (namestring *swig-program*) - :output t - :args `("-sexp" - ,@(mapcar (lambda (dir) - (concatenate 'string - "-I" (namestring dir))) - directory-search-list) - ,@(and module - `("-module" ,module)) - "-o" ,temp-file-name - ,(namestring swig-interface-file-name))))) - #+cmu (unless (or (zerop (ext:process-exit-code process)) - ignore-errors) - (error "Process swig exited abnormally")) - (with-open-file (s temp-file-name) - (read s))))) - -;; Type system - -(defun parse-swigtype (type-string &key start end junk-ok) - "Parse TYPE-STRING as SWIG's internal representation of C/C++ -types. Return two values: The type description (an improper list) and -the terminating index into TYPE-STRING." - ;; SWIG's internal representation is described in Source/Swig/stype.c - (unless start - (setq start 0)) - (unless end - (setq end (length type-string))) - (flet ((prefix-match (prefix) - (let ((position (mismatch prefix type-string :start2 start :end2 end))) - (or (not position) - (= position (length prefix))))) - (bad-type-error (reason) - (error "Bad SWIG type (~A): ~A" reason - (subseq type-string start end))) - (type-char (index) - (and (< index (length type-string)) - (char type-string index))) - (cons-and-recurse (prefix start end) - (multiple-value-bind (type-description index) - (parse-swigtype type-string :start start :end end - :junk-ok junk-ok) - (values (cons prefix type-description) - index)))) - (cond - ((prefix-match "p.") ; pointer - (cons-and-recurse '* (+ start 2) end)) - ((prefix-match "r.") ; C++ reference - (cons-and-recurse '& (+ start 2) end)) - ((prefix-match "a(") ; array - (let ((closing-paren (find #\) type-string - :start (+ start 2) - :end end))) - (unless closing-paren - (bad-type-error "missing right paren")) - (unless (eql (type-char (+ closing-paren 1)) #\.) - (bad-type-error "missing dot")) - (cons-and-recurse (list 'ARRAY (subseq type-string (+ start 2) closing-paren)) - (+ closing-paren 2) end))) - ((prefix-match "q(") ; qualifier (const, volatile) - (let ((closing-paren (find #\) type-string - :start (+ start 2) - :end end))) - (unless closing-paren - (bad-type-error "missing right paren")) - (unless (eql (type-char (+ closing-paren 1)) #\.) - (bad-type-error "missing dot")) - (cons-and-recurse (list 'QUALIFIER (subseq type-string (+ start 2) closing-paren)) - (+ closing-paren 2) end))) - ((prefix-match "m(") ; C++ member pointer - (multiple-value-bind (class-type class-end-index) - (parse-swigtype type-string :junk-ok t - :start (+ start 2) :end end) - (unless (eql (type-char class-end-index) #\)) - (bad-type-error "missing right paren")) - (unless (eql (type-char (+ class-end-index 1)) #\.) - (bad-type-error "missing dot")) - (cons-and-recurse (list 'MEMBER-POINTER class-type) - (+ class-end-index 2) end))) - ((prefix-match "f(") ; function - (loop with index = (+ start 2) - until (eql (type-char index) #\)) - collect (multiple-value-bind (arg-type arg-end-index) - (parse-swigtype type-string :junk-ok t - :start index :end end) - (case (type-char arg-end-index) - (#\, (setq index (+ arg-end-index 1))) - (#\) (setq index arg-end-index)) - (otherwise (bad-type-error "comma or right paren expected"))) - arg-type) - into arg-types - finally (unless (eql (type-char (+ index 1)) #\.) - (bad-type-error "missing dot")) - (return (cons-and-recurse (cons 'FUNCTION arg-types) - (+ index 2) end)))) - (t (let ((junk-position (position-if (lambda (char) - (member char '(#\, #\( #\) #\.))) - type-string - :start start :end end))) - (cond (junk-position ; found junk - (unless junk-ok - (bad-type-error "trailing junk")) - (values (subseq type-string start junk-position) - junk-position)) - (t - (values (subseq type-string start end) - end)))))))) - -(defun swigtype-function-p (swigtype) - "Check whether SWIGTYPE designates a function. If so, the second -value is the list of argument types, and the third value is the return -type." - (if (and (consp swigtype) - (consp (first swigtype)) - (eql (first (first swigtype)) 'FUNCTION)) - (values t (rest (first swigtype)) (rest swigtype)) - (values nil nil nil))) - - -;; UFFI - -(defvar *uffi-definitions* '()) - -(defconstant *uffi-default-primitive-type-alist* - '(("char" . :char) - ("unsigned char" . :unsigned-byte) - ("signed char" . :byte) - ("short" . :short) - ("signed short" . :short) - ("unsigned short" . :unsigned-short) - ("int" . :int) - ("signed int" . :int) - ("unsigned int" . :unsigned-int) - ("long" . :long) - ("signed long" . :long) - ("unsigned long" . :unsigned-long) - ("float" . :float) - ("double" . :double) - ((* . "char") . :cstring) - ((* . "void") . :pointer-void) - ("void" . :void))) - -(defvar *uffi-primitive-type-alist* *uffi-default-primitive-type-alist*) - -(defun uffi-type-spec (type-list) - "Return the UFFI type spec equivalent to TYPE-LIST, or NIL if there -is no representation." - (let ((primitive-type-pair - (assoc type-list *uffi-primitive-type-alist* :test 'equal))) - (cond - (primitive-type-pair - (cdr primitive-type-pair)) - ((and (consp type-list) - (eql (first type-list) '*)) - (let ((base-type-spec (uffi-type-spec (rest type-list)))) - (cond - ((not base-type-spec) - :pointer-void) - (t - (list '* base-type-spec))))) - (t nil)))) - -;; Parse tree - -(defvar *uffi-output* nil) - -(defun emit-uffi-definition (uffi-definition) - (format *uffi-output* "~&~S~%" uffi-definition) - (push uffi-definition *uffi-definitions*)) - -(defun make-cl-symbol (c-identifier) - (intern (substitute #\- #\_ (string-upcase c-identifier)))) - -(defvar *class-scope* '() "A stack of names of nested C++ classes.") - -(defvar *struct-fields* '()) - -(defgeneric handle-node (node-type &key &allow-other-keys) - (:documentation "Handle a node of SWIG's parse tree of a C/C++ program")) - -(defmethod handle-node ((node-type t) &key &allow-other-keys) - ;; do nothing for unknown node types - nil) - -(defmethod handle-node ((node-type (eql 'cdecl)) &key name decl storage parms type &allow-other-keys) - (let ((swigtype (parse-swigtype (concatenate 'string decl type)))) - (let ((*print-pretty* nil)) ; or FUNCTION would be printed as #' by cmucl - (format *uffi-output* "~&;; C Declaration: ~A ~A ~A ~A~%;; with-parms ~W~%;; of-type ~W~%" - storage type name decl parms swigtype)) - (multiple-value-bind (function-p arg-swigtype-list return-swigtype) - (swigtype-function-p swigtype) - (declare (ignore arg-swigtype-list)) - (cond - ((and (null *class-scope*) function-p) ; ordinary top-level function - (let ((uffi-arg-list - (mapcar (lambda (param) - (destructuring-bind (&key name type &allow-other-keys) param - (let ((uffi-type (uffi-type-spec (parse-swigtype type)))) - (unless uffi-type - (format *uffi-output* "~&;; Warning: Cannot handle type ~S of argument `~A'~%" - type name) - (return-from handle-node)) - `(,(make-cl-symbol name) ,uffi-type)))) - parms)) - (uffi-return-type - (uffi-type-spec return-swigtype))) - (unless uffi-return-type - (format *uffi-output* "~&;; Warning: Cannot handle return type `~S'~%" - return-swigtype) - (return-from handle-node)) - (emit-uffi-definition `(UFFI:DEF-FUNCTION ,name ,uffi-arg-list :RETURNING ,uffi-return-type)))) - - ((and (not (null *class-scope*)) (null (rest *class-scope*)) - (not function-p)) ; class/struct member (no nested structs) - (let ((uffi-type (uffi-type-spec swigtype))) - (unless uffi-type - (format *uffi-output* "~&;; Warning: Cannot handle type ~S of struct field `~A'~%" - type name) - (return-from handle-node)) - (push `(,(make-cl-symbol name) ,uffi-type) *struct-fields*))))))) - -(defmethod handle-node ((node-type (eql 'class)) &key name children kind &allow-other-keys) - (format *uffi-output* "~&;; Class ~A~%" name) - (let ((*class-scope* (cons name *class-scope*)) - (*struct-fields* '())) - (dolist (child children) - (apply 'handle-node child)) - (emit-uffi-definition `(,(if (string= kind "union") - 'UFFI:DEF-UNION - 'UFFI:DEF-STRUCT) - ,(make-cl-symbol name) ,@(nreverse *struct-fields*))))) - -(defmethod handle-node ((node-type (eql 'top)) &key children &allow-other-keys) - (dolist (child children) - (apply 'handle-node child))) - -(defmethod handle-node ((node-type (eql 'include)) &key name children &allow-other-keys) - (format *uffi-output* ";; INCLUDE ~A~%" name) - (dolist (child children) - (apply 'handle-node child))) - -;;(defun compute-uffi-definitions (swig-interface) -;; (let ((*uffi-definitions* '())) -;; (handle-node swig-interface) -;; *uffi-definitions*)) - -;; Test instances - -#+ignore -(defvar *gifplot-interface* - (run-swig (merge-pathnames "Examples/GIFPlot/Interface/gifplot.i" - *swig-source-directory*) - :directory-search-list (list (merge-pathnames "Examples/GIFPlot/Interface/" *swig-source-directory*)))) - -(defvar *simple-gifplot-interface* - (run-swig (merge-pathnames "Examples/GIFPlot/Include/gifplot.h" - *swig-source-directory*) - :directory-search-list (list (merge-pathnames "Examples/GIFPlot/Interface/" *swig-source-directory*)) - :module "gifplot")) - -(defvar *cplex-glue-directory* #p"/home/mkoeppe/cvs/cplex-glue/") - -(defvar *cplex-glue-interface* - (run-swig (merge-pathnames "cplex.i" *cplex-glue-directory*) - :directory-search-list (list (merge-pathnames "Lib/guile" - *swig-source-directory*) - *cplex-glue-directory*) - :ignore-errors t)) - - - -(require 'uffi) - -;;(let ((*uffi-primitive-type-alist* (cons '("Pixel" . :unsigned-int) *uffi-default-primitive-type-alist*))) -;; (eval (cons 'progn (compute-uffi-definitions *simple-gifplot-interface*)))) - - -(with-open-file (f "/tmp/swig-uffi.lisp" :direction :output) - (let ((*uffi-definitions* '()) - (*uffi-output* f) - (*uffi-primitive-type-alist* - (cons '("Pixel" . :unsigned-int) *uffi-default-primitive-type-alist*))) - (apply 'handle-node *simple-gifplot-interface*))) - -#+cplex -(with-open-file (f "/tmp/swig-uffi.lisp" :direction :output) - (let ((*uffi-definitions* '()) - (*uffi-output* f) - (*uffi-primitive-type-alist* - (cons '("Pixel" . :unsigned-int) *uffi-default-primitive-type-alist*))) - (apply 'handle-node *cplex-glue-interface*))) - -(compile-file "/tmp/swig-uffi.lisp") - -(load "/tmp/swig-uffi.lisp") - -(uffi:load-foreign-library (merge-pathnames "Examples/GIFPlot/libgifplot.a" - *swig-source-directory*)) - -(load (merge-pathnames "Examples/GIFPlot/Common-Lisp/full/runme.lisp" *swig-source-directory*)) - -(action (namestring (merge-pathnames "Examples/GIFPlot/Common-Lisp/full/cmap" - *swig-source-directory*))) - -;;;; TODO: - -;; * How to do type lookups? Is everything important that SWIG knows -;; about the types written out? What to make of typemaps? -;; -;; * Wrapped functions should probably automatically COERCE their -;; arguments (as of type DOUBLE-FLOAT), to make the functions more -;; flexible? -;; -;; * Why are the functions created by FFI interpreted? -;; -;; * We can't deal with more complicated structs and C++ classes -;; directly with the FFI; we have to emit SWIG wrappers that access -;; those classes. -;; -;; * A CLOS layer where structure fields are mapped as slots. It -;; looks like we need MOP functions to implement this. -;; -;; * Maybe modify SWIG so that key-value hashes are distinguished from -;; value-value hashes. |