Context Navigation

source: trunk/optimizer/src/rp_optimizer_tcl.c @ 903

Last change on this file since 903 was 903, checked in by mmc, 16 years ago

Final tweaks on the optimization package. The demo now works properly.
Just run "wish simple.tcl" to see it work.

Fixed the Tool class to work better with the optimizer. The "run"
method now returns the result directly as a Rappture::Library object,
and the Analyzer merely loads the object.

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

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

Download in other formats: