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 "Yatom.h"
#include "Heap.h"
#ifndef NULL
#define NULL (void *)0
#endif

static BBProp 
PutBBProp(AtomEntry *ae, Term mod)		/* 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);
    }
    p->NextOfPE = ae->PropsOfAE;
    ae->PropsOfAE = AbsBBProp(p);
    p->ModuleOfBB = mod;
    p->Element = NULL;
    p->KeyOfBB = AbsAtom(ae);
    p->KindOfPE = BBProperty;
    INIT_RWLOCK(p->BBRWLock);    
  }
  WRITE_UNLOCK(ae->ARWLock);
  return (p);
}

static BBProp 
PutIntBBProp(Int key, Term mod)	/* 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 = NULL;
    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) {
  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)
{
  BBProp p;

 restart:
  if (IsVarTerm(t1)) {
    Yap_Error(INSTANTIATION_ERROR, t1, msg);
    return(NULL);
  } if (IsAtomTerm(t1)) {
    p = PutBBProp(RepAtom(AtomOfTerm(t1)), mod);
  } else if (IsIntegerTerm(t1)) {
    p = PutIntBBProp(IntegerOfTerm(t1), mod);
  } 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 Int
p_bb_put(void)
{
  Term t1 = Deref(ARG1);
  BBProp p = AddBBProp(t1, "bb_put/2", CurrentModule);
  if (p == NULL)
    return(FALSE);
  WRITE_LOCK(p->BBRWLock);    
  if (p->Element != NULL) {
    Yap_ReleaseTermFromDB(p->Element);
  }
  p->Element = Yap_StoreTermInDB(Deref(ARG2),2);
  WRITE_UNLOCK(p->BBRWLock);
  return(p->Element != NULL);
}

static Int
p_bb_get(void)
{
  Term t1 = Deref(ARG1);
  BBProp p = FetchBBProp(t1, "bb_get/2", CurrentModule);
  Term out;
  if (p == NULL || p->Element == NULL)
    return(FALSE);
  READ_LOCK(p->BBRWLock);  
  while ((out = Yap_FetchTermFromDB(p->Element)) == 0L) {
    if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
      Yap_Error_TYPE = YAP_NO_ERROR;
      if (!Yap_growglobal(NULL)) {
	Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
	return TermNil;
      }
    } else {
      Yap_Error_TYPE = YAP_NO_ERROR;
      if (!Yap_gc(2, ENV, P)) {
	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
	return TermNil;
      }
    }
  }
  READ_UNLOCK(p->BBRWLock);
  return(Yap_unify(ARG2,out));
}

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

  p = FetchBBProp(t1, "bb_delete/2", CurrentModule);
  if (p == NULL || p->Element == NULL)
    return(FALSE);
  while ((out = Yap_FetchTermFromDB(p->Element)) == 0L) {
    if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
      Yap_Error_TYPE = YAP_NO_ERROR;
      if (!Yap_growglobal(NULL)) {
	Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
	return TermNil;
      }
    } else {
      Yap_Error_TYPE = YAP_NO_ERROR;
      if (!Yap_gc(2, ENV, P)) {
	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
	return TermNil;
      }
    }
  }
  WRITE_LOCK(p->BBRWLock);  
  Yap_ReleaseTermFromDB(p->Element);
  p->Element = NULL;
  WRITE_UNLOCK(p->BBRWLock);  
  return(Yap_unify(ARG2,out));
}

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

  p = FetchBBProp(t1, "bb_update/3", CurrentModule);
  if (p == NULL || p->Element == NULL)
    return(FALSE);
  WRITE_LOCK(p->BBRWLock);  
  while ((out = Yap_FetchTermFromDB(p->Element)) == 0L) {
    if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
      Yap_Error_TYPE = YAP_NO_ERROR;
      if (!Yap_growglobal(NULL)) {
	Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage);
	return TermNil;
      }
    } else {
      Yap_Error_TYPE = YAP_NO_ERROR;
      if (!Yap_gc(3, ENV, P)) {
	Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
	return TermNil;
      }
    }
  }
  if (!Yap_unify(ARG2,out)) {
    WRITE_UNLOCK(p->BBRWLock);  
    return(FALSE);
  }

  Yap_ReleaseTermFromDB(p->Element);
  p->Element = Yap_StoreTermInDB(Deref(ARG3),3);
  WRITE_UNLOCK(p->BBRWLock);
  return(p->Element != NULL);
}

static Int
p_resize_bb_int_keys(void)
{
  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);
}