text: /*************************************************************************
  *									 *
  *	 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)		/* 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 = 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)	/* 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) {
    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 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(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)
      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)
  {
    if (IsVarTerm(t)) {
      return MkVarTerm();
    } else if (IsAtomOrIntTerm(t)) {
      return t;
    } else {
      return Yap_LUInstance((LogUpdClause *)DBRefOfTerm(t), arity);
    }
  }
  
  static Int
  p_bb_get(void)
  {
    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);
    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 == 0L)
      return(FALSE);
    WRITE_LOCK(p->BBRWLock);  
    out = BBGet(p->Element,2);
    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(void)
  {
    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);
    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(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);
  }
  
  