/tags/rel-1-3-30rc1-b4beautify/SWIG/Source/Modules/uffi.cxx

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