Exemplo n.º 1
0
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);
}
Exemplo n.º 2
0
static void InitAtoms(void) {
  int i;
  AtomHashTableSize = MaxHash;
  HashChain =
      (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxHash);
  if (HashChain == NULL) {
    Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0),
              "allocating initial atom table");
  }
  for (i = 0; i < MaxHash; ++i) {
    INIT_RWLOCK(HashChain[i].AERWLock);
    HashChain[i].Entry = NIL;
  }
  NOfAtoms = 0;
#if OLD_STYLE_INITIAL_ATOMS
  Yap_LookupAtomWithAddress("**", (AtomEntry *)&(SF_STORE->AtFoundVar));
  Yap_ReleaseAtom(AtomFoundVar);
  Yap_LookupAtomWithAddress("?", (AtomEntry *)&(SF_STORE->AtFreeTerm));
  Yap_ReleaseAtom(AtomFreeTerm);
  Yap_LookupAtomWithAddress("[]", (AtomEntry *)&(SF_STORE->AtNil));
  Yap_LookupAtomWithAddress(".", (AtomEntry *)&(SF_STORE->AtDot));
#else
  SF_STORE->AtFoundVar = Yap_LookupAtom("**");
  Yap_ReleaseAtom(AtomFoundVar);
  SF_STORE->AtFreeTerm = Yap_LookupAtom("?");
  Yap_ReleaseAtom(AtomFreeTerm);
  SF_STORE->AtNil = Yap_LookupAtom("[]");
  SF_STORE->AtDot = Yap_LookupAtom(".");
#endif
}
Exemplo n.º 3
0
static int ExpandPredHash(void) {
  UInt new_size = PredHashTableSize + PredHashIncrement;
  PredEntry **oldp = PredHash;
  PredEntry **np =
      (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) * new_size);
  UInt i;

  if (!np) {
    return FALSE;
  }
  for (i = 0; i < new_size; i++) {
    np[i] = NULL;
  }
  for (i = 0; i < PredHashTableSize; i++) {
    PredEntry *p = PredHash[i];

    while (p) {
      PredEntry *nextp = p->NextPredOfHash;
      UInt hsh = PRED_HASH(p->FunctorOfPred, p->ModuleOfPred, new_size);
      p->NextPredOfHash = np[hsh];
      np[hsh] = p;
      p = nextp;
    }
  }
  PredHashTableSize = new_size;
  PredHash = np;
  Yap_FreeAtomSpace((ADDR)oldp);
  return TRUE;
}
Exemplo n.º 4
0
void
Yap_InitConstExps(void)
{
  unsigned int    i;
  ExpEntry       *p;

  for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
    AtomEntry *ae = RepAtom(Yap_LookupAtom(InitConstTab[i].OpName));
    if (ae == NULL) {
      Yap_EvalError(RESOURCE_ERROR_HEAP,TermNil,"at InitConstExps");
      return;
    }
    WRITE_LOCK(ae->ARWLock);
    if (Yap_GetExpPropHavingLock(ae, 0)) {
      WRITE_UNLOCK(ae->ARWLock);
      break;
    }
    p = (ExpEntry *) Yap_AllocAtomSpace(sizeof(ExpEntry));
    p->KindOfPE = ExpProperty;
    p->ArityOfEE = 0;
    p->ENoOfEE = 0;
    p->FOfEE = InitConstTab[i].f;
    AddPropToAtom(ae, (PropEntry *)p);
    WRITE_UNLOCK(ae->ARWLock);
  }
}
Exemplo n.º 5
0
static Atom
LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */
  uint64_t hash;
  const unsigned char *p;
  Atom a, na;
  AtomEntry *ae;
  size_t sz = AtomHashTableSize;

  /* compute hash */
  p = atom;

  hash = HashFunction(p);
  hash = hash % sz ;

  /* we'll start by holding a read lock in order to avoid contention */
  READ_LOCK(HashChain[hash].AERWLock);
  a = HashChain[hash].Entry;
  /* search atom in chain */
  na = SearchAtom(atom, a);
  if (na != NIL) {
    READ_UNLOCK(HashChain[hash].AERWLock);
    return (na);
  }
  READ_UNLOCK(HashChain[hash].AERWLock);
  /* we need a write lock */
  WRITE_LOCK(HashChain[hash].AERWLock);
/* concurrent version of Yap, need to take care */
#if defined(YAPOR) || defined(THREADS)
  if (a != HashChain[hash].Entry) {
    a = HashChain[hash].Entry;
    na = SearchAtom(atom, a);
    if (na != NIL) {
      WRITE_UNLOCK(HashChain[hash].AERWLock);
      return (na);
    }
  }
#endif
  /* add new atom to start of chain */
  ae = (AtomEntry *)Yap_AllocAtomSpace((sizeof *ae) +
                                       strlen((const char *)atom) + 1);
  if (ae == NULL) {
    WRITE_UNLOCK(HashChain[hash].AERWLock);
    return NIL;
  }
  NOfAtoms++;
  na = AbsAtom(ae);
  ae->PropsOfAE = NIL;
  if (ae->UStrOfAE != atom)
    strcpy((char *)ae->StrOfAE, (const char *)atom);
  ae->NextOfAE = a;
  HashChain[hash].Entry = na;
  INIT_RWLOCK(ae->ARWLock);
  WRITE_UNLOCK(HashChain[hash].AERWLock);

  if (NOfAtoms > 2 * AtomHashTableSize) {
    Yap_signal(YAP_CDOVF_SIGNAL);
  }
  return na;
}
Exemplo n.º 6
0
/* static */
static int
MemPutc(int sno, int ch)
{
  StreamDesc *s = &GLOBAL_Stream[sno];
#if MAC || _MSC_VER
  if (ch == 10)
    {
      ch = '\n';
    }
#endif
  s->u.mem_string.buf[s->u.mem_string.pos++] = ch;
  if (s->u.mem_string.pos >= s->u.mem_string.max_size -8) {
    int old_src = s->u.mem_string.src, new_src;

    /* oops, we have reached an overflow */
    Int new_max_size = s->u.mem_string.max_size + Yap_page_size;
    char *newbuf;

    if (old_src == MEM_BUF_CODE &&
	(newbuf = Yap_AllocAtomSpace(new_max_size*sizeof(char))) != NULL) {
      new_src = MEM_BUF_CODE;
#if HAVE_MEMMOVE
    memmove((void *)newbuf, (void *)s->u.mem_string.buf, (size_t)((s->u.mem_string.pos)*sizeof(char)));
#else
    {
      Int n = s->u.mem_string.pos;
      char *to = newbuf;
      char *from = s->u.mem_string.buf;
      while (n-- >= 0) {
	*to++ = *from++;
      }
    }
#endif
      Yap_FreeAtomSpace(s->u.mem_string.buf);
#if !HAVE_SYSTEM_MALLOC
    } else if ((newbuf = (ADDR)realloc(s->u.mem_string.buf, new_max_size*sizeof(char))) != NULL)  {
      new_src = MEM_BUF_MALLOC;
#endif
    } else {
      if (GLOBAL_Stream[sno].u.mem_string.error_handler) {
          CACHE_REGS
	LOCAL_Error_Size = new_max_size*sizeof(char);
	save_machine_regs();
	longjmp(*(jmp_buf *)GLOBAL_Stream[sno].u.mem_string.error_handler,1);
      } else {
	Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "YAP could not grow heap for writing to string");
      }
      return -1;
    }
   if (old_src == MEM_BUF_CODE) {
    }
    s->u.mem_string.buf = newbuf;
    s->u.mem_string.max_size = new_max_size;
    s->u.mem_string.src = new_src;
  }
  count_output_char(ch,s);
  return ((int) ch);
}
Exemplo n.º 7
0
Arquivo: init.c Projeto: jfmc/yap-6.3
static int
OpDec(int p, const char *type, Atom a, Term m)
{
  int             i;
  AtomEntry      *ae = RepAtom(a);
  OpEntry        *info;

  if (m == TermProlog)
    m = PROLOG_MODULE;
  else if (m == USER_MODULE)
    m = PROLOG_MODULE;
  for (i = 1; i <= 7; ++i)
    if (strcmp(type, optypes[i]) == 0)
      break;
  if (i > 7) {
    Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER,MkAtomTerm(Yap_LookupAtom(type)),"op/3");
    return(FALSE);
  }
  if (p) {
    if (i == 1 || i == 2 || i == 4)
      p |= DcrlpFlag;
    if (i == 1 || i == 3 || i == 6)
      p |= DcrrpFlag;
  }
  WRITE_LOCK(ae->ARWLock);
  info = Yap_GetOpPropForAModuleHavingALock(ae, m);
  if (EndOfPAEntr(info)) {
    info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry));
    info->KindOfPE = Ord(OpProperty);
    info->OpModule = m;
    info->OpName = a;
    //LOCK(OpListLock);
    info->OpNext = OpList;
    OpList = info;
    //UNLOCK(OpListLock);
    AddPropToAtom(ae, (PropEntry *)info);
    INIT_RWLOCK(info->OpRWLock);
    WRITE_LOCK(info->OpRWLock);
    WRITE_UNLOCK(ae->ARWLock);
    info->Prefix = info->Infix = info->Posfix = 0;
  } else {
    WRITE_LOCK(info->OpRWLock);
    WRITE_UNLOCK(ae->ARWLock);
  }
  if (i <= 3) {
    GET_LD
    if (truePrologFlag(PLFLAG_ISO) &&
	info->Posfix != 0) /* there is a posfix operator */ {
      /* ISO dictates */
      WRITE_UNLOCK(info->OpRWLock);
      Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3");
      return FALSE;
    }
    info->Infix = p;
  } else if (i <= 5) {
Exemplo n.º 8
0
bool Yap_dup_op(OpEntry  *op, ModEntry *she)
{
  AtomEntry *ae = RepAtom(op->OpName);
  OpEntry *info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
  if (!info)
    return false;
  memcpy(info, op, sizeof(OpEntry));
  info->NextForME =she->OpForME;
  she->OpForME = info;
  info->OpModule = MkAtomTerm(she->AtomOfME);
  AddPropToAtom(ae, AbsOpProp(info));
  INIT_RWLOCK(info->OpRWLock);
  return true;
}
Exemplo n.º 9
0
static void InitPredHash(void) {
  UInt i;

  PredHash = (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) *
                                              PredHashInitialSize);
  PredHashTableSize = PredHashInitialSize;
  if (PredHash == NULL) {
    Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0),
              "allocating initial predicate hash table");
  }
  for (i = 0; i < PredHashTableSize; ++i) {
    PredHash[i] = NULL;
  }
  INIT_RWLOCK(PredHashRWLock);
}
Exemplo n.º 10
0
int
Yap_OpenBufWriteStream( USES_REGS1 )
{
  char *nbuf;
  size_t sz =  Yap_page_size;


  while ((nbuf = (char *)Yap_AllocAtomSpace(Yap_page_size*sizeof(char))) == NULL) {
    if (!Yap_growheap(FALSE, Yap_page_size*sizeof(char), NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil,  LOCAL_ErrorMessage);
      return -1;
    }
  }
  return Yap_open_buf_write_stream(nbuf, sz, &GLOBAL_Stream[LOCAL_c_output_stream].encoding, 0);
}
Exemplo n.º 11
0
static void InitWideAtoms(void) {
  int i;

  WideAtomHashTableSize = MaxWideHash;
  WideHashChain =
      (AtomHashEntry *)Yap_AllocAtomSpace(sizeof(AtomHashEntry) * MaxWideHash);
  if (WideHashChain == NULL) {
    Yap_Error(SYSTEM_ERROR_FATAL, MkIntTerm(0), "allocating wide atom table");
  }
  for (i = 0; i < MaxWideHash; ++i) {
    INIT_RWLOCK(WideHashChain[i].AERWLock);
    WideHashChain[i].Entry = NIL;
  }
  NOfWideAtoms = 0;
}
Exemplo n.º 12
0
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);
}
Exemplo n.º 13
0
static Int
open_mem_read_stream (USES_REGS1)   /* $open_mem_read_stream(+List,-Stream) */
{
  Term t, ti;
  int sno;
  Int sl = 0, nchars = 0;
  char *nbuf;

  ti = Deref(ARG1);
  while (ti != TermNil) {
    if (IsVarTerm(ti)) {
      Yap_Error(INSTANTIATION_ERROR, ti, "open_mem_read_stream");
      return (FALSE);
    } else if (!IsPairTerm(ti)) {
      Yap_Error(TYPE_ERROR_LIST, ti, "open_mem_read_stream");
      return (FALSE);
    } else {
      sl++;
      ti = TailOfTerm(ti);
    }
  }
  while ((nbuf = (char *)Yap_AllocAtomSpace((sl+1)*sizeof(char))) == NULL) {
    if (!Yap_growheap(FALSE, (sl+1)*sizeof(char), NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil,  LOCAL_ErrorMessage);
      return(FALSE);
    }
  }
  ti = Deref(ARG1);
  while (ti != TermNil) {
    Term ts = HeadOfTerm(ti);

    if (IsVarTerm(ts)) {
      Yap_Error(INSTANTIATION_ERROR, ARG1, "open_mem_read_stream");
      return (FALSE);
    } else if (!IsIntTerm(ts)) {
      Yap_Error(TYPE_ERROR_INTEGER, ARG1, "open_mem_read_stream");
      return (FALSE);
    }
    nbuf[nchars++] = IntOfTerm(ts);
    ti = TailOfTerm(ti);
  }
  nbuf[nchars] = '\0';
  sno = Yap_open_buf_read_stream(nbuf, nchars, &LOCAL_encoding, MEM_BUF_CODE);
  t = Yap_MkStream (sno);
  return (Yap_unify (ARG2, t));
}
Exemplo n.º 14
0
/**
 * initialize module data-structure
 *
 * @param to parent module (CurrentModule)
 * @param ae module name.
 *
 * @return a new module structure
 */ /**               */
