File: alllines.ll

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (784 lines) | stat: -rw-r--r-- 23,209 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
/*
 * @progname       allines.sgml.ll
 * @version        1.1
 * @author         Wetmore, Nozell
 * @category       
 * @output         SGML, NROFF
 * @description    
 *
 * This program shows all ancestral lines of a specified person
 * using a pseudo-Register format.
 *
 * Output is in nroff or sgml format.  This may change to something
 * more generic.
 *
 * Tom Wetmore, ttw@shore.net
 * beta version, 27 February 1997
 *
 * Marc Nozell, nozell@rootsweb.com
 * Added sgmldoc (formerly known as linuxdoc), 3 March 1997
 */

global(format_type)     /* what format? nroff or sgml? */
global(CurID)           /* ID values assigned to ancestors */
global(BOLK)            /* list of keys of persons who begin lines */
global(BOLG)            /* generations of begin line persons */
global(BOLR)            /* relationships of begin line persons */
global(CurK)            /* current line being processed */
global(CurG)            /* generations in current line */
global(CurR)            /* relations in current line */
global(AncT)            /* table of all ancestors */
global(AncL)            /* list of all ancestors */
global(KeyT)            /* table of all saved keys */
global(TOLT)            /* table of top of line persons */
global(TOLL)            /* list of top of line persons */
global(FamT)            /* NEED COMMENT TO DESCRIBE THIS!! */

/* User Options */

global(OPat)            /* follow paternal lines */
global(ORel)            /* show relationships */

/* LineParent -- Return parent in line direction. */

func LineParent (p)
{
        if (OPat) { return(father(p)) }
        else      { return(mother(p)) }
}

/* OthrParent -- Return parent in non-line direction. */

func OthrParent (p)
{
        if (OPat) { return(mother(p)) }
        else      { return(father(p)) }
}

/*
 * main - This is the main routine; it asks the user to identify a person
 * and then calls the DoIt routine.
 */

proc main ()
{
        getindi(i, "Enter person whose full registry ancestry is wanted.")
        if (i) { call DoIt(i) }
        else   { print("Program not run.") }
}

/*
 * DoIt - This is the top routine of the program; it calls routines to
 * perform the main algorithmic jobs and then calls a routine to write the
 * report.
 */

proc DoIt (i)
{
        set(CurID, 1)
        table(KeyT)
        call GetUserOptions()

/*
 * The first step in this program is to compute the list of "bottom of
 * line" persons.  These persons are those that on first sight seem to
 * require an ancestral line generated in the program's output.  Because
 * multiple bottom of line persons may have the same top of line ancestor
 * (due to pedigree collapse) it may turn out that there is not a separate
 * line computed for each bottom of line person.  This complication is
 * dealt with later.  The first bottom of line person is always the
 * starting person, and the first ancestral line shown in the output will
 * be the parental line of this person.  Normally this parental line will
 * be the paternal line.
 */
        print("Finding all bottom of line persons.\n")
        call BFirstCreateBOLLists(i)/**/
        /* call ShowBOLLists() /*DEBUG*/

/*
 * The second step is to build an ancestor table that contains all the
 * information about the ancestors of the key person that is needed in
 * generating the program's output.  The table accumulates the information
 * needed to deal with pedigree collapse.
 */

        print("Creating table of all ancestors.\n")
        call CreateAncStructures() /* call ShowAncTable() /**/

/*
 * The third step is to number the ancestors in the ancestor table in such
 * a way that on output each numbered ancestor magically has the right
 * sequential number.
 */

        print("Numbering all ancestors in table.\n")
        call NumberAncestors() /* call ShowAncTable() /**/

/*
 * The fourth step is to compute the list of top of line ancestors.  Due
 * to pedigree collapse there may be fewer top of line ancestors than
 * there are bottom of line persons.  Whenever this is the case, there
 * will be an ancestor somewhere in the line who has more than one child
 * who are also ancestors (the essence of pedigree collapse).  This program
 * collapses all lines that begin with the same person but lead to
 * different descendants (who are still all ancestors of the starting
 * person)
 */

        print("Computing top of line ancestors.\n")
        call CreateTOLList() /* call ShowTOLList() /**/

/*
 * The last step is to write the report.
 */

        print("Printing final report.\n")
        call WriteReport()
}

/*
 * GetUserOptions - As you can see, users can't actually select them yet!
 */

proc GetUserOptions ()
{
        getintmsg(format_type, "Enter 0 for nroff, 1 for sgml")

        set(OPat, 1)    /* this version only follows paternal lines */
        set(ORel, 1)    /* this version shows relationships */
}

