#! /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 7 (of 7)."
# Contents:  instruct.c tsetup.c
# Wrapped by ray@life on Mon Nov  4 22:56:33 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'instruct.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'instruct.c'\"
else
echo shar: Extracting \"'instruct.c'\" \(22306 characters\)
sed "s/^X//" >'instruct.c' <<'END_OF_FILE'
X/* instruct.c  28-10-91  instruction set for the Tierra simulator */
X/** Tierra Simulator V3.0: Copyright (c) 1991 Thomas S. Ray **/
X
X#include "license.h"
X
X#ifndef lint
Xstatic char     sccsid[] = "@(#)instruct.c	1.22     9/19/91";
X#endif
X
X#include "tierra.h"
X#include "extern.h"
X
Xvoid nop(ci)
XI32s  ci;
X{   (cells + ci)->c.fl = 0; }
X
Xvoid or1(ci) /* flip low order bit of destination register */
XI32s  ci;
X{   Pcells  ce = cells + ci;
X
X    *(is.dreg) ^= (1 + flaw(ci));
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    else if(is.dran && (*(is.dreg) > is.dran || *(is.dreg) < -is.dran))
X    {   *(is.dreg) = is.dval;
X        is.dran = 0;
X        SetFlag(ce); return ;
X    }
X    ce->c.fl = 0;
X}
X
Xvoid shl(ci)
XI32s  ci;
X{   Pcells  ce = cells + ci;
X
X    *(is.dreg) <<= (1 + flaw(ci));
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    else if(is.dran && (*(is.dreg) > is.dran || *(is.dreg) < -is.dran))
X    {   *(is.dreg) = is.dval;
X        is.dran = 0;
X        SetFlag(ce); return ;
X    }
X    ce->c.fl = 0;
X}
X
Xvoid if_cz(ci) /* execute next instruction only if cx == 0 */
XI32s  ci;
X{   Pcells  ce = cells + ci;
X
X    if(is.sval + flaw(ci))
X        is.iip = 2;
X    ce->c.fl = 0;
X}
X
Xvoid math(ci)
XI32s  ci;
X{   Pcells  ce = cells + ci;
X
X    *(is.dreg) = is.sval + is.sval2 + flaw(ci);
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    else if(is.dran && (*(is.dreg) > is.dran || *(is.dreg) < -is.dran))
X    {   *(is.dreg) = is.dval;
X        is.dran = 0;
X        SetFlag(ce); return ;
X    }
X    ce->c.fl = 0;
X}
X
Xvoid push(ci)
XI32s  ci;
X{   Pcells  ce = cells + ci;
X
X    ce->c.sp = ++ce->c.sp % STACK_SIZE;
X    ce->c.st[ce->c.sp] = is.sval; ce->c.fl = 0;
X}
X
Xvoid pop(ci)
XI32s  ci;
X{   Pcells  ce = cells + ci;
X
X    if(is.dran && (ce->c.st[ce->c.sp] >  is.dran ||
X                   ce->c.st[ce->c.sp] < -is.dran))
X    {   is.dran = 0;
X        SetFlag(ce); return ;
X    }
X    *(is.dreg) = ce->c.st[ce->c.sp];
X    if(!ce->c.sp) ce->c.sp = STACK_SIZE - 1; /* decrement stack pointer */
X    else --ce->c.sp;
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    ce->c.fl = 0;
X}
X
Xvoid tcall(ci) /* call template */
XI32s  ci;
X{   push(ci);
X    adr(ci);
X}
X
Xvoid call(ci) /* call address */
XI32s  ci;
X{   push(ci);
X    movdd(ci);
X}
X
Xvoid mov(ci)
XI32s ci;
X{   switch(is.mode)
X    {   case 0: movdd(ci); break; /*   direct destination,   direct source */
X        case 1: movdi(ci); break; /*   direct destination, indirect source */
X        case 2: movid(ci); break; /* indirect destination,   direct source */
X        case 3: movii(ci); break; /* indirect destination, indirect source */
X    }
X}
X
Xvoid movdd(ci)
XI32s ci;
X{   Pcells  ce = (cells + ci);
X
X    *(is.dreg) = is.sval + flaw(ci);
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    else if(is.dran && (*(is.dreg) > is.dran || *(is.dreg) < -is.dran))
X    {   *(is.dreg) = is.dval;
X        is.dran = 0;
X        SetFlag(ce); return ;
X    }
X    ce->c.fl = 0; 
X}
X
Xvoid movdi(ci)
XI32s ci;
X{   Pcells  ce = (cells + ci);
X
X    if((IsInsideCell(ce,is.sval) || !is.sins->read) &&
X        (0 <= is.sval && is.sval < SoupSize))
X    {   *(is.dreg) = is.sins->inst + flaw(ci);
X        ce->c.fl = 0; 
X    }
X    else { SetFlag(ce); return ; }
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    else if(is.dran && (*(is.dreg) > is.dran || *(is.dreg) < -is.dran))
X    {   *(is.dreg) = is.dval;
X        is.dran = 0;
X        SetFlag(ce); return ;
X    }
X}
X
Xvoid movid(ci)
XI32s ci;
X{   Pcells  ce = (cells + ci);
X
X    if((IsInsideCell(ce,is.dval) || !is.dins->write) &&
X        (0 <= is.dval && is.dval < SoupSize))
X    {   is.dins->inst = is.sval + flaw(ci);
X        ce->c.fl = 0;
X    }
X    else SetFlag(ce);
X}
X
Xvoid movii(ci)
XI32s ci;
X{   Pcells  ce = (cells + ci), ct;
X    Pgl     tgl, ogl;
X    I32s    ti;
X    I32u    who;
X
X    if ((!is.dins->write || IsInsideCell(ce,is.dval)) &&
X        (!is.sins->read  || IsInsideCell(ce,is.sval)) &&
X        (0 <= is.dval && is.dval < SoupSize) &&
X        (0 <= is.sval && is.sval < SoupSize))
X    {   if(is.dval >= ce->md.p && is.dval <= ce->md.p + ce->md.s)
X            ce->d.mov_daught++;
X        is.dins->inst = is.sins->inst;
X        if(RateMovMut && ++CountMovMut >= RateMovMut)
X        {   mut_site(soup + ad(is.dval), is.dtra);
X            CountMovMut = tlrand() % RateMovMut;
X            TotMovMut++;
X        }
X        ce->c.fl = 0;
X        if(WatchMov)
X            GenExMov(ci, is.dval, is.sval);
X    }
X    else SetFlag(ce);
X}
X
Xvoid adr(ci) /* is.dreg  = address of instruction after target template */
XI32s  ci;    /* is.dreg2 = template size */
X             /* is.sval2 = size of template */
X             /* is.dval  = start address for forward search */
X             /* is.dval2 = start address for backward search */
X             /* is.mode  = search direction: 0 out, 1 forward, 2 backward */
X             /* is.mode2 = match style: 0 = complement, 1 = direct */
X{   Pcells  ce = cells + ci;
X    Ind     adrt;
X
X    if(!is.sval2) { SetFlag(ce); return ; } /* source template missing */
X    if(!is.mode)     /* outward search */
X        adrt = template(is.dval,is.dval2,is.sval2,'o',is.mode2,ci); 
X    if(is.mode == 1) /* forward search */
X        adrt = template(is.dval,is.dval2,is.sval2,'f',is.mode2,ci); 
X    if(is.mode == 2) /* backward search */
X        adrt = template(is.dval,is.dval2,is.sval2,'b',is.mode2,ci); 
X    if(adrt < 0) /* target template not found */
X    {   is.iip = is.sval2 + 1; /* skip ip over source template */
X        SetFlag(ce); return ;
X    }
X    *(is.dreg) = adrt;
X    *(is.dreg2) = is.sval2;
X    if(is.dmod)
X    {   *(is.dreg) = mo(*(is.dreg),is.dmod);
X        is.dmod = 0;
X    }
X    else if(is.dran && (*(is.dreg) > is.dran || *(is.dreg) < -is.dran))
X    {   *(is.dreg) = is.dval;
X        is.dran = 0;
X        SetFlag(ce); return ;
X    }
X    if(is.dmod2)
X    {   *(is.dreg2) = mo(*(is.dreg2),is.dmod2);
X        is.dmod2 = 0;
X    }
X    else if(is.dran2 && (*(is.dreg2) > is.dran2 || *(is.dreg2) < -is.dran2))
X    {   *(is.dreg2) = is.dval2;
X        is.dran2 = 0;
X        SetFlag(ce); return ;
X    }
X    ce->c.fl = 0; return ;
X}
X
Xvoid mal(ci)  /* allocate space for a new cell */
XI32s  ci;
X{   Pcells  ce = cells + ci;
X    Ind   p;
X    I32s  size, osize;
X
X    if(is.sval <= 0 || is.sval == ce->md.s || is.sval > MaxMalMult*ce->mm.s)
X    {   ce->c.fl = 1; return ; }
X    is.sval2 = size = (I32s) is.sval + flaw(ci);
X    if(!size) return ;
X    if(ce->md.s)
X    {
X#ifdef ERROR
X        if(ce->md.p < 0 || ce->md.p >= SoupSize)
X        {   sprintf(mes[0],"Tierra mal() 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#endif
X        MemDealloc(ce->md.p,ce->md.s);
X        ce->d.mov_daught = 0;
X        ce->md.s = 0;
X    }
X    osize = size;
X    p = MemAlloc(&size);
X    while(!size && osize < 3 * AverageSize)
X    {   reaper(1);
X        size = osize;
X        p = MemAlloc(&size);
X    }
X#ifdef ERROR
X    if(p < 0 || p >= SoupSize)
X    {   sprintf(mes[0],"Tierra mal 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#endif
X    if(!size) { ce->c.fl = 1; return ; }
X    *(is.dreg) = ce->md.p = ad(p); ce->md.s = size; ce->c.fl = 0;
X    DownReperIf(ci);
X}
X
Xvoid chmode(ci)
XI32s ci;
X    /* is.sval  = location of chmoded block */
X    /* is.sval2 = size of chmoded block */
X    /* is.dtra  = track being chmoded */
X    /* is.mode  = chmod mode, unix notation, e.g. 7 = full protection */
X    /*          1 bit = execute, 2 bit = write, 4 bit = read */
X    /* only owner of memory has chmod privelages */
X{   Pcells  ce = cells + ci;
X    Ind     a = 0, t;
X    I8s     exec, write, read;
X
X    exec = IsBit(is.mode,0); write = IsBit(is.mode,1); read =IsBit(is.mode,2);
X    while(a < is.sval2)
X    {   t = ad(is.sval + a);
X        if(IsInsideCell(ce, t))
X        {   soup[t][is.dtra].exec  = exec;
X            soup[t][is.dtra].write = write;
X            soup[t][is.dtra].read  = read;
X        }
X        else SetFlag(ce);
X        a++;
X    }
X    ce->c.fl = 0;
X}
X
Xvoid malchm(ci)
XI32s ci;
X{   /* is.sval = requested size of block, is.sval2 = flawed size of block */
X    /* is.dreg = location of block */
X    mal(ci);
X    is.sval = *(is.dreg);
X    /* is.sval  = location of chmoded block */
X    /* is.sval2 = size of chmoded block */
X    /* is.dtra  = track being chmoded */
X    /* is.mode  = chmod mode, unix notation, e.g. 7 = full protection */
X    chmode(ci);
X}
X
Xvoid divide(ci)
XI32s ci;
X{   Pcells ce = (cells+ci);
X    Pcells  nc;  /* pointer to the new cell */
X    I32s ni = 2;
X
X    if (ce->md.s < MinCellSize || ce->d.mov_daught < (I32s) (ce->md.s *
X        MovPropThrDiv) || !ce->d.mov_daught)
X    {   ce->c.fl = 1; return;}
X    if (DivSameSiz)
X    {   if (ce->mm.s != ce->md.s)
X           { ce->c.fl = 1; return; }
X        if (DivSameGen &&
X           !IsSameGen(ce->mm.s, soup + ce->md.p, soup + ce->mm.p))
X           { ce->c.fl = 1; return; }
X    }
X    switch(is.mode)
X    {   case 0: /* create cpu */
X        {   if(ce->d.ni < 0) /* if there is no cpu (first call to div 0) */
X            {   if(++NumCells > CellsSize - 2)
X                {   CheckCells();
X                    ce = cells + ci;
X                }
X                while((cells + ni)->ld) /* find unoccupied cell struct */
X                {   ni++;
X#ifdef ERROR
X                    if(ni >= CellsSize)
X                    {   sprintf(mes[0],"Tierra DIV error A0, exiting");
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#endif
X                }
X                nc = cells + ni;
X                InitCell(ni);
X                nc->ld = 1;
X                nc->mm = ce->md;
X                nc->c.ip = nc->mm.p;
X                nc->d.dm = 1;
X                ce->d.ni = ni;
X            }
X            else /* if there is a cpu (second call to div 0) */
X            {   ni = ce->d.ni;
X                nc = cells + ni;
X                if(nc->d.is) /* call to div 0 after call to div 1 */
X                {   RmvFrmSlicer(ni);
X                    nc->d.is = 0;
X                }
X                else /* two sequential calls to div 0, error */
X		{   ce->c.fl = 1; return; }
X            }
X            break;
X        }
X        case 1: /* start cpu */
X        {   if(ce->d.ni < 0) /* if there is no cpu, div 1 before div 0 */
X            {   if(++NumCells > CellsSize - 2)
X                {   CheckCells();
X                    ce = cells + ci;
X                }
X                while((cells + ni)->ld) /* find unoccupied cell struct */
X                {   ni++;
X#ifdef ERROR
X                    if(ni >= CellsSize)
X                    {   sprintf(mes[0],"Tierra DIV error B0, exiting");
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#endif
X                }
X                nc = cells + ni;
X                InitCell(ni);
X                nc->ld = 1;
X                nc->mm = ce->md;
X                nc->c.ip = nc->mm.p;
X                nc->d.dm = 1;
X                ce->d.ni = ni;
X            }
X            else /* if there is already a cpu, make pointers to it */
X            {   ni = ce->d.ni;
X                nc = cells + ni;
X            }
X            if(nc->d.is) /* 2nd call to div 1, cpu is already started */
X            {   RmvFrmSlicer(ni);
X                nc->d.is = 0;
X            }
X            else /* not 2nd call to div 1, cpu is not already started */
X            {   EntBotSlicer(ni);
X                nc->d.is = 1;
X            }
X            break;
X        }
X        case 2: /* split */
X        {   if(ce->d.ni < 0) /* if there is no cpu, div 2 before div 0 */
X            {   if(++NumCells > CellsSize - 2)
X                {   CheckCells();
X                    ce = cells + ci;
X                }
X                while((cells + ni)->ld) /* find unoccupied cell struct */
X                {   ni++;
X#ifdef ERROR
X                    if(ni >= CellsSize)
X                    {   sprintf(mes[0],"Tierra DIV error C0, exiting");
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#endif
X                }
X                nc = cells + ni;
X                InitCell(ni);
X                nc->ld = 1;
X                nc->mm = ce->md;
X                nc->c.ip = nc->mm.p;
X            }
X            else
X            {   ni = ce->d.ni;
X                nc = cells + ni;
X            }
X            if(!nc->d.is) /* no slicer, div CX before div BX */
X            {   EntBotSlicer(ni);
X                nc->d.is = 1;
X            }
X            ce->md.s = ce->md.p = 0;
X            ce->d.ni = -1; /* clean up if AX or BX before CX */
X            nc->d.dm = 0;
X            EntBotReaper(ni);
X            DownReperIf(ci);
X            DivideBookeep(ci, ni);
X        }
X    }
X    ce->c.fl = 0; 
X}
X
Xvoid CheckCells() /* check and adjust memory allocation if necessary */
X{   I32s   j, oCellsSize = CellsSize;
X    I8s    buf[80];
X
X    sprintf(mes[0],"in_div CheckCells: realloc, NumCells = %ld", NumCells);
X    sprintf(buf,"    old CellsSize = %ld  ", CellsSize);
X    CellsSize = (I32s) CellsSize * 1.6;
X    if(NumCells > CellsSize - 2) CellsSize += 12;
X    cells = (Pcells) threalloc((I8s Hp) cells,
X            (I32u) CellsSize * (I32u) sizeof(struct cell));
X    if(cells == NULL)
X    {   sprintf(mes[0],"Tierra instructions realloc error, exiting");
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    sprintf(mes[1],"%s new CellsSize = %ld", buf, CellsSize);
X    FEMessage(2);
X#ifdef __TURBOC__
X    sprintf(mes[0],"coreleft = %lu  divide (cells)", coreleft());
X    FEMessage(1);
X#endif
X    for(j = oCellsSize; j < CellsSize; j++)
X        InitCell(j);
X}
X
XI32s flaw(ci)
XI32s  ci;
X{   CountFlaw++;
X    if(RateFlaw && CountFlaw >= RateFlaw)
X    {   CountFlaw = tlrand() % RateFlaw;
X        TotFlaw++;
X        (cells + ci)->d.flaw++;
X        if(tcrand() % 2) return 1;
X        return -1;
X    }
X    return 0;
X}
X
XInd template(f, b, tz, dir, mode, ci) /*search in specified direction for */
X  /* nop template return address, returns address of instruction following */
X  /* target template, i.e., target + tz */
X  /* NOTE: ce->c.ip must point to the instruction (agent) being executed */
XInd   f;    /* starting address for forward search */
XInd   b;    /* starting address for backward search */
XI32s  tz;   /* template size */
XI8s   dir;  /* direction of search, f = forward, b = backward, o = out */
XI8s   mode; /* match mode: 0 = complement, 1 = direct */
XI32s  ci;   /* which cell */
X{   Ind   o, l = 1, adrt;
X    I32s  i = 0, match;
X    I8s   df, db;
X    Pgl   tgl;
X    Pcells  ce = cells + ci;
X
X    if((tz < MinTemplSize) || (tz > SoupSize))
X    {   adrt = -1;
X        goto finish;
X    }
X    if(dir == 'o') df = db = 1;        /* both directions */
X    if(dir == 'f') { df = 1; db = 0; } /* forward only */
X    if(dir == 'b') { df = 0; db = 1; } /* backwards only */
X    o = ad(ce->c.ip + 1);
X    while(1)
X    {   while(1)/*this skips sections of codes that are not templates (NOPs)*/
X        {   /* forward */
X	    if(df && (soup[f][ce->c.tr].inst == 0 
X	        || soup[f][ce->c.tr].inst == 1)) break;
X            else { f++; f = ad(f); }
X	    /* backward */
X            if(db && (soup[b][ce->c.tr].inst == 0 
X	        || soup[b][ce->c.tr].inst == 1)) break;
X            else { b--; b = ad(b); }
X        }
X        match = 1; /* forward */
X        if(df && (soup[f][ce->c.tr].inst == 0 
X	    || soup[f][ce->c.tr].inst == 1)) /* if NOPs */
X        {   if(!mode) /* compliment match mode */
X	    {   for(i = 0; i < tz; i++) /* over the full template size */
X                {   if(soup[ad(o + i)][ce->c.tr].inst 
X		        + soup[ad(f + i)][ce->c.tr].inst != 1)
X                    { match = 0; break; }
X                }
X            }
X	    else /* direct match mode */
X	    {   for(i = 0; i < tz; i++) /* over the full template size */
X                {   if(soup[ad(o + i)][ce->c.tr].inst 
X		        - soup[ad(f + i)][ce->c.tr].inst != 0)
X                    { match = 0; break; }
X                }
X            }
X            if(match)
X            {   f += flaw(ci);
X                adrt = ad(f + tz);
X                goto finish;
X            }
X        }
X        match = 1; /* backward */
X        if(db && (soup[b][ce->c.tr].inst == 0 
X	    || soup[b][ce->c.tr].inst == 1)) /* if NOPs */
X        {   if(!mode) /* compliment match mode */
X	    {   for(i = 0; i < tz; i++) /* over the full template size */
X                {   if(soup[ad(o + i)][ce->c.tr].inst 
X		        + soup[ad(b + i)][ce->c.tr].inst != 1)
X                    { match = 0; break; }
X                }
X	    }
X	    else /* direct match mode */
X	    {   for(i = 0; i < tz; i++) /* over the full template size */
X                {   if(soup[ad(o + i)][ce->c.tr].inst 
X		        - soup[ad(b + i)][ce->c.tr].inst != 0)
X                    { match = 0; break; }
X                }
X            }
X            if(match)
X            {   b += flaw(ci);
X                adrt = ad(b + tz);
X                goto finish;
X            }
X        }      /* increment search pointers, backward and forward */
X        if(db) { b--; b = ad(b); } if(df) { f++; f = ad(f); } l++;
X        if(l > Search_limit) /* if we exceed the search limit abort */
X        {   adrt = -1;
X            goto finish;
X        }
X    }
X    finish:
X    if(1 && WatchTem) tgl = (sl + ce->d.gli.si)->g + ce->d.gli.gi;
X    if(1 && WatchTem && adrt >= 0 && !ce->d.flaw && !ce->d.mut &&
X        ce->mm.p <= ce->c.ip && ce->c.ip < (ce->mm.p + ce->mm.s) &&
X        IsBit(tgl->bits,0))
X        GenExTemp(ad(adrt - tz), ci, tz);
X    return adrt; /* address of instruction following target template */
X}
X
XInd btemplate(f, b, tz, dir, mode, ci) /*search in specified direction for */
X    /* binary template return address, returns address of instruction */
X    /* following target template, i.e., target + tz */
X    /* NOTE: ce->c.ip must point to the instruction (agent) being executed */
XInd   f;    /* starting address for forward search */
XInd   b;    /* starting address for backward search */
XI32s  tz;   /* template size */
XI8s   dir;  /* direction of search, f = forward, b = backward, o = out */
XI8s   mode; /* match mode: 0 = complement, 1 = direct */
XI32s  ci;   /* which cell */
X{   Ind   o, l = 1, adrt;
X    I32s  i = 0, match;
X    I8s   df, db;
X    Pgl   tgl;
X    Pcells  ce = cells + ci;
X
X    if((tz < MinTemplSize) || (tz > SoupSize))
X    {   adrt = -1;
X        goto finish;
X    }
X    if(dir == 'o') df = db = 1;        /* both directions */
X    if(dir == 'f') { df = 1; db = 0; } /* forward only */
X    if(dir == 'b') { df = 0; db = 1; } /* backwards only */
X    o = ad(ce->c.ip + 1);
X    while(1)
X    {   match = 1;
X        if(df) /* if direction forwards */
X        {   if(!mode) /* compliment match mode */
X            {   for(i = 0; i < tz; i++) /* for full template size */
X                {   if((soup[ad(o + i)][ce->c.tr].inst 
X                        ^ soup[ad(f + i)][ce->c.tr].inst) == 31)
X                    { match = 0; break; }
X                }
X            }
X            else /* direct match mode */
X            {   for(i = 0; i < tz; i++) /* for full template size */
X                {   if(soup[ad(o + i)][ce->c.tr].inst 
X                        == soup[ad(f + i)][ce->c.tr].inst)
X                    { match = 0; break; }
X                }
X            }
X            if(match)
X            {   f += flaw(ci);
X                adrt = ad(f + tz);
X                goto finish;
X            }
X        }
X        if(db) /* if direction backwards */
X        {   match = 1;
X            if(!mode) /* compliment match mode */
X            {   for(i = 0; i < tz; i++) /* for full template size */
X                {   if((soup[ad(o + i)][ce->c.tr].inst 
X                        ^ soup[ad(b + i)][ce->c.tr].inst) == 31)
X                    { match = 0; break; }
X                }
X            }
X            else /* direct match mode */
X            {   for(i = 0; i < tz; i++) /* for full template size */
X                {   if(soup[ad(o + i)][ce->c.tr].inst 
X                        == soup[ad(b + i)][ce->c.tr].inst)
X                    { match = 0; break; }
X                }
X            }
X            if(match)
X            {   b += flaw(ci);
X                adrt = ad(b + tz);
X                goto finish;
X            }
X        }      /* increment search pointers, backward and forward */
X        if(db) { b--; b = ad(b); } if(df) { f++; f = ad(f); } l++;
X        if(l > Search_limit)
X        {   adrt = -1;
X            goto finish;
X        }
X    }
X    finish:
X    if(1 && WatchTem) tgl = (sl + ce->d.gli.si)->g + ce->d.gli.gi;
X    if(1 && WatchTem && adrt >= 0 && !ce->d.flaw && !ce->d.mut &&
X        ce->mm.p <= ce->c.ip && ce->c.ip < (ce->mm.p + ce->mm.s) &&
X        IsBit(tgl->bits,0))
X        GenExTemp(ad(adrt - tz), ci, tz);
X    return adrt; /* address of instruction following target template */
X}
END_OF_FILE
if test 22306 -ne `wc -c <'instruct.c'`; then
    echo shar: \"'instruct.c'\" unpacked with wrong size!
fi
# end of 'instruct.c'
fi
if test -f 'tsetup.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tsetup.c'\"
else
echo shar: Extracting \"'tsetup.c'\" \(28501 characters\)
sed "s/^X//" >'tsetup.c' <<'END_OF_FILE'
X/* tsetup.c  19-8-91  Artificial Life simulator  setup routines */
X/** Tierra Simulator V3.0: Copyright (c) 1991 Thomas S. Ray **/
X
X#include "license.h"
X
X#ifndef lint
Xstatic char     sccsid[] = "@(#)tsetup.c	2.15 10/6/91";
X#endif
X
X#include "tierra.h"
X#include "extern.h"
X
XI8s GetAVar(data)
X    I8s  data[85];
X{
X    if(!strncmp(data,"alive",5))
X    {   sscanf(data,"alive = %ld", &alive); return 1; }
X    if(!strncmp(data,"BrkupSiz",8))
X    {   sscanf(data,"BrkupSiz = %ld", &BrkupSiz); return 1; }
X    if(!strncmp(data,"CellsSize",9))
X    {   sscanf(data,"CellsSize = %ld", &CellsSize); return 1; }
X    if(!strncmp(data,"debug",5))
X    {   sscanf(data,"debug = %ld", &debug); return 1; }
X    if(!strncmp(data,"DiskOut",7))
X    {   sscanf(data,"DiskOut = %ld", &DiskOut); return 1; }
X    if(!strncmp(data,"DistFreq",8))
X    {   sscanf(data,"DistFreq = %f", &DistFreq); return 1; }
X    if(!strncmp(data,"DistProp",8))
X    {   sscanf(data,"DistProp = %f", &DistProp); return 1; }
X    if(!strncmp(data,"DivSameSiz",10))
X    {   sscanf(data,"DivSameSiz = %ld", &DivSameSiz); return 1; }
X    if(!strncmp(data,"DivSameGen",10))
X    {   sscanf(data,"DivSameGen = %ld", &DivSameGen); return 1; }
X    if(!strncmp(data,"DropDead",8))
X    {   sscanf(data,"DropDead = %ld", &DropDead); return 1; }
X    if(!strncmp(data,"GeneBnker",9))
X    {   sscanf(data,"GeneBnker = %ld", &GeneBnker); return 1; }
X    if(!strncmp(data,"GenebankPath",12))
X    {   sscanf(data,"GenebankPath = %s", GenebankPath); return 1; }
X    if(!strncmp(data,"GenPerBkgMut",12))
X    {   sscanf(data,"GenPerBkgMut = %f", &GenPerBkgMut); return 1; }
X    if(!strncmp(data,"GenPerFlaw",10))
X    {   sscanf(data,"GenPerFlaw = %f", &GenPerFlaw); return 1; }
X    if(!strncmp(data,"GenPerMovMut",12))
X    {   sscanf(data,"GenPerMovMut = %f", &GenPerMovMut); return 1; }
X    if(!strncmp(data,"hangup",6))
X    {   sscanf(data,"hangup = %ld", &hangup); return 1; }
X    if(!strncmp(data,"MaxFreeBlocks",13))
X    {   sscanf(data,"MaxFreeBlocks = %ld", &MaxFreeBlocks); return 1; }
X    if(!strncmp(data,"MaxMalMult",10))
X    {   sscanf(data,"MaxMalMult = %f", &MaxMalMult); return 1; }
X    if(!strncmp(data,"MinCellSize",11))
X    {   sscanf(data,"MinCellSize = %ld", &MinCellSize); return 1; }
X    if(!strncmp(data,"MinTemplSize ",12))
X    {   sscanf(data,"MinTemplSize = %ld", &MinTemplSize); return 1; }
X    if(!strncmp(data,"MovPropThrDiv",13))
X    {   sscanf(data,"MovPropThrDiv = %f", &MovPropThrDiv); return 1; }
X    if(!strncmp(data,"new_soup",8))
X    {   sscanf(data,"new_soup = %ld", &new_soup); return 1; }
X    if(!strncmp(data,"NumCells",8))
X    {   sscanf(data,"NumCells = %ld", &NumCells); return 1; }
X    if(!strncmp(data,"OutPath",7))
X    {   sscanf(data,"OutPath = %s", OutPath); return 1; }
X    if(!strncmp(data,"PhotonPow",9))
X    {   sscanf(data,"PhotonPow = %f", &PhotonPow); return 1; }
X    if(!strncmp(data,"PhotonWidth",11))
X    {   sscanf(data,"PhotonWidth = %ld", &PhotonWidth); return 1; }
X    if(!strncmp(data,"PhotonWord",10))
X    {   sscanf(data,"PhotonWord = %s", PhotonWord); return 1; }
X    if(!strncmp(data,"RamBankSiz",10))
X    {   sscanf(data,"RamBankSiz = %ld", &RamBankSiz); return 1; }
X    if(!strncmp(data,"SaveFreq",8))
X    {   sscanf(data,"SaveFreq = %ld", &SaveFreq); return 1; }
X    if(!strncmp(data,"SavThrMem",9))
X    {   sscanf(data,"SavThrMem = %f", &SavThrMem); return 1; }
X    if(!strncmp(data,"SavThrPop",9))
X    {   sscanf(data,"SavThrPop = %f", &SavThrPop); return 1; }
X    if(!strncmp(data,"SearchLimit",11))
X    {   sscanf(data,"SearchLimit = %f", &SearchLimit); return 1; }
X    if(!strncmp(data,"seed",4))
X    {   sscanf(data,"seed = %ld", &seed); return 1; }
X    if(!strncmp(data,"SizDepSlice",11))
X    {   sscanf(data,"SizDepSlice = %ld", &SizDepSlice); return 1; }
X    if(!strncmp(data,"SlicePow",8))
X    {   sscanf(data,"SlicePow = %lf", &SlicePow); return 1; }
X    if(!strncmp(data,"SliceSize",9))
X    {   sscanf(data,"SliceSize = %ld", &SliceSize); return 1; }
X    if(!strncmp(data,"SliceStyle",10))
X    {   sscanf(data,"SliceStyle = %ld", &SliceStyle); return 1; }
X    if(!strncmp(data,"SlicFixFrac",11))
X    {   sscanf(data,"SlicFixFrac = %f", &SlicFixFrac); return 1; }
X    if(!strncmp(data,"SlicRanFrac",11))
X    {   sscanf(data,"SlicRanFrac = %f", &SlicRanFrac); return 1; }
X    if(!strncmp(data,"SoupSize",8))
X    {   sscanf(data,"SoupSize = %ld", &SoupSize); return 1; }
X    if(!strncmp(data,"WatchExe",8))
X    {   sscanf(data,"WatchExe = %ld", &WatchExe); return 1; }
X    if(!strncmp(data,"WatchMov",8))
X    {   sscanf(data,"WatchMov = %ld", &WatchMov); return 1; }
X    if(!strncmp(data,"WatchTem",8))
X    {   sscanf(data,"WatchTem = %ld", &WatchTem); return 1; }
X    return 0;
X}
X
Xvoid GetSoup()
X{   FILE  *inf;
X    I8s   data[85];
X    I32s  i;
X
X    sprintf(mes[0],"Using instruction set (INST) = %d",INST);
X    FEMessage(1);
X
X#ifdef __TURBOC__
X    timezone = (I32s) 5L * 60L * 60L;
X#endif
X    inf = fopen(soup_fn,"r");
X    if(inf == NULL)
X    {   sprintf(mes[0],"GetSoup: file %s not opened, exiting", soup_fn);
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        exit(0);
X    }
X    fgets(data,84,inf); sscanf(data,"tierra core:"); /* file header line */
X    fgets(data,84,inf);                              /* blank line */
X    fgets(data,84,inf);
X    while(strlen(data) > 3)
X    {   if(!GetAVar(data))
X        {   sprintf(mes[0],"bad soup_in line: %s", data);
X            FEMessage(1);
X        }
X        fgets(data,84,inf);
X    }
X    if(new_soup)
X    {   GenInList = (I8s **) thcalloc((I32u) NumCells, (I32u) sizeof(I8s  *));
X        GenInBuf = (I8s  *) thcalloc((I32u) NumCells * 13,(I32u) sizeof(I8s));
X        for(i = 0; i < NumCells; i++)
X        {   fgets(data,84,inf);
X            GenInList[i] = GenInBuf + (i * 13);
X            sscanf(data,"%s", GenInList[i]);
X        }
X    }
X    FEStartup(); /* still a dummy function */
X
X        /* allocate arrays */
X    if(NumCells > CellsSize - 2) CellsSize = NumCells + 22L;
X    sprintf(mes[0],"sizeof(Instruction)   = %ld", (I32s) sizeof(Instruction));
X    sprintf(mes[1],"sizeof(struct cell)   = %ld", (I32s) sizeof(struct cell));
X    sprintf(mes[2],"sizeof(struct mem_fr) = %ld",(I32s)sizeof(struct mem_fr));
X    FEMessage(3);
X#ifdef __TURBOC__
X    sprintf(mes[0],"coreleft = %lu", (I32u) coreleft());
X    FEMessage(1);
X#endif
X    soup = (HpInst) thcalloc((I32u ) SoupSize, (I32u) sizeof(Instruction));
X    sprintf(mes[0],"    %ld bytes allocated for soup",
X        SoupSize * sizeof(Instruction));
X    cells = (Pcells) thcalloc((I32u ) CellsSize, (I32u) sizeof(struct cell));
X    sprintf(mes[1],"    %ld bytes allocated for cells",
X        CellsSize * sizeof(struct cell));
X    FreeMem = (struct mem_fr Hp)
X        thcalloc((I32u ) MaxFreeBlocks, (I32u) sizeof(struct mem_fr));
X    sprintf(mes[2],"    %ld bytes allocated for mem_fr",
X        MaxFreeBlocks * sizeof(struct mem_fr));
X    FEMessage(3);
X#ifdef __TURBOC__
X    sprintf(mes[0],"coreleft = %lu  tsetup (soup, cells, FreeMem)",
X        (I32u) coreleft());
X    FEMessage(1);
X#endif
X    if(!soup || !cells || !FreeMem)
X    {   sprintf(mes[0],"Tierra setup malloc error, exiting");
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        exit(0);
X    }
X    else
X    {   sprintf(mes[0],"tsetup: arrays allocated without error");
X        FEMessage(1);
X    }
X#ifdef unix
X    SLASH = 47;
X#endif
X#if __TURBOC__ || OS2_MC
X    SLASH = 92;
X#endif
X    TotFlaw = TotMovMut = TotMut = extr = isolate = fragment = 0;
X    Disturb.m = Disturb.i = DistNext.m = DistNext.i = 0L;
X    if(DivSameGen) DivSameSiz = 1;
X    ONE = 1;
X    if(GeneBnker) GetGenFileList();
X    else WatchExe = WatchMov = WatchTem = 0;
X    if(new_soup) GetNewSoup();
X    else GetOldSoup(inf);
X    if(GeneBnker) StupGenLists();
X    sprintf(mes[0],"tsetup: soup gotten");
X    FEMessage(1);
X    if(SliceStyle == 1)
X    {   PhotonSize = (I32s) strlen(PhotonWord);
X        PhotonTranslate(PhotonInst,PhotonWord);
X        slicer = SlicerPhoton;
X    }
X    else if(SliceStyle == 0) slicer = SlicerQueue;
X    else if(SliceStyle == 2) slicer = RanSlicerQueue;
X    if(new_soup)
X    {   thfree(GenInList); thfree(GenInBuf); }
X    fclose(inf);
X}
X
Xvoid StupGenLists()
X{   I32s  i, j, onum, newgen;
X    Pcells  ce;
X    I8s     gfile[80];
X    FILE    *afp;
X    head_t  head;
X    indx_t  *indx;
X    Pgl     tgl, tglt;
X    Psl     tsl;
X    struct gl_index  glia, glib;
X
X    for(i = 2; i < CellsSize; i++)
X    {   ce = cells + i;
X        if(ce->ld)
X        {   newgen = 0;
X            IsNewSize(i,&ce->d.gli);
X            tsl = sl + ce->d.gli.si;
X            ce->d.gli.gi = Lbl2Int(ce->d.gen.label);
X            if(ce->d.gli.gi >= tsl->a_num)
X            {   onum = tsl->a_num;
X                tsl->a_num = ce->d.gli.gi + 4;
X                tsl->g = (Pgl) threalloc((I8s Hp) tsl->g,
X                    sizeof(struct g_list) * tsl->a_num);
X                for(j = onum; j < tsl->a_num; j++)
X                    InitGList(tsl->g + j, ce->d.gli.si, j, tsl->size);
X            }
X            tgl = tsl->g + ce->d.gli.gi;
X            if(strcmp(ce->d.gen.label,tgl->gen.label) || tgl->genome == NULL)
X                /* if new genotype */
X            {   /* read genotype from disk and put in rambank at tgl */
X                if(strcmp(ce->d.gen.label,tgl->gen.label))
X                {   tsl->num++; newgen = 1; }
X                if (IsBit(tgl->bits,0))
X#ifdef IBM3090
X                    sprintf(gfile,"%04ld.gen.d", tsl->size);
X                else
X                    sprintf(gfile,"%04ld.tmp.d", tsl->size);
X#else
X                    sprintf(gfile,"%s%04ld.gen", GenebankPath, tsl->size);
X                else
X                    sprintf(gfile,"%s%04ld.tmp", GenebankPath, tsl->size);
X#endif
X                if (!(afp = fopen(gfile,"rb")))
X                {   fprintf(stderr,"file %s not opened\n", gfile);
X                    exit(9);
X                }
X                head = read_head(afp);
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                if ((j = find_gen(indx,ce->d.gen.label,head.n)) == head.n)
X                    fprintf(stderr,"%s not in archive\n", ce->d.gen.label);
X                else
X                {   glia = tgl->a; glib = tgl->b;
X                    tglt = get_gen(afp, &head, &indx[j], j);
X                    *tgl = *tglt;
X                    thfree(tglt);
X                    tgl->a = glia; tgl->b = glib;
X                }
X                if(newgen)
X                    AddTopGenQueue(&ce->d.gli);
X                thfree(indx);
X                fclose(afp);
X            }
X            tgl->pop++;
X        }
X    }
X    for(i = 0; i < siz_sl; i++)
X    {   tsl = sl + i;
X        for(j = 0; j < tsl->a_num; j++)
X        {   tgl = tsl->g + j;
X            if(!strcmp(tgl->gen.label,"---"))
X                Int2Lbl(j,tgl->gen.label);
X        }
X    }
X}
X
Xvoid GetNewSoup()
X{   I32s    i, k, ci, cs, spaces = 0;
X    Ind     l;
X    HpInst  si;
X    Pcells  ce;
X
X    sprintf(mes[0],"beginning of GetNewSoup");
X    FEMessage(1);
X    if(!seed) seed = (I32s) time(NULL);
X    tsrand(seed);
X    sprintf(mes[0],"seed = %ld", seed);
X    FEMessage(1);
X    reaped = InstExe.i = InstExe.m = ExtractCount = CountMovMut =
X        CountMutRate = CountFlaw = RateMovMut = RateMut = RateFlaw = 0L;
X    FreeBlocks = FirstOutDisk = 1L;
X    Generations = 0.;
X    FreeMemCurrent = SoupSize;
X    /* initialize soup array */
X    for(l = 0; l < SoupSize; l++)
X    {   for (k = 0; k < PLOIDY; k++)
X        {   soup[l][k].inst = 0;
X            soup[l][k].read = 0;
X            soup[l][k].write = 0;
X            soup[l][k].exec = 0;
X        }
X    }
X    sprintf(mes[0],"init of soup complete");
X    FEMessage(1);
X        /* initialize FreeMem array */
X    SoupBot = 0; SoupTop = 1;
X    FreeMem->p = 0; FreeMem->s = 0;
X    FreeMem->n = 2; FreeMem->o = (I8s ) 1;
X    (FreeMem + 1)->p = SoupSize; (FreeMem + 1)->s = (I32s) 0;
X    (FreeMem + 1)->n = 1; (FreeMem + 1)->o = (I8s ) 1;
X    (FreeMem + 2)->p = 0; (FreeMem + 2)->s = SoupSize;
X    (FreeMem + 2)->n = 1; (FreeMem + 2)->o = (I8s ) 1;
X    for(i = 3; i < MaxFreeBlocks; i++)
X    {   (FreeMem + i)->p = 0;
X        (FreeMem + i)->n = 0;
X        (FreeMem + i)->s = 0;
X        (FreeMem + i)->o = (I8s ) 0;
X    }
X        /* initialize cells array */
X    for(i = 0; i < CellsSize; i++) InitCell(i);
X    cells->ld = (cells + 1)->ld = 1;
X    si = soup; ce = cells + 2; ci = 2;
X    ThisSlice = BottomReap = TopReap = 2;
X
X    /* read in the cell genotypes */
X    for (i = 0; i < NumCells; i++)
X    {   if (!strncmp("space", GenInList[i], 5))
X        {   sscanf(GenInList[i], "%*s%ld", &cs);
X            sprintf(mes[0],"skipping %ld instructions", cs);
X            FEMessage(1);
X            spaces++;
X        }
X        else
X        {   sscanf(GenInList[i], "%4ld", &cs);
X            sprintf(mes[0],
X               "GetNewSoup: about to read %ld instructions of cell %ld",cs,i);
X            FEMessage(1);
X            ReadACreature(GenInList[i], ce, ci, si);
X            ce++; ci++;
X        }
X           si += cs;
X    }
X    NumCells -= spaces;
X    plan();
X}
X
Xvoid ReadACreature(crit, ce, ci, si)
X    I8s     *crit;
X    I32s    ci;
X    Pcells  ce;
X    HpInst  si;
X{
X    I32s    cs, j, k;
X    Pgl  g;
X    char cpath[256], gen[4];
X    FILE *fp;
X    head_t head;
X    indx_t *indx;
X    short n;
X
X    sscanf(crit, "%4ld%3s", &cs, gen);
X    sprintf(cpath, "%s%04ld.gen", GenebankPath, cs);
X    if (!(fp = open_ar(cpath, cs, INST, 0)))
X    {   perror("ReadACreature");
X        exit(7);
X    }
X    head = read_head(fp);
X    indx = read_indx(fp, &head);
X    n = find_gen(indx, gen, head.n);
X    g = get_gen(fp, &head, &indx[n], n);
X    fclose(fp);
X    thfree(indx);
X    ce->c.ip = ce->mm.p = MemAlloc(&cs);
X    ce->d.gen.size = ce->mm.s = cs;
X    ce->d.gen = g->gen;
X    ce->d.parent = g->parent;
X    ce->ld = 1;
X    if (ci == 2)
X    {   ce->q.p_reap = 0;
X        ce->q.n_reap = 1;
X        cells->q.n_reap = 2;
X        (cells + 1)->q.p_reap = 2;
X    }
X    else {
X	EntBotSlicer(ci);
X	EntBotReaper(ci);
X    }
X    OutDisk('b',ce);
X    for (j = 0; j < cs; j++)
X    {   for (k = 0; k < PLOIDY; k++)
X        {   si[0][k] = g->genome[j][k];
X        }
X        si++;
X    }
X    if(g->comments) thfree(g->comments);
X    if(g->genome) thfree(g->genome);
X    thfree(g);
X}
X
Xvoid GetOldSoup(inf)
X    FILE  *inf;
X{
X    I8s   data[85];
X    FILE  *inc;
X
X    fgets(data,84,inf); sscanf(data,"AverageSize = %ld", &AverageSize);
X    fgets(data,84,inf); sscanf(data,"BottomReap = %ld", &BottomReap);
X    fgets(data,84,inf); sscanf(data,"BrkupCou = %ld", &BrkupCou);
X    fgets(data,84,inf); sscanf(data,"BrkupCum = %ld", &BrkupCum);
X    fgets(data,84,inf); sscanf(data,"comsoc = %ld", &comsoc);
X    fgets(data,84,inf); sscanf(data,"CountFlaw = %ld", &CountFlaw);
X    fgets(data,84,inf); sscanf(data,"CountMovMut = %ld", &CountMovMut);
X    fgets(data,84,inf); sscanf(data,"CountMutRate = %ld", &CountMutRate);
X    fgets(data,84,inf); sscanf(data,"debug_switch = %ld", &debug_switch);
X    fgets(data,84,inf); sscanf(data,"DistNext.m = %ld\n", &DistNext.m);
X    fgets(data,84,inf); sscanf(data,"DistNext.i = %ld\n", &DistNext.i);
X    fgets(data,84,inf); sscanf(data,"Disturb.m = %ld\n", &Disturb.m);
X    fgets(data,84,inf); sscanf(data,"Disturb.i = %ld\n", &Disturb.i);
X    fgets(data,84,inf); sscanf(data,"extr = %ld", &extr);
X    fgets(data,84,inf); sscanf(data,"ExtractCount = %ld", &ExtractCount);
X    fgets(data,84,inf); sscanf(data,"FirstOutDisk = %ld", &FirstOutDisk);
X    fgets(data,84,inf); sscanf(data,"fragment = %ld", &fragment);
X    fgets(data,84,inf); sscanf(data,"FreeBlocks = %ld", &FreeBlocks);
X    fgets(data,84,inf); sscanf(data,"FreeMemCurrent = %ld",&FreeMemCurrent);
X    fgets(data,84,inf); sscanf(data,"Generations = %lf",&Generations);
X    fgets(data,84,inf); sscanf(data,"InstExe.i = %ld", &InstExe.i);
X    fgets(data,84,inf); sscanf(data,"InstExe.m = %ld", &InstExe.m);
X    fgets(data,84,inf); sscanf(data,"isolate = %ld", &isolate);
X    fgets(data,84,inf); sscanf(data,"LastDiv.i = %ld", &LastDiv.i);
X    fgets(data,84,inf); sscanf(data,"LastDiv.m = %ld", &LastDiv.m);
X    fgets(data,84,inf); sscanf(data,"RandIx1 = %ld", &RandIx1);
X    fgets(data,84,inf); sscanf(data,"RandIx2 = %ld", &RandIx2);
X    fgets(data,84,inf); sscanf(data,"RandIx3 = %ld", &RandIx3);
X    fgets(data,84,inf); sscanf(data,"RateFlaw = %ld", &RateFlaw);
X    fgets(data,84,inf); sscanf(data,"RateMovMut = %ld", &RateMovMut);
X    fgets(data,84,inf); sscanf(data,"RateMut = %ld", &RateMut);
X    fgets(data,84,inf); sscanf(data,"reaped = %ld", &reaped);
X    fgets(data,84,inf); sscanf(data,"runflag = %ld", &runflag);
X    fgets(data,84,inf); sscanf(data,"Search_limit = %ld", &Search_limit);
X    fgets(data,84,inf); sscanf(data,"SoupBot = %ld", &SoupBot);
X    fgets(data,84,inf); sscanf(data,"SoupTop = %ld", &SoupTop);
X    fgets(data,84,inf); sscanf(data,"ThisSlice = %ld", &ThisSlice);
X    fgets(data,84,inf); sscanf(data,"TimeBirth = %ld", &TimeBirth);
X    fgets(data,84,inf); sscanf(data,"TimeDeath = %ld", &TimeDeath);
X    fgets(data,84,inf); sscanf(data,"TimePop = %lf", &TimePop);
X    fgets(data,84,inf); sscanf(data,"TopReap = %ld", &TopReap);
X    fgets(data,84,inf); sscanf(data,"TotFlaw = %ld", &TotFlaw);
X    fgets(data,84,inf); sscanf(data,"TotMovMut = %ld", &TotMovMut);
X    fgets(data,84,inf); sscanf(data,"TotMut = %ld", &TotMut);
X#ifdef IBM3090
X    strcpy(data,"core_out.io.d");
X#else
X    strcpy(data,"core_out");
X#endif
X    inc = fopen(data,"rb");
X    if (inc == NULL)
X    {   sprintf(mes[0],"GetOldSoup 1: file %s not opened, exiting", data);
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        exit(0);
X    }
X    if (DiskOut) fread(&lo, sizeof(struct LastOut), 1, inc);
X    fread(&is, sizeof(struct inst), 1, inc);
X    fread(TrandArray, sizeof(double), 98, inc);
X    tfread((I8s Hp)FreeMem,(I32s)sizeof(struct mem_fr),MaxFreeBlocks,inc);
X    tfread((I8s Hp) soup, (I32s) sizeof(Instruction), SoupSize, inc);
X    tfread((I8s Hp) cells, (I32s) sizeof(struct cell), CellsSize, inc);
X    fclose(inc);
X    if (DiskOut) {
X#ifdef IBM3090
X        if(BrkupSiz) sprintf(data,"break.%ld.d", BrkupCou);
X        else sprintf(data,"tierra.run");
X#else
X        if(BrkupSiz) sprintf(data,"%sbreak.%ld", OutPath, BrkupCou);
X        else sprintf(data,"%stierra.run", OutPath);
X#endif
X        oufr = fopen(data,"a");
X        if(oufr == NULL)
X        {   sprintf(mes[0],"GetOldSoup 2: file %s not opened, exiting");
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            exit(0);
X        }
X    }
X}
X
Xvoid WriteSoup(close_disk)
X    I8s  close_disk;
X{
X    FILE    *ouf;
X    I32s    i, j, TNumGen = 0, TNumSiz = 0;
X    long int  tp;
X    I8s     comd[120], path[99], tpath[99];
X    Psl     tsl;
X    Pgl     tgl;
X    struct SizList  *tgi;
X
X    FILE *fp, *tf;
X    head_t head, thead;
X    indx_t *indx, *tindx;
X    
X    if (DiskOut && close_disk) fclose(oufr);
X    if (GeneBnker) {
X	tgi = (struct SizList  *) thcalloc(NumSizl, sizeof(struct SizList));
X        for (i=0; i < NumSizl; i++) { /* make list of sizes, record their */
X            tsl = sl + i;              /* position in the size list. */
X            (tgi + i)->size = tsl->size;
X            (tgi + i)->pos = i; /* records the position in the size list */
X            if (tsl->num_s) (tgi + i)->dir = 1;
X            for (j = 0; j < tsl->a_num; j++) {
X		tgl = tsl->g + j;
X                if (tgl->pop || IsBit(tgl->bits,0)) (tgi + i)->ext++;
X            }
X            if ((tgi + i)->ext) TNumSiz++;
X            TNumGen += (tgi + i)->ext;
X        }                            /* then sort the list by size */
X        qsort((void *) tgi, NumSizl, sizeof(struct SizList), slcmp);
X
X        for (i = 0; i < NumSizl; i++) {
X	    tsl = sl + (tgi + i)->pos;  /* position in sl of the ith size */
X            if ((tgi + i)->ext) {
X		sprintf(path,"%s%04ld.gen", GenebankPath, tsl->size);
X		sprintf(tpath,"%s%04ld.tmp", GenebankPath, tsl->size);
X		fp = open_ar(path, tsl->size, INST, !(tgi + i)->dir);
X		tf = open_ar(tpath, tsl->size, INST, 1);
X		head = read_head(fp);
X		thead = read_head(tf);
X		indx = read_indx(fp, &head);
X		tindx = read_indx(tf, &thead);
X		for (j=0; j<tsl->a_num; j++) {
X		    /* for each genotype of this size */
X		    tgl = tsl->g + j;
X		    if (IsBit(tgl->bits,0) || tgl->pop) {
X			/* if this genotype has been saved to disk */
X			/* or has a residual population */
X			SetBit(&tgl->bits, 1, 1);
X			if (IsBit(tgl->bits,0))
X			    add_gen(fp, &head, &indx, tgl);
X			else add_gen(tf, &thead, &tindx, tgl);
X		    }
X		}
X		fclose(fp);
X		fclose(tf);
X		if (!head.n) unlink(path);
X		if (!thead.n) unlink(tpath);
X		thfree(indx);
X		thfree(tindx);
X            }
X        }
X        thfree(tgi);
X    }
X    new_soup = 0;
X    if(alive <= InstExe.m) alive = InstExe.m + 5;
X#ifdef IBM3090
X        sprintf(comd,"soup_out.io.d");
X#else
X        sprintf(comd,"soup_out");
X#endif
X    ouf = fopen(comd,"w");
X    if(ouf == NULL)
X    {   sprintf(mes[0],"WriteSoup 2: file %s not opened, exiting", comd);
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        exit(0);
X    }
X    fprintf(ouf,"tierra core:  %s\n", ctime(&tp));
X    fprintf(ouf,"alive = %ld\n", alive);
X    fprintf(ouf,"BrkupSiz = %ld\n", BrkupSiz);
X    fprintf(ouf,"CellsSize = %ld\n", CellsSize);
X    fprintf(ouf,"debug = %ld\n", debug);
X    fprintf(ouf,"DiskOut = %ld\n", DiskOut);
X    fprintf(ouf,"DistFreq = %f\n", DistFreq);
X    fprintf(ouf,"DistProp = %f\n", DistProp);
X    fprintf(ouf,"DivSameSiz = %ld\n", DivSameSiz);
X    fprintf(ouf,"DivSameGen = %ld\n", DivSameGen);
X    fprintf(ouf,"DropDead = %ld\n", DropDead);
X    fprintf(ouf,"GeneBnker = %ld\n", GeneBnker);
X    fprintf(ouf,"GenebankPath = %s\n", GenebankPath);
X    fprintf(ouf,"GenPerBkgMut = %f\n", GenPerBkgMut);
X    fprintf(ouf,"GenPerFlaw = %f\n", GenPerFlaw);
X    fprintf(ouf,"GenPerMovMut = %f\n", GenPerMovMut);
X    fprintf(ouf,"hangup = %ld\n", hangup);
X    fprintf(ouf,"MaxFreeBlocks = %ld\n", MaxFreeBlocks);
X    fprintf(ouf,"MaxMalMult = %g\n", MaxMalMult);
X    fprintf(ouf,"MinCellSize = %ld\n", MinCellSize);
X    fprintf(ouf,"MinTemplSize = %ld\n", MinTemplSize);
X    fprintf(ouf,"MovPropThrDiv = %g\n", MovPropThrDiv);
X    fprintf(ouf,"new_soup = %ld\n", new_soup);
X    fprintf(ouf,"NumCells = %ld\n", NumCells);
X    fprintf(ouf,"OutPath = %s\n", OutPath);
X    fprintf(ouf,"PhotonPow = %g\n", PhotonPow);
X    fprintf(ouf,"PhotonWidth = %ld\n", PhotonWidth);
X    fprintf(ouf,"PhotonWord = %s\n", PhotonWord);
X    fprintf(ouf,"RamBankSiz = %ld\n", RamBankSiz);
X    fprintf(ouf,"SaveFreq = %ld\n", SaveFreq);
X    fprintf(ouf,"SavThrMem = %g\n", SavThrMem);
X    fprintf(ouf,"SavThrPop = %g\n", SavThrPop);
X    fprintf(ouf,"SearchLimit = %g\n", SearchLimit);
X    fprintf(ouf,"seed = %ld\n", seed);
X    fprintf(ouf,"SizDepSlice = %ld\n", SizDepSlice);
X    fprintf(ouf,"SlicePow = %g\n", SlicePow);
X    fprintf(ouf,"SliceSize = %ld\n", SliceSize);
X    fprintf(ouf,"SliceStyle = %ld\n", SliceStyle);
X    fprintf(ouf,"SlicFixFrac = %g\n", SlicFixFrac);
X    fprintf(ouf,"SlicRanFrac = %g\n", SlicRanFrac);
X    fprintf(ouf,"SoupSize = %ld\n", SoupSize);
X    fprintf(ouf,"WatchExe = %ld\n", WatchExe);
X    fprintf(ouf,"WatchMov = %ld\n", WatchMov);
X    fprintf(ouf,"WatchTem = %ld\n", WatchTem);
X    fprintf(ouf,"\n");
X    /* end soup_in variables */
X    fprintf(ouf,"AverageSize = %ld\n", AverageSize);
X    fprintf(ouf,"BottomReap = %ld\n", BottomReap);
X    fprintf(ouf,"BrkupCou = %ld\n", BrkupCou);
X    fprintf(ouf,"BrkupCum = %ld\n", BrkupCum);
X    fprintf(ouf,"comsoc = %ld\n", comsoc);
X    fprintf(ouf,"CountFlaw = %ld\n", CountFlaw);
X    fprintf(ouf,"CountMovMut = %ld\n", CountMovMut);
X    fprintf(ouf,"CountMutRate = %ld\n", CountMutRate);
X    fprintf(ouf,"debug_switch = %ld\n", debug_switch);
X    fprintf(ouf,"DistNext.m = %ld\n", DistNext.m);
X    fprintf(ouf,"DistNext.i = %ld\n", DistNext.i);
X    fprintf(ouf,"Disturb.m = %ld\n", Disturb.m);
X    fprintf(ouf,"Disturb.i = %ld\n", Disturb.i);
X    fprintf(ouf,"extr = %ld\n", extr);
X    fprintf(ouf,"ExtractCount = %ld\n", ExtractCount);
X    fprintf(ouf,"FirstOutDisk = %ld\n", FirstOutDisk);
X    fprintf(ouf,"fragment = %ld\n", fragment);
X    fprintf(ouf,"FreeBlocks = %ld\n", FreeBlocks);
X    fprintf(ouf,"FreeMemCurrent = %ld\n", FreeMemCurrent);
X    fprintf(ouf,"Generations = %lf\n", Generations);
X    fprintf(ouf,"InstExe.i = %ld\n", InstExe.i);
X    fprintf(ouf,"InstExe.m = %ld\n", InstExe.m);
X    fprintf(ouf,"isolate = %ld\n", isolate);
X    fprintf(ouf,"LastDiv.i = %ld\n", LastDiv.i);
X    fprintf(ouf,"LastDiv.m = %ld\n", LastDiv.m);
X    fprintf(ouf,"RandIx1 = %ld\n", RandIx1);
X    fprintf(ouf,"RandIx2 = %ld\n", RandIx2);
X    fprintf(ouf,"RandIx3 = %ld\n", RandIx3);
X    fprintf(ouf,"RateFlaw = %ld\n", RateFlaw);
X    fprintf(ouf,"RateMovMut = %ld\n", RateMovMut);
X    fprintf(ouf,"RateMut = %ld\n", RateMut);
X    fprintf(ouf,"reaped = %ld\n", reaped);
X    fprintf(ouf,"runflag = %ld\n", runflag);
X    fprintf(ouf,"Search_limit = %ld\n", Search_limit);
X    fprintf(ouf,"SoupBot = %ld\n", SoupBot);
X    fprintf(ouf,"SoupTop = %ld\n", SoupTop);
X    fprintf(ouf,"ThisSlice = %ld\n", ThisSlice);
X    fprintf(ouf,"TimeBirth = %ld\n", TimeBirth);
X    fprintf(ouf,"TimeDeath = %ld\n", TimeDeath);
X    fprintf(ouf,"TimePop = %lf\n", TimePop);
X    fprintf(ouf,"TopReap = %ld\n", TopReap);
X    fprintf(ouf,"TotFlaw = %ld\n", TotFlaw);
X    fprintf(ouf,"TotMovMut = %ld\n", TotMovMut);
X    fprintf(ouf,"TotMut = %ld\n", TotMut);
X    fclose(ouf);
X#ifdef IBM3090
X    strcpy(comd,"core_out.io.d");
X#else
X    strcpy(comd,"core_out");
X#endif
X    ouf = fopen(comd,"wb");
X    if (ouf == NULL)
X    {   sprintf(mes[0],"WriteSoup 3: file %s not opened, exiting", comd);
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        exit(0);
X    }
X    if (DiskOut) fwrite(&lo, sizeof(struct LastOut), 1, ouf);
X    fwrite(&is, sizeof(struct inst), 1, ouf);
X    fwrite(TrandArray, sizeof(double), 98, ouf);
X    tfwrite((I8s Hp) FreeMem, (I32s) sizeof(struct mem_fr),
X        MaxFreeBlocks, ouf);
X    tfwrite((I8s Hp) soup, (I32s) sizeof(Instruction), SoupSize, ouf);
X    tfwrite((I8s Hp) cells, (I32s) sizeof(struct cell), CellsSize, ouf);
X    fclose(ouf);
X}
X
XI16s glcmp(gl1, gl2)
X    const void  *gl1, *gl2;
X{   Pgl  g1 = gl1, g2 = gl2;
X
X    return strcmp(g1->gen.label, g2->gen.label);
X}
X
XI16s slcmp(sl1, sl2)
X    const void  *sl1, *sl2;
X{   struct SizList  *s1 = sl1, *s2 = sl2;
X
X    if (s1->size == s2->size) return 0;
X    if (s1->size <  s2->size) return -1;
X    if (s1->size >  s2->size) return 1;
X    return 0;
X}
X
Xvoid InitCell(ci)
X    I32s  ci;
X{
X    I16s  i;
X    Pcells  ce = cells + ci;
X
X    ce->d.gen.size = 0L;
X    ce->d.gen.label[0] = ce->d.gen.label[1] = ce->d.gen.label[2] = 45;
X    ce->d.gen.label[3] = 0; /* "---" */
X    ce->d.fecundity = ce->d.flags = ce->d.mov_daught = ce->d.inst =
X    ce->d.mut = ce->d.flaw = 0L;
X    ce->d.d1.inst = ce->d.d1.flags = ce->d.d1.mov_daught = 0L;
X    ce->d.d1.BreedTrue = (I8s) 0;
X    ce->d.parent.size = 0L;
X    ce->d.parent.label[0] = ce->d.parent.label[1] = ce->d.parent.label[2] =45;
X    ce->d.parent.label[3] = 0; /* "---" */
X    ce->d.gli.si = ce->d.gli.gi = 0L;
X    ce->d.ib = (I16s) 0; /* instruction bank */
X    ce->d.ni = (I32s) -1; /* index to daughter cell */
X    ce->d.is = (I8s) 0; /* cpu is active */
X    ce->d.dm = (I8s) 0; /* daughter or mother */
X    ce->d.ploidy = (I8s) 1; /* how many tracks */
X    ce->q.n_time=ce->q.p_time=ce->q.n_reap=ce->q.p_reap = ci;
X    ce->mm.s = ce->md.s = 0L;
X    ce->mm.p = ce->md.p = (Ind) 0;
X    for (i = 0; i < NUM_REGS; i++) ce->c.re[i] = 0L;
X    ce->c.sp = (I16s) STACK_SIZE - 1;
X    for (i = 0; i < STACK_SIZE; i++) ce->c.st[i] = 0L;
X    ce->c.ip = (Reg) 0;
X    ce->c.fl = ce->c.tr = (I8s) 0;
X    ce->ld = (I8s) 0;
X}
X
END_OF_FILE
if test 28501 -ne `wc -c <'tsetup.c'`; then
    echo shar: \"'tsetup.c'\" unpacked with wrong size!
fi
# end of 'tsetup.c'
fi
echo shar: End of archive 7 \(of 7\).
cp /dev/null ark7isdone
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) 
    echo  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
