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

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