home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / misc / a154_1 / !Tierra / source / c / bookeep < prev    next >
Text File  |  1992-08-11  |  33KB  |  958 lines
  1. /* bookeep.c   6-7-92  bookeeping functions for the Tierra Simulator */
  2. /* Tierra Simulator V3.13: Copyright (c) 1991, 1992 Tom Ray & Virtual Life */
  3.  
  4. #ifndef lint
  5. static char sccsid[] = "%W% %G%";
  6. #endif /* lint */
  7.  
  8. #include "license.h"
  9. #include "tierra.h"
  10. #include "extern.h"
  11.  
  12.  
  13. #ifdef MEM_CHK
  14. #include <memcheck.h>
  15. #endif /* MEM_CHK */
  16.  
  17. void DivideBookeep(ce, nc)
  18.     Pcells  ce, nc; /* ce = mother cell, nc = daughter cell */
  19. {   GList   *tgl, *tcgl;
  20.     float   maxp, maxi;
  21.     I8s     same = 0;
  22.     int     si, gi;
  23.  
  24.     LastDiv = InstExe;
  25.     if (!ce->d.fecundity && !ce->d.mut && !ce->d.flaw)
  26.     {   ce->d.d1.flags = ce->d.flags;    /* record metabolic data 1st repl */
  27.         ce->d.d1.inst = ce->d.inst + 1;
  28.         ce->d.d1.mov_daught = ce->d.mov_daught;
  29.     }
  30.     ce->d.fecundity++;
  31.     nc->d.gen.size = nc->mm.s;
  32.     if (GeneBnker)
  33.     {   if (ce->mm.s == nc->mm.s &&    /* if cell breeds true */
  34.             IsSameGen(nc->mm.s, soup + nc->mm.p, soup + ce->mm.p))
  35.         {   if (ce->d.fecundity == 1)
  36.                 nc->d.d1.BreedTrue = ce->d.d1.BreedTrue = 1;
  37.             nc->d.parent = ce->d.parent;
  38.             nc->d.gen = ce->d.gen;
  39.             nc->d.gi = ce->d.gi;
  40.             same = 1;
  41.         }
  42.         else     /* if daughter is a new genotype (same = 0) */
  43.         {   nc->d.parent = ce->d.gen; /* this will assign a gen.label */
  44.             CheckGenotype(nc, 17);     /* by checking .gen files */
  45.         }
  46.         tgl  = sl[nc->d.gen.size]->g[nc->d.gi];    /* new cell GList */
  47.         tcgl = sl[si = ce->d.gen.size]->g[gi = ce->d.gi]; /* mother GList */
  48.         if (tcgl && (I32u) tcgl <= 4)
  49.             tcgl = sl[si]->g[gi] = gq_read(si, gi); /* mother GList */
  50.         if ((I32u) tcgl <= 4)
  51.             FEError(-100,EXIT,NOWRITE, 
  52.                 "Tierra DivideBookeep() mother genotype missing\n");
  53.         if (ce->d.fecundity == 1 && !ce->d.mut && !ce->d.flaw)
  54.             tcgl->d1 = ce->d.d1;
  55.         else if (ce->d.fecundity == 2 && !ce->d.mut && !ce->d.flaw)
  56.         {   tcgl->d2.inst = ce->d.inst + 1 - ce->d.d1.inst;
  57.             tcgl->d2.flags = ce->d.flags - ce->d.d1.flags;
  58.             tcgl->d2.mov_daught = ce->d.mov_daught;
  59.             tcgl->d2.BreedTrue = same;
  60.         }
  61.         si = nc->mm.s;
  62.         if (!tgl->pop)
  63.         {   NumGenotypes++;
  64.             sl[si]->num_g++;
  65.         }
  66.         tgl->pop++;
  67.         if (!sl[si]->num_c)
  68.             NumSizes++;
  69.         sl[si]->num_c++;
  70. #if FRONTEND != STDIO
  71.         if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
  72.             query_spec_d(si,nc->d.gi);
  73. #endif /* FRONTEND != STDIO */
  74. /* this might be a good place to keep track of multiple parental genotypes. */
  75.         if (reaped)
  76.         {   maxp = (float) tgl->pop / (float) NumCells;
  77.             if (maxp > tgl->MaxPropPop)
  78.             {   tgl->MaxPropPop = maxp;
  79.                 tgl->mpp_time   = InstExe;         
  80.             }
  81.             maxi = (float) tgl->pop * nc->d.gen.size / (float) SoupSize;
  82.             if (maxi > tgl->MaxPropInst)
  83.                 tgl->MaxPropInst = maxi;
  84.         }
  85.         /* criteria for saving genotype to disk */
  86.         if (reaped && tgl->pop >= SavMinNum
  87.             && ((!IsBit(tgl->bits, 0) && (tgl->MaxPropPop > SavThrPop
  88.             || tgl->MaxPropInst > SavThrMem * .5))
  89.             || (!IsBit(tgl->bits, 1) && (maxp > SavThrPop
  90.             || maxi > SavThrMem * .5))))
  91. /*      if (reaped && (!IsBit(tgl->bits, 0) || !IsBit(tgl->bits, 1))
  92.             && tgl->pop >= SavMinNum && (tgl->MaxPropPop > SavThrPop
  93.             || tgl->MaxPropInst > SavThrMem * .5))
  94. */
  95.         {   if (!IsBit(tgl->bits, 0))
  96.             {   SetBit(&tgl->bits, 0, 1);
  97.                 SetBit(&tgl->bits, 1, 1);
  98.                 extract(nc);
  99.             }
  100.             else
  101.             {   SetBit(&tgl->bits, 1, 1);
  102.                 sprintf(ExtrG, "%04ld%s @ %ld v", tgl->gen.size, tgl->gen.label,
  103.                     (GeneBnker)? tgl->pop : 0L);
  104. #if FRONTEND == STDIO
  105.                 sprintf(mes[0], "extract: %s", ExtrG);
  106.                 FEMessage(1,mes);
  107. #else /* FRONTEND == STDIO */
  108.                 if (Log)
  109.                     fprintf(tfp_log, "ex = %s\n", ExtrG);
  110. #endif /* FRONTEND == STDIO */
  111.             }
  112.         }
  113.     }
  114.     ce->d.mov_daught = ce->d.mut = 0;
  115.     OutDisk((I32s)'b', nc);
  116. #if FRONTEND != STDIO
  117.     FEStats(); 
  118. #endif /* FRONTEND != STDIO */
  119. }
  120.  
  121. void ReapBookeep(ce)
  122.     Pcells  ce;
  123. {   Pgl tgl;
  124.     I32s  si = ce->d.gen.size;
  125.     I16s  gi = ce->d.gi;
  126.  
  127.     OutDisk((I32s)'d', ce);
  128.     if (GeneBnker)
  129.     {   tgl = sl[si]->g[gi];
  130. #ifdef ERROR
  131.         if (gi >= sl[si]->a_num)
  132.             FEError(-101,EXIT,NOWRITE, 
  133.                 "Tierra ReapBookeep() genotype %hd out of range\n", gi);
  134.         if ((I32u) tgl <= 4)
  135.             FEError(-102,EXIT,NOWRITE, 
  136.                 "Tierra ReapBookeep() genotype %hd not in genebank\n", gi);
  137. #endif /* ERROR */
  138.         tgl->pop--;    /* this is a segmentation fault waiting to happen! */
  139.         if (!tgl->pop)
  140.         {   if ((I32u) tgl > 4 && !IsBit(tgl->bits, 0))
  141.             {   if (tgl->genome)
  142.                 {   tfree(tgl->genome);
  143.                     tgl->genome = NULL;
  144.                 }
  145.                 if (tgl->gbits)
  146.                 {   tfree(tgl->gbits);
  147.                     tgl->gbits = NULL;
  148.                 }
  149.                 gq_rem(tgl);
  150.                 tfree(tgl);
  151.                 sl[si]->g[gi] = NULL;
  152.             }
  153.             else
  154.                 SetBit(&tgl->bits, 1, 0);
  155.             NumGenotypes--;
  156.             sl[si]->num_g--;
  157.         }
  158.         sl[si]->num_c--;
  159.         if (!sl[si]->num_c)
  160.         {   NumSizes--;
  161. #ifdef ERROR
  162.             if (sl[si]->num_g)
  163.                 FEError(-103,NOEXIT,NOWRITE, 
  164.                     "Tierra ReapBookeep() genotypes but no individuals\n");
  165. #endif /* ERROR */
  166.         }
  167. #if FRONTEND != STDIO
  168.         if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
  169.             query_spec_d(si,gi);
  170. #endif /* FRONTEND != STDIO */
  171.     }
  172.     InitCell(ce->q.this.a,ce->q.this.i,ce);
  173.     NumCells--;
  174.     reaped = 1;
  175. }
  176.  
  177. void MutBookeep(i)
  178.     Ind i;
  179. {
  180.     I8s    md;
  181.     Pcells ce;
  182.     I32s   si;
  183.     I16s   gi;
  184.     Pgl    tgl;
  185.  
  186.     if (!GeneBnker || IsFree(i)) return;
  187.     WhichCell(i, &ce, &md);
  188.     if (md == 'm')
  189.     {   si = ce->d.gen.size;
  190.         gi = ce->d.gi;
  191.         tgl = sl[si]->g[gi];
  192.         if (IsSameGen(si, soup + ce->mm.p, tgl->genome))
  193.             return ;
  194. #ifdef ERROR
  195.         if (gi >= sl[si]->a_num)
  196.             FEError(-104,EXIT,NOWRITE, 
  197.                 "Tierra MutBookeep() genotype %hd out of range\n", gi);
  198.         if ((I32u) tgl <= 4)
  199.             FEError(-105,EXIT,NOWRITE, 
  200.                 "Tierra MutBookeep() genotype %hd not in genebank\n", gi);
  201. #endif /* ERROR */
  202.         tgl->pop--; /* this is a segmentation fault waiting to happen! */
  203.         if (!tgl->pop)
  204.         {   if ((I32u) tgl > 4 && !IsBit(tgl->bits, 0))
  205.             {   if (tgl->genome)
  206.                 {   tfree(tgl->genome);
  207.                     tgl->genome = NULL;
  208.                 }
  209.                 if (tgl->gbits)
  210.                 {   tfree(tgl->gbits);
  211.                     tgl->gbits = NULL;
  212.                 }
  213.                 gq_rem(tgl);
  214.                 tfree(tgl);
  215.                 sl[si]->g[gi] = NULL;
  216.             }
  217.             else
  218.                 SetBit(&tgl->bits, 1, 0);
  219.             NumGenotypes--;
  220.             sl[si]->num_g--;
  221.         }
  222.         sl[si]->num_c--;
  223. #if FRONTEND != STDIO
  224. /*      if (IMode == GEN_HIST) */
  225.         if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
  226.             query_spec_d(si,gi); 
  227. #endif /* FRONTEND != STDIO */
  228.         OutDisk((I32s)'d', ce);
  229.         ce->d.parent = ce->d.gen;    /* assign new genotype */
  230.         ce->d.gi = -1;
  231.         strcpy(ce->d.gen.label, "---");
  232.         CheckGenotype(ce, 17);    /* this will check .gen files */
  233.         gi = ce->d.gi;
  234.         tgl = sl[si]->g[gi];
  235. #ifdef ERROR
  236.         if (gi >= sl[si]->a_num)
  237.             FEError(-106,EXIT,NOWRITE, 
  238.                 "Tierra MutBookeep() genotype %hd out of range\n", gi);
  239.         if ((I32u) tgl <= 4)
  240.             FEError(-107,EXIT,NOWRITE, 
  241.                 "Tierra MutBookeep() genotype %hd not in genebank\n", gi);
  242. #endif /* ERROR */
  243.         if (!tgl->pop)
  244.         {   NumGenotypes++;
  245.             sl[si]->num_g++;
  246.         }
  247.         tgl->pop++;
  248.         sl[si]->num_c++;
  249. #if FRONTEND != STDIO
  250. /*      if (IMode == GEN_HIST) */
  251.         if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
  252.             query_spec_d(si,gi);
  253. #endif /* FRONTEND != STDIO */
  254.         OutDisk((I32s)'b', ce);
  255.         ce->d.d1.flags = ce->d.d1.mov_daught = 0L;
  256.         ce->d.fecundity = ce->d.flags = 0L;
  257.         ce->d.d1.inst = ce->d.inst = 0L;
  258.         ce->d.mut++;
  259.     }
  260. }
  261.  
  262. void OutDisk(bd, nc)
  263.     I32s bd;
  264.     Pcells nc;
  265. {   I32s ttime;
  266.     I8s label[4];
  267.  
  268.     if (DiskOut)
  269.     {   if (FirstOutDisk)
  270.         {   FirstOutDisk = 0;
  271.             BrkupCum = 0;
  272.             BrkupCou = 1;
  273. #ifdef IBM3090
  274.             if (BrkupSiz)
  275.                 sprintf(Buff, "break.1.d");
  276.             else sprintf(Buff, "tierra.run.d");
  277.             oufr = fopen(Buff, "w");
  278. #else /* IBM3090 */
  279.    #ifdef RISC_OS
  280.             if (BrkupSiz)
  281.                 sprintf(Buff, "%sbreak_1", OutPath);
  282.             else sprintf(Buff, "%stierra_run", OutPath);
  283.    #else /*RISC_OS*/
  284.             if (BrkupSiz)
  285.                 sprintf(Buff, "%sbreak.1", OutPath);
  286.             else sprintf(Buff, "%stierra.run", OutPath);
  287.    #endif /* RISC_OS */
  288.             oufr = fopen(Buff, "w");
  289.  
  290. #endif /* IBM3090 */
  291.             if (oufr == NULL)
  292.             {   FEError(-108,EXIT,NOWRITE, 
  293.                    "Tierra OutDisk() 1: file %s not opened, exiting\n", Buff);
  294.             }
  295.             sprintf(label, nc->d.gen.label);
  296. #ifdef IBM3090
  297.             Ascii2Ebcdic(label);
  298. #endif /* IBM3090 */
  299.             BrkupCum += fprintf(oufr, "%lx %c %ld", InstExe.i, (I8s) bd,
  300.                 nc->d.gen.size);
  301.             if (GeneBnker)
  302.                 BrkupCum += 1 + fprintf(oufr, " %s\n", label);
  303.             else BrkupCum += 1 + fprintf(oufr, "\n");
  304.         }
  305.         else
  306.         {   ttime = InstExe.i - lo.time;
  307.             if (ttime < 0)
  308.                 ttime += 1000000L;
  309.             BrkupCum += fprintf(oufr, "%lx", ttime);
  310.             if (lo.bd != bd)
  311.                 BrkupCum += fprintf(oufr, " %c", bd);
  312.             if (lo.size != nc->d.gen.size)
  313.                 BrkupCum += fprintf(oufr, " %ld", nc->d.gen.size);
  314.             if (GeneBnker && strcmp(lo.label, nc->d.gen.label))
  315.             {   sprintf(label, nc->d.gen.label);
  316. #ifdef IBM3090
  317.                 Ascii2Ebcdic(label);
  318. #endif /* IBM3090 */
  319.                 BrkupCum += fprintf(oufr, " %s", label);
  320.             }
  321.             BrkupCum += 1 + fprintf(oufr, "\n");
  322.             if (BrkupSiz && BrkupCum > BrkupSiz * 1024L)
  323.             {   fclose(oufr);
  324.                 BrkupCum = 0;
  325.                 BrkupCou++;
  326. #ifdef IBM3090
  327.                 sprintf(Buff, "break.%ld.d", BrkupCou);
  328.                 oufr = fopen(Buff, "w");
  329. #else /* IBM3090 */
  330.                 sprintf(Buff, "%sbreak.%ld", OutPath, BrkupCou);
  331.                 oufr = fopen(Buff, "w");
  332. #endif /* IBM3090 */
  333.                 if (oufr == NULL)
  334.                 {   FEError(-109,EXIT,WRITE,
  335.                    "Tierra OutDisk() 2: file %s not opened, exiting\n", Buff);
  336.                 }
  337.             }
  338.         }
  339.     }
  340.     else
  341.     {   if (FirstOutDisk) FirstOutDisk = 0;
  342.         else
  343.         {   ttime = InstExe.i - lo.time;
  344.             if (ttime < 0) ttime += 1000000L;
  345.         }
  346.     }
  347.     lo.bd = bd;
  348.     lo.size = nc->d.gen.size;
  349.     lo.time = InstExe.i;
  350.     strcpy(lo.label, nc->d.gen.label);
  351.     TimePop += (double) ttime *(double) NumCells;
  352.     if ((I8s) bd == 'b')
  353.         TimeBirth++;
  354.     else TimeDeath++;
  355. }
  356.  
  357. #ifdef ERROR
  358.  
  359. void VerifyGB() /* verify genebank */
  360. {   I32s  gNumSizes = 0, cNumSizes = 0, cgNumSizes = 0;
  361.     I32s  gNumGenot = 0, cNumGenot = 0, cgNumGenot = 0;
  362.     I32s  gNumCells = 0, cNumCells = 0, cgNumCells = 0;
  363.     I32s  cgsNumGenot = 0, ggNumGenot = 0;
  364.     I32s  cgsNumCells = 0, ggNumCells = 0;
  365.     I32s  tsiz_sl = 1, si, ar, ci;
  366.     I16s  gi;
  367.     Pcells ce;
  368.     GList  Fp pgl;
  369.     SList  Fp Fp tsl, Fp psl;
  370.  
  371.     /* begin cells array check */
  372.     tsl = (SList Fp Fp) tcalloc(1, sizeof(SList Fp));
  373.     for (ar = 0; ar < NumCelAr; ar++) for (ci = 0; ci < CelArSiz; ci++)
  374.     {   if (ar == 0 && ci < 2)
  375.             continue;
  376.         ce = &cells[ar][ci];
  377.         if (ce->ld)
  378.         {   cNumCells++;
  379.             si = ce->d.gen.size;
  380.             if (si >= siz_sl)
  381.                 FEError(-110,EXIT,WRITE,
  382.                  "Tierra VerifyGB() size %ld out of range in genebank\n", si);
  383.             psl = sl[si];
  384.             if (!psl)
  385.                 FEError(-111,EXIT,WRITE,
  386.                  "Tierra VerifyGB() sl[%ld] not allocated in genebank\n", si);
  387.             gi = ce->d.gi;
  388.             if (gi >= psl->a_num)
  389.                 FEError(-112,EXIT,WRITE,
  390.                "Tierra VerifyGB() genome %hd out of range in genebank\n", gi);
  391.             pgl = psl->g[gi];
  392.             if ((I32u) pgl < 4)
  393.                 FEError(-113,EXIT,WRITE,
  394.                  "Tierra VerifyGB() gl[%hd] not allocated in genebank\n", gi);
  395.             if (!IsSameGen(si, soup + ce->mm.p, pgl->genome))
  396.                 FEError(-114,EXIT,WRITE,
  397.                     "Tierra VerifyGB() cell and genebank do not match\n");
  398.             if (si >= tsiz_sl)
  399.             {   tsl = (SList Fp Fp) trecalloc(tsl,
  400.                     (si + 1) * sizeof(SList Fp), tsiz_sl * sizeof(SList Fp));
  401.                 tsiz_sl = si + 1;
  402.             }
  403.             if (!tsl[si])
  404.             {   tsl[si] = (SList Fp) tcalloc(1, sizeof(SList));
  405.                 tsl[si]->g = (GList Fp Fp) tcalloc(gi + 1, sizeof(GList Fp));
  406.                 tsl[si]->a_num = gi + 1;
  407.             }
  408.             if (!tsl[si]->num_c)
  409.             {   if (tsl[si]->num_g)
  410.                     FEError(-115,NOEXIT,NOWRITE,
  411.                     "Tierra VerifyGB() !tsl[si]->num_c but tsl[si]->num_g\n");
  412.                 cNumSizes++;
  413.             }
  414.             tsl[si]->num_c++;
  415.             if (gi >= tsl[si]->a_num)
  416.             {   tsl[si]->g = (GList Fp Fp) trecalloc(tsl[si]->g,
  417.                     (gi + 1) * sizeof(GList Fp),
  418.                     tsl[si]->a_num * sizeof(GList Fp));
  419.                 tsl[si]->a_num = gi + 1;
  420.             }
  421.             if ((I32u) tsl[si]->g[gi] < 4)
  422.             {   tsl[si]->g[gi] = (GList Fp) tcalloc(1, sizeof(GList));
  423.                 cNumGenot++;
  424.                 tsl[si]->num_g++;
  425.             }
  426.             tsl[si]->g[gi]->pop++;
  427.         }
  428.     } /* check and free temporary genebank */
  429.     for (si = 0; si < tsiz_sl; si++)
  430.     {   if (tsl[si])
  431.         {   if (tsl[si]->num_c != sl[si]->num_c)
  432.                 FEError(-116,NOEXIT,NOWRITE,
  433.              "Tierra VerifyGB() tsl[%ld]->num_c != sl[%ld]->num_c\n", si, si);
  434.             if (tsl[si]->num_g != sl[si]->num_g)
  435.                 FEError(-117,NOEXIT,NOWRITE,
  436.              "Tierra VerifyGB() tsl[%ld]->num_g != sl[%ld]->num_g\n", si, si);
  437.             if (tsl[si]->num_c && tsl[si]->g)
  438.             {   cgNumSizes++;
  439.                 cgsNumCells += tsl[si]->num_c;
  440.                 cgsNumGenot += tsl[si]->num_g;
  441.                 for (gi = 0; gi < tsl[si]->a_num; gi++)
  442.                 {   if ((I32u) tsl[si]->g[gi] > 4)
  443.                     {   if (tsl[si]->g[gi]->pop != sl[si]->g[gi]->pop)
  444.                             FEError(-118,NOEXIT,NOWRITE,
  445.           "Tierra VerifyGB() tsl[%ld]->g[%hd]->pop != sl[%ld]->g[%hd]->pop\n",
  446.                                 si, gi, si, gi);
  447.                         cgNumGenot++;
  448.                         cgNumCells += tsl[si]->g[gi]->pop;
  449.                         tfree(tsl[si]->g[gi]);
  450.                     }
  451.                 }
  452.                 tfree(tsl[si]->g);
  453.                 tfree(tsl[si]);
  454.             }
  455.         }
  456.     }
  457.     tfree(tsl);
  458.     if (NumCells != cNumCells || NumCells != cgNumCells ||
  459.         NumCells != cgsNumCells)
  460.         FEError(-119,NOEXIT,NOWRITE,
  461.             "Tierra VerifyGB() NumCells cells array inconsistency\n");
  462.     if (NumGenotypes != cNumGenot || NumGenotypes != cgNumGenot ||
  463.         NumGenotypes != cgsNumGenot)
  464.         FEError(-120,NOEXIT,NOWRITE,
  465.             "Tierra VerifyGB() NumGenot cells array inconsistency\n");
  466.     if (NumSizes != cNumSizes || NumSizes != cgNumSizes)
  467.         FEError(-121,NOEXIT,NOWRITE,
  468.             "Tierra VerifyGB() NumSizes cells array inconsistency\n");
  469.     /* end cells array check */
  470.  
  471.     /* begin genebank check */
  472.     for (si = 0; si < siz_sl; si++)
  473.     {   psl = sl[si];
  474.         if (!psl)
  475.             continue ;
  476.         if (!psl->num_c || !psl->num_g)
  477.             FEError(-122,NOEXIT,NOWRITE,
  478.                 "Tierra VerifyGB() !sl[si]->num_c or !sl[si]->num_g\n");
  479.                 if (sl[si]->num_c)
  480.                 {   gNumSizes++;
  481.                     ggNumCells += sl[si]->num_c;
  482.                 }
  483.                 if (sl[si]->num_g)
  484.                     ggNumGenot += sl[si]->num_g;
  485.                 for (gi = 0; gi < sl[si]->a_num; gi++)
  486.                 {   pgl = psl->g[gi];
  487.                     if ((I32u) pgl < 4 || !pgl->pop)
  488.                         continue ;
  489.                     gNumGenot++;
  490.                     gNumCells += pgl->pop;
  491.                 }
  492.             }
  493.             if (NumCells != gNumCells || NumCells != ggNumCells)
  494.                 FEError(-123,NOEXIT,NOWRITE,
  495.             "Tierra VerifyGB() NumCells genebank inconsistency\n");
  496.     if (NumGenotypes != gNumGenot || NumGenotypes != ggNumGenot)
  497.         FEError(-124,NOEXIT,NOWRITE,
  498.             "Tierra VerifyGB() NumGenot genebank inconsistency\n");
  499.     if (NumSizes != gNumSizes)
  500.         FEError(-125,NOEXIT,NOWRITE,
  501.             "Tierra VerifyGB() NumSizes genebank inconsistency\n");
  502.     /* end genebank check */
  503. }
  504.  
  505. #endif /* ERROR */
  506.  
  507. void GarbageCollectGB()
  508. {   I32s  i, j, maxsiz = 0, tail;
  509.     GList  Fp Fp tgl, Fp pgl;
  510.     SList  Fp Fp tsl;
  511.     I8s     path[80];
  512.     FILE    *fp;
  513.     head_t  head;
  514.     indx_t  *indx, gindx;
  515.  
  516.     for (i = siz_sl - 1; i >= 0; i--)      /* for each allocated size class */
  517.     {   if (sl[i])
  518.         {   if (sl[i]->num_c)
  519.             {   if (!maxsiz)                     /* find largest size class */
  520.                     maxsiz = i;
  521.                 tail = -1;
  522.                 for (j = sl[i]->a_num - 1; j >= 0; j--)
  523.                 {   if ((I32u) (pgl = sl[i]->g[j]) > 4 && !pgl->pop
  524.                         && !IsBit(pgl->bits, 0))
  525.                     {   gq_rem(pgl);
  526.                         if (pgl->genome)
  527.                         {   tfree(pgl->genome);
  528.                             pgl->genome = NULL;
  529.                         }
  530.                         if (pgl->gbits)
  531.                         {   tfree(pgl->gbits);
  532.                             pgl->gbits = NULL;
  533.                         }
  534.                         tfree(sl[i]->g[j]);
  535.                         sl[i]->g[j] = NULL;
  536.                     }
  537.                     if (tail < 0 && sl[i]->g[j])
  538.                         tail = j;    /* skip empty geotypes at end of array */
  539.                 }
  540.                 if (tail < sl[i]->a_num - 1)
  541.                 {   if (tail < 0)             /* no genotypes in size class */
  542.                     {   if (sl[i]->g)
  543.                         {   tfree(sl[i]->g);
  544.                             sl[i]->g = NULL;
  545.                         }
  546.                         if (sl[i])
  547.                         {   tfree(sl[i]);
  548.                             sl[i] = NULL;
  549.                         }
  550.                     }
  551.                     else           /* shorten g arrays to avoid empty tails */
  552.                     {   tgl = (GList Fp Fp) trecalloc(sl[i]->g,
  553.                             (tail + 1) * sizeof(GList Fp),
  554.                             sl[i]->a_num * sizeof(GList Fp));
  555.                         if (tgl)
  556.                             sl[i]->g = tgl;
  557.                         else if (sl[i]->g)
  558.                         {   tfree(sl[i]->g);
  559.                             sl[i]->g = NULL;
  560.                             FEError(-126,EXIT,WRITE,
  561.                       "Tierra GarbageCollectGB() sl[i]->g trecalloc error\n");
  562.                         }
  563.                         sl[i]->a_num = tail + 1;
  564.                     }
  565.                 }
  566.             }
  567.             else /* no creatures of this size, free sl[i] and sl[i]->g */
  568. #ifdef RISC_OS
  569.             {   sprintf(path, "%sgen.%04ld", GenebankPath, i);
  570. #else
  571.             {   sprintf(path, "%s%04ld.gen", GenebankPath, i);
  572. #endif
  573.                 fp = open_ar(path, i, GFormat, -1);
  574.                 head = read_head(fp);
  575. #ifdef __TURBOC__
  576.                 indx = &gindx;
  577. #else  /* __TURBOC__ */
  578.                 indx = read_indx(fp, &head);
  579. #endif /* __TURBOC__ */
  580.  
  581.                 for (j = sl[i]->a_num - 1; j >= 0; j--)
  582.                     if ((I32u) (pgl = sl[i]->g[j]) > 4)
  583.                     {   if (pgl->pop)
  584.                             FEError(-127,NOEXIT,NOWRITE,
  585.                  "Tierra GarbageCollectGB() pgl->pop not zero, can't free\n");
  586.                         if (IsBit(pgl->bits, 0)) /* save genome to disk */
  587.                             add_gen(fp, &head, &indx, pgl);
  588.                         if (pgl->genome)
  589.                         {   tfree(pgl->genome);
  590.                             pgl->genome = NULL;
  591.                         }
  592.                         if (pgl->gbits)
  593.                         {   tfree(pgl->gbits);
  594.                             pgl->gbits = NULL;
  595.                         }
  596.                         gq_rem(pgl);
  597.                         tfree(sl[i]->g[j]);
  598.                         sl[i]->g[j] = NULL;
  599.                     }
  600.                 fclose(fp);
  601.                 if (!head.n)
  602.                     unlink(path);
  603. #ifndef __TURBOC__
  604.                 if (indx)
  605.                 {   thfree(indx);
  606.                     indx = NULL;
  607.                 }
  608. #endif /* __TURBOC__ */
  609.                 if (sl[i]->g)
  610.                 {   tfree(sl[i]->g);
  611.                     sl[i]->g = NULL;
  612.                 }
  613.                 if (sl[i])
  614.                 {   tfree(sl[i]);
  615.                     sl[i] = NULL;
  616.                 }
  617.             }
  618.         }
  619.     }
  620.     if (maxsiz < siz_sl - 1)
  621.     {   tsl = (SList Fp Fp) trecalloc(sl, (maxsiz + 1) * sizeof(SList Fp),
  622.             siz_sl * sizeof(SList Fp));
  623.         if (tsl)
  624.             sl = tsl;
  625.         else if (sl)
  626.         {   tfree(sl);
  627.             sl = NULL;
  628.    FEError(-128,EXIT,WRITE, "Tierra GarbageCollectGB() sl trecalloc error\n");
  629.         }
  630.         siz_sl = maxsiz + 1;
  631.     } /* end garbage collect for genebank */
  632. }
  633.  
  634. void plan()
  635. {   I32s i, j, n = 0, indiv_gen_time, pop_gen_time;
  636.     I32s MaxPop = 0, MaxMem = 0, pop = 0, mem = 0, ar, ci;
  637.     Genotype MaxGenPop, MaxGenMem;
  638.     double prob_of_hit;
  639.     Pcells ce;
  640.     I8s  *chk;
  641.     Pcells Fp  tcells;
  642. #ifdef MEM_PROF
  643.     I32s  SizSoup, SizCells, SizFreeMem, SizSl, SizSli = 0;
  644.     I32s  SizGl = 0, SizGli = 0, SizGen = 0;
  645. #endif /* MEM_PROF */
  646.  
  647.     if (GeneBnker && reaped)
  648.     {
  649.         GarbageCollectGB();
  650. #ifdef ERROR
  651.         VerifyGB();
  652. #endif /* ERROR */
  653.     }
  654.  
  655.     /* begin calculate averages */
  656.     AverageSize = 0;
  657.     chk = tcalloc(NumCelAr, sizeof(I8s));
  658.     for (ar = 0; ar < NumCelAr; ar++) for (ci = 0; ci < CelArSiz; ci++)
  659.     {   if (ar == 0 && ci < 2)
  660.             continue;
  661.         ce = &cells[ar][ci];
  662.         if (ce->ld)
  663.         {   n++; chk[ar] = 1;
  664.             AverageSize += ce->d.gen.size;
  665.             if (GeneBnker && InstExe.m)
  666.             {   pop = sl[ce->d.gen.size]->g[ce->d.gi]->pop;
  667.                 mem = pop * ce->d.gen.size;
  668.                 if (pop > MaxPop)
  669.                 {   MaxPop = pop;
  670.                     MaxGenPop = ce->d.gen;
  671.                 }
  672.                 if (mem > MaxMem)
  673.                 {   MaxMem = mem;
  674.                     MaxGenMem = ce->d.gen;
  675.                 }
  676.             }
  677.         }
  678.     } /* end calculate averages */
  679.  
  680.     /* begin garbage collect for cells array */
  681.     if (reaped)
  682.         for(ar = NumCelAr - 1; ar > 0; ar--)
  683.         {   if (chk[ar])
  684.                 break;
  685.             if (cells[ar])
  686.             {   tfree(cells[ar]);
  687.                 cells[ar] = NULL;
  688.             }
  689.             NumCelAr--;
  690.             tcells = (Pcells Fp) trecalloc((Pcells Fp) cells,
  691.                 (I32u) NumCelAr * sizeof(Pcells Fp),
  692.                 (I32u) (NumCelAr + 1) * sizeof(Pcells Fp));
  693.             if (tcells)
  694.                 cells = tcells;
  695.             else if (cells)
  696.             {   tfree(cells);
  697.                 cells = NULL;
  698.              FEError(-129,EXIT,WRITE,"Tierra plan() cells trecalloc error\n");
  699.             }
  700.             CellsSize = NumCelAr * CelArSiz;
  701.         } /* end garbage collect for cells array */
  702.  
  703.     if (chk)
  704.     {   tfree(chk);
  705.         chk = NULL;
  706.     }
  707.  
  708. #ifdef MEM_PROF /* calculate memory profile */
  709.  
  710.     TotMemUse = SizSoup = SoupSize * sizeof(Instruction);
  711.     TotMemUse += SizCells = CellsSize * sizeof(struct cell);
  712.     TotMemUse += SizFreeMem = MaxFreeBlocks * sizeof(MemFr);
  713.     if(GeneBnker)
  714.     {   TotMemUse += SizSl = siz_sl * sizeof(SList Fp);
  715.         for (i = 0; i < siz_sl; i++)
  716.         {   if (sl[i])
  717.             {   TotMemUse += sizeof(SList);
  718.                 SizSli += sizeof(SList);
  719.                 TotMemUse += sl[i]->a_num * sizeof(GList Fp);
  720.                 SizGl += sl[i]->a_num * sizeof(GList Fp);
  721.                 for (j = 0; j < sl[i]->a_num; j++)
  722.                 {   if ((I32s) sl[i]->g[j] > 4)
  723.                     {   TotMemUse += sizeof(GList);
  724.                         SizGli += sizeof(GList);
  725.                         if (sl[i]->g[j]->genome)
  726.                         {   TotMemUse += i * sizeof(Instruction);
  727.                             SizGen += i * sizeof(Instruction);
  728.                         }
  729.                         if (sl[i]->g[j]->gbits)
  730.                         {   TotMemUse += i * sizeof(GenBits);
  731.                             SizGen += i * sizeof(GenBits);
  732.                         }
  733.                     }
  734.                 }
  735.             }
  736.         }
  737.     }
  738.  
  739. #endif /* MEM_PROF */
  740.  
  741.     /* begin calculate averages */
  742.     if (n != NumCells)
  743.     {   FEError(-130,EXIT,NOWRITE,
  744.          "Tierra plan() NumCells = %ld  count of cells = %ld\n", NumCells, n);
  745.     }
  746.     AverageSize /= n;
  747.     if (GenPerMovMut)
  748.         RateMovMut = (I32s) 2L *GenPerMovMut * AverageSize;
  749.     indiv_gen_time = 10L * AverageSize;
  750.     if (InstExe.m)
  751.         pop_gen_time = NumCells * indiv_gen_time;
  752.     else pop_gen_time = indiv_gen_time * (SoupSize / (4L * AverageSize));
  753.     prob_of_hit = (double) AverageSize / (double) SoupSize;
  754.     if (GenPerBkgMut)
  755.         RateMut = (I32s) (pop_gen_time * 2L * GenPerBkgMut * prob_of_hit);
  756.     if (GenPerFlaw)
  757.         RateFlaw = (I32s) indiv_gen_time *GenPerFlaw * 2L;
  758.     if (DropDead) DropDead = 1L + AverageSize / 80L;  /* DAN */
  759.     Search_limit = (Ind) (SearchLimit * AverageSize);
  760.     if (InstExe.m)
  761.     {   TimePop /= 1000000.;
  762.         Generations += (double) (TimeBirth + TimeDeath) / (2. * TimePop);
  763.     }
  764.     /* end calculate averages */
  765.  
  766.     FEPlan(MaxPop, MaxMem, &MaxGenPop, &MaxGenMem);
  767.  
  768. #ifdef MEM_PROF
  769.  
  770.     FEMemProf(SizSoup, SizCells, SizFreeMem, SizSl, SizSli,
  771.         SizGl, SizGli, SizGen);
  772.  
  773. #endif /* MEM_PROF */
  774.  
  775.     TimePop = 0.;
  776.     TimeBirth = TimeDeath = 0L;
  777. }
  778.  
  779. void GenExTemp(adrt, ce, tsize)
  780.     Ind     adrt;  /* address of beginning of template */
  781.     Pcells  ce;    /* ce = cell executing instruction */
  782.     I32s    tsize; /* template size */
  783. {
  784.     I32s  i;
  785.     I32u  who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
  786.                 /* 3 free memory; 4 daughter of other cell */
  787.     Ind   dist;
  788.     Pgl   tgl, ogl;
  789.     Pcells  ct;
  790.  
  791.     tgl = sl[ce->d.gen.size]->g[ce->d.gi];
  792.     for (i = 0; i < tsize; i++)
  793.     {   ct = ce;  /* WHAT TO DO WITH THIS? */
  794.         who = WhoIs(&ct, ad(ce->c.ip + 1 + i)); /* who has template pattern */
  795.         if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (12 + who));
  796.         else tgl->bits |= (I32u) (ONE << (I32u) (12 + 2));
  797.         if (!who)
  798.         {   dist = ad(ce->c.ip + 1 + i) - ce->mm.p;
  799.             dist = ad(dist);
  800. #ifdef ERROR
  801.             if (tgl->genome == NULL || dist < 0 || dist >= tgl->gen.size)
  802.                 FEError(-131,EXIT,WRITE, "Tierra GenExTemp() error 0\n");
  803. #endif /* ERROR */
  804. #if PLOIDY == 1
  805.             tgl->gbits[dist] |= 1;
  806. #else /* PLOIDY == 1 */
  807.             tgl->gbits[dist][ce->c.tr] |= 1;
  808. #endif /* PLOIDY == 1 */
  809.         }
  810.         if (who == 2)
  811.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  812.             if (IsBit(ogl->bits, 0))
  813.             {   ogl->bits |= (I32u) (ONE << (I32u) (12 + 4));
  814.                 dist = ad(ce->c.ip + 1 + i) - ct->mm.p;
  815.                 dist = ad(dist);
  816. #ifdef ERROR
  817.                 if (ogl->genome == NULL || dist < 0 || dist >= ogl->gen.size)
  818.                    FEError(-132,EXIT,NOWRITE, "Tierra GenExTemp() error 1\n");
  819. #endif /* ERROR */
  820. #if PLOIDY == 1
  821.                 ogl->gbits[dist] |= (1 << 1);
  822. #else /* PLOIDY == 1 */
  823.                 ogl->gbits[dist][ce->c.tr] |= (1 << 1);
  824. #endif /* PLOIDY == 1 */
  825.             }
  826.         }
  827.         ct = ce;
  828.         who = WhoIs(&ct, ad(adrt + i)); /* who has complementary template */
  829.         if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (7 + who));
  830.         else tgl->bits |= (I32u) (ONE << (I32u) (7 + 2));
  831.         if (!who)
  832.         {   dist = ad(adrt + i) - ce->mm.p;
  833.             dist = ad(dist);
  834. #ifdef ERROR
  835.             if (tgl->genome == NULL || dist < 0 || dist >= tgl->gen.size)
  836.                 FEError(-133,EXIT,WRITE, "Tierra GenExTemp() error 2\n");
  837. #endif /* ERROR */
  838. #if PLOIDY == 1
  839.             tgl->gbits[dist] |= 1;
  840. #else /* PLOIDY == 1 */
  841.             tgl->gbits[dist][ce->c.tr] |= 1;
  842. #endif /* PLOIDY == 1 */
  843.         }
  844.         if (who == 2)
  845.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  846.             if (IsBit(ogl->bits, 0))
  847.             {   ogl->bits |= (I32u) (ONE << (I32u) (7 + 4));
  848.                 dist = ad(adrt + i) - ct->mm.p;
  849.                 dist = ad(dist);
  850. #ifdef ERROR
  851.                 if (ogl->genome == NULL || dist < 0 || dist >= ogl->gen.size)
  852.                     FEError(-134,EXIT,WRITE, "Tierra GenExTemp() error 3\n");
  853. #endif /* ERROR */
  854. #if PLOIDY == 1
  855.                 ogl->gbits[dist]|= (1 << 1);
  856. #else /* PLOIDY == 1 */
  857.                 ogl->gbits[dist][ce->c.tr] |= (1 << 1);
  858. #endif /* PLOIDY == 1 */
  859.             }
  860.         }
  861.     }
  862. }
  863.  
  864. void GenExMov(ce, to, from)
  865.     Pcells  ce;
  866.     I32s    to, from;
  867. {
  868.     Pcells  ct;
  869.     Pgl     tgl, ogl;
  870.     I32u    who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
  871.                   /* 3 free memory; 4 daughter of other cell */
  872.  
  873.     tgl = sl[ce->d.gen.size]->g[ce->d.gi];
  874.     if (ce->d.flaw || ce->d.mut || !IsBit(tgl->bits, 0))
  875.         return;
  876.     /* the mov instruction being executed is within your own genome */
  877.     if (ce->mm.p <= ce->c.ip && ce->c.ip < (ce->mm.p + ce->mm.s))
  878.     {   ct = ce;
  879.         who = WhoIs(&ct, from);    /* who is it moved from */
  880.         if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (17 + who));
  881.         else tgl->bits |= (I32u) (ONE << (I32u) (17 + 2));
  882.         if (who == 2)
  883.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  884.             if (IsBit(ogl->bits, 0))
  885.             ogl->bits |= (I32u) (ONE << (I32u) (17 + 4));
  886.         }
  887.         ct = ce;
  888.         who = WhoIs(&ct, to); /* who is it moved to */
  889.         if (who < 4)
  890.             tgl->bits |= (I32u) (ONE << (I32u) (22 + who));
  891.         else tgl->bits |= (I32u) (ONE << (I32u) (22 + 2));
  892.         if (who == 2)
  893.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  894.             if (IsBit(ogl->bits, 0))
  895.             ogl->bits |= (I32u) (ONE << (I32u) (22 + 4));
  896.         }
  897.     }
  898.     else   /* these are moved from while executing instructions that */
  899.     {   ct = ce;       /* are not your own */
  900.         who = WhoIs(&ct, from);    /* who is it moved from */
  901.         if (who < 4)
  902.             tgl->bits |= (I32u) (ONE << (I32u) (27 + who));
  903.         else tgl->bits |= (I32u) (ONE << (I32u) (27 + 2));
  904.         if (who == 2)   /* ct is cell from which inst is moved */
  905.         {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
  906.             if (IsBit(ogl->bits, 0))
  907.                 ogl->bits |= (I32u) (ONE << (I32u) (27 + 4));
  908.         }
  909.     }
  910. }
  911.  
  912. void GenExExe(ce, adrt)
  913.     Pcells  ce;
  914.     Ind     adrt;
  915. {
  916.     Pcells  ct = ce;
  917.     Pgl tgl;
  918.     I32u    dist;
  919.     I32u    who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
  920.                   /* 3 free memory; 4 daughter of other cell */
  921.  
  922.     tgl = sl[ce->d.gen.size]->g[ce->d.gi];
  923.     if (ce->d.flaw || ce->d.mut || !IsBit(tgl->bits, 0))
  924.         return;
  925.     who = WhoIs(&ct, adrt);
  926.     if (who < 4)
  927.         tgl->bits |= (I32u) (ONE << (I32u) (2 + who));
  928.     else tgl->bits |= (I32u) (ONE << (I32u) (2 + 2));
  929.     if (!who)  /* who == 0 == same cell */
  930.     {   dist = adrt - ce->mm.p;
  931. #ifdef ERROR
  932.         if (tgl->gbits == NULL || dist < 0 || dist >= tgl->gen.size)
  933.             FEError(-135,EXIT,WRITE, "Tierra GenExExe() error 0\n");
  934. #endif /* ERROR */
  935. #if PLOIDY == 1
  936.         tgl->gbits[dist]|= 1;
  937. #else /* PLOIDY == 1 */
  938.         tgl->gbits[dist][ce->c.tr] |= 1;
  939. #endif /* PLOIDY == 1 */
  940.     }
  941.     if (who == 2)  /* is other cell */
  942.     {   tgl = sl[ct->d.gen.size]->g[ct->d.gi];
  943.         if (IsBit(tgl->bits, 0))
  944.         {   tgl->bits |= (ONE << (I32u) (2 + 4));
  945.             dist = adrt - ct->mm.p;
  946. #ifdef ERROR
  947.             if (tgl->gbits == NULL || dist < 0 || dist >= tgl->gen.size)
  948.                 FEError(-136,EXIT,WRITE, "Tierra GenExExe() error 1\n");
  949. #endif /* ERROR */
  950. #if PLOIDY == 1
  951.             tgl->gbits[dist]|= (1 << 1);
  952. #else /* PLOIDY == 1 */
  953.             tgl->gbits[dist][ce->c.tr] |= (1 << 1);
  954. #endif /* PLOIDY == 1 */
  955.         }
  956.     }
  957. }
  958.