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

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