[allegrocl] Fix handling of forward references. Remove code breaking typical code generation. See ChangeLog for more details on the latter.
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk@10860 626c5289-ae23-0410-ae9c-e8d60b6d4f22
This commit is contained in:
Mikel Bancroft
parent
75eb4d20d6
commit
cc88c24c3f
3 changed files with 69 additions and 30 deletions
|
|
@ -1,6 +1,22 @@
|
|||
Version 1.3.37 (in progress)
|
||||
=============================
|
||||
|
||||
2008-09-17: mutandiz (Mikel Bancroft)
|
||||
[allegrocl]
|
||||
- Fix how forward reference typedefs are handled, so as not to conflict
|
||||
with other legit typedefs.
|
||||
- Don't (for now) perform an ffitype typemap lookup when trying to
|
||||
when calling compose_foreign_type(). This is actually a useful thing
|
||||
to do in certain cases, the test cases for which I can't currently
|
||||
locate :/. It's breaking some wrapping behavior that is more commonly
|
||||
seen, however. I'll readd in a more appropriate way when I can
|
||||
recreate the needed test case, or a user complains (which means
|
||||
they probably have a test case).
|
||||
- document the -isolate command-line arg in the 'swig -help' output.
|
||||
It was in the html docs, but not there.
|
||||
- small amount of code cleanup, removed some unused code.
|
||||
- some minor aesthetic changes.
|
||||
|
||||
2008-09-12: bhy
|
||||
[Python] Python 3.0 support branch merged into SWIG trunk. Thanks
|
||||
Google Summer of Code 2008 for support this project! By default
|
||||
|
|
|
|||
|
|
@ -248,7 +248,7 @@ $body)"
|
|||
%insert("lisphead") %{
|
||||
;; $Id$
|
||||
|
||||
(eval-when (compile load eval)
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
|
||||
;; avoid compiling ef-templates at runtime
|
||||
(excl:find-external-format :fat)
|
||||
|
|
@ -375,7 +375,7 @@ $body)"
|
|||
|
||||
(defswig2 swig-defconstant (string value)
|
||||
(cl::let ((symbol (id-convert-and-export string :type :constant)))
|
||||
`(cl::eval-when (compile load eval)
|
||||
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(cl::defconstant ,symbol ,value))))
|
||||
|
||||
(cl::defun maybe-reorder-args (funcname arglist)
|
||||
|
|
@ -421,7 +421,7 @@ $body)"
|
|||
)
|
||||
(cl::when (swig-anyvarargs-p ffargs)
|
||||
(cl::setq ffargs '()))
|
||||
`(cl::eval-when (compile load eval)
|
||||
`(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)
|
||||
|
|
@ -447,7 +447,7 @@ $body)"
|
|||
ffargs
|
||||
(cl::loop for (nil name nil . ffi) in ffargs
|
||||
collect `(,name ,@ffi)))))
|
||||
`(cl::eval-when (compile load eval)
|
||||
`(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)
|
||||
|
|
@ -459,7 +459,7 @@ $body)"
|
|||
(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::eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(cl::defun ,symbol (&rest args)
|
||||
(cl::case (cl::length args)
|
||||
,@(cl::loop for arity in arities
|
||||
|
|
@ -472,14 +472,14 @@ $body)"
|
|||
(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)
|
||||
`(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 load eval)
|
||||
`(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
|
||||
|
|
@ -487,11 +487,11 @@ $body)"
|
|||
|
||||
(defswig2 swig-def-foreign-type (name &rest rest)
|
||||
(cl::let ((symbol (id-convert-and-export name :type :type)))
|
||||
`(cl::eval-when (compile load eval)
|
||||
`(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 load eval)
|
||||
`(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 ))))
|
||||
|
||||
|
|
@ -511,24 +511,24 @@ $body)"
|
|||
(parent-strings (cl::mapcar #'package-name-for-namespace
|
||||
parent-namespaces))
|
||||
(string (package-name-for-namespace namespace)))
|
||||
`(cl::eval-when (compile load eval)
|
||||
`(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 load eval)
|
||||
`(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 load eval)
|
||||
`(cl::eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ff:def-foreign-variable (,symbol ,mangled-name) :type ,ftype))))
|
||||
|
||||
) ;; eval-when
|
||||
|
||||
(cl::eval-when (compile eval)
|
||||
(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)))))
|
||||
|
|
@ -539,7 +539,7 @@ $body)"
|
|||
|
||||
%}
|
||||
|
||||
|
||||
typedef void *__SWIGACL_FwdReference;
|
||||
|
||||
%{
|
||||
|
||||
|
|
@ -551,6 +551,8 @@ $body)"
|
|||
|
||||
#define EXPORT EXTERN SWIGEXPORT
|
||||
|
||||
typedef void *__SWIGACL_FwdReference;
|
||||
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
%}
|
||||
|
|
|
|||
|
|
@ -34,6 +34,8 @@ static bool CWrap = true; // generate wrapper file for C code by default. most c
|
|||
static bool Generate_Wrapper = false;
|
||||
static bool unique_swig_package = false;
|
||||
|
||||
static SwigType *fwdref_ffi_type = NewString("__SWIGACL_FwdReference");
|
||||
|
||||
static String *current_namespace = NewString("");
|
||||
static String *current_package = NewString("");
|
||||
static Hash *defined_namespace_packages = NewHash();
|
||||
|
|
@ -725,7 +727,7 @@ String *internal_compose_foreign_type(SwigType *ty) {
|
|||
} else {
|
||||
Printf(stderr, "Unable to compose foreign type of: '%s'\n", tok);
|
||||
}
|
||||
Printf(ffiType, "(* :void)");
|
||||
Printf(ffiType, "%s", get_ffi_type(fwdref_ffi_type, ""));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -735,22 +737,33 @@ String *internal_compose_foreign_type(SwigType *ty) {
|
|||
|
||||
String *compose_foreign_type(SwigType *ty, String *id = 0) {
|
||||
|
||||
Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0);
|
||||
/* Hash *lookup_res = Swig_typemap_search("ffitype", ty, id, 0); */
|
||||
|
||||
#ifdef ALLEGROCL_TYPE_DEBUG
|
||||
Printf(stderr, "compose_foreign_type: ENTER (%s)...\n ", ty);
|
||||
String *id_ref = SwigType_str(ty, id);
|
||||
Printf(stderr, "compose_foreign_type: ENTER (%s)(%s)...\n ", ty, (id ? id : 0));
|
||||
/* String *id_ref = SwigType_str(ty, id);
|
||||
Printf(stderr, "looking up typemap for %s, found '%s'(%x)\n",
|
||||
id_ref, lookup_res ? Getattr(lookup_res, "code") : 0, lookup_res);
|
||||
if (lookup_res) Swig_print_node(lookup_res);
|
||||
*/
|
||||
#endif
|
||||
|
||||
/* should we allow named lookups in the typemap here? YES! */
|
||||
/* unnamed lookups should be found in get_ffi_type, called
|
||||
by internal_compose_foreign_type(), below. */
|
||||
|
||||
/* I'm reverting to 'no' for the question above. I can no longer
|
||||
remember why I needed it. If a user needed it, I'll find out
|
||||
as soon as they upgrade. Sigh. -mutandiz 9/16/2008. */
|
||||
|
||||
/*
|
||||
if(id && lookup_res) {
|
||||
#ifdef ALLEGROCL_TYPE_DEBUG
|
||||
Printf(stderr, "compose_foreign_type: EXIT-1 (%s)\n ", Getattr(lookup_res, "code"));
|
||||
#endif
|
||||
return NewString(Getattr(lookup_res, "code"));
|
||||
}
|
||||
*/
|
||||
|
||||
SwigType *temp = SwigType_strip_qualifiers(ty);
|
||||
String *res = internal_compose_foreign_type(temp);
|
||||
|
|
@ -1516,7 +1529,10 @@ void ALLEGROCL::main(int argc, char *argv[]) {
|
|||
"\tcalled to convert identifiers to symbols.\n"
|
||||
"\n"
|
||||
" -[no]cwrap\n"
|
||||
"\tTurn on or turn off generation of an intermediate C file when\n" "\tcreating a C interface. By default this is only done for C++ code.\n");
|
||||
"\tTurn on or turn off generation of an intermediate C file when\n" "\tcreating a C interface. By default this is only done for C++ code.\n"
|
||||
" -isolate\n"
|
||||
"Define all SWIG helper functions in a package unique to this module. Avoids redefinition warnings when loading multiple SWIGged modules\n"
|
||||
"into the same running Allegro CL image.\n");
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -1571,7 +1587,7 @@ int ALLEGROCL::top(Node *n) {
|
|||
" (:export #:*swig-identifier-converter* #:*swig-module-name*\n"
|
||||
" #:*void* #:*swig-export-list*))\n"
|
||||
"(in-package :%s)\n\n"
|
||||
"(eval-when (compile load eval)\n"
|
||||
"(eval-when (:compile-toplevel :load-toplevel :execute)\n"
|
||||
" (defparameter *swig-identifier-converter* '%s)\n"
|
||||
" (defparameter *swig-module-name* :%s))\n\n", swig_package, swig_package, identifier_converter, module_name);
|
||||
Printf(f_cl, "(defpackage :%s\n" " (:use :common-lisp :%s :ff :excl))\n\n", module_name, swig_package);
|
||||
|
|
@ -2632,13 +2648,18 @@ int ALLEGROCL::functionWrapper(Node *n) {
|
|||
|
||||
String *tm = Swig_typemap_lookup_out("out", n, "result", f, actioncode);
|
||||
if (!is_void_return && tm) {
|
||||
Replaceall(tm, "$result", "lresult");
|
||||
Printf(f->code, "%s\n", tm);
|
||||
Printf(f->code, " return lresult;\n");
|
||||
Delete(tm);
|
||||
} else {
|
||||
Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number, "Unable to use return type %s in function %s.\n", SwigType_str(t, 0), name);
|
||||
if (tm) {
|
||||
Replaceall(tm, "$result", "lresult");
|
||||
Printf(f->code, "%s\n", tm);
|
||||
Printf(f->code, " return lresult;\n");
|
||||
Delete(tm);
|
||||
} else {
|
||||
Swig_warning(WARN_TYPEMAP_OUT_UNDEF, input_file, line_number,
|
||||
"Unable to use return type %s in function %s.\n",
|
||||
SwigType_str(t, 0), name);
|
||||
}
|
||||
}
|
||||
|
||||
emit_return_variable(n, t, f);
|
||||
|
||||
if (CPlusPlus) {
|
||||
|
|
@ -2901,9 +2922,7 @@ int ALLEGROCL::typedefHandler(Node *n) {
|
|||
Printf(stderr, " typedef in class '%s'(%x)\n", Getattr(in_class, "sym:name"), in_class);
|
||||
#endif
|
||||
Setattr(n, "allegrocl:typedef:in-class", in_class);
|
||||
}
|
||||
|
||||
if (in_class) {
|
||||
String *class_name = Getattr(in_class, "name");
|
||||
name = NewStringf("%s__%s", class_name, sym_name);
|
||||
type_ref = NewStringf("%s::%s", class_name, sym_name);
|
||||
|
|
@ -2917,9 +2936,11 @@ int ALLEGROCL::typedefHandler(Node *n) {
|
|||
|
||||
String *lookup = lookup_defined_foreign_type(typedef_type);
|
||||
|
||||
// Printf(stderr, "** lookup='%s'(%x), ff_type='%s', strstr = '%d'\n", lookup, lookup, ff_type, !Strstr(ff_type,"void"));
|
||||
#ifdef ALLEGROCL_TYPE_DEBUG
|
||||
Printf(stderr, "** lookup='%s'(%x), ff_type='%s', !strstr = '%d'\n", lookup, lookup, ff_type, !Strstr(ff_type,"void"));
|
||||
#endif
|
||||
|
||||
if(lookup || (!lookup && !Strstr(ff_type,"void")))
|
||||
if(lookup || (!lookup && !Strstr(ff_type,"__SWIGACL_FwdReference")))
|
||||
add_defined_foreign_type(n, 0, type_ref, name);
|
||||
else add_forward_referenced_type(n);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue