/* memalloc.c 14-12-93 memory allocation routines for the Tierra Simulator */
/* Tierra Simulator V4.1: Copyright (c) 1991, 1992, 1993 */
/* Tom Ray & Virtual Life */

#ifndef lint
static char     memalloc_sccsid[] = "@(#)memalloc.c        1.5     7/21/92";
#endif

#include <sys/types.h>
#include "license.h"
#include "tierra.h"
#include "extern.h"

#ifdef ALCOMM
#include "tmonitor.h"
#include "trequest.h"
#include <mlayer.h>
#endif


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

/* check to see if cell has privelage at address */
I8s  IsPriv(ce, a)
Pcells  ce;
I32s  a;
{
#ifdef ERROR
    if(a >= SoupSize || a < 0)
        FEError(-600,EXIT,WRITE,
            "Tierra IsPriv() error: address %ld not in soup", a);
#endif
    if(IsInsideCell(ce, a)) return 1;
    return IsFree(a);
}

I8s IsBitPriv(ce,a,mode) /* return 1 if you have the privelage */
Pcells  ce;
I32s    a; /* address being checked */
I32s    mode; /* modes: 1 bit = execute, 2 bit = write, 4 bit = read */
{   I32s  gmode;

    if(a < 0 || a >= SoupSize)
        return 0;

    if(IsInsideCell(ce,a))
        gmode = MemModeMine;
    else if(IsFree(a))
        gmode = MemModeFree;
    else
        gmode = MemModeProt;

#if PLOIDY == 1
    if( (IsBit(mode,0) && IsBit(gmode,0) ) ||
        (IsBit(mode,1) && IsBit(gmode,1) ) ||
        (IsBit(mode,2) && IsBit(gmode,2) ))
#else /* PLOIDY > 1 */
    if( (IsBit(mode,0) && IsBit(gmode,0) ) ||
        (IsBit(mode,1) && IsBit(gmode,1) ) ||
        (IsBit(mode,2) && IsBit(gmode,2) ))
#endif /* PLOIDY > 1 */
        return 0;

    return 1;
}

I8s PrivExec(ce,a) /* return 1 if you have execute privelage */
Pcells  ce;
I32s    a; /* address being checked */
{   I32s  gmode;

    if(a < 0 || a >= SoupSize)
        return 0;

    if(IsInsideCell(ce,a))
        return !IsBit(MemModeMine,0);
    else if(IsFree(a))
        gmode = MemModeFree;
    else
        gmode = MemModeProt;

#if PLOIDY == 1
    if(IsBit(gmode,0) )
#else /* PLOIDY > 1 */
    if(IsBit(gmode,0) )
#endif /* PLOIDY > 1 */
        return 0;

    return 1;
}

I8s PrivWrite(ce,a) /* return 1 if you have write privelage */
Pcells  ce;
I32s    a; /* address being checked */
{   I32s  gmode;

    if(a < 0 || a >= SoupSize)
        return 0;

    if(IsInsideCell(ce,a))
        return !IsBit(MemModeMine,1);
    else if(IsFree(a))
        gmode = MemModeFree;
    else
        gmode = MemModeProt;

#if PLOIDY == 1
    if(IsBit(gmode,1) )
#else /* PLOIDY > 1 */
    if(IsBit(gmode,1) )
#endif /* PLOIDY > 1 */
        return 0;

    return 1;
}

I8s PrivRead(ce,a) /* return 1 if you have read privelage */
Pcells  ce;
I32s    a; /* address being checked */
{   I32s  gmode, tmp;

    if(a < 0 || a >= SoupSize)
        return 0;

    if(IsInsideCell(ce,a))
    {   tmp = !IsBit(MemModeMine,2);
        return tmp;
    }
    else if(IsFree(a))
        gmode = MemModeFree;
    else
        gmode = MemModeProt;

#if PLOIDY == 1
    if(IsBit(gmode,2) )
#else /* PLOIDY > 1 */
    if(IsBit(gmode,2) )
#endif /* PLOIDY > 1 */
        return 0;

    return 1;
}

