rambank.c

地球模拟器

/* rambank.c   9-9-92  rambank manager for the Tierra Simulator */
/* Tierra Simulator V4.0: Copyright (c) 1991, 1992 Tom Ray & Virtual Life */

#ifndef lint
static char sccsid[] = "@(#)rambank.c	1.0        7/21/92";

#endif

#include "license.h"
#include "tierra.h"
#include "extern.h"
#include <errno.h>
#include <sys/types.h>
#ifdef unix
#include <dirent.h>
#endif               /* unix */
#ifdef __TURBOC__
#include <dir.h>
#include <dos.h>
#define d_name ff_name
#endif               /* __TURBOC__ */


#ifdef MEM_CHK
#include <memcheck.h>
#endif

/*
 * CheckGenotype(ce, flags)
 * Check if cell ce is a new genotype.  If it is a new genotype, it will be
 * assigned a unique label.  If this genotype is not present in the RAM
 * genebank, it will be placed there, but there will be no demographic
 * information updated (this is not assumed to be a birth or death).
 * 
 *  flags: bit 0  (1): check .gen files
 *  flags: bit 1  (2): check .tmp files
 *  flags: bit 2  (4): check files even if rambank does not indicate presence
 *      of genotype on disk (used for startup of old or new soups).
 *  flags: bit 3  (8): use all files in the genebank to assemble the list in
 *      the rambank.  Each time a new size is checked, all genomes of that
 *      size in the genebank will become listed in the rambank as being on
 *      the disk (used for startup of old soups and for cumulative genebanks).
 *      However, the genomes will remain on disk until they are actually
 *      accessed, at which time they will be placed in the genequeue in RAM.
 *  flags: bit 4 (16): when reading a file from the disk genebank,
 *      zero bit 1 of the tgl->bits field, otherwise preserve it.
 * 
 *      if soup_in variable CumGeneBnk is non zero, bit 3 is forced ON 
 * 
 *      On the CM5, this function resides on the genebank processor.
 */

GlIndex CheckGenotype(ce, flags)
    Dem   ce;  /* demography structure of cell to be checked */
    I32s  flags;
{
    I32s si;
    GlIndex  GiHash;

    if(CumGeneBnk)
        SetBit(&flags,3,ONE);
    si = ce.gen.size;
    GiHash.si = Hash(si, ce.genome);
	ce.gi = Lbl2Int(ce.gen.label);
    if (IsNewSize(si))
        NewSize(&ce, flags);
    if ((GiHash.gi = IsInGenQueue(&ce, GiHash.si)) >= 0)
    {   gq_movtop(sl[si]->g[GiHash.gi]);
        return GiHash;
    }
#ifndef CM5
    if ((GiHash.gi = IsInGenBank(&ce, GiHash.si, flags)) >= 0)
        return GiHash;
#endif /* CM5 */
    GiHash.gi = NewGenotype(&ce, GiHash.si);
        /* register new genotype in the lists */
    return GiHash;
}

