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

Annotation of /trunk/tcltk98/generic/interface/BrowserDag.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 9 months ago) by aw0a
Original Path: trunk/ascend4/interface/BrowserDag.c
File MIME type: text/x-csrc
File size: 55347 byte(s)
Setting up web subdirectory in repository
1 aw0a 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