/*
 *  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 <tcl.h>
#include <stdlib.h>
#include "tcc.h"

struct TclTCCState {
	TCCState *s;
	int relocated;
};

static void Tcc4tclErrorFunc(Tcl_Interp * interp, char * msg) {
	Tcl_AppendResult(interp, msg, "\n", NULL);
}

static void Tcc4tclCCommandDeleteProc (ClientData cdata) {
	struct TclTCCState *ts;
	TCCState *s ;

	ts = (struct TclTCCState *) cdata;
	s = ts->s;

	/* 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;
	}

	ckfree((void *) ts);
}

static int Tcc4tclHandleCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]){
	unsigned long val;
	void *val_p;
	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 {
		TCC4TCL_ADD_INCLUDE, TCC4TCL_ADD_FILE, TCC4TCL_ADD_LIBRARY, 
		TCC4TCL_ADD_LIBRARY_PATH, TCC4TCL_ADD_SYMBOL, TCC4TCL_COMMAND, TCC4TCL_COMPILE,
		TCC4TCL_DEFINE, TCC4TCL_GET_SYMBOL, TCC4TCL_OUTPUT_FILE, TCC4TCL_UNDEFINE
	};
	char *str;

	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 TCC4TCL_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 TCC4TCL_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 TCC4TCL_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 TCC4TCL_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 TCC4TCL_ADD_SYMBOL:
            if (objc != 4) {
                Tcl_WrongNumArgs(interp, 2, objv, "symbol value");
                return TCL_ERROR;
            }

            Tcl_GetLongFromObj(interp, objv[3], &val);
            val_p = (void *) val;

            tcc_add_symbol(s,Tcl_GetString(objv[2]), val_p); 
            return TCL_OK; 
        case TCC4TCL_COMMAND:
            if (objc != 4) {
                Tcl_WrongNumArgs(interp, 2, objv, "tclname cname");
                return TCL_ERROR;
            }
            if (!ts->relocated) {     
                if(tcc_relocate(s, TCC_RELOCATE_AUTO)!=0) {
                    Tcl_AppendResult(interp, "relocating failed", NULL);
                    return TCL_ERROR;
                } else {
                    ts->relocated=1;
                }
            }

            val_p = tcc_get_symbol(s, Tcl_GetString(objv[3]));
            if (val_p == NULL) {
		    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]),val_p,NULL,NULL);
            return TCL_OK;
        case TCC4TCL_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 TCC4TCL_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 TCC4TCL_GET_SYMBOL:
            if (objc != 3) {
                Tcl_WrongNumArgs(interp, 2, objv, "symbol");
                return TCL_ERROR;
            }
            if (!ts->relocated) {     
                if(tcc_relocate(s, TCC_RELOCATE_AUTO)!=0) {
                    Tcl_AppendResult(interp, "relocating failed", NULL);
                    return TCL_ERROR;
                } else {
                    ts->relocated=1;
                }
            }
            val_p = tcc_get_symbol(s,Tcl_GetString(objv[2]));
            if(val_p == NULL) {
                Tcl_AppendResult(interp, "symbol '", Tcl_GetString(objv[2]),"' not found", NULL);
                return TCL_ERROR;
            }
            sym_addr = Tcl_NewWideIntObj((Tcl_WideInt) val_p);
            Tcl_SetObjResult(interp, sym_addr);
            return TCL_OK; 
        case TCC4TCL_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;
            }
            res = tcc_output_file(s,Tcl_GetString(objv[2]));

            if (res!=0) {
                Tcl_AppendResult(interp, "output to file failed", NULL);
                return TCL_ERROR;
            } else {
                return TCL_OK;
            }
        case TCC4TCL_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 Tcc4tclCreateCmd( 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(Tcl_GetString(objv[1]));
	if (s == NULL) {
		return(TCL_ERROR);
	}

#ifdef USE_TCL_STUBS
	tcc_add_symbol(s, "tclStubsPtr", &tclStubsPtr);
	tcc_define_symbol(s, "USE_TCL_STUBS", "1");
#endif

	tcc_set_error_func(s, interp, (void *)&Tcc4tclErrorFunc);

	ts = (void *) ckalloc(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]),Tcc4tclHandleCmd,ts,Tcc4tclCCommandDeleteProc);

	Tcl_SetObjResult(interp, objv[objc-1]);

	return TCL_OK;
}

int Tcc4tcl_Init(Tcl_Interp *interp) {
#ifdef USE_TCL_STUBS
	if (Tcl_InitStubs(interp, "8.4" , 0) == 0L) {
		return TCL_ERROR;
	}
#endif

	Tcl_CreateObjCommand(interp, "tcc4tcl", Tcc4tclCreateCmd, NULL, NULL);

	return TCL_OK;
}