Check-in [ff7febee23]
Overview
Comment:Corrected macro check for Tcl Stubs and renamed functions
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:ff7febee239f2f1e417654376567b37fa93045e6
User & Date: rkeene on 2014-05-02 16:37:50
Other Links: manifest | tags
Context
2014-05-02
17:07
Added MAKE definition if needed check-in: 387d530657 user: rkeene tags: trunk
16:37
Corrected macro check for Tcl Stubs and renamed functions check-in: ff7febee23 user: rkeene tags: trunk
15:50
Added small patch to silence spurious warnings check-in: 782d14bacd user: rkeene tags: trunk
Changes

Modified tcltcc.c from [373fc5958a] to [fc16e20c80].

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
..
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
...
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
...
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
#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;

	/* We can delete the compiler if the output was not to memory */
................................................................................
		tcc_delete(s);
		ts->s = NULL;
	}

	ckfree((void *) ts);
}

static int TccHandleCmd ( 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;
................................................................................
            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
	};

................................................................................
	s = tcc_new();
	if (s == NULL) {
		return(TCL_ERROR);
	}

	s->tcc_lib_path = tcc_strdup(Tcl_GetString(objv[1]));

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

	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]),TccHandleCmd,ts,TccCCommandDeleteProc);

	return TCL_OK;
}

int Tcc4tcl_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;
}







|



|







 







|







 







|







 







|







|





|





|




24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
..
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
...
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
...
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
#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 */
................................................................................
		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;
................................................................................
            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
	};

................................................................................
	s = tcc_new();
	if (s == NULL) {
		return(TCL_ERROR);
	}

	s->tcc_lib_path = tcc_strdup(Tcl_GetString(objv[1]));

	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);

	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, PACKAGE_NAME, Tcc4tclCreateCmd, NULL, NULL);
	Tcl_PkgProvide(interp, PACKAGE_NAME, PACKAGE_VERSION);

	return TCL_OK;
}