/* check to see if address is inside allocated memory cell ce */
I8s  IsInsideCell(ce, a)
Pcells  ce;
I32s  a;
{
#ifdef ERROR
    if(a >= SoupSize || a < 0)
        FEError(-601,EXIT,WRITE,
            "Tierra IsInsideCell() error: address %ld not in soup", a);
#endif
    if((ce->mm.p <= a && a < ce->mm.p + ce->mm.s) ||
       (ce->md.s > 0 &&
       (ce->md.p <= a && a < ce->md.p + ce->md.s)))
        return 1;
    return 0;
}

void  WhichCell(a, ce, md) /* find cell with address a */
I32s        a;    /* note: a must be in a cell!, call IsFree() before */
Pcells Fp  ce;   /* WhichCell() to find out if a is in a cell or not */
I8s        *md;
{   I32s  ar, ci;
    Pcells  te;

    for(ar = 0; ar < NumCelAr; ar++) for(ci = 0; ci < CelArSiz; ci++)
    {   if (ar == 0 && ci < 2)
            continue;
        te = &cells[ar][ci];
        if (te->ld)
        {   if(te->mm.p <= a && (te->mm.p + te->mm.s) > a)
            {   *ce = te; *md = 'm'; return; }
            if(te->md.p <= a && (te->md.p + te->md.s) > a)
            {   *ce = te; *md = 'd'; return; }
        }
    }
    FEError(-601,EXIT,NOWRITE,
        "Tierra WhichCell() error: address %ld not found in a cell", a);
}

/* ----------------------------------------------------------------------- */

I32s mal(ce,sug_addr,sug_size,mode) /* allocate space for a new cell */
    Pcells  ce;
    I32s *sug_addr, /* returns actuall address of block, */
                    /* also suggested address for mal */
         sug_size,  /* size of block to get */
                    /* function returns actual size, or 0 on failure */
         mode;      /* which mode to use, see switch below */
{
    I32s p;
    I32s size, sad;

    if (sug_size <= 0 || sug_size == ce->md.s || 
        sug_size > MaxMalMult * ce->mm.s)
        return 0;
    size = (I32s) sug_size + flaw(ce);
    if (!size)
        return 0;
    if (ce->md.s)
    {
#ifdef ERROR
        if (ce->md.p < 0 || ce->md.p >= SoupSize)
            FEError(-613,EXIT,WRITE, "Tierra mal() error 1");
#endif  /* DAN should check return val */
        MemDealloc(ce->md.p, ce->md.s);
        ce->d.mov_daught = 0;
        ce->md.s = 0;
    }
    switch (mode)
    {   case 0: /* first fit */
        {   while ((p = MemAlloc(size, 0, SoupSize - 1)) < 0)
                reaper(1,0);
            break;
        }
        case 2: /* random preference */
        {   while ((p = MemAlloc(size, sad = tlrand() % (SoupSize - size),
                    MalLimit)) < 0)
                reaper(1,sad);
            break;
        }
        case 3: /* preference for mother's address */
        {   while ((p = MemAlloc(size, ce->mm.p, MalLimit)) < 0)
                reaper(1,ce->mm.p);
            break;
        }
        case 4: /* preference for ax address */
        {   while ((p = MemAlloc(size, sad = mo(ce->c.a->re[0],
                SoupSize - size), MalLimit)) < 0)
                reaper(1,sad);
            break;
        }
        case 5: /* preference for top of stack address */
        {   while ((p = MemAlloc(size, sad = mo(ce->c.a->st[ce->c.a->sp],
                    SoupSize - size), MalLimit)) < 0)
                reaper(1,sad);
            break;
        }
        case 6: /* preference for suggested address (*sug_addr) */
        {   while ((p = MemAlloc(size, sad = mo(*sug_addr, SoupSize - size),
                    MalLimit)) < 0)
                reaper(1,sad);
            break;
        }
        case 1: default: /* better fit */
        {   while ((p = MemAlloc(size, -1, 0)) < 0)
                reaper(1,-1);
        }
    }
#ifdef ERROR
    if (p < 0 || p >= SoupSize)
        FEError(-614,EXIT,WRITE, "Tierra mal() error 2");
#endif
    if (!size)
        return 0;

    /* got a block, pass location (sug_addr) and size back  */

    *(sug_addr) = ce->md.p = ad(p);
    ce->md.s = size;
    ce->c.a->fl = 0;
    DownReperIf(ce);
    return size;
}

/* ----------------------------------------------------------------------- */

