bed81d66d3
git-svn-id: https://swig.svn.sourceforge.net/svnroot/swig/trunk/SWIG@7416 626c5289-ae23-0410-ae9c-e8d60b6d4f22
522 lines
13 KiB
C++
522 lines
13 KiB
C++
/* -----------------------------------------------------------------------------
|
|
* clisp.cxx
|
|
*
|
|
* clisp module.
|
|
*
|
|
* Author(s) : Surendra Singhi (surendra@asu.edu)
|
|
*
|
|
* Copyright (C) 2005 Surendra Singhi
|
|
* See the file LICENSE for information on usage and redistribution.
|
|
* ----------------------------------------------------------------------------- */
|
|
|
|
char cvsroot_clisp_cxx[] = "$Header$";
|
|
|
|
#include "swigmod.h"
|
|
|
|
class CLISP : public Language {
|
|
public:
|
|
File *f_cl;
|
|
String *module;
|
|
virtual void main(int argc, char *argv[]);
|
|
virtual int top(Node *n);
|
|
virtual int functionWrapper(Node *n);
|
|
virtual int variableWrapper(Node *n);
|
|
virtual int constantWrapper(Node *n);
|
|
virtual int classDeclaration(Node *n);
|
|
virtual int enumDeclaration(Node *n);
|
|
virtual int typedefHandler(Node *n);
|
|
List *entries;
|
|
private:
|
|
String* get_ffi_type(SwigType *ty);
|
|
String* convert_literal(String *num_param, String *type);
|
|
String* strip_parens(String *string);
|
|
int extern_all_flag;
|
|
int generate_typedef_flag;
|
|
int is_function;
|
|
};
|
|
|
|
void CLISP :: main(int argc, char *argv[]) {
|
|
int i;
|
|
|
|
SWIG_library_directory("clisp");
|
|
SWIG_config_file("clisp.swg");
|
|
generate_typedef_flag = 0;
|
|
extern_all_flag=0;
|
|
|
|
for(i=1; i<argc; i++) {
|
|
if (!strcmp(argv[i], "-help")) {
|
|
Printf(stdout, "clisp Options (available with -clisp)\n");
|
|
Printf(stdout,
|
|
" -extern-all\n"
|
|
"\t If this option is given then clisp definitions for all the functions\n"
|
|
"and global variables will be created otherwise only definitions for \n"
|
|
"externed functions and variables are created.\n"
|
|
" -generate-typedef\n"
|
|
"\t If this option is given then def-c-type will be used to generate shortcuts\n"
|
|
"according to the typedefs in the input.\n"
|
|
);
|
|
}
|
|
else if ( (Strcmp(argv[i],"-extern-all") == 0)) {
|
|
extern_all_flag = 1;
|
|
Swig_mark_arg(i);
|
|
}
|
|
else if ( (Strcmp(argv[i],"-generate-typedef") == 0)) {
|
|
generate_typedef_flag = 1;
|
|
Swig_mark_arg(i);
|
|
}
|
|
}
|
|
}
|
|
|
|
int CLISP :: top(Node *n) {
|
|
|
|
File *f_null=NewString("");
|
|
module=Getattr(n, "name");
|
|
String *output_filename;
|
|
entries = NewList();
|
|
|
|
/* Get the output file name */
|
|
String *outfile = Getattr(n,"outfile");
|
|
|
|
if(!outfile)
|
|
output_filename=outfile;
|
|
else {
|
|
output_filename=NewString("");
|
|
Printf(output_filename, "%s%s.lisp", SWIG_output_directory(), module);
|
|
}
|
|
|
|
f_cl=NewFile(output_filename, "w+");
|
|
if (!f_cl) {
|
|
FileErrorDisplay(output_filename);
|
|
SWIG_exit(EXIT_FAILURE);
|
|
}
|
|
|
|
Swig_register_filebyname("header",f_null);
|
|
Swig_register_filebyname("runtime",f_null);
|
|
Swig_register_filebyname("wrapper", f_null);
|
|
|
|
String *header=NewStringf(";; This is an automatically generated file. \n;;Make changes as you feel are necessary (but remember if you try to regenerate this file, your changes will be lost). \n\n(defpackage :%s\n (:use :common-lisp :ffi)", module);
|
|
|
|
Language::top(n);
|
|
|
|
Iterator i;
|
|
|
|
long len=Len(entries);
|
|
if(len > 0) {
|
|
Printf(header,"\n (:export");
|
|
}
|
|
//else nothing to export
|
|
|
|
for (i = First(entries); i.item; i = Next(i)) {
|
|
Printf(header,"\n\t:%s", i.item);
|
|
}
|
|
|
|
if(len > 0) {
|
|
Printf(header,")");
|
|
}
|
|
|
|
Printf(header, ")\n");
|
|
Printf(header,"\n(in-package :%s)\n",module);
|
|
Printf(header,"\n(default-foreign-language :stdc)\n");
|
|
|
|
len= Tell(f_cl);
|
|
|
|
Printf(f_cl,"%s",header);
|
|
|
|
long end = Tell(f_cl);
|
|
|
|
for(len--;len >=0 ; len --) {
|
|
end--;
|
|
Seek(f_cl,len,SEEK_SET);
|
|
int ch=Getc(f_cl);
|
|
Seek(f_cl,end,SEEK_SET);
|
|
Putc(ch,f_cl);
|
|
}
|
|
|
|
Seek(f_cl,0,SEEK_SET);
|
|
Write(f_cl,Char(header), Len(header));
|
|
|
|
Close(f_cl);
|
|
Delete(f_cl); // Deletes the handle, not the file
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
|
|
int CLISP :: functionWrapper(Node *n) {
|
|
is_function=1;
|
|
String *storage=Getattr(n,"storage");
|
|
if(!extern_all_flag && (!storage || (Strcmp(storage,"extern") && Strcmp(storage,"externc"))))
|
|
return SWIG_OK;
|
|
|
|
String *func_name=Getattr(n, "sym:name");
|
|
|
|
ParmList *pl=Getattr(n, "parms");
|
|
|
|
int argnum=0, first=1;
|
|
|
|
Printf(f_cl, "\n(ffi:def-call-out %s\n\t(:name \"%s\")\n", func_name,func_name);
|
|
|
|
Append(entries,func_name);
|
|
|
|
if (ParmList_len(pl) != 0) {
|
|
Printf(f_cl, "\t(:arguments ");
|
|
}
|
|
for (Parm *p=pl; p; p=nextSibling(p), argnum++) {
|
|
|
|
String *argname=Getattr(p, "name");
|
|
// SwigType *argtype;
|
|
|
|
String *ffitype=get_ffi_type(Getattr(p, "type"));
|
|
|
|
int tempargname=0;
|
|
|
|
if (!argname) {
|
|
argname=NewStringf("arg%d", argnum);
|
|
tempargname=1;
|
|
}
|
|
|
|
if (!first) {
|
|
Printf(f_cl, "\n\t\t");
|
|
}
|
|
Printf(f_cl, "(%s %s)", argname, ffitype);
|
|
first=0;
|
|
|
|
Delete(ffitype);
|
|
|
|
if (tempargname)
|
|
Delete(argname);
|
|
}
|
|
if (ParmList_len(pl) != 0) {
|
|
Printf(f_cl, ")\n"); /* finish arg list */
|
|
}
|
|
String *ffitype=get_ffi_type(Getattr(n, "type"));
|
|
if(Strcmp(ffitype,"NIL")) { //when return type is not nil
|
|
Printf(f_cl, "\t(:return-type %s)\n", ffitype);
|
|
}
|
|
Printf(f_cl, "\t(:library +library-name+))\n");
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
|
|
int CLISP :: constantWrapper(Node *n) {
|
|
is_function=0;
|
|
String *type=Getattr(n, "type");
|
|
String *converted_value=convert_literal(Getattr(n, "value"), type);
|
|
String *name=Getattr(n, "sym:name");
|
|
|
|
Printf(f_cl, "\n(defconstant %s %s)\n", name, converted_value);
|
|
Append(entries,name);
|
|
Delete(converted_value);
|
|
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int CLISP :: variableWrapper(Node *n) {
|
|
is_function=0;
|
|
// SwigType *type=;
|
|
String *storage=Getattr(n,"storage");
|
|
|
|
if(!extern_all_flag && (!storage || (Strcmp(storage,"extern") && Strcmp(storage,"externc"))))
|
|
return SWIG_OK;
|
|
|
|
String *var_name=Getattr(n, "sym:name");
|
|
String *lisp_type=get_ffi_type(Getattr(n, "type"));
|
|
Printf(f_cl,"\n(ffi:def-c-var %s\n (:type %s)\n",var_name,lisp_type);
|
|
Printf(f_cl, "\t(:library +library-name+))\n");
|
|
Append(entries,var_name);
|
|
|
|
Delete(lisp_type);
|
|
return SWIG_OK;
|
|
}
|
|
|
|
int CLISP :: typedefHandler(Node *n) {
|
|
if(generate_typedef_flag) {
|
|
is_function=0;
|
|
Printf(f_cl,"\n(ffi:def-c-type %s %s)\n",Getattr(n,"name"),get_ffi_type(Getattr(n,"type")));
|
|
}
|
|
|
|
return Language::typedefHandler(n);
|
|
}
|
|
|
|
int CLISP :: enumDeclaration(Node *n) {
|
|
is_function=0;
|
|
String *name=Getattr(n, "sym:name");
|
|
|
|
Printf(f_cl,"\n(ffi:def-c-enum %s ",name);
|
|
|
|
for (Node *c=firstChild(n); c; c=nextSibling(c)) {
|
|
|
|
String *slot_name = Getattr(c, "name");
|
|
String *value = Getattr(c, "enumvalue");
|
|
|
|
Printf(f_cl,"(%s %s)",slot_name,value);
|
|
|
|
Append(entries,slot_name);
|
|
|
|
Delete(value);
|
|
}
|
|
|
|
Printf(f_cl, ")\n");
|
|
return SWIG_OK;
|
|
}
|
|
|
|
|
|
// Includes structs
|
|
int CLISP :: classDeclaration(Node *n) {
|
|
is_function=0;
|
|
String *name=Getattr(n, "sym:name");
|
|
String *kind = Getattr(n,"kind");
|
|
|
|
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,"\n(ffi:def-c-struct %s",name);
|
|
|
|
Append(entries,NewStringf("make-%s",name));
|
|
|
|
for (Node *c=firstChild(n); c; c=nextSibling(c)) {
|
|
|
|
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);
|
|
}
|
|
|
|
String *temp=Copy(Getattr(c,"decl"));
|
|
Append(temp,Getattr(c,"type")); //appending type to the end, otherwise wrong type
|
|
String *lisp_type=get_ffi_type(temp);
|
|
Delete(temp);
|
|
|
|
String *slot_name = Getattr(c, "sym:name");
|
|
Printf(f_cl,
|
|
"\n\t(%s %s)",
|
|
slot_name,
|
|
lisp_type);
|
|
|
|
Append(entries,NewStringf("%s-%s",name,slot_name));
|
|
|
|
Delete(lisp_type);
|
|
}
|
|
|
|
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;
|
|
}
|
|
|
|
/* utilities */
|
|
/* returns new string w/ parens stripped */
|
|
String* CLISP::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;
|
|
}
|
|
|
|
String* CLISP::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;
|
|
}
|
|
|
|
String* CLISP::get_ffi_type(SwigType *ty) {
|
|
Hash *typemap =Swig_typemap_search("in", ty,"", 0);
|
|
if (typemap) {
|
|
String *typespec = Getattr(typemap, "code");
|
|
return NewString(typespec);
|
|
}
|
|
else if(SwigType_ispointer(ty)) {
|
|
SwigType *cp = Copy(ty);
|
|
SwigType_del_pointer(cp);
|
|
String *inner_type=get_ffi_type(cp);
|
|
|
|
if(SwigType_isfunction(cp)) {
|
|
return inner_type;
|
|
}
|
|
|
|
SwigType *base=SwigType_base(ty);
|
|
String *base_name=SwigType_str(base,0);
|
|
|
|
String *str;
|
|
if(!Strcmp(base_name,"int") || !Strcmp(base_name,"float") || !Strcmp(base_name,"short")
|
|
|| !Strcmp(base_name,"double") || !Strcmp(base_name,"long") || !Strcmp(base_name,"char")) {
|
|
|
|
str = NewStringf("(ffi:c-ptr %s)",inner_type);
|
|
}
|
|
else {
|
|
str = NewStringf("(ffi:c-pointer %s)",inner_type);
|
|
}
|
|
Delete(base_name);
|
|
Delete(base);
|
|
Delete(cp);
|
|
Delete(inner_type);
|
|
return str;
|
|
}
|
|
else if(SwigType_isarray(ty)) {
|
|
SwigType *cp = Copy(ty);
|
|
String *array_dim=SwigType_array_getdim(ty,0);
|
|
|
|
if(!Strcmp(array_dim,"")) { //dimension less array convert to pointer
|
|
Delete(array_dim);
|
|
SwigType_del_array(cp);
|
|
SwigType_add_pointer(cp);
|
|
String *str =get_ffi_type(cp);
|
|
Delete(cp);
|
|
return str;
|
|
}
|
|
else {
|
|
SwigType_pop_arrays(cp);
|
|
String *inner_type = get_ffi_type(cp);
|
|
Delete(cp);
|
|
|
|
int ndim=SwigType_array_ndim(ty);
|
|
String *dimension;
|
|
if(ndim == 1) {
|
|
dimension=array_dim;
|
|
}
|
|
else {
|
|
dimension = array_dim;
|
|
for(int i=1;i<ndim;i++) {
|
|
array_dim=SwigType_array_getdim(ty,i);
|
|
Append(dimension," ");
|
|
Append(dimension,array_dim);
|
|
Delete(array_dim);
|
|
}
|
|
String *temp=dimension;
|
|
dimension=NewStringf("(%s)",dimension);
|
|
Delete(temp);
|
|
}
|
|
String *str;
|
|
if(is_function)
|
|
str=NewStringf("(ffi:c-ptr (ffi:c-array %s %s))",inner_type,dimension);
|
|
else
|
|
str=NewStringf("(ffi:c-array %s %s)",inner_type,dimension);
|
|
|
|
Delete(inner_type);
|
|
Delete(dimension);
|
|
return str;
|
|
}
|
|
}
|
|
else if(SwigType_isfunction(ty)) {
|
|
SwigType *cp = Copy(ty);
|
|
SwigType *fn=SwigType_pop_function(cp);
|
|
String *args=NewString("");
|
|
ParmList *pl= SwigType_function_parms(fn);
|
|
if (ParmList_len(pl) != 0) {
|
|
Printf(args, "(:arguments ");
|
|
}
|
|
int argnum=0, first=1;
|
|
for (Parm *p=pl; p; p=nextSibling(p), argnum++) {
|
|
String *argname=Getattr(p, "name");
|
|
SwigType *argtype=Getattr(p, "type");
|
|
String *ffitype=get_ffi_type(argtype);
|
|
|
|
int tempargname=0;
|
|
|
|
if (!argname) {
|
|
argname=NewStringf("arg%d", argnum);
|
|
tempargname=1;
|
|
}
|
|
if (!first) {
|
|
Printf(args, "\n\t\t");
|
|
}
|
|
Printf(args, "(%s %s)", argname, ffitype);
|
|
first=0;
|
|
Delete(ffitype);
|
|
if (tempargname)
|
|
Delete(argname);
|
|
}
|
|
if (ParmList_len(pl) != 0) {
|
|
Printf(args, ")\n"); /* finish arg list */
|
|
}
|
|
String *ffitype = get_ffi_type(cp);
|
|
String *str=NewStringf("(ffi:c-function %s \t\t\t\t(:return-type %s))",args,ffitype);
|
|
Delete(fn);
|
|
Delete(args);
|
|
Delete(cp);
|
|
Delete(ffitype);
|
|
return str;
|
|
}
|
|
String *str=SwigType_str(ty,0);
|
|
if(str) {
|
|
char *st = Strstr(str,"struct");
|
|
if(st) {
|
|
st+=7;
|
|
return NewString(st);
|
|
}
|
|
char *cl = Strstr(str,"class");
|
|
if(cl) {
|
|
cl+=6;
|
|
return NewString(cl);
|
|
}
|
|
}
|
|
return str;
|
|
}
|
|
|
|
extern "C" Language *swig_clisp(void) {
|
|
return new CLISP();
|
|
}
|
|
|
|
|