#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 6 (of 7)."
# Contents:  genebank.c genio.c
# Wrapped by ray@life on Mon Nov  4 22:56:33 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'genebank.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'genebank.c'\"
else
echo shar: Extracting \"'genebank.c'\" \(19725 characters\)
sed "s/^X//" >'genebank.c' <<'END_OF_FILE'
X/* genebank.c  19-8-91  genebank manager for the tierra simulator */
X/** Tierra Simulator V3.0: Copyright (c) 1991 Thomas S. Ray **/
X/* rationale for genebank function are commented at the end of this file */
X
X#include "license.h"
X
X#ifndef lint
Xstatic char     sccsid[] = "@(#)genebank.c	2.5 8/27/91";
X#endif
X
X#include "tierra.h"
X#include "extern.h"
X#include <errno.h>
X
Xvoid GetGenFileList() /* read list from disk, and set up list in memory */
X{   I8s   data[80]; /* when program starts up */
X    I32s  size, i, j, k, gi, ng, onum;
X    FILE  *inl;
X    Psl   tsl;
X    Pgl   sgl = (Pgl) thcalloc(1, sizeof(struct g_list));
X
X    num_genq = 0;
X#ifdef IBM3090
X    sprintf(data,"list.io.d");
X#else
X    sprintf(data,"%slist", GenebankPath);
X#endif
X    inl = fopen(data,"r");
X    if (inl == NULL)
X    {   sprintf(mes[0],"GetGenFileList: file %s not opened, exiting", data);
X        FEMessage(1);
X        while(hangup) ;
X        exit(0);
X    }
X    fgets(data,79,inl);
X    sscanf(data,"NumSizes: %ld  num_gentypes: %ld",&NumSiz,&num_gen);
X    siz_sl = ((NumSiz / 20L) + 1L) * 20L + 20L;
X    NumSizl = NumSiz;
X    num_genl = num_gen;
X    tsl = (Psl) thcalloc((I32u) siz_sl, (I32u) sizeof(struct s_list));
X    if (tsl == NULL)
X    {   sprintf(mes[0],"Tierra GetGenFileList tsl thcalloc error");
X        FEMessage(1);
X        while(hangup) ;
X        exit(0);
X    }
X    else sl = tsl;
X    for (i = 0; i < NumSiz; i++) /* read list of sizes and # gens of each */
X    {   if (fgets(data,79,inl) == NULL) break;
X        data[strlen(data) - 1] = 0;
X        tsl = sl + i;
X        sscanf(data,"%ld%ld", &tsl->size, &tsl->num);
X        tsl->num_s = tsl->num;
X        tsl->a_num = tsl->num + 20;
X        tsl->g = (Pgl) thcalloc((I32u) tsl->a_num, sizeof(struct g_list));
X        if (tsl->g == NULL)
X        {   sprintf(mes[0],"Tierra GetGenFileList sl.g thcalloc error");
X            FEMessage(1);
X            while(hangup) ;
X            exit(0);
X        }
X        for (j=0; j < tsl->a_num; j++) InitGList(tsl->g + j, i, j, tsl->size);
X    }
X    for (i = 0; i < NumSiz; i++) /* read list of genotypes */
X    {   tsl = sl + i;
X        ng = tsl->num;
X        for (j = 0; j < ng; j++)
X        {   if (fgets(data,79,inl) == NULL) break;
X            sscanf(data,"%ld%s%f%f%ld", &size, sgl->gen.label,
X                &sgl->MaxPropPop, &sgl->MaxPropInst, &sgl->bits);
X#ifdef IBM3090
X            Ebcdic2Ascii(sgl->gen.label);
X#endif
X            gi = Lbl2Int(sgl->gen.label);
X            sgl->b.si = sgl->a.si = i;
X            sgl->b.gi = sgl->a.gi = gi;
X            if (gi >= tsl->a_num)
X            {   onum = tsl->a_num;
X                tsl->a_num = gi + 4;
X                tsl->g = (Pgl) threalloc((I8s Hp) tsl->g,
X                (I32u) sizeof(struct g_list) * tsl->a_num);
X                for (k = onum; k < tsl->a_num; k++)
X                    InitGList(tsl->g + k, i, k, tsl->size);
X            }
X            sgl->gen.size = size;
X            *(tsl->g + gi) = *sgl;
X        }
X#ifdef ERROR
X        if (size != tsl->size)
X        {   sprintf(mes[0],"Tierra GetGenFileList size match error");
X            FEMessage(1);
X            while(hangup) ;
X            exit(0);
X        }
X#endif
X    }
X    thfree(sgl);
X    fclose(inl);
X}
X
Xvoid InitGList(g, si, gi, size)
X    Pgl   g;
X    I32s  si, gi, size;
X{
X    g->pop = 0;
X    g->bits = 0;
X    g->gen.label[0] = g->gen.label[1] = g->gen.label[2] = 45;
X    g->gen.label[3] = 0; /* "---" */
X    g->gen.size = size;
X    g->parent.label[0] = g->parent.label[1] = g->parent.label[2] = 45;
X    g->parent.label[3] = 0; /* "---" */
X    g->parent.size = 0;
X    g->d1.inst = g->d1.flags = g->d1.mov_daught = g->d1.BreedTrue = 0;
X    g->d2.inst = g->d2.flags = g->d2.mov_daught = g->d2.BreedTrue = 0;
X    g->originI.i = g->originI.m = g->originC = 0;
X    g->MaxPropPop = g->MaxPropInst = 0;
X    g->comments = NULL; g->genome = NULL, g->gbits = NULL;
X    g->b.si = g->a.si = si;
X    g->b.gi = g->a.gi = gi;
X}
X
Xvoid find_gl(g,gli) /* find the list index of a certain genotype */
X    struct genotype  *g;
X    struct gl_index  *gli;
X{
X    I32s  i, j;
X
X    for (i = 0; i < NumSizl; i++) if (g->size == (sl + i)->size) {
X	for (j = 0; j < (sl + i)->num; j++)
X        if (!strcmp(g->label,((sl + i)->g + j)->gen.label)) {
X	    gli->si = i; gli->gi = j;
X            return ;
X        }
X    }
X    sprintf(mes[0],"Tierra find_gl error");
X    if (!hangup)
X        FEMessage(1);
X    else
X    {   sprintf(mes[1],"system being saved to disk");
X        FEMessage(2);
X    }
X    while(hangup) ;
X    WriteSoup(1);
X    exit(0);
X}
X
Xvoid CheckGenotype(ci,gli)    /* check if ci is a new genotype */
X    I32s  ci;
X    struct gl_index  *gli;
X{
X    IsNewSize(ci,gli);
X    if (IsInGenQueue(ci,gli)) return ;
X    if (IsInGenBank(ci,gli)) return ;
X    NewGenotype(ci,gli);      /* register new genotype in the lists */
X}
X
Xvoid IsNewSize(ci,gli)
X    I32s  ci;
X    struct gl_index  *gli;
X{
X    I32s  i;
X    Psl   tsl;
X    Pgl   tgl;
X
X    for (i = 0; i < NumSizl; i++)
X        if ((sl + i)->size == (cells + ci)->mm.s) {
X	    gli->si = i;
X            return ;
X        }
X    if (++NumSizl > siz_sl)
X    {   siz_sl += 20;
X        tsl = (Psl) threalloc((I8s Hp) sl, sizeof(struct s_list) * siz_sl);
X        if (tsl == NULL)
X        {   sprintf(mes[0],"Tierra IsNewSize threalloc error");
X            if (!hangup)
X                FEMessage(1);
X            else
X            {   sprintf(mes[1],"system being saved to disk");
X                FEMessage(2);
X            }
X            while(hangup) ;
X            WriteSoup(1);
X            exit(0);
X        }
X        else sl = tsl;
X        sprintf(mes[0],"lgeneban: realloc, siz_sl = %ld", siz_sl);
X        FEMessage(1);
X        for (i = siz_sl - 20; i < siz_sl; i++)
X        {   tsl = sl + i;
X            tsl->size = tsl->num = tsl->num_s = tsl->num_q = tsl->a_num = 0;
X            tsl->g = NULL;
X        }
X    }
X    (sl + NumSizl - 1)->size = (cells + ci)->mm.s;
X    (sl + NumSizl - 1)->a_num = 20;
X    tgl = (sl + NumSizl - 1)->g = (Pgl) thcalloc(20, sizeof(struct g_list));
X    for (i = 0; i < 20; i++)
X        InitGList(tgl + i, NumSizl - 1, i, (cells + ci)->mm.s);
X    gli->si = NumSizl - 1;
X    return ;
X}
X
XI8s  IsInGenQueue(ci,gli)
X    I32s  ci;
X    struct gl_index  *gli;
X{   
X    Pcells  ce = cells + ci;
X    I32s  i;
X    Pgl  tgl;
X    Psl  tsl;
X
X    tsl = sl + gli->si;
X    for (i = 0; i < tsl->num; i++)
X    {   tgl = tsl->g + i;
X        if (tgl->genome != NULL &&
X            IsSameGen(ce->mm.s,(HpInst)(soup + ce->mm.p),tgl->genome))
X        {   gli->gi = i;
X            ce->d.gli = *gli;
X            strcpy(ce->d.gen.label,tgl->gen.label);
X            MovToTopGenQueue(gli);
X            return 1;
X        }
X    }
X    return 0;
X}
X
XI8s IsInGenBank(ci,gli) /* check to see if ci is in the disk genebank */
X    I32s  ci;
X    struct gl_index  *gli;
X{
X    Pcells ce = cells + ci;
X    I32s i, j;
X    I8s gfile[80];
X    Psl tsl = (sl + gli->si);
X    Pgl tgl, g = 0;
X    FILE *afp;
X    head_t head;
X    indx_t *indx;
X
X#ifdef IBM3090
X    sprintf(gfile,"%04ld.gen.d", tsl->size);
X#else
X    sprintf(gfile,"%s%04ld.gen", GenebankPath, tsl->size);
X#endif
X
X    if (!(afp = fopen(gfile, "rb")))
X    {   if (errno == ENOENT) return 0;
X        perror("IsInGenBank");
X        exit(9);
X    }
X    head = read_head(afp);
X
X/*
Xhead.magic[3] = '1';
X*/
X
X    if (strncmp(head.magic, "tie", 3) || head.magic[3] - '0' != INST)
X    {   fprintf(stderr, "IsInGenBank: bad magic number");
X        exit(10);
X    }
X    indx = read_indx(afp, &head);
X
X    for (i=0; i<tsl->num; i++) /* read all gens of this size from disk */
X    {   tgl = tsl->g + i; /* tgl = the ith genotype of this size */
X        if (tgl->genome == NULL && (IsBit(tgl->bits,0) || tgl->pop > 0))
X            /* check only genotypes that are not in RAM bank, but which */
X           /* have been saved to disk (either permanent or temporary names) */
X
X        {   if ((j = find_gen(indx, tgl->gen.label, head.n)) == head.n)
X            {   fprintf(stderr, "%s not in archive\n", tgl->gen.label);
X                continue;
X            }
X            g = get_gen(afp, &head, &indx[j], j);
X
X            if (IsSameGen(ce->mm.s, (HpInst) (soup + ce->mm.p), g->genome))
X                /* if disk genotype matches soup genotype */
X                /* name cell and put genotype in genequeue */
X            {   strcpy(ce->d.gen.label,tgl->gen.label);
X                ce->d.gli.si = gli->si; ce->d.gli.gi = gli->gi = i;
X                *tgl = *g;
X                AddTopGenQueue(gli); /* define gli.gi, and place in queue */
X                thfree(g);
X                fclose(afp);
X                return 1;
X            }
X            else if (!RamBankSiz || num_genq < RamBankSiz)
X            {   gli->gi = i;
X                *tgl = *g;
X                AddTopGenQueue(gli);
X            }
X            else if (g->genome)
X            {   thfree(g->genome);
X                g->genome = NULL;
X            }
X            if (g) thfree(g);
X        }
X    }
X    thfree(indx);
X    fclose(afp);
X    return 0;
X}
X
Xvoid NewGenotype(ci,gli) /* add a new genotype to the RAM list */
X    I32s  ci;
X    struct gl_index  *gli;
X{
X    Pcells  ce = cells + ci;
X    Psl  tsl = (sl + gli->si); /* point to this size in size list */
X    Pgl  tgl;
X    I32s  i, j;
X    I8s  found = 0;
X
X    for (i = 0; i < tsl->num; i++)  /* find a free name if there is one */
X    {   tgl = tsl->g + i;
X        if (!IsBit(tgl->bits,0) && tgl->pop < 1)
X        {   gli->gi = i;
X            found = 1;
X            break;
X        }
X    }
X    if (!found) AddToGl(gli);  /* if no free name, make a new one */
X    tgl = tsl->g + gli->gi;       /* point to this new genotype */
X    strcpy(ce->d.gen.label,tgl->gen.label);
X    tgl->d1.inst = tgl->d1.flags = tgl->d1.mov_daught = tgl->d1.BreedTrue = 0;
X    tgl->d2.inst = tgl->d2.flags = tgl->d2.mov_daught = tgl->d2.BreedTrue = 0;
X    if (tgl->genome == NULL)
X    {   AddTopGenQueue(gli);
X        tgl->genome = (HpInst) thcalloc(tsl->size, sizeof(Instruction));
X        if (tgl->genome == NULL)
X        {   sprintf(mes[0],"Tierra NewGenotype thcalloc error 1");
X            if (!hangup)
X                FEMessage(1);
X            else
X            {   sprintf(mes[1],"system being saved to disk");
X                FEMessage(2);
X            }
X            while(hangup) ;
X            WriteSoup(1);
X            exit(0);
X        }
X    }
X    if (tgl->gbits == NULL)
X    {   tgl->gbits = (HpGenB) thcalloc(tsl->size, sizeof(GenBits));
X        if (tgl->gbits == NULL)
X        {   sprintf(mes[0],"Tierra NewGenotype thcalloc error 2");
X            if (!hangup)
X                FEMessage(1);
X            else
X            {   sprintf(mes[1],"system being saved to disk");
X                FEMessage(2);
X            }
X            while(hangup) ;
X            WriteSoup(1);
X            exit(0);
X        }
X    }
X    else if (!found) AddTopGenQueue(gli);
X    else MovToTopGenQueue(gli);
X    for (i = 0; i < tsl->size; i++)
X    {   for (j = 0; j < PLOIDY; j++)
X        {   tgl->genome[i][j] = soup[ad(ce->mm.p + i)][j];
X        }
X    }
X    tgl->originC = time(NULL);
X    tgl->originI = InstExe;
X    tgl->parent = ce->d.parent;
X    tgl->bits = 0; tgl->pop = 0;
X    if (reaped)
X    {   tgl->MaxPropPop = (float) 1 / (float) NumCells;
X        tgl->MaxPropInst = (float) tsl->size / (float) SoupSize;
X    }
X    tgl->ploidy = ce->d.ploidy;
X    tgl->track = ce->c.tr;
X}
X
XI32u WhoIs(ci, a)
X    I32s  *ci;
X    Ind   a;
X{
X    Pcells  ce = cells + *ci;
X    I8s     md;
X
X    if (a >= ce->mm.p && a < ce->mm.p + ce->mm.s) return 0; /* same cell */
X    if (a >= ce->md.p && a < ce->md.p + ce->md.s) return 1;/* daughter cell */
X    if (IsFree(a)) return 3; /* is free memory */
X    WhichCell(a, ci, &md);
X    if (md == 'm') return 2; /* is other cell */
X    return 4;     /* is the daughter of another cell */
X}
X
Xvoid AddToGl(gli)
X    struct gl_index  *gli;
X{
X    I32s  i;
X    Psl   tsl = sl + gli->si;
X    Pgl   tgl;
X    I8s   aaalabel[4];
X
X    aaalabel[0] = aaalabel[1] = aaalabel[2] = 97;
X    aaalabel[3] = 0;
X    num_genl++;
X    if (++tsl->num >= tsl->a_num) {
X	tsl->a_num += 20;
X        tsl->g = (Pgl) threalloc((I8s Hp) tsl->g,
X            sizeof(struct g_list) * tsl->a_num);
X        for (i = tsl->a_num - 20; i < tsl->a_num; i++)
X            InitGList(tsl->g + i,gli->si,i,tsl->size);
X    }
X    tgl = tsl->g + tsl->num - 1;
X    gli->gi = tsl->num - 1;
X    if (tsl->num == 1) strcpy(tgl->gen.label,aaalabel);
X    else IncrLbl(tgl->gen.label,(tgl - 1)->gen.label);
X    if (reaped) {
X	tgl->MaxPropPop  = (float) 1 / (float) NumCells;
X        tgl->MaxPropInst = (float) tsl->size / (float) SoupSize;
X    }
X}
X
XI8s  IsSameGen(size, g1, g2) /* compare two genomes */
X    I32s   size;
X    HpInst  g1, g2;
X{
X    I32s  i, j;
X
X    for (i = 0; i < size; i++)
X    {   for (j = 0; j < PLOIDY; j++)
X            if ((g1 + i)[j]->inst != (g2 + i)[j]->inst) return 0;
X    }
X    return 1;
X}
X
Xvoid AddTopGenQueue(gli)
X    struct gl_index  *gli;
X{
X    Pgl   tgl;
X    Psl   tsl;
X
X    tsl = sl + gli->si;
X    tgl = tsl->g + gli->gi;
X    tsl->num_q++;
X    if (!num_genq) gq_top = gq_bot = *gli;
X    if(++num_genq > RamBankSiz) DelBotGenQueue();/* free place for genotype */
X    tgl->b = gq_top;   /* new top points below to old top of queue */
X    ((sl+gq_top.si)->g+gq_top.gi)->a= *gli;/*old top points above to new top*/
X    tgl->a = *gli;  /* new top points above to self */
X    gq_top = *gli;  /* gli is now the top */
X}
X
Xvoid MovToTopGenQueue(gli)
X    struct gl_index  *gli;
X{
X    Pgl  tgl;
X
X    tgl = (sl + gli->si)->g + gli->gi;
X    if (gli->si == gq_top.si && gli->gi == gq_top.gi) return ;
X    if (gli->si == gq_bot.si && gli->gi == gq_bot.gi) {
X	gq_bot = tgl->a;      /* new bot is above old bot */
X        ((sl + gq_bot.si)->g + gq_bot.gi)->b = gq_bot;  /* new bot points */
X    }                                                   /* down to self */
X    else {   /* next gq points to previous gq */
X        ((sl + tgl->b.si)->g + tgl->b.gi)->a = tgl->a;
X        ((sl + tgl->a.si)->g + tgl->a.gi)->b = tgl->b;
X    }   /* previous gq points to next gq */
X    tgl->a = *gli;               /* points up to self, is at top of queue */
X    tgl->b = gq_top;           /* points down to old top */
X    ((sl+gq_top.si)->g + gq_top.gi)->a = *gli;/*old top points up to new top*/
X    gq_top = *gli;              /* gq_top is now gli */
X}
X
Xvoid DelBotGenQueue()
X{   struct gl_index  new_gq_bot;
X    Pgl  ogl, ngl;
X    Psl  tsl;
X    I8s  path[80];
X    FILE  *fp;
X    head_t head;
X    indx_t *indx;
X
X    tsl = sl + gq_bot.si;
X    ogl = (sl + gq_bot.si)->g + gq_bot.gi;            /* old bottom gl */
X    if (ogl->pop > 0 && !IsBit(ogl->bits,0) && ogl->genome != NULL) {
X#ifdef IBM3090
X        sprintf(path,"%04ld.tmp.d", tsl->size);
X#else
X	sprintf(path,"%s%04ld.tmp", GenebankPath, tsl->size);
X#endif
X	fp = open_ar(path, tsl->size, INST, 0);
X        head = read_head(fp);
X	indx = read_indx(fp, &head);
X	add_gen(fp, &head, &indx, ogl);
X	fclose(fp);
X    }
X    new_gq_bot = ogl->a;
X    ngl = (sl + new_gq_bot.si)->g + new_gq_bot.gi;    /* new bottom gl */
X    ngl->b = new_gq_bot;            /* new bottom gl points down to self */
X    if (ogl->genome) {
X	thfree(ogl->genome);
X        ogl->genome = NULL;
X    }
X    num_genq--;
X    tsl->num_q--;
X    ogl->a = ogl->b = gq_bot;
X    gq_bot = new_gq_bot;
X}
X
Xvoid IncrLbl(lbln, lblo)
X    I8s   *lbln, *lblo;  /* 97 = a, 122 = z in ASCII */
X{   
X    strcpy(lbln,lblo);
X    if (lbln[2] < 122) {
X	lbln[2]++;
X        goto finish;
X    }
X    if (lbln[1] < 122) {
X	lbln[1]++;
X        lbln[2] = 97;
X        goto finish;
X    }
X    if (lbln[0] < 122) {
X	lbln[0]++;
X        lbln[1] = 97;
X        lbln[2] = 97;
X        goto finish;
X    }
X    finish:
X    return ;
X}
X
Xvoid MaxLbl(lbl, s) /* if s > lbl then lbl = s */
X    I8s   *lbl, *s;  /* 97 = a, 122 = z in ASCII */
X{   
X    if (strcmp(lbl,s) > 0) goto finish;
X    if (strcmp(lbl,s) < 0) strcpy(lbl,s);
X    if (lbl[2] < 122) {
X	lbl[2]++;
X        goto finish;
X    }
X    if (lbl[1] < 122) {
X	lbl[1]++;
X        lbl[2] = 97;
X        goto finish;
X    }
X    if (lbl[0] < 122) {
X	lbl[0]++;
X        lbl[1] = 97;
X        lbl[2] = 97;
X        goto finish;
X    }
X    finish:
X    return ;
X}
X
XI32s Lbl2Int(s)
X    I8s  *s;
X{   if(s[0] == '-') return -1;
X    return (s[2]- 'a') + (26 * (s[1] - 'a')) + (676 * (s[0] - 'a'));
X}
X
Xvoid Int2Lbl(i, s)
X    I32s  i;
X    I8s   *s;
X{   if(i < 0)
X    {   strcpy(s,"---");
X        return;
X    }
X    s[0] = 'a' + i / 676;
X    i %= 676;
X    s[1] = 'a' + i / 26;
X    i %= 26;
X    s[2] = 'a' + i;
X    s[3] = 0;
X}
X
Xvoid DelGenFile(tgl) /* this fn is going away real soon */
X    Pgl  tgl;
X{
X    I8s  comd[99];
X
X#ifdef IBM3090
X    strcpy(label, tgl->gen.label);
X    Ascii2Ebcdic(label);
X    sprintf(comd,"erase %04ld%s gen d", tgl->gen.size, label);
X#endif
X#ifdef unix
X    sprintf(comd,"rm %s%04ld%c%04ld%s", GenebankPath,
X	tgl->gen.size, SLASH, tgl->gen.size, tgl->gen.label);
X#endif
X#if __TURBOC__ || OS2_MC
X    sprintf(comd,"del %s%04ld%c%04ld%s", GenebankPath,
X	tgl->gen.size, SLASH, tgl->gen.size, tgl->gen.label);
X#endif
X    system(comd);
X    SetBit(&tgl->bits, 1, 0);
X}
X
X/* rationale for the functioning of the genebank:
X
XThe term ``rambank'' refers to a collection of genotypes maintained in RAM
XThe term ``diskbank'' refers to a collection of genotypes maintained on disk
XThe term ``genebank'' refers to both the rambank and the diskbank
X
XGenotype names have two parts: size-label, for example 0080aaa, 0045eat,
X6666god.
X
X1) When a creature is born its genotype will be compared to that of its
X   parent.
X   A) if they are the same, the daughter will be given the same name as the
X      mother.
X   B) if they are not the same, the genebank will be searched.
X      a) if the daughter genotype is found in the genebank, it will be given
X         the same name as the genotype that it matches in the bank.
X      b) if the daughter genotype does not match any genotype in the bank,
X         a new name will be created for it, and it will be entered into the
X         rambank.
X2) For each birth and death a count of the population of both the genotype
X   and the size class involved will be incremente or decremented, so that we
X   have a count of the current population of each genotype and each size
X   class.  This information is maintained in rambank.
X3) If a genotype frequency crosses a critical threshold, the genotype name
X   will become permanent and the genotype will be saved to the diskbank.
X   There may be several types of thresholds: proportion of population
X   (e.g., 2%), proportion of soup, or just numbers of creatures.
X4) When a genotype frequency drops to zero:
X   A) If the genotype never crossed the thresholds, the genotype will be
X      removed from the genebank, and its unique name will become available for
X      reuse.
X   B) If the genotype crossed the threshold, gaining a permanent name, it
X      should be retained in the genebank.
X5) Periodically, Tierra saves the complete state of the machine (e.g., every
X   100 million instructions executed).  At that time, the complete rambank
X   is saved to the diskbank.  For this reason, 4 A applies also to genotypes
X   which never became permanent, and these must be removed from the diskbank
X   as well.  The bitfield in the genotype structure tells us if a genotype is
X   saved to the diskbank, and if it is permanent.
X6) If the rambank becomes ``too full'', some relatively unused portion of it
X   should be swapped to the diskbank.  In DOS, ``too full'' could be signaled
X   by a malloc failure.  In unix, ``too full'' could be signaled by some
X   specified limit on how big the rambank should get, if this seems wise.
X   That portion of the rambank to be swapped to the diskbank might consist of
X   the least recently accessed size class.  For this reason it might be
X   worthwhile to maintain a queue of size classes, ordered by last use.
X*/
END_OF_FILE
if test 19725 -ne `wc -c <'genebank.c'`; then
    echo shar: \"'genebank.c'\" unpacked with wrong size!
