rambank.c

地球模拟器

                        tfree(tsl[si]->g[gi]);
                    }
                }
                tfree(tsl[si]->g);
                tfree(tsl[si]);
            }
        }
    }
    tfree(tsl);
    if (NumCells != cNumCells || NumCells != cgNumCells ||
        NumCells != cgsNumCells)
        FEError(-119,NOEXIT,NOWRITE,
            "Tierra VerifyGB() NumCells cells array inconsistency\n");
    if (NumGenotypes != cNumGenot || NumGenotypes != cgNumGenot ||
        NumGenotypes != cgsNumGenot)
        FEError(-120,NOEXIT,NOWRITE,
            "Tierra VerifyGB() NumGenot cells array inconsistency\n");
    if (NumSizes != cNumSizes || NumSizes != cgNumSizes)
        FEError(-121,NOEXIT,NOWRITE,
            "Tierra VerifyGB() NumSizes cells array inconsistency\n");
    /* end cells array check */

    /* begin genebank check */
    for (si = 0; si < siz_sl; si++)
    {   psl = sl[si];
        if (!psl)
            continue ;
        if (!psl->num_c || !psl->num_g)
            FEError(-122,NOEXIT,NOWRITE,
                "Tierra VerifyGB() !sl[si]->num_c or !sl[si]->num_g\n");
        if (sl[si]->num_c)
        {   gNumSizes++;
            ggNumCells += sl[si]->num_c;
        }
        if (sl[si]->num_g)
            ggNumGenot += sl[si]->num_g;
        for (gi = 0; gi < sl[si]->a_num; gi++)
        {   pgl = psl->g[gi];
            if ((I32u) pgl < 4 || !pgl->pop)
                continue ;
            gNumGenot++;
            gNumCells += pgl->pop;
        }
    }
    if (NumCells != gNumCells || NumCells != ggNumCells)
        FEError(-123,NOEXIT,NOWRITE,
            "Tierra VerifyGB() NumCells genebank inconsistency\n");
    if (NumGenotypes != gNumGenot || NumGenotypes != ggNumGenot)
        FEError(-124,NOEXIT,NOWRITE,
            "Tierra VerifyGB() NumGenot genebank inconsistency\n");
    if (NumSizes != gNumSizes)
        FEError(-125,NOEXIT,NOWRITE,
            "Tierra VerifyGB() NumSizes genebank inconsistency\n");
    /* end genebank check */
}

#endif /* ERROR */

