Check-in [d6a2d38950]
Overview
Comment:Wrapping some Tcl-specific changes to TCC into TclTCC
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d6a2d389505dfc7384c84f3e368e0d669683d830
User & Date: rkeene on 2014-05-01 23:50:52
Other Links: manifest | tags
Context
2014-05-02
00:54
Added start of initial patches to TCC needed for integration with Tcl check-in: 08662daa7c user: rkeene tags: trunk
2014-05-01
23:50
Wrapping some Tcl-specific changes to TCC into TclTCC check-in: d6a2d38950 user: rkeene tags: trunk
23:35
Corrected call to tcc configure check-in: 013ffc32d5 user: rkeene tags: trunk
Changes

Modified tcltcc.c from [07a867c26b] to [fae14f0ce9].

     1      1   /*
     2      2    *  TclTCC - Tcl binding to Tiny C Compiler
     3      3    * 
     4      4    *  Copyright (c) 2007 Mark Janssen
            5  + *  Copyright (c) 2014 Roy Keene
     5      6    *
     6      7    * This library is free software; you can redistribute it and/or
     7      8    * modify it under the terms of the GNU Lesser General Public
     8      9    * License as published by the Free Software Foundation; either
     9     10    * version 2 of the License, or (at your option) any later version.
    10     11    *
    11     12    * This library is distributed in the hope that it will be useful,
................................................................................
    16     17    * You should have received a copy of the GNU Lesser General Public
    17     18    * License along with this library; if not, write to the Free Software
    18     19    * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
    19     20    */
    20     21   
    21     22   #include <tcl.h>
    22     23   #include "tcc.h"
           24  +
           25  +struct TclTCCState {
           26  +	TCCState *s;
           27  +	int relocated;
           28  +};
    23     29   
    24     30   static void TccErrorFunc(Tcl_Interp * interp, char * msg) {
    25         -    Tcl_AppendResult(interp, msg, "\n", NULL);
           31  +	Tcl_AppendResult(interp, msg, "\n", NULL);
    26     32   }
    27         -
    28     33   
    29     34   static void TccCCommandDeleteProc (ClientData cdata) {
    30         -    TCCState * s ;
    31         -    s = (TCCState *)cdata;
    32         -    Tcl_DecrRefCount(s->tcc_lib_path);
    33         -    /* We can delete the compiler if the output was not to memory */
    34         -    if (s->output_type != TCC_OUTPUT_MEMORY) {
    35         -        tcc_delete(s);
    36         -    }
           35  +	struct TclTCCState *ts;
           36  +	TCCState *s ;
           37  +
           38  +	ts = (struct TclTCCState *) cdata;
           39  +	s = ts->s;
           40  +
           41  +	Tcl_DecrRefCount(s->tcc_lib_path);
           42  +
           43  +	/* We can delete the compiler if the output was not to memory */
           44  +	if (s->output_type != TCC_OUTPUT_MEMORY) {
           45  +		tcc_delete(s);
           46  +		ts->s = NULL;
           47  +	}
           48  +
           49  +	free(ts);
    37     50   }
    38     51   
    39     52   static int TccHandleCmd ( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]){
    40         -    unsigned long val;
    41         -    int index;
    42         -    int res;
    43         -    TCCState * s = (TCCState *)cdata ;
    44         -    Tcl_Obj * sym_addr;
           53  +	unsigned long val;
           54  +	int index;
           55  +	int res;
           56  +	struct TclTCCState *ts;
           57  +	TCCState *s;
           58  +	Tcl_Obj *sym_addr;
           59  +	static CONST char *options[] = {
           60  +		"add_include_path", "add_file",  "add_library", 
           61  +		"add_library_path", "add_symbol", "command", "compile",
           62  +		"define", "get_symbol", "output_file", "undefine",    (char *) NULL
           63  +	};
           64  +	enum options {
           65  +		TCLTCC_ADD_INCLUDE, TCLTCC_ADD_FILE, TCLTCC_ADD_LIBRARY, 
           66  +		TCLTCC_ADD_LIBRARY_PATH, TCLTCC_ADD_SYMBOL, TCLTCC_COMMAND, TCLTCC_COMPILE,
           67  +		TCLTCC_DEFINE, TCLTCC_GET_SYMBOL, TCLTCC_OUTPUT_FILE, TCLTCC_UNDEFINE
           68  +	};
    45     69   
    46         -    static CONST char *options[] = {
    47         -        "add_include_path", "add_file",  "add_library", 
    48         -        "add_library_path", "add_symbol", "command", "compile",
    49         -        "define", "get_symbol", "output_file", "undefine",    (char *) NULL
    50         -    };
    51         -    enum options {
    52         -        TCLTCC_ADD_INCLUDE, TCLTCC_ADD_FILE, TCLTCC_ADD_LIBRARY, 
    53         -        TCLTCC_ADD_LIBRARY_PATH, TCLTCC_ADD_SYMBOL, TCLTCC_COMMAND, TCLTCC_COMPILE,
    54         -        TCLTCC_DEFINE, TCLTCC_GET_SYMBOL, TCLTCC_OUTPUT_FILE, TCLTCC_UNDEFINE
    55         -    };
    56         -
           70  +	ts = (struct TclTCCState *) cdata;
           71  +	s = ts->s;
    57     72   
    58     73       if (objc < 2) {
    59     74           Tcl_WrongNumArgs(interp, 1, objv, "subcommand arg ?arg ...?");
    60     75           return TCL_ERROR;
    61     76       }
    62     77   
    63     78       if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
................................................................................
   109    124               tcc_add_symbol(s,Tcl_GetString(objv[2]),val); 
   110    125               return TCL_OK; 
   111    126           case TCLTCC_COMMAND:
   112    127               if (objc != 4) {
   113    128                   Tcl_WrongNumArgs(interp, 2, objv, "tclname cname");
   114    129                   return TCL_ERROR;
   115    130               }
   116         -            if (!s->relocated) {     
          131  +            if (!ts->relocated) {     
   117    132                   if(tcc_relocate(s)!=0) {
   118    133                       Tcl_AppendResult(interp, "relocating failed", NULL);
   119    134                       return TCL_ERROR;
   120    135                   } else {
   121         -                    s->relocated=1;
          136  +                    ts->relocated=1;
   122    137                   }
   123    138               }
   124    139               if (tcc_get_symbol(s,&val,Tcl_GetString(objv[3]))!=0) {
   125    140   		    Tcl_AppendResult(interp, "symbol '", Tcl_GetString(objv[3]),"' not found", NULL);
   126    141   		    return TCL_ERROR;
   127    142   	    }
   128    143   
   129    144               /*printf("symbol: %x\n",val); */
   130    145               Tcl_CreateObjCommand(interp,Tcl_GetString(objv[2]),(void *)val,NULL,NULL);
   131    146               return TCL_OK;
   132    147           case TCLTCC_COMPILE:
   133         -            if(s->relocated == 1) {
          148  +            if(ts->relocated == 1) {
   134    149                   Tcl_AppendResult(interp, "code already relocated, cannot compile more",NULL);
   135    150                   return TCL_ERROR;
   136    151               }
   137    152               if (objc != 3) {
   138    153                   Tcl_WrongNumArgs(interp, 2, objv, "ccode");
   139    154                   return TCL_ERROR;
   140    155               } else {
................................................................................
   157    172               tcc_define_symbol(s,Tcl_GetString(objv[2]),Tcl_GetString(objv[3]));
   158    173               return TCL_OK;
   159    174           case TCLTCC_GET_SYMBOL:
   160    175               if (objc != 3) {
   161    176                   Tcl_WrongNumArgs(interp, 2, objv, "symbol");
   162    177                   return TCL_ERROR;
   163    178               }
   164         -            if (!s->relocated) {     
          179  +            if (!ts->relocated) {     
   165    180                   if(tcc_relocate(s)!=0) {
   166    181                       Tcl_AppendResult(interp, "relocating failed", NULL);
   167    182                       return TCL_ERROR;
   168    183                   } else {
   169         -                    s->relocated=1;
          184  +                    ts->relocated=1;
   170    185                   }
   171    186               }
   172    187               if(tcc_get_symbol(s,&val,Tcl_GetString(objv[2]))!=0) {
   173    188                   Tcl_AppendResult(interp, "symbol '", Tcl_GetString(objv[2]),"' not found", NULL);
   174    189                   return TCL_ERROR;
   175    190               }
   176    191               sym_addr = Tcl_NewLongObj(val);
................................................................................
   177    192               Tcl_SetObjResult(interp, sym_addr);
   178    193               return TCL_OK; 
   179    194           case TCLTCC_OUTPUT_FILE:
   180    195               if (objc != 3) {
   181    196                   Tcl_WrongNumArgs(interp, 2, objv, "filename");
   182    197                   return TCL_ERROR;
   183    198               }
   184         -            if (s->relocated) {     
          199  +            if (ts->relocated) {     
   185    200                   Tcl_AppendResult(interp, "code already relocated, cannot output to file", NULL);
   186    201                   return TCL_ERROR;
   187    202               }
   188    203               if (s->output_type == TCC_OUTPUT_MEMORY) {     
   189    204                   Tcl_AppendResult(interp, "output_type memory not valid for output to file", NULL);
   190    205                   return TCL_ERROR;
   191    206               }
................................................................................
   211    226           default:
   212    227               Tcl_Panic("internal error during option lookup");
   213    228       }
   214    229       return TCL_OK;
   215    230   } 
   216    231   
   217    232   static int TccCreateCmd( ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj * CONST objv[]){
   218         -    TCCState * s;
   219         -    static CONST char *types[] = {
   220         -        "memory", "exe", "dll", "obj", "preprocess",    (char *) NULL
   221         -    };
   222         -    int index;
   223         -    if (objc < 3 || objc > 4) {
   224         -        Tcl_WrongNumArgs(interp, 1, objv, "tcc_libary_path ?output_type? handle");
   225         -        return TCL_ERROR;
   226         -    }
   227         -    if (objc == 3) {
   228         -        index = TCC_OUTPUT_MEMORY;
   229         -    } else {
   230         -        if (Tcl_GetIndexFromObj(interp, objv[2], types, "type", 0,
   231         -                    &index) != TCL_OK) {
   232         -            return TCL_ERROR;
   233         -        }
   234         -    }
   235         -    s = tcc_new(objv[1]);
   236         -    tcc_set_error_func(s, interp, (void *)&TccErrorFunc);
   237         -    s->relocated = 0;
   238         -    /*printf("type: %d\n", index); */
   239         -    tcc_set_output_type(s,index);
   240         -    Tcl_CreateObjCommand(interp,Tcl_GetString(objv[objc-1]),TccHandleCmd,s,TccCCommandDeleteProc);
          233  +	struct TclTCCState *ts
          234  +	TCCState *s;
          235  +    	int index;
          236  +	static CONST char *types[] = {
          237  +		"memory", "exe", "dll", "obj", "preprocess",    (char *) NULL
          238  +	};
          239  +
          240  +	if (objc < 3 || objc > 4) {
          241  +		Tcl_WrongNumArgs(interp, 1, objv, "tcc_libary_path ?output_type? handle");
          242  +		return TCL_ERROR;
          243  +	}
          244  +
          245  +	if (objc == 3) {
          246  +		index = TCC_OUTPUT_MEMORY;
          247  +	} else {
          248  +		if (Tcl_GetIndexFromObj(interp, objv[2], types, "type", 0, &index) != TCL_OK) {
          249  +			return TCL_ERROR;
          250  +		}
          251  +	}
          252  +
          253  +	s = tcc_new(objv[1]);
          254  +	tcc_set_error_func(s, interp, (void *)&TccErrorFunc);
          255  +
          256  +	ts = malloc(sizeof(*ts));
          257  +	ts->s = s;
          258  +    	ts->relocated = 0;
          259  +
          260  +	/*printf("type: %d\n", index); */
          261  +	tcc_set_output_type(s,index);
          262  +	Tcl_CreateObjCommand(interp,Tcl_GetString(objv[objc-1]),TccHandleCmd,s,TccCCommandDeleteProc);
   241    263   
   242         -    return TCL_OK;
          264  +	return TCL_OK;
   243    265   }
   244    266   
   245         -DLL_EXPORT int Tcc_Init(Tcl_Interp *interp)
   246         -{
   247         -    if (Tcl_InitStubs(interp, "8.4" , 0) == 0L) {
   248         -        return TCL_ERROR;
   249         -    }
   250         -    Tcl_CreateObjCommand(interp,PACKAGE_NAME,TccCreateCmd,NULL,NULL);
   251         -    Tcl_PkgProvide(interp,PACKAGE_NAME,PACKAGE_VERSION);
   252         -    return TCL_OK;
   253         -}
          267  +DLL_EXPORT int Tcc_Init(Tcl_Interp *interp) {
          268  +#ifdef TCL_USE_STUBS
          269  +	if (Tcl_InitStubs(interp, "8.4" , 0) == 0L) {
          270  +		return TCL_ERROR;
          271  +	}
          272  +#endif
          273  +	Tcl_CreateObjCommand(interp,PACKAGE_NAME,TccCreateCmd,NULL,NULL);
          274  +	Tcl_PkgProvide(interp,PACKAGE_NAME,PACKAGE_VERSION);
   254    275   
   255         -
   256         -
          276  +	return TCL_OK;
          277  +}