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

Contents of /trunk/tcltk98/generic/interface/BrowserDag.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: 55359 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 * BrowserDag.c
3 * by Kirk Abbott and Ben Allan
4 * Created: 1/94
5 * Version: $Revision: 1.15 $
6 * Version control file: $RCSfile: BrowserDag.c,v $
7 * Date last modified: $Date: 2003/08/23 18:43:04 $
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
31 #include <tcl.h>
32 #include <tk.h>
33 #include <utilities/ascConfig.h>
34 #include <utilities/ascMalloc.h>
35 #include <general/list.h>
36 #include <compiler/instance_enum.h>
37 #include <solver/var.h>
38 #include <solver/rel.h>
39 #include <solver/slv_client.h>
40 #include "BrowserQuery.h"
41 #include "BrowserDag.h"
42 #include <general/mathmacros.h>
43
44 #ifndef lint
45 static CONST char BrowserDagID[] = "$Id: BrowserDag.c,v 1.15 2003/08/23 18:43:04 ballan Exp $";
46 #endif
47
48
49 /* OLD */
50 /*
51 *
52 * This is the original version of the code.
53 * It may be going away soon.
54 *
55 */
56 static Tcl_Interp *local_interp = NULL;
57 static struct InstanceName global_name;
58
59 int BrowWriteName_ToInterp(Tcl_Interp *interp,
60 CONST struct InstanceName *rec)
61 {
62 char tmp[256];
63 switch(InstanceNameType(*rec)) {
64 case IntArrayIndex:
65 sprintf(tmp,"[%ld]",InstanceIntIndex(*rec));
66 Tcl_AppendResult(interp,tmp,(char *)NULL);
67 break;
68 case StrArrayIndex:
69 sprintf(tmp,"'%s'",InstanceStrIndex(*rec));
70 Tcl_AppendResult(interp,tmp,(char *)NULL);
71 break;
72 case StrName:
73 Tcl_AppendResult(interp,InstanceNameStr(*rec),(char *)NULL);
74 break;
75 }
76 return TCL_OK;
77 }
78
79
80 void BrowSpecialVisitTree(struct Instance *inst)
81 {
82 unsigned long nch,c;
83 struct InstanceName childname;
84 struct Instance *child;
85 if (inst) {
86 nch = NumberChildren(inst);
87 switch(InstanceKind(inst)) {
88 case ARRAY_ENUM_INST:
89 case ARRAY_INT_INST:
90 if (BrowIsAtomicArray(inst)||(BrowIsRelation(inst))) {
91 break;
92 }
93 /* fall through */
94 case MODEL_INST:
95 Tcl_AppendResult(local_interp,"{",(char *)NULL); /* write name */
96 (void)BrowWriteName_ToInterp(local_interp,&global_name);
97 if (nch) {
98 Tcl_AppendResult(local_interp," {",(char *)NULL);
99 for (c=1;c<=nch;c++) {
100 child = InstanceChild(inst,c);
101 if (child) {
102 if (!BrowIsAtomicArray(child) && !BrowIsRelation(child)) {
103 childname = ChildName(inst,c);
104 (void)BrowWriteName_ToInterp(local_interp,&childname);
105 }
106 Tcl_AppendResult(local_interp," ",(char *)NULL);
107 }
108 }
109 Tcl_AppendResult(local_interp,"}} ",(char *)NULL);
110 }
111 break;
112 default:
113 break;
114 }
115 for(c=1;c<=nch;c++) {
116 if (child = InstanceChild(inst,c)) {
117 global_name = ChildName(inst,c);
118 BrowSpecialVisitTree(child);
119 } else {
120 FPRINTF(stderr,"Null instance in tree ???\n");
121 }
122 }
123 }
124 }
125
126
127 int Asc_BrowTreeListCmd(ClientData cdata, Tcl_Interp *interp,
128 int argc, CONST84 char *argv[])
129 {
130 struct Instance *i;
131 struct gl_list_t *list;
132 if ( argc != 3 ) {
133 Tcl_SetResult(interp,
134 "wrong # args: Usage __brow_tree_list ?current?search name",
135 TCL_STATIC);
136 return TCL_ERROR;
137 }
138 if (strncmp(argv[1],"current",3)==0) {
139 i = g_curinst;
140 } else {
141 i = g_search_inst;
142 }
143 if (!i) {
144 Tcl_SetResult(interp, "requested instance is NULL", TCL_STATIC);
145 return TCL_ERROR;
146 }
147 local_interp = interp;
148 SetInstanceNameStrPtr(global_name,argv[2]);
149 SetInstanceNameType(global_name,StrName);
150 BrowSpecialVisitTree(i);
151 local_interp = NULL;
152 return TCL_OK;
153 }
154
155
156 /* NEW */
157 /*
158 * BrowTree Commands.
159 * This is the new version of the code. It kicks out
160 * copy numbers. It may replace the original verion
161 * of the code.
162 */
163
164 #define AVG_PARENTS 2
165 #define AVG_CHILDREN 4
166 #define AVG_RELATIONS 15
167 #define AVG_GROWTH 2
168 #define PART_THRESHOLD 1000
169
170 /*
171 * Global Data.
172 * g_dagdata is the main structure. It is static permanent
173 * structure to facilitate, multiple queries of the data.
174 * It must firt be prepared, and then later shutdown to
175 * free whatever memory is associated with it.
176 */
177
178 enum DagVisitSequence {
179 v_df_bu = 0, /* depth first bottom up */
180 v_df_td, /* depth first top down */
181 v_bf_bu, /* breadth first bottom up */
182 v_bf_td /* breadth first top down */
183 };
184
185 enum PartitionMethod {
186 p_clusterup = 0, /* bottom up clustering */
187 p_clusterdown, /* top down clustering */
188 p_bisection, /* as the name says */
189 p_kwaypart /* k-way partitioning */
190 };
191
192
193 struct DagData {
194 struct gl_list_t *instances;
195 struct gl_list_t *models;
196 struct gl_list_t *relations;
197 struct gl_list_t *counts;
198 struct gl_list_t *partitions;
199 struct gl_list_t *tears;
200 unsigned long threshold;
201 unsigned long last_used_index; /* index of last partition seen */
202 enum DagVisitSequence visit;
203 enum PartitionMethod p_method;
204 int initialized;
205 };
206
207 static struct DagData g_dagdata_reset = {
208 NULL, /* instances */
209 NULL, /* models */
210 NULL, /* relations */
211 NULL, /* counts */
212 NULL, /* partitions */
213 NULL, /* tears */
214 0, /* threshold */
215 1, /* index */
216 v_df_bu, /* this is the default visit sequence */
217 p_clusterup, /* default partitioning */
218 0 /* intialized */
219 };
220
221 static struct DagData g_dagdata;
222
223 struct SlvModel {
224 struct Instance *instance;
225 unsigned long index;
226 unsigned long level;
227 unsigned long local;
228 unsigned long subtree;
229 unsigned long partition;
230 struct gl_list_t *parents; /* a list of parents */
231 struct gl_list_t *children;
232 struct gl_list_t *relations; /* a list of lists of relations */
233 };
234
235 static struct SlvModel *CreateSlvModel(void)
236 {
237 struct SlvModel *result;
238
239 result = (struct SlvModel *)ascmalloc(sizeof(struct SlvModel));
240 result->instance = NULL;
241 result->index = 0;
242 result->level = 0;
243 result->local = 0;
244 result->subtree = 0;
245 result->partition = 1; /* the default partition */
246 result->parents = gl_create(AVG_PARENTS);
247 result->children = gl_create(AVG_CHILDREN);
248 result->relations = gl_create(AVG_GROWTH);
249 return result;
250 }
251
252 static
253 void DestroySlvModel(struct SlvModel *model)
254 {
255 unsigned long len,c;
256 struct gl_list_t *tmp;
257
258 if (!model) {
259 return;
260 }
261 if (model->parents) {
262 gl_destroy(model->parents);
263 }
264 if (model->children) {
265 if (gl_length(model->children)==0) {
266 DoSlvModel_BreakPoint();
267 }
268 gl_destroy(model->children);
269 }
270 if (model->relations) {
271 len = gl_length(model->relations);
272 for (c=1;c<=len;c++) {
273 tmp = (struct gl_list_t *)gl_fetch(model->relations,c);
274 gl_destroy(tmp);
275 }
276 gl_destroy(model->relations);
277 }
278 ascfree((char *)model);
279 return;
280 }
281
282 static
283 void DestroyModelList(struct gl_list_t *models)
284 {
285 unsigned long len,c;
286 struct SlvModel *model;
287
288 if (!models) {
289 return;
290 }
291 len = gl_length(models);
292 for (c=1;c<=len;c++) {
293 model = (struct SlvModel *)gl_fetch(models,c);
294 DestroySlvModel(model);
295 }
296 gl_destroy(models);
297 }
298
299 static
300 void ResetDagData(void)
301 {
302 g_dagdata = g_dagdata_reset; /* structure assignment */
303 }
304
305 static
306 void DestroyDagData(void)
307 {
308 unsigned long len,c;
309 struct SlvModel *model;
310
311 if (g_dagdata.instances) {
312 gl_destroy(g_dagdata.instances);
313 g_dagdata.instances = NULL;
314 }
315
316 if (g_dagdata.models) {
317 DestroyModelList(g_dagdata.models);
318 g_dagdata.models = NULL;
319 }
320
321 if (g_dagdata.relations) {
322 gl_destroy(g_dagdata.relations);
323 g_dagdata.relations = NULL;
324 }
325
326 if (g_dagdata.counts) {
327 gl_destroy(g_dagdata.counts);
328 }
329 ResetDagData();
330 }
331
332
333 /*
334 * This code is here for debugging purposes only.
335 */
336 int DoSlvModel_BreakPoint(void)
337 {
338 return 1;
339 }
340
341 /*
342 *********************************************************************
343 * CountRelations
344 *
345 * The next few functions are concerned with the counting of relations.
346 * Some of these functions run of the original instance structure,
347 * whilst others work off the SolverModel.
348 *********************************************************************
349 */
350
351 /*
352 * Given an instance, which is assumed to be able to respond to
353 * a NumberChildren query, this function will count the number of
354 * relations associated with instance. It is recursive as, a given
355 * model instance has ownership of relations in a number of ways.
356 * 1) a REL_INST may be a direct child of the model.
357 * 2) the REL_INST may be a child of an array, (or multiply dimensioned
358 * array, which is the child of the model.
359 *
360 * CountLocalRelations__ is used by CountLocalRelations, which returns
361 * a list of counts foreach model in an instance list.
362 */
363 static
364 void CountLocalRelations__(struct Instance *inst, unsigned long *count)
365 {
366 struct Instance *child;
367 unsigned long nch,c;
368
369 if (!inst) {
370 return;
371 }
372 nch = NumberChildren(inst);
373 for (c=1;c<=nch;c++) {
374 child = InstanceChild(inst,c);
375 if (!child) {
376 continue;
377 }
378 switch (InstanceKind(child)) {
379 case REL_INST:
380 (*count)++;
381 break;
382 case ARRAY_ENUM_INST:
383 case ARRAY_INT_INST:
384 if (BrowIsRelation(child)) { /* an array of relations */
385 CountLocalRelations__(child,count);
386 }
387 break;
388 default:
389 break;
390 }
391 }
392 }
393
394
395 /*
396 * Creates and returns a list of relation counts for each
397 * instance on the given list. Uses the primitive CountLocalRelations__
398 */
399 static
400 struct gl_list_t *CountLocalRelations(struct gl_list_t *inst_list)
401 {
402 struct gl_list_t *list;
403 struct Instance *inst;
404 unsigned long len,c;
405 unsigned long count;
406 unsigned long total = 0; /* KAA_DEBUG */
407
408 len = gl_length(inst_list);
409 list = gl_create(len);
410 for (c=1;c<=len;c++) {
411 count = 0;
412 inst = (struct Instance *)gl_fetch(inst_list,c);
413 CountLocalRelations__(inst,&count);
414 gl_append_ptr(list,(char *)count); /* assumes pointer == unsigned long */
415 total += count;
416 }
417 FPRINTF(stderr,"Found %lu relations\n",total);
418 return list;
419 }
420
421 /*
422 * This function is very similar to CountLocalRelations, but
423 * appends each relation found to the given rellist. It has
424 * been made a separate function for efficiency, HOWEVER
425 * they perhaps be rationalized; any one who simply wants a
426 * count simply builds the list and then queries the length.
427 * I WILL CLEAN THIS UP LATER.
428 */
429 static
430 void CollectLocalRelations(struct Instance *inst,
431 struct gl_list_t *rellist)
432 {
433 struct Instance *child;
434 unsigned long nch,c;
435
436 if (!inst) {
437 return;
438 }
439 nch = NumberChildren(inst);
440 for (c=1;c<=nch;c++) {
441 child = InstanceChild(inst,c);
442 if (!child) {
443 continue;
444 }
445 switch (InstanceKind(child)) {
446 case REL_INST:
447 gl_append_ptr(rellist,(char *)child);
448 break;
449 case ARRAY_ENUM_INST:
450 case ARRAY_INT_INST:
451 if (BrowIsRelation(child)) { /* an array of relations */
452 CollectLocalRelations(child,rellist);
453 }
454 break;
455 default:
456 break;
457 }
458 }
459 }
460
461
462 /*
463 * These functions are tot be used when the model tree has already been
464 * built, and the local relations have been filled in.
465 */
466
467 static
468 unsigned long CountRelnsInList_Fast(struct gl_list_t *models,
469 unsigned long start,
470 unsigned long end)
471 {
472 struct SlvModel *model;
473 unsigned long c;
474 unsigned long total = 0L;
475
476 for (c=start;c<=end;c++) {
477 model = (struct SlvModel *)gl_fetch(models,c);
478 total += model->local;
479 }
480 return total;
481 }
482
483
484
485 /*
486 *********************************************************************
487 * Auxiliary Functions
488 *
489 * The next few functions are auxiliary functions that may be applied
490 * to a tree/list of solver models. These include
491 * 1) Labelling levels in the tree.
492 * 2) Counting aliased variables.
493 * 3) RemovingAliasing using different heuristics.
494 * 4) Tree Reorienting routines.
495 *********************************************************************
496 */
497 static
498 void LabelLevels(struct SlvModel *root, int *level)
499 {
500 struct SlvModel *modchild;
501 unsigned long nch,c;
502
503 if (!root) {
504 return;
505 }
506 nch = gl_length(root->children);
507 if (nch) {
508 (*level)++;
509 for (c=1;c<=nch;c++) {
510 modchild = (struct SlvModel *)gl_fetch(root->children,c);
511 LabelLevels(modchild,level);
512 }
513 (*level)--;
514 } else {
515 root->level = MAX(root->level,*level);
516 }
517 }
518
519 /*
520 * This function returns :
521 * 1 if p1 has *less* children than p2
522 * -1 if p2 has *more* children than p1
523 * 0 if equal.
524 */
525 int ReorientCriteria_1(void *p1, void *p2)
526 {
527 struct SlvModel *child1 = (struct SlvModel *)p1;
528 struct SlvModel *child2 = (struct SlvModel *)p2;
529
530 if (gl_length(child1->children) < gl_length(child2->children)) {
531 return 1;
532 } else if (gl_length(child1->children) > gl_length(child2->children)) {
533 return -1;
534 } else {
535 return 0;
536 }
537 }
538
539 /*
540 * This function attempts to reorient a SlvModel tree, such
541 * that nodes with more children appear before nodes with less
542 * children.
543 *
544 * NOTE: After calling this function, anyone with references to
545 * models in the tree *will* still have valid references.
546 * However the indexing, whether bottom up or top down or breadth first
547 * rather than depth first will be messed up. The tree then will need
548 * to be reindexed.
549 */
550 static
551 void ReorientTree(struct SlvModel *root)
552 {
553 struct SlvModel *child;
554 unsigned long len,c;
555
556 if (!root) {
557 return;
558 }
559 gl_sort(root->children,(CmpFunc)ReorientCriteria_1);
560 len = gl_length(root->children);
561 for (c=1;c<=len;c++) {
562 child = (struct SlvModel *)gl_fetch(root->children,c);
563 ReorientTree(child);
564 }
565 }
566
567 /*
568 * This fuction should be called before any of the Indexing functions are
569 * called. Otherwise, later code will die. The reason is simple:
570 * the indexing code depends upon unique labeling; we use the label of 0,
571 * to find out if a node has been visited or not. If the labeling gets
572 * messed up (in particular if we end up with a label greater than
573 * the length of the original list, then the PostFixup code will choke.
574 */
575 static
576 void ResetModelTree(struct gl_list_t *models)
577 {
578 struct SlvModel *model;
579 unsigned long len,c;
580
581 len = gl_length(models);
582 for (c=1;c<=len;c++) {
583 model = (struct SlvModel *)gl_fetch(models,c);
584 model->index = 0;
585 }
586 }
587
588 /*
589 * This function does a Depth First Bottom up indexing of the model tree.
590 * Because we may have aliasing in the tree, we need to see if a node has
591 * been visited before we index it. This function thus assumes that all
592 * the indexes in the tree have been reset to 0. A nonzero index means
593 * that the node has already been visited, so that we dont reindex it.
594 */
595 static
596 void IndexTreeDF_BottomUp(struct SlvModel *model, unsigned long *index)
597 {
598 struct SlvModel *child;
599 unsigned long nch,c;
600
601 if (!model) {
602 return;
603 }
604 nch = gl_length(model->children);
605 for (c=1;c<=nch;c++) {
606 child = (struct SlvModel *)gl_fetch(model->children,c);
607 IndexTreeDF_BottomUp(child,index);
608 }
609 if (!model->index) { /* do the visitation check */
610 model->index = (*index)++; /* index the node */
611 }
612 }
613
614 /*
615 * This function does a Depth First Top Down indexing
616 * of the model tree. See the comments regarding aliasing
617 * for IndexTreeDF_BottomUp.
618 */
619 static
620 void IndexTreeDF_TopDown(struct SlvModel *model, unsigned long *index)
621 {
622 struct SlvModel *child;
623 unsigned long nch,c;
624
625 if (!model) {
626 return;
627 }
628 nch = gl_length(model->children);
629 if (!model->index) { /* do the visitation check */
630 model->index = (*index)++;
631 }
632 for (c=1;c<=nch;c++) {
633 child = (struct SlvModel *)gl_fetch(model->children,c);
634 IndexTreeDF_TopDown(child,index);
635 }
636 }
637
638 static
639 void IndexTree(struct SlvModel *model, enum DagVisitSequence visit)
640 {
641 unsigned long index = 1;
642 switch (visit) {
643 case v_df_bu:
644 case v_bf_bu:
645 IndexTreeDF_BottomUp(model,&index);
646 break;
647 case v_df_td:
648 case v_bf_td:
649 IndexTreeDF_TopDown(model,&index);
650 break;
651 default:
652 FPRINTF(stderr,"Unknown visit sequence\n");
653 return;
654 }
655 }
656
657 static
658 void PostIndexingFixup(struct SlvModel *root,
659 struct gl_list_t *models)
660 {
661 struct SlvModel *child;
662 unsigned long nch,c;
663
664 if (!root) {
665 return;
666 }
667 nch = gl_length(root->children);
668 for (c=1;c<=nch;c++) {
669 child = (struct SlvModel *)gl_fetch(root->children,c);
670 /*
671 assert((child->index >=1) && (child->index <= gl_length(models)));
672 */
673 if ((child->index < 1) || (child->index > gl_length(models))) {
674 FPRINTF(stderr,"Corrupted data in PostIndexingFixup at %lu\n",c);
675 continue;
676 }
677 gl_store(models,child->index,(char *)child);
678 PostIndexingFixup(child,models);
679 }
680 }
681
682 /*
683 *********************************************************************
684 * Partitioning Routines
685 *
686 * Partitions are simply a list of relations. By storing the start
687 * and end models, which maintain the relation information we have
688 * enough information to define a partition.
689
690 * This code uses a list of Solver Models and attempts to create
691 * partitions of relations. A number of different partitioning
692 * algorithms may be used.
693 *
694 * 1) PartitionBU_1 -- by doing a special ordering of the model nodes
695 * we simply run accumulator over the number of local relations.
696 * We mark of partitions as we pass some threshold value. This
697 * is essentially a stack of models. We continue pushing models
698 * onto the stack on the threshold has been reached, then we
699 * pop the entire thing off the stack and label it as being in
700 * the same partition.
701 *
702 * 2) PartitionTD_1 -- the same algorithm as PartitionBU_1 but we
703 * collect the partitions by working from the end of the list
704 * provided.
705 *
706 *********************************************************************
707 */
708
709 struct Partition {
710 unsigned long start;
711 unsigned long end;
712 unsigned long count;
713 unsigned long index;
714 struct Partition *left; /* Used in the bisect partition */
715 struct Partition *right;
716 };
717
718 struct Partition *CreatePartition(unsigned long start,
719 unsigned long end)
720 {
721 struct Partition *result;
722
723 result = (struct Partition *)ascmalloc(sizeof(struct Partition));
724 assert(result);
725 result->start = start;
726 result->end = end;
727 result->count = 0L;
728 result->index = 0L;
729 result->left = NULL;
730 result->right = NULL;
731 return result;
732 }
733
734 /*
735 * start and end refer to the start and end indexes of the sublist
736 * of models on the main model list. All models on the list
737 * between and including start and end will be processed.
738 */
739 struct gl_list_t *PartitionBU_1(struct gl_list_t *models,
740 unsigned long threshold,
741 unsigned long start,
742 unsigned long end)
743
744 {
745 struct SlvModel *model;
746 struct gl_list_t *partitionlist;
747 struct Partition *p;
748 long len;
749 unsigned long c;
750 unsigned long accum, partition;
751
752 accum = 0;
753 partition = 1;
754 len = end - start + 1; /* just to get an estimate */
755
756 /*
757 * Create the partiton list; then create and add the first
758 * partition to the this list. The initial partition is the
759 * size of the entire problem. Successive partitions shrink.
760 */
761 partitionlist = gl_create((unsigned long)(len*0.1 + 1));
762 p = CreatePartition(start,end);
763 gl_append_ptr(partitionlist,(char *)p);
764
765 for (c=start;c<=end;c++) {
766 model = (struct SlvModel *)gl_fetch(models,c);
767 accum += model->local;
768 model->partition = partition;
769 if (accum >= threshold) {
770 p->count = accum;
771 p->end = c; /* finish up the previous partition */
772 /*
773 * Set up for next partition. Make sure that we are not
774 * at the end of the list of models.
775 */
776 if (c!=end) {
777 p = CreatePartition(c+1,end); /* start the next partition */
778 gl_append_ptr(partitionlist,(char *)p);
779 partition++;
780 accum = 0;
781 }
782 }
783 }
784 FPRINTF(stderr,"%lu partitions were found\n",
785 gl_length(partitionlist));
786 return partitionlist;
787 }
788
789 struct gl_list_t *PartitionTD_1(struct gl_list_t *models,
790 unsigned long threshold,
791 unsigned long start,
792 unsigned long end)
793 {
794 struct SlvModel *model;
795 struct gl_list_t *partitionlist;
796 struct Partition *p;
797 long len;
798 unsigned long c;
799 unsigned long accum, partition;
800
801 accum = 0;
802 partition = 1;
803 len = end - start + 1; /* just to get an estimate */
804
805 /*
806 * Create the partiton list; then create and add the first
807 * partition to the this list. The initial partition is the
808 * size of the entire problem. Successive partitions shrink.
809 */
810 partitionlist = gl_create((unsigned long)(len*0.1 + 1));
811 p = CreatePartition(start,end);
812 gl_append_ptr(partitionlist,(char *)p);
813
814 for (c=end;c>=start;c--) {
815 model = (struct SlvModel *)gl_fetch(models,c);
816 accum += model->local;
817 model->partition = partition;
818 if (accum >= threshold) {
819 p->count = accum;
820 p->start = c; /* finish up the previous partition */
821 /*
822 * Set up for next partition. Make sure that we are not
823 * at the top of the list of models.
824 */
825 if (c!=start) {
826 p = CreatePartition(start,c-1); /* start the next partition */
827 gl_append_ptr(partitionlist,(char *)p);
828 partition++;
829 accum = 0;
830 }
831 }
832 }
833 FPRINTF(stderr,"%lu partitions were found\n",
834 gl_length(partitionlist));
835 return partitionlist;
836 }
837
838 struct gl_list_t *Partition_1(struct gl_list_t *models,
839 unsigned long threshold,
840 enum PartitionMethod p_method,
841 unsigned long start, unsigned long end)
842 {
843 struct gl_list_t *partitionlist = NULL;
844
845 switch (p_method) {
846 case p_clusterdown:
847 partitionlist = PartitionTD_1(models,threshold,start,end);
848 break;
849 case p_clusterup:
850 default:
851 partitionlist = PartitionBU_1(models,threshold,start,end);
852 break;
853 }
854 return partitionlist;
855 }
856
857
858 /*
859 *********************************************************************
860 * BisectPartition
861 *
862 * This code performs a bisection of the model list using the local
863 * local relation counts as the criteria. It essentially
864 * accumulates the count until a cutoff is reached. This forms the
865 * 'left' partition. The rest of the models and their respective
866 * relations form the 'right' partition.
867 *
868 * We then do a bottom up visitation of the partition tree (LRV)
869 * to label it and simultaneously collect the partitions into a
870 * partitionlist. Once this is done all the other partition code is
871 * then applicable.
872 *********************************************************************
873 */
874 static
875 void BisectPartition(struct Partition *root,
876 struct gl_list_t *models,
877 unsigned long cutoff)
878 {
879 struct SlvModel *model;
880 struct Partition *left, *right;
881 unsigned long c,accum = 0;
882 unsigned long threshold;
883
884 if (!root) {
885 return;
886 }
887 if (root->start==root->end) {
888 return;
889 }
890 threshold = (root->count / 2);
891 if (threshold < cutoff) {
892 return;
893 }
894
895 for (c=root->start;c<=root->end;c++) {
896 model = (struct SlvModel *)gl_fetch(models,c);
897 accum += model->local;
898 if (accum >= threshold) {
899 root->left = CreatePartition(root->start,c);
900 root->left->count = accum;
901 root->right = CreatePartition(c+1,root->end);
902 root->right->count = MAX(0,(root->count - accum));
903 BisectPartition(root->left,models,cutoff); /* visit left */
904 BisectPartition(root->right,models,cutoff); /* visit right */
905 break;
906 }
907 }
908 }
909
910 static
911 void LabelPartitions_2(struct Partition *root,
912 struct gl_list_t *partitionlist)
913 {
914 if (root) { /* LRV -- i.e. postorder */
915 LabelPartitions_2(root->left,partitionlist);
916 LabelPartitions_2(root->right,partitionlist);
917 gl_append_ptr(partitionlist,(char *)root);
918 root->index = gl_length(partitionlist);
919 }
920 }
921
922 /*
923 * The partition list for a bisection partition contains
924 * partition of different granularity. It is the leaf partitions
925 * that matter, and these leaves contain the information necessary
926 * to label their models. We do that here.
927 * NOTE: We could possibly be smarter about labelling of models.
928 * so that we dont have to scan the entire model list. I need to
929 * think about this some more. This could almost surely be done
930 * while we are doing the BisectPartition.
931 */
932 static
933 int IsLeafPartition(struct Partition *part)
934 {
935 if ((part->left==NULL) && (part->right==NULL)) {
936 return 1;
937 } else {
938 return 0;
939 }
940 }
941
942 static
943 void LabelLeafPartitions(struct gl_list_t *partitionlist,
944 struct gl_list_t *models)
945 {
946 struct Partition *part;
947 struct SlvModel *model;
948 unsigned long len,c,cc;
949 unsigned long partition,start,end;
950
951 len = gl_length(partitionlist);
952 for (c=1;c<=len;c++) {
953 part = (struct Partition *)gl_fetch(partitionlist,c);
954 if (IsLeafPartition(part)) {/* label the models in the leaves */
955 partition = part->index;
956 start = part->start;
957 end = part->end;
958 for (cc=start;cc<=end;cc++) {
959 model = (struct SlvModel *)gl_fetch(models,cc);
960 model->partition = partition;
961 }
962 }
963 }
964 }
965
966 static
967 struct gl_list_t *Partition_2(struct gl_list_t *models,
968 unsigned long cutoff)
969 {
970 struct Partition *root;
971 struct gl_list_t *partitionlist = NULL;
972 unsigned long len,c;
973
974 len = gl_length(models);
975 if (!len) {
976 partitionlist = gl_create(1L);
977 return partitionlist;
978 }
979 /*
980 * the length of the partitionlist should be a log function
981 */
982 partitionlist = gl_create((0.05*len) + 1);
983 root = CreatePartition(1,len);
984 root->count = CountRelnsInList_Fast(models,1,len);
985 BisectPartition(root,models,cutoff);
986 LabelPartitions_2(root,partitionlist);
987 LabelLeafPartitions(partitionlist,models);
988 FPRINTF(stderr,"\t%lu partitions were found by bisection\n",
989 gl_length(partitionlist));
990 return partitionlist;
991 }
992
993 /*
994 * These functions will mark the relations in a list as
995 * being in the given partition. This could be made smarter,
996 * possibly by the use of a master relations list. We also
997 * mark the relation as not being torn.
998 */
999 static
1000 void MarkRelationList(struct gl_list_t *relations,
1001 unsigned long partition)
1002 {
1003 struct Instance *relinst;
1004 struct rel_relation *rel;
1005 unsigned long len,c;
1006
1007 len = gl_length(relations);
1008 if (!len) {
1009 return;
1010 }
1011
1012 for (c=1;c<=len;c++) { /* Put some sanity checking here FIX */
1013 relinst = (struct Instance *)gl_fetch(relations,c);
1014 rel = (struct rel_relation *)GetInterfacePtr(relinst);
1015 rel_set_flagbit(rel,REL_PARTITION,(int)partition);
1016 rel_set_flagbit(rel,REL_COUPLING,rel_interfacial(rel));
1017 /* rel->partition = (int)partition;*/ /* FIX FIX FIX dont deference */
1018 /* rel->coupling = rel_interfacial(rel);*/ /* FIX FIX */
1019 }
1020 }
1021
1022
1023 static
1024 void MarkRelnPartitions(struct gl_list_t *models)
1025 {
1026 struct SlvModel *model;
1027 struct gl_list_t *tmp;
1028 unsigned long len,c,cc;
1029 unsigned long nrelsets, partition;
1030
1031 len = gl_length(models);
1032 if (!len) {
1033 return;
1034 }
1035 for (c=1;c<=len;c++) {
1036 model = (struct SlvModel *)gl_fetch(models,c);
1037 nrelsets = gl_length(model->relations);
1038 for (cc=1;cc<=nrelsets;cc++) {
1039 tmp = (struct gl_list_t *)gl_fetch(model->relations,cc);
1040 MarkRelationList(tmp,model->partition);
1041 }
1042 }
1043 }
1044
1045
1046 /*
1047 *********************************************************************
1048 * Coupling Relations
1049 *
1050 * rel_interfacial is an expensive query, so we cache the
1051 * info here. We accept a relation if its signature is less
1052 * than the filter. e.g, if the filter is 1, and the relation
1053 * has a signature of 100, it would be ignored.
1054 *********************************************************************
1055 */
1056 static
1057 void MarkCouplingRelations(struct rel_relation **rp, int nrels,
1058 int filter)
1059 {
1060 struct rel_relation *rel;
1061 int signature;
1062 int i;
1063
1064 for (i=0;i<nrels;i++) {
1065 rel = rp[i];
1066 signature = rel_interfacial(rel);
1067 if (signature <= filter) {
1068 rel_set_flagbit(rel,REL_COUPLING,1);
1069 } else {
1070 rel_set_flagbit(rel,REL_COUPLING,0);
1071 }
1072 }
1073 }
1074
1075 int WriteCouplingRelnsToInterp(Tcl_Interp *interp,
1076 struct rel_relation **rp,int nrels,
1077 int filter)
1078 {
1079 struct rel_relation *rel;
1080 int i;
1081 char tmp[64];
1082
1083 if (!rp) {
1084 Tcl_SetResult(interp, "No relation list given", TCL_STATIC);
1085 return TCL_ERROR;
1086 }
1087 MarkCouplingRelations(rp,nrels,filter); /* mark them first */
1088 for (i=0;i<nrels;i++) {
1089 rel = rp[i];
1090 if (rel_coupling(rel)) {
1091 sprintf(tmp,"%d",rel_mindex(rel));
1092 Tcl_AppendResult(interp," ",tmp," ",(char *)NULL);
1093 }
1094 }
1095 return 0;
1096 }
1097
1098
1099 static
1100 void WritePartitions(struct gl_list_t *partitionlist)
1101 {
1102 struct Partition *part;
1103 unsigned long len,c;
1104
1105 len = gl_length(partitionlist);
1106 for (c=1;c<=len;c++) {
1107 part = (struct Partition *)gl_fetch(partitionlist,c);
1108 FPRINTF(stderr,"Partition %3lu: %4lu -> %4lu: size = %lu",
1109 part->index, part->start, part->end, part->count);
1110 if (IsLeafPartition(part)) {
1111 FPRINTF(stderr," *** \n");
1112 } else {
1113 FPRINTF(stderr,"\n");
1114 }
1115 }
1116 }
1117
1118
1119 /*
1120 *********************************************************************
1121 * Tearing Routines
1122 *
1123 * This code implements the labelling of the variables that need to be
1124 * torn. The algorithm is simple: for any given variable, find out how
1125 * many partitions that it exists in. If this count is more than 1,
1126 * it is a candidate variable to be torn.
1127 *********************************************************************
1128 */
1129
1130 /*
1131 * KAA_DEBUG. fetching the struct rel_relation *from a rel_instance NEEDS
1132 * a function and/or macro.
1133 */
1134
1135 /*
1136 * Determine the socalled home partition of the variable. This will
1137 * be the partition of the first relation that it is incident upon.
1138 * The first relation that is not in the home partition means that
1139 * the variable is a tear. Return TRUE if the variable is a tear;
1140 * false otherwise. The possibility of using some heuristics, such
1141 * as working from the end of the relations list back towards the
1142 * front exists, and may be investigated in a late iteration.
1143 *
1144 */
1145
1146 /*
1147 * The var_index is for debugging purposes only.
1148 */
1149 static
1150 int IsTearVariable_1(struct Instance *var, int var_sindex)
1151 {
1152 struct Instance *compiler_reln;
1153 struct rel_relation *rel;
1154 unsigned long nrels, i;
1155 int homepartition;
1156 int tear = 0;
1157
1158 nrels = RelationsCount(var);
1159 if (nrels <= 1) { /* a singleton var -- never a tear */
1160 return 0;
1161 }
1162
1163 compiler_reln = RelationsForAtom(var,1);
1164 rel = (struct rel_relation *)GetInterfacePtr(compiler_reln); /* FIX */
1165 assert(rel);
1166 homepartition = rel_partition(rel);
1167
1168 for (i=2;i<=nrels;i++) {
1169 compiler_reln = RelationsForAtom(var,i);
1170 rel = (struct rel_relation *)GetInterfacePtr(compiler_reln); /* FIX */
1171 if (rel_partition(rel)!=homepartition) { /* we have a tear */
1172 tear = 1;
1173 return 1;
1174 }
1175 }
1176
1177 return 0; /* if we are here then it is not a tear */
1178 }
1179
1180 static
1181 struct gl_list_t *MarkTearVariables(struct var_variable **vp, int nvars)
1182 {
1183 struct Instance *var;
1184 struct gl_list_t *tears;
1185 int j;
1186
1187 if (nvars==0) {
1188 tears = gl_create(1L);
1189 return tears;
1190 } else {
1191 tears = gl_create((unsigned long)(0.05*nvars + 1)); /* FINE TUNE */
1192 }
1193
1194 for (j=0;j<nvars;j++) {
1195 if (var_incident(vp[j])) {
1196 var = var_instance(vp[j]);
1197 if (IsTearVariable_1(var,var_sindex(vp[j]))) {
1198 gl_append_ptr(tears,var);
1199 }
1200 }
1201 }
1202 return tears;
1203 }
1204
1205
1206 /*
1207 * This function assumes that a REAL_ATOM_INST is synonymous with
1208 * a var !! FIX . KIRKBROKEN
1209 */
1210 static
1211 void WriteTearVarsToInterp(Tcl_Interp *interp,struct gl_list_t *tears)
1212 {
1213 struct Instance *var;
1214 char tmp[64];
1215 unsigned long len,c;
1216 int index;
1217
1218 len = gl_length(tears);
1219 for (c=1;c<=len;c++) {
1220 var = (struct Instance *)gl_fetch(tears,c);
1221 index = var_sindex(var); /* FIX */
1222 sprintf(tmp,"%d ",index);
1223 Tcl_AppendResult(interp,tmp,(char *)NULL);
1224 }
1225 }
1226
1227 /*
1228 * This is some debugging code. It may cleaned up or better
1229 * yet removed.
1230 */
1231 static
1232 void WriteModelData(struct gl_list_t *models)
1233 {
1234 FILE *fp;
1235 struct SlvModel *model;
1236 unsigned long len,c;
1237
1238 fp = fopen("modeldata.tmp","w");
1239 if (!fp) {
1240 return;
1241 }
1242 len = gl_length(models);
1243 for (c=1;c<=len;c++) {
1244 model = (struct SlvModel *)gl_fetch(models,c);
1245 if (!model) {
1246 FPRINTF(stderr,"Corrupted model data found !!\n");
1247 }
1248 FPRINTF(fp,"%4lu. index %4lu: nrels %4lu: partition %4lu\n",
1249 c, model->index, model->local, model->partition);
1250 }
1251 fclose(fp);
1252 }
1253
1254
1255 /*
1256 * Write the model-relation file to a file. This should be
1257 * really be written to the interpreter, and then handled
1258 * from the command line level but I am feeling lazy.
1259 * This code is as ugly as it is, because I am keeping a list
1260 * of list of relation instances associated which each slvmodel,
1261 * in the event that I *really* start to play clustering games.
1262 * In this case collapsing nodes will be moving around lists
1263 * rather than the individual relations which could be a big
1264 * win. In the mean time.....
1265 *
1266 * The format of the file is:
1267 * n_models n_relations
1268 * model_ndx rel_ndx
1269 * model_ndx rel_ndx
1270 * [ .... ]
1271 */
1272 static
1273 int WriteModelRelnsToFile(FILE *fp,
1274 struct gl_list_t *models,
1275 int n_relations)
1276 {
1277 unsigned long len1,len2,len3;
1278 unsigned long i,j,k;
1279 struct SlvModel *model;
1280 struct Instance *relinst;
1281 struct gl_list_t *list;
1282 struct rel_relation *rel;
1283
1284 len1 = gl_length(models);
1285 FPRINTF(fp,"%d %d\n",(int)len1,n_relations);
1286
1287 for (i=1;i<=len1;i++) {
1288 model = (struct SlvModel *)gl_fetch(models,i);
1289 len2 = gl_length(model->relations);
1290 for (j=1;j<=len2;j++) {
1291 list = (struct gl_list_t *)gl_fetch(model->relations,j);
1292 len3 = gl_length(list);
1293 for (k=1;k<=len3;k++) {
1294 relinst = (struct Instance *)gl_fetch(list,k);
1295 rel = (struct rel_relation *)GetInterfacePtr(relinst);
1296 FPRINTF(fp,"%d %d\n",(int)model->index,rel_mindex(rel));
1297 }
1298 }
1299 }
1300 }
1301
1302
1303 /*
1304 *********************************************************************
1305 * Dag Creation Routines
1306 *
1307 * This function builds a dag of solver models based on the list
1308 * of model and array instances given. It also builds a list of relations
1309 * for each solver model and appends it. The linking of the models
1310 * is done elsewhere. This routine assumes that the instance list is
1311 * unique i.e, a dag or a tree with no aliases. If this is not the
1312 * case then the relations count will not be correct, but otherwise
1313 * the code will work fine.
1314 *
1315 * NOTE: We could be more efficient here by using arrays of SlvModelsf
1316 * rather than mallocing a node for each. That will be left for another
1317 * iteration of the code.
1318 *********************************************************************
1319 */
1320 struct gl_list_t *Build_SlvModels(struct gl_list_t *inst_list)
1321 {
1322 struct Instance *inst;
1323 struct gl_list_t *newlist, *tmp;
1324 struct SlvModel *model;
1325 unsigned long len,c;
1326 unsigned long total = 0;
1327
1328 assert(inst_list);
1329 len = gl_length(inst_list);
1330 newlist = gl_create(len);
1331
1332 for (c=1;c<=len;c++) {
1333 inst = (struct Instance *)gl_fetch(inst_list,c);
1334 model = CreateSlvModel(); /* create a node */
1335 model->index = c;
1336 model->instance = inst;
1337 tmp = gl_create(AVG_RELATIONS);
1338 CollectLocalRelations(inst,tmp);
1339 model->local = gl_length(tmp); /* set up local count */
1340 total += model->local; /* debugging totalizer */
1341 gl_append_ptr(model->relations,(char *)tmp);
1342 gl_append_ptr(newlist,(char *)model); /* add node to list */
1343 }
1344 FPRINTF(stderr,"Found %lu relations in Build_SlvModels\n",total);
1345 return newlist;
1346 }
1347
1348
1349 /*
1350 * This function attempts to wire up the list of solver models
1351 * based on the original list of models. The code here is based
1352 * on the wire up code that may be found in instance.c. The only
1353 * trick here is that we need to remove aliasing. A model may have
1354 * more than 1 parent, (i.e. it has an alias).
1355 * We build a replica of the instance tree. Removal of aliasing
1356 * is done somewhere else.
1357 */
1358
1359 static
1360 void LinkSlvModels(struct gl_list_t *inst_list,
1361 struct gl_list_t *newlist)
1362 {
1363 struct Instance *inst, *child;
1364 struct SlvModel *model, *modchild;
1365 unsigned long len,c,cc;
1366 unsigned long nch, copynum, index;
1367
1368 len = gl_length(inst_list);
1369 for (c=1;c<=len;c++) {
1370 inst = (struct Instance *)gl_fetch(inst_list,c);
1371 model = (struct SlvModel *)gl_fetch(newlist,c);
1372 nch = NumberChildren(inst);
1373 for (cc=1;cc<=nch;cc++) {
1374 child = InstanceChild(inst,cc);
1375 index = GetTmpNum(child);
1376 if (index==0) { /* we did not label these */
1377 continue;
1378 }
1379 /*
1380 * Link parents and children.
1381 */
1382 modchild = (struct SlvModel *)gl_fetch(newlist,index);
1383 gl_append_ptr(modchild->parents,(char *)model);
1384 gl_append_ptr(model->children,(char *)modchild); /* add child */
1385 }
1386 }
1387 }
1388
1389 static
1390 struct gl_list_t *BuildDag(struct gl_list_t *inst_list)
1391 {
1392 struct gl_list_t *models;
1393
1394 models = Build_SlvModels(inst_list);
1395 LinkSlvModels(inst_list,models);
1396 return models;
1397 }
1398
1399 /*
1400 *********************************************************************
1401 * BuildInstanceList
1402 *
1403 * These functions visit the instance tree from the given instance
1404 * and collect all instances that are models or arrays of models.
1405 * We first visit the tree to count the data and to index the nodes,
1406 * by setting their copynums. We then make a second appending the data
1407 * to a list which is then returned.
1408 *********************************************************************
1409 */
1410 extern void ResetNodes(struct Instance *); /* see compiler/instance.c */
1411
1412 struct CountNodeData {
1413 unsigned long count;
1414 };
1415
1416 static
1417 void CountModelNodes(struct Instance *inst,void *data)
1418 {
1419 struct CountNodeData *tmp = (struct CountNodeData *)data;
1420 unsigned long count;
1421
1422 if (!inst) {
1423 return;
1424 }
1425 count = tmp->count;
1426 switch (InstanceKind(inst)) {
1427 case MODEL_INST:
1428 count++;
1429 SetTmpNum(inst,count);
1430 break;
1431 case ARRAY_ENUM_INST:
1432 case ARRAY_INT_INST:
1433 if (!BrowIsAtomicArray(inst) && !BrowIsRelation(inst)) {
1434 count++;
1435 SetTmpNum(inst,count);
1436 }
1437 break;
1438 default:
1439 break;
1440 }
1441 tmp->count = count; /* update the count */
1442 }
1443
1444 static
1445 void CollectModelNodes(struct Instance *inst,void *data)
1446 {
1447 struct gl_list_t *list = (struct gl_list_t *)data;
1448
1449 if (!inst) {
1450 return;
1451 }
1452 if (GetTmpNum(inst)) {
1453 gl_append_ptr(list,inst);
1454 }
1455 }
1456
1457 static
1458 struct gl_list_t *BuildInstanceList(struct Instance *inst,
1459 enum DagVisitSequence visit)
1460 {
1461 struct gl_list_t *list;
1462 struct CountNodeData data;
1463
1464 if (!inst) {
1465 list = gl_create(1);
1466 return list;
1467 }
1468
1469 switch (visit) {
1470 case v_df_td:
1471 ZeroTmpNums(inst,0);
1472 data.count = 0;
1473 VisitInstanceTreeTwo(inst,CountModelNodes,
1474 0,0,(void *)&data);
1475 list = gl_create(data.count);
1476 VisitInstanceTreeTwo(inst,CollectModelNodes,
1477 0,0,(void *)list);
1478 break;
1479 default:
1480 FPRINTF(stderr,"This visitation sequence is not yet supported\n");
1481 /* fall through */
1482 case v_df_bu:
1483 ZeroTmpNums(inst,1);
1484 data.count = 0;
1485 VisitInstanceTreeTwo(inst,CountModelNodes,
1486 1,0,(void *)&data);
1487 list = gl_create(data.count);
1488 VisitInstanceTreeTwo(inst,CollectModelNodes,
1489 1,0,(void *)list);
1490 break;
1491 }
1492
1493 g_dagdata.visit = visit;
1494 return list;
1495 }
1496
1497
1498 /*
1499 *********************************************************************
1500 * Exported Functions
1501 *
1502 * These functions are the entry points to the code in this file.
1503 * The supported functions at this moment are:
1504 * 0) PrepareDag
1505 * 1) WriteDagToInterp
1506 * 2) WriteRelnCountToInterp
1507 * 3) WriteTearsToInterp
1508 * 4) ShutDownDag
1509 *********************************************************************
1510 */
1511
1512
1513
1514 /*
1515 * We dont want to write out information for leaf model nodes;
1516 * i.e, a model that has only atoms, or relations or arrays of
1517 * atoms, or arrays of relations. So we start running down the
1518 * child list until we find something useful, then stop.
1519 * We prepare the formatting information, and then do the
1520 * processing from start to nch.
1521 */
1522 static
1523 void WriteInstNodeToInterp(Tcl_Interp *interp,struct Instance *inst)
1524 {
1525 struct Instance *child;
1526 char tmp[64];
1527 unsigned long index,nch,c;
1528 unsigned long start = 0;
1529
1530 nch = NumberChildren(inst);
1531 for (c=1;c<=nch;c++) {
1532 child = InstanceChild(inst,c);
1533 index = GetTmpNum(child);
1534 if (index) {
1535 start = c;
1536 break;
1537 }
1538 }
1539 if (!start) {
1540 return; /* => this was a leaf node */
1541 }
1542
1543 sprintf(tmp,"%lu",GetTmpNum(inst));
1544 Tcl_AppendResult(interp," {",tmp," ",(char *)NULL);
1545 for (c=start;c<=nch;c++) {
1546 child = InstanceChild(inst,c);
1547 index = GetTmpNum(child);
1548 if (index) {
1549 sprintf(tmp,"%lu",GetTmpNum(child));
1550 Tcl_AppendResult(interp,tmp," ",(char *)NULL);
1551 }
1552 }
1553 Tcl_AppendResult(interp,"} ",(char *)NULL);
1554 }
1555
1556 static
1557 void WriteInstListToInterp(Tcl_Interp *interp, struct gl_list_t *list)
1558 {
1559 struct Instance *tmp_inst;
1560 unsigned long len,c;
1561
1562 len = gl_length(list);
1563 for (c=1;c<=len;c++) {
1564 tmp_inst = (struct Instance *)gl_fetch(list,c);
1565 WriteInstNodeToInterp(interp,tmp_inst);
1566 }
1567 }
1568
1569 int Asc_DagWriteInstDagCmd(ClientData cdata, Tcl_Interp *interp,
1570 int argc, CONST84 char *argv[])
1571 {
1572 struct Instance *i;
1573 struct gl_list_t *list;
1574 if ( argc < 2 ) {
1575 Tcl_SetResult(interp,
1576 "wrong # args: Usage __dag_write_instdag ?current?search",
1577 TCL_STATIC);
1578 return TCL_ERROR;
1579 }
1580 if (strncmp(argv[1],"current",3)==0) {
1581 i = g_curinst;
1582 } else {
1583 i = g_search_inst;
1584 }
1585 if (!i) {
1586 Tcl_SetResult(interp, "requested instance is NULL", TCL_STATIC);
1587 return TCL_ERROR;
1588 }
1589 list = g_dagdata.instances;
1590 if (!list) {
1591 Tcl_SetResult(interp, "dag data has not been prepared", TCL_STATIC);
1592 return TCL_ERROR;
1593 }
1594 WriteInstListToInterp(interp,list);
1595 return TCL_OK;
1596 }
1597
1598
1599 /*
1600 *********************************************************************
1601 * WriteModel Dag
1602 *
1603 * These functions accept a list of models, and write out the
1604 * connectivity information requied to reconstruct the dag associated
1605 * with the list of models. It is very similar to the above functions
1606 * but runs off a model list rather than an instance list. Once the
1607 * model list has been built it should be much faster than the instance
1608 * version as there is much less stuff to skip over.
1609 *********************************************************************
1610 */
1611 static
1612 void WriteModelNodeToInterp(Tcl_Interp *interp,struct SlvModel *model)
1613 {
1614 struct SlvModel *child;
1615 char tmp[64];
1616 unsigned long nch,c;
1617
1618 nch = gl_length(model->children);
1619 if (!nch) {
1620 return;
1621 }
1622
1623 sprintf(tmp,"%lu",model->index);
1624 Tcl_AppendResult(interp," {",tmp," ",(char *)NULL);
1625 for (c=1;c<=nch;c++) {
1626 child = (struct SlvModel *)gl_fetch(model->children,c);
1627 sprintf(tmp,"%lu",child->index);
1628 Tcl_AppendResult(interp,tmp," ",(char *)NULL);
1629 }
1630 Tcl_AppendResult(interp,"} ",(char *)NULL);
1631 }
1632
1633 static
1634 void WriteModelDagToInterp(Tcl_Interp *interp, struct gl_list_t *list)
1635 {
1636 struct SlvModel *model;
1637 unsigned long len,c;
1638
1639 len = gl_length(list);
1640 for (c=1;c<=len;c++) {
1641 model = (struct SlvModel *)gl_fetch(list,c);
1642 WriteModelNodeToInterp(interp,model);
1643 }
1644 }
1645
1646 int Asc_DagWriteModelDagCmd(ClientData cdata, Tcl_Interp *interp,
1647 int argc, CONST84 char *argv[])
1648 {
1649 struct Instance *i;
1650 struct gl_list_t *list;
1651 struct gl_list_t *models;
1652
1653 if ( argc < 2 ) {
1654 Tcl_SetResult(interp,
1655 "wrong # args : Usage __dag_write_modeldag ?current?search",
1656 TCL_STATIC);
1657 return TCL_ERROR;
1658 }
1659 if (strncmp(argv[1],"current",3)==0) {
1660 i = g_curinst;
1661 } else {
1662 i = g_search_inst;
1663 }
1664 if (!i) {
1665 Tcl_SetResult(interp, "requested instance is NULL", TCL_STATIC);
1666 return TCL_ERROR;
1667 }
1668 list = g_dagdata.instances;
1669 if (!list) {
1670 Tcl_SetResult(interp, "dag data has not been prepared", TCL_STATIC);
1671 return TCL_ERROR;
1672 }
1673 models = g_dagdata.models;
1674 if (!models) {
1675 Tcl_SetResult(interp, "model data has not been prepared", TCL_STATIC);
1676 return TCL_ERROR;
1677 }
1678
1679 WriteModelDagToInterp(interp,models);
1680 return TCL_OK;
1681 }
1682
1683
1684 /*
1685 * In v_*_td visitation of the tree, the root model will the
1686 * first model on the list. In a v_*_bu visitation, it will be
1687 * the last.
1688 */
1689 static
1690 struct SlvModel *GetDagRoot(struct gl_list_t *models,
1691 enum DagVisitSequence visit)
1692 {
1693 struct SlvModel *root;
1694 unsigned long len;
1695
1696 len = gl_length(models);
1697 assert(len);
1698 switch (visit) { /* root is first on the list */
1699 case v_df_td:
1700 case v_bf_td:
1701 root = (struct SlvModel *)gl_fetch(models,1);
1702 break;
1703 case v_df_bu:
1704 case v_bf_bu:
1705 root = (struct SlvModel *)gl_fetch(models,len);
1706 break;
1707 default:
1708 FPRINTF(stderr,"Unknown visitation sequence\n");
1709 root = NULL;
1710 break;
1711 }
1712 return root;
1713 }
1714
1715
1716 int DagPartition(Tcl_Interp *interp,unsigned long threshold,
1717 int method)
1718 {
1719 struct SlvModel *root;
1720 struct gl_list_t *list;
1721 struct gl_list_t *models;
1722 struct gl_list_t *partitionlist;
1723 struct gl_list_t *tears;
1724 slv_system_t sys;
1725 struct var_variable **vp;
1726 unsigned long len;
1727
1728 /*
1729 * Check all of our data. If stuff checks out ok, update
1730 * the g_dagdata structure.
1731 */
1732 list = g_dagdata.instances;
1733 if (!list) {
1734 Tcl_SetResult(interp, "dag data not prepared", TCL_STATIC);
1735 return TCL_ERROR;
1736 }
1737
1738 models = g_dagdata.models;
1739 if (!models) {
1740 Tcl_SetResult(interp, "dag model not prepared", TCL_STATIC);
1741 return TCL_ERROR;
1742 }
1743
1744 sys = g_solvsys_cur; /* this might be made more general */
1745 if (!sys) {
1746 Tcl_SetResult(interp, "solve system does not exist", TCL_STATIC);
1747 return TCL_ERROR;
1748 }
1749
1750 if (threshold < 100) {
1751 g_dagdata.threshold = 100;
1752 } else {
1753 g_dagdata.threshold = threshold;
1754 }
1755
1756 switch (method) {
1757 case 1:
1758 /*
1759 * Pre process
1760 */
1761 len = gl_length(list);
1762 root = GetDagRoot(models,g_dagdata.visit);
1763 assert(root);
1764 ReorientTree(root);
1765 ResetModelTree(models);
1766 IndexTree(root,g_dagdata.visit);
1767 PostIndexingFixup(root,models);
1768 /*
1769 * Do the partitioning. This also labels each model as to which
1770 * partition that it sits in.
1771 */
1772 partitionlist = Partition_1(models, g_dagdata.threshold,
1773 p_clusterup, 1,len);
1774 /*
1775 * Post process.
1776 */
1777 MarkRelnPartitions(models);
1778 tears = MarkTearVariables(slv_get_master_var_list(sys),
1779 slv_get_num_master_vars(sys));
1780 break;
1781 case 2:
1782 /*
1783 * Pre process
1784 */
1785 len = gl_length(list);
1786 root = GetDagRoot(models,g_dagdata.visit);
1787 assert(root);
1788 ReorientTree(root);
1789 ResetModelTree(models);
1790 IndexTree(root,g_dagdata.visit);
1791 PostIndexingFixup(root,models);
1792 /*
1793 * Do the partitioning. This also labels each model as to which
1794 * partition that it sits in.
1795 */
1796 partitionlist = Partition_2(models,threshold);
1797 /*
1798 * Post process.
1799 */
1800 MarkRelnPartitions(models);
1801 tears = MarkTearVariables(slv_get_master_var_list(sys),
1802 slv_get_num_master_vars(sys));
1803 break;
1804 default:
1805 Tcl_SetResult(interp, "this method not yet supported", TCL_STATIC);
1806 return TCL_ERROR;
1807 }
1808
1809 /*
1810 * Do some data reporting, and set up for the next call.
1811 */
1812 WritePartitions(partitionlist);
1813 WriteTearVarsToInterp(interp,tears);
1814 WriteModelData(models);
1815 if (g_dagdata.tears) {
1816 gl_destroy(g_dagdata.tears);
1817 g_dagdata.tears = tears;
1818 }
1819 if (g_dagdata.partitions) {
1820 gl_free_and_destroy(g_dagdata.partitions); /* destroy the data */
1821 g_dagdata.partitions = partitionlist;
1822 }
1823
1824 return 0;
1825 }
1826
1827 /*
1828 * This is the sole entry point for all the partitioning algorithms.
1829 * method controls which partitioning algorithm will be used.
1830 * threshold means different things for different algorithms, but
1831 * in general means the cutoff size for clusters.
1832 */
1833 int Asc_DagPartitionCmd(ClientData cdata, Tcl_Interp *interp,
1834 int argc, CONST84 char *argv[])
1835 {
1836 unsigned long threshold;
1837 int method;
1838 int result;
1839
1840 if ( argc != 3 ) {
1841 Tcl_SetResult(interp,
1842 "wrong # args : Usage __dag_partition method threshold",
1843 TCL_STATIC);
1844 return TCL_ERROR;
1845 }
1846 method = atoi(argv[1]);
1847 threshold = atol(argv[2]);
1848 result = DagPartition(interp,threshold,method);
1849 if (result) {
1850 return TCL_ERROR;
1851 }
1852 }
1853
1854
1855 /*
1856 * THIS IS INCOMPLETE
1857 * I need to fiqure out a way to avoid calling ParentsName
1858 * for every model in the graph, as ParentsName requires a
1859 * linear search. In fact it is perhaps much easier to do
1860 * this off the instance list, rather than off the model list.
1861 * THIS IS INCOMPLETE.
1862 */
1863
1864 static
1865 void DagWriteNamesToInterp(Tcl_Interp *interp,struct gl_list_t *models)
1866 {
1867 struct SlvModel *model;
1868 unsigned long len,c;
1869
1870 return;
1871 }
1872
1873 /* THIS IS INCOMPLETE */
1874 int DagWriteNamesCmd(ClientData cdata, Tcl_Interp *interp,
1875 int argc, CONST84 char *argv[])
1876 {
1877 if ( argc != 1 ) {
1878 Tcl_SetResult(interp, "wrong # args : Usage __dag_writenames", TCL_STATIC);
1879 return TCL_ERROR;
1880 }
1881 if (g_dagdata.models==NULL) {
1882 Tcl_SetResult(interp, "model dag data not prepared", TCL_STATIC);
1883 return TCL_ERROR;
1884 }
1885 DagWriteNamesToInterp(interp,g_dagdata.models);
1886 return TCL_OK;
1887 }
1888
1889
1890 int Asc_DagCouplingRelnsCmd(ClientData cdata, Tcl_Interp *interp,
1891 int argc, CONST84 char *argv[])
1892 {
1893 slv_system_t sys;
1894 int result;
1895 int filter;
1896
1897 if ( argc != 3 ) {
1898 Tcl_SetResult(interp,
1899 "wrong # args:"
1900 " Usage __dag_coupling_relns ?current?search filter",
1901 TCL_STATIC);
1902 return TCL_ERROR;
1903 }
1904 sys = g_solvsys_cur; /* this might be made more general */
1905 if (!sys) {
1906 Tcl_SetResult(interp, "solve system does not exist", TCL_STATIC);
1907 return TCL_ERROR;
1908 }
1909 filter = atoi(argv[2]);
1910 result = WriteCouplingRelnsToInterp(interp,slv_get_master_rel_list(sys),
1911 slv_get_num_master_rels(sys),
1912 filter);
1913 if (result) {
1914 return TCL_ERROR;
1915 }
1916 return TCL_OK;
1917 }
1918
1919
1920 int Asc_DagModelRelnsCmd(ClientData cdata, Tcl_Interp *interp,
1921 int argc, CONST84 char *argv[])
1922 {
1923 FILE *fp = NULL;
1924 slv_system_t sys;
1925 char *file;
1926
1927 if ( argc != 3 ) {
1928 Tcl_SetResult(interp,
1929 "wrong # args: Usage __dag_model_relns ?current?search file",
1930 TCL_STATIC);
1931 return TCL_ERROR;
1932 }
1933 if (!g_dagdata.models) {
1934 Tcl_SetResult(interp, "model data has not been prepared", TCL_STATIC);
1935 return TCL_ERROR;
1936 }
1937 sys = g_solvsys_cur; /* this might be made more general */
1938 if (!sys) {
1939 Tcl_SetResult(interp, "solve system does not exist", TCL_STATIC);
1940 return TCL_ERROR;
1941 }
1942
1943 fp = fopen(argv[2],"w");
1944 if (!fp) {
1945 Tcl_SetResult(interp, "unable to open file", TCL_STATIC);
1946 return TCL_ERROR;
1947 }
1948 WriteModelRelnsToFile(fp,g_dagdata.models,
1949 slv_get_num_master_rels(sys));
1950 if (fp) {
1951 fclose(fp);
1952 }
1953 return TCL_OK;
1954 }
1955
1956
1957 void DagWriteLocalRelns(Tcl_Interp *interp, struct gl_list_t *list)
1958 {
1959 char tmp[64];
1960 unsigned long len,c;
1961 unsigned long local;
1962
1963 len = gl_length(list);
1964 for (c=1;c<=len;c++) {
1965 local = (unsigned long)gl_fetch(list,c);
1966 sprintf(tmp,"%lu",local);
1967 Tcl_AppendResult(interp,tmp," ",(char *)NULL);
1968 }
1969 }
1970
1971 int Asc_DagCountRelnsCmd(ClientData cdata, Tcl_Interp *interp,
1972 int argc, CONST84 char *argv[])
1973 {
1974 struct gl_list_t *list;
1975
1976 if ( argc < 2 ) {
1977 Tcl_SetResult(interp,
1978 "wrong # args : Usage __dag_countrelns ?current?search",
1979 TCL_STATIC);
1980 return TCL_ERROR;
1981 }
1982 if (g_dagdata.instances==NULL) {
1983 Tcl_SetResult(interp, "dag data not prepared", TCL_STATIC);
1984 return TCL_ERROR;
1985 }
1986 list = CountLocalRelations(g_dagdata.instances);
1987 DagWriteLocalRelns(interp,list);
1988 gl_destroy(list); /* we could possibly save it; but... */
1989 return TCL_OK;
1990 }
1991
1992
1993 /*
1994 * This function assumes that the instance list has been built
1995 * already and safely cached away in the g_dagdata structure.
1996 * It will build the dag model list and also stash it away.
1997 * It will not destroy an existing model list. It will also
1998 * use whatever vistitation sequence that the instance list was
1999 * built from.
2000 */
2001 int Asc_DagBuildDagCmd(ClientData cdata, Tcl_Interp *interp,
2002 int argc, CONST84 char *argv[])
2003 {
2004 struct Instance *i;
2005 struct gl_list_t *list;
2006 struct gl_list_t *models;
2007
2008 if ( argc < 2 ) {
2009 Tcl_SetResult(interp,
2010 "wrong # args : Usage __dag_build_modeldag ?current?search",
2011 TCL_STATIC);
2012 return TCL_ERROR;
2013 }
2014 if (strncmp(argv[1],"current",3)==0) {
2015 i = g_curinst;
2016 } else {
2017 i = g_search_inst;
2018 }
2019 if (!i) {
2020 Tcl_SetResult(interp, "requested instance is NULL", TCL_STATIC);
2021 return TCL_ERROR;
2022 }
2023 list = g_dagdata.instances;
2024 if (!list) {
2025 Tcl_SetResult(interp, "dag data has not been prepared", TCL_STATIC);
2026 return TCL_ERROR;
2027 }
2028
2029 models = g_dagdata.models;
2030 if (!models) { /* Need to build the model list */
2031 models = BuildDag(list);
2032 g_dagdata.models = models;
2033 }
2034 return TCL_OK;
2035 }
2036
2037 int Asc_DagPrepareCmd(ClientData cdata, Tcl_Interp *interp,
2038 int argc, CONST84 char *argv[])
2039 {
2040 struct Instance *i;
2041 enum DagVisitSequence visitseq;
2042 if ( argc != 3 ) {
2043 Tcl_AppendResult(interp,"wrong # args : ",
2044 "Usage __dag_prepare ?current?search? ",
2045 "visit_sequence",(char *)NULL);
2046 return TCL_ERROR;
2047 }
2048
2049 if (strncmp(argv[1],"current",3)==0) {
2050 i = g_curinst;
2051 } else {
2052 i = g_search_inst;
2053 }
2054 if (!i) {
2055 Tcl_SetResult(interp, "requested instance is NULL", TCL_STATIC);
2056 return TCL_ERROR;
2057 }
2058 visitseq = (enum DagVisitSequence)atoi(argv[2]);
2059 ResetDagData();
2060 g_dagdata.instances = BuildInstanceList(i,visitseq);
2061 g_dagdata.visit = visitseq;
2062 return TCL_OK;
2063 }
2064
2065 /*
2066 * Registered as __dag_shutdown
2067 */
2068 int Asc_DagShutdownCmd(ClientData cdata, Tcl_Interp *interp,
2069 int argc, CONST84 char *argv[])
2070 {
2071 DestroyDagData(); /* Write Function */
2072 ResetDagData();
2073 return TCL_OK;
2074 }
2075

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