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 * clisp.cxx 6 * 7 * clisp language module for SWIG. 8 * ----------------------------------------------------------------------------- */ 9 10char cvsroot_clisp_cxx[] = "$Id: clisp.cxx 11380 2009-07-08 12:17:45Z wsfulton $"; 11 12#include "swigmod.h" 13 14class CLISP:public Language { 15public: 16 File *f_cl; 17 String *module; 18 virtual void main(int argc, char *argv[]); 19 virtual int top(Node *n); 20 virtual int functionWrapper(Node *n); 21 virtual int variableWrapper(Node *n); 22 virtual int constantWrapper(Node *n); 23 virtual int classDeclaration(Node *n); 24 virtual int enumDeclaration(Node *n); 25 virtual int typedefHandler(Node *n); 26 List *entries; 27private: 28 String *get_ffi_type(Node *n, SwigType *ty); 29 String *convert_literal(String *num_param, String *type); 30 String *strip_parens(String *string); 31 int extern_all_flag; 32 int generate_typedef_flag; 33 int is_function; 34}; 35 36void CLISP::main(int argc, char *argv[]) { 37 int i; 38 39 Preprocessor_define("SWIGCLISP 1", 0); 40 SWIG_library_directory("clisp"); 41 SWIG_config_file("clisp.swg"); 42 generate_typedef_flag = 0; 43 extern_all_flag = 0; 44 45 for (i = 1; i < argc; i++) { 46 if (!strcmp(argv[i], "-help")) { 47 Printf(stdout, "clisp Options (available with -clisp)\n"); 48 Printf(stdout, 49 " -extern-all\n" 50 "\t If this option is given then clisp definitions for all the functions\n" 51 "and global variables will be created otherwise only definitions for \n" 52 "externed functions and variables are created.\n" 53 " -generate-typedef\n" 54 "\t If this option is given then def-c-type will be used to generate shortcuts\n" 55 "according to the typedefs in the input.\n"); 56 } else if ((Strcmp(argv[i], "-extern-all") == 0)) { 57 extern_all_flag = 1; 58 Swig_mark_arg(i); 59 } else if ((Strcmp(argv[i], "-generate-typedef") == 0)) { 60 generate_typedef_flag = 1; 61 Swig_mark_arg(i); 62 } 63 } 64} 65 66int CLISP::top(Node *n) { 67 68 File *f_null = NewString(""); 69 module = Getattr(n, "name"); 70 String *output_filename; 71 entries = NewList(); 72 73 /* Get the output file name */ 74 String *outfile = Getattr(n, "outfile"); 75 76 if (!outfile) 77 output_filename = outfile; 78 else { 79 output_filename = NewString(""); 80 Printf(output_filename, "%s%s.lisp", SWIG_output_directory(), module); 81 } 82 83 f_cl = NewFile(output_filename, "w+", SWIG_output_files()); 84 if (!f_cl) { 85 FileErrorDisplay(output_filename); 86 SWIG_exit(EXIT_FAILURE); 87 } 88 89 Swig_register_filebyname("header", f_null); 90 Swig_register_filebyname("begin", f_null); 91 Swig_register_filebyname("runtime", f_null); 92 Swig_register_filebyname("wrapper", f_null); 93 94 String *header = NewString(""); 95 96 Swig_banner_target_lang(header, ";;"); 97 98 Printf(header, "\n(defpackage :%s\n (:use :common-lisp :ffi)", module); 99 100 Language::top(n); 101 102 Iterator i; 103 104 long len = Len(entries); 105 if (len > 0) { 106 Printf(header, "\n (:export"); 107 } 108 //else nothing to export 109 110 for (i = First(entries); i.item; i = Next(i)) { 111 Printf(header, "\n\t:%s", i.item); 112 } 113 114 if (len > 0) { 115 Printf(header, ")"); 116 } 117 118 Printf(header, ")\n"); 119 Printf(header, "\n(in-package :%s)\n", module); 120 Printf(header, "\n(default-foreign-language :stdc)\n"); 121 122 len = Tell(f_cl); 123 124 Printf(f_cl, "%s", header); 125 126 long end = Tell(f_cl); 127 128 for (len--; len >= 0; len--) { 129 end--; 130 Seek(f_cl, len, SEEK_SET); 131 int ch = Getc(f_cl); 132 Seek(f_cl, end, SEEK_SET); 133 Putc(ch, f_cl); 134 } 135 136 Seek(f_cl, 0, SEEK_SET); 137 Write(f_cl, Char(header), Len(header)); 138 139 Close(f_cl); 140 Delete(f_cl); // Deletes the handle, not the file 141 142 return SWIG_OK; 143} 144 145 146int CLISP::functionWrapper(Node *n) { 147 is_function = 1; 148 String *storage = Getattr(n, "storage"); 149 if (!extern_all_flag && (!storage || (Strcmp(storage, "extern") && Strcmp(storage, "externc")))) 150 return SWIG_OK; 151 152 String *func_name = Getattr(n, "sym:name"); 153 154 ParmList *pl = Getattr(n, "parms"); 155 156 int argnum = 0, first = 1; 157 158 Printf(f_cl, "\n(ffi:def-call-out %s\n\t(:name \"%s\")\n", func_name, func_name); 159 160 Append(entries, func_name); 161 162 if (ParmList_len(pl) != 0) { 163 Printf(f_cl, "\t(:arguments "); 164 } 165 for (Parm *p = pl; p; p = nextSibling(p), argnum++) { 166 167 String *argname = Getattr(p, "name"); 168 // SwigType *argtype; 169 170 String *ffitype = get_ffi_type(n, Getattr(p, "type")); 171 172 int tempargname = 0; 173 174 if (!argname) { 175 argname = NewStringf("arg%d", argnum); 176 tempargname = 1; 177 } 178 179 if (!first) { 180 Printf(f_cl, "\n\t\t"); 181 } 182 Printf(f_cl, "(%s %s)", argname, ffitype); 183 first = 0; 184 185 Delete(ffitype); 186 187 if (tempargname) 188 Delete(argname); 189 } 190 if (ParmList_len(pl) != 0) { 191 Printf(f_cl, ")\n"); /* finish arg list */ 192 } 193 String *ffitype = get_ffi_type(n, Getattr(n, "type")); 194 if (Strcmp(ffitype, "NIL")) { //when return type is not nil 195 Printf(f_cl, "\t(:return-type %s)\n", ffitype); 196 } 197 Printf(f_cl, "\t(:library +library-name+))\n"); 198 199 return SWIG_OK; 200} 201 202 203int CLISP::constantWrapper(Node *n) { 204 is_function = 0; 205 String *type = Getattr(n, "type"); 206 String *converted_value = convert_literal(Getattr(n, "value"), type); 207 String *name = Getattr(n, "sym:name"); 208 209 Printf(f_cl, "\n(defconstant %s %s)\n", name, converted_value); 210 Append(entries, name); 211 Delete(converted_value); 212 213 return SWIG_OK; 214} 215 216int CLISP::variableWrapper(Node *n) { 217 is_function = 0; 218 // SwigType *type=; 219 String *storage = Getattr(n, "storage"); 220 221 if (!extern_all_flag && (!storage || (Strcmp(storage, "extern") && Strcmp(storage, "externc")))) 222 return SWIG_OK; 223 224 String *var_name = Getattr(n, "sym:name"); 225 String *lisp_type = get_ffi_type(n, Getattr(n, "type")); 226 Printf(f_cl, "\n(ffi:def-c-var %s\n (:name \"%s\")\n (:type %s)\n", var_name, var_name, lisp_type); 227 Printf(f_cl, "\t(:library +library-name+))\n"); 228 Append(entries, var_name); 229 230 Delete(lisp_type); 231 return SWIG_OK; 232} 233 234int CLISP::typedefHandler(Node *n) { 235 if (generate_typedef_flag) { 236 is_function = 0; 237 Printf(f_cl, "\n(ffi:def-c-type %s %s)\n", Getattr(n, "name"), get_ffi_type(n, Getattr(n, "type"))); 238 } 239 240 return Language::typedefHandler(n); 241} 242 243int CLISP::enumDeclaration(Node *n) { 244 is_function = 0; 245 String *name = Getattr(n, "sym:name"); 246 247 Printf(f_cl, "\n(ffi:def-c-enum %s ", name); 248 249 for (Node *c = firstChild(n); c; c = nextSibling(c)) { 250 251 String *slot_name = Getattr(c, "name"); 252 String *value = Getattr(c, "enumvalue"); 253 254 Printf(f_cl, "(%s %s)", slot_name, value); 255 256 Append(entries, slot_name); 257 258 Delete(value); 259 } 260 261 Printf(f_cl, ")\n"); 262 return SWIG_OK; 263} 264 265 266// Includes structs 267int CLISP::classDeclaration(Node *n) { 268 is_function = 0; 269 String *name = Getattr(n, "sym:name"); 270 String *kind = Getattr(n, "kind"); 271 272 if (Strcmp(kind, "struct")) { 273 Printf(stderr, "Don't know how to deal with %s kind of class yet.\n", kind); 274 Printf(stderr, " (name: %s)\n", name); 275 SWIG_exit(EXIT_FAILURE); 276 } 277 278 279 Printf(f_cl, "\n(ffi:def-c-struct %s", name); 280 281 Append(entries, NewStringf("make-%s", name)); 282 283 for (Node *c = firstChild(n); c; c = nextSibling(c)) { 284 285 if (Strcmp(nodeType(c), "cdecl")) { 286 Printf(stderr, "Structure %s has a slot that we can't deal with.\n", name); 287 Printf(stderr, "nodeType: %s, name: %s, type: %s\n", nodeType(c), Getattr(c, "name"), Getattr(c, "type")); 288 SWIG_exit(EXIT_FAILURE); 289 } 290 291 String *temp = Copy(Getattr(c, "decl")); 292 Append(temp, Getattr(c, "type")); //appending type to the end, otherwise wrong type 293 String *lisp_type = get_ffi_type(n, temp); 294 Delete(temp); 295 296 String *slot_name = Getattr(c, "sym:name"); 297 Printf(f_cl, "\n\t(%s %s)", slot_name, lisp_type); 298 299 Append(entries, NewStringf("%s-%s", name, slot_name)); 300 301 Delete(lisp_type); 302 } 303 304 Printf(f_cl, ")\n"); 305 306 /* Add this structure to the known lisp types */ 307 //Printf(stdout, "Adding %s foreign type\n", name); 308 // add_defined_foreign_type(name); 309 310 return SWIG_OK; 311} 312 313/* utilities */ 314/* returns new string w/ parens stripped */ 315String *CLISP::strip_parens(String *string) { 316 char *s = Char(string), *p; 317 int len = Len(string); 318 String *res; 319 320 if (len == 0 || s[0] != '(' || s[len - 1] != ')') { 321 return NewString(string); 322 } 323 324 p = (char *) malloc(len - 2 + 1); 325 if (!p) { 326 Printf(stderr, "Malloc failed\n"); 327 SWIG_exit(EXIT_FAILURE); 328 } 329 330 strncpy(p, s + 1, len - 1); 331 p[len - 2] = 0; /* null terminate */ 332 333 res = NewString(p); 334 free(p); 335 336 return res; 337} 338 339String *CLISP::convert_literal(String *num_param, String *type) { 340 String *num = strip_parens(num_param), *res; 341 char *s = Char(num); 342 343 /* Make sure doubles use 'd' instead of 'e' */ 344 if (!Strcmp(type, "double")) { 345 String *updated = Copy(num); 346 if (Replace(updated, "e", "d", DOH_REPLACE_ANY) > 1) { 347 Printf(stderr, "Weird!! number %s looks invalid.\n", num); 348 SWIG_exit(EXIT_FAILURE); 349 } 350 Delete(num); 351 return updated; 352 } 353 354 if (SwigType_type(type) == T_CHAR) { 355 /* Use CL syntax for character literals */ 356 return NewStringf("#\\%s", num_param); 357 } else if (SwigType_type(type) == T_STRING) { 358 /* Use CL syntax for string literals */ 359 return NewStringf("\"%s\"", num_param); 360 } 361 362 if (Len(num) < 2 || s[0] != '0') { 363 return num; 364 } 365 366 /* octal or hex */ 367 368 res = NewStringf("#%c%s", s[1] == 'x' ? 'x' : 'o', s + 2); 369 Delete(num); 370 371 return res; 372} 373 374String *CLISP::get_ffi_type(Node *n, SwigType *ty) { 375 Node *node = NewHash(); 376 Setattr(node, "type", ty); 377 Setfile(node, Getfile(n)); 378 Setline(node, Getline(n)); 379 const String *tm = Swig_typemap_lookup("in", node, "", 0); 380 Delete(node); 381 382 if (tm) { 383 return NewString(tm); 384 } else if (SwigType_ispointer(ty)) { 385 SwigType *cp = Copy(ty); 386 SwigType_del_pointer(cp); 387 String *inner_type = get_ffi_type(n, cp); 388 389 if (SwigType_isfunction(cp)) { 390 return inner_type; 391 } 392 393 SwigType *base = SwigType_base(ty); 394 String *base_name = SwigType_str(base, 0); 395 396 String *str; 397 if (!Strcmp(base_name, "int") || !Strcmp(base_name, "float") || !Strcmp(base_name, "short") 398 || !Strcmp(base_name, "double") || !Strcmp(base_name, "long") || !Strcmp(base_name, "char")) { 399 400 str = NewStringf("(ffi:c-ptr %s)", inner_type); 401 } else { 402 str = NewStringf("(ffi:c-pointer %s)", inner_type); 403 } 404 Delete(base_name); 405 Delete(base); 406 Delete(cp); 407 Delete(inner_type); 408 return str; 409 } else if (SwigType_isarray(ty)) { 410 SwigType *cp = Copy(ty); 411 String *array_dim = SwigType_array_getdim(ty, 0); 412 413 if (!Strcmp(array_dim, "")) { //dimension less array convert to pointer 414 Delete(array_dim); 415 SwigType_del_array(cp); 416 SwigType_add_pointer(cp); 417 String *str = get_ffi_type(n, cp); 418 Delete(cp); 419 return str; 420 } else { 421 SwigType_pop_arrays(cp); 422 String *inner_type = get_ffi_type(n, cp); 423 Delete(cp); 424 425 int ndim = SwigType_array_ndim(ty); 426 String *dimension; 427 if (ndim == 1) { 428 dimension = array_dim; 429 } else { 430 dimension = array_dim; 431 for (int i = 1; i < ndim; i++) { 432 array_dim = SwigType_array_getdim(ty, i); 433 Append(dimension, " "); 434 Append(dimension, array_dim); 435 Delete(array_dim); 436 } 437 String *temp = dimension; 438 dimension = NewStringf("(%s)", dimension); 439 Delete(temp); 440 } 441 String *str; 442 if (is_function) 443 str = NewStringf("(ffi:c-ptr (ffi:c-array %s %s))", inner_type, dimension); 444 else 445 str = NewStringf("(ffi:c-array %s %s)", inner_type, dimension); 446 447 Delete(inner_type); 448 Delete(dimension); 449 return str; 450 } 451 } else if (SwigType_isfunction(ty)) { 452 SwigType *cp = Copy(ty); 453 SwigType *fn = SwigType_pop_function(cp); 454 String *args = NewString(""); 455 ParmList *pl = SwigType_function_parms(fn); 456 if (ParmList_len(pl) != 0) { 457 Printf(args, "(:arguments "); 458 } 459 int argnum = 0, first = 1; 460 for (Parm *p = pl; p; p = nextSibling(p), argnum++) { 461 String *argname = Getattr(p, "name"); 462 SwigType *argtype = Getattr(p, "type"); 463 String *ffitype = get_ffi_type(n, argtype); 464 465 int tempargname = 0; 466 467 if (!argname) { 468 argname = NewStringf("arg%d", argnum); 469 tempargname = 1; 470 } 471 if (!first) { 472 Printf(args, "\n\t\t"); 473 } 474 Printf(args, "(%s %s)", argname, ffitype); 475 first = 0; 476 Delete(ffitype); 477 if (tempargname) 478 Delete(argname); 479 } 480 if (ParmList_len(pl) != 0) { 481 Printf(args, ")\n"); /* finish arg list */ 482 } 483 String *ffitype = get_ffi_type(n, cp); 484 String *str = NewStringf("(ffi:c-function %s \t\t\t\t(:return-type %s))", args, ffitype); 485 Delete(fn); 486 Delete(args); 487 Delete(cp); 488 Delete(ffitype); 489 return str; 490 } 491 String *str = SwigType_str(ty, 0); 492 if (str) { 493 char *st = Strstr(str, "struct"); 494 if (st) { 495 st += 7; 496 return NewString(st); 497 } 498 char *cl = Strstr(str, "class"); 499 if (cl) { 500 cl += 6; 501 return NewString(cl); 502 } 503 } 504 return str; 505} 506 507extern "C" Language *swig_clisp(void) { 508 return new CLISP(); 509} 510