void GarbageCollectGB()
{   I32s  i, j, maxsiz = 0, tail;
    GList  Fp Fp tgl, Fp pgl;
    SList  Fp Fp tsl;
    I8s     path[80];
    FILE    *fp;
    head_t  head;
    indx_t  *indx, gindx;

    for (i = siz_sl - 1; i >= 0; i--)      /* for each allocated size class */
    {   if (sl[i])
        {   if (sl[i]->num_c)
            {   if (!maxsiz)                     /* find largest size class */
                    maxsiz = i;
                tail = -1;
                for (j = sl[i]->a_num - 1; j >= 0; j--)
                {   if ((I32u) (pgl = sl[i]->g[j]) > 4 && !pgl->pop
                        && !IsBit(pgl->bits, 0))
                    {   gq_rem(pgl);
                        if (pgl->genome)
                        {   tfree(pgl->genome);
                            pgl->genome = NULL;
                        }
                        if (pgl->gbits)
                        {   tfree(pgl->gbits);
                            pgl->gbits = NULL;
                        }
                        tfree(sl[i]->g[j]);
                        sl[i]->g[j] = NULL;
                    }
                    if (tail < 0 && sl[i]->g[j])
                        tail = j;    /* skip empty geotypes at end of array */
                }
                if (tail < sl[i]->a_num - 1)
                {   if (tail < 0)             /* no genotypes in size class */
                    {   if (sl[i]->g)
                        {   tfree(sl[i]->g);
                            sl[i]->g = NULL;
                        }
                        if (sl[i])
                        {   tfree(sl[i]);
                            sl[i] = NULL;
                        }
                    }
                    else           /* shorten g arrays to avoid empty tails */
                    {   tgl = (GList Fp Fp) trecalloc(sl[i]->g,
                            (tail + 1) * sizeof(GList Fp),
                            sl[i]->a_num * sizeof(GList Fp));
                        if (tgl)
                            sl[i]->g = tgl;
                        else if (sl[i]->g)
                        {   tfree(sl[i]->g);
                            sl[i]->g = NULL;
                            FEError(-126,EXIT,WRITE,
                      "Tierra GarbageCollectGB() sl[i]->g trecalloc error\n");
                        }
                        sl[i]->a_num = tail + 1;
                    }
                }
            }
            else /* no creatures of this size, free sl[i] and sl[i]->g */
            {   sprintf(path, "%s%04ld.gen", GenebankPath, i);
                fp = open_ar(path, i, GFormat, -1);
                head = read_head(fp);
#ifdef __TURBOC__
                indx = &gindx;
#else  /* __TURBOC__ */
                indx = read_indx(fp, &head);
#endif /* __TURBOC__ */

                for (j = sl[i]->a_num - 1; j >= 0; j--)
                    if ((I32u) (pgl = sl[i]->g[j]) > 4)
                    {   if (pgl->pop)
                            FEError(-127,NOEXIT,NOWRITE,
 "Tierra GarbageCollectGB(), pgl = %ld, pgl->pop not zero, can't free\n",
     (I32s) pgl);
                        if (IsBit(pgl->bits, 0)) /* save genome to disk */
                            add_gen(fp, &head, &indx, pgl);
                        if (pgl->genome)
                        {   tfree(pgl->genome);
                            pgl->genome = NULL;
                        }
                        if (pgl->gbits)
                        {   tfree(pgl->gbits);
                            pgl->gbits = NULL;
                        }
                        gq_rem(pgl);
                        tfree(sl[i]->g[j]);
                        sl[i]->g[j] = NULL;
                    }
                fclose(fp);
                if (!head.n)
                    unlink(path);
#ifndef __TURBOC__
                if (indx)
                {   thfree(indx);
                    indx = NULL;
                }
#endif /* __TURBOC__ */
                if (sl[i]->g)
                {   tfree(sl[i]->g);
                    sl[i]->g = NULL;
                }
                if (sl[i])
                {   tfree(sl[i]);
                    sl[i] = NULL;
                }
            }
        }
    }
    if (maxsiz < siz_sl - 1)
    {   tsl = (SList Fp Fp) trecalloc(sl, (maxsiz + 1) * sizeof(SList Fp),
            siz_sl * sizeof(SList Fp));
        if (tsl)
            sl = tsl;
        else if (sl)
        {   tfree(sl);
            sl = NULL;
   FEError(-128,EXIT,WRITE, "Tierra GarbageCollectGB() sl trecalloc error\n");
        }
        siz_sl = maxsiz + 1;
    } /* end garbage collect for genebank */
}

#ifdef CM5

struct MaxGen FindMaxGen()
{   I32s  i, j, pop, mem, MaxPop = 0, MaxMem = 0;
    Genotype  MaxGenPop, MaxGenMem;

    for (i = siz_sl - 1; i >= 0; i--)      /* for each allocated size class */
    {   if (sl[i] && sl[i]->num_c)
        {   for (j = sl[i]->a_num - 1; j >= 0; j--)
            {   if ((I32u) (pgl = sl[i]->g[j]) > 4 && pop = pgl->pop)
                {   mem = pop * ce->d.gen.size;
                    if (pop > MaxPop)
                    {   MaxPop = pop;
                        MaxGenPop.size = i;
                        strcpy(MaxGenPop.gen, Int2Lbl(j));
                    }
                    if (mem > MaxMem)
                    {   MaxMem = mem;
                        MaxGenMem.size = i;
                        strcpy(MaxGenMem.gen, Int2Lbl(j));
                    }
                }
            }
        }
    }
}

#endif /* CM5 */

