/****************************************************************************
**
*W  weakptr.c                   GAP source                       Steve Linton
**
**
*Y  Copyright (C)  1997,  School of Mathematical and Computational Sciences,
*Y  (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
*Y  Copyright (C) 2002 The GAP Group
*Y                        University of St Andrews, Scotland
*Y  (C) 1998 School Math and Comp. Sci., University of St Andrews, Scotland
*Y  Copyright (C) 2002 The GAP Group
**
**  This file contains the functions that deal with weak pointer objects
**  A weak pointer object looks like a plain list, except that its entries
**  are NOT kept alive through a garbage collection (unless they are contained
**  in some other kind of object). 
*/
#include        "system.h"              /* system dependent part           */


#include        "gasman.h"              /* garbage collector               */
#include        "objects.h"             /* objects                         */

#include        "gap.h"                 /* error handling, initialisation  */

#include        "gvars.h"               /* global variables                */

#include        "bool.h"                /* booleans                        */

#include        "weakptr.h"             /* weak pointers                   */

#include        "lists.h"               /* generic lists                   */
#include        "plist.h"               /* plain lists                     */

#include        "calls.h"               /* generic call mechanism          */
#include        "saveload.h"            /* saving and loading              */
#include        "opers.h"               /* generic operations              */

#include	"scanner.h"		/* scanner                         */
#include	"code.h"		/* coder                           */
#include	"thread.h"		/* threads			   */
#include	"tls.h"			/* thread-local storage		   */


/****************************************************************************
**
*F  GROW_WPOBJ(<wp>,<plen>) . make sure a weak pointer object is large enough
**
**  'GROW_WPOBJ' grows the weak pointer   object <wp> if necessary  to
**  ensure that it has room for at least <plen> elements.
**
**  Note that 'GROW_WPOBJ' is a macro, so do not call it with arguments that
**  have side effects.  */

#define GROW_WPOBJ(wp,plen)   ((plen) < SIZE_OBJ(wp)/sizeof(Obj) ? \
                                 0L : GrowWPObj(wp,plen) )

Int GrowWPObj (
               Obj                 wp,
               UInt                need )
{
  UInt                plen;           /* new physical length             */
  UInt                good;           /* good new physical length        */

    /* find out how large the object should become                     */
    good = 5 * (SIZE_OBJ(wp)/sizeof(Obj)-1) / 4 + 4;

    /* but maybe we need more                                              */
    if ( need < good ) { plen = good; }
    else               { plen = need; }

    /* resize the plain list                                               */
    ResizeBag( wp, ((plen)+1)*sizeof(Obj) );

    /* return something (to please some C compilers)                       */
    return 0L;
}


/****************************************************************************
**
*F  STORE_LEN_WPOBJ(<wp>,<len>) . . . . . . .  set the length of a WP object
**
**  'STORE_LEN_WPOBJ' sets the length of  the WP object  <wp> to <len>.
**
**  Note  that 'STORE_LEN_WPOBJ'  is a macro, so do not call it with  arguments
**  that have side effects.
** 
**  Objects at the end of wp may evaporate, so the stored length can only
**  be regarded as an upper bound.
*/

#define STORE_LEN_WPOBJ(wp,len)         (ADDR_OBJ(wp)[0] = (Obj)(len))


/****************************************************************************
**
*F  STORED_ LEN_WPOBJ(<wp>). . .. . . . . . .  stored length of a WP Object
**
**  'STORED_LEN_WPOBJ' returns the stored length of the WP object <wp> 
**  as a C integer.
**
**  Note that 'STORED_LEN_WPOBJ' is a  macro, so do  not call it 
**  with arguments that have side effects.
**
**  Note that as the list can mutate under your feet, the length may be
**  an overestimate
*/

#define STORED_LEN_WPOBJ(wp)                 ((Int)(ADDR_OBJ(wp)[0]))

/****************************************************************************
**
*F  ELM_WPOBJ(<wp>,<pos>) . . . . . . . . . . . . . element of a WP object
**
**  'ELM_WPOBJ' return the <wp>-th element of the WP object <wp>.  <pos> must
**  be a positive integer less than or equal  to the physical length of <wp>.
**  If <wp> has no assigned element at position <pos>, 'ELM_WPOBJ' returns 0.
**
**  If the entry died at a recent garbage collection, it will return a Bag ID
**  for which IS_WEAK_DEAD_BAG will return 1
**
**  Note that  'ELM_WPOBJ' is a macro, so do  not call it with arguments that
**  have side effects.  
**
**  ELM_WPOBJ(<wp>,<pos>) is a valid lvalue and may be assigned to
*/

#define ELM_WPOBJ(list,pos)             (ADDR_OBJ(list)[pos])



/****************************************************************************
**
*F  FuncWeakPointerObj( <self>, <list> ) . . . . . .make a weak pointer object
**
** Handler  for the GAP function  WeakPointerObject(<list>), which makes a new
** WP object 
*/

Obj FuncWeakPointerObj( Obj self, Obj list ) { 
  Obj wp; 
  Int i;
  Int len; 
  len = LEN_LIST(list);
  wp = (Obj) NewBag(T_WPOBJ, (len+1)*sizeof(Obj));
  STORE_LEN_WPOBJ(wp,len); 
  for (i = 1; i <= len ; i++) 
    { 
      ELM_WPOBJ(wp,i) = ELM0_LIST(list,i); 
      CHANGED_BAG(wp);          /* this must be here in case list is 
                                 in fact an object and causes a GC in the 
                                 element access method */
    }

  return wp; 
} 


/****************************************************************************
**
*F  LengthWPObj(<wp>) . . . . . . . . . . . . . . current length of WP Object
**
**  'LengthWPObj(<wp>)' returns  the   current length  of WP  Object  as  a C
**  integer  the   value cannot be   trusted past  a   garbage collection, as
**  trailing items may evaporate.
**   
**  Any identifiers of trailing objects that have evaporated in a garbage
**  collection are cleaned up by this function
*/

Int LengthWPObj(Obj wp)
{
  Int len;
  Obj elm;
  Int changed = 0;
  for (len = STORED_LEN_WPOBJ(wp); 
       len > 0 && 
         (!(elm = ELM_WPOBJ(wp,len)) ||
          IS_WEAK_DEAD_BAG(elm)); 
       len --)
    {
      changed = 1;
      if (elm)
        ELM_WPOBJ(wp,len) = 0;
    }
  if (changed)
    STORE_LEN_WPOBJ(wp,len);
  return len;
}

/****************************************************************************
**
*F  FuncLengthWPObj(<wp>) . . . . . . . . . . . . current length of WP Object
**
**  'FuncLengthWPObj(<wp>)' is a handler for a  GAP function that returns the
**  current length of WP  Object. The value  cannot be trusted past a garbage
**  collection, as trailing items may evaporate.
** 
*/

Obj FuncLengthWPObj(Obj self, Obj wp)
{
  return INTOBJ_INT(LengthWPObj(wp));
}


/****************************************************************************
**
*F  FuncSetElmWPObj(<self>, <wp>, <pos>, <obj> ) . set an entry in a WP Object
**
**  'FuncSetElmWPObj(<self>, <wp>,  <pos>, <obj>  )'  is a  handler for a GAP
**  function that sets an entry in a WP object.
** 
*/

Obj FuncSetElmWPObj(Obj self, Obj wp, Obj pos, Obj val)
{
  UInt ipos = INT_INTOBJ(pos);
  if (LengthWPObj(wp)  < ipos)
    {
      GROW_WPOBJ(wp, ipos);
      STORE_LEN_WPOBJ(wp,ipos);
    }
  ELM_WPOBJ(wp,ipos) = val;
  CHANGED_BAG(wp);
  return 0;
}

/****************************************************************************
**
*F  IsBoundElmWPObj( <wp>, <pos> ) .  . . . . is an entry bound in a WP Object
**
**  'IsBoundElmWPObj( <wp>, <pos> )' returns 1 is there is (currently) a live
**  value at position pos or the WP object wp and  0 otherwise, cleaning up a
**  dead entry if there is one
** */


Int IsBoundElmWPObj( Obj wp, Obj pos)
{
  UInt ipos = INT_INTOBJ(pos);
  Obj elm;
  if ( LengthWPObj(wp) < ipos ) 
    {
      return 0;
    }
  elm = ELM_WPOBJ(wp,ipos);
  if (IS_WEAK_DEAD_BAG(elm))
    {
      ELM_WPOBJ(wp,ipos) = 0;
      return 0;
    }
  if (elm == 0)
    {
      return 0;
    }
  return 1;
}

/****************************************************************************
**
*F  FuncIsBoundElmWPObj( <self>, <wp>, <pos> ) . . . . . . .IsBound WP Object
**
**  GAP  handler for IsBound  test on WP Object.   Remember that bindings can
**  evaporate in any garbage collection.
*/


Obj FuncIsBoundElmWPObj( Obj self, Obj wp, Obj pos)
{
  return IsBoundElmWPObj(wp, pos) ? True : False;
}


/****************************************************************************
**
*F  FuncUnbindElmWPObj( <self>, <wp>, <pos> ) . . . . . . . .Unbind WP Object
**
**  GAP  handler for Unbind on WP Object. 
*/

Obj FuncUnbindElmWPObj( Obj self, Obj wp, Obj pos)
{
  Int len = LengthWPObj(wp);
  if ( INT_INTOBJ(pos) <= len ) {
    ELM_WPOBJ( wp, INT_INTOBJ(pos)) =  0;
  }
  return 0;
}

/****************************************************************************
**
*F  FuncElmWPObj( <self>, <wp>, <pos> ) . . . . . . . . . . .Access WP Object
**
**  GAP handler for access to WP Object. If the entry is not bound, then fail
**  is  returned. It would not be  correct to return  an error, because there
**  would be no  way  to  safely access  an  element, which  might  evaporate
**  between a  call   to Isbound and the    access. This, of  course,  causes
**  possible  confusion  with a WP  object which  does have  a  value of fail
**  stored in  it. This, however  can be  checked  with a subsequent  call to
**  IsBound, relying on the fact  that fail can never  dissapear in a garbage
**  collection.
*/

Obj FuncElmWPObj( Obj self, Obj wp, Obj pos)
{
  Obj elm;
  UInt ipos = INT_INTOBJ(pos);
  if ( STORED_LEN_WPOBJ(wp) < ipos ) 
    {
      return Fail;
    }
  elm = ELM_WPOBJ(wp,ipos);
  if (IS_WEAK_DEAD_BAG(elm))
    {
      ELM_WPOBJ(wp,ipos) = 0;
      return Fail;
    }
  if (elm == 0)
    {
      return Fail;
    }
  return elm;
}


/****************************************************************************
**
*F  TypeWPObj( <wp> ) . . . . . . . . . . . . . . . . . . . Type of WP Object
**
**  This is imported from the library variable  TYPE_WPOBJ. They all have the
**  same type
*/

Obj TYPE_WPOBJ;              

Obj TypeWPObj( Obj wp )
{
  return TYPE_WPOBJ;
}


/****************************************************************************
**
*F  FuncIsWPObj( <self>, <wp>) . . . . . . . Handler for GAP function IsWPObj
*/
static Obj IsWPObjFilt;

Obj FuncIsWPObj( Obj self, Obj wp)
{
  return (TNUM_OBJ(wp) == T_WPOBJ) ? True : False;
}

/****************************************************************************
**
*F  MarkWeakPointerObj( <wp> ) . . . . . . . . . . . . . . . Marking function
*F  SweepWeakPointerObj( <src>, <dst>, <len> ) . . . . . . .Sweeping function
**
**  These functions are installed for GASMAN to use in garbage collection The
**  sweeping function must  clean up any  dead  weak pointers encountered  so
**  that, after a  full  GC, the  masterpointers  occupied by the  dead  weak
**  pointers can be reclaimed.  
*/

void MarkWeakPointerObj( Obj wp) 
{
  Int i;
  /* can't use the stored length here, in case we
     are in the middle of copying */
  for (i = 1; i <= (SIZE_BAG(wp)/sizeof(Obj))-1; i++)
    MarkBagWeakly(ELM_WPOBJ(wp,i));
}

void SweepWeakPointerObj( Bag *src, Bag *dst, UInt len)
{
  Bag elm;
  while (len --)
    {
      elm = *src++;
      *dst ++ = IS_WEAK_DEAD_BAG(elm) ? (Bag) 0 : elm;
    }
}


/****************************************************************************
**
*F  CopyObjWPObj( <obj>, <mut> ) . . . . . . . . .  copy a positional object
**
**  Note  that an  immutable   copy of  a  weak  pointer  object is a  normal
**  immutable plist. An Immutable WP object is a contradiction.
**
*N  I am far from clear that this is safe from a badly timed GC during copying.
**
*/

Obj CopyObjWPObj (
    Obj                 obj,
    Int                 mut )
{
    Obj                 copy;           /* copy, result                    */
    Obj                 tmp;            /* temporary variable              */
    Obj                 elm;
    UInt                i;              /* loop variable                   */

    /* make a copy                                                         */
    if ( mut ) {
        copy = NewBag( T_WPOBJ, SIZE_OBJ(obj) );
        ADDR_OBJ(copy)[0] = ADDR_OBJ(obj)[0];
    }
    else {
        copy = NewBag( T_PLIST+IMMUTABLE, SIZE_OBJ(obj) );
        SET_LEN_PLIST(copy,LengthWPObj(obj));
    }

    /* leave a forwarding pointer                                          */
    tmp = NEW_PLIST( T_PLIST, 2 );
    SET_LEN_PLIST( tmp, 2 );
    SET_ELM_PLIST( tmp, 1, ADDR_OBJ(obj)[0] );
    SET_ELM_PLIST( tmp, 2, copy );
    ADDR_OBJ(obj)[0] = tmp;
    CHANGED_BAG(obj);

    /* now it is copied                                                    */
    RetypeBag( obj, T_WPOBJ + COPYING );

    /* copy the subvalues                                                  */
    for ( i =  SIZE_OBJ(obj)/sizeof(Obj)-1; i > 0; i-- ) {
        elm = ADDR_OBJ(obj)[i];
        if ( elm != 0  && !IS_WEAK_DEAD_BAG(elm)) {
            tmp = COPY_OBJ( elm, mut );
            ADDR_OBJ(copy)[i] = tmp;
            CHANGED_BAG( copy );
        }
    }

    /* return the copy                                                     */
    return copy;
}

/****************************************************************************
**
*F  MakeImmutableWPObj( <obj> ) . . . . . . . . . . make immutable in place
**
*/

void MakeImmutableWPObj( Obj obj )
{
  UInt i;
  Obj elm;
  
  /* remove any weak dead bags */
  for (i = 1; i <= STORED_LEN_WPOBJ(obj); i++)
    {
      elm = ELM_WPOBJ(obj,i);
      if (elm != 0 && IS_WEAK_DEAD_BAG(elm)) 
        ELM_WPOBJ(obj,i) = 0;
    }
  /* Change the type */
  RetypeBag( obj, T_PLIST+IMMUTABLE);
}

/****************************************************************************
**
*F  CleanObjWPObj( <obj> ) . . . . . . . . . . . . . . . . . . .  clean WPobj
*/
void CleanObjWPObj (
    Obj                 obj )
{
}


/****************************************************************************
**
*F  CopyObjWPObjCopy( <obj>, <mut> ) . . . . . . . . . .  . copy a WPobj copy
*/
Obj CopyObjWPObjCopy (
    Obj                 obj,
    Int                 mut )
{
    return ELM_PLIST( ADDR_OBJ(obj)[0], 2 );
}


/****************************************************************************
**
*F  CleanObjWPObjCopy( <obj> ) . . . . . . . . . . . . . . clean WPobj copy
*/
void CleanObjWPObjCopy (
    Obj                 obj )
{
    UInt                i;              /* loop variable                   */
    Obj                 elm;            /* subobject                       */

    /* remove the forwarding pointer                                       */
    ADDR_OBJ(obj)[0] = ELM_PLIST( ADDR_OBJ(obj)[0], 1 );
    CHANGED_BAG(obj);

    /* now it is cleaned                                                   */
    RetypeBag( obj, TNUM_OBJ(obj) - COPYING );

    /* clean the subvalues                                                 */
    for ( i = 1; i < SIZE_OBJ(obj)/sizeof(Obj); i++ ) {
        elm = ADDR_OBJ(obj)[i];
        if ( elm != 0  && !IS_WEAK_DEAD_BAG(elm)) 
          CLEAN_OBJ( elm );
    }

}

/****************************************************************************
**
*F  SaveWPObj( <wpobj> )
*/

void SaveWPObj( Obj wpobj )
{
  UInt len, i;
  Obj *ptr;
  Obj x;
  ptr = ADDR_OBJ(wpobj)+1;
  len = STORED_LEN_WPOBJ(wpobj);
  SaveUInt(len);
  for (i = 1; i <= len; i++)
    {
      x = *ptr;
      if (IS_WEAK_DEAD_BAG(x))
        {
          SaveSubObj(0);
          *ptr = 0;
        }
      else
        SaveSubObj(x);
      ptr++;
    }
}

/****************************************************************************
**
*F  LoadWPObj( <wpobj> )
*/

void LoadWPObj( Obj wpobj )
{
  UInt len, i;
  Obj *ptr;
  ptr = ADDR_OBJ(wpobj)+1;
  len =   LoadUInt();
  STORE_LEN_WPOBJ(wpobj, len);
  for (i = 1; i <= len; i++)
    {
      *ptr++ = LoadSubObj();
    }
}


/****************************************************************************
**

*F * * * * * * * * * * * * * initialize package * * * * * * * * * * * * * * *
*/


/****************************************************************************
**

*V  GVarFilts . . . . . . . . . . . . . . . . . . . list of filters to export
*/
static StructGVarFilt GVarFilts [] = {

    { "IsWPObj", "obj", &IsWPObjFilt,
      FuncIsWPObj, "src/weakptr.c:IsWPObj" },

    { 0 }

};


/****************************************************************************
**
*V  GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
*/
static StructGVarFunc GVarFuncs [] = {

    { "WeakPointerObj", 1, "list",
      FuncWeakPointerObj, "src/weakptr.c:WeakPointerObj" },

    { "LengthWPObj", 1, "wp",
      FuncLengthWPObj, "src/weakptr.c:LengthWPObj" },

    { "SetElmWPObj", 3, "wp, pos, val",
      FuncSetElmWPObj, "src/weakptr.c:SetElmWPObj" },

    { "IsBoundElmWPObj", 2, "wp, pos",
      FuncIsBoundElmWPObj, "src/weakptr.c:IsBoundElmWPObj" },

    { "UnbindElmWPObj", 2, "wp, pos",
      FuncUnbindElmWPObj, "src/weakptr.c:UnbindElmWPObj" },

    { "ElmWPObj", 2, "wp, pos",
      FuncElmWPObj, "src/weakptr.c:ElmWPObj" },

    { 0 }

};


/****************************************************************************
**

*F  InitKernel( <module> )  . . . . . . . . initialise kernel data structures
*/
static Int InitKernel (
    StructInitInfo *    module )
{
    /* install the marking and sweeping methods                            */
    InfoBags[ T_WPOBJ          ].name = "object (weakptr)";
    InfoBags[ T_WPOBJ +COPYING ].name = "object (weakptr, copied)";

    InitMarkFuncBags ( T_WPOBJ,          MarkWeakPointerObj   );
    InitSweepFuncBags( T_WPOBJ,          SweepWeakPointerObj  );
    InitMarkFuncBags ( T_WPOBJ +COPYING, MarkWeakPointerObj   );
    InitSweepFuncBags( T_WPOBJ +COPYING, SweepWeakPointerObj  );

    /* typing method                                                       */
    TypeObjFuncs[ T_WPOBJ ] = TypeWPObj;
    ImportGVarFromLibrary( "TYPE_WPOBJ", &TYPE_WPOBJ );

    /* init filters and functions                                          */
    InitHdlrFiltsFromTable( GVarFilts );
    InitHdlrFuncsFromTable( GVarFuncs );

    /* saving function                                                     */
    SaveObjFuncs[ T_WPOBJ ] = SaveWPObj;
    LoadObjFuncs[ T_WPOBJ ] = LoadWPObj;
    
    /* copying functions                                                   */
    CopyObjFuncs[  T_WPOBJ           ] = CopyObjWPObj;
    CopyObjFuncs[  T_WPOBJ + COPYING ] = CopyObjWPObjCopy;
    CleanObjFuncs[ T_WPOBJ           ] = CleanObjWPObj;
    CleanObjFuncs[ T_WPOBJ + COPYING ] = CleanObjWPObjCopy;

    MakeImmutableObjFuncs[ T_WPOBJ ] = MakeImmutableWPObj;
    /* return success                                                      */
    return 0;
}


/****************************************************************************
**
*F  InitLibrary( <module> ) . . . . . . .  initialise library data structures
*/
static Int InitLibrary (
    StructInitInfo *    module )
{
    /* init filters and functions                                          */
    InitGVarFiltsFromTable( GVarFilts );
    InitGVarFuncsFromTable( GVarFuncs );

    /* return success                                                      */
    return 0;
}


/****************************************************************************
**
*F  InitInfoWeakPtr() . . . . . . . . . . . . . . . . table of init functions
*/
static StructInitInfo module = {
    MODULE_BUILTIN,                     /* type                           */
    "weakptr",                          /* name                           */
    0,                                  /* revision entry of c file       */
    0,                                  /* revision entry of h file       */
    0,                                  /* version                        */
    0,                                  /* crc                            */
    InitKernel,                         /* initKernel                     */
    InitLibrary,                        /* initLibrary                    */
    0,                                  /* checkInit                      */
    0,                                  /* preSave                        */
    0,                                  /* postSave                       */
    0                                   /* postRestore                    */
};

StructInitInfo * InitInfoWeakPtr ( void )
{
    return &module;
}


/****************************************************************************
**

*E  weakptr.c . . . . . . . . . . . . . . . . . . . . . . . . . . . ends here
*/
