From de9c786cad8461c6ccd821dc6bd54bab95baebbc Mon Sep 17 00:00:00 2001 From: Art Yerkes Date: Mon, 10 Mar 2003 04:14:04 +0000 Subject: Working example. See Examples/ocaml/shapes. git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@4489 626c5289-ae23-0410-ae9c-e8d60b6d4f22 --- Examples/Makefile.in | 28 ++++++++++++++++++ Lib/ocaml/director.swg | 6 ++-- Lib/ocaml/mlheading.swg | 3 +- Lib/ocaml/ocaml.i | 1 + Lib/ocaml/typemaps.i | 6 ++++ Source/Modules/ocaml.cxx | 76 ++++++++++++++++++++++++++++++------------------ configure.in | 11 +++++++ 7 files changed, 99 insertions(+), 32 deletions(-) diff --git a/Examples/Makefile.in b/Examples/Makefile.in index 5c1c52a8c..8041e4372 100644 --- a/Examples/Makefile.in +++ b/Examples/Makefile.in @@ -510,6 +510,7 @@ mzscheme_clean: OCC=@OCAMLC@ OCAMLDLGEN=@OCAMLDLGEN@ OCAMLFIND=@OCAMLFIND@ +OCAMLMKTOP=@OCAMLMKTOP@ NOLINK ?= false ocaml_static: $(SRCS) @@ -541,6 +542,18 @@ ocaml_dynamic: $(SRCS) -package dl -linkpkg \ $(INTERFACE:%.i=%.cmo) $(PROGFILE:%.ml=%.cmo) +ocaml_static_toplevel: $(SRCS) + $(SWIG) -ocaml $(SWIGOPT) $(INTERFACE) + $(OCC) -g -c -ccopt -g -ccopt "$(INCLUDES)" $(ISRCS) $(SRCS) + $(OCC) -g -c $(INTERFACE:%.i=%.mli) + $(OCC) -g -c $(INTERFACE:%.i=%.ml) + test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ + $(OCC) -c $(PROGFILE) + $(NOLINK) || $(OCAMLMKTOP) \ + -g -ccopt -g -cclib -g -custom -o $(TARGET)_top \ + $(INTERFACE:%.i=%.cmo) \ + $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) -cclib "$(LIBS)" + ocaml_static_cpp: $(SRCS) $(SWIG) -ocaml -c++ $(SWIGOPT) $(INTERFACE) cp $(ICXXSRCS) $(ICXXSRCS:%.cxx=%.c) @@ -556,6 +569,21 @@ ocaml_static_cpp: $(SRCS) $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) \ -cclib "$(LIBS)" -cc '$(CXX)' +ocaml_static_cpp_toplevel: $(SRCS) + $(SWIG) -ocaml -c++ $(SWIGOPT) $(INTERFACE) + cp $(ICXXSRCS) $(ICXXSRCS:%.cxx=%.c) + $(OCC) -cc '$(CXX)' -g -c -ccopt -g -ccopt "-xc++ $(INCLUDES)" \ + $(ICXXSRCS:%.cxx=%.c) $(SRCS) $(CXXSRCS) + $(OCC) -g -c $(INTERFACE:%.i=%.mli) + $(OCC) -g -c $(INTERFACE:%.i=%.ml) + test -z "$(PROGFILE)" || test -f "$(PROGFILE)" && \ + $(OCC) -c $(PROGFILE) + $(NOLINK) || $(OCAMLMKTOP) \ + -g -ccopt -g -cclib -g -custom -o $(TARGET)_top \ + $(INTERFACE:%.i=%.cmo) \ + $(INTERFACE:%.i=%_wrap.@OBJEXT@) $(OBJS) \ + -cclib "$(LIBS)" -cc '$(CXX)' + ocaml_dynamic_cpp: $(SRCS) $(SWIG) -ocaml -c++ $(SWIGOPT) $(INTERFACE) cp $(ICXXSRCS) $(ICXXSRCS:%.cxx=%.c) diff --git a/Lib/ocaml/director.swg b/Lib/ocaml/director.swg index ca190a25f..0f7e51569 100644 --- a/Lib/ocaml/director.swg +++ b/Lib/ocaml/director.swg @@ -91,10 +91,12 @@ public: /* wrap a ocaml object, optionally taking ownership */ __DIRECTOR__(value self, int disown): _self(self), _disown(disown) { + register_global_root(&_self); } /* discard our reference at destruction */ virtual ~__DIRECTOR__() { + remove_global_root(&_self); __disown(); // Disown is safe here because we're just divorcing a reference that // points to us. @@ -102,7 +104,7 @@ public: /* return a pointer to the wrapped ocaml object */ value __get_self() const { - return _self; + return callback(*caml_named_value("caml_director_get_self"),_self); } /* get the _up flag to determine if the method call should be routed @@ -188,7 +190,7 @@ let new_derived_object cfun x_class args = let obj = cfun (match args with C_list argl -> - (C_list ((C_obj new_class) :: argl)) + (C_list ((C_director_core (C_obj new_class,ob_ref)) :: argl)) | a -> (C_list [ C_director_core (C_obj new_class,ob_ref) ; a ])) in ob_ref := Some obj ; diff --git a/Lib/ocaml/mlheading.swg b/Lib/ocaml/mlheading.swg index 791aed716..74f486e1c 100644 --- a/Lib/ocaml/mlheading.swg +++ b/Lib/ocaml/mlheading.swg @@ -94,7 +94,8 @@ let disown_object obj = let _ = Callback.register "caml_obj_disown" disown_object let director_get_self obj = match obj with - C_director_core (self,r) -> self + C_obj o -> obj + | C_director_core (self,r) -> self | _ -> raise (Failure "Not a director core object") let _ = Callback.register "caml_director_get_self" director_get_self diff --git a/Lib/ocaml/ocaml.i b/Lib/ocaml/ocaml.i index 8e72c73e1..491da959a 100644 --- a/Lib/ocaml/ocaml.i +++ b/Lib/ocaml/ocaml.i @@ -29,3 +29,4 @@ %include "typemaps.i" %include "typecheck.i" %include "exception.i" +%include "director.swg" diff --git a/Lib/ocaml/typemaps.i b/Lib/ocaml/typemaps.i index d7e43b2bd..9b620b2c1 100644 --- a/Lib/ocaml/typemaps.i +++ b/Lib/ocaml/typemaps.i @@ -190,9 +190,15 @@ temp = ($*1_ltype) MZ_TO_C($input); $1 = &temp; } +%typemap(outv) C_NAME { + $1 = MZ_TO_C($input); +} %typemap(argout) C_NAME & { swig_result = caml_list_append(swig_result,C_TO_MZ((long)*$1)); } +%typemap(inv) C_NAME { + args = caml_list_append(args,C_TO_MZ($1_name)); +} %enddef SIMPLE_MAP(bool, caml_val_bool, caml_long_val); diff --git a/Source/Modules/ocaml.cxx b/Source/Modules/ocaml.cxx index 5bf60254b..ba7123854 100755 --- a/Source/Modules/ocaml.cxx +++ b/Source/Modules/ocaml.cxx @@ -330,7 +330,6 @@ public: // Add a symbol for this module Preprocessor_define ("SWIGOCAML 1",0); - // Set name of typemaps SWIG_typemap_lang("ocaml"); @@ -367,6 +366,26 @@ public: /* Set comparison with none for ConstructorToFunction */ SetNoneComparison( NewString( "$arg != Val_unit" ) ); + /* check if directors are enabled for this module. note: this + * is a "master" switch, without which no director code will be + * emitted. %feature("director") statements are also required + * to enable directors for individual classes or methods. + * + * use %module(directors="1") modulename at the start of the + * interface file to enable director generation. + */ + { + Node *module = Getattr(n, "module"); + if (module) { + Node *options = Getattr(module, "options"); + if (options) { + if (Getattr(options, "directors")) { + allow_directors(); + } + } + } + } + /* Initialize all of the output files */ String *outfile = Getattr(n,"outfile"); @@ -670,12 +689,12 @@ public: // adds local variables Wrapper_add_local(f, "args", "CAMLparam1(args)"); - Wrapper_add_local(f, "ret", "CAMLlocal2(swig_result,rv)"); + Wrapper_add_local(f, "ret" , "CAMLlocal2(swig_result,rv)"); Wrapper_add_local(f, "_len", "int _len"); Wrapper_add_local(f, "lenv", "int lenv = 1"); Wrapper_add_local(f, "argc", "int argc = caml_list_length(args)"); Wrapper_add_local(f, "argv", "value *argv"); - Wrapper_add_local(f, "i", "int i"); + Wrapper_add_local(f, "i" , "int i"); Printv( f->code, "argv = (value *)malloc( argc * sizeof( value ) );\n" @@ -818,7 +837,7 @@ public: // Now have return value, figure out what to do with it. if ((tm = Swig_typemap_lookup_new("out",n,"result",0))) { - Replaceall(tm,"$source","result"); + Replaceall(tm,"$source","swig_result"); Replaceall(tm,"$target","rv"); Replaceall(tm,"$result","rv"); Replaceall(tm,"$ntype",return_type_normalized); @@ -837,7 +856,7 @@ public: if (Getattr(n,"feature:new")) { if ((tm = Swig_typemap_lookup_new("newfree",n,"result",0))) { - Replaceall(tm,"$source","result"); + Replaceall(tm,"$source","swig_result"); Printv(f->code, tm, "\n",NIL); } } @@ -1412,7 +1431,9 @@ public: w = NewWrapper(); declaration = NewString(""); - Wrapper_add_local(w,"swig_result","CAMLlocal2(swig_result,args)"); + Wrapper_add_local(w,"swig_result", + "CAMLparam0();\n" + "CAMLlocal2(swig_result,args)"); /* determine if the method returns a pointer */ decl = Getattr(n, "decl"); @@ -1461,7 +1482,7 @@ public: wrap_args = NewString(""); int outputs = 0; if (!is_void) outputs++; - + /* build argument list and type conversion string */ for (i=0, idx=0, p = l; i < num_arguments; i++) { @@ -1478,11 +1499,9 @@ public: if ((tm = Getattr(p, "tmap:inv")) != 0) { String* parse = Getattr(p, "tmap:inv:parse"); if (!parse) { - sprintf(source, "obj%d", idx++); Replaceall(tm, "$input", source); Replaceall(tm, "$owner", "0"); Printv(wrap_args, tm, "\n", NIL); - Wrapper_add_localv(w, source, "value", source, "= 0", NIL); Printv(arglist, source, NIL); } else { Replaceall(tm, "$input", pname); @@ -1570,9 +1589,13 @@ public: if (!is_void) { Wrapper_add_localv(w, "c_result", SwigType_lstr(return_type, "c_result"), NIL); } + + Printv(w->code, "swig_result = Val_unit;\n",0); + Printf(w->code,"args = Val_unit;\n"); + /* direct call to superclass if _up is set */ Printf(w->code, "if (__get_up()) {\n"); - Printf(w->code, "return %s;\n", Swig_method_call(super,l)); + Printf(w->code, "CAMLreturn(%s);\n", Swig_method_call(super,l)); Printf(w->code, "}\n"); /* check that we don't wrap a null... */ @@ -1582,10 +1605,15 @@ public: Printv(w->code, wrap_args, NIL); /* pass the method call on to the Python object */ + Printv(w->code, + "swig_result = caml_swig_alloc(1,C_list);\n" + "Store_field(swig_result,0,args);\n" + "args = swig_result;\n" + "swig_result = Val_unit;\n",0); Printf(w->code, - "swig_result = caml_list_append(swig_result," - "callback3(*caml_named_value(\"swig_runmethod\")," - "__get_self(),copy_string(\"%s\"),args));\n", + "swig_result = " + "callback2(callback(*caml_named_value(\"swig_runmethod\")," + "__get_self()),copy_string(\"%s\"),args);\n", Getattr(n,"name")); /* exception handling */ tm = Swig_typemap_lookup_new("director:except", n, "result", 0); @@ -1625,20 +1653,15 @@ public: * occurs in Language::cDeclaration(). */ Setattr(n, "type", return_type); - tm = Swig_typemap_lookup_new("outv", n, "result", w); + tm = Swig_typemap_lookup_new("outv", n, "c_result", w); Setattr(n, "type", type); if (tm == 0) { - String *name = NewString("result"); + String *name = NewString("c_result"); tm = Swig_typemap_search("outv", return_type, name, NULL); Delete(name); } if (tm != 0) { - if (outputs > 1) { - Printf(w->code, "output = PyTuple_GetItem(result, %d);\n", idx++); - Replaceall(tm, "$input", "output"); - } else { - Replaceall(tm, "$input", "result"); - } + Replaceall(tm, "$input", "swig_result"); /* TODO check this */ if (Getattr(n,"wrap:disown")) { Replaceall(tm,"$disown","SWIG_POINTER_DISOWN"); @@ -1657,12 +1680,7 @@ public: /* marshal outputs */ for (p = l; p; ) { if ((tm = Getattr(p, "tmap:argoutv")) != 0) { - if (outputs > 1) { - Printf(w->code, "output = PyTuple_GetItem(result, %d);\n", idx++); - Replaceall(tm, "$input", "output"); - } else { - Replaceall(tm, "$input", "result"); - } + Replaceall(tm, "$input", "swig_result"); Replaceall(tm, "$result", Getattr(p, "name")); Printv(w->code, tm, "\n", NIL); p = Getattr(p, "tmap:argoutv:next"); @@ -1674,9 +1692,9 @@ public: /* any existing helper functions to handle this? */ if (!is_void) { if (!SwigType_isreference(return_type)) { - Printf(w->code, "return c_result;\n"); + Printf(w->code, "CAMLreturn(c_result);\n"); } else { - Printf(w->code, "return *c_result;\n"); + Printf(w->code, "CAMLreturn(*c_result);\n"); } } diff --git a/configure.in b/configure.in index 9d3432f96..455d8979a 100644 --- a/configure.in +++ b/configure.in @@ -916,6 +916,7 @@ AC_ARG_WITH(ocaml,[ --with-ocaml=path Set location of ocaml executable],[ OCA AC_ARG_WITH(ocamlc,[ --with-ocamlc=path Set location of ocamlc executable],[ OCAMLC="$withval"], [OCAMLC=]) AC_ARG_WITH(ocamldlgen,[ --with-ocamldlgen=path Set location of ocamldlgen],[ OCAMLDLGEN="$withval" ], [OCAMLDLGEN=]) AC_ARG_WITH(ocamlfind,[ --with-ocamlfind=path Set location of ocamlfind],[OCAMLFIND="$withval"],[OCAMLFIND=]) +AC_ARG_WITH(ocamlmktop,[ --with-ocamlmktop=path Set location of ocamlmktop executable],[ OCAMLMKTOP="$withval"], [OCAMLMKTOP=]) AC_MSG_CHECKING(for Ocaml DL load generator) if test -z "$OCAMLDLGEN"; then @@ -944,6 +945,14 @@ AC_CHECK_PROGS(OCAMLBIN, ocaml, ocaml) else OCAMLBIN="$OCAMLBIN" fi + +AC_MSG_CHECKING(for Ocaml toplevel creator) +if test -z "$OCAMLMKTOP"; then +AC_CHECK_PROGS(OCAMLMKTOP, ocamlmktop, ocamlmktop) +else +OCAMLMKTOP="$OCAMLMKTOP" +fi + AC_MSG_CHECKING(for Ocaml header files) dirs="/usr/lib/ocaml/caml /usr/local/lib/ocaml/caml" for i in $dirs; do @@ -963,12 +972,14 @@ export OCAMLBIN export OCAMLC export OCAMLDLGEN export OCAMLFIND +export OCAMLMKTOP AC_SUBST(OCAMLINC) AC_SUBST(OCAMLBIN) AC_SUBST(OCAMLC) AC_SUBST(OCAMLDLGEN) AC_SUBST(OCAMLFIND) +AC_SUBST(OCAMLMKTOP) #---------------------------------------------------------------- # Look for Pike -- cgit v1.2.3