/*
 * BFirstCreateBOLLists - This routine creates the beginning of lines lists.
 * This is the breadth first version of this routine.  Following is the
 * moving front version.  I don't know which order is the best.  Try them
 * both and see which you prefer.
 */

proc BFirstCreateBOLLists (i)
{
        list(BOLK) list(BOLG) list(BOLR)
        list(TmpK) list(TmpG) list(TmpR)
        enqueue(TmpK, savekey(key(i)))
        enqueue(TmpG, 1) enqueue(TmpR, 1)

        while (k, dequeue(TmpK)) {
                set(p, indi(k))
                set(g, dequeue(TmpG)) set(r, dequeue(TmpR))
                if (eq(1, mod(r, 2))) {
                        enqueue(BOLK, k) enqueue(BOLG, g) enqueue(BOLR, r)
                }
                set(g, add(1, g)) set(r, mul(2, r))
                if (f, LineParent(p)) {
                        enqueue(TmpK, savekey(key(f)))
                        enqueue(TmpG, g) enqueue(TmpR, r)
                }
                set(r, add(1, r))
                if (m, OthrParent(p)) {
                        enqueue(TmpK, savekey(key(m)))
                        enqueue(TmpG, g) enqueue(TmpR, r)
                }
        }
}

/*
 * MFrontCreateBOLLists - This routine also creates the beginning of line
 * lists.  This is the moving front version, and is not used in this beta
 * version.
 */

proc MFrontCreateBOLLists (i)
{
        list(BOLK) list(BOLG) list(BOLR)
        list(TmpK) list(TmpG) list(TmpR)
        enqueue(TmpK, savekey(key(i)))
        enqueue(TmpG, 1) enqueue(TmpR, 1)

        while (k, dequeue(TmpK)) {
                set(g, dequeue(TmpG)) set(r, dequeue(TmpR))
                set(p, indi(k))
                enqueue(BOLK, k) enqueue(BOLG, g) enqueue(BOLR, r)
                while (p) {
                        set(g, add(g, 1)) set(r, mul(r, 2))
                        if (m, OthrParent(p)) {
                                enqueue(TmpK, savekey(key(m)))
                                enqueue(TmpG, g) enqueue(TmpR, add(r, 1))
                        }
                        set(p, LineParent(p))
                }
        }
}

/*
 * CreateAncStructures - This routine creates the AncT table and AncL list.
 *  These are data structures that hold information about all ancestors of
 *  the starting person.  This routine operates by considering each bottom
 *  of line person in turn.  For each bottom of line person his or her
 *  ancestral line is computed and then the ProcessCurLine routine is
 *  called.  It is the ProcessCurLine routine that actually updates the
 *  data structures.
 *
 *  Note that the only use of the AncL list is in the debugging routine
 *  ShowAncTable.
 */

proc CreateAncStructures ()
{
        table(AncT) list(AncL)

        forlist(BOLK, k, n) {  /* for each bottom of line person ... */
                set(g, getel(BOLG, n)) set(r, getel(BOLR, n))
                set(p, indi(k))

                list(CurK) list(CurG) list(CurR) /* make them empty */
                while (p) { /* start with BOL person and follow line back */
                        push(CurK, savekey(key(p)))
                        push(CurG, g) push(CurR, r)
                        set(g, add(1, g))
                        set(r, mul(2, r))
                        set(p, LineParent(p))
                }
                call ProcessCurLine()
        }
}

/*
 * ProcessCurLine - This routine updates the ancestor table and list based
 * on an ancestral line just computed for a bottom of line person by the
 * CreateAncStructures routine.  This line is stored in the three global
 * lists CurK, CurG, and CurR, which form the interface between this
 * routine and CreateAncStructures.  This routine processes the line from
 * the last line ancestor of the bottom of line person to the bottom of
 * line person.
 */

proc ProcessCurLine ()
{
        set(f, 0)  /* f holds the line parent of the current person */
        set(k, pop(CurK))
        while (k) {
                set(p, indi(k))
                set(g, pop(CurG))
                set(r, pop(CurR))
                call AddToAncTable(k, g, r, f)
                /*name(p) " (" d(g) ", " d(r) ") "/*DEBUG*/
                set(f, k)
                set(k, pop(CurK))
        }
}

/*
 * AddToAncTable - This routine adds information to the ancestor table.
 * Each table entry is a list with six elements:
 * 1 Key of person
 * 2 ID of person
 * 3 Number of appearances in pedigree
 * 4 List of generations relative to key person by appearance
 * 5 List of relationships to key person by appearance
 * 6 List of children of this person who are also ancestors of key person
 */

