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

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

Improved the Rappture optimization API to include Tcl bindings.
Added standard build/test stuff for Tcl libraries. Created a
plugin hook for optimization libraries like pgapack. The plugin
support still needs some work.
File size: 18.9 KB
RevLine 
[897]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;
28RpOptimCleanup PgapackCleanup;
29extern RpTclOption PgapackOptions;
30
31static RpOptimPlugin rpOptimPlugins[] = {
32    {"pgapack", PgapackInit, PgapackCleanup, &PgapackOptions},
33    {NULL, NULL, NULL},
34};
35
36typedef struct RpOptimPluginData {
37    RpOptimPlugin *pluginDefn;      /* points back to plugin definition */
38    ClientData clientData;          /* data needed for particular plugin */
39} RpOptimPluginData;
40
41/*
42 * ----------------------------------------------------------------------
43 *  Options for the various parameter types
44 * ----------------------------------------------------------------------
45 */
46RpTclOption rpOptimNumberOpts[] = {
47  {"-min", RP_OPTION_DOUBLE, NULL, Rp_Offset(RpOptimParamNumber,min)},
48  {"-max", RP_OPTION_DOUBLE, NULL, Rp_Offset(RpOptimParamNumber,max)},
49  {NULL, NULL, NULL, 0}
50};
51
52RpTclOption rpOptimStringOpts[] = {
53  {"-values", RP_OPTION_LIST, NULL, Rp_Offset(RpOptimParamString,values)},
54  {NULL, NULL, NULL, 0}
55};
56
57static int RpOptimizerCmd _ANSI_ARGS_((ClientData clientData,
58    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
59static void RpOptimCmdDelete _ANSI_ARGS_((ClientData cdata));
60static int RpOptimInstanceCmd _ANSI_ARGS_((ClientData clientData,
61    Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
62static void RpOptimInstanceCleanup _ANSI_ARGS_((ClientData cdata));
63
64#ifdef BUILD_Rappture
65__declspec( dllexport )
66#endif
67
68int
69Rapptureoptimizer_Init(Tcl_Interp *interp)   /* interpreter being initialized */
70{
71    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
72        return TCL_ERROR;
73    }
74    if (Tcl_PkgProvide(interp, "RapptureOptimizer", PACKAGE_VERSION)
75          != TCL_OK) {
76        return TCL_ERROR;
77    }
78
79    Tcl_CreateObjCommand(interp, "::Rappture::optimizer", RpOptimizerCmd,
80        (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
81
82    return TCL_OK;
83}
84
85/*
86 * ------------------------------------------------------------------------
87 *  RpOptimizerCmd()
88 *
89 *  Invoked whenever someone uses the "optimizer" command to create a
90 *  new optimizer context.  Handles the following syntax:
91 *
92 *      optimizer ?<name>? ?-using <pluginName>?
93 *
94 *  Creates a command called <name> that can be used to manipulate
95 *  the optimizer context.  Returns TCL_OK on success, and TCL_ERROR
96 *  (along with an error message in the interpreter) if anything goes
97 *  wrong.
98 * ------------------------------------------------------------------------
99 */
100static int
101RpOptimizerCmd(cdata, interp, objc, objv)
102    ClientData cdata;         /* not used */
103    Tcl_Interp *interp;       /* interpreter handling this request */
104    int objc;                 /* number of command line args */
105    Tcl_Obj *CONST objv[];    /* command line args */
106{
107    /* use this for auto-generated names */
108    static int autocounter = 0;
109
110    /* use this plugin by default for -using */
111    RpOptimPlugin *usingPluginPtr = &rpOptimPlugins[0];
112
113    char *name = NULL;
114
115    RpOptimEnv* envPtr;
116    RpOptimPlugin* pluginPtr;
117    RpOptimPluginData* pluginDataPtr;
118    int n;
119    char *option, autoname[32], *sep;
120    Tcl_CmdInfo cmdInfo;
121
122    /*
123     * Make sure that a command with this name doesn't already exist.
124     */
125    n = 1;
126    if (objc >= 2) {
127        name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
128        if (*name != '-') {
129            if (Tcl_GetCommandInfo(interp, name, &cmdInfo)) {
130                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
131                    "command \"", name, "\" already exists",
132                    (char*)NULL);
133                return TCL_ERROR;
134            }
135            n++;
136        }
137    }
138
139    /*
140     * Parse the rest of the arguments.
141     */
142    while (n < objc) {
143        option = Tcl_GetStringFromObj(objv[n], (int*)NULL);
144        if (strcmp(option,"-using") == 0) {
145            if (n+1 >= objc) {
146                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
147                    "missing value for option \"", option, "\"",
148                    (char*)NULL);
149                return TCL_ERROR;
150            }
151
152            /* search for a plugin with the given name */
153            option = Tcl_GetStringFromObj(objv[n+1], (int*)NULL);
154            for (pluginPtr=rpOptimPlugins; pluginPtr->name; pluginPtr++) {
155                if (strcmp(pluginPtr->name,option) == 0) {
156                    break;
157                }
158            }
159            if (pluginPtr->name == NULL) {
160                /* oops! name not recognized */
161                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
162                    "bad plugin name \"", option, "\": should be ",
163                    (char*)NULL);
164
165                sep = "";
166                for (pluginPtr=rpOptimPlugins; pluginPtr->name; pluginPtr++) {
167                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
168                        sep, pluginPtr->name, (char*)NULL);
169                    sep = ", ";
170                }
171                return TCL_ERROR;
172            }
173            usingPluginPtr = pluginPtr;
174            n += 2;
175        }
176        else {
177            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
178                "bad option \"", option, "\": should be ",
179                "-using", (char*)NULL);
180            return TCL_ERROR;
181        }
182    }
183
184    /*
185     * If a name wasn't specified, then auto-generate one.
186     */
187    while (name == NULL) {
188        sprintf(autoname, "optimizer%d", autocounter++);
189        if (!Tcl_GetCommandInfo(interp, autoname, &cmdInfo)) {
190            name = autoname;
191        }
192    }
193
194    /*
195     * Create an optimizer and install a Tcl command to access it.
196     */
197    pluginDataPtr = (RpOptimPluginData*)malloc(sizeof(RpOptimPluginData));
198    pluginDataPtr->pluginDefn = usingPluginPtr;
199    pluginDataPtr->clientData = NULL;
200    if (usingPluginPtr->initPtr) {
201        pluginDataPtr->clientData = (*usingPluginPtr->initPtr)();
202    }
203    envPtr = RpOptimCreate((ClientData)pluginDataPtr, RpOptimInstanceCleanup);
204
205    Tcl_CreateObjCommand(interp, name, RpOptimInstanceCmd,
206        (ClientData)envPtr, (Tcl_CmdDeleteProc*)RpOptimCmdDelete);
207
208    Tcl_SetResult(interp, name, TCL_VOLATILE);
209    return TCL_OK;
210}
211
212/*
213 * ----------------------------------------------------------------------
214 * RpOptimDelete()
215 *
216 * Called whenever a optimizer object is deleted to clean up after
217 * the command.  If the optimizer is running, it is aborted, and
218 * the optimizer is deleted.
219 * ----------------------------------------------------------------------
220 */
221static void
222RpOptimCmdDelete(cdata)
223    ClientData cdata;   /* optimizer being deleted */
224{
225    RpOptimEnv *envPtr = (RpOptimEnv*)cdata;
226    int n;
227    ClientData paramdata;
228
229    for (n=0; n < envPtr->numParams; n++) {
230        paramdata = (ClientData)envPtr->paramList[n];
231        switch (envPtr->paramList[n]->type) {
232        case RP_OPTIMPARAM_NUMBER:
233            RpTclOptionsCleanup(rpOptimNumberOpts, paramdata);
234            break;
235        case RP_OPTIMPARAM_STRING:
236            RpTclOptionsCleanup(rpOptimStringOpts, paramdata);
237            break;
238        }
239    }
240    RpOptimDelete(envPtr);
241}
242
243/*
244 * ------------------------------------------------------------------------
245 *  RpOptimInstanceCmd()
246 *
247 *  Invoked to handle the actions of an optimizer object.  Handles the
248 *  following syntax:
249 *
250 *      <name> add number <path> ?-min <number>? ?-max <number>?
251 *      <name> add string <path> ?-values <valueList>?
252 *      <name> get ?<glob>? ?-option?
253 *      <name> configure ?-option? ?value -option value ...?
254 *      <name> perform ?-maxruns <num>? ?-abortvar <varName>?
255 *
256 *  The "add" command is used to add various parameter types to the
257 *  optimizer context.  The "perform" command kicks off an optimization
258 *  run.
259 * ------------------------------------------------------------------------
260 */
261static int
262RpOptimInstanceCmd(cdata, interp, objc, objv)
263    ClientData cdata;         /* optimizer context */
264    Tcl_Interp *interp;       /* interpreter handling this request */
265    int objc;                 /* number of command line args */
266    Tcl_Obj *CONST objv[];    /* command line args */
267{
268    RpOptimEnv* envPtr = (RpOptimEnv*)cdata;
269    RpOptimPluginData* pluginDataPtr = (RpOptimPluginData*)envPtr->pluginData;
270
271    int n, j, nmatches;
272    char *option, *type, *path;
273    RpOptimParam *paramPtr;
274    RpTclOption *optSpecPtr;
275    Tcl_Obj *rval, *rrval;
276
277    if (objc < 2) {
278        Tcl_WrongNumArgs(interp, 1, objv, "option ?args...?");
279        return TCL_ERROR;
280    }
281    option = Tcl_GetStringFromObj(objv[1], (int*)NULL);
282
283    /*
284     * OPTION:  add type ?args...?
285     */
286    if (*option == 'a' && strcmp(option,"add") == 0) {
287        if (objc < 4) {
288            Tcl_WrongNumArgs(interp, 1, objv, "add type path ?args...?");
289            return TCL_ERROR;
290        }
291        type = Tcl_GetStringFromObj(objv[2], (int*)NULL);
292        path = Tcl_GetStringFromObj(objv[3], (int*)NULL);
293
294        /*
295         * OPTION:  add number name ?-min num? ?-max num?
296         */
297        if (*type == 'n' && strcmp(type,"number") == 0) {
298            paramPtr = RpOptimAddParamNumber(envPtr, path);
299            if (RpTclOptionsProcess(interp, objc-4, objv+4,
300                  rpOptimNumberOpts, (ClientData)paramPtr) != TCL_OK) {
301                RpOptimDeleteParam(envPtr, path);
302                return TCL_ERROR;
303            }
304        }
305
306        /*
307         * OPTION:  add string name ?-values list?
308         */
309        else if (*type == 's' && strcmp(type,"string") == 0) {
310            paramPtr = RpOptimAddParamString(envPtr, path);
311            if (RpTclOptionsProcess(interp, objc-4, objv+4,
312                  rpOptimStringOpts, (ClientData)paramPtr) != TCL_OK) {
313                RpOptimDeleteParam(envPtr, path);
314                return TCL_ERROR;
315            }
316        }
317        else {
318            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
319                "bad parameter type \"", type, "\": should be number, string",
320                (char*)NULL);
321            return TCL_ERROR;
322        }
323    }
324
325    /*
326     * OPTION:  get ?globPattern? ?-option?
327     */
328    else if (*option == 'g' && strcmp(option,"get") == 0) {
329        if (objc > 2) {
330            path = Tcl_GetStringFromObj(objv[2], (int*)NULL);
331        } else {
332            path = NULL;
333        }
334        if (objc > 3) {
335            option = Tcl_GetStringFromObj(objv[3], (int*)NULL);
336        } else {
337            option = NULL;
338        }
339        if (objc > 4) {
340            Tcl_WrongNumArgs(interp, 1, objv, "get ?pattern? ?-option?");
341            return TCL_ERROR;
342        }
343
344        /* count the number of matches */
345        nmatches = 0;
346        for (n=0; n < envPtr->numParams; n++) {
347            if (path == NULL
348                  || Tcl_StringMatch(envPtr->paramList[n]->name,path)) {
349                nmatches++;
350            }
351        }
352
353        rval = Tcl_NewListObj(0,NULL);
354        Tcl_IncrRefCount(rval);
355        for (n=0; n < envPtr->numParams; n++) {
356            if (path == NULL
357                  || Tcl_StringMatch(envPtr->paramList[n]->name,path)) {
358
359                rrval = Tcl_NewListObj(0,NULL);
360                Tcl_IncrRefCount(rrval);
361
362                /* add the parameter name as the first element */
363                if (nmatches > 1 || path == NULL) {
364                    if (Tcl_ListObjAppendElement(interp, rrval,
365                          Tcl_NewStringObj(envPtr->paramList[n]->name,-1))
366                          != TCL_OK) {
367                        Tcl_DecrRefCount(rrval);
368                        Tcl_DecrRefCount(rval);
369                        return TCL_ERROR;
370                    }
371                }
372
373                /* get the option specifications for this parameter */
374                switch (envPtr->paramList[n]->type) {
375                case RP_OPTIMPARAM_NUMBER:
376                    optSpecPtr = rpOptimNumberOpts;
377                    break;
378                case RP_OPTIMPARAM_STRING:
379                    optSpecPtr = rpOptimStringOpts;
380                    break;
381                default:
382                    Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
383                        "internal error: unrecognized parameter type",
384                        " for \"", envPtr->paramList[n]->name,"\"",
385                        (char*)NULL);
386                    Tcl_DecrRefCount(rrval);
387                    Tcl_DecrRefCount(rval);
388                    return TCL_ERROR;
389                }
390
391                if (option == NULL) {
392                    /* no particular option value */
393                    for (j=0; optSpecPtr[j].optname; j++) {
394                        char *curOpt = optSpecPtr[j].optname;
395                        /* append -option name */
396                        if (Tcl_ListObjAppendElement(interp, rrval,
397                              Tcl_NewStringObj(curOpt,-1)) != TCL_OK) {
398                            Tcl_DecrRefCount(rrval);
399                            Tcl_DecrRefCount(rval);
400                            return TCL_ERROR;
401                        }
402                        /* append option value */
403                        if (RpTclOptionGet(interp, optSpecPtr,
404                            (ClientData)envPtr->paramList[n],
405                            optSpecPtr[j].optname) != TCL_OK) {
406                            Tcl_DecrRefCount(rrval);
407                            Tcl_DecrRefCount(rval);
408                            return TCL_ERROR;
409                        }
410                        if (Tcl_ListObjAppendElement(interp, rrval,
411                              Tcl_GetObjResult(interp)) != TCL_OK) {
412                            Tcl_DecrRefCount(rrval);
413                            Tcl_DecrRefCount(rval);
414                            return TCL_ERROR;
415                        }
416                    }
417                } else {
418                    if (RpTclOptionGet(interp, optSpecPtr,
419                        (ClientData)envPtr->paramList[n], option) != TCL_OK) {
420                        Tcl_DecrRefCount(rrval);
421                        Tcl_DecrRefCount(rval);
422                        return TCL_ERROR;
423                    }
424                    if (Tcl_ListObjAppendElement(interp, rrval,
425                          Tcl_GetObjResult(interp)) != TCL_OK) {
426                        Tcl_DecrRefCount(rrval);
427                        Tcl_DecrRefCount(rval);
428                        return TCL_ERROR;
429                    }
430                }
431                if (Tcl_ListObjAppendElement(interp, rval, rrval) != TCL_OK) {
432                    Tcl_DecrRefCount(rrval);
433                    Tcl_DecrRefCount(rval);
434                    return TCL_ERROR;
435                }
436                Tcl_DecrRefCount(rrval);
437            }
438        }
439
440        if (nmatches == 1) {
441            /* only one result? then return it directly */
442            Tcl_ListObjIndex(interp, rval, 0, &rrval);
443            Tcl_SetObjResult(interp, rrval);
444        } else {
445            /* return a whole list */
446            Tcl_SetObjResult(interp, rval);
447        }
448        Tcl_DecrRefCount(rval);
449        return TCL_OK;
450    }
451
452    /*
453     * OPTION:  configure ?-option? ?value -option value ...?
454     */
455    else if (*option == 'c' && strcmp(option,"configure") == 0) {
456        optSpecPtr = pluginDataPtr->pluginDefn->optionSpec;
457        if (objc == 2) {
458            /* report all values: -option val -option val ... */
459
460            rval = Tcl_NewListObj(0,NULL);
461            Tcl_IncrRefCount(rval);
462
463            for (n=0; optSpecPtr[n].optname; n++) {
464                if (RpTclOptionGet(interp, optSpecPtr,
465                    (ClientData)pluginDataPtr->clientData,
466                    optSpecPtr[n].optname) != TCL_OK) {
467                    Tcl_DecrRefCount(rval);
468                    return TCL_ERROR;
469                }
470                if (Tcl_ListObjAppendElement(interp, rval,
471                      Tcl_NewStringObj(optSpecPtr[n].optname,-1)) != TCL_OK) {
472                    Tcl_DecrRefCount(rval);
473                    return TCL_ERROR;
474                }
475                if (Tcl_ListObjAppendElement(interp, rval,
476                      Tcl_GetObjResult(interp)) != TCL_OK) {
477                    Tcl_DecrRefCount(rval);
478                    return TCL_ERROR;
479                }
480            }
481            Tcl_SetObjResult(interp, rval);
482            Tcl_DecrRefCount(rval);
483            return TCL_OK;
484        }
485        else if (objc == 3) {
486            /* report the value for just one option */
487            option = Tcl_GetStringFromObj(objv[2], (int*)NULL);
488            return RpTclOptionGet(interp, optSpecPtr,
489                (ClientData)pluginDataPtr->clientData, option);
490        }
491        else {
492            return RpTclOptionsProcess(interp, objc-2, objv+2,
493                optSpecPtr, pluginDataPtr->clientData);
494        }
495    }
496
497    /*
498     * OPTION:  perform ?-maxruns num? ?-abortvar name?
499     */
500    else if (*option == 'p' && strcmp(option,"perform") == 0) {
501    }
502
503    else {
504        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
505            "bad option \"", option, "\": should be add, perform",
506            (char*)NULL);
507        return TCL_ERROR;
508    }
509    return TCL_OK;
510}
511
512/*
513 * ----------------------------------------------------------------------
514 * RpOptimInstanceCleanup()
515 *
516 * Called whenever a optimizer environment is being delete to clean
517 * up any plugin data associated with it.  It's a little convoluted.
518 * Here's the sequence:  A Tcl command is deleted, RpOptimCmdDelete()
519 * gets called to clean it up, RpOptimDelete() is called within that,
520 * and this method gets called to clean up the client data associated
521 * with the underlying environment.
522 * ----------------------------------------------------------------------
523 */
524static void
525RpOptimInstanceCleanup(cdata)
526    ClientData cdata;   /* plugin data being deleted */
527{
528    RpOptimPluginData *pluginDataPtr = (RpOptimPluginData*)cdata;
529
530    /* if there are config options, clean them up first */
531    if (pluginDataPtr->pluginDefn->optionSpec) {
532        RpTclOptionsCleanup(pluginDataPtr->pluginDefn->optionSpec,
533            pluginDataPtr->clientData);
534    }
535
536    /* call a specialized cleanup routine to handle the rest */
537    if (pluginDataPtr->pluginDefn->cleanupPtr) {
538        (*pluginDataPtr->pluginDefn->cleanupPtr)(pluginDataPtr->clientData);
539    }
540    pluginDataPtr->clientData = NULL;
541
542    /* free the container */
543    free((char*)pluginDataPtr);
544}
Note: See TracBrowser for help on using the repository browser.