Event DivGenBook(ce, nc, InstExe, reaped, mom, same, disk)
    Pcells  ce, nc; /* ce = mother cell, nc = daughter cell */
    Event   InstExe; /* current time */
    I32s    reaped; /* 1 = the reaper has acted */
    I32s    mom;    /* 1 = do bookeeping on mother as well */
    I32s    same;   /* 1 = daughter is same genotype as mother */
    I32s    disk;   /* 1 = this creature originated from the disk (Inject) */
{   GList   *tgl, *tcgl;
    float   maxp, maxi;
    int     si, gi;
    Event   SizGen;

    SizGen.i = SizGen.m = 0;
    if (mom) /* this code deals only with the mother of the cell being born */
    {   tcgl = sl[si = ce->d.gen.size]->g[gi = ce->d.gi]; /* mother GList */
        if (tcgl && (I32u) tcgl <= 4)
        {
#ifdef CM5
            FEError(-100,EXIT,NOWRITE, 
                "Tierra DivideBookeep() mother genotype missing\n");
#endif /* CM5 */
            tcgl = sl[si]->g[gi] = gq_read(si, gi); /* mother GList */
        }
        if ((I32u) tcgl <= 4)
            FEError(-100,EXIT,NOWRITE, 
                "Tierra DivideBookeep() mother genotype missing\n");
        if (ce->d.fecundity == 1 && !ce->d.mut && !ce->d.flaw)
            tcgl->d1 = ce->d.d1;
        else if (ce->d.fecundity == 2 && !ce->d.mut && !ce->d.flaw)
        {   tcgl->d2.inst = ce->d.inst + 1 - ce->d.d1.inst;
            tcgl->d2.flags = ce->d.flags - ce->d.d1.flags;
            tcgl->d2.mov_daught = ce->d.mov_daught;
            tcgl->d2.BreedTrue = same;
        }
    }

/* the following code deals only with the cell being "born" */

    tgl = sl[si = nc->d.gen.size]->g[nc->d.gi];    /* new cell GList */
    if (!tgl->pop)
    {   SizGen.i = 1;
/*      NumGenotypes++; */
        sl[si]->num_g++;
        if (disk)
        {   NumGenDG++;
            SetBit(&tgl->bits, 0, 1);
            SetBit(&tgl->bits, 1, 0);
        }
    }
    tgl->pop++;
    if (!sl[si]->num_c)
        SizGen.m = 1;
/*      NumSizes++; */
    sl[si]->num_c++;
#if FRONTEND != STDIO
    if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
        query_spec_d(si,nc->d.gi);
#endif /* FRONTEND != STDIO */
/* this might be a good place to keep track of multiple parental genotypes. */
    if (reaped)
    {   maxp = (float) tgl->pop / (float) NumCells;
        if (maxp > tgl->MaxPropPop)
        {   tgl->MaxPropPop = maxp;
            tgl->mpp_time   = InstExe;         
        }
        maxi = (float) tgl->pop * nc->d.gen.size / (float) SoupSize;
        if (maxi > tgl->MaxPropInst)
            tgl->MaxPropInst = maxi;
    }
#ifndef CM5
    /* criteria for saving genotype to disk */
    if (reaped && tgl->pop >= SavMinNum
        && ((!IsBit(tgl->bits, 0) && (tgl->MaxPropPop > SavThrPop
        || tgl->MaxPropInst > SavThrMem * .5))
        || (!IsBit(tgl->bits, 1) && (maxp > SavThrPop
        || maxi > SavThrMem * .5))))
    {   if (!IsBit(tgl->bits, 0))
        {   SetBit(&tgl->bits, 0, 1);
            SetBit(&tgl->bits, 1, 1);
            extract(nc);
        }
        else
        {   SetBit(&tgl->bits, 1, 1);
            sprintf(ExtrG, "%04ld%s @ %ld v", tgl->gen.size, tgl->gen.label,
                (GeneBnker)? tgl->pop : 0L);
#if FRONTEND == STDIO
            sprintf(mes[0], "extract: %s", ExtrG);
            FEMessage(1,mes);
#else /* FRONTEND == STDIO */
            if (Log)
                fprintf(tfp_log, "ex = %s\n", ExtrG);
#endif /* FRONTEND == STDIO */
        }
    }
#endif /* CM5 */
    return SizGen;
}

Event ReapGenBook(ce)
    Pcells  ce;
{   Pgl tgl;
    I32s  si = ce->d.gen.size;
    I16s  gi = ce->d.gi;
    Event   SizGen;

    SizGen.i = SizGen.m = 0;
    tgl = sl[si]->g[gi];
#ifdef ERROR
    if (gi >= sl[si]->a_num)
        FEError(-101,EXIT,NOWRITE, 
            "Tierra ReapBookeep() genotype %hd out of range\n", gi);
    if ((I32u) tgl <= 4)
        FEError(-102,EXIT,NOWRITE, 
            "Tierra ReapBookeep() genotype %hd not in genebank\n", gi);
#endif /* ERROR */
    tgl->pop--;    /* this is a segmentation fault waiting to happen! */
    if (!tgl->pop)
    {   if ((I32u) tgl > 4 && !IsBit(tgl->bits, 0))
        {   if (tgl->genome)
            {   tfree(tgl->genome);
                tgl->genome = NULL;
            }
            if (tgl->gbits)
            {   tfree(tgl->gbits);
                tgl->gbits = NULL;
            }
            gq_rem(tgl);
            tfree(tgl);
            sl[si]->g[gi] = NULL;
        }
        else
            SetBit(&tgl->bits, 1, 0);
/*      NumGenotypes--; */
        SizGen.i = -1;
        sl[si]->num_g--;
    }
    sl[si]->num_c--;
    if (!sl[si]->num_c)
    {   SizGen.m = -1;
/*      NumSizes--; */
#ifdef ERROR
        if (sl[si]->num_g)
            FEError(-103,NOEXIT,NOWRITE, 
                "Tierra ReapBookeep() genotypes but no individuals\n");
#endif /* ERROR */
    }
#if FRONTEND != STDIO
    if ((IMode == SIZ_HIST)|| (IMode == SIZM_HIST) || (IMode == GEN_HIST))
        query_spec_d(si,gi);
#endif /* FRONTEND != STDIO */
    return SizGen;
}

I8s IsNewSize(si)
    I32s si;
{
    if (si < siz_sl && sl[si])
        return 0;
    return 1;
}

void NewSize(ce, flags)
    Dem   *ce;
    I32s  flags;
{
    I32s i, j, si;
    I16s gi;
    SList Fp Fp  tsl;
    GList Fp Fp  tgl;
    Pgl sgl = NULL;
#ifndef CM5
    FILE *afp;
    head_t head;
    indx_t *indx, *tindx, gindx;
#endif /* CM5 */

    si = ce->gen.size;
    if (si >= siz_sl)
    {   tsl = (SList Fp Fp) trecalloc(sl,
            sizeof(SList Fp) * (si + 1),
            sizeof(SList Fp) * siz_sl);
        if (tsl)
            sl = tsl;
        else if (sl)
        {   tfree(sl);
            sl = NULL;
            FEError(-300,EXIT,WRITE, "Tierra NewSize() sl trecalloc error");
        }
#ifndef __TURBOC__
        for (i = siz_sl; i <= si; i++)
            sl[i] = NULL;
#endif /* __TURBOC__ */
        siz_sl = si + 1;
#ifdef ERROR
        sprintf(mes[0], "genebank: recalloc, siz_sl = %ld", siz_sl - 1);
        FEMessage(1,mes);
#endif
    }
    sl[si] = (SList *) tcalloc(1, sizeof(SList));
    sl[si]->a_num = 20;
    sl[si]->g = (GList **) tcalloc(20, sizeof(GList *));
#ifndef CM5
    if (IsBit(flags, 3))  /* use for old soups, and cumulative genebanks */
    {
#ifdef IBM3090
        sprintf(Buff, "%04ld.gen.d", si);
#else /* IBM3090 */
        sprintf(Buff, "%s%04ld.gen", GenebankPath, si);
#endif /* IBM3090 */
        afp = fopen(Buff, "rb");
        if (!afp) return;
        head = read_head(afp);
#ifdef __TURBOC__
        indx = &gindx;
#else  /* __TURBOC__ */
        indx = read_indx(afp, &head);
#endif /* __TURBOC__ */
        for (i = head.n - 1; i >= 0; i--)
        {
#ifdef __TURBOC__
            find_gen(afp, indx, "---", i);
            tindx = indx;
#else  /* __TURBOC__ */
            tindx = &indx[i];
#endif /* __TURBOC__ */
            sgl = get_gen(afp, &head, tindx, i);
            gi = Lbl2Int(sgl->gen.label);
            if (gi >= sl[si]->a_num)
            {   tgl = (GList Fp Fp) trecalloc(sl[si]->g,
                    sizeof(GList *) * (gi + 1),
                    sizeof(GList *) * sl[si]->a_num);
                if (tgl)
                    sl[si]->g = tgl;
                else if (sl[si]->g)
                {   tfree(sl[si]->g);
                    sl[si]->g = NULL;
                    FEError(-301,EXIT,WRITE,
                        "Tierra NewSize() sl[si]->g trecalloc error");
                }
#ifndef __TURBOC__
                for (j = sl[si]->a_num; j <= gi; j++)
                    sl[si]->g[j] = NULL;
#endif /* __TURBOC__ */
                sl[si]->a_num = gi + 1;
            }
            sl[si]->g[gi] = (Pgl)1;    /* permanent genotype name */
            if (sgl)
            {   if (sgl->genome)
                {   tfree(sgl->genome);
                    sgl->genome = NULL;
                }
                if (sgl->gbits)
                {   tfree(sgl->gbits);
                    sgl->gbits = NULL;
                }
                tfree(sgl);
                sgl = NULL;
            }
        }
        fclose(afp);
#ifndef __TURBOC__
        if (indx)
        {   thfree(indx);
            indx = NULL;
        }
#endif /* __TURBOC__ */
    }
#endif /* CM5 */
}

