rambank.c

地球模拟器

                for (j = sl[si]->a_num; j <= gi; j++)
                    sl[si]->g[j] = NULL;
#endif /* __TURBOC__ */
                sl[si]->a_num = gi + 1;
            }
            n = find_gen(afp, indx, Int2Lbl(gi), head.n);
            if (n < head.n)
            {
#ifdef __TURBOC__
                tindx = indx;
#else  /* __TURBOC__ */
                tindx = &indx[n];
#endif /* __TURBOC__ */
                sl[si]->g[gi] = g = get_gen(afp, &head, tindx, n);
                if (IsBit(flags, 4))
                    SetBit(&g->bits, 1, 0);
                gq_add(g);
#ifdef ERROR
                if (IsSameGen(si, (FpInst) (ce->genome), g->genome))
                {   if (hash != g->hash)
                        FEError(-1503,EXIT,WRITE,
                 "Tierra IsInGenBank() error: IsSameGen, but not same hash");
                }
#endif /* ERROR */
                /* if disk genotype matches soup genotype */
                /* name cell and put genotype in genequeue */
                if (hash == g->hash &&
                    IsSameGen(si, (FpInst) (ce->genome), g->genome))
                {   ce->gen = g->gen;
                    ce->gi = gi;
#ifndef __TURBOC__
                    if (indx)
                    {   thfree(indx);
                        indx = NULL;
                    }
#endif /* __TURBOC__ */
                    fclose(afp);
                    return gi;
                }
            }
        }
        else /* we don't know what genotype we are looking for */
        /*
         * check only genotypes that are listed in the rambank as on
         * disk, but whose genomes are not held in the rambank
         * (0 < sl[si]->g[j] <= 4); or which are not listed in the
         * rambank at all (!sl[si]->g[j]), if bit 2 is set, which
         * means we are starting a new or old soup and don't have
         * a list of what is on disk. 
         */
        for (j = 0; j < sl[si]->a_num; j++)
        {   if (!((I32s) sl[si]->g[j] > 0 && (I32s) sl[si]->g[j] <= 4
                    || !sl[si]->g[j] && IsBit(flags, 2)))
                continue;
            n = find_gen(afp, indx, Int2Lbl(j), head.n);
            if (n < head.n)
            {
#ifdef __TURBOC__
                tindx = indx;
#else  /* __TURBOC__ */
                tindx = &indx[n];
#endif /* __TURBOC__ */
                sl[si]->g[j] = g = get_gen(afp, &head, tindx, n);
                if (IsBit(flags, 4))
                    SetBit(&g->bits, 1, 0);
                gq_add(g);
                /* if disk genotype matches soup genotype */
                /* name cell and put genotype in genequeue */
                if (hash == g->hash &&
                    IsSameGen(si, ce->genome, g->genome))
                {   ce->gen = g->gen;
                    ce->gi = j;
#ifndef __TURBOC__
                    if (indx)
                    {   thfree(indx);
                        indx = NULL;
                    }
#endif /* __TURBOC__ */
                    fclose(afp);
                    return j;
                }
            }
        }
        if (afp)
        {
#ifndef __TURBOC__
            if (indx)
            {   thfree(indx);
                indx = NULL;
            }
#endif /* __TURBOC__ */
            fclose(afp);
        }
    }
    return -1;
}

#endif /* CM5 */

/*
 * add a new genotype to the RAM list
 */

I16s NewGenotype(ce, hash)
    Dem   *ce;
    I32s  hash;
{
    GList  *tgl;
    I32s   i, j, size = ce->gen.size;
    I16s   gi;
    I8s    found = 0;
    GList Fp Fp  tglp;

    /* find a free name if there is one */
    for (i = 0; i < sl[size]->a_num; i++) if (!sl[size]->g[i])
    {   gi = i;
        found = 1;
        break;
    }
    if (!found)
    {   gi = sl[size]->a_num;
        tglp = (GList Fp Fp) trecalloc(sl[size]->g,
            sizeof(GList Fp) * (gi + 4),
            sizeof(GList Fp) * gi);
        if (tglp)
            sl[size]->g = tglp;
        else if (sl[size]->g)
        {   tfree(sl[size]->g);
            sl[size]->g = NULL;
            FEError(-303,EXIT,WRITE,
                "Tierra NewGenotype() sl[size]->g trecalloc error");
        }
#ifndef __TURBOC__
        for (i = gi; i < gi + 4; i++)
            sl[size]->g[i] = NULL;
#endif /* __TURBOC__ */
        sl[size]->a_num += 4;
    }
    sl[size]->g[gi] = tgl =
        (GList *) tcalloc(1, sizeof(GList));
    tgl->gen.size = ce->gen.size = size;
    tgl->genome = (FpInst) tcalloc(size, sizeof(Instruction));
    if (tgl->genome == NULL)
        FEError(-304,EXIT,WRITE, "Tierra NewGenotype() tcalloc error 1");
    tgl->gbits = (FpGenB) tcalloc(size, sizeof(GenBits));
    if (tgl->gbits == NULL)
        FEError(-305,EXIT,WRITE, "Tierra NewGenotype() tcalloc error 2");
    gq_add(tgl);
    for (i = 0; i < size; i++) 
#if PLOIDY == 1
        tgl->genome[i] = ce->genome[i];
#else
        for (j = 0; j < PLOIDY; j++)
        tgl->genome[i][j] = ce->genome[i][j];
#endif
    strcpy(tgl->gen.label, Int2Lbl(gi));
    tgl->originC = time(NULL);
    tgl->originI = InstExe;
    tgl->parent = ce->parent;
    tgl->bits = 0;
    tgl->hash = hash;
    tgl->pop = 0;
    if (reaped)
    {   tgl->MaxPropPop = (float) 1 / (float) NumCells;
        tgl->MaxPropInst = (float) size / (float) SoupSize;
        tgl->mpp_time = InstExe;
    }
    tgl->ploidy = ce->ploidy;
    tgl->track = ce->tr;
    return gi;
}

void gq_add(p)
    GList  *p;
{
    if (!NumGenRQ++)
    {   gq_top = gq_bot = p->a = p->b = p;
        return;
    }
    /* NumGenotypes hasn't been updated yet so add 1 in test */
    while (NumGenRQ > RamBankSiz && NumGenRQ > NumGenotypes + 1)
        gq_swap();
    p->b = gq_top;
    gq_top = gq_top->a = p->a = p;
}

I8s gq_swap()
{   GList  *p;
    I8s saved = 0;
    FILE *fp;
    head_t head;
    indx_t *indx, gindx;

    p = gq_bot;
    while (p->pop > 0 && p != gq_top)
        p = p->a;
    if (p->pop > 0)
    {   if (gq_bot != gq_top)
        {   p = gq_bot;
            GoDown = 1;
            IMode = PLN_STATS;
            sprintf(mes[0], "gq_swap: NumGenRQ = %ld  NumGenotypes = %ld\n",
                NumGenRQ, NumGenotypes);
            sprintf(mes[1],
                "         all genotypes extant, living genome deleted\n");
            sprintf(mes[2],
  "system coming down, then bring back up, to defragment memory, or:\n");
            sprintf(mes[3],
"try higher SavThrMem & SavThrPop, lower SoupSize, or turn off genebanker\n");
            FEMessage(4,mes);
        }
        else
        {   sprintf(mes[0], "gq_swap: NumGenRQ = %ld  NumGenotypes = %ld\n",
                NumGenRQ, NumGenotypes);
            sprintf(mes[1],
                "         attempt to swap out last living genome\n");
            FEMessage(2,mes);
            FEError(-306,EXIT,NOWRITE,
"try higher SavThrMem & SavThrPop, lower SoupSize, or turn off genebanker\n");
            return 0;
        }
    }
    saved = IsBit(p->bits, 0);
    sprintf(Buff,
#ifdef IBM3090
        "%04ld.%s.d",
#else  /* IBM3090 */
        "%s%04ld.%s", GenebankPath,
#endif /* IBM3090 */
        p->gen.size, "gen");
    if (!(fp = open_ar(Buff, p->gen.size, GFormat, -1)))
        FEError(-307,EXIT,WRITE,    
            "Tierra gq_swap() unable to open genome file %s",Buff);
    head = read_head(fp);
#ifdef __TURBOC__
    indx = &gindx;
#else  /* __TURBOC__ */
    indx = read_indx(fp, &head);
#endif /* __TURBOC__ */
    add_gen(fp, &head, &indx, p);
#ifndef __TURBOC__
    if (indx)
    {   thfree(indx);
        indx = NULL;
    }
#endif /* __TURBOC__ */
    fclose(fp);
    gq_rem(p);
    if (p)
    {   if (p->gbits)
        {   tfree(p->genome);
            p->genome = NULL;
        }
        if (p->gbits)
        {   tfree(p->gbits);
            p->gbits = NULL;
        }
        sl[p->gen.size]->g[Lbl2Int(p->gen.label)] = (Pgl) saved;
        tfree(p);
        p = NULL;
    }
    return 1;
}

void gq_rem(p)
    GList  *p;
{
    if (gq_top == gq_bot)
        gq_top = gq_bot = 0;
    else if (p == gq_top)
        gq_top = p->b->a = p->b;
    else if (p == gq_bot)
        gq_bot = p->a->b = p->a;
    else
    {   p->a->b = p->b;
        p->b->a = p->a;
    }
    NumGenRQ--;
}

void gq_movtop(p)
    GList  *p;
{
    if (p == gq_top)
        return;
    gq_rem(p);
    gq_add(p);
}

GList *gq_read(si, gi)
{   GList *p = sl[si]->g[gi];
    I16s n;
    FILE *fp;
    head_t head;
    indx_t *indx, *tindx, gindx;

    if ((I32u) p > 4)
        return p;
    sprintf(Buff,
#ifdef IBM3090
        "%04ld.%s.d",
#else
        "%s%04ld.%s", GenebankPath,
#endif
        si, (I32u) p == 1 ? "gen" : "mem");
    if (!(fp = open_ar(Buff, si, GFormat, 0)))
        FEError(-308,EXIT,WRITE,    
            "Tierra gq_read() unable to open genome file %s",Buff);
    head = read_head(fp);
#ifdef __TURBOC__
    indx = &gindx;
#else  /* __TURBOC__ */
    indx = read_indx(fp, &head);
#endif /* __TURBOC__ */
    n = find_gen(fp, indx, Int2Lbl(gi), head.n);
#ifdef __TURBOC__
    tindx = indx;
#else  /* __TURBOC__ */
    tindx = &indx[n];
#endif /* __TURBOC__ */
    p = get_gen(fp, &head, tindx, n);
    fclose(fp);
#ifndef __TURBOC__
    if (indx)
    {   thfree(indx);
        indx = NULL;
    }
#endif /* __TURBOC__ */
    gq_add(p);
    return p;
}

void printq()
{   GList  *p;
    int    i = 1;

    printf("%ld:B ", NumGenRQ);
    if (p = gq_bot)
    {   printf("%ld%s[%ld] ", p->gen.size, p->gen.label, p->pop);
        while (p != gq_top)
        {   p = p->a, i++;
            printf("%ld%s[%ld] ", p->gen.size, p->gen.label, p->pop);
        }
    }
    printf("%d:T\n", i);
}

#ifdef ERROR

