source: branches/blt4/lang/tcl/src/RpRusage.c @ 2170

Last change on this file since 2170 was 2170, checked in by gah, 11 years ago
File size: 12.5 KB
Line 
1/*
2 * ----------------------------------------------------------------------
3 *  Rappture::rusage
4 *
5 *  This is an interface to the system getrusage() routine.  It allows
6 *  you to query resource used by child executables.  We use this in
7 *  Rappture to track the usage during each click of the "Simulate"
8 *  button.
9 * ======================================================================
10 *  AUTHOR:  Michael McLennan, Purdue University
11 *  Copyright (c) 2004-2006  Purdue Research Foundation
12 *
13 *  See the file "license.terms" for information on usage and
14 *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15 * ======================================================================
16 */
17#include <tcl.h>
18#include <string.h>
19#ifndef WIN32
20#include <sys/time.h>
21#include <sys/resource.h>
22#else
23#include "RpWinResource.h"
24#endif
25
26#include "RpOp.h"
27
28/*
29 * Store rusage info in this data structure:
30 */
31typedef struct RpRusageStats {
32    struct timeval times;
33    struct rusage resources;
34} RpRusageStats;
35
36static RpRusageStats RpRusage_Start;      /* time at start of program */
37
38static Tcl_ObjCmdProc RpRusageCmd;
39static Tcl_ObjCmdProc RpRusageForgetOp;
40static Tcl_ObjCmdProc RpRusageMarkOp;
41static Tcl_ObjCmdProc RpRusageMeasureOp;
42
43static int RpRusageCapture _ANSI_ARGS_((Tcl_Interp *interp,
44    RpRusageStats *rptr));
45static double RpRusageTimeDiff _ANSI_ARGS_((struct timeval *currptr,
46    struct timeval *prevptr));
47static void RpDestroyMarkNames _ANSI_ARGS_((ClientData cdata,
48    Tcl_Interp *interp));
49
50/*
51 * rusage subcommands:
52 */
53static Rp_OpSpec rusageOps[] = {
54    {"forget", 1, RpRusageForgetOp, 2, 0, "?name...?",},
55    {"mark",    2, RpRusageMarkOp, 2, 3, "?name?",},
56    {"measure", 2, RpRusageMeasureOp, 2, 3, "?name?",},
57};
58static int nRusageOps = sizeof(rusageOps) / sizeof(Rp_OpSpec);
59
60/*
61 * ------------------------------------------------------------------------
62 *  RpRusage_Init()
63 *
64 *  Called in Rappture_Init() to initialize the commands defined
65 *  in this file.
66 * ------------------------------------------------------------------------
67 */
68int
69RpRusage_Init(interp)
70    Tcl_Interp *interp;  /* interpreter being initialized */
71{
72    Tcl_HashTable *markNamesPtr;
73
74    Tcl_CreateObjCommand(interp, "::Rappture::rusage", RpRusageCmd,
75        NULL, NULL);
76
77    /* set up a hash table for different mark names */
78    markNamesPtr = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
79    Tcl_InitHashTable(markNamesPtr, TCL_STRING_KEYS);
80
81    Tcl_SetAssocData(interp, "RpRusageMarks",
82        RpDestroyMarkNames, (ClientData)markNamesPtr);
83
84    /* capture the starting time for this program */
85    if (RpRusageCapture(interp, &RpRusage_Start) != TCL_OK) {
86        return TCL_ERROR;
87    }
88
89    /* set an initial "global" mark automatically */
90    if (RpRusageMarkOp(NULL, interp, 0, (Tcl_Obj**)NULL) != TCL_OK) {
91        return TCL_ERROR;
92    }
93
94    return TCL_OK;
95}
96
97/*
98 * ------------------------------------------------------------------------
99 *  RpRusageCmd()
100 *
101 *  Invoked whenever someone uses the "rusage" command to get/set
102 *  limits for child processes.  Handles the following syntax:
103 *
104 *      rusage mark
105 *      rusage measure
106 *
107 *  Returns TCL_OK on success, and TCL_ERROR (along with an error
108 *  message in the interpreter) if anything goes wrong.
109 * ------------------------------------------------------------------------
110 */
111static int
112RpRusageCmd(cdata, interp, objc, objv)
113    ClientData cdata;         /* not used */
114    Tcl_Interp *interp;       /* interpreter handling this request */
115    int objc;                 /* number of command line args */
116    Tcl_Obj *const *objv;     /* strings for command line args */
117{
118    Tcl_ObjCmdProc *proc;
119
120    proc = Rp_GetOpFromObj(interp, nRusageOps, rusageOps, RP_OP_ARG1,
121        objc, objv, 0);
122
123    if (proc == NULL) {
124        return TCL_ERROR;
125    }
126    return (*proc)(cdata, interp, objc, objv);
127}
128
129/*
130 * ------------------------------------------------------------------------
131 *  RpRusageMarkOp()
132 *
133 *  Invoked whenever someone uses the "rusage mark" command to mark
134 *  the start of an execution.  Handles the following syntax:
135 *
136 *      rusage mark ?name?
137 *
138 *  Returns TCL_OK on success, and TCL_ERROR (along with an error
139 *  message in the interpreter) if anything goes wrong.
140 * ------------------------------------------------------------------------
141 */
142static int
143RpRusageMarkOp(cdata, interp, objc, objv)
144    ClientData cdata;         /* not used */
145    Tcl_Interp *interp;       /* interpreter handling this request */
146    int objc;                 /* number of command line args */
147    Tcl_Obj *const *objv;     /* strings for command line args */
148{
149    char *markName;
150    Tcl_HashTable *markNamesPtr;
151    Tcl_HashEntry *entryPtr;
152    int newEntry;
153    RpRusageStats *markPtr;
154
155    markNamesPtr = (Tcl_HashTable *)
156        Tcl_GetAssocData(interp, "RpRusageMarks", NULL);
157
158    markName = (objc > 2) ? Tcl_GetString(objv[2]): "global";
159    entryPtr = Tcl_CreateHashEntry(markNamesPtr, markName, &newEntry);
160    if (newEntry) {
161        markPtr = (RpRusageStats*)ckalloc(sizeof(RpRusageStats));
162        Tcl_SetHashValue(entryPtr, (ClientData)markPtr);
163    } else {
164        markPtr = (RpRusageStats*)Tcl_GetHashValue(entryPtr);
165    }
166
167    return RpRusageCapture(interp, markPtr);
168}
169
170/*
171 * ------------------------------------------------------------------------
172 *  RpRusageMeasureOp()
173 *
174 *  Invoked whenever someone uses the "rusage measure" command to
175 *  measure resource usage since the last "mark" operation.  Handles
176 *  the following syntax:
177 *
178 *      rusage measure ?name?
179 *
180 *  Returns TCL_OK on success, and TCL_ERROR (along with an error
181 *  message in the interpreter) if anything goes wrong.
182 * ------------------------------------------------------------------------
183 */
184static int
185RpRusageMeasureOp(cdata, interp, objc, objv)
186    ClientData cdata;         /* not used */
187    Tcl_Interp *interp;       /* interpreter handling this request */
188    int objc;                 /* number of command line args */
189    Tcl_Obj *const *objv;     /* strings for command line args */
190{
191    char *markName;
192    Tcl_HashTable *markNamesPtr;
193    Tcl_HashEntry *entryPtr;
194    RpRusageStats *markPtr;
195    double tval;
196    RpRusageStats curstats;
197    Tcl_Obj *listObjPtr, *objPtr;
198
199    if (RpRusageCapture(interp, &curstats) != TCL_OK) {
200        return TCL_ERROR;
201    }
202
203    markNamesPtr = (Tcl_HashTable *)
204        Tcl_GetAssocData(interp, "RpRusageMarks", NULL);
205
206    markName = (objc > 2) ? Tcl_GetString(objv[2]): "global";
207    entryPtr = Tcl_FindHashEntry(markNamesPtr, markName);
208    if (entryPtr == NULL) {
209        Tcl_AppendResult(interp, "mark \"", markName,
210            "\" doesn't exist", NULL);
211        return TCL_ERROR;
212    }
213    markPtr = (RpRusageStats*)Tcl_GetHashValue(entryPtr);
214
215    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
216    /*
217     * Compute: START TIME
218     */
219    objPtr = Tcl_NewStringObj("start", 5);
220    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
221    tval = RpRusageTimeDiff(&markPtr->times, &RpRusage_Start.times);
222    objPtr = Tcl_NewDoubleObj(tval);
223    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
224
225    /*
226     * Compute: WALL TIME
227     */
228    objPtr = Tcl_NewStringObj("walltime", 8);
229    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
230    tval = RpRusageTimeDiff(&curstats.times, &markPtr->times);
231    objPtr = Tcl_NewDoubleObj(tval);
232    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
233
234
235    /*
236     * Compute: CPU TIME = user time + system time
237     */
238    objPtr = Tcl_NewStringObj("cputime", 7);
239    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
240    tval = RpRusageTimeDiff(&curstats.resources.ru_utime,
241             &markPtr->resources.ru_utime)
242         + RpRusageTimeDiff(&curstats.resources.ru_stime,
243             &markPtr->resources.ru_stime);
244    objPtr = Tcl_NewDoubleObj(tval);
245    Tcl_ListObjAppendElement(interp, listObjPtr, objPtr);
246    Tcl_SetObjResult(interp, listObjPtr);
247    return TCL_OK;
248}
249
250/*
251 * ------------------------------------------------------------------------
252 *  RpRusageForgetOp()
253 *
254 *  Invoked whenever someone uses the "rusage forget" command to release
255 *  information previous set by "rusage mark".  With no args, it releases
256 *  all known marks; otherwise, it releases just the specified mark
257 *  names.  This isn't usually needed, but if a program creates thousands
258 *  of marks, this gives a way to avoid a huge memory leak.
259 *  Handles the following syntax:
260 *
261 *      rusage forget ?name name...?
262 *
263 *  Returns TCL_OK on success, and TCL_ERROR (along with an error
264 *  message in the interpreter) if anything goes wrong.
265 * ------------------------------------------------------------------------
266 */
267static int
268RpRusageForgetOp(cdata, interp, objc, objv)
269    ClientData cdata;         /* not used */
270    Tcl_Interp *interp;       /* interpreter handling this request */
271    int objc;                 /* number of command line args */
272    Tcl_Obj *const *objv;     /* strings for command line args */
273{
274    int i;
275    char *markName;
276    Tcl_HashTable *markNamesPtr;
277    Tcl_HashEntry *entryPtr;
278    Tcl_HashSearch search;
279
280    markNamesPtr = (Tcl_HashTable *)
281        Tcl_GetAssocData(interp, "RpRusageMarks", NULL);
282
283    /*
284     * No args? Then clear all entries in the hash table.
285     */
286    if (objc == 2) {
287        for (entryPtr = Tcl_FirstHashEntry(markNamesPtr, &search);
288             entryPtr != NULL;
289             entryPtr = Tcl_NextHashEntry(&search)) {
290            ckfree((char *)Tcl_GetHashValue(entryPtr));
291        }
292        Tcl_DeleteHashTable(markNamesPtr);
293        Tcl_InitHashTable(markNamesPtr, TCL_STRING_KEYS);
294    }
295
296    /*
297     * Otherwise, delete only the specified marks.  Be forgiving.
298     * If a mark isn't recognized, ignore it.
299     */
300    else {
301        for (i=2; i < objc; i++) {
302            markName = Tcl_GetString(objv[i]);
303            entryPtr = Tcl_FindHashEntry(markNamesPtr, markName);
304            if (entryPtr) {
305                ckfree((char *)Tcl_GetHashValue(entryPtr));
306                Tcl_DeleteHashEntry(entryPtr);
307            }
308        }
309    }
310    return TCL_OK;
311}
312
313/*
314 * ------------------------------------------------------------------------
315 *  RpRusageCapture()
316 *
317 *  Used internally to capture a snapshot of current time and resource
318 *  usage.  Stores the stats in the given data structure.
319 *
320 *  Returns TCL_OK on success, and TCL_ERROR (along with an error
321 *  message in the interpreter) if anything goes wrong.
322 * ------------------------------------------------------------------------
323 */
324static int
325RpRusageCapture(interp, rptr)
326    Tcl_Interp *interp;       /* interpreter handling this request */
327    RpRusageStats *rptr;      /* returns: snapshot of stats */
328{
329    int status;
330
331    status = getrusage(RUSAGE_CHILDREN, &rptr->resources);
332    if (status != 0) {
333        Tcl_AppendResult(interp, "unexpected error from getrusage()",
334            (char*)NULL);
335        return TCL_ERROR;
336    }
337
338    status = gettimeofday(&rptr->times, (struct timezone*)NULL);
339    if (status != 0) {
340        Tcl_AppendResult(interp, "unexpected error from gettimeofday()",
341            (char*)NULL);
342        return TCL_ERROR;
343    }
344
345    return TCL_OK;
346}
347
348/*
349 * ------------------------------------------------------------------------
350 *  RpRusageTimeDiff()
351 *
352 *  Used internally to compute the difference between two timeval
353 *  structures.  Returns a double precision value representing the
354 *  time difference.
355 * ------------------------------------------------------------------------
356 */
357static double
358RpRusageTimeDiff(currptr, prevptr)
359    struct timeval *currptr;  /* current time */
360    struct timeval *prevptr;  /*  - previous time */
361{
362    double tval;
363
364    if (prevptr) {
365        tval = (currptr->tv_sec - prevptr->tv_sec)
366                 + 1.0e-6*(currptr->tv_usec - prevptr->tv_usec);
367    } else {
368        tval = currptr->tv_sec + 1.0e-6*currptr->tv_usec;
369    }
370    return tval;
371}
372
373/*
374 * ------------------------------------------------------------------------
375 *  RpDestroyMarkNames()
376 *
377 *  Used internally to clean up the marker names when the interpreter
378 *  that owns them is being destroyed.
379 * ------------------------------------------------------------------------
380 */
381static void
382RpDestroyMarkNames(cdata, interp)
383    ClientData cdata;         /* data being destroyed */
384    Tcl_Interp *interp;       /* interpreter that owned the data */
385{
386    Tcl_HashTable *markNamesPtr;
387    Tcl_HashEntry *entryPtr;
388    Tcl_HashSearch search;
389
390    for (entryPtr=Tcl_FirstHashEntry(markNamesPtr, &search);
391         entryPtr != NULL;
392         entryPtr = Tcl_NextHashEntry(&search)) {
393        ckfree( (char*)Tcl_GetHashValue(entryPtr) );
394    }
395    Tcl_DeleteHashTable(markNamesPtr);
396    ckfree((char*)markNamesPtr);
397}
Note: See TracBrowser for help on using the repository browser.