[UFFI] Remove code for Common Lisp UFFI
We dropped support for it in SWIG 4.0.0 and nobody has stepped forward to revive it in over 2 years. See #2009.
This commit is contained in:
Olly Betts
parent
b7a99f22f5
commit
a54d62b22e
4 changed files with 5 additions and 557 deletions
|
|
@ -7,6 +7,11 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
|
|||
Version 4.1.0 (in progress)
|
||||
===========================
|
||||
|
||||
2021-05-13: olly
|
||||
[UFFI] #2009 Remove code for Common Lisp UFFI. We dropped support
|
||||
for it in SWIG 4.0.0 and nobody has stepped forward to revive it in
|
||||
over 2 years.
|
||||
|
||||
2021-05-13: olly
|
||||
[S-EXP] #2009 Remove code for Common Lisp S-Exp. We dropped
|
||||
support for it in SWIG 4.0.0 and nobody has stepped forward to
|
||||
|
|
|
|||
|
|
@ -1,51 +0,0 @@
|
|||
#######################################################################
|
||||
# Makefile for uffi test-suite
|
||||
#######################################################################
|
||||
|
||||
LANGUAGE = uffi
|
||||
UFFI = @UFFIBIN@
|
||||
SCRIPTSUFFIX = _runme.lisp
|
||||
|
||||
srcdir = @srcdir@
|
||||
top_srcdir = @top_srcdir@
|
||||
top_builddir = @top_builddir@
|
||||
|
||||
include $(srcdir)/../common.mk
|
||||
|
||||
# Overridden variables here
|
||||
# no C++ tests for now
|
||||
CPP_TEST_CASES =
|
||||
#C_TEST_CASES +=
|
||||
|
||||
# Custom tests - tests with additional commandline options
|
||||
# none!
|
||||
|
||||
# Rules for the different types of tests
|
||||
%.cpptest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_cpp)
|
||||
$(run_testcase)
|
||||
|
||||
%.ctest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_c)
|
||||
$(run_testcase)
|
||||
|
||||
%.multicpptest:
|
||||
$(setup)
|
||||
+$(swig_and_compile_multi_cpp)
|
||||
$(run_testcase)
|
||||
|
||||
# Runs the testcase. A testcase is only run if
|
||||
# a file is found which has _runme.lisp appended after the testcase name.
|
||||
run_testcase = \
|
||||
if [ -f $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX) ]; then \
|
||||
env LD_LIBRARY_PATH=.:$$LD_LIBRARY_PATH $(RUNTOOL) $(UFFI) -batch -s $(SCRIPTDIR)/$(SCRIPTPREFIX)$*$(SCRIPTSUFFIX); \
|
||||
fi
|
||||
|
||||
# Clean: (does nothing, we dont generate extra uffi code)
|
||||
%.clean:
|
||||
@exit 0
|
||||
|
||||
clean:
|
||||
$(MAKE) -f $(top_builddir)/$(EXAMPLES)/Makefile SRCDIR='$(SRCDIR)' uffi_clean
|
||||
|
|
@ -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
|
||||
%}
|
||||
|
|
@ -1,405 +0,0 @@
|
|||
/* -----------------------------------------------------------------------------
|
||||
* This file is part of SWIG, which is licensed as a whole under version 3
|
||||
* (or any later version) of the GNU General Public License. Some additional
|
||||
* terms also apply to certain portions of SWIG. The full details of the SWIG
|
||||
* license and copyrights can be found in the LICENSE and COPYRIGHT files
|
||||
* included with the SWIG source code as distributed by the SWIG developers
|
||||
* and at http://www.swig.org/legal.html.
|
||||
*
|
||||
* uffi.cxx
|
||||
*
|
||||
* Uffi language module for SWIG.
|
||||
* ----------------------------------------------------------------------------- */
|
||||
|
||||
// TODO: remove remnants of lisptype
|
||||
|
||||
#include "swigmod.h"
|
||||
|
||||
static const char *usage = "\
|
||||
UFFI Options (available with -uffi)\n\
|
||||
-identifier-converter <type or funcname> - \n\
|
||||
Specifies the type of conversion to do on C identifiers\n\
|
||||
to convert them to symbols. There are two built-in\n\
|
||||
converters: 'null' and 'lispify'. The default is\n\
|
||||
'null'. If you supply a name other than one of the\n\
|
||||
built-ins, then a function by that name will be\n\
|
||||
called to convert identifiers to symbols.\n\
|
||||
";
|
||||
|
||||
class UFFI:public Language {
|
||||
public:
|
||||
|
||||
virtual void main(int argc, char *argv[]);
|
||||
virtual int top(Node *n);
|
||||
virtual int functionWrapper(Node *n);
|
||||
virtual int constantWrapper(Node *n);
|
||||
virtual int classHandler(Node *n);
|
||||
virtual int membervariableHandler(Node *n);
|
||||
|
||||
};
|
||||
|
||||
static File *f_cl = 0;
|
||||
|
||||
static struct {
|
||||
int count;
|
||||
String **entries;
|
||||
} defined_foreign_types;
|
||||
|
||||
static String *identifier_converter = NewString("identifier-convert-null");
|
||||
|
||||
static int any_varargs(ParmList *pl) {
|
||||
Parm *p;
|
||||
|
||||
for (p = pl; p; p = nextSibling(p)) {
|
||||
if (SwigType_isvarargs(Getattr(p, "type")))
|
||||
return 1;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
/* utilities */
|
||||
/* returns new string w/ parens stripped */
|
||||
static String *strip_parens(String *string) {
|
||||
char *s = Char(string), *p;
|
||||
int len = Len(string);
|
||||
String *res;
|
||||
|
||||
if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
|
||||
return NewString(string);
|
||||
}
|
||||
|
||||
p = (char *) malloc(len - 2 + 1);
|
||||
if (!p) {
|
||||
Printf(stderr, "Malloc failed\n");
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
strncpy(p, s + 1, len - 1);
|
||||
p[len - 2] = 0; /* null terminate */
|
||||
|
||||
res = NewString(p);
|
||||
free(p);
|
||||
|
||||
return res;
|
||||
}
|
||||
|
||||
|
||||
static String *convert_literal(String *num_param, String *type) {
|
||||
String *num = strip_parens(num_param), *res;
|
||||
char *s = Char(num);
|
||||
|
||||
/* Make sure doubles use 'd' instead of 'e' */
|
||||
if (!Strcmp(type, "double")) {
|
||||
String *updated = Copy(num);
|
||||
if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
|
||||
Printf(stderr, "Weird!! number %s looks invalid.\n", num);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
Delete(num);
|
||||
return updated;
|
||||
}
|
||||
|
||||
if (SwigType_type(type) == T_CHAR) {
|
||||
/* Use CL syntax for character literals */
|
||||
return NewStringf("#\\%s", num_param);
|
||||
} else if (SwigType_type(type) == T_STRING) {
|
||||
/* Use CL syntax for string literals */
|
||||
return NewStringf("\"%s\"", num_param);
|
||||
}
|
||||
|
||||
if (Len(num) < 2 || s[0] != '0') {
|
||||
return num;
|
||||
}
|
||||
|
||||
/* octal or hex */
|
||||
|
||||
res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
|
||||
Delete(num);
|
||||
|
||||
return res;
|
||||
}
|
||||
|
||||
static void add_defined_foreign_type(String *type) {
|
||||
if (!defined_foreign_types.count) {
|
||||
/* Make fresh */
|
||||
defined_foreign_types.count = 1;
|
||||
defined_foreign_types.entries = (String **) malloc(sizeof(String *));
|
||||
} else {
|
||||
/* make room */
|
||||
defined_foreign_types.count++;
|
||||
defined_foreign_types.entries = (String **)
|
||||
realloc(defined_foreign_types.entries, defined_foreign_types.count * sizeof(String *));
|
||||
}
|
||||
|
||||
if (!defined_foreign_types.entries) {
|
||||
Printf(stderr, "Out of memory\n");
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
/* Fill in the new data */
|
||||
defined_foreign_types.entries[defined_foreign_types.count - 1] = Copy(type);
|
||||
|
||||
}
|
||||
|
||||
|
||||
static String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
|
||||
Node *node = NewHash();
|
||||
Setattr(node, "type", ty);
|
||||
Setattr(node, "name", name);
|
||||
Setfile(node, Getfile(n));
|
||||
Setline(node, Getline(n));
|
||||
const String *tm = Swig_typemap_lookup("ffitype", node, "", 0);
|
||||
Delete(node);
|
||||
|
||||
if (tm) {
|
||||
return NewString(tm);
|
||||
} else {
|
||||
SwigType *tr = SwigType_typedef_resolve_all(ty);
|
||||
char *type_reduced = Char(tr);
|
||||
int i;
|
||||
|
||||
//Printf(stdout,"convert_type %s\n", ty);
|
||||
if (SwigType_isconst(tr)) {
|
||||
SwigType_pop(tr);
|
||||
type_reduced = Char(tr);
|
||||
}
|
||||
|
||||
if (SwigType_ispointer(type_reduced) || SwigType_isarray(ty) || !strncmp(type_reduced, "p.f", 3)) {
|
||||
return NewString(":pointer-void");
|
||||
}
|
||||
|
||||
for (i = 0; i < defined_foreign_types.count; i++) {
|
||||
if (!Strcmp(ty, defined_foreign_types.entries[i])) {
|
||||
return NewStringf("#.(%s \"%s\" :type :type)", identifier_converter, ty);
|
||||
}
|
||||
}
|
||||
|
||||
if (!Strncmp(type_reduced, "enum ", 5)) {
|
||||
return NewString(":int");
|
||||
}
|
||||
|
||||
Printf(stderr, "Unsupported data type: %s (was: %s)\n", type_reduced, ty);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static String *get_lisp_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
|
||||
Node *node = NewHash();
|
||||
Setattr(node, "type", ty);
|
||||
Setattr(node, "name", name);
|
||||
Setfile(node, Getfile(n));
|
||||
Setline(node, Getline(n));
|
||||
const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
|
||||
Delete(node);
|
||||
|
||||
return tm ? NewString(tm) : NewString("");
|
||||
}
|
||||
|
||||
void UFFI::main(int argc, char *argv[]) {
|
||||
int i;
|
||||
|
||||
Preprocessor_define("SWIGUFFI 1", 0);
|
||||
SWIG_library_directory("uffi");
|
||||
SWIG_config_file("uffi.swg");
|
||||
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
if (!strcmp(argv[i], "-identifier-converter")) {
|
||||
char *conv = argv[i + 1];
|
||||
|
||||
if (!conv)
|
||||
Swig_arg_error();
|
||||
|
||||
Swig_mark_arg(i);
|
||||
Swig_mark_arg(i + 1);
|
||||
i++;
|
||||
|
||||
/* check for built-ins */
|
||||
if (!strcmp(conv, "lispify")) {
|
||||
Delete(identifier_converter);
|
||||
identifier_converter = NewString("identifier-convert-lispify");
|
||||
} else if (!strcmp(conv, "null")) {
|
||||
Delete(identifier_converter);
|
||||
identifier_converter = NewString("identifier-convert-null");
|
||||
} else {
|
||||
/* Must be user defined */
|
||||
Delete(identifier_converter);
|
||||
identifier_converter = NewString(conv);
|
||||
}
|
||||
}
|
||||
|
||||
if (!strcmp(argv[i], "-help")) {
|
||||
Printf(stdout, "%s\n", usage);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
int UFFI::top(Node *n) {
|
||||
String *module = Getattr(n, "name");
|
||||
String *output_filename = NewString("");
|
||||
File *f_null = NewString("");
|
||||
|
||||
Printf(output_filename, "%s%s.cl", SWIG_output_directory(), module);
|
||||
|
||||
|
||||
f_cl = NewFile(output_filename, "w", SWIG_output_files());
|
||||
if (!f_cl) {
|
||||
FileErrorDisplay(output_filename);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
Swig_register_filebyname("header", f_null);
|
||||
Swig_register_filebyname("begin", f_null);
|
||||
Swig_register_filebyname("runtime", f_null);
|
||||
Swig_register_filebyname("wrapper", f_cl);
|
||||
|
||||
Swig_banner_target_lang(f_cl, ";;");
|
||||
|
||||
Printf(f_cl, "\n"
|
||||
";; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; package: %s -*-\n\n(defpackage :%s\n (:use :common-lisp :uffi))\n\n(in-package :%s)\n",
|
||||
module, module, module);
|
||||
Printf(f_cl, "(eval-when (compile load eval)\n (defparameter *swig-identifier-converter* '%s))\n", identifier_converter);
|
||||
|
||||
Language::top(n);
|
||||
|
||||
Delete(f_cl); // Delete the handle, not the file
|
||||
Delete(f_null);
|
||||
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
int UFFI::functionWrapper(Node *n) {
|
||||
String *funcname = Getattr(n, "sym:name");
|
||||
ParmList *pl = Getattr(n, "parms");
|
||||
Parm *p;
|
||||
int argnum = 0, first = 1;
|
||||
// int varargs = 0;
|
||||
|
||||
//Language::functionWrapper(n);
|
||||
|
||||
Printf(f_cl, "(swig-defun \"%s\"\n", funcname);
|
||||
Printf(f_cl, " (");
|
||||
|
||||
/* Special cases */
|
||||
|
||||
if (ParmList_len(pl) == 0) {
|
||||
Printf(f_cl, ":void");
|
||||
} else if (any_varargs(pl)) {
|
||||
Printf(f_cl, "#| varargs |#");
|
||||
// varargs = 1;
|
||||
} else {
|
||||
for (p = pl; p; p = nextSibling(p), argnum++) {
|
||||
String *argname = Getattr(p, "name");
|
||||
SwigType *argtype = Getattr(p, "type");
|
||||
String *ffitype = get_ffi_type(n, argtype, argname);
|
||||
String *lisptype = get_lisp_type(n, argtype, argname);
|
||||
int tempargname = 0;
|
||||
|
||||
if (!argname) {
|
||||
argname = NewStringf("arg%d", argnum);
|
||||
tempargname = 1;
|
||||
}
|
||||
|
||||
if (!first) {
|
||||
Printf(f_cl, "\n ");
|
||||
}
|
||||
Printf(f_cl, "(%s %s %s)", argname, ffitype, lisptype);
|
||||
first = 0;
|
||||
|
||||
Delete(ffitype);
|
||||
Delete(lisptype);
|
||||
if (tempargname)
|
||||
Delete(argname);
|
||||
|
||||
}
|
||||
}
|
||||
Printf(f_cl, ")\n"); /* finish arg list */
|
||||
Printf(f_cl, " :returning %s\n"
|
||||
//" :strings-convert t\n"
|
||||
//" :call-direct %s\n"
|
||||
//" :optimize-for-space t"
|
||||
")\n", get_ffi_type(n, Getattr(n, "type"), Swig_cresult_name())
|
||||
//,varargs ? "nil" : "t"
|
||||
);
|
||||
|
||||
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
int UFFI::constantWrapper(Node *n) {
|
||||
String *type = Getattr(n, "type");
|
||||
String *converted_value = convert_literal(Getattr(n, "value"), type);
|
||||
String *name = Getattr(n, "sym:name");
|
||||
|
||||
#if 0
|
||||
Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
|
||||
#endif
|
||||
|
||||
Printf(f_cl, "(swig-defconstant \"%s\" %s)\n", name, converted_value);
|
||||
|
||||
Delete(converted_value);
|
||||
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
// Includes structs
|
||||
int UFFI::classHandler(Node *n) {
|
||||
|
||||
String *name = Getattr(n, "sym:name");
|
||||
String *kind = Getattr(n, "kind");
|
||||
Node *c;
|
||||
|
||||
if (Strcmp(kind, "struct")) {
|
||||
Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
|
||||
Printf(stderr, " (name: %s)\n", name);
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
Printf(f_cl, "(swig-def-struct \"%s\"\n \n", name);
|
||||
|
||||
for (c = firstChild(n); c; c = nextSibling(c)) {
|
||||
SwigType *type = Getattr(c, "type");
|
||||
SwigType *decl = Getattr(c, "decl");
|
||||
if (type) {
|
||||
type = Copy(type);
|
||||
SwigType_push(type, decl);
|
||||
String *lisp_type;
|
||||
|
||||
if (Strcmp(nodeType(c), "cdecl")) {
|
||||
Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
|
||||
Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
|
||||
SWIG_exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
/* Printf(stdout, "Converting %s in %s\n", type, name); */
|
||||
lisp_type = get_ffi_type(n, type, Getattr(c, "sym:name"));
|
||||
|
||||
Printf(f_cl, " (#.(%s \"%s\" :type :slot) %s)\n", identifier_converter, Getattr(c, "sym:name"), lisp_type);
|
||||
|
||||
Delete(lisp_type);
|
||||
}
|
||||
}
|
||||
|
||||
// Language::classHandler(n);
|
||||
|
||||
Printf(f_cl, " )\n");
|
||||
|
||||
/* Add this structure to the known lisp types */
|
||||
//Printf(stdout, "Adding %s foreign type\n", name);
|
||||
add_defined_foreign_type(name);
|
||||
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
int UFFI::membervariableHandler(Node *n) {
|
||||
Language::membervariableHandler(n);
|
||||
return SWIG_OK;
|
||||
}
|
||||
|
||||
|
||||
extern "C" Language *swig_uffi(void) {
|
||||
return new UFFI();
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue