yap-6.3/C/bb.c

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		bb.c							 *
* Last rev:	12/29/99						 *
* mods:									 *
* comments:	YAP's blackboard routines				 *
*									 *
*************************************************************************/
#ifdef SCCS
static char     SccsId[] = "%W% %G%";
#endif

#include "Yap.h"
#include "clause.h"
#ifndef NULL
#define NULL (void *)0
#endif

static BBProp 
PutBBProp(AtomEntry *ae, Term mod USES_REGS)		/* get BBentry for at; */
{
  Prop          p0;
  BBProp        p;

  WRITE_LOCK(ae->ARWLock);
  p = RepBBProp(p0 = ae->PropsOfAE);
  while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
		(p->ModuleOfBB != mod))) {
    p = RepBBProp(p0 = p->NextOfPE);
  }
  if (p0 == NIL) {
    p = (BBProp)Yap_AllocAtomSpace(sizeof(*p));
    if (p == NULL) {
      WRITE_UNLOCK(ae->ARWLock);
      Yap_Error(OUT_OF_HEAP_ERROR,ARG1,"could not allocate space in bb_put/2");
      return(NULL);
    }
    AddPropToAtom(ae, (PropEntry *)p);
    p->ModuleOfBB = mod;
    p->Element = 0L;
    p->KeyOfBB = AbsAtom(ae);
    p->KindOfPE = BBProperty;
    INIT_RWLOCK(p->BBRWLock);    
  }
  WRITE_UNLOCK(ae->ARWLock);
  return (p);
}

static BBProp 
PutIntBBProp(Int key, Term mod USES_REGS)	/* get BBentry for at; */
{
  Prop          p0;
  BBProp        p;
  UInt hash_key;

  if (INT_BB_KEYS == NULL) {
    INT_BB_KEYS = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*INT_BB_KEYS_SIZE);
    if (INT_BB_KEYS != NULL) {
      UInt i = 0;
      Prop *pp = INT_BB_KEYS;
      for (i = 0; i < INT_BB_KEYS_SIZE; i++) {
	pp[0] = NIL;
	pp++;
      }
    } else {
      Yap_Error(OUT_OF_HEAP_ERROR,ARG1,"could not allocate space in bb_put/2");
      return(NULL);
    }
  }
  hash_key = (CELL)key % INT_BB_KEYS_SIZE;
  p0 = INT_BB_KEYS[hash_key];
  p = RepBBProp(p0);
  while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
		       key != (Int)(p->KeyOfBB) ||
		(p->ModuleOfBB != mod))) {
    p = RepBBProp(p0 = p->NextOfPE);
  }
  if (p0 == NIL) {
    YAPEnterCriticalSection();
    p = (BBProp)Yap_AllocAtomSpace(sizeof(*p));
    if (p == NULL) {
      YAPLeaveCriticalSection();
      Yap_Error(OUT_OF_HEAP_ERROR,ARG1,"could not allocate space in bb_put/2");
      return(NULL);
    }
    p->ModuleOfBB = mod;
    p->Element = 0L;
    p->KeyOfBB = (Atom)key;
    p->KindOfPE = BBProperty;
    p->NextOfPE = INT_BB_KEYS[hash_key];
    INT_BB_KEYS[hash_key] = AbsBBProp(p);
    YAPLeaveCriticalSection();
  }
  return (p);
}

static BBProp 
GetBBProp(AtomEntry *ae, Term mod)		/* get BBentry for at; */
{
  Prop          p0;
  BBProp        p;

  READ_LOCK(ae->ARWLock);
  p = RepBBProp(p0 = ae->PropsOfAE);
  while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
		(p->ModuleOfBB != mod))) {
    p = RepBBProp(p0 = p->NextOfPE);
  }
  READ_UNLOCK(ae->ARWLock);
  if (p0 == NIL) {
    return(NULL);
  }
  return (p);
}

static BBProp 
GetIntBBProp(Int key, Term mod)		/* get BBentry for at; */
{
  Prop          p0;
  BBProp        p;
  UInt hash_key;

  if (INT_BB_KEYS == NULL)
    return(NULL);
  hash_key = (CELL)key % INT_BB_KEYS_SIZE;
  p0 = INT_BB_KEYS[hash_key];
  p = RepBBProp(p0);
  while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
		       key != (Int)(p->KeyOfBB) ||
		(p->ModuleOfBB != mod))) {
    p = RepBBProp(p0 = p->NextOfPE);
  }
  if (p0 == NIL) {
    return(NULL);
  }
  return (p);
}

static int
resize_bb_int_keys(UInt new_size) {
  CACHE_REGS
  Prop *new;
  UInt i;

  YAPEnterCriticalSection();
  if (INT_BB_KEYS == NULL) {
    INT_BB_KEYS_SIZE = new_size;
    YAPLeaveCriticalSection();
    return(TRUE);
  }
  new = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*new_size);
  if (new == NULL) {
    YAPLeaveCriticalSection();
    Yap_Error(OUT_OF_HEAP_ERROR,ARG1,"could not allocate space");
    return(FALSE);
  }
  for (i = 0; i < new_size; i++) {
    new[i] = NIL;
  }
  for (i = 0; i < INT_BB_KEYS_SIZE; i++) {
    if (INT_BB_KEYS[i] != NIL) {
      Prop p0 = INT_BB_KEYS[i];
      while (p0 != NIL) {
	BBProp p = RepBBProp(p0);
	CELL key = (CELL)(p->KeyOfBB);
	UInt hash_key = (CELL)key % new_size;
	p0 = p->NextOfPE;
	p->NextOfPE = new[hash_key];
	new[hash_key] = AbsBBProp(p);
      }
    }
  }
  Yap_FreeCodeSpace((char *)INT_BB_KEYS);
  INT_BB_KEYS = new;
  INT_BB_KEYS_SIZE = new_size;
  YAPLeaveCriticalSection();
  return(TRUE);
}

static BBProp
AddBBProp(Term t1, char *msg, Term mod USES_REGS)
{
  BBProp p;

 restart:
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, msg);
    return(NULL);
  } if (IsAtomTerm(t1)) {
    p = PutBBProp(RepAtom(AtomOfTerm(t1)), mod PASS_REGS);
  } else if (IsIntegerTerm(t1)) {
    p = PutIntBBProp(IntegerOfTerm(t1), mod PASS_REGS);
  } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
    Term tmod = ArgOfTerm(1, t1);
    if (!IsVarTerm(tmod) ) {
      t1 = ArgOfTerm(2, t1);
      mod = tmod;
      goto restart;
    } else {
      Yap_Error(INSTANTIATION_ERROR, t1, msg);
      return(NULL);
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, t1, msg);
    return(NULL);
  }
  return(p);
}

static BBProp
FetchBBProp(Term t1, char *msg, Term mod)
{
  BBProp p;

 restart:
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, msg);
    return(NULL);
  } if (IsAtomTerm(t1)) {
    p = GetBBProp(RepAtom(AtomOfTerm(t1)), mod);
  } else if (IsIntegerTerm(t1)) {
    p = GetIntBBProp(IntegerOfTerm(t1), mod);
  } else if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
    Term tmod = ArgOfTerm(1, t1);
    if (!IsVarTerm(tmod) ) {
      mod = tmod;
      t1 = ArgOfTerm(2, t1);
      goto restart;
    } else {
      Yap_Error(INSTANTIATION_ERROR, t1, msg);
      return(NULL);
    }
  } else {
    Yap_Error(TYPE_ERROR_ATOM, t1, msg);
    return(NULL);
  }
  return(p);
}

static Term 
BBPut(Term t0, Term t2)
{
  if (!IsVarTerm(t0) && IsApplTerm(t0)) {
    Yap_ErLogUpdCl((LogUpdClause *)DBRefOfTerm(t0));
  }
  if (IsVarTerm(t2) || IsAtomOrIntTerm(t2)) {
    return t2;
  } else {
    LogUpdClause *cl = Yap_new_ludbe(t2, NULL, 0);

    if (cl == NULL) {
      return 0L;
    }
    return MkDBRefTerm((DBRef)cl);
  }
}

static Int
p_bb_put( USES_REGS1 )
{
  Term t1 = Deref(ARG1);
  BBProp p = AddBBProp(t1, "bb_put/2", CurrentModule PASS_REGS);

  if (p == NULL) {
    return(FALSE);
  }
  WRITE_LOCK(p->BBRWLock);    
  /*
    if (p->Element)
    fprintf(stderr,"putting %p, size %d\n", p, p->Element->NOfCells);
  */
  p->Element = BBPut(p->Element, Deref(ARG2));
  WRITE_UNLOCK(p->BBRWLock);
  return (p->Element != 0L);
}

static Term
BBGet(Term t, UInt arity USES_REGS)
{
  if (IsVarTerm(t)) {
    return MkVarTerm();
  } else if (IsAtomOrIntTerm(t)) {
    return t;
  } else {
    return Yap_LUInstance((LogUpdClause *)DBRefOfTerm(t), arity);
  }
}

static Int
p_bb_get( USES_REGS1 )
{
  Term t1 = Deref(ARG1);
  BBProp p = FetchBBProp(t1, "bb_get/2", CurrentModule);
  Term out, t0;
  if (p == NULL || p->Element == 0L)
    return(FALSE);
  READ_LOCK(p->BBRWLock);  
  /*
    if (p->Element)
      fprintf(stderr,"getting %p, size %d\n", p, p->Element->NOfCells);
  */
  t0 = p->Element;
  READ_UNLOCK(p->BBRWLock);  
  out = BBGet(t0, 2 PASS_REGS);
  return Yap_unify(ARG2,out);
}

static Int
p_bb_delete( USES_REGS1 )
{
  Term t1 = Deref(ARG1);
  BBProp p;
  Term out;

  p = FetchBBProp(t1, "bb_delete/2", CurrentModule);
  if (p == NULL || p->Element == 0L)
    return(FALSE);
  WRITE_LOCK(p->BBRWLock);  
  out = BBGet(p->Element, 2 PASS_REGS);
  if (!IsVarTerm(p->Element) && IsApplTerm(p->Element)) {
    Yap_ErLogUpdCl((LogUpdClause *)DBRefOfTerm(p->Element));
  }
  p->Element = 0L;
  WRITE_UNLOCK(p->BBRWLock);  
  return Yap_unify(ARG2,out);
}

static Int
p_bb_update( USES_REGS1 )
{
  Term t1 = Deref(ARG1);
  BBProp p;
  Term out;

  p = FetchBBProp(t1, "bb_update/3", CurrentModule);
  if (p == NULL || p->Element == 0L)
    return FALSE;
  WRITE_LOCK(p->BBRWLock);  
  out = BBGet(p->Element, 3 PASS_REGS);
  if (!Yap_unify(out,ARG2)) {
    WRITE_UNLOCK(p->BBRWLock);
    return FALSE;
  }
  p->Element = BBPut(p->Element, Deref(ARG3));
  WRITE_UNLOCK(p->BBRWLock);
  return (p->Element != 0L);
}

static Int
p_resize_bb_int_keys( USES_REGS1 )
{
  Term t1 = Deref(ARG1);
  if (IsVarTerm(t1)) {
    return(Yap_unify(ARG1,MkIntegerTerm((Int)INT_BB_KEYS_SIZE)));
  }
  if (!IsIntegerTerm(t1)) {
    Yap_Error(TYPE_ERROR_INTEGER, t1, "yap_flag(resize_bb_int_keys,T)");
    return(FALSE);
  }
  return(resize_bb_int_keys(IntegerOfTerm(t1)));
}

void 
Yap_InitBBPreds(void)
{
  Yap_InitCPred("bb_put", 2, p_bb_put, 0);
  Yap_InitCPred("bb_get", 2, p_bb_get, 0);
  Yap_InitCPred("bb_delete", 2, p_bb_delete, 0);
  Yap_InitCPred("bb_update", 3, p_bb_update, 0);
  Yap_InitCPred("$resize_bb_int_keys", 1, p_resize_bb_int_keys, SafePredFlag|SyncPredFlag|HiddenPredFlag);
}