1/* struct::graph - critcl - layer 1 declarations 2 * (b) Node operations. 3 */ 4 5#include <arc.h> 6#include <node.h> 7#include <util.h> 8 9/* .................................................. */ 10 11GN* 12gn_new (G* g, const char* name) 13{ 14 GN* n; 15 int new; 16 17 if (Tcl_FindHashEntry (g->nodes.map, name) != NULL) { 18 Tcl_Panic ("struct::graph(c) gn_new - tried to use duplicate name for new node"); 19 } 20 21 n = ALLOC (GN); 22 23 gc_setup ((GC*) n, &g->nodes, name, g); 24 gc_add ((GC*) n, &g->nodes); 25 26 gn_shimmer_self (n); 27 28 n->in.first = NULL; n->in.n = 0; 29 n->out.first = NULL; n->out.n = 0; 30 31 return n; 32} 33 34void 35gn_delete (GN* n) 36{ 37 /* We assume that the node may still have incoming and outgoing arcs. They 38 * are deleted recursively. 39 */ 40 41 gc_remove ((GC*) n, &n->base.graph->nodes); 42 gc_delete ((GC*) n); 43 44 while (n->in.first) { ga_delete (n->in.first->a); } 45 while (n->out.first) { ga_delete (n->out.first->a); } 46 47 n->in.first = NULL; n->in.n = 0; 48 n->out.first = NULL; n->out.n = 0; 49 50 ckfree ((char*) n); 51} 52 53/* .................................................. */ 54 55void 56gn_err_duplicate (Tcl_Interp* interp, Tcl_Obj* n, Tcl_Obj* g) 57{ 58 Tcl_Obj* err = Tcl_NewObj (); 59 60 Tcl_AppendToObj (err, "node \"", -1); 61 Tcl_AppendObjToObj (err, n); 62 Tcl_AppendToObj (err, "\" already exists in graph \"", -1); 63 Tcl_AppendObjToObj (err, g); 64 Tcl_AppendToObj (err, "\"", -1); 65 66 Tcl_SetObjResult (interp, err); 67} 68 69void 70gn_err_missing (Tcl_Interp* interp, Tcl_Obj* n, Tcl_Obj* g) 71{ 72 Tcl_Obj* err = Tcl_NewObj (); 73 74 /* Keep any prefix ... */ 75 Tcl_AppendObjToObj (err, Tcl_GetObjResult (interp)); 76 Tcl_AppendToObj (err, "node \"", -1); 77 Tcl_AppendObjToObj (err, n); 78 Tcl_AppendToObj (err, "\" does not exist in graph \"", -1); 79 Tcl_AppendObjToObj (err, g); 80 Tcl_AppendToObj (err, "\"", -1); 81 82 Tcl_SetObjResult (interp, err); 83} 84 85/* .................................................. */ 86 87Tcl_Obj* 88gn_serial_arcs (GN* n, Tcl_Obj* empty, Tcl_HashTable* cn) 89{ 90 int lc; 91 Tcl_Obj** lv; 92 Tcl_Obj* arcs; 93 GL* il; 94 GA* a; 95 int i, id; 96 Tcl_HashEntry* he; 97 98 /* Quick return if node has no outgoing arcs */ 99 100 if (!n->out.n) return empty; 101 102 lc = n->out.n; 103 lv = NALLOC (lc, Tcl_Obj*); 104 105 for (i=0, il = n->out.first; 106 il != NULL; 107 il = il->next) { 108 a = il->a; 109 he = Tcl_FindHashEntry (cn, (char*) a->end->n); 110 111 /* Ignore arcs which lead out of the subgraph spanned up by the nodes 112 * in 'cn'. 113 */ 114 115 if (!he) continue; 116 ASSERT_BOUNDS(i, lc); 117 id = (int) Tcl_GetHashValue (he); 118 lv [i] = ga_serial (a, empty, id); 119 i++; 120 } 121 lc = i; 122 123 arcs = Tcl_NewListObj (lc, lv); 124 ckfree ((char*) lv); 125 return arcs; 126} 127 128/* .................................................. */ 129 130/* 131 * Local Variables: 132 * mode: c 133 * c-basic-offset: 4 134 * fill-column: 78 135 * End: 136 */ 137