void GenExTemp(adrt, ce, tsize)
    I32s     adrt;  /* address of beginning of template */
    Pcells  ce;    /* ce = cell executing instruction */
    I32s    tsize; /* template size */
{
    I32s  i;
    I32u  who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
                /* 3 free memory; 4 daughter of other cell */
    I32s   dist;
    Pgl   tgl, ogl;
    Pcells  ct;

    tgl = sl[ce->d.gen.size]->g[ce->d.gi];
    for (i = 0; i < tsize; i++)
    {   ct = ce;  /* WHAT TO DO WITH THIS? */
        who = WhoIs(&ct, ad(ce->c.ip + 1 + i)); /* who has template pattern */
        if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (12 + who));
        else tgl->bits |= (I32u) (ONE << (I32u) (12 + 2));
        if (!who)
        {   dist = ad(ce->c.ip + 1 + i) - ce->mm.p;
            dist = ad(dist);
#ifdef ERROR
            if (tgl->genome == NULL || dist < 0 || dist >= tgl->gen.size)
                FEError(-131,EXIT,WRITE, "Tierra GenExTemp() error 0\n");
#endif /* ERROR */
#if PLOIDY == 1
            tgl->gbits[dist] |= 1;
#else /* PLOIDY == 1 */
            tgl->gbits[dist][ce->d.tr] |= 1;
#endif /* PLOIDY == 1 */
        }
        if (who == 2)
        {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
            if (IsBit(ogl->bits, 0))
            {   ogl->bits |= (I32u) (ONE << (I32u) (12 + 4));
                dist = ad(ce->c.ip + 1 + i) - ct->mm.p;
                dist = ad(dist);
#ifdef ERROR
                if (ogl->genome == NULL || dist < 0 || dist >= ogl->gen.size)
                   FEError(-132,EXIT,NOWRITE, "Tierra GenExTemp() error 1\n");
#endif /* ERROR */
#if PLOIDY == 1
                ogl->gbits[dist] |= (1 << 1);
#else /* PLOIDY == 1 */
                ogl->gbits[dist][ce->d.tr] |= (1 << 1);
#endif /* PLOIDY == 1 */
            }
        }
        ct = ce;
        who = WhoIs(&ct, ad(adrt + i)); /* who has complementary template */
        if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (7 + who));
        else tgl->bits |= (I32u) (ONE << (I32u) (7 + 2));
        if (!who)
        {   dist = ad(adrt + i) - ce->mm.p;
            dist = ad(dist);
#ifdef ERROR
            if (tgl->genome == NULL || dist < 0 || dist >= tgl->gen.size)
                FEError(-133,EXIT,WRITE, "Tierra GenExTemp() error 2\n");
#endif /* ERROR */
#if PLOIDY == 1
            tgl->gbits[dist] |= 1;
#else /* PLOIDY == 1 */
            tgl->gbits[dist][ce->d.tr] |= 1;
#endif /* PLOIDY == 1 */
        }
        if (who == 2)
        {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
            if (IsBit(ogl->bits, 0))
            {   ogl->bits |= (I32u) (ONE << (I32u) (7 + 4));
                dist = ad(adrt + i) - ct->mm.p;
                dist = ad(dist);
#ifdef ERROR
                if (ogl->genome == NULL || dist < 0 || dist >= ogl->gen.size)
                    FEError(-134,EXIT,WRITE, "Tierra GenExTemp() error 3\n");
#endif /* ERROR */
#if PLOIDY == 1
                ogl->gbits[dist]|= (1 << 1);
#else /* PLOIDY == 1 */
                ogl->gbits[dist][ce->d.tr] |= (1 << 1);
#endif /* PLOIDY == 1 */
            }
        }
    }
}

void GenExMov(ce, to, from)
    Pcells  ce;
    I32s    to, from;
{
    Pcells  ct;
    Pgl     tgl, ogl;
    I32u    who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
                  /* 3 free memory; 4 daughter of other cell */

    tgl = sl[ce->d.gen.size]->g[ce->d.gi];
    if (ce->d.flaw || ce->d.mut || !IsBit(tgl->bits, 0))
        return;
    /* the mov instruction being executed is within your own genome */
    if (ce->mm.p <= ce->c.ip && ce->c.ip < (ce->mm.p + ce->mm.s))
    {   ct = ce;
        who = WhoIs(&ct, from);    /* who is it moved from */
        if (who < 4) tgl->bits |= (I32u) (ONE << (I32u) (17 + who));
        else tgl->bits |= (I32u) (ONE << (I32u) (17 + 2));
        if (who == 2)
        {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
            if (IsBit(ogl->bits, 0))
            ogl->bits |= (I32u) (ONE << (I32u) (17 + 4));
        }
        ct = ce;
        who = WhoIs(&ct, to); /* who is it moved to */
        if (who < 4)
            tgl->bits |= (I32u) (ONE << (I32u) (22 + who));
        else tgl->bits |= (I32u) (ONE << (I32u) (22 + 2));
        if (who == 2)
        {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
            if (IsBit(ogl->bits, 0))
            ogl->bits |= (I32u) (ONE << (I32u) (22 + 4));
        }
    }
    else   /* these are moved from while executing instructions that */
    {   ct = ce;       /* are not your own */
        who = WhoIs(&ct, from);    /* who is it moved from */
        if (who < 4)
            tgl->bits |= (I32u) (ONE << (I32u) (27 + who));
        else tgl->bits |= (I32u) (ONE << (I32u) (27 + 2));
        if (who == 2)   /* ct is cell from which inst is moved */
        {   ogl = sl[ct->d.gen.size]->g[ct->d.gi];
            if (IsBit(ogl->bits, 0))
                ogl->bits |= (I32u) (ONE << (I32u) (27 + 4));
        }
    }
}