fi
# end of 'genebank.c'
fi
if test -f 'genio.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'genio.c'\"
else
echo shar: Extracting \"'genio.c'\" \(20687 characters\)
sed "s/^X//" >'genio.c' <<'END_OF_FILE'
X/* genio.c  28-10-91  genebank input/output routines */
X/** Tierra Simulator V3.0: Copyright (c) 1991 Thomas S. Ray **/
X
X#include "license.h"
X
X#ifndef lint
Xstatic char     sccsid[] = "@(#)genio.c	2.9 10/8/91";
X#endif
X
X#include "tierra.h"
X#include "extern.h"
X#include <sys/types.h>
X#include <sys/stat.h>
X#include <errno.h>
X
X#define WritEcoS(bits)		WritEcoF(bits, stdout)
X
X/*
X * open_ar - open a genebank archive
X *
X *     file - the filename;
X *     size - the creature size
X *     format - a byte, usually the instruction set number
X *     mode - 0 if the file exists its contents should be preserved,
X *	      1+ if the file should be created (or truncated). mode > 1
X *	      is taken as the number of index entries to allocate 
X *            (will be rounded to the next highest # such that
X *            index + header is a multiple of 1K)
X *
X * returns a pointer to a file opened for update, or NULL if unsuccessful.
X * open_ar fails if size or format are incompatible with the archive.
X */
X
XFILE *open_ar(file, size, format, mode)
X    I8s   *file, format;
X    I16s  size, mode;
X{
X    FILE *fp;
X    head_t head;
X    struct stat *buf = (struct stat *) thcalloc(1, sizeof(struct stat));
X
X    if (mode || stat(file, buf) == -1) {
X	if (fp = fopen(file, "w+b")) {
X	    strcpy(head.magic, "tie");
X	    head.magic[3] = '0' + format;
X	    head.size = size;
X	    head.n = 0;
X	    head.n_alloc = (((int) ((sizeof(head_t) + mode * sizeof(indx_t)) /
X                1024.0) + 1) * 1024 - sizeof head) / sizeof(indx_t);
X	    head.g_off = sizeof(head_t) + head.n_alloc * sizeof(indx_t);
X	    write_head(fp, &head);
X	}
X    }
X    else if (fp = fopen(file, "r+b")) {
X	head = read_head(fp);
X	if (head.size != size || head.magic[3] != format + '0' ||
X                strncmp(head.magic, "tie", 3)) {
X	    fclose(fp);
X	    fp = NULL;
X	    errno = EINVAL;
X	}
X    }
X    return fp;
X}
X
X/*
X * read_head - read header from a genebank archive
X */
X
Xhead_t read_head(fp)
X    FILE *fp;
X{
X    head_t t;
X
X    if (!fseek(fp, 0, 0)) fread(&t, sizeof(head_t), 1, fp);
X    else perror("read_head");
X    return t;
X}
X
X/*
X * write_head - write header to a genebank archive
X */
X
Xvoid write_head(fp, head)
X    FILE    *fp;
X    head_t  *head;
X{
X    if (!fseek(fp, 0, 0)) fwrite(head, sizeof(head_t), 1, fp);
X    else perror("write_head");
X}
X
X/*
X * read_indx - read the index from a genebank archive
X */
X
Xindx_t *read_indx(fp, head)
X    FILE    *fp;
X    head_t  *head;
X{
X    indx_t *t = 0;
X    
X    if (!fseek(fp, sizeof(head_t), 0)) {
X	t = (indx_t *) thcalloc(head->n_alloc, sizeof(indx_t));
X	fread(t, sizeof(indx_t), head->n, fp);
X    }
X    else perror("read_indx");
X    return t;
X}
X
X/*
X * write_indx - write the index to a genebank archive
X */
X
Xvoid write_indx(fp, head, indx)
X    FILE    *fp;
X    head_t  *head;
X    indx_t  *indx;
X{
X    if (!fseek(fp, sizeof(head_t), 0)) {
X	fwrite(indx, sizeof(indx_t), head->n_alloc, fp);
X    }
X    else perror("write_indx");
X}
X
X/*
X * find_gen - find the index of a genome in an archive by its 3 letter name
X *
X * will return n (number of genomes) if not found, otherwise the position
X * (0 - n-1) in archive
X */
X
XI32s find_gen(indx, gen, n)
X    indx_t indx[];
X    I8s   *gen;
X    I32s  n;
X{
X    I32s  i;
X
X    for (i=0; i<n; i++) if (!strncmp(indx[i].gen, gen, 3)) break;
X    return i;
X}
X
X/*
X * get_gen - read a genome from genebank archive and return a pointer
X *     to a struct g_list containing all saved info.
X *
X *     fp - pointer to open archive file
X *     head - archive header
X *     indxn - index entry of desired genome
X *     n - position of desired genome in archive
X *
X * reads the genome and reformats its other args into the form used
X * internally by tierra. the genotype must be in archive. n can be
X * determined by find_gen(). currently no error checking
X */
X
XPgl get_gen(fp, head, indxn, n)
X    FILE    *fp;
X    indx_t  *indxn;
X    head_t  *head;
X    I32s    n;
X{
X    Pgl  t = (Pgl) thcalloc(1, sizeof(struct g_list));
X
X    fseek(fp, head->g_off +
X        (n * head->size * (sizeof(Instruction) + sizeof(GenBits))), 0);
X    t->genome = (HpInst) thcalloc(head->size, sizeof(Instruction));
X    t->gbits  = (HpGenB) thcalloc(head->size, sizeof(GenBits));
X    fread(t->genome, head->size * sizeof(Instruction), 1, fp);
X    fread(t->gbits,  head->size * sizeof(GenBits),     1, fp);
X    t->gen.size = head->size;
X    strncpy(t->gen.label, indxn->gen, 3);
X    t->parent.size = indxn->psize;
X    strncpy(t->parent.label, indxn->pgen, 3);
X    t->bits = indxn->bits;
X    t->d1 = indxn->d1;
X    t->d2 = indxn->d2;
X    t->originI = indxn->originI; t->originC = indxn->originC;
X    t->MaxPropPop = (float) indxn->mpp / 10000.;
X    t->MaxPropInst = (float) indxn->mpi / 10000.;
X    t->ploidy = (indxn->pt & 0360) >> 4;
X    t->track = indxn->pt & 017;
X    return t;
X}
X
X/*
X * add_gen - replace or add a genotype to end of genebank archive
X *
X *     fp - pointer to open archive file
X *     head - header of archive
X *     indx - index of archive
X *     gen - genotype to be added
X *
X * reformats the genotype and replaces it in the archive, or adds it to
X * the end if not found. args head & indx are modified by this fn.
X * returns 0 on add, and 1 on replace.
X */
X
XI32s add_gen(fp, head, indx, gen)
X    FILE *fp;
X    head_t *head;
X    indx_t **indx;
X    Pgl    gen;
X{
X    Instruction *buf;
X    int n, s;
X
X    n = find_gen(*indx, gen->gen.label, head->n);
X    if (n == head->n && head->n == head->n_alloc) {
X	head->n_alloc += 1024 / sizeof(indx_t);
X	*indx = (indx_t *) threalloc(*indx, head->n_alloc * sizeof(indx_t));
X	fseek(fp, head->g_off, 0);
X	buf = (Instruction *) thcalloc(s = head->size * head->n *
X            sizeof(Instruction), 1);
X	fread(buf, s, 1, fp);
X	fseek(fp, head->g_off=sizeof(head_t)+head->n_alloc*sizeof(indx_t), 0);
X	fwrite(buf, s, 1, fp);
X	thfree(buf);
X    }
X    fseek(fp, head->g_off +
X        (n * head->size * (sizeof(Instruction) + sizeof(GenBits))), 0);
X    fwrite(gen->genome, head->size * sizeof(Instruction), 1, fp);
X    fwrite(gen->gbits,  head->size * sizeof(GenBits),     1, fp);
X    strncpy((*indx)[n].gen, gen->gen.label, 3);
X    (*indx)[n].psize = gen->parent.size;
X    strncpy((*indx)[n].pgen, gen->parent.label, 3);
X    (*indx)[n].bits = gen->bits;
X    (*indx)[n].d1 = gen->d1;
X    (*indx)[n].d2 = gen->d2;
X    (*indx)[n].originI = gen->originI;
X    (*indx)[n].originC = gen->originC;
X    (*indx)[n].mpp = (short) (gen->MaxPropPop * 10000);
X    (*indx)[n].mpi = (short) (gen->MaxPropInst * 10000);
X    (*indx)[n].pt = (gen->ploidy << 4) + gen->track;
X    head->n += n = n == head->n;
X    write_head(fp, head);
X    write_indx(fp, head, *indx);
X    return !n;
X}
X
X
X/***** todo:
X    combine & fix getasc?gen, writasc?file
X    ?? replace getgen?format, writ?genfile w/ getgen, addgen in tierra
X*****/
X
XI16s GetAscGen(g, ifile)
X    Pgl  g;
X    I8s  ifile[];
X{
X    I8s   bit[4], chm[4], buf[81], *data, inst[9], *inst2;
X    I16s  t1, BufSiz = 512, ComSiz = 0, format;
X    I32u  sl = 0, sln;
X    I32s  j, k, p, a = 0, b = 0, sc = 1;
X    I8u   ti, *s, *t;
X    FILE  *inf;
X
X    inf = fopen(ifile,"r");
X    if(inf == NULL)
X    {   sprintf(mes[0],"GetAscGen: file %s not opened, exiting");
X        FEMessage(1);
X        while(hangup) ;
X        exit(0);
X    }
X    data = (I8s  *) thcalloc(85, sizeof(I8s));
X    g->ploidy = (I8s) 1; /* default ploidy */
X    fgets(data,84,inf);                                    /* blank line */
X    while(1)
X    {   fgets(data,84,inf);
X        if(strlen(data) < 3) break; /* get a blank line and break */
X        sscanf(data,"%s", buf);
X        if(!strcmp(buf,"format:"))
X        {   sscanf(data,"%*s%hd%*s%lu", &format, &g->bits); continue; }
X        if(!strcmp(buf,"genotype:"))
X	{   sscanf(data,"%*s%ld%s%*s%*s%ld%s", &g->gen.size,
X                g->gen.label, &g->parent.size, g->parent.label);
X            continue;
X        }
X        if(!strcmp(buf,"1st_daughter:"))
X	{   sscanf(data,"%*s%*s%ld%*s%ld%*s%ld%*s%hd",
X                &g->d1.flags, &g->d1.inst, &g->d1.mov_daught, &t1);
X            g->d1.BreedTrue = t1;
X            continue;
X        }
X        if(!strcmp(buf,"2nd_daughter:"))
X	{   sscanf(data,"%*s%*s%ld%*s%ld%*s%ld%*s%hd",
X                &g->d2.flags, &g->d2.inst, &g->d2.mov_daught, &t1);
X            g->d2.BreedTrue = t1;
X            continue;
X        }
X        if(!strcmp(buf,"InstExe.m:"))
X	{   sscanf(data,"%*s%ld%*s%ld%*s%ld",
X                &g->originI.m, &g->originI.i, &g->originC);
X            continue;
X        }
X        if(!strcmp(buf,"MaxPropPop:"))
X	{   sscanf(data,"%*s%f%*s%f", &g->MaxPropPop, &g->MaxPropInst);
X            continue;
X        }
X        if(!strcmp(buf,"ploidy:"))
X	{   sscanf(data,"%*s%ld%*s%ld", &j, &k);
X            g->ploidy = (I8s) j; g->track = (I8s) k;
X            continue;
X        }
X        if(!strcmp(buf,"comments:"))
X        {
X#ifdef COMMENTS
X	    g->comments = (I8s  Fp) thcalloc(BufSiz, sizeof(I8s));
X            ComSiz = sl = strlen(data + 9);
X            while(ComSiz > BufSiz) {
X		BufSiz += 512;
X                g->comments = (I8s  Fp) threalloc(g->comments, BufSiz);
X            }
X            strcpy(g->comments,data + 9);
X#endif
X/*  TOM UFFNER: sl has not been initialized! */
X            while(sl > 1) {
X		fgets(data,84,inf);
X                sln = strlen(data);
X#ifdef COMMENTS
X                while(ComSiz + sln > BufSiz) {
X		    BufSiz += 512;
X                    g->comments = (I8s  Fp) threalloc(g->comments, BufSiz);
X                }
X                strcpy(g->comments + ComSiz, data);
X                ComSiz += sln;
X#endif
X                sl = sln;
X            }
X#ifdef COMMENTS
X            sl = strlen(g->comments);
X            g->comments = (I8s  Fp) threalloc(g->comments, sl + 1);
X#endif
X            break;
X        }
X    }
X    g->genome = (HpInst) thcalloc(g->gen.size, sizeof(Instruction));
X    g->gbits  = (HpGenB) thcalloc(g->gen.size, sizeof(GenBits));
X    for(p = 0; p < PLOIDY; p++)
X    {   if (p) fgets(data,84,inf);
X        fgets(data,84,inf);   fgets(data,84,inf);
X        for(j = 0; j < g->gen.size; j++)
X        {   fgets(data,84,inf); sl = sscanf(data,"%s%*s%s%s", inst, chm, bit);
X            if(sl > 1 && strlen(chm) == 3)
X            {   g->genome[j][p].read  = chm[2] - '0';
X                g->genome[j][p].write = chm[1] - '0';
X                g->genome[j][p].exec  = chm[0] - '0';
X            }
X            if(sl > 2 && strlen(bit) == 3)
X            {   if(bit[0] - '0')
X                    g->gbits[j][p] |= (I8s) 1;
X                if(bit[1] - '0')
X                    g->gbits[j][p] |= (I8s) (1 << 1);
X                if(bit[2] - '0')
X                    g->gbits[j][p] |= (I8s) (1 << 2);
X            }
X            for(k = 0; k < INSTNUM; k++)
X            {   if(!strcmp(inst,aid[k].mn))
X	        {   ti = aid[k].op;
X                    break;
X                }
X            }
X            if(k == INSTNUM)
X            {   sprintf(mes[0],"mnemonic %s not recognized", inst);
X                FEMessage(1);
X                ti = 0;
X            }
X            g->genome[j][p].inst = ti;
X        }
X    }
X    fclose(inf);
X#ifdef IBM3090
X    Ebcdic2Ascii(g->gen.label); Ebcdic2Ascii(g->parent.label);
X    if(g->comments) Ebcdic2Ascii(g->comments);
X#endif
X    return 1;
X}
X
Xvoid WritAscFile(g, file)
X    Pgl   g;
X    I8s   *file;
X{
X    I8s   bit[4], chm[4];
X    I16s  t1;
X    I16u  di, t, j;
X    I8s  format = INST;
X    long int  tp;
X    FILE *fp;
X#ifdef IBM3090
X    I8s  lbl[4], plbl[4], *comnts;
X#endif
X 
X    if (!strcmp(file, "-")) fp = stdout;
X    else if (!(fp = fopen(file, "w")))
X    {   perror("WritAscFile");
X	exit(1);
X    }
X    fprintf(fp, "\nformat: %hd  bits: %lu  ", format, g->bits);
X    WritEcoF(g->bits, fp);
X#ifdef IBM3090
X    strcpy(lbl,g->gen.label); strcpy(plbl,g->parent.label);
X    Ascii2Ebcdic(lbl); Ascii2Ebcdic(plbl);
X    fprintf(fp, "genotype: %04ld%s  parent genotype: %04ld%s\n",
X        g->gen.size, lbl, g->parent.size, plbl);
X#else
X    fprintf(fp, "genotype: %04ld%s  parent genotype: %04ld%s\n",
X        g->gen.size, g->gen.label, g->parent.size, g->parent.label);
X#endif
X    t1 = g->d1.BreedTrue;
X    fprintf(fp, "1st_daughter:  flags: %ld  inst: %ld  mov_daught: %ld  \
X        breed_true: %hd\n", g->d1.flags, g->d1.inst, g->d1.mov_daught, t1);
X    t1 = g->d2.BreedTrue;
X    fprintf(fp, "2nd_daughter:  flags: %ld  inst: %ld  mov_daught: %ld  \
X        breed_true: %hd\n", g->d2.flags, g->d2.inst, g->d2.mov_daught, t1);
X    tp = g->originC;
X    fprintf(fp, "InstExe.m: %ld  InstExe.i: %ld  origin: %ld  %s",
X        g->originI.m, g->originI.i, g->originC, ctime(&tp));
X    fprintf(fp, "MaxPropPop: %g  MaxPropInst: %g\n", g->MaxPropPop,
X        g->MaxPropInst);
X    fprintf(fp, "ploidy: %ld  track: %ld\n", (I32s) g->ploidy,
X        (I32s) g->track);
X#ifdef COMMENTS
X    if(g->comments) {
X#ifdef IBM3090
X        t = strlen(g->comments);
X        comnts = (I8s  *) thcalloc(t + 1, sizeof(I8s));
X        strcpy(comnts,g->comments);
X        Ascii2Ebcdic(comnts);
X        fprintf(fp, "comments:%s", comnts);
X        thfree(comnts);
X#else
X        fprintf(fp, "comments:%s", g->comments);
X#endif
X    }
X    else
X#endif
X	fprintf(fp, "\n");
X    chm[3] = bit[3] = 0;
X    for (j = 0; j < PLOIDY; j++)
X    {   if(j) fprintf(fp,"\n");
X        fprintf(fp, "track %ld: prot\n          xwr\n", j);
X        for (t = 0; t < g->gen.size; t++)
X        {   di = g->genome[t][j].inst;
X            bit[0] = IsBit(g->gbits[t][j],0) ? '1' : '0';
X            bit[1] = IsBit(g->gbits[t][j],1) ? '1' : '0';
X            bit[2] = IsBit(g->gbits[t][j],2) ? '1' : '0';
X            chm[0] = '0' + g->genome[t][j].exec;
X            chm[1] = '0' + g->genome[t][j].write;
X            chm[2] = '0' + g->genome[t][j].read;
X	    fprintf(fp,"%-8s; %s %s %02x %3u\n", aid[di].mn, chm, bit, di, t);
X        }
X    }
X}
X
X/*
X * WritGenFile - write old style genebank file
X *
X *     replaces Writ1GenFile and Writ2GenFile...
X * warning: this function is obsolescent. use only to verify that the new
X * archive format works correctly.
X */
X
Xvoid WritGenFile(g, file)
X    Pgl  g;
X    I8s  file[];
X{
X    FILE  *ouf;
X    I16s  prop;
X    I8s   format = INST;
X
X    ouf = fopen(file,"wb");
X    if(ouf == NULL)
X    {   sprintf(mes[0],"WritGenFile: file %s not opened, exiting", file);
X        FEMessage(1);
X        while(hangup) ;
X        exit(0);
X    }
X    fwrite(&format,          sizeof(I8s),               1, ouf);
X    fwrite(&g->bits,    sizeof(I32u),              1, ouf);
X    fwrite(&g->gen,     sizeof(struct genotype),   1, ouf);
X    fwrite(&g->parent,  sizeof(struct genotype),   1, ouf);
X    fwrite(&g->d1,      sizeof(struct metabolism), 1, ouf);
X    fwrite(&g->d2,      sizeof(struct metabolism), 1, ouf);
X    fwrite(&g->originI, sizeof(struct event),      1, ouf);
X    fwrite(&g->originC, sizeof(I32s),              1, ouf);
X    prop = (I16s) 10000 * g->MaxPropPop;
X    fwrite(&prop,       sizeof(I16s),              1, ouf);
X    prop = (I16s) 10000 * g->MaxPropInst;
X    fwrite(&prop,       sizeof(I16s),              1, ouf);
X#ifdef COMMENTS
X    if (g->comments == NULL)
X#endif
X	fwrite("\012\0", sizeof(I8s), 2, ouf); /* "\n", ebcdic compatible */
X#ifdef COMMENTS
X    else {
X	s = strlen(g->comments) + 1;
X        fwrite(g->comments, sizeof(I8s),           s, ouf);
X    }
X#endif
X#if INST > 1
X    fwrite(&g->ploidy,  sizeof(I8s),               1, ouf);
X    fwrite(&g->track,   sizeof(I8s),               1, ouf);
X#endif
X    fwrite(g->genome, sizeof(Instruction), g->gen.size, ouf);
X    fwrite(g->gbits,  sizeof(GenBits),     g->gen.size, ouf);
X    fclose(ouf);
X}
X
X/*
X * GetGenFormat - read old style genebank file
X *
X *     replaces GetGen1Format and GetGen2Format...
X * warning: this function is obsolescent. use only to verify that the new
X * archive format works correctly.
X */
X
XI16s GetGenFormat(g,file)
X    Pgl  g;
X    I8s  file[];
X{  
X    FILE  *inf;
X    I8s   c = 1, format;
X    I16s  prop;
X    I32s  t = 0, bufsiz = 512;
X
X    inf = fopen(file,"rb");
X    fread(&format,     sizeof(I8s),               1, inf);
X    fread(&g->bits,    sizeof(I32u),              1, inf);
X    fread(&g->gen,     sizeof(struct genotype),   1, inf);
X    fread(&g->parent,  sizeof(struct genotype),   1, inf);
X    fread(&g->d1,      sizeof(struct metabolism), 1, inf);
X    fread(&g->d2,      sizeof(struct metabolism), 1, inf);
X    fread(&g->originI, sizeof(struct event),      1, inf);
X    fread(&g->originC, sizeof(I32s),              1, inf);
X    fread(&prop,       sizeof(I16s),              1, inf);
X    g->MaxPropPop  = (float) prop / 10000.;
X    fread(&prop,       sizeof(I16s),              1, inf);
X    g->MaxPropInst = (float) prop / 10000.;
X    g->comments = (I8s *) thcalloc(bufsiz,sizeof(I8s));
X    do {
X	c = getc(inf);
X        g->comments[t++] = c;
X        if (t >= bufsiz) {
X	    bufsiz += 512;
X            g->comments = (I8s *) threalloc(g->comments,bufsiz);
X        }
X    }
X    while(c);
X    if(g->comments[0] == 10 && g->comments[1] == 0) {  
X	thfree(g->comments);
X        g->comments = NULL;
X    }
X    else g->comments = (I8s  *) threalloc(g->comments,t);
X#ifndef COMMENTS
X    thfree(g->comments);
X    g->comments = NULL;
X#endif
X#if INST > 1
X    fread(&g->ploidy,  sizeof(I8s), 1, inf);
X    fread(&g->track,   sizeof(I8s), 1, inf);
X#endif
X    g->genome = (HpInst) thcalloc(g->gen.size,sizeof(Instruction));
X    fread(g->genome, sizeof(Instruction), g->gen.size, inf);
X    fclose(inf);
X    return (I16s) format;
X}
X
X#ifdef IBM3090
Xstatic unsigned char a2e[] = {
X0000,0001,0002,0003,0067,0055,0056,0057,0026,0005,0045,0013,0014,0015,0016,
X0017,0020,0021,0022,0023,0074,0075,0062,0046,0030,0031,0077,0047,0034,0035,
X0036,0037,0100,0117,0177,0173,0133,0154,0120,0175,0115,0135,0134,0116,0153,
X0140,0113,0141,0360,0361,0362,0363,0364,0365,0366,0367,0370,0371,0172,0136,
X0114,0176,0156,0157,0174,0301,0302,0303,0304,0305,0306,0307,0310,0311,0321,
X0322,0323,0324,0325,0326,0327,0330,0331,0342,0343,0344,0345,0346,0347,0350,
X0351,0112,0340,0132,0137,0155,0171,0201,0202,0203,0204,0205,0206,0207,0210,
X0211,0221,0222,0223,0224,0225,0226,0227,0230,0231,0242,0243,0244,0245,0246,
X0247,0250,0251,0300,0152,0320,0241,0007,0040,0041,0042,0043,0044,0025,0006,
X0027,0050,0051,0052,0053,0054,0011,0012,0033,0060,0061,0032,0063,0064,0065,
X0066,0010,0070,0071,0072,0073,0004,0024,0076,0341,0101,0102,0103,0104,0105,
X0106,0107,0110,0111,0121,0122,0123,0124,0125,0126,0127,0130,0131,0142,0143,
X0144,0145,0146,0147,0150,0151,0160,0161,0162,0163,0164,0165,0166,0167,0170,
X0200,0212,0213,0214,0215,0216,0217,0220,0232,0233,0234,0235,0236,0237,0240,
X0252,0253,0254,0255,0256,0257,0260,0261,0262,0263,0264,0265,0266,0267,0270,
X0271,0272,0273,0274,0275,0276,0277,0312,0313,0314,0315,0316,0317,0332,0333,
X0334,0335,0336,0337,0352,0353,0354,0355,0356,0357,0372,0373,0374,0375,0376,
X0377 };
X
Xstatic unsigned char e2a[] = {
X0000,0001,0002,0003,0234,0011,0206,0177,0227,0215,0216,0013,0014,0015,0016,
X0017,0020,0021,0022,0023,0235,0205,0010,0207,0030,0031,0222,0217,0034,0035,
X0036,0037,0200,0201,0202,0203,0204,0012,0027,0033,0210,0211,0212,0213,0214,
X0005,0006,0007,0220,0221,0026,0223,0224,0225,0226,0004,0230,0231,0232,0233,
X0024,0025,0236,0032,0040,0240,0241,0242,0243,0244,0245,0246,0247,0250,0133,
X0056,0074,0050,0053,0041,0046,0251,0252,0253,0254,0255,0256,0257,0260,0261,
X0135,0044,0052,0051,0073,0136,0055,0057,0262,0263,0264,0265,0266,0267,0270,
X0271,0174,0054,0045,0137,0076,0077,0272,0273,0274,0275,0276,0277,0300,0301,
X0302,0140,0072,0043,0100,0047,0075,0042,0303,0141,0142,0143,0144,0145,0146,
X0147,0150,0151,0304,0305,0306,0307,0310,0311,0312,0152,0153,0154,0155,0156,
X0157,0160,0161,0162,0313,0314,0315,0316,0317,0320,0321,0176,0163,0164,0165,
X0166,0167,0170,0171,0172,0322,0323,0324,0325,0326,0327,0330,0331,0332,0333,
X0334,0335,0336,0337,0340,0341,0342,0343,0344,0345,0346,0347,0173,0101,0102,
X0103,0104,0105,0106,0107,0110,0111,0350,0351,0352,0353,0354,0355,0175,0112,
X0113,0114,0115,0116,0117,0120,0121,0122,0356,0357,0360,0361,0362,0363,0134,
X0237,0123,0124,0125,0126,0127,0130,0131,0132,0364,0365,0366,0367,0370,0371,
X0060,0061,0062,0063,0064,0065,0066,0067,0070,0071,0372,0373,0374,0375,0376,
X0377 };
X
XAscii2Ebcdic(s) char *s; { while (*s = a2e[*s]) s++; }
XEbcdic2Ascii(s) char *s; { while (*s = e2a[*s]) s++; }
X#endif
X
Xvoid WritEcoF(bits, ouf)
X    I32u  bits;
X    FILE  *ouf;
X{  
X    static char s[6], *t[] = { "EX", " TC", " TP", " MF", " MT", " MB" };
X    int i, j;
X
X    for (i=0,j=0; i<6; i++,j=0) {
X	if (IsBit(bits, 5 * i + 2)) s[j++] = 's';
X	if (IsBit(bits, 5 * i + 3)) s[j++] = 'd';
X	if (IsBit(bits, 5 * i + 4)) s[j++] = 'o';
X	if (IsBit(bits, 5 * i + 5)) s[j++] = 'f';
X	if (IsBit(bits, 5 * i + 6)) s[j++] = 'h';
X	s[j] = 0;
X	fprintf(ouf,"%s%s", t[i], s);
X    }
X    fprintf(ouf,"\n");
X}
X
Xvoid SetBit(seed, bit, value)
XI32u  *seed, bit, value;
X{   if(value)
X        (*seed) |= (1 << bit);
X    else
X        (*seed) &= (~(1 << bit));
X}
END_OF_FILE
if test 20687 -ne `wc -c <'genio.c'`; then
    echo shar: \"'genio.c'\" unpacked with wrong size!
fi
# end of 'genio.c'
fi
echo shar: End of archive 6 \(of 7\).
cp /dev/null ark6isdone
MISSING=""
for I in 1 2 3 4 5 6 7 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 7 archives.
    echo "Please see the README file(s) 
    for detailed instructions"
    rm -f ark[1-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0
