/[ascend]/trunk/tcltk98/generic/interface/ProbeProc.c
ViewVC logotype

Contents of /trunk/tcltk98/generic/interface/ProbeProc.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 389 - (show annotations) (download) (as text)
Thu Mar 30 06:24:10 2006 UTC (16 years, 2 months ago) by johnpye
File MIME type: text/x-csrc
File size: 25306 byte(s)
Cleaning up #includes in the Tcl/Tk interface. Doing this
all as a group so that it can be reversed out if necessary.
1 /*
2 * ProbeProc.c
3 * by Ben Allan
4 * Created: 6/97
5 * Version: $Revision: 1.38 $
6 * Version control file: $RCSfile: ProbeProc.c,v $
7 * Date last modified: $Date: 2003/08/23 18:43:07 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the ASCEND Tcl/Tk interface
11 *
12 * Copyright 1997, Carnegie Mellon University
13 *
14 * The ASCEND Tcl/Tk interface is free software; you can redistribute
15 * it and/or modify it under the terms of the GNU General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
18 *
19 * The ASCEND Tcl/Tk interface is distributed in hope that it will be
20 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 * General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License
25 * along with the program; if not, write to the Free Software Foundation,
26 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27 * COPYING. COPYING is found in ../compiler.
28 */
29
30 #include <tcl.h>
31 #include <utilities/ascConfig.h>
32 #include <utilities/ascPanic.h>
33 #include <utilities/ascMalloc.h>
34 #include <general/list.h>
35 #include <general/dstring.h>
36 #include <compiler/compiler.h>
37 #include <compiler/symtab.h>
38 #include <compiler/instance_enum.h>
39 #include <compiler/fractions.h>
40 #include <compiler/dimen.h>
41 #include <compiler/instquery.h>
42 #include <compiler/visitinst.h>
43 #include <compiler/instance_name.h>
44 #include <compiler/instance_io.h>
45 #include "HelpProc.h"
46 #include "Qlfdid.h"
47 #include "BrowserQuery.h"
48 #include "ProbeProc.h"
49 #include "UnitsProc.h"
50 #include "ProbeProc.h"
51
52 #ifndef lint
53 static CONST char ProbeProcID[] = "$Id: ProbeProc.c,v 1.38 2003/08/23 18:43:07 ballan Exp $";
54 #endif
55
56
57 /*
58 * the number of arguments required to specify a complete filter.
59 */
60 #define NUMFILTERS 16
61
62 #define ENTRYMALLOC \
63 (struct ProbeEntry *)ascmalloc((unsigned)sizeof(struct ProbeEntry))
64
65 /*
66 * In the 0->len-1 indexing, returns the list in position n.
67 * returns NULL for n out of range.
68 */
69 #define ProbeArray(n) GetProbeList(n)
70 /*
71 * return ProbeArray size, or 0 if not initialized.
72 */
73 #define ProbeArraySize ((g_probe_array==NULL) ? 0 : g_probe_array_size)
74 /*
75 * return the attributes of a probe entry pointer
76 */
77 #define ProbeEntryName(e) (e)->name
78 #define ProbeEntryInst(e) (e)->i
79 /*
80 * Fetch an entry pointer, assumes valid num and ind.
81 */
82 #define ProbeGetEntry(num,ind) \
83 (struct ProbeEntry *)gl_fetch(ProbeArray(num),(unsigned long)((ind)+1))
84
85
86 struct ProbeEntry {
87 char *name;
88 /* This is the authoritative data. */
89 struct Instance *i;
90 /* This may be NULL, requiring lookup or deletion per user */
91 };
92
93 struct ProbeFilterFlags {
94 unsigned VisitRelations;
95 unsigned VisitLogRelations;
96 unsigned VisitBooleans;
97 unsigned VisitIntegers;
98 unsigned VisitReals;
99 unsigned VisitSymbols;
100 unsigned VisitSets;
101 unsigned VisitSABooleans;
102 unsigned VisitSAIntegers;
103 unsigned VisitSAReals;
104 unsigned VisitSASymbols;
105 unsigned VisitSASets;
106 unsigned VisitBooleanConstants;
107 unsigned VisitIntegerConstants;
108 unsigned VisitRealConstants;
109 unsigned VisitSymbolConstants;
110 };
111
112 /*
113 * An array of lists we use to track collections. Grown as needed.
114 * not a list because it is too hard to replace list elements.
115 * All elements of this array should always contain
116 * a list, though the list may be empty or change identity.
117 * Eventually, should become an array of userdata, perhaps.
118 */
119 static struct gl_list_t **g_probe_array = NULL;
120 /*
121 * The size of this array. valid entries 0..size-1.
122 */
123 static unsigned g_probe_array_size = 0;
124
125 /*
126 * The instance root while creating names within
127 * a Visit collection of instances.
128 */
129 static struct Instance *g_visit_root = NULL;
130
131 /* The current context for visit consumption.
132 */
133 static struct gl_list_t *g_cur_context = NULL;
134
135 /* The root name for visit consumption.
136 */
137 static char *g_visit_root_name = NULL;
138
139 /* the length of the root name, without ending NULL.
140 */
141 static int g_visit_root_name_len = 0;
142
143 /*
144 * A struct for visit functions to use in selecting object to
145 * add to the collection.
146 */
147 static struct ProbeFilterFlags g_probe_filter;
148
149 /*
150 * Returns, with sanity check, the nth element of the collection array.
151 */
152 static
153 struct gl_list_t *GetProbeList(unsigned int n)
154 {
155 if (g_probe_array == NULL || n >= g_probe_array_size) {
156 return NULL;
157 }
158 return g_probe_array[n];
159 }
160
161 static
162 void InitProbeFilter(struct ProbeFilterFlags *f)
163 {
164 f->VisitRelations =
165 f->VisitLogRelations =
166 f->VisitBooleans =
167 f->VisitIntegers =
168 f->VisitReals =
169 f->VisitSymbols =
170 f->VisitSets =
171 f->VisitSABooleans =
172 f->VisitSAIntegers =
173 f->VisitSAReals =
174 f->VisitSASymbols =
175 f->VisitSASets =
176 f->VisitBooleanConstants =
177 f->VisitIntegerConstants =
178 f->VisitRealConstants =
179 f->VisitSymbolConstants = 0;
180 }
181
182 /*
183 * This function is the source of the positional dependence of
184 * the filter arguments.
185 * low is the index in argv of first flag. argc is the
186 */
187 static
188 void SetupProbeFilter(struct ProbeFilterFlags *f,
189 char **argv,int low,int argc)
190 {
191 int c;
192
193 InitProbeFilter(f);
194 c = low;
195
196 #define SPFGetArg(flag) \
197 if (c<argc && argv[c][0]=='1') { f->flag = 1; } c++
198
199 SPFGetArg(VisitRelations);
200 SPFGetArg(VisitLogRelations);
201 SPFGetArg(VisitBooleans);
202 SPFGetArg(VisitIntegers);
203 SPFGetArg(VisitReals);
204 SPFGetArg(VisitSymbols);
205 SPFGetArg(VisitSets);
206 SPFGetArg(VisitSABooleans);
207 SPFGetArg(VisitSAIntegers);
208 SPFGetArg(VisitSAReals);
209 SPFGetArg(VisitSASymbols);
210 SPFGetArg(VisitSASets);
211 SPFGetArg(VisitBooleanConstants);
212 SPFGetArg(VisitIntegerConstants);
213 SPFGetArg(VisitRealConstants);
214 SPFGetArg(VisitSymbolConstants);
215 #undef SPFGetArg
216 }
217
218
219 /*
220 * mallocs an entry, assigning name and inst. i may be NULL,
221 * but if name is NULL, returns NULL.
222 * The entry owns the name string given.
223 * i may change over the course of the entry's existence.
224 * We may want to make a pool for these if malloc is too slow.
225 */
226 static
227 struct ProbeEntry *ProbeEntryCreate(char *name, struct Instance *i)
228 {
229 struct ProbeEntry *result;
230
231 result = ENTRYMALLOC;
232 if (result==NULL || name == NULL) {
233 /* should ascpanic here */
234 return NULL;
235 }
236 result->name = name;
237 result->i = i;
238 return result;
239 }
240
241 /*
242 * Frees the memory associated with the entry.
243 */
244 static
245 void ProbeEntryDestroy(struct ProbeEntry *e)
246 {
247 if(e!=NULL) {
248 if (e->name != NULL) {
249 ascfree(e->name);
250 } /* very odd if this if fails! */
251 e->name = NULL;
252 e->i = NULL;
253 ascfree(e);
254 }
255 }
256
257 /*
258 * Sets up the global array, and/or expands it by 1 empty list.
259 * returns 0 if ok or 1 if insufficient memory.
260 * Grows only by one.
261 */
262 static
263 int Asc_ProbeArrayGrow()
264 {
265 struct gl_list_t **tmp;
266 if (g_probe_array==NULL) {
267 g_probe_array =
268 (struct gl_list_t **)ascmalloc(sizeof(struct gl_list_t *));
269 if (g_probe_array==NULL) {
270 g_probe_array_size = 0;
271 return 1;
272 }
273 g_probe_array[0] = gl_create(100);
274 if (g_probe_array[0]==NULL) {
275 g_probe_array_size = 0;
276 ascfree(g_probe_array);
277 g_probe_array = NULL;
278 return 1;
279 }
280 g_probe_array_size = 1;
281 } else {
282 tmp = (struct gl_list_t **)ascrealloc(g_probe_array,
283 sizeof(struct gl_list_t *)*(1+g_probe_array_size));
284 if (tmp == NULL) {
285 return 1;
286 }
287 g_probe_array = tmp;
288 g_probe_array[g_probe_array_size] = gl_create(100);
289 if (g_probe_array[g_probe_array_size]==NULL) {
290 return 1;
291 }
292 g_probe_array_size++;
293 }
294 return 0;
295 }
296
297 static
298 void ProbeDeleteAll(struct gl_list_t *p)
299 {
300 struct ProbeEntry *e;
301 unsigned long len,c;
302
303 if (p==NULL) {
304 return;
305 }
306 len = gl_length(p);
307 for (c=1;c<=len;c++) {
308 e = (struct ProbeEntry *)gl_fetch(p,c);
309 ProbeEntryDestroy(e); /* should free e->name, NULL i+name, and free e */
310 }
311 gl_destroy(p);
312 }
313
314 /*
315 * Frees all memory associated with the probe. Should
316 * be called before shutting down the system.
317 */
318 static
319 void Asc_ProbeArrayDestroy(void)
320 {
321 unsigned int c;
322 for (c = 0; c < ProbeArraySize; c++) {
323 ProbeDeleteAll(ProbeArray(c));
324 g_probe_array[c] = NULL;
325 }
326 ascfree(g_probe_array);
327 g_probe_array = NULL;
328 }
329
330 static
331 void ProbeUpdateEntries(struct gl_list_t *p)
332 {
333 unsigned long c,len;
334 int err;
335 struct ProbeEntry *e;
336 if (p != NULL) {
337 len = gl_length(p);
338 for (c=1;c <= len; c++) {
339 e = (struct ProbeEntry *)gl_fetch(p,c);
340 if (ProbeEntryInst(e)==NULL) {
341 err = Asc_QlfdidSearch3(ProbeEntryName(e),0);
342 if (err == 0) {
343 ProbeEntryInst(e) = g_search_inst;
344 }
345 }
346 }
347 }
348 }
349
350 static
351 void ProbeNullInstances(struct gl_list_t *p)
352 {
353 unsigned long c,len;
354 if (p != NULL) {
355 len = gl_length(p);
356 for (c=1;c <= len; c++) {
357 ((struct ProbeEntry *)gl_fetch(p,c))->i = NULL;
358 }
359 }
360 }
361
362 static
363 void NullAllInstancePointers(void)
364 {
365 unsigned c,len;
366 if (g_probe_array != NULL) {
367 len = g_probe_array_size;
368 for (c=0;c < len; c++) {
369 ProbeNullInstances(ProbeArray(c));
370 }
371 }
372 }
373
374 /*
375 * returns -1 if context is invalid.
376 */
377 static
378 int ProbeNumEntries(unsigned int context)
379 {
380 struct gl_list_t *p;
381 if ( context >= g_probe_array_size) {
382 return -1;
383 }
384 p = ProbeArray(context);
385
386 return ((p!=NULL)? (int) gl_length(p) : -1);
387 }
388
389 static
390 void ProbeVisitAll_Filtered(struct Instance *i)
391 {
392 struct ProbeEntry *e1;
393 char *wholename, *nametail;
394 int add=0;
395
396 #define PVAFAdd(flag) add = (g_probe_filter.flag) ? 1 : 0
397 if (i!=NULL) {
398 switch(InstanceKind(i)) {
399 case BOOLEAN_INST:
400 PVAFAdd(VisitSABooleans);
401 break;
402 case BOOLEAN_ATOM_INST:
403 PVAFAdd(VisitBooleans);
404 break;
405 case BOOLEAN_CONSTANT_INST:
406 PVAFAdd(VisitBooleanConstants);
407 break;
408 case INTEGER_INST:
409 PVAFAdd(VisitSAIntegers);
410 break;
411 case INTEGER_ATOM_INST:
412 PVAFAdd(VisitIntegers);
413 break;
414 case INTEGER_CONSTANT_INST:
415 PVAFAdd(VisitIntegerConstants);
416 break;
417 case REAL_INST:
418 PVAFAdd(VisitSAReals);
419 break;
420 case REAL_ATOM_INST:
421 PVAFAdd(VisitReals);
422 break;
423 case REAL_CONSTANT_INST:
424 PVAFAdd(VisitRealConstants);
425 break;
426 case REL_INST:
427 PVAFAdd(VisitRelations);
428 break;
429 case LREL_INST:
430 PVAFAdd(VisitLogRelations);
431 break;
432 case SYMBOL_INST:
433 PVAFAdd(VisitSASymbols);
434 break;
435 case SYMBOL_ATOM_INST:
436 PVAFAdd(VisitSymbols);
437 break;
438 case SYMBOL_CONSTANT_INST:
439 PVAFAdd(VisitSymbolConstants);
440 break;
441 case SET_INST:
442 PVAFAdd(VisitSASets);
443 break;
444 case SET_ATOM_INST:
445 PVAFAdd(VisitSets);
446 break;
447 default:
448 add = 0;
449 break;
450 }
451 if (add) {
452 nametail = WriteInstanceNameString(i,g_visit_root);
453 if (nametail==NULL) { /* out of memory */
454 return;
455 }
456 wholename = (char *)ascmalloc(g_visit_root_name_len +
457 strlen(nametail) + 3);
458 if (wholename ==NULL) {
459 ascfree(nametail);
460 return;
461 }
462 if (IsArrayInstance(g_visit_root)) {
463 sprintf(wholename,"%s%s",g_visit_root_name,nametail);
464 } else {
465 sprintf(wholename,"%s.%s",g_visit_root_name,nametail);
466 }
467 ascfree(nametail);
468 e1 = ProbeEntryCreate(wholename,i);
469 if (e1==NULL) {
470 ascfree(wholename);
471 }
472 gl_append_ptr(g_cur_context,e1);
473 }
474 }
475 }
476
477 /*
478 * Adds the value of the entry passed to it to the interp as an
479 * element, or at least the name if the instance pointer is NULL.
480 * At preseent always returns 0 because it ignores the returns of
481 * functions it calls.
482 */
483 static
484 int AppendEntryItem(Tcl_Interp *interp,struct ProbeEntry *e)
485 {
486 char *name;
487 char *ustr, tmp[1024]; /* not safe for long symbol values at all */
488 struct Instance *i;
489
490 if (e==NULL) {
491 Tcl_AppendElement(interp,"UNDEFINED probe entry");
492 return 0;
493 }
494
495 i = ProbeEntryInst(e);
496 name = ProbeEntryName(e);
497
498 Tcl_AppendResult(interp,"{",(char *)NULL); /* start element */
499 Tcl_AppendResult(interp,name,(char *)NULL); /* append name */
500 if (i==NULL) {
501 Tcl_AppendResult(interp," = UNCERTAIN} ",(char *)NULL);
502 return 0;
503 }
504 switch(InstanceKind(i)) {
505 case REL_INST:
506 case REAL_INST:
507 case REAL_ATOM_INST:
508 case REAL_CONSTANT_INST:
509 ustr = Asc_UnitValue(i);
510 if (ustr!=NULL) {
511 Tcl_AppendResult(interp," = ",ustr,(char *)NULL);
512 } else {
513 Tcl_AppendResult(interp," = ","????",(char *)NULL);
514 }
515 Tcl_AppendResult(interp,"} ",(char *)NULL); /* end REAL */
516 break;
517 case INTEGER_INST:
518 case INTEGER_ATOM_INST:
519 case INTEGER_CONSTANT_INST:
520 case BOOLEAN_INST:
521 case BOOLEAN_CONSTANT_INST:
522 case BOOLEAN_ATOM_INST:
523 case SYMBOL_INST:
524 case SYMBOL_ATOM_INST:
525 case SYMBOL_CONSTANT_INST:
526 case LREL_INST:
527 tmp[0] = '\0';
528 Tcl_AppendResult(interp,tmp," = ",(char *)NULL);
529 (void)Asc_BrowWriteAtomValue(tmp,i);
530 Tcl_AppendResult(interp,tmp,"} ",(char *)NULL); /* end OTHERS */
531 break;
532 default:
533 Tcl_AppendResult(interp,"} ",(char *)NULL); /* end default */
534 break;
535 }
536 return 0;
537 }
538
539 static
540 void ProbeAppendAll(Tcl_Interp *interp, struct gl_list_t *p)
541 {
542 unsigned long c,len;
543 struct ProbeEntry *e;
544 if (p != NULL) {
545 len = gl_length(p);
546 for (c=1;c <= len; c++) {
547 e = (struct ProbeEntry *)gl_fetch(p,c);
548 AppendEntryItem(interp,e);
549 }
550 }
551 }
552
553 /*
554 * This function is alleged to explain the filter flags. it needs
555 * improvement.
556 */
557 static
558 void DefineProbeFilters(Tcl_Interp *interp)
559 {
560 Tcl_AppendElement(interp,"VisitRelations/Collect relations");
561 Tcl_AppendElement(interp,"VisitLogRelations/Collect logical relations");
562 Tcl_AppendElement(interp,"VisitBooleans/Collect booleans");
563 Tcl_AppendElement(interp,"VisitIntegers/Collect integers");
564 Tcl_AppendElement(interp,"VisitReals/Collect reals");
565 Tcl_AppendElement(interp,"VisitSymbols/Collect symbols");
566 Tcl_AppendElement(interp,"VisitSets/Collect sets");
567 Tcl_AppendElement(interp,"VisitSABooleans/Collect subatomic booleans");
568 Tcl_AppendElement(interp,"VisitSAIntegers/Collect subatomic integers");
569 Tcl_AppendElement(interp,"VisitSAReals/Collect subatomic reals");
570 Tcl_AppendElement(interp,"VisitSASymbols/Collect subatomic symbols");
571 Tcl_AppendElement(interp,"VisitSASets/Collect subatomic sets");
572 Tcl_AppendElement(interp,"VisitBooleanConstants/Collect boolean constants");
573 Tcl_AppendElement(interp,"VisitIntegerConstants/Collect integer constants");
574 Tcl_AppendElement(interp,"VisitRealConstants/Collect real constants");
575 Tcl_AppendElement(interp,"VisitSymbolConstants/Collect symbol constants");
576 }
577
578 static
579 void ProbeGarbageCollect(int number)
580 {
581 struct gl_list_t *new, *old;
582 struct ProbeEntry *e;
583 unsigned long c, len;
584 if (number <0 || number > (int)g_probe_array_size) {
585 return;
586 }
587 old = ProbeArray(number);
588 if (old==NULL) {
589 g_probe_array[number] = gl_create(100L);
590 return;
591 }
592 len = gl_length(old);
593 if (len == 0L) {
594 return;
595 }
596 new = gl_create(len);
597 if (new==NULL) {
598 return;
599 }
600 for (c = 1; c <= len; c++) {
601 e = (struct ProbeEntry *)gl_fetch(old,c);
602 if (ProbeEntryInst(e)!=NULL) {
603 gl_append_ptr(new,e);
604 } else {
605 ProbeEntryDestroy(e);
606 }
607 }
608 g_probe_array[number] = new;
609 gl_destroy(old);
610 }
611 /*
612 * macro ParseCollectionNumber assumes int status, char *argv[],
613 * Tcl_Interp *interp , int number, int argc.Forces a return with
614 * an appropriately filled interp if argv[2] is not an int or out of range.
615 * This ugly macro is only for use in Asc_ProbeCmd.
616 * The arg dummy is ignored.
617 * This validates the number.
618 */
619 #define ParseCollectionNumber(dummy) \
620 if (argc <3) { \
621 Tcl_AppendResult(interp, "\nProbe collection number missing ", \
622 argv[0]," ", argv[1],(char *)NULL); \
623 return TCL_ERROR; \
624 } \
625 status = Tcl_GetInt(interp,argv[2],&number); \
626 if (status != TCL_OK) { \
627 Tcl_AppendResult(interp, "\nError in probe collection number ", \
628 argv[0]," ", argv[1]," ", argv[2],(char *)NULL); \
629 return TCL_ERROR; \
630 } \
631 if (number < 0 || number >= (int)ProbeArraySize) { \
632 Tcl_AppendResult(interp, "\nProbe collection number out of range ", \
633 argv[0], " ",argv[1]," ", argv[2],(char *)NULL); \
634 return TCL_ERROR; \
635 }
636
637 /*
638 * macro ParseCollectionIndex assumes int status, char *argv[],
639 * Tcl_Interp *interp , int number, int index, int argc.Forces a return with
640 * an appropriately filled interp if argv[2] is not an int or out of range.
641 * This ugly macro is only for use in Asc_ProbeCmd.
642 * Number is assumed to be a valid collection number.
643 * This validates the index. ndx is the element of argv to be digested.
644 */
645 #define ParseCollectionIndex(number,ndx) \
646 if (argc <4) { \
647 Tcl_AppendResult(interp, "\nProbe collection index missing: ", \
648 argv[0]," ", argv[1]," ", argv[2], (char *)NULL); \
649 return TCL_ERROR; \
650 } \
651 status = Tcl_GetInt(interp,argv[(ndx)],&index); \
652 if (status != TCL_OK) { \
653 Tcl_AppendResult(interp, "\nError in collection index: ", \
654 argv[0]," ", argv[1]," ", argv[2]," ",argv[(ndx)],(char *)NULL); \
655 return TCL_ERROR; \
656 } \
657 if ( index < 0 || \
658 (unsigned long)index >= gl_length(g_probe_array[(number)])) { \
659 Tcl_ResetResult(interp); \
660 Tcl_AppendResult(interp,Asc_ProbeCmdHN," ",argv[1]," ",argv[2]," ", \
661 argv[(ndx)], " : index out of list range.", (char *)NULL); \
662 return TCL_ERROR; \
663 }
664
665 STDHLF(Asc_ProbeCmd,(Asc_ProbeCmdHL1, Asc_ProbeCmdHL2, Asc_ProbeCmdHL3,
666 Asc_ProbeCmdHL4, Asc_ProbeCmdHL5, Asc_ProbeCmdHL6, Asc_ProbeCmdHL7,
667 Asc_ProbeCmdHL8, Asc_ProbeCmdHL9, Asc_ProbeCmdHL10, Asc_ProbeCmdHL11,
668 HLFSTOP));
669
670 int Asc_ProbeCmd(ClientData cdata, Tcl_Interp *interp,
671 int argc, CONST84 char *argv[])
672 {
673 int number, index, status, oldindex, pos;
674 unsigned int size;
675 unsigned long c,len;
676 struct ProbeEntry *e;
677 char buf[MAXIMUM_NUMERIC_LENGTH];
678 char *name;
679 /* newlist may be leftover from a prior early exit. clear it, but not the
680 * data if it is not NULL.
681 * We should never see this leaked at shutdown if the probe has
682 * been destroyed before exiting.
683 */
684 static struct gl_list_t *newlist = NULL, *oldlist;
685
686 if (newlist!=NULL) {
687 gl_destroy(newlist);
688 newlist = NULL;
689 }
690 ASCUSE;
691 if (argc <2) {
692 Asc_HelpGetUsage(interp,Asc_ProbeCmdHN);
693 return TCL_ERROR;
694 };
695 /*
696 * On breaking out of the switch, the function returns tcl_ok.
697 */
698 switch (argv[1][0]) {
699 case 'a': /* add */
700 if (argc<4) {
701 Tcl_AppendResult(interp,"Not enough arguments to ",
702 Asc_ProbeCmdHN," ",argv[1],": need also <number> <instance>",
703 " [filter-list]", (char *)NULL);
704 return TCL_ERROR;
705 }
706 ParseCollectionNumber(0);
707 g_cur_context = ProbeArray(number);
708 status = Asc_QlfdidSearch3(argv[3],0);
709 if (argc ==4) {
710 name = ascstrdup(argv[3]);
711 e = ProbeEntryCreate(name,((status==0) ? g_search_inst : NULL));
712 gl_append_ptr(g_cur_context,e);
713 break;
714 } else {
715 if (status!=0) {
716 Tcl_AppendResult(interp, Asc_ProbeCmdHN," ",argv[1]," ",argv[2],
717 " ",argv[3],": unable to locate ",argv[3]," for search",
718 (char *)NULL);
719 return TCL_ERROR;
720 }
721 }
722 g_visit_root = g_search_inst;
723 if (argc == (4+NUMFILTERS)) {
724 g_visit_root_name = QUIET(argv[3]);
725 g_visit_root_name_len = strlen(argv[3]);
726 SetupProbeFilter(&g_probe_filter,QUIET2(argv),4,argc);
727 VisitInstanceTree(g_visit_root,ProbeVisitAll_Filtered,0,1);
728 } else {
729 sprintf(buf,"%d",NUMFILTERS);
730 Tcl_AppendResult(interp,"Not enough arguments to ",
731 Asc_ProbeCmdHN," ",argv[1]," ",argv[2]," ",argv[3]," [filter-list]: ",
732 "filter-list needs ",buf," boolean values.",(char *)NULL);
733 return TCL_ERROR;
734 }
735 break;
736 case 'c': /* clear */
737 ParseCollectionNumber(0);
738 if (argc==3) { /* clear whole list */
739 ProbeDeleteAll(ProbeArray(number));
740 g_probe_array[number] = gl_create(100L);
741 /* create cannot fail because we just recycled one of those */
742 } else {
743 newlist = gl_create(gl_length(g_probe_array[number]));
744 if (newlist==NULL) {
745 Tcl_ResetResult(interp);
746 Tcl_AppendResult(interp,Asc_ProbeCmdHN," ",argv[1]," ",argv[2],
747 " : not enough memory",(char *)NULL);
748 return TCL_ERROR;
749 }
750 pos = 3;
751 c = 1;
752 oldindex = -1;
753 /* for memory integrity we must copy and delete in separate passes */
754 /* this also traps erroneous user indices automagically + safely */
755 while(pos < argc) { /* copy list, except for the given indices. */
756 ParseCollectionIndex(number,pos);
757 if (index <= oldindex) { /* no duplicates or reversals allowed */
758 gl_destroy(newlist);
759 newlist = NULL;
760 Tcl_ResetResult(interp);
761 Tcl_AppendResult(interp,Asc_ProbeCmdHN," ",argv[1]," ",argv[2],
762 " : index out of order ",argv[pos],(char *)NULL);
763 return TCL_ERROR;
764 }
765 oldindex = index;
766 while(c < (unsigned long)(index+1)) { /* copy up to the next index */
767 gl_append_ptr(newlist,gl_fetch(g_probe_array[number],c));
768 c++;
769 }
770 c++; /* skip the indicated element */
771 pos++; /* next index */
772 }
773 /* copy the list tail after the last deleted entry */
774 oldlist = g_probe_array[number];
775 len = gl_length(oldlist);
776 /* ? c++; */
777 while (c <= len) {
778 gl_append_ptr(newlist,gl_fetch(oldlist,c));
779 c++;
780 }
781 /* destroy the indicated entries of the old list and swap in new one */
782 pos = 3;
783 c = 1;
784 while(pos < argc) { /* copy list, except for the given indices. */
785 ParseCollectionIndex(number,pos);
786 ProbeEntryDestroy(ProbeGetEntry(number,index));
787 pos++;
788 }
789 g_probe_array[number] = newlist;
790 newlist = NULL;
791 gl_destroy(oldlist);
792 }
793 break;
794 case 'd': /* destroy */
795 Asc_ProbeArrayDestroy();
796 break;
797 case 'e': /* expand */
798 if (argc!=2) {
799 Tcl_AppendResult(interp,"Too many arguments to ",
800 Asc_ProbeCmdHN," ",argv[1],(char *)NULL);
801 return TCL_ERROR;
802 }
803 if (Asc_ProbeArrayGrow()) {
804 Tcl_AppendResult(interp,"Insufficient memory to ",
805 argv[0]," ",argv[1],(char *)NULL);
806 return TCL_ERROR;
807 }
808 sprintf(buf,"%u",ProbeArraySize-1);
809 Tcl_AppendResult(interp,buf,(char *)NULL);
810 break;
811 case 'f': /* filter */
812 DefineProbeFilters(interp);
813 break;
814 case 'g': /* get */
815 ParseCollectionNumber(0);
816 if (argc==3) {
817 /* get whole list */
818 ProbeAppendAll(interp,ProbeArray(number));
819 } else {
820 /* get the given indices. */
821 pos = 3;
822 while(pos < argc) {
823 ParseCollectionIndex(number,pos);
824 AppendEntryItem(interp,ProbeGetEntry(number,index));
825 pos++; /* next index */
826 }
827 }
828 break;
829 case 'i': /* invalidate */
830 NullAllInstancePointers();
831 break;
832 case 'n': /* name */
833 if (argc!=4) {
834 Tcl_AppendResult(interp,Asc_ProbeCmdHN," ",argv[1]," <number> <index>",
835 (char *)NULL);
836 return TCL_ERROR;
837 }
838 ParseCollectionNumber(0);
839 ParseCollectionIndex(number,3);
840 Tcl_AppendResult(interp,ProbeEntryName(ProbeGetEntry(number,index)),
841 (char *)NULL);
842 break;
843 case 'q': /* qlfdid */
844 if (argc!=4) {
845 Tcl_AppendResult(interp,Asc_ProbeCmdHN," ",argv[1]," <number> <index>",
846 (char *)NULL);
847 return TCL_ERROR;
848 }
849 ParseCollectionNumber(0);
850 ParseCollectionIndex(number,3);
851 g_relative_inst = g_search_inst =
852 ProbeEntryInst(ProbeGetEntry(number,index));
853 if (g_search_inst==NULL) {
854 Tcl_AppendResult(interp,"0",(char *)NULL);
855 } else {
856 Tcl_AppendResult(interp,"1",(char *)NULL);
857 }
858 break;
859 case 's': /* size */
860 /*
861 * size of probe array or of one list in it.
862 */
863 if (argc==2) {
864 sprintf(buf,"%u",ProbeArraySize);
865 Tcl_AppendResult(interp,buf,(char *)NULL);
866 } else {
867 ParseCollectionNumber(0);
868 size = ProbeNumEntries(number);
869 sprintf(buf,"%d",size);
870 Tcl_AppendResult(interp,buf,(char *)NULL);
871 }
872 break;
873 case 't': /* trash */
874 if (argc>3) {
875 Tcl_AppendResult(interp,"Too many arguments to ",
876 Asc_ProbeCmdHN," ",argv[1],(char *)NULL);
877 return TCL_ERROR;
878 }
879 if (argc==2) { /* garbage collect all */
880 for (number = 0; number < (int)g_probe_array_size; number++) {
881 ProbeGarbageCollect(number);
882 }
883 } else {
884 ParseCollectionNumber(0);
885 ProbeGarbageCollect(number);
886 }
887 break;
888 case 'u': /* update */
889 if (argc>3) {
890 Tcl_AppendResult(interp,"Too many arguments to ",
891 Asc_ProbeCmdHN," ",argv[1],(char *)NULL);
892 return TCL_ERROR;
893 }
894 if (argc==2) { /* garbage collect all */
895 for (number = 0; number < (int)g_probe_array_size; number++) {
896 ProbeUpdateEntries(ProbeArray(number));
897 }
898 } else {
899 ParseCollectionNumber(0);
900 ProbeUpdateEntries(ProbeArray(number));
901 }
902 break;
903 default:
904 Asc_HelpGetUsage(interp,Asc_ProbeCmdHN);
905 return TCL_ERROR;
906 }
907 #undef ParseCollectionIndex
908 #undef ParseCollectionNumber
909 return TCL_OK;
910 }
911

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22