static ModEntry *initMod(AtomEntry *toname, AtomEntry *ae) {
  CACHE_REGS
  ModEntry *n, *parent;

  if (toname == NULL)
    parent = NULL;
  else {
    parent = FetchModuleEntry(toname);
  }
  n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n));
  INIT_RWLOCK(n->ModRWLock);
  n->KindOfPE = ModProperty;
  n->PredForME = NULL;
  n->NextME = CurrentModules;
  CurrentModules = n;
  n->AtomOfME = ae;
  n->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
  AddPropToAtom(ae, (PropEntry *)n);
  Yap_setModuleFlags(n, parent);
  return n;
}
Exemplo n.º 15
0
/* vsc: We must guarantee that IsVarTerm(functor) returns true! */
static inline Functor InlinedUnlockedMkFunctor(AtomEntry *ae,
                                               unsigned int arity) {
  FunctorEntry *p;
  Prop p0;

  p0 = GetFunctorProp(ae, arity);
  if (p0 != NIL) {
    return ((Functor)RepProp(p0));
  }
  p = (FunctorEntry *)Yap_AllocAtomSpace(sizeof(*p));
  if (!p)
    return NULL;
  p->KindOfPE = FunctorProperty;
  p->NameOfFE = AbsAtom(ae);
  p->ArityOfFE = arity;
  p->PropsOfFE = NIL;
  INIT_RWLOCK(p->FRWLock);
  /* respect the first property, in case this is a wide atom */
  AddPropToAtom(ae, (PropEntry *)p);
  return ((Functor)p);
}
Exemplo n.º 16
0
OpEntry *
Yap_OpPropForModule(Atom a,
                    Term mod) { /* look property list of atom a for kind  */
  AtomEntry *ae = RepAtom(a);
  PropEntry *pp;
  OpEntry *info = NULL;

  if (mod == TermProlog)
    mod = PROLOG_MODULE;
  WRITE_LOCK(ae->ARWLock);
  pp = RepProp(ae->PropsOfAE);
  while (!EndOfPAEntr(pp)) {
    if (pp->KindOfPE == OpProperty) {
      info = (OpEntry *)pp;
      if (info->OpModule == mod) {
        WRITE_LOCK(info->OpRWLock);
        WRITE_UNLOCK(ae->ARWLock);
        return info;
      }
    }
    pp = pp->NextOfPE;
  }
  info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry));
  info->KindOfPE = Ord(OpProperty);
  info->OpModule = mod;
  info->OpName = a;
  LOCK(OpListLock);
  info->OpNext = OpList;
  OpList = info;
  UNLOCK(OpListLock);
  AddPropToAtom(ae, (PropEntry *)info);
  INIT_RWLOCK(info->OpRWLock);
  WRITE_LOCK(info->OpRWLock);
  WRITE_UNLOCK(ae->ARWLock);
  info->Prefix = info->Infix = info->Posfix = 0;
  return info;
}
Exemplo n.º 17
0
void
Yap_InitBinaryExps(void)
{
  unsigned int    i;
  ExpEntry       *p;

  for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
    AtomEntry *ae = RepAtom(Yap_LookupAtom(InitBinTab[i].OpName));
    if (ae == NULL) {
      Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"at InitBinaryExps");
      return;
    }
    WRITE_LOCK(ae->ARWLock);
    if (Yap_GetExpPropHavingLock(ae, 2)) {
      WRITE_UNLOCK(ae->ARWLock);
      break;
    }
    p = (ExpEntry *) Yap_AllocAtomSpace(sizeof(ExpEntry));
    p->KindOfPE = ExpProperty;
    p->ArityOfEE = 2;
    p->ENoOfEE = 2;
    p->FOfEE = InitBinTab[i].f;
    p->NextOfPE = ae->PropsOfAE;
    ae->PropsOfAE = AbsExpProp(p);
    WRITE_UNLOCK(ae->ARWLock);
  }
  Yap_InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag);
  Yap_InitCPred("$binary_op_as_integer", 2, p_binary_op_as_integer, TestPredFlag|SafePredFlag);
  Yap_InitAsmPred("$plus", 3, _plus, export_p_plus, SafePredFlag);
  Yap_InitAsmPred("$minus", 3, _minus, export_p_minus, SafePredFlag);
  Yap_InitAsmPred("$times", 3, _times, export_p_times, SafePredFlag);
  Yap_InitAsmPred("$div", 3, _div, export_p_div, SafePredFlag);
  Yap_InitAsmPred("$and", 3, _and, export_p_and, SafePredFlag);
  Yap_InitAsmPred("$or", 3, _or, export_p_or, SafePredFlag);
  Yap_InitAsmPred("$sll", 3, _sll, export_p_sll, SafePredFlag);
  Yap_InitAsmPred("$slr", 3, _slr, export_p_slr, SafePredFlag);
}
Exemplo n.º 18
0
/* fe is supposed to be locked */
Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) {
  PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p));

  if (p == NULL) {
    WRITE_UNLOCK(fe->FRWLock);
    return NULL;
  }
  if (cur_mod == TermProlog || cur_mod == 0L) {
    p->ModuleOfPred = 0L;
  } else
    p->ModuleOfPred = cur_mod;
