Context Navigation

source: trunk/packages/optimizer/src/rp_optimizer_tcl.c @ 1067

Last change on this file since 1067 was 1062, checked in by liveletlive, 16 years ago
Committing changes related to command <name> samples ?number?
File size: 30.9 KB

Line
1	/*
2	* ----------------------------------------------------------------------
3	* rp_optimizer_tcl
4	*
5	* This is the Tcl API for the functions in rp_optimizer. This code
6	* allows you to call all of the core optimization functions from Tcl.
7	*
8	* ======================================================================
9	* AUTHOR: Michael McLennan, Purdue University
10	* Copyright (c) 2008 Purdue Research Foundation
11	*
12	* See the file "license.terms" for information on usage and
13	* redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14	* ======================================================================
15	*/
16	#include "rp_optimizer.h"
17
18	extern int pgapack_abort;
19
20	/*
21	* ----------------------------------------------------------------------
22	* KNOWN OPTIMIZATION PACKAGES
23	* Add an entry below for each new optimization package that is
24	* plugged in and available via the -using option. End with all
25	* NULL values.
26	* ----------------------------------------------------------------------
27	*/
28	RpOptimInit PgapackInit;
29	RpOptimHandler PgapackRun;
30	RpOptimCleanup PgapackCleanup;
31	extern RpTclOption PgapackOptions;
32
33	static RpOptimPlugin rpOptimPlugins[] = {
34	{"pgapack", PgapackInit, PgapackRun, PgapackCleanup, &PgapackOptions},
35	{NULL, NULL, NULL},
36	};
37
38	typedef struct RpOptimToolData {
39	Tcl_Interp interp; / interp handling this tool */
40	Tcl_Obj toolPtr; / command for tool object */
41	Tcl_Obj updateCmdPtr; / command used to look for abort */
42	} RpOptimToolData;
43
44	/*
45	* ----------------------------------------------------------------------
46	* Options for the various parameter types
47	* ----------------------------------------------------------------------
48	*/
49	RpTclOption rpOptimNumberOpts[] = {
50	{"-min", RP_OPTION_DOUBLE, Rp_Offset(RpOptimParamNumber,min)},
51	{"-max", RP_OPTION_DOUBLE, Rp_Offset(RpOptimParamNumber,max)},
52	{NULL, NULL, 0}
53	};
54
55	RpTclOption rpOptimStringOpts[] = {
56	{"-values", RP_OPTION_LIST, Rp_Offset(RpOptimParamString,values)},
57	{NULL, NULL, 0}
58	};
59
60	static int RpOptimizerCmd _ANSI_ARGS_((ClientData clientData,
61	Tcl_Interp interp, int objc, Tcl_Obj CONST objv[]));
62	static void RpOptimCmdDelete _ANSI_ARGS_((ClientData cdata));
63	static int RpOptimInstanceCmd _ANSI_ARGS_((ClientData clientData,
64	Tcl_Interp interp, int objc, Tcl_Obj CONST objv[]));
65	static RpOptimStatus RpOptimizerPerformInTcl _ANSI_ARGS_((RpOptimEnv *envPtr,
66	RpOptimParam values, int numValues, double fitnessPtr));
67
68	#ifdef BUILD_Rappture
69	__declspec( dllexport )
70	#endif
71
72	extern int pgapack_abort;
73	extern void PGARuntimeDataTableInit();
74	extern void PGARuntimeDataTableDeInit();
75	extern void GetSampleInformation();
76
77	int
78	Rapptureoptimizer_Init(Tcl_Interp interp) / interpreter being initialized */
79	{
80	if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
81	return TCL_ERROR;
82	}
83	if (Tcl_PkgProvide(interp, "RapptureOptimizer", PACKAGE_VERSION)
84	!= TCL_OK) {
85	return TCL_ERROR;
86	}
87
88	Tcl_CreateObjCommand(interp, "::Rappture::optimizer", RpOptimizerCmd,
89	(ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
90
91	return TCL_OK;
92	}
93
94	/*
95	* ------------------------------------------------------------------------
96	* RpOptimizerCmd()
97	*
98	* Invoked whenever someone uses the "optimizer" command to create a
99	* new optimizer context. Handles the following syntax:
100	*
101	* optimizer ?<name>? ?-using <pluginName>?
102	*
103	* Creates a command called <name> that can be used to manipulate
104	* the optimizer context. Returns TCL_OK on success, and TCL_ERROR
105	* (along with an error message in the interpreter) if anything goes
106	* wrong.
107	* ------------------------------------------------------------------------
108	*/
109	static int
110	RpOptimizerCmd(cdata, interp, objc, objv)
111	ClientData cdata; /* not used */
112	Tcl_Interp interp; / interpreter handling this request */
113	int objc; /* number of command line args */
114	Tcl_Obj CONST objv[]; / command line args */
115	{
116	/* use this for auto-generated names */
117	static int autocounter = 0;
118
119	/* use this plugin by default for -using */
120	RpOptimPlugin *usingPluginPtr = &rpOptimPlugins[0];
121
122	/* no good default for the tool being optimized */
123	Tcl_Obj *toolPtr = NULL;
124
125	/* no name for this object by default */
126	char *name = NULL;
127
128	RpOptimEnv* envPtr;
129	RpOptimPlugin* pluginPtr;
130	RpOptimToolData* toolDataPtr;
131
132	int n;
133	char option, autoname[32], sep;
134	Tcl_CmdInfo cmdInfo;
135
136	/*
137	* Make sure that a command with this name doesn't already exist.
138	*/
139	n = 1;
140	if (objc >= 2) {
141	name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
142	if (*name != '-') {
143	if (Tcl_GetCommandInfo(interp, name, &cmdInfo)) {
144	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
145	"command \"", name, "\" already exists",
146	(char*)NULL);
147	return TCL_ERROR;
148	}
149	n++;
150	}
151	}
152
153	/*
154	* Parse the rest of the arguments.
155	*/
156	while (n < objc) {
157	option = Tcl_GetStringFromObj(objv[n], (int*)NULL);
158	if (strcmp(option,"-using") == 0) {
159	if (n+1 >= objc) {
160	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
161	"missing value for option \"", option, "\"",
162	(char*)NULL);
163	return TCL_ERROR;
164	}
165
166	/* search for a plugin with the given name */
167	option = Tcl_GetStringFromObj(objv[n+1], (int*)NULL);
168	for (pluginPtr=rpOptimPlugins; pluginPtr->name; pluginPtr++) {
169	if (strcmp(pluginPtr->name,option) == 0) {
170	break;
171	}
172	}
173	if (pluginPtr->name == NULL) {
174	/* oops! name not recognized */
175	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
176	"bad plugin name \"", option, "\": should be ",
177	(char*)NULL);
178
179	sep = "";
180	for (pluginPtr=rpOptimPlugins; pluginPtr->name; pluginPtr++) {
181	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
182	sep, pluginPtr->name, (char*)NULL);
183	sep = ", ";
184	}
185	return TCL_ERROR;
186	}
187	usingPluginPtr = pluginPtr;
188	n += 2;
189	}
190	else if (strcmp(option,"-tool") == 0) {
191	if (n+1 >= objc) {
192	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
193	"missing value for option \"", option, "\"",
194	(char*)NULL);
195	return TCL_ERROR;
196	}
197	toolPtr = objv[n+1];
198	Tcl_IncrRefCount(toolPtr);
199	n += 2;
200	}
201	else {
202	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
203	"bad option \"", option, "\": should be ",
204	"-tool, -using", (char*)NULL);
205	return TCL_ERROR;
206	}
207	}
208
209	/*
210	* If a name wasn't specified, then auto-generate one.
211	*/
212	while (name == NULL) {
213	sprintf(autoname, "optimizer%d", autocounter++);
214	if (!Tcl_GetCommandInfo(interp, autoname, &cmdInfo)) {
215	name = autoname;
216	}
217	}
218
219	/*
220	* Create an optimizer and install a Tcl command to access it.
221	*/
222	envPtr = RpOptimCreate(usingPluginPtr);
223
224	toolDataPtr = (RpOptimToolData*)malloc(sizeof(RpOptimToolData));
225	toolDataPtr->interp = interp;
226	toolDataPtr->toolPtr = toolPtr;
227	toolDataPtr->updateCmdPtr = NULL;
228	envPtr->toolData = (ClientData)toolDataPtr;
229	Tcl_CreateObjCommand(interp, name, RpOptimInstanceCmd,
230	(ClientData)envPtr, (Tcl_CmdDeleteProc*)RpOptimCmdDelete);
231	Tcl_SetResult(interp, name, TCL_VOLATILE);
232	return TCL_OK;
233	}
234
235	/*
236	* ----------------------------------------------------------------------
237	* RpOptimDelete()
238	*
239	* Called whenever a optimizer object is deleted to clean up after
240	* the command. If the optimizer is running, it is aborted, and
241	* the optimizer is deleted.
242	* ----------------------------------------------------------------------
243	*/
244	static void
245	RpOptimCmdDelete(cdata)
246	ClientData cdata; /* optimizer being deleted */
247	{
248	RpOptimEnv envPtr = (RpOptimEnv)cdata;
249	RpOptimToolData *toolDataPtr;
250	int n;
251	ClientData paramdata;
252
253	PGARuntimeDataTableDeInit();/Free space allocated to data table here/
254	if (envPtr->toolData) {
255	toolDataPtr = (RpOptimToolData*)envPtr->toolData;
256	if (toolDataPtr->toolPtr) {
257	Tcl_DecrRefCount(toolDataPtr->toolPtr);
258	}
259	if (toolDataPtr->updateCmdPtr) {
260	Tcl_DecrRefCount(toolDataPtr->updateCmdPtr);
261	}
262	free(toolDataPtr);
263	envPtr->toolData = NULL;
264	}
265
266	for (n=0; n < envPtr->numParams; n++) {
267	paramdata = (ClientData)envPtr->paramList[n];
268	switch (envPtr->paramList[n]->type) {
269	case RP_OPTIMPARAM_NUMBER:
270	RpTclOptionsCleanup(rpOptimNumberOpts, paramdata);
271	break;
272	case RP_OPTIMPARAM_STRING:
273	RpTclOptionsCleanup(rpOptimStringOpts, paramdata);
274	break;
275	}
276	}
277	RpOptimDelete(envPtr);
278	}
279
280	/*
281	* ------------------------------------------------------------------------
282	* RpOptimInstanceCmd()
283	*
284	* Invoked to handle the actions of an optimizer object. Handles the
285	* following syntax:
286	*
287	* <name> add number <path> ?-min <number>? ?-max <number>?
288	* <name> add string <path> ?-values <valueList>?
289	* <name> get ?<glob>? ?-option?
290	* <name> configure ?-option? ?value -option value ...?
291	* <name> perform ?-tool <tool>? ?-fitness <expr>? \
292	* ?-updatecommand <varName>?
293	* <name> using
294	* <name> samples ?number?
295	*
296	* The "add" command is used to add various parameter types to the
297	* optimizer context. The "perform" command kicks off an optimization
298	* run. The "samples" command displays sample info during an optimization run.
299	* ------------------------------------------------------------------------
300	*/
301	static int
302	RpOptimInstanceCmd(cdata, interp, objc, objv)
303	ClientData cdata; /* optimizer context */
304	Tcl_Interp interp; / interpreter handling this request */
305	int objc; /* number of command line args */
306	Tcl_Obj CONST objv[]; / command line args */
307	{
308	RpOptimEnv* envPtr = (RpOptimEnv*)cdata;
309	RpOptimToolData* toolDataPtr = (RpOptimToolData*)envPtr->toolData;
310
311	int n, j, nvals, nmatches;
312	char option, type, path, fitnessExpr;
313	RpOptimParam *paramPtr;
314	RpOptimParamString *strPtr;
315	RpOptimStatus status;
316	RpTclOption *optSpecPtr;
317	Tcl_Obj rval, rrval, toolPtr, updateCmdPtr;
318
319	if (objc < 2) {
320	Tcl_WrongNumArgs(interp, 1, objv, "option ?args...?");
321	return TCL_ERROR;
322	}
323	option = Tcl_GetStringFromObj(objv[1], (int*)NULL);
324
325	/*
326	* OPTION: add type ?args...?
327	*/
328	if (*option == 'a' && strcmp(option,"add") == 0) {
329	if (objc < 4) {
330	Tcl_WrongNumArgs(interp, 1, objv, "add type path ?args...?");
331	return TCL_ERROR;
332	}
333	type = Tcl_GetStringFromObj(objv[2], (int*)NULL);
334	path = Tcl_GetStringFromObj(objv[3], (int*)NULL);
335
336	/*
337	* OPTION: add number name ?-min num? ?-max num?
338	*/
339	if (*type == 'n' && strcmp(type,"number") == 0) {
340	paramPtr = RpOptimAddParamNumber(envPtr, path);
341	if (RpTclOptionsProcess(interp, objc-4, objv+4,
342	rpOptimNumberOpts, (ClientData)paramPtr) != TCL_OK) {
343	RpOptimDeleteParam(envPtr, path);
344	return TCL_ERROR;
345	}
346	}
347
348	/*
349	* OPTION: add string name ?-values list?
350	*/
351	else if (*type == 's' && strcmp(type,"string") == 0) {
352	paramPtr = RpOptimAddParamString(envPtr, path);
353	if (RpTclOptionsProcess(interp, objc-4, objv+4,
354	rpOptimStringOpts, (ClientData)paramPtr) != TCL_OK) {
355	RpOptimDeleteParam(envPtr, path);
356	return TCL_ERROR;
357	}
358
359	/* list of values just changed -- patch up the count */
360	strPtr = (RpOptimParamString*)paramPtr;
361	for (nvals=0; strPtr->values[nvals]; nvals++)
362	; /* count the values */
363	strPtr->numValues = nvals;
364	}
365	else {
366	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
367	"bad parameter type \"", type, "\": should be number, string",
368	(char*)NULL);
369	return TCL_ERROR;
370	}
371	} else if (*option == 'a' && strcmp(option,"abort") == 0) {
372	int value;
373
374	if (objc < 3) {
375	Tcl_WrongNumArgs(interp, 1, objv, "abort bool");
376	return TCL_ERROR;
377	}
378	if (Tcl_GetBooleanFromObj(interp, objv[2], &value) != TCL_OK) {
379	return TCL_ERROR;
380	}
381	pgapack_abort = value;
382	return TCL_OK;
383	} else if (*option == 'g' && strcmp(option,"get") == 0) {
384	/*
385	* OPTION: get ?globPattern? ?-option?
386	*/
387	if (objc > 2) {
388	path = Tcl_GetStringFromObj(objv[2], (int*)NULL);
389	} else {
390	path = NULL;
391	}
392	if (objc > 3) {
393	option = Tcl_GetStringFromObj(objv[3], (int*)NULL);
394	} else {
395	option = NULL;
396	}
397	if (objc > 4) {
398	Tcl_WrongNumArgs(interp, 1, objv, "get ?pattern? ?-option?");
399	return TCL_ERROR;
400	}
401
402	/* count the number of matches */
403	nmatches = 0;
404	for (n=0; n < envPtr->numParams; n++) {
405	if (path == NULL
406	\|\| Tcl_StringMatch(envPtr->paramList[n]->name,path)) {
407	nmatches++;
408	}
409	}
410
411	rval = Tcl_NewListObj(0,NULL);
412	Tcl_IncrRefCount(rval);
413	for (n=0; n < envPtr->numParams; n++) {
414	if (path == NULL
415	\|\| Tcl_StringMatch(envPtr->paramList[n]->name,path)) {
416
417	rrval = Tcl_NewListObj(0,NULL);
418	Tcl_IncrRefCount(rrval);
419
420	/* add the parameter name as the first element */
421	if (nmatches > 1 \|\| path == NULL) {
422	if (Tcl_ListObjAppendElement(interp, rrval,
423	Tcl_NewStringObj(envPtr->paramList[n]->name,-1))
424	!= TCL_OK) {
425	Tcl_DecrRefCount(rrval);
426	Tcl_DecrRefCount(rval);
427	return TCL_ERROR;
428	}
429	}
430
431	/* get the option specifications for this parameter */
432	switch (envPtr->paramList[n]->type) {
433	case RP_OPTIMPARAM_NUMBER:
434	optSpecPtr = rpOptimNumberOpts;
435	if (option == NULL) {
436	/* no particular option value? then include type */
437	if (Tcl_ListObjAppendElement(interp, rrval,
438	Tcl_NewStringObj("number",-1)) != TCL_OK) {
439	Tcl_DecrRefCount(rrval);
440	Tcl_DecrRefCount(rval);
441	return TCL_ERROR;
442	}
443	}
444	break;
445	case RP_OPTIMPARAM_STRING:
446	optSpecPtr = rpOptimStringOpts;
447	if (option == NULL) {
448	/* no particular option value? then include type */
449	if (Tcl_ListObjAppendElement(interp, rrval,
450	Tcl_NewStringObj("string",-1)) != TCL_OK) {
451	Tcl_DecrRefCount(rrval);
452	Tcl_DecrRefCount(rval);
453	return TCL_ERROR;
454	}
455	}
456	break;
457	default:
458	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
459	"internal error: unrecognized parameter type",
460	" for \"", envPtr->paramList[n]->name,"\"",
461	(char*)NULL);
462	Tcl_DecrRefCount(rrval);
463	Tcl_DecrRefCount(rval);
464	return TCL_ERROR;
465	}
466
467	if (option == NULL) {
468	/* no particular option value */
469	for (j=0; optSpecPtr[j].optname; j++) {
470	char *curOpt = optSpecPtr[j].optname;
471	/* append -option name */
472	if (Tcl_ListObjAppendElement(interp, rrval,
473	Tcl_NewStringObj(curOpt,-1)) != TCL_OK) {
474	Tcl_DecrRefCount(rrval);
475	Tcl_DecrRefCount(rval);
476	return TCL_ERROR;
477	}
478	/* append option value */
479	if (RpTclOptionGet(interp, optSpecPtr,
480	(ClientData)envPtr->paramList[n],
481	optSpecPtr[j].optname) != TCL_OK) {
482	Tcl_DecrRefCount(rrval);
483	Tcl_DecrRefCount(rval);
484	return TCL_ERROR;
485	}
486	if (Tcl_ListObjAppendElement(interp, rrval,
487	Tcl_GetObjResult(interp)) != TCL_OK) {
488	Tcl_DecrRefCount(rrval);
489	Tcl_DecrRefCount(rval);
490	return TCL_ERROR;
491	}
492	}
493	} else {
494	if (RpTclOptionGet(interp, optSpecPtr,
495	(ClientData)envPtr->paramList[n], option) != TCL_OK) {
496	Tcl_DecrRefCount(rrval);
497	Tcl_DecrRefCount(rval);
498	return TCL_ERROR;
499	}
500	if (Tcl_ListObjAppendElement(interp, rrval,
501	Tcl_GetObjResult(interp)) != TCL_OK) {
502	Tcl_DecrRefCount(rrval);
503	Tcl_DecrRefCount(rval);
504	return TCL_ERROR;
505	}
506	}
507	if (Tcl_ListObjAppendElement(interp, rval, rrval) != TCL_OK) {
508	Tcl_DecrRefCount(rrval);
509	Tcl_DecrRefCount(rval);
510	return TCL_ERROR;
511	}
512	Tcl_DecrRefCount(rrval);
513	}
514	}
515
516	if (nmatches == 1) {
517	/* only one result? then return it directly */
518	Tcl_ListObjIndex(interp, rval, 0, &rrval);
519	Tcl_SetObjResult(interp, rrval);
520	} else {
521	/* return a whole list */
522	Tcl_SetObjResult(interp, rval);
523	}
524	Tcl_DecrRefCount(rval);
525	return TCL_OK;
526	}
527
528	/*
529	* OPTION: configure ?-option? ?value -option value ...?
530	*/
531	else if (*option == 'c' && strcmp(option,"configure") == 0) {
532	optSpecPtr = envPtr->pluginDefn->optionSpec;
533	if (objc == 2) {
534	/* report all values: -option val -option val ... */
535
536	rval = Tcl_NewListObj(0,NULL);
537	Tcl_IncrRefCount(rval);
538
539	for (n=0; optSpecPtr[n].optname; n++) {
540	if (RpTclOptionGet(interp, optSpecPtr,
541	(ClientData)envPtr->pluginData,
542	optSpecPtr[n].optname) != TCL_OK) {
543	Tcl_DecrRefCount(rval);
544	return TCL_ERROR;
545	}
546	if (Tcl_ListObjAppendElement(interp, rval,
547	Tcl_NewStringObj(optSpecPtr[n].optname,-1)) != TCL_OK) {
548	Tcl_DecrRefCount(rval);
549	return TCL_ERROR;
550	}
551	if (Tcl_ListObjAppendElement(interp, rval,
552	Tcl_GetObjResult(interp)) != TCL_OK) {
553	Tcl_DecrRefCount(rval);
554	return TCL_ERROR;
555	}
556	}
557	Tcl_SetObjResult(interp, rval);
558	Tcl_DecrRefCount(rval);
559	return TCL_OK;
560	}
561	else if (objc == 3) {
562	/* report the value for just one option */
563	option = Tcl_GetStringFromObj(objv[2], (int*)NULL);
564	return RpTclOptionGet(interp, optSpecPtr,
565	(ClientData)envPtr->pluginData, option);
566	}
567	else {
568	return RpTclOptionsProcess(interp, objc-2, objv+2,
569	optSpecPtr, envPtr->pluginData);
570	}
571	}
572
573	/*
574	* OPTION: perform ?-tool name? ?-fitness expr? ?-updatecommand name?
575	*/
576	else if (*option == 'p' && strcmp(option,"perform") == 0) {
577	/* use this tool by default */
578	toolPtr = toolDataPtr->toolPtr;
579
580	/* no -fitness function by default */
581	fitnessExpr = NULL;
582
583	/* no -updatecommand by default */
584	updateCmdPtr = NULL;
585
586	PGARuntimeDataTableInit(envPtr);/Initialize Data table here..../
587
588	n = 2;
589	while (n < objc) {
590	option = Tcl_GetStringFromObj(objv[n], (int*)NULL);
591	if (n+1 >= objc) {
592	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
593	"missing value for option \"", option, "\"",
594	(char*)NULL);
595	return TCL_ERROR;
596	}
597	if (strcmp(option,"-tool") == 0) {
598	toolPtr = objv[n+1];
599	n += 2;
600	}
601	else if (strcmp(option,"-fitness") == 0) {
602	fitnessExpr = Tcl_GetStringFromObj(objv[n+1], (int*)NULL);
603	n += 2;
604	}
605	else if (strcmp(option,"-updatecommand") == 0) {
606	updateCmdPtr = objv[n+1];
607	n += 2;
608	}
609	else {
610	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
611	"bad option \"", option, "\": should be -fitness, -tool,"
612	" -updatecommand", (char*)NULL);
613	return TCL_ERROR;
614	}
615	}
616
617	/*
618	* Must have a tool object and a fitness function at this point,
619	* or else we don't know what to optimize.
620	*/
621	if (toolPtr == NULL) {
622	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
623	"tool being optimized not specified via -tool option",
624	(char*)NULL);
625	return TCL_ERROR;
626	}
627	if (fitnessExpr == NULL) {
628	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
629	"missing -fitness function for optimization",
630	(char*)NULL);
631	return TCL_ERROR;
632	}
633
634	Tcl_IncrRefCount(toolPtr);
635	if (updateCmdPtr) {
636	Tcl_IncrRefCount(updateCmdPtr);
637	toolDataPtr->updateCmdPtr = updateCmdPtr;
638	}
639
640	/* call the main optimization routine here */
641	status = (*envPtr->pluginDefn->runProc)(envPtr,
642	RpOptimizerPerformInTcl, fitnessExpr);
643
644	fprintf(stderr, ">>>status=%d\n", status);
645
646	Tcl_DecrRefCount(toolPtr);
647	if (updateCmdPtr) {
648	Tcl_DecrRefCount(updateCmdPtr);
649	toolDataPtr->updateCmdPtr = NULL;
650	}
651
652	switch (status) {
653	case RP_OPTIM_SUCCESS:
654	Tcl_SetResult(interp, "success", TCL_STATIC);
655	break;
656	case RP_OPTIM_FAILURE:
657	Tcl_SetResult(interp, "failure", TCL_STATIC);
658	break;
659	case RP_OPTIM_ABORTED:
660	fprintf(stderr, "Got abort status=%d\n", status);
661	Tcl_SetResult(interp, "aborted", TCL_STATIC);
662	break;
663	case RP_OPTIM_UNKNOWN:
664	default:
665	Tcl_SetResult(interp, "???", TCL_STATIC);
666	break;
667	}
668	return TCL_OK;
669	}
670
671	/*
672	* OPTION: using
673	*/
674	else if (*option == 'u' && strcmp(option,"using") == 0) {
675	if (objc > 2) {
676	Tcl_WrongNumArgs(interp, 1, objv, "using");
677	return TCL_ERROR;
678	}
679	Tcl_SetResult(interp, envPtr->pluginDefn->name, TCL_STATIC);
680
681	/* if the -tool was specified, then add it as a second element */
682	toolDataPtr = (RpOptimToolData*)envPtr->toolData;
683	if (toolDataPtr->toolPtr) {
684	Tcl_AppendElement(interp,
685	Tcl_GetStringFromObj(toolDataPtr->toolPtr, (int*)NULL));
686	}
687	return TCL_OK;
688	}
689
690	else if(*option == 's' && strcmp(option,"samples") == 0){
691	int sampleNumber = -1; /initing sampnum to -1, use it when no sample number is specified/
692	char *sampleDataBuffer;
693	if(objc>3){
694	Tcl_WrongNumArgs(interp, 2, objv, "?sampleNumber?");
695	return TCL_ERROR;
696	}
697
698	if(objc == 3){
699	if(Tcl_GetIntFromObj(interp,objv[2],&sampleNumber) != TCL_OK){
700	return TCL_ERROR;
701	}
702	sampleDataBuffer = malloc(sizeof(char)*SINGLE_SAMPLE_DATA_BUFFER_DEFAULT_SIZE);
703	}else{
704	sampleDataBuffer = malloc(sizeof(char)*50);
705	}
706
707	if(sampleDataBuffer == NULL){
708	panic("Error: Could not allocate memory for sample data buffer.");
709	}
710	GetSampleInformation(sampleDataBuffer,sampleNumber);
711	fprintf(stdout,sampleDataBuffer);/*TODO GTG check if this should be fprintf or something else/
712	free(sampleDataBuffer);
713	return TCL_OK;
714
715	}
716
717	else {
718	Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
719	"bad option \"", option, "\": should be add, configure, "
720	"get, perform, using, samples", (char*)NULL);
721	return TCL_ERROR;
722	}
723	return TCL_OK;
724	}
725
726	/*
727	* ------------------------------------------------------------------------
728	* RpOptimizerPerformInTcl()
729	*
730	* Invoked as a call-back within RpOptimPerform() to handle each
731	* optimization run. Launches a run of a Rappture-based tool using
732	* the given values and computes the value for the fitness function.
733	*
734	* Returns RP_OPTIM_SUCCESS if the run was successful, along with
735	* the value in the fitness function in fitnessPtr. If something
736	* goes wrong with the run, it returns RP_OPTIM_FAILURE.
737	* ------------------------------------------------------------------------
738	*/
739	static RpOptimStatus
740	RpOptimizerPerformInTcl(envPtr, values, numValues, fitnessPtr)
741	RpOptimEnv envPtr; / optimization environment */
742	RpOptimParam values; / incoming values for the simulation */
743	int numValues; /* number of incoming values */
744	double fitnessPtr; / returns: computed value of fitness func */
745	{
746	RpOptimStatus result = RP_OPTIM_SUCCESS;
747	Tcl_Obj *xmlObj = NULL;
748	RpOptimToolData toolDataPtr = (RpOptimToolData)envPtr->toolData;
749	Tcl_Interp *interp = toolDataPtr->interp;
750
751	int n, status;
752	#define MAXBUILTIN 10
753	int objc; Tcl_Obj *objv, storage[MAXBUILTIN], *getcmd[3];
754	int rc; Tcl_Obj **rv;
755	Tcl_Obj *dataPtr;
756	Tcl_DString buffer;
757
758	/*
759	* Set up the arguments for a Tcl evaluation.
760	*/
761	objc = 2numValues + 2; / "tool run" + (name value)numValues /
762	if (objc > MAXBUILTIN) {
763	objv = (Tcl_Obj*)malloc(objcsizeof(Tcl_Obj));
764	} else {
765	objv = storage;
766	}
767	objv[0] = toolDataPtr->toolPtr;
768	objv[1] = Tcl_NewStringObj("run",-1); Tcl_IncrRefCount(objv[1]);
769	for (n=0; n < numValues; n++) {
770	objv[2*n+2] = Tcl_NewStringObj(values[n].name, -1);
771	Tcl_IncrRefCount(objv[2*n+2]);
772
773	switch (values[n].type) {
774	case RP_OPTIMPARAM_NUMBER:
775	objv[2*n+3] = Tcl_NewDoubleObj(values[n].value.dval);
776	Tcl_IncrRefCount(objv[2*n+3]);
777	break;
778	case RP_OPTIMPARAM_STRING:
779	objv[2*n+3] = Tcl_NewStringObj(values[n].value.sval.str,-1);
780	Tcl_IncrRefCount(objv[2*n+3]);
781	break;
782	default:
783	panic("bad parameter type in RpOptimizerPerformInTcl()");
784	}
785	}
786
787	/*
788	* Invoke the tool and pick apart its results.
789	*/
790	status = Tcl_EvalObjv(interp, objc, objv, TCL_EVAL_GLOBAL);
791
792	if (status != TCL_OK) {
793	result = RP_OPTIM_FAILURE;
794	fprintf(stderr, "== JOB FAILED: %s\n", Tcl_GetStringResult(interp));
795	} else {
796	dataPtr = Tcl_GetObjResult(interp);
797	/* hang on to this while we pick it apart into rv[] */
798	Tcl_IncrRefCount(dataPtr);
799
800	if (Tcl_ListObjGetElements(interp, dataPtr, &rc, &rv) != TCL_OK) {
801	result = RP_OPTIM_FAILURE;
802	fprintf(stderr, "== JOB FAILED: %s\n", Tcl_GetStringResult(interp));
803	} else if (rc != 2
804	\|\| Tcl_GetIntFromObj(interp, rv[0], &status) != TCL_OK) {
805	result = RP_OPTIM_FAILURE;
806	fprintf(stderr, "== JOB FAILED: malformed result: expected {status output}\n");
807	} else {
808	if (status != 0) {
809	result = RP_OPTIM_FAILURE;
810	fprintf(stderr, "== JOB FAILED with status code %d:\n%s\n",
811	status, Tcl_GetStringFromObj(rv[1], (int*)NULL));
812	} else {
813	/*
814	* Get the output value from the tool output in the
815	* result we just parsed above: {status xmlobj}
816	*
817	* Eventually, we should write a whole parser to
818	* handle arbitrary fitness functions. For now,
819	* just query a single output value by calling:
820	* xmlobj get fitnessExpr
821	*/
822	xmlObj = rv[1];
823	/* hang onto this for -updatecommand below */
824	Tcl_IncrRefCount(xmlObj);
825
826	getcmd[0] = xmlObj;
827	getcmd[1] = Tcl_NewStringObj("get",-1);
828	getcmd[2] = Tcl_NewStringObj(envPtr->fitnessExpr,-1);
829	for (n=0; n < 3; n++) {
830	Tcl_IncrRefCount(getcmd[n]);
831	}
832
833	status = Tcl_EvalObjv(interp, 3, getcmd, TCL_EVAL_GLOBAL);
834
835	if (status != TCL_OK) {
836	result = RP_OPTIM_FAILURE;
837	fprintf(stderr, "== UNEXPECTED ERROR while extracting output value:%s\n", Tcl_GetStringResult(interp));
838	} else if (Tcl_GetDoubleFromObj(interp,
839	Tcl_GetObjResult(interp), fitnessPtr) != TCL_OK) {
840	result = RP_OPTIM_FAILURE;
841	fprintf(stderr, "== ERROR while extracting output value:%s\n", Tcl_GetStringResult(interp));
842	}
843	for (n=0; n < 3; n++) {
844	Tcl_DecrRefCount(getcmd[n]);
845	}
846	}
847	}
848	Tcl_DecrRefCount(dataPtr);
849	}
850
851	/*
852	* Clean up objects created for command invocation.
853	*/
854	for (n=1; n < objc; n++) {
855	Tcl_DecrRefCount(objv[n]);
856	}
857	if (objv != storage) {
858	free(objv);
859	}
860
861	/*
862	* If there's the -updatecommand was specified, execute it here
863	* to bring the application up-to-date and see if the user wants
864	* to abort.
865	*/
866	if (toolDataPtr->updateCmdPtr) {
867	Tcl_DStringInit(&buffer);
868	Tcl_DStringAppend(&buffer,
869	Tcl_GetStringFromObj(toolDataPtr->updateCmdPtr, (int*)NULL), -1);
870	Tcl_DStringAppendElement(&buffer,
871	(xmlObj != NULL) ? Tcl_GetStringFromObj(xmlObj, (int*)NULL): "");
872
873	status = Tcl_GlobalEval(toolDataPtr->interp,
874	Tcl_DStringValue(&buffer));
875	if (status == TCL_ERROR) {
876	Tcl_BackgroundError(toolDataPtr->interp);
877	}
878	Tcl_DStringFree(&buffer);
879	}
880
881	if (xmlObj) {
882	Tcl_DecrRefCount(xmlObj); /* done with this now */
883	}
884	return result;
885	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: