#ifdef RCSID
static char RCSid[] =
"$Header: d:/cvsroot/tads/TADS2/OBJCOMP.C,v 1.3 1999/07/11 00:46:30 MJRoberts Exp $";
#endif

/* 
 *   Copyright (c) 1992, 2002 Michael J. Roberts.  All Rights Reserved.
 *   
 *   Please see the accompanying license file, LICENSE.TXT, for information
 *   on using and copying this software.  
 */
/*
Name
  objcomp.c - object manipulation routines for compiler
Function
  Provides routines used only by the compiler
Notes
  Split off from obj main module to make run-time smaller
Modified
  12/18/92 MJRoberts     - creation
*/

#include "os.h"
#include "std.h"
#include "err.h"
#include "mcm.h"
#include "obj.h"

/*
 *   Set up for emitting code into an object.  No undo information is
 *   kept for this type of operation, as it is presumed that the object is
 *   being compiled rather than being manipulated at run-time.  Any
 *   previous value for the property is deleted, a property header is set
 *   up, and the offset of the next free byte in the object is returned.
 */
uint objemt(mcmcxdef *ctx, objnum objn, prpnum prop, dattyp typ)
{
    objdef *objptr;
    prpdef *p;
    
    objptr = (objdef *)mcmlck(ctx, (mcmon)objn);
    
    ERRBEGIN(ctx->mcmcxgl->mcmcxerr)

    objdelp(ctx, objn, prop, FALSE);   /* delete old property value, if any */
    p = objpfre(objptr);                        /* get top of property area */
    
    if ((char *)p - (char *)objptr + PRPHDRSIZ >=
        mcmobjsiz(ctx, (mcmon)objn))
    {
        ushort newsiz = 64 + ((objfree(objptr) + PRPHDRSIZ) -
                              mcmobjsiz(ctx, (mcmon)objn));
        objptr = objexp(ctx, objn, &newsiz);
        p = objpfre(objptr);                       /* object may have moved */
    }
    
    /* set up property header as much as we can (don't know size yet) */
    prpsetprop(p, prop);
    prptype(p) = typ;
    prpflg(p) = 0;
    objsnp(objptr, objnprop(objptr) + 1);              /* one more property */

    ERRCLEAN(ctx->mcmcxgl->mcmcxerr)
        mcmunlck(ctx, (mcmon)objn);
    ERRENDCLN(ctx->mcmcxgl->mcmcxerr)

    /* dirty the cache object and release the lock before return */
    mcmtch(ctx, objn);
    mcmunlck(ctx, (mcmon)objn);
    return(((uchar *)prpvalp(p)) - ((uchar *)objptr));
}

/* done emitting code into property - finish setting object information */
void objendemt(mcmcxdef *ctx, objnum objn, prpnum prop, uint endofs)
{
    objdef *objptr;
    prpdef *p;
    uint    siz;
    
    objptr = (objdef *)mcmlck(ctx, (mcmon)objn);
    p = objofsp(objptr, objgetp(ctx, objn, prop, (dattyp *)0));
    
    siz = endofs - (((uchar *)prpvalp(p)) - ((uchar *)objptr));
    
    prpsetsize(p, siz);
    objsfree(objptr, objfree(objptr) + siz + PRPHDRSIZ);
    
    /* mark the object as changed, and unlock it */
    mcmtch(ctx, (mcmon)objn);
    mcmunlck(ctx, (mcmon)objn);
}

/* add superclasses to an object */
void objaddsc(mcmcxdef *mctx, int sccnt, objnum objn)
{
    objdef *o;
    ushort  siz;
    
    /* get lock on object */
    o = (objdef *)mcmlck(mctx, objn);
    
    /* make sure there's enough space, adding space if needed */
    if (mcmobjsiz(mctx, (mcmon)objn) - objfree(o) < 2 * sccnt)
    {
        siz = 64 + ((2 * sccnt + objfree(o)) -
                    mcmobjsiz(mctx, (mcmon)objn));
        o = objexp(mctx, objn, &siz);                  /* expand the object */
    }

    /* move properties, if any, above added superclasses */
    if (objnprop(o))
        memmove(objprp(o), ((uchar *)objprp(o)) + 2 * sccnt,
                (size_t)(((uchar *)o) + objfree(o) - (uchar *)objprp(o)));
    
    /* set new free pointer */
    objsfree(o, objfree(o) + 2 * sccnt);
    
    /* mark cache object modified and unlock it */
    mcmtch(mctx, objn);
    mcmunlck(mctx, objn);
}

/* delete an object's properties and superclasses */
void objclr(mcmcxdef *mctx, objnum objn, prpnum mindel)
{
    objdef *o;
    prpdef *p;
    int     cnt;
    prpnum  prop;
    int     indexed;
    
    /* get a lock on the object */
    o = (objdef *)mcmlck(mctx, objn);
    indexed = objflg(o) & OBJFINDEX;
    
    /* delete superclasses - move properties down over former sc array */
    if (objnprop(o))
        memmove(objsc(o), objprp(o),
                (size_t)(((uchar *)o) + objfree(o) - (uchar *)objprp(o)));
    objsnsc(o, 0);                                 /* zero superclasses now */
    
    /* delete non-"system" properties (propnum < mindel) */
    for (p = objprp(o), cnt = objnprop(o) ; cnt ; --cnt)
    {
        if ((prop = prpprop(p)) >= mindel)
        {
            prpflg(p) &= ~PRPFIGN;   /* delete even if it was marked ignore */
            objdelp(mctx, objn, prop, FALSE);  /* remove prpdef from object */
            /* p is left pointing at next prop, as it was moved down */
        }
        else
            p = objpnxt(p);                   /* advance over this property */
    }
    
    /* mark cache object modified and unlock it */
    mcmtch(mctx, objn);
    mcmunlck(mctx, objn);
    if (indexed) objindx(mctx, objn);
}

/* set up just-compiled object:  mark static part and original props */
void objcomp(mcmcxdef *mctx, objnum objn, int for_debug)
{
    objdef *objptr;
    prpdef *p;
    prpdef *nxt;
    int     cnt;
    
    /* lock object */
    objptr = (objdef *)mcmlck(mctx, (mcmon)objn);

    /* 
     *   first, go through the properties, and delete each one that's
     *   marked as ignored 
     */
    for (cnt = objnprop(objptr), p = objprp(objptr) ; cnt != 0 ;
         p = nxt, --cnt)
    {
        /* remember the next property */
        nxt = objpnxt(p);

        /* if this is marked as being ignored, delete it */
        if ((prpflg(p) & PRPFIGN) != 0)
        {
            /* 
             *   Delete the property.  If we're compiling in debug mode,
             *   don't really delete anything, but simply mark the
             *   property as deleted; this is necessary because certain
             *   debug records are not self-relative, hence are not
             *   tolerant of changes to the internal structure of the
             *   object.  If we're not compiling for debugging, we can
             *   actually delete properties, because all non-debug code is
             *   completely self-relative and thus can be moved around
             *   inside the object without any problems.  
             */
            if (for_debug)
            {
                /* simply mark the property as deleted */
                prpflg(p) |= PRPFDEL;

                /* 
                 *   clear the IGNORE flag, since we IGNORE and DELETED
                 *   are mutually exclusive 
                 */
                prpflg(p) &= ~PRPFIGN;
            }
            else
            {
                /* clear the flags so we can really delete it */
                prpflg(p) &= ~(PRPFORG | PRPFIGN | PRPFDEL);

                /* delete it */
                objdelp(mctx, objn, (prpnum)prpprop(p), FALSE);

                /* 
                 *   continue from the present location, since we moved
                 *   the next property to the current location 
                 */
                nxt = p;
            }
        }
    }
    
    /* set static entries:  free space pointer, and number of properties */
    objsetst(objptr, objnprop(objptr));
    objsetrst(objptr, objfree(objptr));

    /* go through properties, marking each as original */
    for (cnt = objnprop(objptr), p = objprp(objptr) ; cnt != 0 ;
         p = objpnxt(p), --cnt)
    {
        assert(p < objptr + mcmobjsiz(mctx, (mcmon)objn));
        prpflg(p) |= PRPFORG;             /* set ORIGINAL flag for property */
    }
    
    /* mark object changed, and unlock it */
    mcmtch(mctx, objn);
    mcmunlck(mctx, objn);
}