void GenExExe(ce, adrt)
    Pcells  ce;
    I32s     adrt;
{
    Pcells  ct = ce;
    Pgl tgl;
    I32u    dist;
    I32u    who;  /* 0 same cell; 1 daughter cell; 2 other cell; */
                  /* 3 free memory; 4 daughter of other cell */

    tgl = sl[ce->d.gen.size]->g[ce->d.gi];
    if (ce->d.flaw || ce->d.mut || !IsBit(tgl->bits, 0))
        return;
    who = WhoIs(&ct, adrt);
    if (who < 4)
        tgl->bits |= (I32u) (ONE << (I32u) (2 + who));
    else tgl->bits |= (I32u) (ONE << (I32u) (2 + 2));
    if (!who)  /* who == 0 == same cell */
    {   dist = adrt - ce->mm.p;
#ifdef ERROR
        if (tgl->gbits == NULL || dist < 0 || dist >= tgl->gen.size)
            FEError(-135,EXIT,WRITE, "Tierra GenExExe() error 0\n");
#endif /* ERROR */
#if PLOIDY == 1
        tgl->gbits[dist]|= 1;
#else /* PLOIDY == 1 */
        tgl->gbits[dist][ce->d.tr] |= 1;
#endif /* PLOIDY == 1 */
    }
    if (who == 2)  /* is other cell */
    {   tgl = sl[ct->d.gen.size]->g[ct->d.gi];
        if (IsBit(tgl->bits, 0))
        {   tgl->bits |= (ONE << (I32u) (2 + 4));
            dist = adrt - ct->mm.p;
#ifdef ERROR
            if (tgl->gbits == NULL || dist < 0 || dist >= tgl->gen.size)
                FEError(-136,EXIT,WRITE, "Tierra GenExExe() error 1\n");
#endif /* ERROR */
#if PLOIDY == 1
            tgl->gbits[dist]|= (1 << 1);
#else /* PLOIDY == 1 */
            tgl->gbits[dist][ce->d.tr] |= (1 << 1);
#endif /* PLOIDY == 1 */
        }
    }
}

/* rationale for the functioning of the genebank:

The term ``rambank'' refers to a collection of genotypes maintained in RAM
The term ``diskbank'' refers to a collection of genotypes maintained on disk
The term ``genebank'' refers to both the rambank and the diskbank

Genotype names have two parts: size-label, for example 0080aaa, 0045eat,
6666god.

1) When a creature is born its genotype will be compared to that of its parent.
   A) if they are the same, the daughter will be given the same name as the
      mother.
   B) if they are not the same, the genebank will be searched.
      a) if the daughter genotype is found in the genebank, it will be given
         the same name as the genotype that it matches in the bank.
      b) if the daughter genotype does not match any genotype in the bank,
         a new name will be created for it, and it will be entered into the
         rambank.
2) For each birth and death a count of the population of both the genotype
   and the size class involved will be incremente or decremented, so that we
   have a count of the current population of each genotype and each size class.
   This information is maintained in rambank.
3) If a genotype frequency crosses a critical threshold, the genotype name
   will become permanent and the genotype will be saved to the diskbank.
   There may be several types of thresholds: proportion of population
   (e.g., 2%), proportion of soup, or just numbers of creatures.
4) When a genotype frequency drops to zero:
   A) If the genotype never crossed the thresholds, the genotype will be
      removed from the genebank, and its unique name will become available for
      reuse.
   B) If the genotype crossed the threshold, gaining a permanent name, it
      should be retained in the genebank.
5) Periodically, Tierra saves the complete state of the machine (e.g., every
   100 million instructions executed).  At that time, the complete rambank
   is saved to the diskbank.  For this reason, 4 A applies also to genotypes
   which never became permanent, and these must be removed from the diskbank
   as well.  The bitfield in the genotype structure tells us if a genotype is
   saved to the diskbank, and if it is permanent.
6) If the rambank becomes ``too full'', some relatively unused portion of it
   should be swapped to the diskbank.  In DOS, ``too full'' could be signaled
   by a malloc failure.  In unix, ``too full'' could be signaled by some
   specified limit on how big the rambank should get, if this seems wise.
   That portion of the rambank to be swapped to the diskbank might consist of
   the least recently accessed size class.  For this reason it might be
   worthwhile to maintain a queue of size classes, ordered by last use.
*/