void VerifyGB() /* verify genebank */
{   I32s  gNumSizes = 0, cNumSizes = 0, cgNumSizes = 0;
    I32s  gNumGenot = 0, cNumGenot = 0, cgNumGenot = 0;
    I32s  gNumCells = 0, cNumCells = 0, cgNumCells = 0;
    I32s  cgsNumGenot = 0, ggNumGenot = 0;
    I32s  cgsNumCells = 0, ggNumCells = 0;
    I32s  tsiz_sl = 1, si, ar, ci;
    I16s  gi;
    Pcells ce;
    GList  Fp pgl;
    SList  Fp Fp tsl, Fp psl;

    /* begin cells array check */
    tsl = (SList Fp Fp) tcalloc(1, sizeof(SList Fp));
    for (ar = 0; ar < NumCelAr; ar++) for (ci = 0; ci < CelArSiz; ci++)
    {   if (ar == 0 && ci < 2)
            continue;
        ce = &cells[ar][ci];
        if (ce->ld)
        {   cNumCells++;
            si = ce->d.gen.size;
            if (si >= siz_sl)
                FEError(-110,EXIT,WRITE,
                 "Tierra VerifyGB() size %ld out of range in genebank\n", si);
            psl = sl[si];
            if (!psl)
                FEError(-111,EXIT,WRITE,
                 "Tierra VerifyGB() sl[%ld] not allocated in genebank\n", si);
            gi = ce->d.gi;
            if (gi >= psl->a_num)
                FEError(-112,EXIT,WRITE,
               "Tierra VerifyGB() genome %hd out of range in genebank\n", gi);
            pgl = psl->g[gi];
            if ((I32u) pgl < 4)
                FEError(-113,EXIT,WRITE,
                 "Tierra VerifyGB() gl[%hd] not allocated in genebank\n", gi);
            if (!IsSameGen(si, soup + ce->mm.p, pgl->genome))
                FEError(-114,EXIT,WRITE,
                    "Tierra VerifyGB() cell and genebank do not match\n");
            if (si >= tsiz_sl)
            {   tsl = (SList Fp Fp) trecalloc(tsl,
                    (si + 1) * sizeof(SList Fp), tsiz_sl * sizeof(SList Fp));
                tsiz_sl = si + 1;
            }
            if (!tsl[si])
            {   tsl[si] = (SList Fp) tcalloc(1, sizeof(SList));
                tsl[si]->g = (GList Fp Fp) tcalloc(gi + 1, sizeof(GList Fp));
                tsl[si]->a_num = gi + 1;
            }
            if (!tsl[si]->num_c)
            {   if (tsl[si]->num_g)
                    FEError(-115,NOEXIT,NOWRITE,
                    "Tierra VerifyGB() !tsl[si]->num_c but tsl[si]->num_g\n");
                cNumSizes++;
            }
            tsl[si]->num_c++;
            if (gi >= tsl[si]->a_num)
            {   tsl[si]->g = (GList Fp Fp) trecalloc(tsl[si]->g,
                    (gi + 1) * sizeof(GList Fp),
                    tsl[si]->a_num * sizeof(GList Fp));
                tsl[si]->a_num = gi + 1;
            }
            if ((I32u) tsl[si]->g[gi] < 4)
            {   tsl[si]->g[gi] = (GList Fp) tcalloc(1, sizeof(GList));
                cNumGenot++;
                tsl[si]->num_g++;
            }
            tsl[si]->g[gi]->pop++;
        }
    } /* check and free temporary genebank */
    for (si = 0; si < tsiz_sl; si++)
    {   if (tsl[si])
        {   if (tsl[si]->num_c != sl[si]->num_c)
                FEError(-116,NOEXIT,NOWRITE,
             "Tierra VerifyGB() tsl[%ld]->num_c != sl[%ld]->num_c\n", si, si);
            if (tsl[si]->num_g != sl[si]->num_g)
                FEError(-117,NOEXIT,NOWRITE,
             "Tierra VerifyGB() tsl[%ld]->num_g != sl[%ld]->num_g\n", si, si);
            if (tsl[si]->num_c && tsl[si]->g)
            {   cgNumSizes++;
                cgsNumCells += tsl[si]->num_c;
                cgsNumGenot += tsl[si]->num_g;
                for (gi = 0; gi < tsl[si]->a_num; gi++)
                {   if ((I32u) tsl[si]->g[gi] > 4)
                    {   if (tsl[si]->g[gi]->pop != sl[si]->g[gi]->pop)
                            FEError(-118,NOEXIT,NOWRITE,
          "Tierra VerifyGB() tsl[%ld]->g[%hd]->pop != sl[%ld]->g[%hd]->pop\n",
                                si, gi, si, gi);
                        cgNumGenot++;
                        cgNumCells += tsl[si]->g[gi]->pop;