home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TIERRA40.ZIP / TIERRA / RAMBANK.C < prev    next >
C/C++ Source or Header  |  1992-09-09  |  43KB  |  1,316 lines
  1. /* rambank.c   9-9-92  rambank manager for the Tierra Simulator */
  2. /* Tierra Simulator V4.0: Copyright (c) 1991, 1992 Tom Ray & Virtual Life */
  3.  
  4. #ifndef lint
  5. static char sccsid[] = "@(#)rambank.c    1.0        7/21/92";
  6.  
  7. #endif
  8.  
  9. #include "license.h"
  10. #include "tierra.h"
  11. #include "extern.h"
  12. #include <errno.h>
  13. #include <sys/types.h>
  14. #ifdef unix
  15. #include <dirent.h>
  16. #endif               /* unix */
  17. #ifdef __TURBOC__
  18. #include <dir.h>
  19. #include <dos.h>
  20. #define d_name ff_name
  21. #endif               /* __TURBOC__ */
  22.  
  23.  
  24. #ifdef MEM_CHK
  25. #include <memcheck.h>
  26. #endif
  27.  
  28. /*
  29.  * CheckGenotype(ce, flags)
  30.  * Check if cell ce is a new genotype.  If it is a new genotype, it will be
  31.  * assigned a unique label.  If this genotype is not present in the RAM
  32.  * genebank, it will be placed there, but there will be no demographic
  33.  * information updated (this is not assumed to be a birth or death).
  34.  * 
  35.  *  flags: bit 0  (1): check .gen files
  36.  *  flags: bit 1  (2): check .tmp files
  37.  *  flags: bit 2  (4): check files even if rambank does not indicate presence
  38.  *      of genotype on disk (used for startup of old or new soups).
  39.  *  flags: bit 3  (8): use all files in the genebank to assemble the list in
  40.  *      the rambank.  Each time a new size is checked, all genomes of that
  41.  *      size in the genebank will become listed in the rambank as being on
  42.  *      the disk (used for startup of old soups and for cumulative genebanks).
  43.  *      However, the genomes will remain on disk until they are actually
  44.  *      accessed, at which time they will be placed in the genequeue in RAM.
  45.  *  flags: bit 4 (16): when reading a file from the disk genebank,
  46.  *      zero bit 1 of the tgl->bits field, otherwise preserve it.
  47.  * 
  48.  *      if soup_in variable CumGeneBnk is non zero, bit 3 is forced ON 
  49.  * 
  50.  *      On the CM5, this function resides on the genebank processor.
  51.  */
  52.  
  53. GlIndex CheckGenotype(ce, flags)
  54.     Dem   ce;  /* demography structure of cell to be checked */
  55.     I32s  flags;
  56. {
  57.     I32s si;
  58.     GlIndex  GiHash;
  59.  
  60.     if(CumGeneBnk)
  61.         SetBit(&flags,3,ONE);
  62.     si = ce.gen.size;
  63.     GiHash.si = Hash(si, ce.genome);
  64.     ce.gi = Lbl2Int(ce.gen.label);
  65.     if (IsNewSize(si))
  66.         NewSize(&ce, flags);
  67.     if ((GiHash.gi = IsInGenQueue(&ce, GiHash.si)) >= 0)
  68.     {   gq_movtop(sl[si]->g[GiHash.gi]);
  69.         return GiHash;
  70.     }
  71. #ifndef CM5
  72.     if ((GiHash.gi = IsInGenBank(&ce, GiHash.si, flags)) >= 0)
  73.         return GiHash;
  74. #endif /* CM5 */
  75.     GiHash.gi = NewGenotype(&ce, GiHash.si);
  76.         /* register new genotype in the lists */
  77.     return GiHash;
  78. }
  79.  
  80. Event DivGenBook(ce, nc, InstExe, reaped, mom, same, disk)
  81.     Pcells  ce, nc; /* ce = mother cell, nc = daughter cell */
  82.     Event   InstExe; /* current time */
  83.     I32s    reaped; /* 1 = the reaper has acted */
  84.     I32s    mom;    /* 1 = do bookeeping on mother as well */
  85.     I32s    same;   /* 1 = daughter is same genotype as mother */
  86.     I32s    disk;   /* 1 = this creature originated from the disk (Inject) */
  87. {   GList   *tgl, *tcgl;
  88.     float   maxp, maxi;
  89.     int     si, gi;
  90.     Event   SizGen;
  91.  
  92.     SizGen.i = SizGen.m = 0;
  93.     if (mom) /* this code deals only with the mother of the cell being born */
  94.     {   tcgl = sl[si = ce->d.gen.size]->g[gi = ce->d.gi]; /* mother GList */
  95.         if (tcgl && (I32u) tcgl <= 4)
  96.         {
  97. #ifdef CM5
  98.             FEError(-100,EXIT,NOWRITE, 
  99.                 "Tierra DivideBookeep() mother genotype missing\n");
  100. #endif /* CM5 */
  101.             tcgl = sl[si]->g[gi] = gq_read(si, gi); /* mother GList */
  102.         }
  103.         if ((I32u) tcgl <= 4)
  104.             FEError(-100,EXIT,NOWRITE, 
  105.                 "Tierra DivideBookeep() mother genotype missing\n");
  106.         if (ce->d.fecundity == 1 && !ce->d.mut && !ce->d.flaw)
  107.             tcgl->d1 = ce->d.d1;
  108.         else if (ce->d.fecundity == 2 && !ce->d.mut && !ce->d.flaw)
  109.         {   tcgl->d2.inst = ce->d.inst + 1 - ce->d.d1.inst;
  110.             tcgl->d2.flags = ce->d.flags - ce->d.d1.flags;
  111.             tcgl->d2.mov_daught = ce->d.mov_daught;
  112.             tcgl->d2.BreedTrue = same;
  113.         }
  114.     }
  115.  
  116. /* the following code deals only with the cell being "born" */
  117.  
  118.     tgl = sl[si = nc->d.gen.size]->g[nc->d.gi];    /* new cell GList */
  119.     if (!tgl->pop)
  120.     {   SizGen.i = 1;
  121. /*      NumGenotypes++; */
  122.         sl[si]->num_g++;
  123.         if (disk)
  124.         {   NumGenDG++;
  125.             SetBit(&tgl->bits, 0, 1);
  126.             SetBit(&tgl->bits, 1, 0);
  127.         }
  128.     }
  129.     tgl->pop++;
  130.     if (!sl[si]->num_c)
  131.         SizGen.m = 1;
  132. /*      NumSizes++; */
  133.     sl[si]->num_c++;
  134. #if FRONTEND != STDIO
  135.     if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
  136.         query_spec_d(si,nc->d.gi);
  137. #endif /* FRONTEND != STDIO */
  138. /* this might be a good place to keep track of multiple parental genotypes. */
  139.     if (reaped)
  140.     {   maxp = (float) tgl->pop / (float) NumCells;
  141.         if (maxp > tgl->MaxPropPop)
  142.         {   tgl->MaxPropPop = maxp;
  143.             tgl->mpp_time   = InstExe;         
  144.         }
  145.         maxi = (float) tgl->pop * nc->d.gen.size / (float) SoupSize;
  146.         if (maxi > tgl->MaxPropInst)
  147.             tgl->MaxPropInst = maxi;
  148.     }
  149. #ifndef CM5
  150.     /* criteria for saving genotype to disk */
  151.     if (reaped && tgl->pop >= SavMinNum
  152.         && ((!IsBit(tgl->bits, 0) && (tgl->MaxPropPop > SavThrPop
  153.         || tgl->MaxPropInst > SavThrMem * .5))
  154.         || (!IsBit(tgl->bits, 1) && (maxp > SavThrPop
  155.         || maxi > SavThrMem * .5))))
  156.     {   if (!IsBit(tgl->bits, 0))
  157.         {   SetBit(&tgl->bits, 0, 1);
  158.             SetBit(&tgl->bits, 1, 1);
  159.             extract(nc);
  160.         }
  161.         else
  162.         {   SetBit(&tgl->bits, 1, 1);
  163.             sprintf(ExtrG, "%04ld%s @ %ld v", tgl->gen.size, tgl->gen.label,
  164.                 (GeneBnker)? tgl->pop : 0L);
  165. #if FRONTEND == STDIO
  166.             sprintf(mes[0], "extract: %s", ExtrG);
  167.             FEMessage(1,mes);
  168. #else /* FRONTEND == STDIO */
  169.             if (Log)
  170.                 fprintf(tfp_log, "ex = %s\n", ExtrG);
  171. #endif /* FRONTEND == STDIO */
  172.         }
  173.     }
  174. #endif /* CM5 */
  175.     return SizGen;
  176. }
  177.  
  178. Event ReapGenBook(ce)
  179.     Pcells  ce;
  180. {   Pgl tgl;
  181.     I32s  si = ce->d.gen.size;
  182.     I16s  gi = ce->d.gi;
  183.     Event   SizGen;
  184.  
  185.     SizGen.i = SizGen.m = 0;
  186.     tgl = sl[si]->g[gi];
  187. #ifdef ERROR
  188.     if (gi >= sl[si]->a_num)
  189.         FEError(-101,EXIT,NOWRITE, 
  190.             "Tierra ReapBookeep() genotype %hd out of range\n", gi);
  191.     if ((I32u) tgl <= 4)
  192.         FEError(-102,EXIT,NOWRITE, 
  193.             "Tierra ReapBookeep() genotype %hd not in genebank\n", gi);
  194. #endif /* ERROR */
  195.     tgl->pop--;    /* this is a segmentation fault waiting to happen! */
  196.     if (!tgl->pop)
  197.     {   if ((I32u) tgl > 4 && !IsBit(tgl->bits, 0))
  198.         {   if (tgl->genome)
  199.             {   tfree(tgl->genome);
  200.                 tgl->genome = NULL;
  201.             }
  202.             if (tgl->gbits)
  203.             {   tfree(tgl->gbits);
  204.                 tgl->gbits = NULL;
  205.             }
  206.             gq_rem(tgl);
  207.             tfree(tgl);
  208.             sl[si]->g[gi] = NULL;
  209.         }
  210.         else
  211.             SetBit(&tgl->bits, 1, 0);
  212. /*      NumGenotypes--; */
  213.         SizGen.i = -1;
  214.         sl[si]->num_g--;
  215.     }
  216.     sl[si]->num_c--;
  217.     if (!sl[si]->num_c)
  218.     {   SizGen.m = -1;
  219. /*      NumSizes--; */
  220. #ifdef ERROR
  221.         if (sl[si]->num_g)
  222.             FEError(-103,NOEXIT,NOWRITE, 
  223.                 "Tierra ReapBookeep() genotypes but no individuals\n");
  224. #endif /* ERROR */
  225.     }
  226. #if FRONTEND != STDIO
  227.     if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
  228.         query_spec_d(si,gi);
  229. #endif /* FRONTEND != STDIO */
  230.     return SizGen;
  231. }
  232.  
  233. I8s IsNewSize(si)
  234.     I32s si;
  235. {
  236.     if (si < siz_sl && sl[si])
  237.         return 0;
  238.     return 1;
  239. }
  240.  
  241. void NewSize(ce, flags)
  242.     Dem   *ce;
  243.     I32s  flags;
  244. {
  245.     I32s i, j, si;
  246.     I16s gi;
  247.     SList Fp Fp  tsl;
  248.     GList Fp Fp  tgl;
  249.     Pgl sgl = NULL;
  250. #ifndef CM5
  251.     FILE *afp;
  252.     head_t head;
  253.     indx_t *indx, *tindx, gindx;
  254. #endif /* CM5 */
  255.  
  256.     si = ce->gen.size;
  257.     if (si >= siz_sl)
  258.     {   tsl = (SList Fp Fp) trecalloc(sl,
  259.             sizeof(SList Fp) * (si + 1),
  260.             sizeof(SList Fp) * siz_sl);
  261.         if (tsl)
  262.             sl = tsl;
  263.         else if (sl)
  264.         {   tfree(sl);
  265.             sl = NULL;
  266.             FEError(-300,EXIT,WRITE, "Tierra NewSize() sl trecalloc error");
  267.         }
  268. #ifndef __TURBOC__
  269.         for (i = siz_sl; i <= si; i++)
  270.             sl[i] = NULL;
  271. #endif /* __TURBOC__ */
  272.         siz_sl = si + 1;
  273. #ifdef ERROR
  274.         sprintf(mes[0], "genebank: recalloc, siz_sl = %ld", siz_sl - 1);
  275.         FEMessage(1,mes);
  276. #endif
  277.     }
  278.     sl[si] = (SList *) tcalloc(1, sizeof(SList));
  279.     sl[si]->a_num = 20;
  280.     sl[si]->g = (GList **) tcalloc(20, sizeof(GList *));
  281. #ifndef CM5
  282.     if (IsBit(flags, 3))  /* use for old soups, and cumulative genebanks */
  283.     {
  284. #ifdef IBM3090
  285.         sprintf(Buff, "%04ld.gen.d", si);
  286. #else /* IBM3090 */
  287.         sprintf(Buff, "%s%04ld.gen", GenebankPath, si);
  288. #endif /* IBM3090 */
  289.         afp = fopen(Buff, "rb");
  290.         if (!afp) return;
  291.         head = read_head(afp);
  292. #ifdef __TURBOC__
  293.         indx = &gindx;
  294. #else  /* __TURBOC__ */
  295.         indx = read_indx(afp, &head);
  296. #endif /* __TURBOC__ */
  297.         for (i = head.n - 1; i >= 0; i--)
  298.         {
  299. #ifdef __TURBOC__
  300.             find_gen(afp, indx, "---", i);
  301.             tindx = indx;
  302. #else  /* __TURBOC__ */
  303.             tindx = &indx[i];
  304. #endif /* __TURBOC__ */
  305.             sgl = get_gen(afp, &head, tindx, i);
  306.             gi = Lbl2Int(sgl->gen.label);
  307.             if (gi >= sl[si]->a_num)
  308.             {   tgl = (GList Fp Fp) trecalloc(sl[si]->g,
  309.                     sizeof(GList *) * (gi + 1),
  310.                     sizeof(GList *) * sl[si]->a_num);
  311.                 if (tgl)
  312.                     sl[si]->g = tgl;
  313.                 else if (sl[si]->g)
  314.                 {   tfree(sl[si]->g);
  315.                     sl[si]->g = NULL;
  316.                     FEError(-301,EXIT,WRITE,
  317.                         "Tierra NewSize() sl[si]->g trecalloc error");
  318.                 }
  319. #ifndef __TURBOC__
  320.                 for (j = sl[si]->a_num; j <= gi; j++)
  321.                     sl[si]->g[j] = NULL;
  322. #endif /* __TURBOC__ */
  323.                 sl[si]->a_num = gi + 1;
  324.             }
  325.             sl[si]->g[gi] = (Pgl)1;    /* permanent genotype name */
  326.             if (sgl)
  327.             {   if (sgl->genome)
  328.                 {   tfree(sgl->genome);
  329.                     sgl->genome = NULL;
  330.                 }
  331.                 if (sgl->gbits)
  332.                 {   tfree(sgl->gbits);
  333.                     sgl->gbits = NULL;
  334.                 }
  335.                 tfree(sgl);
  336.                 sgl = NULL;
  337.             }
  338.         }
  339.         fclose(afp);
  340. #ifndef __TURBOC__
  341.         if (indx)
  342.         {   thfree(indx);
  343.             indx = NULL;
  344.         }
  345. #endif /* __TURBOC__ */
  346.     }
  347. #endif /* CM5 */
  348. }
  349.  
  350. I16s IsInGenQueue(ce, hash)/* returns the index of the genotype in the list */
  351.     Dem   *ce;
  352.     I32s  hash;
  353. {
  354.     I32s si = ce->gen.size;
  355.     I16s gi = ce->gi, i;
  356.     GList  *tgl;
  357.  
  358.     if (gi >= 0)
  359.     {   if (gi < sl[si]->a_num && (I32u) sl[si]->g[gi] > 4)
  360.             return gi;
  361.         return -1;
  362.     }
  363.     for (i = 0; i < sl[si]->a_num; i++)
  364.     {   tgl = sl[si]->g[i];
  365. #ifdef ERROR
  366.         if ((I32u) tgl > 4)
  367.         {   if (IsSameGen(si, ce->genome, tgl->genome))
  368.             {   if (hash != tgl->hash)
  369.                     FEError(-1501,EXIT,WRITE,
  370.                 "Tierra IsInGenQueue() error: IsSameGen, but not same hash");
  371.             }
  372.         }
  373. #endif /* ERROR */
  374.         if ((I32u) tgl > 4 && hash == tgl->hash &&
  375.             IsSameGen(si, ce->genome, tgl->genome))
  376.                 return i;
  377.     }
  378.     return -1;
  379. }
  380.  
  381. /*
  382.  * Check to see if ce is in the disk genebank.  This will require the reading
  383.  * of successive genotypes of this size from the .gen files on disk.
  384.  * Each genotype that is read will be placed in the genequeue and the complete
  385.  * genome will be placed in the rambank.
  386.  */
  387.  
  388. #ifndef CM5
  389.  
  390. I16s IsInGenBank(ce, hash, flags)
  391.     Dem   *ce;
  392.     I32s  hash, flags;
  393. {
  394.     static char *ext[] = {"gen", "tmp"};
  395.     I32s i, si = ce->gen.size;
  396.     I32u t, j, n;
  397.     I16s gi = ce->gi;
  398.     Pgl g;
  399.     FILE *afp;
  400.     head_t head;
  401.     indx_t *indx, *tindx, gindx;
  402.     GList Fp Fp  tgl;
  403.  
  404.     /*
  405.      * return -1 if we are looking for a specific geneotype, and it does not
  406.      * appear in the genequeue list, and we are not starting up a soup
  407.      */
  408.     if (gi >= 0 && !sl[si]->g[gi] && !IsBit(flags, 2))
  409.         return -1;
  410.     for (i = 0; i < 2; i++) if (IsBit(flags, i))
  411.     {
  412. #ifdef IBM3090
  413.         sprintf(Buff, "%04ld.%s.d", si, ext[i]);
  414. #else
  415.         sprintf(Buff, "%s%04ld.%s", GenebankPath, si, ext[i]);
  416. #endif
  417.         if (afp = fopen(Buff, "rb"))
  418.         {   head = read_head(afp);
  419. #ifdef __TURBOC__
  420.             indx = &gindx;
  421. #else  /* __TURBOC__ */
  422.             indx = read_indx(afp, &head);
  423. #endif /* __TURBOC__ */
  424.         }
  425.         else continue;
  426.         if (gi >= 0)  /* if we know what genotype we are looking for */
  427.         {   if (gi >= sl[si]->a_num)
  428.             {   tgl = (GList Fp Fp) trecalloc(sl[si]->g,
  429.                     sizeof(GList Fp) * (gi+1),
  430.                     sizeof(GList Fp) * sl[si]->a_num);
  431.                 if (tgl)
  432.                     sl[si]->g = tgl;
  433.                 else if (sl[si]->g)
  434.                 {   tfree(sl[si]->g);
  435.                     sl[si]->g = NULL;
  436.                     FEError(-302,EXIT,WRITE,
  437.                         "Tierra IsInGenBank() sl[si]->g trecalloc error");
  438.                 }
  439. #ifndef __TURBOC__
  440.                 for (j = sl[si]->a_num; j <= gi; j++)
  441.                     sl[si]->g[j] = NULL;
  442. #endif /* __TURBOC__ */
  443.                 sl[si]->a_num = gi + 1;
  444.             }
  445.             n = find_gen(afp, indx, Int2Lbl(gi), head.n);
  446.             if (n < head.n)
  447.             {
  448. #ifdef __TURBOC__
  449.                 tindx = indx;
  450. #else  /* __TURBOC__ */
  451.                 tindx = &indx[n];
  452. #endif /* __TURBOC__ */
  453.                 sl[si]->g[gi] = g = get_gen(afp, &head, tindx, n);
  454.                 if (IsBit(flags, 4))
  455.                     SetBit(&g->bits, 1, 0);
  456.                 gq_add(g);
  457. #ifdef ERROR
  458.                 if (IsSameGen(si, (FpInst) (ce->genome), g->genome))
  459.                 {   if (hash != g->hash)
  460.                         FEError(-1503,EXIT,WRITE,
  461.                  "Tierra IsInGenBank() error: IsSameGen, but not same hash");
  462.                 }
  463. #endif /* ERROR */
  464.                 /* if disk genotype matches soup genotype */
  465.                 /* name cell and put genotype in genequeue */
  466.                 if (hash == g->hash &&
  467.                     IsSameGen(si, (FpInst) (ce->genome), g->genome))
  468.                 {   ce->gen = g->gen;
  469.                     ce->gi = gi;
  470. #ifndef __TURBOC__
  471.                     if (indx)
  472.                     {   thfree(indx);
  473.                         indx = NULL;
  474.                     }
  475. #endif /* __TURBOC__ */
  476.                     fclose(afp);
  477.                     return gi;
  478.                 }
  479.             }
  480.         }
  481.         else /* we don't know what genotype we are looking for */
  482.         /*
  483.          * check only genotypes that are listed in the rambank as on
  484.          * disk, but whose genomes are not held in the rambank
  485.          * (0 < sl[si]->g[j] <= 4); or which are not listed in the
  486.          * rambank at all (!sl[si]->g[j]), if bit 2 is set, which
  487.          * means we are starting a new or old soup and don't have
  488.          * a list of what is on disk. 
  489.          */
  490.         for (j = 0; j < sl[si]->a_num; j++)
  491.         {   if (!((I32s) sl[si]->g[j] > 0 && (I32s) sl[si]->g[j] <= 4
  492.                     || !sl[si]->g[j] && IsBit(flags, 2)))
  493.                 continue;
  494.             n = find_gen(afp, indx, Int2Lbl(j), head.n);
  495.             if (n < head.n)
  496.             {
  497. #ifdef __TURBOC__
  498.                 tindx = indx;
  499. #else  /* __TURBOC__ */
  500.                 tindx = &indx[n];
  501. #endif /* __TURBOC__ */
  502.                 sl[si]->g[j] = g = get_gen(afp, &head, tindx, n);
  503.                 if (IsBit(flags, 4))
  504.                     SetBit(&g->bits, 1, 0);
  505.                 gq_add(g);
  506.                 /* if disk genotype matches soup genotype */
  507.                 /* name cell and put genotype in genequeue */
  508.                 if (hash == g->hash &&
  509.                     IsSameGen(si, ce->genome, g->genome))
  510.                 {   ce->gen = g->gen;
  511.                     ce->gi = j;
  512. #ifndef __TURBOC__
  513.                     if (indx)
  514.                     {   thfree(indx);
  515.                         indx = NULL;
  516.                     }
  517. #endif /* __TURBOC__ */
  518.                     fclose(afp);
  519.                     return j;
  520.                 }
  521.             }
  522.         }
  523.         if (afp)
  524.         {
  525. #ifndef __TURBOC__
  526.             if (indx)
  527.             {   thfree(indx);
  528.                 indx = NULL;
  529.             }
  530. #endif /* __TURBOC__ */
  531.             fclose(afp);
  532.         }
  533.     }
  534.     return -1;
  535. }
  536.  
  537. #endif /* CM5 */
  538.  
  539. /*
  540.  * add a new genotype to the RAM list
  541.  */
  542.  
  543. I16s NewGenotype(ce, hash)
  544.     Dem   *ce;
  545.     I32s  hash;
  546. {
  547.     GList  *tgl;
  548.     I32s   i, j, size = ce->gen.size;
  549.     I16s   gi;
  550.     I8s    found = 0;
  551.     GList Fp Fp  tglp;
  552.  
  553.     /* find a free name if there is one */
  554.     for (i = 0; i < sl[size]->a_num; i++) if (!sl[size]->g[i])
  555.     {   gi = i;
  556.         found = 1;
  557.         break;
  558.     }
  559.     if (!found)
  560.     {   gi = sl[size]->a_num;
  561.         tglp = (GList Fp Fp) trecalloc(sl[size]->g,
  562.             sizeof(GList Fp) * (gi + 4),
  563.             sizeof(GList Fp) * gi);
  564.         if (tglp)
  565.             sl[size]->g = tglp;
  566.         else if (sl[size]->g)
  567.         {   tfree(sl[size]->g);
  568.             sl[size]->g = NULL;
  569.             FEError(-303,EXIT,WRITE,
  570.                 "Tierra NewGenotype() sl[size]->g trecalloc error");
  571.         }
  572. #ifndef __TURBOC__
  573.         for (i = gi; i < gi + 4; i++)
  574.             sl[size]->g[i] = NULL;
  575. #endif /* __TURBOC__ */
  576.         sl[size]->a_num += 4;
  577.     }
  578.     sl[size]->g[gi] = tgl =
  579.         (GList *) tcalloc(1, sizeof(GList));
  580.     tgl->gen.size = ce->gen.size = size;
  581.     tgl->genome = (FpInst) tcalloc(size, sizeof(Instruction));
  582.     if (tgl->genome == NULL)
  583.         FEError(-304,EXIT,WRITE, "Tierra NewGenotype() tcalloc error 1");
  584.     tgl->gbits = (FpGenB) tcalloc(size, sizeof(GenBits));
  585.     if (tgl->gbits == NULL)
  586.         FEError(-305,EXIT,WRITE, "Tierra NewGenotype() tcalloc error 2");
  587.     gq_add(tgl);
  588.     for (i = 0; i < size; i++) 
  589. #if PLOIDY == 1
  590.         tgl->genome[i] = ce->genome[i];
  591. #else
  592.         for (j = 0; j < PLOIDY; j++)
  593.         tgl->genome[i][j] = ce->genome[i][j];
  594. #endif
  595.     strcpy(tgl->gen.label, Int2Lbl(gi));
  596.     tgl->originC = time(NULL);
  597.     tgl->originI = InstExe;
  598.     tgl->parent = ce->parent;
  599.     tgl->bits = 0;
  600.     tgl->hash = hash;
  601.     tgl->pop = 0;
  602.     if (reaped)
  603.     {   tgl->MaxPropPop = (float) 1 / (float) NumCells;
  604.         tgl->MaxPropInst = (float) size / (float) SoupSize;
  605.         tgl->mpp_time = InstExe;
  606.     }
  607.     tgl->ploidy = ce->ploidy;
  608.     tgl->track = ce->tr;
  609.     return gi;
  610. }
  611.  
  612. void gq_add(p)
  613.     GList  *p;
  614. {
  615.     if (!NumGenRQ++)
  616.     {   gq_top = gq_bot = p->a = p->b = p;
  617.         return;
  618.     }
  619.     /* NumGenotypes hasn't been updated yet so add 1 in test */
  620.     while (NumGenRQ > RamBankSiz && NumGenRQ > NumGenotypes + 1)
  621.         gq_swap();
  622.     p->b = gq_top;
  623.     gq_top = gq_top->a = p->a = p;
  624. }
  625.  
  626. I8s gq_swap()
  627. {   GList  *p;
  628.     I8s saved = 0;
  629.     FILE *fp;
  630.     head_t head;
  631.     indx_t *indx, gindx;
  632.  
  633.     p = gq_bot;
  634.     while (p->pop > 0 && p != gq_top)
  635.         p = p->a;
  636.     if (p->pop > 0)
  637.     {   if (gq_bot != gq_top)
  638.         {   p = gq_bot;
  639.             GoDown = 1;
  640.             IMode = PLN_STATS;
  641.             sprintf(mes[0], "gq_swap: NumGenRQ = %ld  NumGenotypes = %ld\n",
  642.                 NumGenRQ, NumGenotypes);
  643.             sprintf(mes[1],
  644.                 "         all genotypes extant, living genome deleted\n");
  645.             sprintf(mes[2],
  646.   "system coming down, then bring back up, to defragment memory, or:\n");
  647.             sprintf(mes[3],
  648. "try higher SavThrMem & SavThrPop, lower SoupSize, or turn off genebanker\n");
  649.             FEMessage(4,mes);
  650.         }
  651.         else
  652.         {   sprintf(mes[0], "gq_swap: NumGenRQ = %ld  NumGenotypes = %ld\n",
  653.                 NumGenRQ, NumGenotypes);
  654.             sprintf(mes[1],
  655.                 "         attempt to swap out last living genome\n");
  656.             FEMessage(2,mes);
  657.             FEError(-306,EXIT,NOWRITE,
  658. "try higher SavThrMem & SavThrPop, lower SoupSize, or turn off genebanker\n");
  659.             return 0;
  660.         }
  661.     }
  662.     saved = IsBit(p->bits, 0);
  663.     sprintf(Buff,
  664. #ifdef IBM3090
  665.         "%04ld.%s.d",
  666. #else  /* IBM3090 */
  667.         "%s%04ld.%s", GenebankPath,
  668. #endif /* IBM3090 */
  669.         p->gen.size, "gen");
  670.     if (!(fp = open_ar(Buff, p->gen.size, GFormat, -1)))
  671.         FEError(-307,EXIT,WRITE,    
  672.             "Tierra gq_swap() unable to open genome file %s",Buff);
  673.     head = read_head(fp);
  674. #ifdef __TURBOC__
  675.     indx = &gindx;
  676. #else  /* __TURBOC__ */
  677.     indx = read_indx(fp, &head);
  678. #endif /* __TURBOC__ */
  679.     add_gen(fp, &head, &indx, p);
  680. #ifndef __TURBOC__
  681.     if (indx)
  682.     {   thfree(indx);
  683.         indx = NULL;
  684.     }
  685. #endif /* __TURBOC__ */
  686.     fclose(fp);
  687.     gq_rem(p);
  688.     if (p)
  689.     {   if (p->gbits)
  690.         {   tfree(p->genome);
  691.             p->genome = NULL;
  692.         }
  693.         if (p->gbits)
  694.         {   tfree(p->gbits);
  695.             p->gbits = NULL;
  696.         }
  697.         sl[p->gen.size]->g[Lbl2Int(p->gen.label)] = (Pgl) saved;
  698.         tfree(p);
  699.         p = NULL;
  700.     }
  701.     return 1;
  702. }
  703.  
  704. void gq_rem(p)
  705.     GList  *p;
  706. {
  707.     if (gq_top == gq_bot)
  708.         gq_top = gq_bot = 0;
  709.     else if (p == gq_top)
  710.         gq_top = p->b->a = p->b;
  711.     else if (p == gq_bot)
  712.         gq_bot = p->a->b = p->a;
  713.     else
  714.     {   p->a->b = p->b;
  715.         p->b->a = p->a;
  716.     }
  717.     NumGenRQ--;
  718. }
  719.  
  720. void gq_movtop(p)
  721.     GList  *p;
  722. {
  723.     if (p == gq_top)
  724.         return;
  725.     gq_rem(p);
  726.     gq_add(p);
  727. }
  728.  
  729. GList *gq_read(si, gi)
  730. {   GList *p = sl[si]->g[gi];
  731.     I16s n;
  732.     FILE *fp;
  733.     head_t head;
  734.     indx_t *indx, *tindx, gindx;
  735.  
  736.     if ((I32u) p > 4)
  737.         return p;
  738.     sprintf(Buff,
  739. #ifdef IBM3090
  740.         "%04ld.%s.d",
  741. #else
  742.         "%s%04ld.%s", GenebankPath,
  743. #endif
  744.         si, (I32u) p == 1 ? "gen" : "mem");
  745.     if (!(fp = open_ar(Buff, si, GFormat, 0)))
  746.         FEError(-308,EXIT,WRITE,    
  747.             "Tierra gq_read() unable to open genome file %s",Buff);
  748.     head = read_head(fp);
  749. #ifdef __TURBOC__
  750.     indx = &gindx;
  751. #else  /* __TURBOC__ */
  752.     indx = read_indx(fp, &head);
  753. #endif /* __TURBOC__ */
  754.     n = find_gen(fp, indx, Int2Lbl(gi), head.n);
  755. #ifdef __TURBOC__
  756.     tindx = indx;
  757. #else  /* __TURBOC__ */
  758.     tindx = &indx[n];
  759. #endif /* __TURBOC__ */
  760.     p = get_gen(fp, &head, tindx, n);
  761.     fclose(fp);
  762. #ifndef __TURBOC__
  763.     if (indx)
  764.     {   thfree(indx);
  765.         indx = NULL;
  766.     }
  767. #endif /* __TURBOC__ */
  768.     gq_add(p);
  769.     return p;
  770. }
  771.  
  772. void printq()
  773. {   GList  *p;
  774.     int    i = 1;
  775.  
  776.     printf("%ld:B ", NumGenRQ);
  777.     if (p = gq_bot)
  778.     {   printf("%ld%s[%ld] ", p->gen.size, p->gen.label, p->pop);
  779.         while (p != gq_top)
  780.         {   p = p->a, i++;
  781.             printf("%ld%s[%ld] ", p->gen.size, p->gen.label, p->pop);
  782.         }
  783.     }
  784.     printf("%d:T\n", i);
  785. }
  786.  
  787. #ifdef ERROR
  788.  
  789. void VerifyGB() /* verify genebank */
  790. {   I32s  gNumSizes = 0, cNumSizes = 0, cgNumSizes = 0;
  791.     I32s  gNumGenot = 0, cNumGenot = 0, cgNumGenot = 0;
  792.     I32s  gNumCells = 0, cNumCells = 0, cgNumCells = 0;
  793.     I32s  cgsNumGenot = 0, ggNumGenot = 0;
  794.     I32s  cgsNumCells = 0, ggNumCells = 0;
  795.     I32s  tsiz_sl = 1, si, ar, ci;
  796.     I16s  gi;
  797.     Pcells ce;
  798.     GList  Fp pgl;
  799.     SList  Fp Fp tsl, Fp psl;
  800.  
  801.     /* begin cells array check */
  802.     tsl = (SList Fp Fp) tcalloc(1, sizeof(SList Fp));
  803.     for (ar = 0; ar < NumCelAr; ar++) for (ci = 0; ci < CelArSiz; ci++)
  804.     {   if (ar == 0 && ci < 2)
  805.             continue;
  806.         ce = &cells[ar][ci];
  807.         if (ce->ld)
  808.         {   cNumCells++;
  809.             si = ce->d.gen.size;
  810.             if (si >= siz_sl)
  811.                 FEError(-110,EXIT,WRITE,
  812.                  "Tierra VerifyGB() size %ld out of range in genebank\n", si);
  813.             psl = sl[si];
  814.             if (!psl)
  815.                 FEError(-111,EXIT,WRITE,
  816.                  "Tierra VerifyGB() sl[%ld] not allocated in genebank\n", si);
  817.             gi = ce->d.gi;
  818.             if (gi >= psl->a_num)
  819.                 FEError(-112,EXIT,WRITE,
  820.                "Tierra VerifyGB() genome %hd out of range in genebank\n", gi);
  821.             pgl = psl->g[gi];
  822.             if ((I32u) pgl < 4)
  823.                 FEError(-113,EXIT,WRITE,
  824.                  "Tierra VerifyGB() gl[%hd] not allocated in genebank\n", gi);
  825.             if (!IsSameGen(si, soup + ce->mm.p, pgl->genome))
  826.                 FEError(-114,EXIT,WRITE,
  827.                     "Tierra VerifyGB() cell and genebank do not match\n");
  828.             if (si >= tsiz_sl)
  829.             {   tsl = (SList Fp Fp) trecalloc(tsl,
  830.                     (si + 1) * sizeof(SList Fp), tsiz_sl * sizeof(SList Fp));
  831.                 tsiz_sl = si + 1;
  832.             }
  833.             if (!tsl[si])
  834.             {   tsl[si] = (SList Fp) tcalloc(1, sizeof(SList));
  835.                 tsl[si]->g = (GList Fp Fp) tcalloc(gi + 1, sizeof(GList Fp));
  836.                 tsl[si]->a_num = gi + 1;
  837.             }
  838.             if (!tsl[si]->num_c)
  839.             {   if (tsl[si]->num_g)
  840.                     FEError(-115,NOEXIT,NOWRITE,
  841.                     "Tierra VerifyGB() !tsl[si]->num_c but tsl[si]->num_g\n");
  842.                 cNumSizes++;
  843.             }
  844.             tsl[si]->num_c++;
  845.             if (gi >= tsl[si]->a_num)
  846.             {   tsl[si]->g = (GList Fp Fp) trecalloc(tsl[si]->g,
  847.                     (gi + 1) * sizeof(GList Fp),
  848.                     tsl[si]->a_num * sizeof(GList Fp));
  849.                 tsl[si]->a_num = gi + 1;
  850.             }
  851.             if ((I32u) tsl[si]->g[gi] < 4)
  852.             {   tsl[si]->g[gi] = (GList Fp) tcalloc(1, sizeof(GList));
  853.                 cNumGenot++;
  854.                 tsl[si]->num_g++;
  855.             }
  856.             tsl[si]->g[gi]->pop++;
  857.         }
  858.     } /* check and free temporary genebank */
  859.     for (si = 0; si < tsiz_sl; si++)
  860.     {   if (tsl[si])
  861.         {   if (tsl[si]->num_c != sl[si]->num_c)
  862.                 FEError(-116,NOEXIT,NOWRITE,
  863.              "Tierra VerifyGB() tsl[%ld]->num_c != sl[%ld]->num_c\n", si, si);
  864.             if (tsl[si]->num_g != sl[si]->num_g)
  865.                 FEError(-117,NOEXIT,NOWRITE,
  866.              "Tierra VerifyGB() tsl[%ld]->num_g != sl[%ld]->num_g\n", si, si);
  867.             if (tsl[si]->num_c && tsl[si]->g)
  868.             {   cgNumSizes++;
  869.                 cgsNumCells += tsl[si]->num_c;
  870.                 cgsNumGenot += tsl[si]->num_g;
  871.                 for (gi = 0; gi < tsl[si]->a_num; gi++)
  872.                 {   if ((I32u) tsl[si]->g[gi] > 4)
  873.                     {   if (tsl[si]->g[gi]->pop != sl[si]->g[gi]->pop)
  874.                             FEError(-118,NOEXIT,NOWRITE,
  875.           "Tierra VerifyGB() tsl[%ld]->g[%hd]->pop != sl[%ld]->g[%hd]->pop\n",
  876.                                 si, gi, si, gi);
  877.                         cgNumGenot++;
  878.                         cgNumCells += tsl[si]->g[gi]->pop;
  879.                         tfree(tsl[si]->g[gi]);
  880.                     }
  881.                 }
  882.                 tfree(tsl[si]->g);
  883.                 tfree(tsl[si]);
  884.             }
  885.         }
  886.     }
  887.     tfree(tsl);
  888.     if (NumCells != cNumCells || NumCells != cgNumCells ||
  889.         NumCells != cgsNumCells)
  890.         FEError(-119,NOEXIT,NOWRITE,
  891.             "Tierra VerifyGB() NumCells cells array inconsistency\n");
  892.     if (NumGenotypes != cNumGenot || NumGenotypes != cgNumGenot ||
  893.         NumGenotypes != cgsNumGenot)
  894.         FEError(-120,NOEXIT,NOWRITE,
  895.             "Tierra VerifyGB() NumGenot cells array inconsistency\n");
  896.     if (NumSizes != cNumSizes || NumSizes != cgNumSizes)
  897.         FEError(-121,NOEXIT,NOWRITE,
  898.             "Tierra VerifyGB() NumSizes cells array inconsistency\n");
  899.     /* end cells array check */
  900.  
  901.     /* begin genebank check */
  902.     for (si = 0; si < siz_sl; si++)
  903.     {   psl = sl[si];
  904.         if (!psl)
  905.             continue ;
  906.         if (!psl->num_c || !psl->num_g)
  907.             FEError(-122,NOEXIT,NOWRITE,
  908.                 "Tierra VerifyGB() !sl[si]->num_c or !sl[si]->num_g\n");
  909.         if (sl[si]->num_c)
  910.         {   gNumSizes++;
  911.             ggNumCells += sl[si]->num_c;
  912.         }
  913.         if (sl[si]->num_g)
  914.             ggNumGenot += sl[si]->num_g;
  915.         for (gi = 0; gi < sl[si]->a_num; gi++)
  916.         {   pgl = psl->g[gi];
  917.             if ((I32u) pgl < 4 || !pgl->pop)
  918.                 continue ;
  919.             gNumGenot++;
  920.             gNumCells += pgl->pop;
  921.         }
  922.     }
  923.     if (NumCells != gNumCells || NumCells != ggNumCells)
  924.         FEError(-123,NOEXIT,NOWRITE,
  925.             "Tierra VerifyGB() NumCells genebank inconsistency\n");
  926.     if (NumGenotypes != gNumGenot || NumGenotypes != ggNumGenot)
  927.         FEError(-124,NOEXIT,NOWRITE,
  928.             "Tierra VerifyGB() NumGenot genebank inconsistency\n");
  929.     if (NumSizes != gNumSizes)
  930.         FEError(-125,NOEXIT,NOWRITE,
  931.             "Tierra VerifyGB() NumSizes genebank inconsistency\n");
  932.     /* end genebank check */
  933. }
  934.  
  935. #endif /* ERROR */
  936.  
  937. void GarbageCollectGB()
  938. {   I32s  i, j, maxsiz = 0, tail;
  939.     GList  Fp Fp tgl, Fp pgl;
  940.     SList  Fp Fp tsl;
  941.     I8s     path[80];
  942.     FILE    *fp;
  943.     head_t  head;
  944.     indx_t  *indx, gindx;
  945.  
  946.     for (i = siz_sl - 1; i >= 0; i--)      /* for each allocated size class */
  947.     {   if (sl[i])
  948.         {   if (sl[i]->num_c)
  949.             {   if (!maxsiz)                     /* find largest size class */
  950.                     maxsiz = i;
  951.                 tail = -1;
  952.                 for (j = sl[i]->a_num - 1; j >= 0; j--)
  953.                 {   if ((I32u) (pgl = sl[i]->g[j]) > 4 && !pgl->pop
  954.                         && !IsBit(pgl->bits, 0))
  955.                     {   gq_rem(pgl);
  956.                         if (pgl->genome)
  957.                         {   tfree(pgl->genome);
  958.                             pgl->genome = NULL;
  959.                         }
  960.                         if (pgl->gbits)
  961.                         {   tfree(pgl->gbits);
  962.                             pgl->gbits = NULL;
  963.                         }
  964.                         tfree(sl[i]->g[j]);
  965.                         sl[i]->g[j] = NULL;
  966.                     }
  967.                     if (tail < 0 && sl[i]->g[j])
  968.                         tail = j;    /* skip empty geotypes at end of array */
  969.                 }
  970.                 if (tail < sl[i]->a_num - 1)
  971.                 {   if (tail < 0)             /* no genotypes in size class */
  972.                     {   if (sl[i]->g)
  973.                         {   tfree(sl[i]->g);
  974.                             sl[i]->g = NULL;
  975.                         }
  976.                         if (sl[i])
  977.                         {   tfree(sl[i]);
  978.                             sl[i] = NULL;
  979.                         }
  980.                     }
  981.                     else           /* shorten g arrays to avoid empty tails */
  982.                     {   tgl = (GList Fp Fp) trecalloc(sl[i]->g,
  983.                             (tail + 1) * sizeof(GList Fp),
  984.                             sl[i]->a_num * sizeof(GList Fp));
  985.                         if (tgl)
  986.                             sl[i]->g = tgl;
  987.                         else if (sl[i]->g)
  988.                         {   tfree(sl[i]->g);
  989.                             sl[i]->g = NULL;
  990.                             FEError(-126,EXIT,WRITE,
  991.                       "Tierra GarbageCollectGB() sl[i]->g trecalloc error\n");
  992.                         }
  993.                         sl[i]->a_num = tail + 1;
  994.                     }
  995.                 }
  996.             }
  997.             else /* no creatures of this size, free sl[i] and sl[i]->g */
  998.             {   sprintf(path, "%s%04ld.gen", GenebankPath, i);
  999.                 fp = open_ar(path, i, GFormat, -1);
  1000.                 head = read_head(fp);
  1001. #ifdef __TURBOC__
  1002.                 indx = &gindx;
  1003. #else  /* __TURBOC__ */
  1004.                 indx = read_indx(fp, &head);
  1005. #endif /* __TURBOC__ */
  1006.  
  1007.                 for (j = sl[i]->a_num - 1; j >= 0; j--)
  1008.                     if ((I32u) (pgl = sl[i]->g[j]) > 4)
  1009.                     {   if (pgl->pop)
  1010.                             FEError(-127,NOEXIT,NOWRITE,
  1011.  "Tierra GarbageCollectGB(), pgl = %ld, pgl->pop not zero, can't free\n",
  1012.      (I32s) pgl);
  1013.                         if (IsBit(pgl->bits, 0)) /* save genome to disk */
  1014.                             add_gen(fp, &head, &indx, pgl);
  1015.                         if (pgl->genome)
  1016.                         {   tfree(pgl->genome);
  1017.                             pgl->genome = NULL;
  1018.                         }
  1019.                         if (pgl->gbits)
  1020.                         {   tfree(pgl->gbits);
  1021.                             pgl->gbits = NULL;
  1022.                         }
  1023.                         gq_rem(pgl);
  1024.                         tfree(sl[i]->g[j]);
  1025.                         sl[i]->g[j] = NULL;
  1026.                     }
  1027.                 fclose(fp);
  1028.                 if (!head.n)
  1029.                     unlink(path);
  1030. #ifndef __TURBOC__
  1031.                 if (indx)
  1032.                 {   thfree(indx);
  1033.                     indx = NULL;
  1034.                 }
  1035. #endif /* __TURBOC__ */
  1036.                 if (sl[i]->g)
  1037.                 {   tfree(sl[i]->g);
  1038.                     sl[i]->g = NULL;
  1039.                 }
  1040.                 if (sl[i])
  1041.                 {   tfree(sl[i]);
  1042.                     sl[i] = NULL;
  1043.                 }
  1044.             }
  1045.         }
  1046.     }
  1047.     if (maxsiz < siz_sl - 1)
  1048.     {   tsl = (SList Fp Fp) trecalloc(sl, (maxsiz + 1) * sizeof(SList Fp),
  1049.             siz_sl * sizeof(SList Fp));
  1050.         if (tsl)
  1051.             sl = tsl;
  1052.         else if (sl)
  1053.         {   tfree(sl);
  1054.             sl = NULL;
  1055.    FEError(-128,EXIT,WRITE, "Tierra GarbageCollectGB() sl trecalloc error\n");
  1056.         }
  1057.         siz_sl = maxsiz + 1;
  1058.     } /* end garbage collect for genebank */
  1059. }
  1060.  
  1061. #ifdef CM5
  1062.  
  1063. struct MaxGen FindMaxGen()
  1064. {   I32s  i, j, pop, mem, MaxPop = 0, MaxMem = 0;
  1065.     Genotype  MaxGenPop, MaxGenMem;
  1066.  
  1067.     for (i = siz_sl - 1; i >= 0; i--)      /* for each allocated size class */
  1068.     {   if (sl[i] && sl[i]->num_c)
  1069.         {   for (j = sl[i]->a_num - 1; j >= 0; j--)
  1070.             {   if ((I32u) (pgl = sl[i]->g[j]) > 4 && pop = pgl->pop)
  1071.                 {   mem = pop * ce->d.gen.size;
  1072.                     if (pop > MaxPop)
  1073.                     {   MaxPop = pop;
  1074.                         MaxGenPop.size = i;
  1075.                         strcpy(MaxGenPop.gen, Int2Lbl(j));
  1076.                     }
  1077.                     if (mem > MaxMem)
  1078.                     {   MaxMem = mem;
  1079.                         MaxGenMem.size = i;
  1080.                         strcpy(MaxGenMem.gen, Int2Lbl(j));
  1081.                     }
  1082.                 }
  1083.             }
  1084.         }
  1085.     }
  1086. }
  1087.  
  1088. #endif /* CM5 */
  1089.  
  1090. void GenExTemp(adrt, ce, tsize)
  1091.     I32s     adrt;  /* address of beginning of template */
  1092.     Pcells  ce;    /* ce = cell executing instruction */
  1093.     I32s    tsize; /* template size */
  1094. {
  1095.     I32s  i;
  1096.     I32u  who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
  1097.                 /* 3 free memory; 4 daughter of other cell */
  1098.     I32s   dist;
  1099.     Pgl   tgl, ogl;
  1100.     Pcells  ct;
  1101.  
  1102.     tgl = sl[ce->d.gen.size]->g[ce->d.gi];
  1103.     for (i = 0; i < tsize; i++)
  1104.     {   ct = ce;  /* WHAT TO DO WITH THIS? */
  1105.         who = WhoIs(&ct, ad(ce->c.ip + 1 + i)); /* who has template pattern */
  1106.         if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (12 + who));
  1107.         else tgl->bits |= (I32u) (ONE << (I32u) (12 + 2));
  1108.         if (!who)
  1109.         {   dist = ad(ce->c.ip + 1 + i) - ce->mm.p;
  1110.             dist = ad(dist);
  1111. #ifdef ERROR
  1112.             if (tgl->genome == NULL || dist < 0 || dist >= tgl->gen.size)
  1113.                 FEError(-131,EXIT,WRITE, "Tierra GenExTemp() error 0\n");
  1114. #endif /* ERROR */
  1115. #if PLOIDY == 1
  1116.             tgl->gbits[dist] |= 1;
  1117. #else /* PLOIDY == 1 */
  1118.             tgl->gbits[dist][ce->d.tr] |= 1;
  1119. #endif /* PLOIDY == 1 */
  1120.         }
  1121.         if (who == 2)
  1122.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  1123.             if (IsBit(ogl->bits, 0))
  1124.             {   ogl->bits |= (I32u) (ONE << (I32u) (12 + 4));
  1125.                 dist = ad(ce->c.ip + 1 + i) - ct->mm.p;
  1126.                 dist = ad(dist);
  1127. #ifdef ERROR
  1128.                 if (ogl->genome == NULL || dist < 0 || dist >= ogl->gen.size)
  1129.                    FEError(-132,EXIT,NOWRITE, "Tierra GenExTemp() error 1\n");
  1130. #endif /* ERROR */
  1131. #if PLOIDY == 1
  1132.                 ogl->gbits[dist] |= (1 << 1);
  1133. #else /* PLOIDY == 1 */
  1134.                 ogl->gbits[dist][ce->d.tr] |= (1 << 1);
  1135. #endif /* PLOIDY == 1 */
  1136.             }
  1137.         }
  1138.         ct = ce;
  1139.         who = WhoIs(&ct, ad(adrt + i)); /* who has complementary template */
  1140.         if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (7 + who));
  1141.         else tgl->bits |= (I32u) (ONE << (I32u) (7 + 2));
  1142.         if (!who)
  1143.         {   dist = ad(adrt + i) - ce->mm.p;
  1144.             dist = ad(dist);
  1145. #ifdef ERROR
  1146.             if (tgl->genome == NULL || dist < 0 || dist >= tgl->gen.size)
  1147.                 FEError(-133,EXIT,WRITE, "Tierra GenExTemp() error 2\n");
  1148. #endif /* ERROR */
  1149. #if PLOIDY == 1
  1150.             tgl->gbits[dist] |= 1;
  1151. #else /* PLOIDY == 1 */
  1152.             tgl->gbits[dist][ce->d.tr] |= 1;
  1153. #endif /* PLOIDY == 1 */
  1154.         }
  1155.         if (who == 2)
  1156.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  1157.             if (IsBit(ogl->bits, 0))
  1158.             {   ogl->bits |= (I32u) (ONE << (I32u) (7 + 4));
  1159.                 dist = ad(adrt + i) - ct->mm.p;
  1160.                 dist = ad(dist);
  1161. #ifdef ERROR
  1162.                 if (ogl->genome == NULL || dist < 0 || dist >= ogl->gen.size)
  1163.                     FEError(-134,EXIT,WRITE, "Tierra GenExTemp() error 3\n");
  1164. #endif /* ERROR */
  1165. #if PLOIDY == 1
  1166.                 ogl->gbits[dist]|= (1 << 1);
  1167. #else /* PLOIDY == 1 */
  1168.                 ogl->gbits[dist][ce->d.tr] |= (1 << 1);
  1169. #endif /* PLOIDY == 1 */
  1170.             }
  1171.         }
  1172.     }
  1173. }
  1174.  
  1175. void GenExMov(ce, to, from)
  1176.     Pcells  ce;
  1177.     I32s    to, from;
  1178. {
  1179.     Pcells  ct;
  1180.     Pgl     tgl, ogl;
  1181.     I32u    who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
  1182.                   /* 3 free memory; 4 daughter of other cell */
  1183.  
  1184.     tgl = sl[ce->d.gen.size]->g[ce->d.gi];
  1185.     if (ce->d.flaw || ce->d.mut || !IsBit(tgl->bits, 0))
  1186.         return;
  1187.     /* the mov instruction being executed is within your own genome */
  1188.     if (ce->mm.p <= ce->c.ip && ce->c.ip < (ce->mm.p + ce->mm.s))
  1189.     {   ct = ce;
  1190.         who = WhoIs(&ct, from);    /* who is it moved from */
  1191.         if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (17 + who));
  1192.         else tgl->bits |= (I32u) (ONE << (I32u) (17 + 2));
  1193.         if (who == 2)
  1194.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  1195.             if (IsBit(ogl->bits, 0))
  1196.             ogl->bits |= (I32u) (ONE << (I32u) (17 + 4));
  1197.         }
  1198.         ct = ce;
  1199.         who = WhoIs(&ct, to); /* who is it moved to */
  1200.         if (who < 4)
  1201.             tgl->bits |= (I32u) (ONE << (I32u) (22 + who));
  1202.         else tgl->bits |= (I32u) (ONE << (I32u) (22 + 2));
  1203.         if (who == 2)
  1204.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  1205.             if (IsBit(ogl->bits, 0))
  1206.             ogl->bits |= (I32u) (ONE << (I32u) (22 + 4));
  1207.         }
  1208.     }
  1209.     else   /* these are moved from while executing instructions that */
  1210.     {   ct = ce;       /* are not your own */
  1211.         who = WhoIs(&ct, from);    /* who is it moved from */
  1212.         if (who < 4)
  1213.             tgl->bits |= (I32u) (ONE << (I32u) (27 + who));
  1214.         else tgl->bits |= (I32u) (ONE << (I32u) (27 + 2));
  1215.         if (who == 2)   /* ct is cell from which inst is moved */
  1216.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  1217.             if (IsBit(ogl->bits, 0))
  1218.                 ogl->bits |= (I32u) (ONE << (I32u) (27 + 4));
  1219.         }
  1220.     }
  1221. }
  1222.  
  1223. void GenExExe(ce, adrt)
  1224.     Pcells  ce;
  1225.     I32s     adrt;
  1226. {
  1227.     Pcells  ct = ce;
  1228.     Pgl tgl;
  1229.     I32u    dist;
  1230.     I32u    who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
  1231.                   /* 3 free memory; 4 daughter of other cell */
  1232.  
  1233.     tgl = sl[ce->d.gen.size]->g[ce->d.gi];
  1234.     if (ce->d.flaw || ce->d.mut || !IsBit(tgl->bits, 0))
  1235.         return;
  1236.     who = WhoIs(&ct, adrt);
  1237.     if (who < 4)
  1238.         tgl->bits |= (I32u) (ONE << (I32u) (2 + who));
  1239.     else tgl->bits |= (I32u) (ONE << (I32u) (2 + 2));
  1240.     if (!who)  /* who == 0 == same cell */
  1241.     {   dist = adrt - ce->mm.p;
  1242. #ifdef ERROR
  1243.         if (tgl->gbits == NULL || dist < 0 || dist >= tgl->gen.size)
  1244.             FEError(-135,EXIT,WRITE, "Tierra GenExExe() error 0\n");
  1245. #endif /* ERROR */
  1246. #if PLOIDY == 1
  1247.         tgl->gbits[dist]|= 1;
  1248. #else /* PLOIDY == 1 */
  1249.         tgl->gbits[dist][ce->d.tr] |= 1;
  1250. #endif /* PLOIDY == 1 */
  1251.     }
  1252.     if (who == 2)  /* is other cell */
  1253.     {   tgl = sl[ct->d.gen.size]->g[ct->d.gi];
  1254.         if (IsBit(tgl->bits, 0))
  1255.         {   tgl->bits |= (ONE << (I32u) (2 + 4));
  1256.             dist = adrt - ct->mm.p;
  1257. #ifdef ERROR
  1258.             if (tgl->gbits == NULL || dist < 0 || dist >= tgl->gen.size)
  1259.                 FEError(-136,EXIT,WRITE, "Tierra GenExExe() error 1\n");
  1260. #endif /* ERROR */
  1261. #if PLOIDY == 1
  1262.             tgl->gbits[dist]|= (1 << 1);
  1263. #else /* PLOIDY == 1 */
  1264.             tgl->gbits[dist][ce->d.tr] |= (1 << 1);
  1265. #endif /* PLOIDY == 1 */
  1266.         }
  1267.     }
  1268. }
  1269.  
  1270. /* rationale for the functioning of the genebank:
  1271.  
  1272. The term ``rambank'' refers to a collection of genotypes maintained in RAM
  1273. The term ``diskbank'' refers to a collection of genotypes maintained on disk
  1274. The term ``genebank'' refers to both the rambank and the diskbank
  1275.  
  1276. Genotype names have two parts: size-label, for example 0080aaa, 0045eat,
  1277. 6666god.
  1278.  
  1279. 1) When a creature is born its genotype will be compared to that of its parent.
  1280.    A) if they are the same, the daughter will be given the same name as the
  1281.       mother.
  1282.    B) if they are not the same, the genebank will be searched.
  1283.       a) if the daughter genotype is found in the genebank, it will be given
  1284.          the same name as the genotype that it matches in the bank.
  1285.       b) if the daughter genotype does not match any genotype in the bank,
  1286.          a new name will be created for it, and it will be entered into the
  1287.          rambank.
  1288. 2) For each birth and death a count of the population of both the genotype
  1289.    and the size class involved will be incremente or decremented, so that we
  1290.    have a count of the current population of each genotype and each size class.
  1291.    This information is maintained in rambank.
  1292. 3) If a genotype frequency crosses a critical threshold, the genotype name
  1293.    will become permanent and the genotype will be saved to the diskbank.
  1294.    There may be several types of thresholds: proportion of population
  1295.    (e.g., 2%), proportion of soup, or just numbers of creatures.
  1296. 4) When a genotype frequency drops to zero:
  1297.    A) If the genotype never crossed the thresholds, the genotype will be
  1298.       removed from the genebank, and its unique name will become available for
  1299.       reuse.
  1300.    B) If the genotype crossed the threshold, gaining a permanent name, it
  1301.       should be retained in the genebank.
  1302. 5) Periodically, Tierra saves the complete state of the machine (e.g., every
  1303.    100 million instructions executed).  At that time, the complete rambank
  1304.    is saved to the diskbank.  For this reason, 4 A applies also to genotypes
  1305.    which never became permanent, and these must be removed from the diskbank
  1306.    as well.  The bitfield in the genotype structure tells us if a genotype is
  1307.    saved to the diskbank, and if it is permanent.
  1308. 6) If the rambank becomes ``too full'', some relatively unused portion of it
  1309.    should be swapped to the diskbank.  In DOS, ``too full'' could be signaled
  1310.    by a malloc failure.  In unix, ``too full'' could be signaled by some
  1311.    specified limit on how big the rambank should get, if this seems wise.
  1312.    That portion of the rambank to be swapped to the diskbank might consist of
  1313.    the least recently accessed size class.  For this reason it might be
  1314.    worthwhile to maintain a queue of size classes, ordered by last use.
  1315. */
  1316.