/* * TclTCC - Tcl binding to Tiny C Compiler * * Copyright (c) 2007 Mark Janssen * Copyright (c) 2014 Roy Keene * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #include #include "tcc.h" struct TclTCCState { TCCState *s; int relocated; }; static void TccErrorFunc(Tcl_Interp * interp, char * msg) { Tcl_AppendResult(interp, msg, "\n", NULL); } static void TccCCommandDeleteProc (ClientData cdata) { struct TclTCCState *ts; TCCState *s ; ts = (struct TclTCCState *) cdata; s = ts->s; Tcl_DecrRefCount(s->tcc_lib_path); /* We can delete the compiler if the output was not to memory */ if (s->output_type != TCC_OUTPUT_MEMORY) { tcc_delete(s); ts->s = NULL; } free(ts); } static int TccHandleCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]){ unsigned long val; int index; int res; struct TclTCCState *ts; TCCState *s; Tcl_Obj *sym_addr; static CONST char *options[] = { "add_include_path", "add_file", "add_library", "add_library_path", "add_symbol", "command", "compile", "define", "get_symbol", "output_file", "undefine", (char *) NULL }; enum options { TCLTCC_ADD_INCLUDE, TCLTCC_ADD_FILE, TCLTCC_ADD_LIBRARY, TCLTCC_ADD_LIBRARY_PATH, TCLTCC_ADD_SYMBOL, TCLTCC_COMMAND, TCLTCC_COMPILE, TCLTCC_DEFINE, TCLTCC_GET_SYMBOL, TCLTCC_OUTPUT_FILE, TCLTCC_UNDEFINE }; ts = (struct TclTCCState *) cdata; s = ts->s; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "subcommand arg ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case TCLTCC_ADD_INCLUDE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } else { tcc_add_include_path(s, Tcl_GetString(objv[2])); return TCL_OK; } case TCLTCC_ADD_FILE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "filename"); return TCL_ERROR; } else { if(tcc_add_file(s, Tcl_GetString(objv[2]))!=0) { return TCL_ERROR; } else { return TCL_OK; } } case TCLTCC_ADD_LIBRARY: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "lib"); return TCL_ERROR; } else { tcc_add_library(s, Tcl_GetString(objv[2])); return TCL_OK; } case TCLTCC_ADD_LIBRARY_PATH: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "path"); return TCL_ERROR; } else { tcc_add_library_path(s, Tcl_GetString(objv[2])); return TCL_OK; } case TCLTCC_ADD_SYMBOL: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "symbol value"); return TCL_ERROR; } Tcl_GetLongFromObj(interp,objv[3], &val); tcc_add_symbol(s,Tcl_GetString(objv[2]),val); return TCL_OK; case TCLTCC_COMMAND: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "tclname cname"); return TCL_ERROR; } if (!ts->relocated) { if(tcc_relocate(s)!=0) { Tcl_AppendResult(interp, "relocating failed", NULL); return TCL_ERROR; } else { ts->relocated=1; } } if (tcc_get_symbol(s,&val,Tcl_GetString(objv[3]))!=0) { Tcl_AppendResult(interp, "symbol '", Tcl_GetString(objv[3]),"' not found", NULL); return TCL_ERROR; } /*printf("symbol: %x\n",val); */ Tcl_CreateObjCommand(interp,Tcl_GetString(objv[2]),(void *)val,NULL,NULL); return TCL_OK; case TCLTCC_COMPILE: if(ts->relocated == 1) { Tcl_AppendResult(interp, "code already relocated, cannot compile more",NULL); return TCL_ERROR; } if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "ccode"); return TCL_ERROR; } else { int i; Tcl_GetString(objv[2]); i = tcc_compile_string(s,Tcl_GetString(objv[2])); if (i!=0) { Tcl_AppendResult(interp,"compilation failed",NULL); return TCL_ERROR; } else { return TCL_OK; } } case TCLTCC_DEFINE: if (objc != 4) { Tcl_WrongNumArgs(interp, 2, objv, "symbol value"); return TCL_ERROR; } tcc_define_symbol(s,Tcl_GetString(objv[2]),Tcl_GetString(objv[3])); return TCL_OK; case TCLTCC_GET_SYMBOL: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "symbol"); return TCL_ERROR; } if (!ts->relocated) { if(tcc_relocate(s)!=0) { Tcl_AppendResult(interp, "relocating failed", NULL); return TCL_ERROR; } else { ts->relocated=1; } } if(tcc_get_symbol(s,&val,Tcl_GetString(objv[2]))!=0) { Tcl_AppendResult(interp, "symbol '", Tcl_GetString(objv[2]),"' not found", NULL); return TCL_ERROR; } sym_addr = Tcl_NewLongObj(val); Tcl_SetObjResult(interp, sym_addr); return TCL_OK; case TCLTCC_OUTPUT_FILE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "filename"); return TCL_ERROR; } if (ts->relocated) { Tcl_AppendResult(interp, "code already relocated, cannot output to file", NULL); return TCL_ERROR; } if (s->output_type == TCC_OUTPUT_MEMORY) { Tcl_AppendResult(interp, "output_type memory not valid for output to file", NULL); return TCL_ERROR; } #ifdef WIN32 res = tcc_output_pe(s,Tcl_GetString(objv[2])); #else res = tcc_output_file(s,Tcl_GetString(objv[2])); #endif if (res!=0) { Tcl_AppendResult(interp, "output to file failed", NULL); return TCL_ERROR; } else { return TCL_OK; } case TCLTCC_UNDEFINE: if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "symbol"); return TCL_ERROR; } tcc_undefine_symbol(s,Tcl_GetString(objv[2])); return TCL_OK; default: Tcl_Panic("internal error during option lookup"); } return TCL_OK; } static int TccCreateCmd( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]){ struct TclTCCState *ts TCCState *s; int index; static CONST char *types[] = { "memory", "exe", "dll", "obj", "preprocess", (char *) NULL }; if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "tcc_libary_path ?output_type? handle"); return TCL_ERROR; } if (objc == 3) { index = TCC_OUTPUT_MEMORY; } else { if (Tcl_GetIndexFromObj(interp, objv[2], types, "type", 0, &index) != TCL_OK) { return TCL_ERROR; } } s = tcc_new(objv[1]); tcc_set_error_func(s, interp, (void *)&TccErrorFunc); ts = malloc(sizeof(*ts)); ts->s = s; ts->relocated = 0; /*printf("type: %d\n", index); */ tcc_set_output_type(s,index); Tcl_CreateObjCommand(interp,Tcl_GetString(objv[objc-1]),TccHandleCmd,s,TccCCommandDeleteProc); return TCL_OK; } DLL_EXPORT int Tcc_Init(Tcl_Interp *interp) { #ifdef TCL_USE_STUBS if (Tcl_InitStubs(interp, "8.4" , 0) == 0L) { return TCL_ERROR; } #endif Tcl_CreateObjCommand(interp,PACKAGE_NAME,TccCreateCmd,NULL,NULL); Tcl_PkgProvide(interp,PACKAGE_NAME,PACKAGE_VERSION); return TCL_OK; }