proc AddToAncTable (k, g, r, f)
{
        if (e, lookup(AncT, k)) {  /* if person is already in table ... */

                setel(e, 3, add(1, getel(e, 3)))  /* incr num of appearances */
                set(l, getel(e, 4))
                enqueue(l, g)  /* update list of generations */
                set(l, getel(e, 5))
                enqueue(l, r)  /* update list of relationships */

        } else {  /* this is the first time this ancestor has been seen */

                list(e)  /* create new, empty table entry for person */
                enqueue(e, k)   /* add person's key */
                enqueue(e, 0)   /* init id to zero */
                enqueue(e, 1)   /* init num of appearences to one */
                list(l)         /* create sub-list to hold generations */
                enqueue(l, g)   /* init sub-list to current generation */
                enqueue(e, l)   /* add sub-list to table entry */
                list(l)         /* create sub-list to hold relationships */
                enqueue(l, r)   /* init sub-list to current relationship */
                enqueue(e, l)   /* add sub-list to table entry */
                list(l)         /* create sub-list to hold line descendants */
                enqueue(e, l)   /* add (empty) sub-list to table entry */
                insert(AncT, k, e)  /* add new entry to ancestor table */
                enqueue(AncL, k)  /* add key of person to ancestor list */
        }
        if (f) {  /* if not top of line make a child of line parent */
                set(d, lookup(AncT, f))
                set(l, getel(d, 6))
                if (not(inlist(l, k))) {
                        enqueue (l, k)
                }
        }
}

/*
 * NumberAncestors - This routine numbers the ancestors in the ancestor
 * table.
 */

proc NumberAncestors ()
{
        forlist(BOLK, k, n) {
                set(p, indi(k))
                while (f, LineParent(p)) { set(p, f) }
                call NumberLine(key(p))
        }
}

proc NumberLine (k)
{
        set(e, lookup(AncT, k))
        if (ne(0, getel(e, 2))) { return() }
        list(TmpQ)
        enqueue(TmpQ, k)
        while (k, dequeue(TmpQ)) {
                set(p, indi(k))
                set(e, lookup(AncT, k))
                setel(e, 2, CurID)
                set(CurID, add(1, CurID))
                set(cl, getel(e, 6))
                families (p, f, s, n) {
                        children (f, o, m) {
                                if (inlist(cl, key(o))) {
                                        enqueue(TmpQ, savekey(key(o)))
                                }
                        }
                }
        }
}

proc CreateTOLList ()
{
        table(TOLT) list(TOLL)
        forlist (BOLK, k, n) {
                set(p, indi(k))
                while (f, LineParent(p)) { set(p, f) }
                set(s, savekey(key(p)))
                if (and(nestr(k, s), not(lookup(TOLT, s)))) {
                        enqueue(TOLL, s)
                        insert(TOLT, s, s)
                }
        }
}

proc ShowTOLList ()
{
        "START OF LINE LIST --\n"
        forlist (TOLL, k, n) {
                name(indi(k)) "\n"
        }
}

/*
 * WriteReport - This routine controls writing a report.  Right now this
 * program has built in knowledge that the report is being generated in
 * nroff format.  This should be changed so that only generic routines
 * are called out of this routine, making substitution for different report
 * formats (e.g., LaTeX, HTML) easier in the future.
 */

proc WriteReport ()
{
        call WriteHeading()
        table(FamT)
        forlist (TOLL, k, n) {
                call WriteLine(k)
        }
        call WriteTail()
}

/*
 * WriteLine - This routine is responsible writing a single line to the
 * report file.
 */

proc WriteLine (k)      /* k -- key of a line's top of line person */
{
        call LineTitle(k)
        set(e, lookup(AncT, k))
        list(TmpQ)
        enqueue(TmpQ, k)
        while (k, dequeue(TmpQ)) {
                set(e, lookup(AncT, k))
                call WriteLinePerson(e)
                call WriteChildren(e)
                forlist(getel(e, 6), c, n) {
                        enqueue(TmpQ, c)
                }
        }
}

proc EmitPara () {
        if (eq(format_type, 0)) { call nroffPara() }
        else { call sgmlPara() }
}

proc EmitLeftSquareBracket () {
        if (eq(format_type, 0)) { call nroffLeftSquareBracket() }
        else { call sgmlLeftSquareBracket() }
}

proc EmitRightSquareBracket () {
        if (eq(format_type, 0)) { call nroffRightSquareBracket() }
        else { call sgmlRightSquareBracket() }
}

proc EmitStartList () {
        if (eq(format_type, 0)) { call nroffStartList() }
        else { call sgmlStartList() }
}

