home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / misc / a154_1 / !Tierra / source / c / genebank < prev    next >
Text File  |  1992-08-11  |  26KB  |  874 lines
  1. /* genebank.c   6-7-92  genebank manager 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.  
  7. #endif
  8.  
  9. #include "license.h"
  10. #include "tierra.h"
  11. #include "extern.h"
  12. #include <errno.h>
  13. #ifndef RISC_OS
  14. #include <sys/types.h>
  15. #endif
  16. #ifdef unix
  17. #include <dirent.h>
  18. #endif               /* unix */
  19. #ifdef __TURBOC__
  20. #include <dir.h>
  21. #include <dos.h>
  22. #define d_name ff_name
  23. #endif               /* __TURBOC__ */
  24.  
  25.  
  26. #ifdef MEM_CHK
  27. #include <memcheck.h>
  28. #endif
  29.  
  30. /*
  31.  * CheckGenotype(ce, hash, flags)
  32.  * Check if cell ce is a new genotype.  If it is a new genotype, it will be
  33.  * assigned a unique label.  If this genotype is not present in the RAM
  34.  * genebank, it will be placed there, but there will be no demographic
  35.  * information updated (this is not assumed to be a birth or death).
  36.  * 
  37.  *  flags: bit 0  (1): check .gen files
  38.  *  flags: bit 1  (2): check .tmp files
  39.  *  flags: bit 2  (4): check files even if rambank does not indicate presence
  40.  *      of genotype on disk (used for startup of old or new soups).
  41.  *  flags: bit 3  (8): use all files in the genebank to assemble the list in
  42.  *      the rambank.  Each time a new size is checked, all genomes of that
  43.  *      size in the genebank will become listed in the rambank as being on
  44.  *      the disk (used for startup of old soups and for cumulative genebanks).
  45.  *      However, the genomes will remain on disk until they are actually
  46.  *      accessed, at which time they will be placed in the genequeue in RAM.
  47.  *  flags: bit 4 (16): when reading a file from the disk genebank,
  48.  *      zero bit 1 of the tgl->bits field, otherwise preserve it.
  49.  * 
  50.  * NEW : if soup_in variable CumGeneBnk is non zero, bit 3 is forced ON 
  51.  */
  52.  
  53. void CheckGenotype(ce, flags)
  54.     Pcells  ce;  /* cell to be checked */
  55.     I32u    flags;
  56. {
  57.     I32s si, hash;
  58.     I16s gi;
  59.  
  60.     if(CumGeneBnk)
  61.         SetBit(&flags,3,ONE);
  62.     si = ce->mm.s;
  63.     hash = Hash(si, soup + ce->mm.p);
  64.     ce->d.gi = Lbl2Int(ce->d.gen.label);
  65.     if (IsNewSize(si)) 
  66.         NewSize(ce, flags);
  67.     if ((gi = IsInGenQueue(ce, hash)) >= 0)
  68.     {   gq_movtop(sl[si]->g[gi]);
  69.         return;
  70.     }
  71.     if (IsInGenBank(ce, hash, flags))
  72.         return;
  73.     NewGenotype(ce, hash);  /* register new genotype in the lists */
  74. }
  75.  
  76. I8s IsNewSize(si)
  77.     I32s si;
  78. {
  79.     if (si < siz_sl && sl[si])
  80.         return 0;
  81.     return 1;
  82. }
  83.  
  84. void NewSize(ce, flags)
  85.     Pcells  ce;
  86.     I32s     flags;
  87. {
  88.     I32s i, j, si;
  89.     I16s gi;
  90.     FILE *afp;
  91.     head_t head;
  92.     indx_t *indx, *tindx, gindx;
  93.     SList Fp Fp  tsl;
  94.     GList Fp Fp  tgl;
  95.     Pgl sgl = NULL;
  96.  
  97.     si = ce->mm.s;
  98.     if (si >= siz_sl)
  99.     {   tsl = (SList Fp Fp) trecalloc(sl,
  100.             sizeof(SList Fp) * (si + 1),
  101.             sizeof(SList Fp) * siz_sl);
  102.         if (tsl)
  103.             sl = tsl;
  104.         else if (sl)
  105.         {   tfree(sl);
  106.             sl = NULL;
  107.             FEError(-300,EXIT,WRITE, "Tierra NewSize() sl trecalloc error");
  108.         }
  109. #ifndef __TURBOC__
  110.         for (i = siz_sl; i <= si; i++)
  111.             sl[i] = NULL;
  112. #endif /* __TURBOC__ */
  113.         siz_sl = si + 1;
  114. #ifdef ERROR
  115.         sprintf(mes[0], "genebank: recalloc, siz_sl = %ld", siz_sl - 1);
  116.         FEMessage(1,mes);
  117. #endif
  118.     }
  119.     sl[si] = (SList *) tcalloc(1, sizeof(SList));
  120.     sl[si]->a_num = 20;
  121.     sl[si]->g = (GList **) tcalloc(20, sizeof(GList *));
  122.     if (IsBit(flags, 3))  /* use for old soups, and cumulative genebanks */
  123.     {
  124. #ifdef IBM3090
  125.         sprintf(Buff, "%04ld.gen.d", si);
  126. #else
  127. #ifdef RISC_OS
  128.         sprintf(Buff, "%sgen.%04ld", GenebankPath, si);
  129. #else
  130.         sprintf(Buff, "%s%04ld.gen", GenebankPath, si);
  131. #endif
  132. #endif
  133.         afp = fopen(Buff, "rb");
  134.         if (!afp) return;
  135.         head = read_head(afp);
  136. #ifdef __TURBOC__
  137.         indx = &gindx;
  138. #else  /* __TURBOC__ */
  139.         indx = read_indx(afp, &head);
  140. #endif /* __TURBOC__ */
  141.         for (i = head.n - 1; i >= 0; i--)
  142.         {
  143. #ifdef __TURBOC__
  144.             find_gen(afp, indx, "---", i);
  145.             tindx = indx;
  146. #else  /* __TURBOC__ */
  147.             tindx = &indx[i];
  148. #endif /* __TURBOC__ */
  149.             sgl = get_gen(afp, &head, tindx, i);
  150.             gi = Lbl2Int(sgl->gen.label);
  151.             if (gi >= sl[si]->a_num)
  152.             {   tgl = (GList Fp Fp) trecalloc(sl[si]->g,
  153.                     sizeof(GList *) * (gi + 1),
  154.                     sizeof(GList *) * sl[si]->a_num);
  155.                 if (tgl)
  156.                     sl[si]->g = tgl;
  157.                 else if (sl[si]->g)
  158.                 {   tfree(sl[si]->g);
  159.                     sl[si]->g = NULL;
  160.                     FEError(-301,EXIT,WRITE,
  161.                         "Tierra NewSize() sl[si]->g trecalloc error");
  162.                 }
  163. #ifndef __TURBOC__
  164.                 for (j = sl[si]->a_num; j <= gi; j++)
  165.                     sl[si]->g[j] = NULL;
  166. #endif /* __TURBOC__ */
  167.                 sl[si]->a_num = gi + 1;
  168.             }
  169.             sl[si]->g[gi] = (Pgl)1;    /* permanent genotype name */
  170.             if (sgl)
  171.             {   if (sgl->genome)
  172.                 {   tfree(sgl->genome);
  173.                     sgl->genome = NULL;
  174.                 }
  175.                 if (sgl->gbits)
  176.                 {   tfree(sgl->gbits);
  177.                     sgl->gbits = NULL;
  178.                 }
  179.                 tfree(sgl);
  180.                 sgl = NULL;
  181.             }
  182.         }
  183.         fclose(afp);
  184. #ifndef __TURBOC__
  185.         if (indx)
  186.         {   thfree(indx);
  187.             indx = NULL;
  188.         }
  189. #endif /* __TURBOC__ */
  190.     }
  191. }
  192.  
  193. I16s IsInGenQueue(ce, hash)/* returns the index of the genotype in the list */
  194.     Pcells  ce;
  195.     I32s    hash;
  196. {
  197.     I32s si = ce->mm.s;
  198.     I16s gi = ce->d.gi, i;
  199.     GList  *tgl;
  200.  
  201.     if (gi >= 0)
  202.     {   if (gi < sl[si]->a_num && (I32u) sl[si]->g[gi] > 4)
  203.             return gi;
  204.         return -1;
  205.     }
  206.     for (i = 0; i < sl[si]->a_num; i++)
  207.     {   tgl = sl[si]->g[i];
  208. #ifdef ERROR
  209.         if ((I32u) tgl > 4)
  210.         {   if (IsSameGen(si, soup + ce->mm.p, tgl->genome))
  211.             {   if (hash != tgl->hash)
  212.                     FEError(-1501,EXIT,WRITE,
  213.                 "Tierra IsInGenQueue() error: IsSameGen, but not same hash");
  214.             }
  215.             else
  216.                 if (hash == tgl->hash)
  217.                     FEError(-1502,NOEXIT,NOWRITE,
  218.                 "Tierra IsInGenQueue() notice: !IsSameGen, but same hash");
  219.         }
  220. #endif /* ERROR */
  221.         if ((I32u) tgl > 4 && hash == tgl->hash &&
  222.             IsSameGen(si, soup + ce->mm.p, tgl->genome))
  223.         {   ce->d.gi = i;
  224.             strcpy(ce->d.gen.label, Int2Lbl(i));
  225.             return i;
  226.         }
  227.     }
  228.     return -1;
  229. }
  230.  
  231. /*
  232.  * Check to see if ce is in the disk genebank.  This will require the reading
  233.  * of successive genotypes of this size from the .gen files on disk.
  234.  * Each genotype that is read will be placed in the genequeue and the complete
  235.  * genome will be placed in the rambank.
  236.  */
  237.  
  238. I8s IsInGenBank(ce, hash, flags)
  239.     Pcells  ce;
  240.     I32s    hash, flags;
  241. {
  242.     static char *ext[] = {"gen", "tmp"};
  243.     I32s i, si = ce->mm.s;
  244.     I32u t, j, n;
  245.     I16s gi = ce->d.gi;
  246.     Pgl g;
  247.     FILE *afp;
  248.     head_t head;
  249.     indx_t *indx, *tindx, gindx;
  250.     GList Fp Fp  tgl;
  251.  
  252.     /*
  253.      * return 0 if we are looking for a specific geneotype, and it does not
  254.      * appear in the genequeue list, and we are not starting up a soup
  255.      */
  256.     if (gi >= 0 && !sl[si]->g[gi] && !IsBit(flags, 2))
  257.         return 0;
  258.     for (i = 0; i < 2; i++) if (IsBit(flags, i))
  259.     {
  260. #ifdef IBM3090
  261.         sprintf(Buff, "%04ld.%s.d", si, ext[i]);
  262. #else
  263. #ifdef RISC_OS
  264.         sprintf(Buff, "%s%s.%04ld", GenebankPath, ext[i], si);
  265. #else
  266.         sprintf(Buff, "%s%04ld.%s", GenebankPath, si, ext[i]);
  267. #endif
  268. #endif
  269.         if (afp = fopen(Buff, "rb"))
  270.         {   head = read_head(afp);
  271. #ifdef __TURBOC__
  272.             indx = &gindx;
  273. #else  /* __TURBOC__ */
  274.             indx = read_indx(afp, &head);
  275. #endif /* __TURBOC__ */
  276.         }
  277.         else continue;
  278.         if (gi >= 0)  /* if we know what genotype we are looking for */
  279.         {   if (gi >= sl[si]->a_num)
  280.             {   tgl = (GList Fp Fp) trecalloc(sl[si]->g,
  281.                     sizeof(GList Fp) * (gi+1),
  282.                     sizeof(GList Fp) * sl[si]->a_num);
  283.                 if (tgl)
  284.                     sl[si]->g = tgl;
  285.                 else if (sl[si]->g)
  286.                 {   tfree(sl[si]->g);
  287.                     sl[si]->g = NULL;
  288.                     FEError(-302,EXIT,WRITE,
  289.                         "Tierra IsInGenBank() sl[si]->g trecalloc error");
  290.                 }
  291. #ifndef __TURBOC__
  292.                 for (j = sl[si]->a_num; j <= gi; j++)
  293.                     sl[si]->g[j] = NULL;
  294. #endif /* __TURBOC__ */
  295.                 sl[si]->a_num = gi + 1;
  296.             }
  297.             n = find_gen(afp, indx, Int2Lbl(gi), head.n);
  298.             if (n < head.n)
  299.             {
  300. #ifdef __TURBOC__
  301.                 tindx = indx;
  302. #else  /* __TURBOC__ */
  303.                 tindx = &indx[n];
  304. #endif /* __TURBOC__ */
  305.                 sl[si]->g[gi] = g = get_gen(afp, &head, tindx, n);
  306.                 if (IsBit(flags, 4))
  307.                     SetBit(&g->bits, 1, 0);
  308.                 gq_add(g);
  309. #ifdef ERROR
  310.                 if (IsSameGen(si, (FpInst) (soup + ce->mm.p), g->genome))
  311.                 {   if (hash != g->hash)
  312.                         FEError(-1503,EXIT,WRITE,
  313.                  "Tierra IsInGenBank() error: IsSameGen, but not same hash");
  314.                 }
  315.                 else
  316.                     if (hash == g->hash)
  317.                         FEError(-1504,NOEXIT,NOWRITE,
  318.                     "Tierra IsInGenBank() notice: !IsSameGen, but same hash");
  319. #endif /* ERROR */
  320.                 /* if disk genotype matches soup genotype */
  321.                 /* name cell and put genotype in genequeue */
  322.                 if (hash == g->hash &&
  323.                     IsSameGen(si, (FpInst) (soup + ce->mm.p), g->genome))
  324.                 {   ce->d.gen = g->gen;
  325.                     ce->d.gi = gi;
  326. #ifndef __TURBOC__
  327.                     if (indx)
  328.                     {   thfree(indx);
  329.                         indx = NULL;
  330.                     }
  331. #endif /* __TURBOC__ */
  332.                     fclose(afp);
  333.                     return 1;
  334.                 }
  335.             }
  336.         }
  337.         else /* we don't know what genotype we are looking for */
  338.         /*
  339.          * check only genotypes that are listed in the rambank as on
  340.          * disk, but whose genomes are not held in the rambank
  341.          * (0 < sl[si]->g[j] <= 4); or which are not listed in the
  342.          * rambank at all (!sl[si]->g[j]), if bit 2 is set, which
  343.          * means we are starting a new or old soup and don't have
  344.          * a list of what is on disk. 
  345.          */
  346.         for (j = 0; j < sl[si]->a_num; j++)
  347.         {   if (!((I32s) sl[si]->g[j] > 0 && (I32s) sl[si]->g[j] <= 4
  348.                     || !sl[si]->g[j] && IsBit(flags, 2)))
  349.                 continue;
  350.             n = find_gen(afp, indx, Int2Lbl(j), head.n);
  351.             if (n < head.n)
  352.             {
  353. #ifdef __TURBOC__
  354.                 tindx = indx;
  355. #else  /* __TURBOC__ */
  356.                 tindx = &indx[n];
  357. #endif /* __TURBOC__ */
  358.                 sl[si]->g[j] = g = get_gen(afp, &head, tindx, n);
  359.                 if (IsBit(flags, 4))
  360.                     SetBit(&g->bits, 1, 0);
  361.                 gq_add(g);
  362.                 /* if disk genotype matches soup genotype */
  363.                 /* name cell and put genotype in genequeue */
  364.                 if (hash == g->hash &&
  365.                     IsSameGen(si, soup + ce->mm.p, g->genome))
  366.                 {   ce->d.gen = g->gen;
  367.                     ce->d.gi = j;
  368. #ifndef __TURBOC__
  369.                     if (indx)
  370.                     {   thfree(indx);
  371.                         indx = NULL;
  372.                     }
  373. #endif /* __TURBOC__ */
  374.                     fclose(afp);
  375.                     return 1;
  376.                 }
  377.             }
  378.         }
  379.         if (afp)
  380.         {
  381. #ifndef __TURBOC__
  382.             if (indx)
  383.             {   thfree(indx);
  384.                 indx = NULL;
  385.             }
  386. #endif /* __TURBOC__ */
  387.             fclose(afp);
  388.         }
  389.     }
  390.     return 0;
  391. }
  392.  
  393. /*
  394.  * add a new genotype to the RAM list
  395.  */
  396.  
  397. void NewGenotype(ce, hash)
  398.     Pcells  ce;
  399.     I32s    hash;
  400. {
  401.     GList  *tgl;
  402.     I32s   i, j, size = ce->mm.s, gi;
  403.     I8s    found = 0;
  404.     GList Fp Fp  tglp;
  405.  
  406.     /* find a free name if there is one */
  407.     for (i = 0; i < sl[size]->a_num; i++) if (!sl[size]->g[i])
  408.     {   gi = i;
  409.         found = 1;
  410.         break;
  411.     }
  412.     if (!found)
  413.     {   gi = sl[size]->a_num;
  414.         tglp = (GList Fp Fp) trecalloc(sl[size]->g,
  415.             sizeof(GList Fp) * (gi + 4),
  416.             sizeof(GList Fp) * gi);
  417.         if (tglp)
  418.             sl[size]->g = tglp;
  419.         else if (sl[size]->g)
  420.         {   tfree(sl[size]->g);
  421.             sl[size]->g = NULL;
  422.             FEError(-303,EXIT,WRITE,
  423.                 "Tierra NewGenotype() sl[size]->g trecalloc error");
  424.         }
  425. #ifndef __TURBOC__
  426.         for (i = gi; i < gi + 4; i++)
  427.             sl[size]->g[i] = NULL;
  428. #endif /* __TURBOC__ */
  429.         sl[size]->a_num += 4;
  430.     }
  431.     sl[size]->g[gi] = tgl =
  432.         (GList *) tcalloc(1, sizeof(GList));
  433.     strcpy(ce->d.gen.label, strcpy(tgl->gen.label, Int2Lbl(gi)));
  434.     tgl->gen.size = ce->d.gen.size = size;
  435.     ce->d.gi = gi;
  436.     tgl->genome = (FpInst) tcalloc(size, sizeof(Instruction));
  437.     if (tgl->genome == NULL)
  438.         FEError(-304,EXIT,WRITE, "Tierra NewGenotype() tcalloc error 1");
  439.     tgl->gbits = (FpGenB) tcalloc(size, sizeof(GenBits));
  440.     if (tgl->gbits == NULL)
  441.         FEError(-305,EXIT,WRITE, "Tierra NewGenotype() tcalloc error 2");
  442.     gq_add(tgl);
  443.     for (i = 0; i < size; i++) 
  444. #if PLOIDY == 1
  445.         tgl->genome[i] = soup[ad(ce->mm.p + i)];
  446. #else
  447.         for (j = 0; j < PLOIDY; j++)
  448.         tgl->genome[i][j] = soup[ad(ce->mm.p + i)][j];
  449. #endif
  450.     tgl->originC = time(NULL);
  451.     tgl->originI = InstExe;
  452.     tgl->parent = ce->d.parent;
  453.     tgl->bits = 0;
  454.     tgl->hash = hash;
  455.     tgl->pop = 0;
  456.     if (reaped)
  457.     {   tgl->MaxPropPop = (float) 1 / (float) NumCells;
  458.         tgl->MaxPropInst = (float) size / (float) SoupSize;
  459.         tgl->mpp_time = InstExe;
  460.     }
  461.     tgl->ploidy = ce->d.ploidy;
  462.     tgl->track = ce->c.tr;
  463. }
  464.  
  465. I32u WhoIs(ce, a)
  466.     Pcells  Fp ce;
  467.     Ind a;
  468. {
  469.     I8s md;
  470.  
  471.     if (a >= (*ce)->mm.p && a < (*ce)->mm.p + (*ce)->mm.s)
  472.         return 0;          /* same cell */
  473.     if (a >= (*ce)->md.p && a < (*ce)->md.p + (*ce)->md.s)
  474.         return 1;          /* daughter cell */
  475.     if (IsFree(a))
  476.         return 3;          /* is free memory */
  477.     WhichCell(a, ce, &md);
  478.     if (md == 'm')
  479.         return 2;          /* is other cell */
  480.     return 4;              /* is the daughter of another cell */
  481. }
  482.  
  483. I8s IsSameGen(size, g1, g2)/* compare two genomes */
  484.     I32s size;
  485.     FpInst g1, g2;
  486. {
  487.     I32s i, j;
  488.  
  489.     for (i = 0; i < size; i++) 
  490. #if PLOIDY == 1
  491.         if ((g1 + i)->inst != (g2 + i)->inst)
  492. #else /* PLOIDY > 1 */
  493.     for (j = 0; j < PLOIDY; j++)
  494.         if ((g1 + i)[j]->inst != (g2 + i)[j]->inst)
  495. #endif /* PLOIDY > 1 */
  496.             return 0;
  497.     return 1;
  498. }
  499.  
  500. void Inject(g, size, rrpi)
  501. FpInst  g;    /* pointer to genome */
  502. I32s    size; /* size of genome */
  503. float   *rrpi; /* reap rand prop for injection */
  504. {   float   tReapRndProp = ReapRndProp;
  505.     I32s    osize, j, k;
  506.     I16s   gi;
  507.     Pcells  ce;
  508.     FpInst  si;
  509.  
  510.     ce = GetFreeCell();   /* get a cell structure */
  511.     ce->ld = 1;
  512.     ce->d.gen.size = ce->mm.s = size;
  513.  
  514.     ReapRndProp = *rrpi;   /* allocate the needed memory */
  515.     osize = size;
  516.     ce->mm.p = MemAlloc(&size);
  517.     while (!size )        /* kill till we get our memory */
  518.     {   reaper(1);
  519.         size = osize;
  520.         ce->mm.p = MemAlloc(&size);
  521.     }
  522.     ReapRndProp = tReapRndProp;
  523.     ce->c.ip = ce->mm.p;
  524.  
  525.     EntBotSlicer(ce);     /* enter into slicer and reaper queues */
  526.     ce->d.is = 1;
  527.     EntBotReaper(ce);
  528.  
  529.     si = soup + ce->mm.p;
  530.     for (j = 0; j < size; j++, si++) /* put genome in soup */
  531. #if PLOIDY == 1
  532.         si[0] = g[j];
  533. #else  /* PLOIDY == 1 */
  534.     for (k = 0; k < PLOIDY; k++)
  535.         si[0][k] = g[j][k];
  536. #endif /* PLOIDY == 1 */
  537.  
  538.     if (GeneBnker) /* determine genotype, record in genebanker */
  539.     {   CheckGenotype(ce, 21);    /* check .gen files */
  540.         ce->d.gi = gi = Lbl2Int(ce->d.gen.label);
  541.         if (!sl[size]->g[gi]->pop)
  542.         {   NumGenotypes++;
  543.             NumGenDG++;
  544.             SetBit(&sl[size]->g[gi]->bits, 0, 1);
  545.             SetBit(&sl[size]->g[gi]->bits, 1, 0);
  546.             sl[size]->num_g++;
  547.         }
  548.         sl[size]->g[gi]->pop++;
  549.         if (!sl[size]->num_c)
  550.             NumSizes++;
  551.         sl[size]->num_c++;
  552.         ce->d.parent = sl[size]->g[gi]->parent;
  553.     }
  554.     OutDisk((I32s) 'b', ce);
  555. }
  556.  
  557. void InjectFromBank(crit)
  558.     I8s     *crit;
  559. {
  560.     float  rrpi = 1;
  561.     I32s   size;
  562.     I16s   gi, n;
  563.     GList  *g;
  564.     char   cpath[128], gen[4];
  565.     FILE   *fp;
  566.     head_t head;
  567.     indx_t *indx, *tindx, gindx;
  568.  
  569.     sscanf(crit, "%4ld%3s", &size, gen);
  570. #ifdef RISC_OS
  571.     sprintf(cpath, "%sgen.%04ld", GenebankPath, size);
  572.     if (!(fp = open_ar(cpath, size, GFormat, 0)))
  573.     {   FEError(-1306,NOEXIT,NOWRITE,
  574.             "Tierra InjectFromBank() unable to open genome file %s\n",cpath);
  575.         return;
  576.     }
  577. #else
  578.     sprintf(cpath, "%s%04ld.gen", GenebankPath, size);
  579.     if (!(fp = open_ar(cpath, size, GFormat, 0)))
  580.     {   FEError(-1306,EXIT,NOWRITE,
  581.             "Tierra InjectFromBank() unable to open genome file %s\n",cpath);
  582.     }
  583. #endif
  584.     head = read_head(fp);
  585. #ifdef __TURBOC__
  586.     indx = &gindx;
  587.     n = find_gen(fp, indx, gen, head.n);
  588.     tindx = indx;
  589. #else  /* __TURBOC__ */
  590.     indx = read_indx(fp, &head);
  591.     n = find_gen(fp, indx, gen, head.n);
  592.     tindx = &indx[n];
  593. #endif /* __TURBOC__ */
  594.     g = get_gen(fp, &head, tindx, n);
  595.     fclose(fp);
  596. #ifndef __TURBOC__
  597.     if (indx)
  598.     {   thfree(indx);
  599.         indx = NULL;
  600.     }
  601. #endif  /* __TURBOC__ */
  602.  
  603.     Inject(g->genome, size, &rrpi);
  604.  
  605.     if (g)
  606.     {   if (g->genome)
  607.         {   tfree(g->genome);
  608.             g->genome = NULL;
  609.         }
  610.         if (g->gbits)
  611.         {   tfree(g->gbits);
  612.             g->gbits = NULL;
  613.         }
  614.         tfree(g);
  615.         g = NULL;
  616.     }
  617. }
  618.  
  619. void gq_add(p)
  620.     GList  *p;
  621. {
  622.     if (!NumGenRQ++)
  623.     {   gq_top = gq_bot = p->a = p->b = p;
  624.         return;
  625.     }
  626.     /* NumGenotypes hasn't been updated yet so add 1 in test */
  627.     while (NumGenRQ > RamBankSiz && NumGenRQ > NumGenotypes + 1)
  628.         gq_swap();
  629.     p->b = gq_top;
  630.     gq_top = gq_top->a = p->a = p;
  631. }
  632.  
  633. I8s gq_swap()
  634. {   GList  *p;
  635.     I8s saved = 0;
  636.     FILE *fp;
  637.     head_t head;
  638.     indx_t *indx, gindx;
  639.  
  640.     p = gq_bot;
  641.     while (p->pop > 0 && p != gq_top)
  642.         p = p->a;
  643.     if (p->pop > 0)
  644.     {   if (gq_bot != gq_top)
  645.         {   p = gq_bot;
  646.             GoDown = 1;
  647.             IMode = PLN_STATS;
  648.             sprintf(mes[0], "gq_swap: NumGenRQ = %ld  NumGenotypes = %ld\n",
  649.                 NumGenRQ, NumGenotypes);
  650.             sprintf(mes[1],
  651.                 "         all genotypes extant, living genome deleted\n");
  652.             sprintf(mes[2],
  653.   "system coming down, then bring back up, to defragment memory, or:\n");
  654.             sprintf(mes[3],
  655. "try higher SavThrMem & SavThrPop, lower SoupSize, or turn off genebanker\n");
  656.             FEMessage(4,mes);
  657.         }
  658.         else
  659.         {   sprintf(mes[0], "gq_swap: NumGenRQ = %ld  NumGenotypes = %ld\n",
  660.                 NumGenRQ, NumGenotypes);
  661.             sprintf(mes[1],
  662.                 "         attempt to swap out last living genome\n");
  663.             FEMessage(2,mes);
  664.             FEError(-306,EXIT,NOWRITE,
  665. "try higher SavThrMem & SavThrPop, lower SoupSize, or turn off genebanker\n");
  666.             return 0;
  667.         }
  668.     }
  669.     saved = IsBit(p->bits, 0);
  670. #ifdef RISC_OS
  671.     sprintf(Buff,"%sgen.%04ld", GenebankPath, p->gen.size);
  672. #else
  673.     sprintf(Buff,
  674. #ifdef IBM3090
  675.         "%04ld.%s.d",
  676. #else  /* IBM3090 */
  677.         "%s%04ld.%s", GenebankPath,
  678. #endif /* IBM3090 */
  679.         p->gen.size, "gen");
  680. #endif /*RISC_OS*/
  681.     if (!(fp = open_ar(Buff, p->gen.size, GFormat, -1)))  
  682.         FEError(-307,EXIT,WRITE,    
  683.             "Tierra gq_swap() unable to open genome file %s",Buff);
  684.     head = read_head(fp);
  685. #ifdef __TURBOC__
  686.     indx = &gindx;
  687. #else  /* __TURBOC__ */
  688.     indx = read_indx(fp, &head);
  689. #endif /* __TURBOC__ */
  690.     add_gen(fp, &head, &indx, p);
  691. #ifndef __TURBOC__
  692.     if (indx)
  693.     {   thfree(indx);
  694.         indx = NULL;
  695.     }
  696. #endif /* __TURBOC__ */
  697.     fclose(fp);
  698.     gq_rem(p);
  699.     if (p)
  700.     {   if (p->gbits)
  701.         {   tfree(p->genome);
  702.             p->genome = NULL;
  703.         }
  704.         if (p->gbits)
  705.         {   tfree(p->gbits);
  706.             p->gbits = NULL;
  707.         }
  708.         sl[p->gen.size]->g[Lbl2Int(p->gen.label)] = (Pgl) saved;
  709.         tfree(p);
  710.         p = NULL;
  711.     }
  712.     return 1;
  713. }
  714.  
  715. void gq_rem(p)
  716.     GList  *p;
  717. {
  718.     if (gq_top == gq_bot)
  719.         gq_top = gq_bot = 0;
  720.     else if (p == gq_top)
  721.         gq_top = p->b->a = p->b;
  722.     else if (p == gq_bot)
  723.         gq_bot = p->a->b = p->a;
  724.     else
  725.     {   p->a->b = p->b;
  726.         p->b->a = p->a;
  727.     }
  728.     NumGenRQ--;
  729. }
  730.  
  731. void gq_movtop(p)
  732.     GList  *p;
  733. {
  734.     if (p == gq_top)
  735.         return;
  736.     gq_rem(p);
  737.     gq_add(p);
  738. }
  739.  
  740. GList *gq_read(si, gi)
  741. {   GList *p = sl[si]->g[gi];
  742.     I16s n;
  743.     FILE *fp;
  744.     head_t head;
  745.     indx_t *indx, *tindx, gindx;
  746.  
  747.     if ((I32u) p > 4)
  748.         return p;
  749. #ifdef RISC_OS
  750.     sprintf(Buff,"%s%s.%04ld", GenebankPath, (I32u) p == 1 ? "gen" : "mem", si);
  751. #else /*RISC_OS*/
  752.     sprintf(Buff,
  753. #ifdef IBM3090
  754.         "%04ld.%s.d",
  755. #else
  756.         "%s%04ld.%s", GenebankPath,
  757. #endif
  758.         si, (I32u) p == 1 ? "gen" : "mem");
  759. #endif /*RISC_OS*/
  760.     if (!(fp = open_ar(Buff, si, GFormat, 0)))
  761.         FEError(-308,EXIT,WRITE,    
  762.             "Tierra gq_read() unable to open genome file %s",Buff);
  763.     head = read_head(fp);
  764. #ifdef __TURBOC__
  765.     indx = &gindx;
  766. #else  /* __TURBOC__ */
  767.     indx = read_indx(fp, &head);
  768. #endif /* __TURBOC__ */
  769.     n = find_gen(fp, indx, Int2Lbl(gi), head.n);
  770. #ifdef __TURBOC__
  771.     tindx = indx;
  772. #else  /* __TURBOC__ */
  773.     tindx = &indx[n];
  774. #endif /* __TURBOC__ */
  775.     p = get_gen(fp, &head, tindx, n);
  776.     fclose(fp);
  777. #ifndef __TURBOC__
  778.     if (indx)
  779.     {   thfree(indx);
  780.         indx = NULL;
  781.     }
  782. #endif /* __TURBOC__ */
  783.     gq_add(p);
  784.     return p;
  785. }
  786.  
  787. void printq()
  788. {   GList  *p;
  789.     int    i = 1;
  790.  
  791.     printf("%ld:B ", NumGenRQ);
  792.     if (p = gq_bot)
  793.     {   printf("%ld%s[%ld] ", p->gen.size, p->gen.label, p->pop);
  794.         while (p != gq_top)
  795.         {   p = p->a, i++;
  796.             printf("%ld%s[%ld] ", p->gen.size, p->gen.label, p->pop);
  797.         }
  798.     }
  799.     printf("%d:T\n", i);
  800. }
  801.  
  802. I16s Lbl2Int(s)
  803.     I8s *s;
  804. {
  805.     if (s[0] == '-')
  806.     return -1;
  807.     return (s[2] - 'a') + (26 * (s[1] - 'a')) + (676 * (s[0] - 'a'));
  808. }
  809.  
  810. I8s *Int2Lbl(i)
  811.     I32s i;
  812. {
  813.     static I8s s[4];
  814.  
  815.     if (i < 0) {
  816.     strcpy(s, "---");
  817.     return s;
  818.     }
  819.     s[0] = 'a' + (I16s) i / 676;
  820.     i %= 676;
  821.     s[1] = 'a' + (I16s) i / 26;
  822.     i %= 26;
  823.     s[2] = 'a' + (I16s) i;
  824.     s[3] = 0;
  825.     return s;
  826. }
  827.  
  828. /* rationale for the functioning of the genebank:
  829.  
  830. The term ``rambank'' refers to a collection of genotypes maintained in RAM
  831. The term ``diskbank'' refers to a collection of genotypes maintained on disk
  832. The term ``genebank'' refers to both the rambank and the diskbank
  833.  
  834. Genotype names have two parts: size-label, for example 0080aaa, 0045eat,
  835. 6666god.
  836.  
  837. 1) When a creature is born its genotype will be compared to that of its parent.
  838.    A) if they are the same, the daughter will be given the same name as the
  839.       mother.
  840.    B) if they are not the same, the genebank will be searched.
  841.       a) if the daughter genotype is found in the genebank, it will be given
  842.          the same name as the genotype that it matches in the bank.
  843.       b) if the daughter genotype does not match any genotype in the bank,
  844.          a new name will be created for it, and it will be entered into the
  845.          rambank.
  846. 2) For each birth and death a count of the population of both the genotype
  847.    and the size class involved will be incremente or decremented, so that we
  848.    have a count of the current population of each genotype and each size class.
  849.    This information is maintained in rambank.
  850. 3) If a genotype frequency crosses a critical threshold, the genotype name
  851.    will become permanent and the genotype will be saved to the diskbank.
  852.    There may be several types of thresholds: proportion of population
  853.    (e.g., 2%), proportion of soup, or just numbers of creatures.
  854. 4) When a genotype frequency drops to zero:
  855.    A) If the genotype never crossed the thresholds, the genotype will be
  856.       removed from the genebank, and its unique name will become available for
  857.       reuse.
  858.    B) If the genotype crossed the threshold, gaining a permanent name, it
  859.       should be retained in the genebank.
  860. 5) Periodically, Tierra saves the complete state of the machine (e.g., every
  861.    100 million instructions executed).  At that time, the complete rambank
  862.    is saved to the diskbank.  For this reason, 4 A applies also to genotypes
  863.    which never became permanent, and these must be removed from the diskbank
  864.    as well.  The bitfield in the genotype structure tells us if a genotype is
  865.    saved to the diskbank, and if it is permanent.
  866. 6) If the rambank becomes ``too full'', some relatively unused portion of it
  867.    should be swapped to the diskbank.  In DOS, ``too full'' could be signaled
  868.    by a malloc failure.  In unix, ``too full'' could be signaled by some
  869.    specified limit on how big the rambank should get, if this seems wise.
  870.    That portion of the rambank to be swapped to the diskbank might consist of
  871.    the least recently accessed size class.  For this reason it might be
  872.    worthwhile to maintain a queue of size classes, ordered by last use.
  873. */
  874.