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

Last change on this file since 898 was 898, checked in by mmc, 15 years ago

Optimization part is getting better. Fleshed out the plug-in for
PGApack, and integrated a first cut that includes the data handling.

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