proc EmitEndList () {
        if (eq(format_type, 0)) { call nroffEndList() }
        else { call sgmlEndList() }
}

proc EmitChildItem () {
        if (eq(format_type, 0)) { call nroffChildItem() }
        else { call sgmlChildItem() }
}

proc WriteHeading () {
        if (eq(format_type, 0)) { call nroffhead() }
        else { call sgmlhead() }
}

proc WriteTail () {
        if (eq(format_type, 0)) { call nrofftail() }
        else { call sgmltail() }
}

proc LineTitle (k)
{
        if (eq(format_type, 0)) { call nroffLineTitle(k) }
        else { call sgmlLineTitle(k) }
}

proc nroffhead ()
{
    ".de CH\n"
    ".sp\n"
    ".in 11n\n"
    ".ti 1\n"
    "\\h'3n'\\h'-\\w'\\\\$1'u'\\\\$1\\h'5n'\\h'-\\w'\\\\$2'u'\\\\$2\\h'1n'\n"
    "..\n"

    ".de P\n.sp\n.in 0\n..\n"
    /*".po 5\n"*/
    ".ll 72\n"
    ".ls 1\n"
    ".na\n"
}

proc sgmlhead ()
{

    "<!doctype linuxdoc system>" nl()
    "<article>" nl()
    "<title>All Lines</title>" nl()
    "<author>by Marc Nozell</author>"
        "<abstract> " nl()
         "This shows all ancestral lines of a specified person  using a pseudo-Register format."
        "</abstract>" nl()
        "<toc>" nl()
}

proc nrofftail ()
{
        " " nl() /* pretty boring... */
}

proc sgmltail ()
{
        "  </article>" nl()
}

proc nroffLineTitle (k) {
        ".P\n.sp 2\nANCESTRAL LINE FROM " upper(name(indi(k))) "\n"
        ".br\n-----------------------------------------------------\n"
}

proc sgmlLineTitle (k) {
         nl()"<sect>Ancestral line from " upper(name(indi(k))) "\n"
}

proc nroffPara () {
        ".P\n"
}

proc sgmlPara () {
         "<p>\n"
}

proc nroffLeftSquareBracket () {
        "["
}
proc sgmlLeftSquareBracket () {
        "&lsqb;"
}

proc nroffRightSquareBracket () {
        "]"
}
proc sgmlRightSquareBracket () {
        "&rsqb;"
}

proc nroffStartList () {
        "\n"
}

proc sgmlStartList () {
        "<enum>\n"
}

proc nroffEndList () {
        "\n"
}

proc sgmlEndList () {
        "</enum>\n"
}

proc nroffChildItem () {
        " "
}

proc sgmlChildItem () {
        "<item>\n"
}


/*
 * WriteChildren - This routine writes out the children for a person in an
 * ancestral line.
 */

proc WriteChildren (e)
{
        set(p, indi(getel(e, 1)))
        set(cl, getel(e, 6))    /* list of child keys also in this line */
        families (p, f, s, n) {
                if (s) { set(u, save(name(s))) }
                else   { set(u, "(_____)") }
                if (lookup(FamT, key(f))) {
                        call EmitPara()
                        "Children of " name(p) " and " u
                        " listed under " u ".\n"
                } elsif (gt(nchildren(f), 0)) {
                        call EmitPara()
                        "Children of " name(p) " and " u ":\n"
                        call EmitStartList()
                        children(f, c, m) {
                                if (inlist(cl, key(c))) {
                                        set(ce, lookup(AncT, key(c)))
                                        call EmitChildItem()
                                        d(getel(ce, 2)) " "
                                        roman(m) "\n"
                                        call shortvitals(c)
                                } else {
                                        call EmitChildItem()
                                        roman(m) "\n"
                                        call middlevitals(c)
                                }
                        }
                        insert(FamT, savekey(key(f)), 1)
                        call EmitEndList()
                }
        }
}

proc shortvitals (i)
{
        name(i)
        set(b, birth(i)) set(d, death(i))
        if (and(b, short(b))) { ", b. " short(b) }
        if (and(d, short(d))) { ", d. " short(d) }
        ".\n"
        call EmitPara()
}

proc middlevitals (i)
{
        name(i) ".\n"
        set(e, birth(i))
        if(and(e,long(e))) {
                call EmitPara()
                "Born " long(e) ".\n" }
        if (eq(1, nspouses(i))) {
                spouses(i, s, f, n) {
                        call EmitPara()
                        "Married"
                        call spousevitals(s, f)
                }
        } else {
                spouses(i, s, f, n) {
                        call EmitPara()
                        "Married " ord(n) ","
                        call spousevitals(s, f)
                }
        }
        set(e, death(i))
        if(and(e, long(e))) {
                call EmitPara()
                "Died " long(e) ".\n" }
        set(p, 0)
}

