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