1/* -----------------------------------------------------------------------------
2 * See the LICENSE file for information on copyright, usage and redistribution
3 * of SWIG, and the README file for authors - http://www.swig.org/release.html.
4 *
5 * uffi.cxx
6 *
7 * Uffi language module for SWIG.
8 * ----------------------------------------------------------------------------- */
9
10// TODO: remove remnants of lisptype
11
12char cvsroot_uffi_cxx[] = "$Id: uffi.cxx 11380 2009-07-08 12:17:45Z wsfulton $";
13
14#include "swigmod.h"
15
16class UFFI:public Language {
17public:
18
19  virtual void main(int argc, char *argv[]);
20  virtual int top(Node *n);
21  virtual int functionWrapper(Node *n);
22  virtual int constantWrapper(Node *n);
23  virtual int classHandler(Node *n);
24  virtual int membervariableHandler(Node *n);
25
26};
27
28static File *f_cl = 0;
29
30static struct {
31  int count;
32  String **entries;
33} defined_foreign_types;
34
35static const char *identifier_converter = "identifier-convert-null";
36
37static int any_varargs(ParmList *pl) {
38  Parm *p;
39
40  for (p = pl; p; p = nextSibling(p)) {
41    if (SwigType_isvarargs(Getattr(p, "type")))
42      return 1;
43  }
44
45  return 0;
46}
47
48
49/* utilities */
50/* returns new string w/ parens stripped */
51static String *strip_parens(String *string) {
52  char *s = Char(string), *p;
53  int len = Len(string);
54  String *res;
55
56  if (len == 0 || s[0] != '(' || s[len - 1] != ')') {
57    return NewString(string);
58  }
59
60  p = (char *) malloc(len - 2 + 1);
61  if (!p) {
62    Printf(stderr, "Malloc failed\n");
63    SWIG_exit(EXIT_FAILURE);
64  }
65
66  strncpy(p, s + 1, len - 1);
67  p[len - 2] = 0;		/* null terminate */
68
69  res = NewString(p);
70  free(p);
71
72  return res;
73}
74
75
76static String *convert_literal(String *num_param, String *type) {
77  String *num = strip_parens(num_param), *res;
78  char *s = Char(num);
79
80  /* Make sure doubles use 'd' instead of 'e' */
81  if (!Strcmp(type, "double")) {
82    String *updated = Copy(num);
83    if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) {
84      Printf(stderr, "Weird!! number %s looks invalid.\n", num);
85      SWIG_exit(EXIT_FAILURE);
86    }
87    Delete(num);
88    return updated;
89  }
90
91  if (SwigType_type(type) == T_CHAR) {
92    /* Use CL syntax for character literals */
93    return NewStringf("#\\%s", num_param);
94  } else if (SwigType_type(type) == T_STRING) {
95    /* Use CL syntax for string literals */
96    return NewStringf("\"%s\"", num_param);
97  }
98
99  if (Len(num) < 2 || s[0] != '0') {
100    return num;
101  }
102
103  /* octal or hex */
104
105  res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2);
106  Delete(num);
107
108  return res;
109}
110
111static void add_defined_foreign_type(String *type) {
112  if (!defined_foreign_types.count) {
113    /* Make fresh */
114    defined_foreign_types.count = 1;
115    defined_foreign_types.entries = (String **) malloc(sizeof(String *));
116  } else {
117    /* make room */
118    defined_foreign_types.count++;
119    defined_foreign_types.entries = (String **)
120	realloc(defined_foreign_types.entries, defined_foreign_types.count * sizeof(String *));
121  }
122
123  if (!defined_foreign_types.entries) {
124    Printf(stderr, "Out of memory\n");
125    SWIG_exit(EXIT_FAILURE);
126  }
127
128  /* Fill in the new data */
129  defined_foreign_types.entries[defined_foreign_types.count - 1] = Copy(type);
130
131}
132
133
134static String *get_ffi_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
135  Node *node = NewHash();
136  Setattr(node, "type", ty);
137  Setattr(node, "name", name);
138  Setfile(node, Getfile(n));
139  Setline(node, Getline(n));
140  const String *tm = Swig_typemap_lookup("ffitype", node, "", 0);
141  Delete(node);
142
143  if (tm) {
144    return NewString(tm);
145  } else {
146    SwigType *tr = SwigType_typedef_resolve_all(ty);
147    char *type_reduced = Char(tr);
148    int i;
149
150    //Printf(stdout,"convert_type %s\n", ty);
151    if (SwigType_isconst(tr)) {
152      SwigType_pop(tr);
153      type_reduced = Char(tr);
154    }
155
156    if (SwigType_ispointer(type_reduced) || SwigType_isarray(ty) || !strncmp(type_reduced, "p.f", 3)) {
157      return NewString(":pointer-void");
158    }
159
160    for (i = 0; i < defined_foreign_types.count; i++) {
161      if (!Strcmp(ty, defined_foreign_types.entries[i])) {
162	return NewStringf("#.(%s \"%s\" :type :type)", identifier_converter, ty);
163      }
164    }
165
166    if (!Strncmp(type_reduced, "enum ", 5)) {
167      return NewString(":int");
168    }
169
170    Printf(stderr, "Unsupported data type: %s (was: %s)\n", type_reduced, ty);
171    SWIG_exit(EXIT_FAILURE);
172  }
173  return 0;
174}
175
176static String *get_lisp_type(Node *n, SwigType *ty, const_String_or_char_ptr name) {
177  Node *node = NewHash();
178  Setattr(node, "type", ty);
179  Setattr(node, "name", name);
180  Setfile(node, Getfile(n));
181  Setline(node, Getline(n));
182  const String *tm = Swig_typemap_lookup("lisptype", node, "", 0);
183  Delete(node);
184
185  return tm ? NewString(tm) : NewString("");
186}
187
188void UFFI::main(int argc, char *argv[]) {
189  int i;
190
191  Preprocessor_define("SWIGUFFI 1", 0);
192  SWIG_library_directory("uffi");
193  SWIG_config_file("uffi.swg");
194
195
196  for (i = 1; i < argc; i++) {
197    if (!strcmp(argv[i], "-identifier-converter")) {
198      char *conv = argv[i + 1];
199
200      if (!conv)
201	Swig_arg_error();
202
203      Swig_mark_arg(i);
204      Swig_mark_arg(i + 1);
205      i++;
206
207      /* check for built-ins */
208      if (!strcmp(conv, "lispify")) {
209	identifier_converter = "identifier-convert-lispify";
210      } else if (!strcmp(conv, "null")) {
211	identifier_converter = "identifier-convert-null";
212      } else {
213	/* Must be user defined */
214	char *idconv = new char[strlen(conv) + 1];
215	strcpy(idconv, conv);
216	identifier_converter = idconv;
217      }
218    }
219
220    if (!strcmp(argv[i], "-help")) {
221      fprintf(stdout, "UFFI Options (available with -uffi)\n");
222      fprintf(stdout,
223	      "    -identifier-converter <type or funcname>\n"
224	      "\tSpecifies the type of conversion to do on C identifiers to convert\n"
225	      "\tthem to symbols.  There are two built-in converters:  'null' and\n"
226	      "\t 'lispify'.  The default is 'null'.  If you supply a name other\n"
227	      "\tthan one of the built-ins, then a function by that name will be\n"
228	      "\tcalled to convert identifiers to symbols.\n");
229    }
230  }
231}
232
233int UFFI::top(Node *n) {
234  String *module = Getattr(n, "name");
235  String *output_filename = NewString("");
236  File *f_null = NewString("");
237
238  Printf(output_filename, "%s%s.cl", SWIG_output_directory(), module);
239
240
241  f_cl = NewFile(output_filename, "w", SWIG_output_files());
242  if (!f_cl) {
243    FileErrorDisplay(output_filename);
244    SWIG_exit(EXIT_FAILURE);
245  }
246
247  Swig_register_filebyname("header", f_null);
248  Swig_register_filebyname("begin", f_null);
249  Swig_register_filebyname("runtime", f_null);
250  Swig_register_filebyname("wrapper", f_cl);
251
252  Swig_banner_target_lang(f_cl, ";;");
253
254  Printf(f_cl, "\n"
255	 ";; -*- 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",
256	 module, module, module);
257  Printf(f_cl, "(eval-when (compile load eval)\n  (defparameter *swig-identifier-converter* '%s))\n", identifier_converter);
258
259  Language::top(n);
260
261  Close(f_cl);
262  Delete(f_cl);			// Delete the handle, not the file
263  Close(f_null);
264  Delete(f_null);
265
266  return SWIG_OK;
267}
268
269int UFFI::functionWrapper(Node *n) {
270  String *funcname = Getattr(n, "sym:name");
271  ParmList *pl = Getattr(n, "parms");
272  Parm *p;
273  int argnum = 0, first = 1, varargs = 0;
274
275  //Language::functionWrapper(n);
276
277  Printf(f_cl, "(swig-defun \"%s\"\n", funcname);
278  Printf(f_cl, "  (");
279
280  /* Special cases */
281
282  if (ParmList_len(pl) == 0) {
283    Printf(f_cl, ":void");
284  } else if (any_varargs(pl)) {
285    Printf(f_cl, "#| varargs |#");
286    varargs = 1;
287  } else {
288    for (p = pl; p; p = nextSibling(p), argnum++) {
289      String *argname = Getattr(p, "name");
290      SwigType *argtype = Getattr(p, "type");
291      String *ffitype = get_ffi_type(n, argtype, argname);
292      String *lisptype = get_lisp_type(n, argtype, argname);
293      int tempargname = 0;
294
295      if (!argname) {
296	argname = NewStringf("arg%d", argnum);
297	tempargname = 1;
298      }
299
300      if (!first) {
301	Printf(f_cl, "\n   ");
302      }
303      Printf(f_cl, "(%s %s %s)", argname, ffitype, lisptype);
304      first = 0;
305
306      Delete(ffitype);
307      Delete(lisptype);
308      if (tempargname)
309	Delete(argname);
310
311    }
312  }
313  Printf(f_cl, ")\n");		/* finish arg list */
314  Printf(f_cl, "  :returning %s\n"
315	 //"  :strings-convert t\n"
316	 //"  :call-direct %s\n"
317	 //"  :optimize-for-space t"
318	 ")\n", get_ffi_type(n, Getattr(n, "type"), "result")
319	 //,varargs ? "nil"  : "t"
320      );
321
322
323  return SWIG_OK;
324}
325
326int UFFI::constantWrapper(Node *n) {
327  String *type = Getattr(n, "type");
328  String *converted_value = convert_literal(Getattr(n, "value"), type);
329  String *name = Getattr(n, "sym:name");
330
331#if 0
332  Printf(stdout, "constant %s is of type %s. value: %s\n", name, type, converted_value);
333#endif
334
335  Printf(f_cl, "(swig-defconstant \"%s\" %s)\n", name, converted_value);
336
337  Delete(converted_value);
338
339  return SWIG_OK;
340}
341
342// Includes structs
343int UFFI::classHandler(Node *n) {
344
345  String *name = Getattr(n, "sym:name");
346  String *kind = Getattr(n, "kind");
347  Node *c;
348
349  if (Strcmp(kind, "struct")) {
350    Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind);
351    Printf(stderr, " (name: %s)\n", name);
352    SWIG_exit(EXIT_FAILURE);
353  }
354
355  Printf(f_cl, "(swig-def-struct \"%s\"\n \n", name);
356
357  for (c = firstChild(n); c; c = nextSibling(c)) {
358    SwigType *type = Getattr(c, "type");
359    SwigType *decl = Getattr(c, "decl");
360    type = Copy(type);
361    SwigType_push(type, decl);
362    String *lisp_type;
363
364    if (Strcmp(nodeType(c), "cdecl")) {
365      Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name);
366      Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type"));
367      SWIG_exit(EXIT_FAILURE);
368    }
369
370
371    /* Printf(stdout, "Converting %s in %s\n", type, name); */
372    lisp_type = get_ffi_type(n, type, Getattr(c, "sym:name"));
373
374    Printf(f_cl, "  (#.(%s \"%s\" :type :slot) %s)\n", identifier_converter, Getattr(c, "sym:name"), lisp_type);
375
376    Delete(lisp_type);
377  }
378
379  // Language::classHandler(n);
380
381  Printf(f_cl, " )\n");
382
383  /* Add this structure to the known lisp types */
384  //Printf(stdout, "Adding %s foreign type\n", name);
385  add_defined_foreign_type(name);
386
387  return SWIG_OK;
388}
389
390int UFFI::membervariableHandler(Node *n) {
391  Language::membervariableHandler(n);
392  return SWIG_OK;
393}
394
395
396extern "C" Language *swig_uffi(void) {
397  return new UFFI();
398}
399