// TRUE_FUNC_WRITE_LOCK(fe);
  INIT_LOCK(p->PELock);
  p->KindOfPE = PEProp;
  p->ArityOfPE = fe->ArityOfFE;
  p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
  p->cs.p_code.NOfClauses = 0;
  p->PredFlags = 0L;
  p->src.OwnerFile = Yap_source_file_name();
  p->OpcodeOfPred = UNDEF_OPCODE;
  p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred));
  p->cs.p_code.ExpandCode = EXPAND_OP_CODE;
  p->TimeStampOfPred = 0L;
  p->LastCallOfPred = LUCALL_ASSERT;
  if (cur_mod == TermProlog)
    p->ModuleOfPred = 0L;
  else
    p->ModuleOfPred = cur_mod;
  Yap_NewModulePred(cur_mod, p);

#ifdef TABLING
  p->TableOfPred = NULL;
#endif /* TABLING */
#ifdef BEAM
  p->beamTable = NULL;
#endif /* BEAM */
  /* careful that they don't cross MkFunctor */
  if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) {
    p->PredFlags |= NoTracePredFlag;
  }
  p->FunctorOfPred = fe;
  if (fe->PropsOfFE) {
    UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);

    WRITE_LOCK(PredHashRWLock);
    if (10 * (PredsInHashTable + 1) > 6 * PredHashTableSize) {
      if (!ExpandPredHash()) {
        Yap_FreeCodeSpace((ADDR)p);
        WRITE_UNLOCK(PredHashRWLock);
        FUNC_WRITE_UNLOCK(fe);
        return NULL;
      }
      /* retry hashing */
      hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
    }
    PredsInHashTable++;
    if (p->ModuleOfPred == 0L) {
      PredEntry *pe = RepPredProp(fe->PropsOfFE);

      hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize);
      /* should be the first one */
      pe->NextPredOfHash = PredHash[hsh];
      PredHash[hsh] = pe;
      fe->PropsOfFE = AbsPredProp(p);
      p->NextOfPE = AbsPredProp(pe);
    } else {
      p->NextPredOfHash = PredHash[hsh];
      PredHash[hsh] = p;
      p->NextOfPE = fe->PropsOfFE->NextOfPE;
      fe->PropsOfFE->NextOfPE = AbsPredProp(p);
    }
    WRITE_UNLOCK(PredHashRWLock);
  } else {
    fe->PropsOfFE = AbsPredProp(p);
    p->NextOfPE = NIL;
  }
  FUNC_WRITE_UNLOCK(fe);
  {
    Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p,
                                  GPROF_NEW_PRED_FUNC);
    if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) {
      Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode),
                                    &(p->cs.p_code.ExpandCode) + 1, p,
                                    GPROF_NEW_PRED_FUNC);
    }
  }
  return AbsPredProp(p);
}
Exemplo n.º 19
0
/* fe is supposed to be locked */
Prop
Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
{
  PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));

  if (p == NULL) {
    WRITE_UNLOCK(fe->FRWLock);
    return NULL;
  }
  if (cur_mod == TermProlog)
    p->ModuleOfPred = 0L;
  else
    p->ModuleOfPred = cur_mod;
  if (fe->PropsOfFE) {
    UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);

    WRITE_LOCK(PredHashRWLock);
    if (10*(PredsInHashTable+1) > 6*PredHashTableSize) {
      if (!ExpandPredHash()) {
	Yap_FreeCodeSpace((ADDR)p);
	WRITE_UNLOCK(PredHashRWLock);
	WRITE_UNLOCK(fe->FRWLock);
	return NULL;
      }
      /* retry hashing */
      hsh = PRED_HASH(fe, cur_mod, PredHashTableSize);
    }
    PredsInHashTable++;
    if (p->ModuleOfPred == 0L) {
      PredEntry *pe = RepPredProp(fe->PropsOfFE);

      hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize);
      /* should be the first one */
      pe->NextOfPE = AbsPredProp(PredHash[hsh]);
      PredHash[hsh] = pe;
      fe->PropsOfFE = AbsPredProp(p);
    } else {
      p->NextOfPE = AbsPredProp(PredHash[hsh]);
      PredHash[hsh] = p;
    }
    WRITE_UNLOCK(PredHashRWLock);
    /* make sure that we have something here: note that this is not a valid pointer!! */
    RepPredProp(fe->PropsOfFE)->NextOfPE = fe->PropsOfFE;
  } else {
    fe->PropsOfFE = AbsPredProp(p);
    p->NextOfPE = NIL;
  }
  INIT_LOCK(p->PELock);
  p->KindOfPE = PEProp;
  p->ArityOfPE = fe->ArityOfFE;
  p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
  p->cs.p_code.NOfClauses = 0;
  p->PredFlags = 0L;
  p->src.OwnerFile = AtomNil;
  p->OpcodeOfPred = UNDEF_OPCODE;
  p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); 
  p->cs.p_code.ExpandCode = EXPAND_OP_CODE; 
  p->TimeStampOfPred = 0L; 
  p->LastCallOfPred = LUCALL_ASSERT; 
  if (cur_mod == TermProlog)
    p->ModuleOfPred = 0L;
  else
    p->ModuleOfPred = cur_mod;
  Yap_NewModulePred(cur_mod, p);
  INIT_LOCK(p->StatisticsForPred.lock);
  p->StatisticsForPred.NOfEntries = 0;
  p->StatisticsForPred.NOfHeadSuccesses = 0;
  p->StatisticsForPred.NOfRetries = 0;