/*
 * WriteLinePerson - This routine generates the report output for one
 * person in one of the ancestral lines.  This version of the routine
 * generates output in nroff format.  It prints boiler plate vitals
 * information about the person followed by all notes in the person's
 * record in the database.  This routine does not print the person's
 * children (see routine >>>>> for this).
 */

proc WriteLinePerson (e)
{
        set(p, indi(getel(e, 1)))
        call EmitPara()
        d(getel(e, 2)) "  "
        name(p)
        if (ORel) {
                call EmitLeftSquareBracket()
                set(c, "")
                forlist (getel(e, 5), r, n) {
                        c call ShowRel(r) set(c, ", ")
                }
                call EmitRightSquareBracket()
        }
        ".\n"
        call EmitPara()
        set(o, birth(p))
        if(and(o, long(o))) { "Born " long(o) ".\n" }
        if (eq(1, nspouses(p))) {
                spouses(p, s, f, n) {
                        "Married"
                        call spousevitals(s, f)
                }
        } else {
                spouses(p, s, f, n) {
                        "Married " ord(n) ","
                        call spousevitals(s, f)
                }
        }
        set(o, death(p))
        if(and(o, long(o))) { "Died " long(o) ".\n" }
        set(b, 0)
        fornotes(root(p), n) {
                if (not(b)) {
                        call EmitPara()
                        set(b, 1) }
                n "\n"
        }
}

proc spousevitals (s, f)
{
        set(e, marriage(f))
        if (and(e, long(e))) { "\n" long(e) "," }
        "\n" name(s)
        set(e, birth(s))
        if (and(e, long(e)))  { ",\nborn " long(e) }
        set(e, death(s))
        if (and(e, long(e)))  { ",\ndied " long(e) }
        set(d, LineParent(s))
        set(m, OthrParent(s))
        if (or(d, m)) {
                ",\n"
                if (male(s))      { "son of " }
                elsif (female(s)) { "daughter of " }
                else              { "child of " }
        }
        if (d)         { name(d) }
        if (and(d, m)) { "\nand " }
        if (m)         { name(m) }
        ".\n"
}

/*
 * ShowBOLLists - This debug routine shows the bottom of line persons as
 * recorded in the BOLK, BOLG, and BOLR lists
 */

proc ShowBOLLists ()
{
        forlist(BOLK, k, n) {
                set(g, getel(BOLG, n)) set(r, getel(BOLR, n))
                name(indi(k)) " " d(g) " "
                d(r) " (" call ShowRel(r) ")\n"
        }
}

proc ShowCurLine ()
{
        set(k, pop(CurK))
        set(p, indi(k))
        while (p) {
                set(g, pop(CurG)) set(r, pop(CurR))
                name(p) " (" d(g) "," d(r) ") "
                set(k, pop(CurK)) set(p, indi(k))
        }
        "\n"
}

/* ShowAncTable -- Debug routine which shows contents of AncT. */

proc ShowAncTable ()
{
        forlist(AncL, k, n) {
                set(e, lookup(AncT, k))
                set(p, indi(k))
                set(i, getel(e, 2))
                set(g, getel(e, 4))
                set(r, getel(e, 5))
                set(d, getel(e, 6))
                k " " name(p) " " d(i) " "
                forlist (g, j, l) { d(getel(g, l)) " " }
                forlist (r, j, l) { call ShowRel(getel(r, l)) " " }
                forlist (d, c, l) { name(indi(c)) " " }
                "\n"
        }
}

proc ShowRel (r)
{
        if (eq(r, 1)) { "s" }
        if (gt(r, 1)) {
                list(RelStack)
                push(RelStack, neg(1))
                while (gt(r, 1)) {
                        set(m, mod(r, 2))
                        set(r, div(r, 2))
                        push(RelStack, m)
                }
                set(r, pop(RelStack))
                while (ne(r, neg(1))) {
                        if (r) { "m" }
                        else   { "f" }
                        set(r, pop(RelStack))
                }
        }
}

/* inlist -- See if a string is in a list of strings */

func inlist (l, s)
{
        forlist(l, e, n) {
                if (eqstr(e, s)) { return(1) }
        }
        return(0)
}

func savekey (k)
{
        if (e, lookup(KeyT, k)) {  return(e) }
        set(k, save(k))
        insert(KeyT, k, k)
        return(k)
}