1 gaskelld 1.1 /*-----------------------------------------------------------------------------
2 * Copyright (c) 1992 Southeastern Universities Research Association,
3 * Continuous Electron Beam Accelerator Facility
4 *
5 * This software was developed under a United States Government license
6 * described in the NOTICE file included as part of this distribution.
7 *
8 * Stephen A. Wood, 12000 Jefferson Ave., Newport News, VA 23606
9 * Email: saw@cebaf.gov Tel: (804) 249-7367 Fax: (804) 249-5800
10 *-----------------------------------------------------------------------------
11 *
12 * Description:
13 * C and Fortran routines for registering variables to be used by
14 * the test, histogram and parameter packages.
15 *
16 * Author: Stephen Wood, CEBAF HALL C
17 *
18 * Revision History:
19 * $Log: daVarRegister.c,v $
20 * Revision 1.3 2003/02/21 20:55:24 saw
21 * Clean up some types and casts to reduce compiler warnings.
22 gaskelld 1.1 *
23 * Revision 1.2 1999/11/04 20:34:04 saw
24 * Alpha compatibility.
25 * New RPC call needed for root event display.
26 * Start of code to write ROOT trees (ntuples) from new "tree" block
27 *
28 * Revision 1.13 1999/08/25 13:16:05 saw
29 * *** empty log message ***
30 *
31 * Revision 1.12 1999/03/01 19:51:32 saw
32 * Add Absoft Fortran stuff
33 *
34 * Revision 1.11 1997/05/29 18:56:25 saw
35 * Lock changes before adding Absoft(Linux) compatibility
36 *
37 * Revision 1.10 1996/07/31 20:37:53 saw
38 * Use hash table for name storage.
39 *
40 * Revision 1.9 1994/09/27 20:20:53 saw
41 * Remove linux dependencies, allow wild cards in daVarList
42 *
43 gaskelld 1.1 * Revision 1.8 1994/08/24 14:27:00 saw
44 * Have daVarLookupPWithClass return S_DAVAR_UNKNOWN if var not found
45 *
46 * Revision 1.7 1994/06/03 20:59:26 saw
47 * Replace stderr with STDERR
48 *
49 * Revision 1.6 1994/02/10 21:58:33 saw
50 * Change node variable name to nd to not conflict with node type.
51 *
52 * Revision 1.5 1994/02/10 18:34:05 saw
53 * Small fixes for SGI compatibility
54 *
55 * Revision 1.4 1993/11/24 21:37:39 saw
56 * Add fortran calls for registering double (REAL *8) variable type.
57 *
58 * Revision 1.3 1993/11/22 20:09:42 saw
59 * Add REGPARMSTRING fortran call for new Fortran string type DAVARFSTRING
60 *
61 * Revision 1.2 1993/08/12 19:58:10 saw
62 * On HPUX don't use native tsearch.
63 *
64 gaskelld 1.1 * Revision 1.1 1993/05/10 20:05:09 saw
65 * Initial revision
66 *
67 *
68 * 18-dec-92 saw Original version
69 *
70 *
71 * Routines available to general users:
72 * --------
73 * daVarRegister(int flag, daVarStruct *args)
74 * daVarLookup(char *name, daVarStruct *results)
75 *
76 * Routines available to "friendly" packages (e.g.) RPC service routines
77 * --------
78 * daVarLookupP(char *name, daVarStruct **results)
79 * daVarList(char ***listp)
80 * daVarFreeList(char **list)
81 *
82 *
83 */
84 #include "cfortran.h"
85 gaskelld 1.1 #include "daVar.h"
86
87 #define USEHASH
88 #ifdef USEHASH
89 #include "daVarHash.h"
90 #else
91 #if !defined(ultrix)
92 #define NO_TSEARCH
93 #endif
94
95 #include <stdio.h>
96 #ifdef NOFNMATCH
97 #include "fnmatch.h"
98 #else
99 #include <fnmatch.h>
100 #endif
101
102 /* Stuff for Tsearch routines*/
103 typedef struct node_t
104 {
105 daVarStruct *key;
106 gaskelld 1.1 struct node_t *left, *right;
107 } node;
108
109 #ifdef NO_TSEARCH
110 typedef enum { preorder, postorder, endorder, leaf } VISIT;
111 node *mytsearch(void *key, node **rootp, int (* compar)());
112 node *mytfind(void *key, node **rootp, int (* compar)());
113 void mytwalk();
114 #else
115 #include <search.h>
116 #define mytsearch tsearch
117 #define mytfind tfind
118 #define mytwalk twalk
119 #endif
120 #endif
121
122 #ifdef USEHASH
123 symbolEntry *hash_table[TABLE_SIZE];
124 int hashNotInited=1;
125 #else
126 node *daVarRoot=0;
127 gaskelld 1.1 #endif
128 int daVarCount=0; /* Used by daVarList */
129 char **daVarListGlob;
130 char *daVarListPattern;
131 int (*daVarListCompFunction)();
132 int daVarListPattern_length;
133
134 /* Local prototypes */
135 int daVarComp(daVarStruct *item1, daVarStruct *item2);
136
137 /* Code */
138 int daVarRegister(int flag, daVarStruct *args)
139 /* Should accept a title arg of zero and create a null string in that
140 case.
141 */
142 {
143 daVarStruct search, *new, **searchresult;
144 int fullnamelen;
145
146 if(flag != 0) {
147 fprintf(STDERR,
148 gaskelld 1.1 "(daVarRegister) Only zero allowed for flag argument now.\n");
149 return(S_FAILURE);
150 }
151
152 search.name = args->name;
153 /* printf("Searching for %s\n",args->name);*/
154 #ifdef USEHASH
155 if(hashNotInited) {crlHashCreate(hash_table); hashNotInited = 0;}
156 if(searchresult = (daVarStruct **) crlHashFind((CrlSymbol) &search,hash_table)) {
157 #else
158 if(searchresult = (daVarStruct **) mytfind(&search,&daVarRoot,daVarComp)){
159 #endif
160 fprintf(STDERR,
161 "(daVar) Replacing definition of variable \"%s\" in table\n",
162 args->name);
163 free((*searchresult)->title);
164 if(args->title) {
165 if(((*searchresult)->title = (char *) malloc(strlen(args->title)+1))
166 == NULL)
167 return(S_FAILURE);
168 strcpy((*searchresult)->title,args->title);
169 gaskelld 1.1 } else {
170 if(((*searchresult)->title = (char *) malloc(1))
171 == NULL)
172 return(S_FAILURE);
173 (*searchresult)->title[0] = '\0';
174 }
175 (*searchresult)->varptr = args->varptr;
176 (*searchresult)->size = (args->size<=0) ? 1 : args->size;
177 (*searchresult)->type = args->type;
178 (*searchresult)->flag = args->flag;
179 (*searchresult)->rhook = args->rhook;
180 (*searchresult)->whook = args->whook;
181 (*searchresult)->opaque = args->opaque;
182 return(S_DAVAR_REPLACED);
183 } else {
184 if((new = (daVarStruct *) malloc(sizeof(daVarStruct))) == NULL)
185 return(S_FAILURE);
186 if((new->name = (char *) malloc(strlen(args->name)+1)) == NULL)
187 return(S_FAILURE);
188 strcpy(new->name,args->name);
189
190 gaskelld 1.1
191 if(args->title) {
192 if((new->title = (char *) malloc(strlen(args->title)+1)) == NULL)
193 return(S_FAILURE);
194 strcpy(new->title,args->title);
195 } else {
196 if((new->title = (char *) malloc(1)) == NULL)
197 return(S_FAILURE);
198 new->title[0] = '\0';
199 }
200 new->type = args->type;
201 new->varptr = args->varptr;
202 new->size = (args->size<=0) ? 1 : args->size;
203 new->flag = args->flag;
204 new->rhook = args->rhook;
205 new->whook = args->whook;
206 new->opaque = args->opaque;
207
208 #ifdef USEHASH
209 if(crlHashAdd((CrlSymbol) new, hash_table))
210 #else
211 gaskelld 1.1 if(mytsearch((void *) new,&daVarRoot,daVarComp))
212 #endif
213 return(S_SUCCESS);
214 else
215 return(S_FAILURE);
216 }
217 }
218
219
220 int daVarLookup(char *name, daVarStruct *result)
221 {
222 daVarStruct search, **searchresult;
223 static char *namel=0; /* Pointers to static space for copies of */
224 static int namelsize=0;
225 static char *titlel=0; /* the name and title pointers */
226 static int titlelsize=0;
227 int len;
228
229 search.name = name;
230 #ifdef USEHASH
231 if(searchresult = (daVarStruct **) crlHashFind((CrlSymbol) &search,hash_table)) {
232 gaskelld 1.1 #else
233 if(searchresult = (daVarStruct **) mytfind(&search,&daVarRoot,daVarComp)){
234 #endif
235
236 len=strlen((*searchresult)->name);
237 if(len >= namelsize) {
238 if(namel) free(namel);
239 namel = (char *) malloc(len+1);
240 namelsize = len+1;
241 }
242 strcpy(namel,(*searchresult)->name);
243 result->name = namel;
244
245 len=strlen((*searchresult)->title);
246 if(len >= titlelsize) {
247 if(titlel) free(titlel);
248 titlel = (char *) malloc(len + 1);
249 titlelsize = len+1;
250 }
251 strcpy(titlel,(*searchresult)->title);
252 result->title = titlel;
253 gaskelld 1.1
254 result->type = (*searchresult)->type;
255 result->varptr = (*searchresult)->varptr;
256 result->size = (*searchresult)->size;
257 result->opaque = (*searchresult)->opaque;
258 result->rhook = (*searchresult)->rhook;
259 result->whook = (*searchresult)->whook;
260 return(S_SUCCESS);
261 } else
262 return(S_DAVAR_UNKNOWN);
263 }
264 int daVarStrcmp(register char *s1, register char *s2)
265 {
266 while(toupper(*s1) == toupper(*s2++))
267 if(*s1++ == '\0')
268 return(0);
269 return(toupper(*s1) - toupper(*--s2));
270 }
271 int daVarFnmatch(register char *pattern, register char *s, register int n)
272 {
273 return(fnmatch(pattern,s,0));
274 gaskelld 1.1 }
275 int daVarStrncmp(register char *s1, register char *s2, register int n)
276 {
277 while(toupper(*s1) == toupper(*s2++))
278 if(*s1++ == '\0' || (--n) <= 0)
279 return(0);
280 return(toupper(*s1) - toupper(*--s2));
281 }
282
283 int daVarComp(daVarStruct *item1, daVarStruct *item2)
284 /* Do case insensitive comparisons of keys */
285 {
286 return(daVarStrcmp(item1->name,item2->name));
287 }
288
289 int daVarLookupP(char *name, daVarStruct **varstructptr)
290 {
291 daVarStruct search, **searchresult;
292
293 search.name = name;
294 #ifdef USEHASH
295 gaskelld 1.1 if(searchresult = (daVarStruct **) crlHashFind((CrlSymbol) &search,hash_table)) {
296 #else
297 if(searchresult = (daVarStruct **) mytfind(&search,&daVarRoot,daVarComp)){
298 #endif
299 *varstructptr = *searchresult;
300 return(S_SUCCESS);
301 } else
302 return(S_DAVAR_UNKNOWN);
303 }
304
305 daVarLookupPWithClass(char *name, char **prefixlist, daVarStruct **varp)
306 {
307 int namlen,namtrylen;
308 char *namtry;
309
310 namlen = strlen(name);
311 if(daVarLookupP(name,varp)==S_SUCCESS) return(S_SUCCESS);
312 namtrylen = namlen + 10;
313 namtry = (char *) malloc(namtrylen+1);
314 while(*prefixlist){
315 int thislen;
316 gaskelld 1.1 thislen = strlen(*prefixlist) + namlen + 1;
317 if(thislen > namtrylen) {
318 namtrylen = thislen;
319 namtry = (char *) realloc(namtry,namtrylen);
320 }
321 strcpy(namtry,*prefixlist);
322 strcat(namtry,".");
323 strcat(namtry,name);
324 if(daVarLookupP(namtry,varp)==S_SUCCESS) {
325 free(namtry);
326 return(S_SUCCESS);
327 }
328 prefixlist++;
329 }
330 free(namtry);
331 return(S_DAVAR_UNKNOWN); /* Variable not registered */
332 }
333
334 void daVarCount_node
335 #ifdef USEHASH
336 (void *entry)
337 gaskelld 1.1 {
338 #else
339 (node *nd,VISIT order, int level)
340 {
341 if(order==postorder || order == leaf)
342 #endif
343 daVarCount++;
344 }
345
346 void daVarList_node
347 #ifdef USEHASH
348 (void *entry)
349 {
350 #else
351 (node *nd,VISIT order, int level)
352 {
353 if(order==postorder || order == leaf)
354 #endif
355 {
356 char *name;
357
358 gaskelld 1.1 name = ((daVarStruct *) entry)->name;
359 if(daVarListPattern_length == 0 ||
360 (daVarListCompFunction)(daVarListPattern,name,daVarListPattern_length) == 0)
361 daVarListGlob[daVarCount++] = name;
362 }
363 }
364
365
366 int daVarList(char *pattern, char ***listp, int *count)
367 /* User is not allowed to muck with the strings pointed to in the list
368 because they are the actual strings in the tables. */
369 {
370
371 if(strchr(pattern,'*') || strchr(pattern,'?')) {
372 daVarListCompFunction = daVarFnmatch;
373 } else {
374 daVarListCompFunction = daVarStrncmp;
375 }
376 if(pattern) {
377 daVarListPattern = pattern;
378 daVarListPattern_length = strlen(daVarListPattern);
379 gaskelld 1.1 } else
380 daVarListPattern_length = 0;
381 daVarCount = 0;
382 #ifdef USEHASH
383 crlHashWalk(hash_table,daVarCount_node);
384 #else
385 mytwalk(daVarRoot,daVarCount_node);/* Should make list only big enough
386 for what matches */
387 #endif
388
389 if((*listp = daVarListGlob =
390 (char **) malloc((daVarCount)*sizeof(char *))) == NULL)
391 return(S_FAILURE);
392 daVarCount = 0;
393 #ifdef USEHASH
394 crlHashWalk(hash_table,daVarList_node);
395 #else
396 mytwalk(daVarRoot,daVarList_node);
397 #endif
398 *count = daVarCount;
399 return(S_SUCCESS);
400 gaskelld 1.1 }
401 #ifndef USEHASH
402 daVarPrint_node(node *nd,VISIT order, int level)
403 {
404 char *name,*title;
405
406 if(order==postorder || order == leaf) {
407 name = ((daVarStruct *) nd->key)->name;
408 title = ((daVarStruct *) nd->key)->title;
409 printf("XX: %s %s %x %x\n",name,title,nd,nd->key);
410 }
411 }
412
413 int daVarPrint()
414 {
415 mytwalk(daVarRoot,daVarPrint_node);
416 return(S_SUCCESS);
417 }
418 #endif
419 int daVarFreeList(char **list)
420 /* Free's up the list of variables in listp */
421 gaskelld 1.1 {
422 int i;
423
424 free(list);
425 return(S_SUCCESS);
426 }
427
428 /* Fortran entry points */
429
430 #define LENDEFARRAY int *size,
431 #define LENDEFSCALER
432 #define LENARGARRAY *size
433 #define LENARGSCALER 1
434
435 #define MAKEFSUB(SUBNAME,CLASS,TYPENAME,DATYPE,ARRAY) \
436 int SUBNAME(char *name, TYPENAME *vptr, LENDEF##ARRAY char *title\
437 ,unsigned l_name, unsigned l_title)\
438 {\
439 int A0;\
440 daVarStruct args;\
441 char *BN=0;\
442 gaskelld 1.1 char *BT=0;\
443 char *BF = 0;\
444 \
445 BF = malloc(strlen(CLASS)+l_name+1);\
446 strcpy(BF,CLASS);\
447 args.name = strcat(BF,((!*(int *)name)?0:memchr(name,'\0',l_name)?name:\
448 (memcpy(BN=(char *) malloc(l_name+1),name,l_name)\
449 ,BN[l_name]='\0',kill_trailing(BN,' '))));\
450 args.title = ((!*(int *)title)?0:memchr(title,'\0',l_title)?title:\
451 (memcpy(BT=(char *) malloc(l_title+1),title,l_title)\
452 ,BT[l_title]='\0',kill_trailing(BT,' ')));\
453 args.size = LENARG##ARRAY;\
454 args.varptr = (void *) vptr;\
455 args.flag = DAVAR_READWRITE;\
456 args.type = DATYPE;\
457 args.opaque = 0;\
458 args.rhook = 0;\
459 args.whook = 0;\
460 A0 = daVarRegister((int) 0, &args);\
461 if(BF) free(BF);\
462 if(BN) free(BN);\
463 gaskelld 1.1 if(BT) free(BT);\
464 return(A0);\
465 }
466
467 /* Can't figure out a more clever way */
468 #ifdef AbsoftUNIXFortran
469 MAKEFSUB(regreal,"",float,DAVARFLOAT,SCALER)
470 MAKEFSUB(regdouble,"",double,DAVARDOUBLE,SCALER)
471 MAKEFSUB(regint,"",int,DAVARINT,SCALER)
472 MAKEFSUB(regrealarray,"",float,DAVARFLOAT,ARRAY)
473 MAKEFSUB(regdoublearray,"",double,DAVARDOUBLE,ARRAY)
474 MAKEFSUB(regintarray,"",int,DAVARINT,ARRAY)
475
476 MAKEFSUB(regparmreal,"parm.",float,DAVARFLOAT,SCALER)
477 MAKEFSUB(regparmdouble,"parm.",double,DAVARDOUBLE,SCALER)
478 MAKEFSUB(regeventreal,"event.",float,DAVARFLOAT,SCALER)
479 MAKEFSUB(regeventdouble,"event.",double,DAVARDOUBLE,SCALER)
480 MAKEFSUB(regparmint,"parm.",int,DAVARINT,SCALER)
481 MAKEFSUB(regeventint,"event.",int,DAVARINT,SCALER)
482 MAKEFSUB(regparmrealarray,"parm.",float,DAVARFLOAT,ARRAY)
483 MAKEFSUB(regparmdoublearray,"parm.",double,DAVARDOUBLE,ARRAY)
484 gaskelld 1.1 MAKEFSUB(regeventrealarray,"event.",float,DAVARFLOAT,ARRAY)
485 MAKEFSUB(regeventdoublearray,"event.",double,DAVARDOUBLE,ARRAY)
486 MAKEFSUB(regparmintarray,"parm.",int,DAVARINT,ARRAY)
487 MAKEFSUB(regeventintarray,"event.",int,DAVARINT,ARRAY)
488
489 MAKEFSUB(regtestint,"test.",int,DAVARINT,SCALER)
490 MAKEFSUB(regtestintarray,"test.",int,DAVARINT,ARRAY)
491 #else
492 MAKEFSUB(regreal_,"",float,DAVARFLOAT,SCALER)
493 MAKEFSUB(regdouble_,"",double,DAVARDOUBLE,SCALER)
494 MAKEFSUB(regint_,"",int,DAVARINT,SCALER)
495 MAKEFSUB(regrealarray_,"",float,DAVARFLOAT,ARRAY)
496 MAKEFSUB(regdoublearray_,"",double,DAVARDOUBLE,ARRAY)
497 MAKEFSUB(regintarray_,"",int,DAVARINT,ARRAY)
498
499 MAKEFSUB(regparmreal_,"parm.",float,DAVARFLOAT,SCALER)
500 MAKEFSUB(regparmdouble_,"parm.",double,DAVARDOUBLE,SCALER)
501 MAKEFSUB(regeventreal_,"event.",float,DAVARFLOAT,SCALER)
502 MAKEFSUB(regeventdouble_,"event.",double,DAVARDOUBLE,SCALER)
503 MAKEFSUB(regparmint_,"parm.",int,DAVARINT,SCALER)
504 MAKEFSUB(regeventint_,"event.",int,DAVARINT,SCALER)
505 gaskelld 1.1 MAKEFSUB(regparmrealarray_,"parm.",float,DAVARFLOAT,ARRAY)
506 MAKEFSUB(regparmdoublearray_,"parm.",double,DAVARDOUBLE,ARRAY)
507 MAKEFSUB(regeventrealarray_,"event.",float,DAVARFLOAT,ARRAY)
508 MAKEFSUB(regeventdoublearray_,"event.",double,DAVARDOUBLE,ARRAY)
509 MAKEFSUB(regparmintarray_,"parm.",int,DAVARINT,ARRAY)
510 MAKEFSUB(regeventintarray_,"event.",int,DAVARINT,ARRAY)
511
512 MAKEFSUB(regtestint_,"test.",int,DAVARINT,SCALER)
513 MAKEFSUB(regtestintarray_,"test.",int,DAVARINT,ARRAY)
514 #endif
515
516 /* Entry points for String registration. Do entry points for anything other
517 than parmameters make sense? */
518 #ifdef AbsoftUNIXFortran
519 int regparmstring
520 #else
521 int regparmstring_
522 #endif
523 (char *name, char *sptr, char *title
524 ,unsigned l_name, unsigned l_sptr, unsigned l_title)
525 {
526 gaskelld 1.1 int A0;
527 daVarStruct args;
528 char *BN=0;
529
530 char *BT=0;
531 char *BF = 0;
532
533 BF = malloc(5+l_name+1);
534 strcpy(BF,"parm.");
535 args.name = strcat(BF,((!*(int *)name)?0:memchr(name,'\0',l_name)?name:
536 (memcpy(BN=(char *) malloc(l_name+1),name,l_name)
537 ,BN[l_name]='\0',kill_trailing(BN,' '))));
538 args.title = ((!*(int *)title)?0:memchr(title,'\0',l_title)?title:
539 (memcpy(BT=(char *) malloc(l_title+1),title,l_title)
540 ,BT[l_title]='\0',kill_trailing(BT,' ')));
541 args.size = l_sptr;
542 args.varptr = (void *) sptr;
543 args.flag = DAVAR_READWRITE;
544 args.type = DAVARFSTRING;
545 args.opaque = 0;
546 args.rhook = 0;
547 gaskelld 1.1 args.whook = 0;
548 A0 = daVarRegister((int) 0, &args);
549 if(BF) free(BF);
550 if(BN) free(BN);
551 return(A0);
552 }
553
554 #ifdef NO_TSEARCH
555 /*
556 * Tree search generalized from Knuth (6.2.2) Algorithm T just like
557 * the AT&T man page says.
558 *
559 * The node_t structure is for internal use only, lint doesn't grok it.
560 *
561 * Written by reading the System V Interface Definition, not the code.
562 *
563 * Totally public domain.
564 */
565 /*LINTLIBRARY*/
566
567 /*
568 gaskelld 1.1 #include <search.h>
569
570 typedef struct node_t
571 {
572 char *key;
573 struct node_t *left, *right;
574 }
575 node;
576 */
577
578 node *mytsearch(key, rootp, compar)
579 /* find or insert datum into search tree */
580 void *key; /* key to be located */
581 register node **rootp; /* address of tree root */
582 int (*compar)(); /* ordering function */
583 {
584 register node *q;
585
586 if (rootp == (struct node_t **)0)
587 return ((struct node_t *)0);
588 while (*rootp != (struct node_t *)0) /* Knuth's T1: */
589 gaskelld 1.1 {
590 int r;
591
592 if ((r = (*compar)(key, (*rootp)->key)) == 0) /* T2: */
593 return (*rootp); /* we found it! */
594 rootp = (r < 0) ?
595 &(*rootp)->left : /* T3: follow left branch */
596 &(*rootp)->right; /* T4: follow right branch */
597 }
598 q = (node *) malloc(sizeof(node)); /* T5: key not found */
599 if (q != (struct node_t *)0) /* make new node */
600 {
601 *rootp = q; /* link new node to old */
602 q->key = key; /* initialize new node */
603 q->left = q->right = (struct node_t *)0;
604 }
605 return (q);
606 }
607
608 node *mytdelete(key, rootp, compar)
609 /* delete node with given key */
610 gaskelld 1.1 char *key; /* key to be deleted */
611 register node **rootp; /* address of the root of tree */
612 int (*compar)(); /* comparison function */
613 {
614 node *p;
615 register node *q;
616 register node *r;
617 int cmp;
618
619 if (rootp == (struct node_t **)0 || (p = *rootp) == (struct node_t *)0)
620 return ((struct node_t *)0);
621 while ((cmp = (*compar)(key, (*rootp)->key)) != 0)
622 {
623 p = *rootp;
624 rootp = (cmp < 0) ?
625 &(*rootp)->left : /* follow left branch */
626 &(*rootp)->right; /* follow right branch */
627 if (*rootp == (struct node_t *)0)
628 return ((struct node_t *)0); /* key not found */
629 }
630 r = (*rootp)->right; /* D1: */
631 gaskelld 1.1 if ((q = (*rootp)->left) == (struct node_t *)0) /* Left (struct node_t *)0? */
632 q = r;
633 else if (r != (struct node_t *)0) /* Right link is null? */
634 {
635 if (r->left == (struct node_t *)0) /* D2: Find successor */
636 {
637 r->left = q;
638 q = r;
639 }
640 else
641 { /* D3: Find (struct node_t *)0 link */
642 for (q = r->left; q->left != (struct node_t *)0; q = r->left)
643 r = q;
644 r->left = q->right;
645 q->left = (*rootp)->left;
646 q->right = (*rootp)->right;
647 }
648 }
649 free((struct node_t *) *rootp); /* D4: Free node */
650 *rootp = q; /* link parent to new node */
651 return(p);
652 gaskelld 1.1 }
653
654 static void trecurse(root, action, level)
655 /* Walk the nodes of a tree */
656 register node *root; /* Root of the tree to be walked */
657 register void (*action)(); /* Function to be called at each node */
658 register int level;
659 {
660 if (root->left == (struct node_t *)0 && root->right == (struct node_t *)0)
661 (*action)(root, leaf, level);
662 else
663 {
664 (*action)(root, preorder, level);
665 if (root->left != (struct node_t *)0)
666 trecurse(root->left, action, level + 1);
667 (*action)(root, postorder, level);
668 if (root->right != (struct node_t *)0)
669 trecurse(root->right, action, level + 1);
670 (*action)(root, endorder, level);
671 }
672 }
673 gaskelld 1.1
674 void mytwalk(root, action) /* Walk the nodes of a tree */
675 node *root; /* Root of the tree to be walked */
676 void (*action)(); /* Function to be called at each node */
677 {
678 if (root != (node *)0 && action != (void(*)())0)
679 trecurse(root, action, 0);
680 }
681
682 /* mytsearch.c ends here */
683 /*
684 * Tree search generalized from Knuth (6.2.2) Algorithm T just like
685 * the AT&T man page says.
686 *
687 * The node_t structure is for internal use only, lint doesn't grok it.
688 *
689 * Written by reading the System V Interface Definition, not the code.
690 *
691 * Totally public domain.
692 */
693 /*LINTLIBRARY*/
694 gaskelld 1.1 /*
695 #include <search.h>
696
697 typedef struct node_t
698 {
699 char *key;
700 struct node_t *left, *right;
701 } node;
702 */
703
704 node *mytfind(key, rootp, compar)
705 /* find a node, or return 0 */
706 void *key; /* key to be found */
707 register node **rootp; /* address of the tree root */
708 int (*compar)(); /* ordering function */
709 {
710 if (rootp == (struct node_t **)0)
711 return ((struct node_t *)0);
712 while (*rootp != (struct node_t *)0) /* T1: */
713 {
714 int r;
715 gaskelld 1.1 if ((r = (*compar)(key, (*rootp)->key)) == 0) /* T2: */
716 return (*rootp); /* key found */
717 rootp = (r < 0) ?
718 &(*rootp)->left : /* T3: follow left branch */
719 &(*rootp)->right; /* T4: follow right branch */
720 }
721 return (node *)0;
722 }
723 #endif
|
Return to
daVarRegister.c
CVS log
Up to [HallC] / simc_gfortran / CTP