#ifdef TABLING
  p->TableOfPred = NULL;
#endif /* TABLING */
#ifdef BEAM
  p->beamTable = NULL;
#endif  /* BEAM */
  /* careful that they don't cross MkFunctor */
  if (PRED_GOAL_EXPANSION_FUNC) {
    if (fe->PropsOfFE &&
	(RepPredProp(fe->PropsOfFE)->PredFlags & GoalExPredFlag)) {
      p->PredFlags |= GoalExPredFlag;
    }
  }
  p->FunctorOfPred = fe;
  WRITE_UNLOCK(fe->FRWLock);
  {
    Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_FUNC);
    if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
      Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_FUNC);
    }
  }
  return AbsPredProp(p);
}
Exemplo n.º 20
0
static Atom
LookupWideAtom(const wchar_t *atom) { /* lookup atom in atom table            */
  CELL hash;
  wchar_t *p;
  Atom a, na;
  AtomEntry *ae;
  UInt sz;
  WideAtomEntry *wae;

  /* compute hash */
  p = (wchar_t *)atom;
  hash = WideHashFunction(p) % WideAtomHashTableSize;
  /* we'll start by holding a read lock in order to avoid contention */
  READ_LOCK(WideHashChain[hash].AERWLock);
  a = WideHashChain[hash].Entry;
  /* search atom in chain */
  na = SearchWideAtom(atom, a);
  if (na != NIL) {
    READ_UNLOCK(WideHashChain[hash].AERWLock);
    return (na);
  }
  READ_UNLOCK(WideHashChain[hash].AERWLock);
  /* we need a write lock */
  WRITE_LOCK(WideHashChain[hash].AERWLock);
/* concurrent version of Yap, need to take care */
#if defined(YAPOR) || defined(THREADS)
  if (a != WideHashChain[hash].Entry) {
    a = WideHashChain[hash].Entry;
    na = SearchWideAtom(atom, a);
    if (na != NIL) {
      WRITE_UNLOCK(WideHashChain[hash].AERWLock);
      return na;
    }
  }
#endif
  /* add new atom to start of chain */
  sz = wcslen(atom);
  ae = (AtomEntry *)Yap_AllocAtomSpace((size_t)(((AtomEntry *)NULL) + 1) +
                                       sizeof(wchar_t) * (sz + 1));
  if (ae == NULL) {
    WRITE_UNLOCK(WideHashChain[hash].AERWLock);
    return NIL;
  }
  wae = (WideAtomEntry *)Yap_AllocAtomSpace(sizeof(WideAtomEntry));
  if (wae == NULL) {
    WRITE_UNLOCK(WideHashChain[hash].AERWLock);
    return NIL;
  }
  na = AbsAtom(ae);
  ae->PropsOfAE = AbsWideAtomProp(wae);
  wae->NextOfPE = NIL;
  wae->KindOfPE = WideAtomProperty;
  wae->SizeOfAtom = sz;
  if (ae->WStrOfAE != atom)
    wcscpy(ae->WStrOfAE, atom);
  NOfAtoms++;
  ae->NextOfAE = a;
  WideHashChain[hash].Entry = na;
  INIT_RWLOCK(ae->ARWLock);
  WRITE_UNLOCK(WideHashChain[hash].AERWLock);

  if (NOfWideAtoms > 2 * WideAtomHashTableSize) {
    Yap_signal(YAP_CDOVF_SIGNAL);
  }
  return na;
}
Exemplo n.º 21
0
  FUNC_WRITE_UNLOCK(fe);
  {
    Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p,
                                  GPROF_NEW_PRED_FUNC);
    if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) {
      Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode),
                                    &(p->cs.p_code.ExpandCode) + 1, p,
                                    GPROF_NEW_PRED_FUNC);
    }
  }
  return AbsPredProp(p);
}

#if THREADS
Prop Yap_NewThreadPred(PredEntry *ap USES_REGS) {
  PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p));

  if (p == NULL) {
    return NIL;
  }
  INIT_LOCK(p->PELock);
  p->KindOfPE = PEProp;
  p->ArityOfPE = ap->ArityOfPE;
  p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL;
  p->cs.p_code.NOfClauses = 0;
  p->PredFlags = ap->PredFlags & ~(IndexedPredFlag | SpiedPredFlag);
#if SIZEOF_INT_P == 4
  p->ExtraPredFlags = 0L;
#endif
  p->src.OwnerFile = ap->src.OwnerFile;
  p->OpcodeOfPred = FAIL_OPCODE;