I16s IsInGenQueue(ce, hash)/* returns the index of the genotype in the list */
    Dem   *ce;
    I32s  hash;
{
    I32s si = ce->gen.size;
    I16s gi = ce->gi, i;
    GList  *tgl;

    if (gi >= 0)
    {   if (gi < sl[si]->a_num && (I32u) sl[si]->g[gi] > 4)
            return gi;
        return -1;
    }
    for (i = 0; i < sl[si]->a_num; i++)
    {   tgl = sl[si]->g[i];
#ifdef ERROR
        if ((I32u) tgl > 4)
        {   if (IsSameGen(si, ce->genome, tgl->genome))
            {   if (hash != tgl->hash)
                    FEError(-1501,EXIT,WRITE,
                "Tierra IsInGenQueue() error: IsSameGen, but not same hash");
            }
        }
#endif /* ERROR */
        if ((I32u) tgl > 4 && hash == tgl->hash &&
            IsSameGen(si, ce->genome, tgl->genome))
                return i;
    }
    return -1;
}

/*
 * Check to see if ce is in the disk genebank.  This will require the reading
 * of successive genotypes of this size from the .gen files on disk.
 * Each genotype that is read will be placed in the genequeue and the complete
 * genome will be placed in the rambank.
 */

#ifndef CM5

I16s IsInGenBank(ce, hash, flags)
    Dem   *ce;
    I32s  hash, flags;
{
    static char *ext[] = {"gen", "tmp"};
    I32s i, si = ce->gen.size;
    I32u t, j, n;
    I16s gi = ce->gi;
    Pgl g;
    FILE *afp;
    head_t head;
    indx_t *indx, *tindx, gindx;
    GList Fp Fp  tgl;

    /*
     * return -1 if we are looking for a specific geneotype, and it does not
     * appear in the genequeue list, and we are not starting up a soup
     */
    if (gi >= 0 && !sl[si]->g[gi] && !IsBit(flags, 2))
        return -1;
    for (i = 0; i < 2; i++) if (IsBit(flags, i))
    {
#ifdef IBM3090
        sprintf(Buff, "%04ld.%s.d", si, ext[i]);
#else
        sprintf(Buff, "%s%04ld.%s", GenebankPath, si, ext[i]);
#endif
        if (afp = fopen(Buff, "rb"))
        {   head = read_head(afp);
#ifdef __TURBOC__
            indx = &gindx;
#else  /* __TURBOC__ */
            indx = read_indx(afp, &head);
#endif /* __TURBOC__ */
        }
        else continue;
        if (gi >= 0)  /* if we know what genotype we are looking for */
        {   if (gi >= sl[si]->a_num)
            {   tgl = (GList Fp Fp) trecalloc(sl[si]->g,
                    sizeof(GList Fp) * (gi+1),
                    sizeof(GList Fp) * sl[si]->a_num);
                if (tgl)
                    sl[si]->g = tgl;
                else if (sl[si]->g)
                {   tfree(sl[si]->g);
                    sl[si]->g = NULL;
                    FEError(-302,EXIT,WRITE,
                        "Tierra IsInGenBank() sl[si]->g trecalloc error");
                }
#ifndef __TURBOC__