[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.
diff --git a/CHANGES.current b/CHANGES.current
index e391be9..4eee6b2 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -8,6 +8,11 @@
===========================
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
revive it in over 2 years.
diff --git a/Examples/test-suite/uffi/Makefile.in b/Examples/test-suite/uffi/Makefile.in
deleted file mode 100644
index 5d6dc11..0000000
--- a/Examples/test-suite/uffi/Makefile.in
+++ /dev/null
@@ -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
diff --git a/Lib/uffi/uffi.swg b/Lib/uffi/uffi.swg
deleted file mode 100644
index 41b0859..0000000
--- a/Lib/uffi/uffi.swg
+++ /dev/null
@@ -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
-%}
diff --git a/Source/Modules/uffi.cxx b/Source/Modules/uffi.cxx
deleted file mode 100644
index 10a53a5..0000000
--- a/Source/Modules/uffi.cxx
+++ /dev/null
@@ -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();
-}
