Пример #1
0
bool Yap_PrintWarning(Term twarning) {
  CACHE_REGS
  PredEntry *pred = RepPredProp(PredPropByFunc(
      FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
  Term cmod = ( CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule );
  bool rc;
  Term ts[2];

  if (LOCAL_within_print_message) {
    /* error within error */
    fprintf(stderr, "%% WARNING WITHIN WARNING\n");
    Yap_RestartYap(1);
  }
  LOCAL_DoingUndefp = true;
  LOCAL_within_print_message = true;
  if (pred->OpcodeOfPred == UNDEF_OPCODE ||
      pred->OpcodeOfPred == FAIL_OPCODE 
  ) {
     fprintf(stderr, "warning message:\n");
     Yap_DebugPlWrite(twarning);
     fprintf(stderr, "\n");
    LOCAL_DoingUndefp = false;
    LOCAL_within_print_message = false;
    CurrentModule = cmod;
    return false;
  }
  ts[1] = twarning;
  ts[0] = MkAtomTerm(AtomWarning);
  HB = B->cp_h = HR;
  B->cp_tr = TR; 
  rc = Yap_execute_pred(pred, ts, true PASS_REGS);
  LOCAL_within_print_message = false;
  LOCAL_DoingUndefp = false;
  return rc;
}
Пример #2
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) {
      Prop nextp = p->NextOfPE;
      UInt hsh = PRED_HASH(p->FunctorOfPred, p->ModuleOfPred, new_size);
      p->NextOfPE = AbsPredProp(np[hsh]);
      np[hsh] = p;
      p = RepPredProp(nextp);
    }
  }
  PredHashTableSize = new_size;
  PredHash = np;
  Yap_FreeAtomSpace((ADDR)oldp);
  return TRUE;
}
Пример #3
0
static Int 
p_creep_fail( USES_REGS1 )
{
  Atom            at;
  PredEntry      *pred;

  at = AtomCreep;
  pred = RepPredProp(PredPropByFunc(Yap_MkFunctor(at, 1),0));
  CreepCode = pred;
  do_signal(YAP_CREEP_SIGNAL PASS_REGS);
  return FALSE;
}
Пример #4
0
YAPPredicate::YAPPredicate(Term &t, Term &tmod, CELL *&ts, const char *pname) {
  Term t0 = t;
  ap = nullptr;
restart:
  if (IsVarTerm(t)) {
    throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
  } else if (IsAtomTerm(t)) {
    ap = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t), tmod));
    ts = nullptr;
  } else if (IsIntegerTerm(t) && tmod == IDB_MODULE) {
    ts = nullptr;
    ap = Yap_FindLUIntKey(IntegerOfTerm(t));
  } else if (IsPairTerm(t)) {
    t = Yap_MkApplTerm(FunctorCsult, 1, &t);
    goto restart;
  } else if (IsApplTerm(t)) {
    Functor fun = FunctorOfTerm(t);
    if (IsExtensionFunctor(fun)) {
      throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE,
                     Yap_TermToIndicator(t, tmod), pname);
    }
    if (fun == FunctorModule) {
      tmod = ArgOfTerm(1, t);
      if (IsVarTerm(tmod)) {
        throw YAPError(SOURCE(), INSTANTIATION_ERROR, t0, pname);
      }
      if (!IsAtomTerm(tmod)) {
        throw YAPError(SOURCE(), TYPE_ERROR_ATOM, t0, pname);
      }
      t = ArgOfTerm(2, t);
      goto restart;
    }
    ap = RepPredProp(Yap_GetPredPropByFunc(fun, tmod));
    ts = RepAppl(t) + 1;
  } else {
    throw YAPError(SOURCE(), TYPE_ERROR_CALLABLE, t0, pname);
  }
}
Пример #5
0
static void InitCodes(void) {
  CACHE_REGS
#if THREADS
  int wid;
  for (wid = 1; wid < MAX_THREADS; wid++) {
    Yap_local[wid] = NULL;
  }
#endif
#include "ihstruct.h"
#if THREADS
  Yap_InitThread(0);
#endif /* THREADS */
  InitGlobal();
#if !THREADS
  InitWorker(0);
#endif /* THREADS */
  Yap_InitFirstWorkerThreadHandle();
  /* make sure no one else can use these two atoms */
  LOCAL_SourceModule = CurrentModule = 0;
  Yap_ReleaseAtom(AtomOfTerm(TermRefoundVar));
  /* flags require atom table done, but must be done as soon as possible,
     definitely before any predicate initialization */
  // Yap_InitFlags(); moved to HEAPFIELDS
  /* make sure we have undefp defined */
  /* predicates can only be defined after this point */
  {
    /* make sure we know about the module predicate */
    PredEntry *modp = RepPredProp(PredPropByFunc(FunctorModule, PROLOG_MODULE));
    modp->PredFlags |= MetaPredFlag;
  }
#ifdef YAPOR
  Yap_heap_regs->getwork_code->y_u.Otapl.p =
      RepPredProp(PredPropByAtom(AtomGetwork, PROLOG_MODULE));
  Yap_heap_regs->getwork_seq_code->y_u.Otapl.p =
      RepPredProp(PredPropByAtom(AtomGetworkSeq, PROLOG_MODULE));
#endif /* YAPOR */
}
Пример #6
0
static void
kill_thread_engine (int wid, int always_die)
{
  Prop p0 = AbsPredProp(REMOTE_ThreadHandle(wid).local_preds);
  GlobalEntry *gl = REMOTE_GlobalVariables(wid);

  REMOTE_ThreadHandle(wid).local_preds = NIL;
  REMOTE_GlobalVariables(wid) = NULL;
  /* kill all thread local preds */
  while(p0) {
    PredEntry *ap = RepPredProp(p0);
    p0 = ap->NextOfPE;
    Yap_Abolish(ap);
    Yap_FreeCodeSpace((char *)ap);
  }
  while (gl) {
    gl->global = TermFoundVar;
    gl = gl->NextGE;
  }
  Yap_KillStacks(wid);
  REMOTE_ActiveSignals(wid) = 0L;
  if (REMOTE_ScratchPad(wid).ptr)
    free(REMOTE_ScratchPad(wid).ptr);
  REMOTE_ThreadHandle(wid).current_yaam_regs = NULL;
  if (REMOTE_ThreadHandle(wid).start_of_timesp)
    free(REMOTE_ThreadHandle(wid).start_of_timesp);
  if (REMOTE_ThreadHandle(wid).last_timep)
    free(REMOTE_ThreadHandle(wid).last_timep);
  if (REMOTE_ThreadHandle(wid).texit) {
    Yap_FreeCodeSpace((ADDR)REMOTE_ThreadHandle(wid).texit);
  }
  /* FreeCodeSpace requires LOCAL requires yaam_regs */
  free(REMOTE_ThreadHandle(wid).default_yaam_regs);
  REMOTE_ThreadHandle(wid).default_yaam_regs = NULL;
  LOCK(GLOBAL_ThreadHandlesLock);
  if (REMOTE_ThreadHandle(wid).tdetach == MkAtomTerm(AtomTrue) ||
      always_die) {
    REMOTE_ThreadHandle(wid).zombie = FALSE;
    REMOTE_ThreadHandle(wid).in_use = FALSE;
    DEBUG_TLOCK_ACCESS(1, wid);
    pthread_mutex_unlock(&(REMOTE_ThreadHandle(wid).tlock));
  }
  UNLOCK(GLOBAL_ThreadHandlesLock);
}
Пример #7
0
bool Yap_Warning(const char *s, ...) {
  CACHE_REGS
  va_list ap;
  PredEntry *pred;
  bool rc;
  Term ts[2];
  const char *fmt;
  char tmpbuf[MAXPATHLEN];
  yap_error_number err;

  LOCAL_DoingUndefp = true;
  if (LOCAL_PrologMode & InErrorMode && (err = LOCAL_ActiveError->errorNo)) {
    fprintf(stderr, "%% Warning %s WITHIN ERROR %s %s\n", s,
            Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
    Yap_RestartYap(1);
  }
  LOCAL_PrologMode |= InErrorMode;
  pred = RepPredProp(PredPropByFunc(FunctorPrintMessage,
                                    PROLOG_MODULE)); // PROCEDURE_print_message2
  va_start(ap, s);
  fmt = va_arg(ap, char *);
  if (fmt != NULL) {
#if HAVE_VSNPRINTF
    vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap);
#else
    (void)vsprintf(tmpbuf, fmt, ap);
#endif
  } else {
    return false;
  }
  va_end(ap);
  if (pred->OpcodeOfPred == UNDEF_OPCODE || pred->OpcodeOfPred == FAIL_OPCODE) {
    fprintf(stderr, "warning message: %s\n", tmpbuf);
    LOCAL_DoingUndefp = false;
    LOCAL_PrologMode &= ~InErrorMode;
    return false;
  }

  ts[1] = MkAtomTerm(AtomWarning);
  ts[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
  rc = Yap_execute_pred(pred, ts, true PASS_REGS);
  LOCAL_PrologMode &= ~InErrorMode;
  return rc;
}
Пример #8
0
bool Yap_PrintWarning(Term twarning) {
  CACHE_REGS
  PredEntry *pred = RepPredProp(PredPropByFunc(
      FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
  if (twarning)
    __android_log_print(ANDROID_LOG_INFO, "YAPDroid ", " warning(%s)",
                        Yap_TermToBuffer(twarning, Quote_illegal_f | Ignore_ops_f | Handle_cyclics_f));
  Term cmod = (CurrentModule == PROLOG_MODULE ? TermProlog : CurrentModule);
  bool rc;
  Term ts[2], err;

  
  if (twarning && LOCAL_PrologMode & InErrorMode &&
      LOCAL_ActiveError->errorClass != WARNING &&
      (err = LOCAL_ActiveError->errorNo)  ) {
    fprintf(stderr, "%% Warning %s while processing error: %s %s\n",
            Yap_TermToBuffer(twarning,
                             Quote_illegal_f | Ignore_ops_f),
            Yap_errorClassName(Yap_errorClass(err)), Yap_errorName(err));
    return false;
  }
  LOCAL_PrologMode |= InErrorMode;
  if (pred->OpcodeOfPred == UNDEF_OPCODE || pred->OpcodeOfPred == FAIL_OPCODE) {
    fprintf(stderr, "%s:%ld/* d:%d warning */:\n",
	    LOCAL_ActiveError->errorFile,
	    LOCAL_ActiveError->errorLine, 0 );
    if (!twarning)
      twarning =  Yap_MkFullError();
    Yap_DebugPlWriteln(twarning);
    LOCAL_DoingUndefp = false;
    LOCAL_PrologMode &= ~InErrorMode;
    CurrentModule = cmod;
    return false;
  }
    if (!twarning)
      twarning =  Yap_MkFullError();
  ts[1] = twarning;
  ts[0] = MkAtomTerm(AtomWarning);
  rc = Yap_execute_pred(pred, ts, true PASS_REGS);
  LOCAL_within_print_message = false;
  LOCAL_PrologMode &= ~InErrorMode;
  return rc;
   
}
Пример #9
0
bool Yap_Warning(const char *s, ...) {
  CACHE_REGS
  va_list ap;
  PredEntry *pred;
  bool rc;
  Term ts[2];
  const char *format;
  char tmpbuf[MAXPATHLEN];

  if (LOCAL_within_print_message) {
    /* error within error */
    fprintf(stderr, "%% WARNING WITHIN WARNING\n");
    Yap_RestartYap(1);
  }
  LOCAL_DoingUndefp = true;
  LOCAL_within_print_message = true;
  pred = RepPredProp(PredPropByFunc(FunctorPrintMessage,
                                    PROLOG_MODULE)); // PROCEDURE_print_message2
  va_start(ap, s);
  format = va_arg(ap, char *);
  if (format != NULL) {
#if HAVE_VSNPRINTF
    vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap);
#else
    (void)vsprintf(tmpbuf, format, ap);
#endif
  } else
    return false;
  va_end(ap);
  if (pred->OpcodeOfPred == UNDEF_OPCODE||
      pred->OpcodeOfPred == FAIL_OPCODE) {
    fprintf(stderr, "warning message: %s\n", tmpbuf);
    LOCAL_DoingUndefp = false;
    LOCAL_within_print_message = false;
    return false;
  }

  ts[1] = MkAtomTerm(AtomWarning);
  ts[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
  rc = Yap_execute_pred(pred, ts, true PASS_REGS);
  return rc;
}
Пример #10
0
static void
RestoreHashPreds(void)
{
  UInt i;

  for (i = 0; i < PredHashTableSize; i++) {
    PredEntry *p = PredHash[i];

    if (p)
      p = PredEntryAdjust(p);
    while (p) {
      Prop nextp;
      
      if (p->NextOfPE)
	p->NextOfPE = PropAdjust(p->NextOfPE);
      nextp = p->NextOfPE;
      CleanCode(p);
      p = RepPredProp(nextp);
    }
  }
}
Пример #11
0
static bool callPortray(Term t, struct DB_TERM **old_EXp, int sno USES_REGS) {
  PredEntry *pe;
  Int b0 = LCL0 - (CELL *)B;

  *old_EXp = Yap_RefToException();
  UNLOCK(GLOBAL_Stream[sno].streamlock);
  if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
      pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
      Yap_execute_pred(pe, &t, true PASS_REGS)) {
    choiceptr B0 = (choiceptr)(LCL0 - b0);
    if (Yap_HasException() && !*old_EXp)
      *old_EXp = Yap_RefToException();
    Yap_fail_all(B0 PASS_REGS);
    LOCK(GLOBAL_Stream[sno].streamlock);
    return true;
  }
  LOCK(GLOBAL_Stream[sno].streamlock);
  if (Yap_HasException() && !*old_EXp)
    *old_EXp = Yap_RefToException();
  return false;
}
Пример #12
0
inline static Prop GetPredPropByAtomHavingLockInThisModule(AtomEntry *ae,
                                                           Term cur_mod)
/* get predicate entry for ap/arity; create it if neccessary.              */
{
  Prop p0;

  p0 = ae->PropsOfAE;
  while (p0) {
    PredEntry *pe = RepPredProp(p0);
    if (pe->KindOfPE == PEProp && pe->ModuleOfPred == cur_mod) {
#if THREADS
      /* Thread Local Predicates */
      if (pe->PredFlags & ThreadLocalPredFlag) {
        return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS));
      }
#endif
      return (p0);
    }
    p0 = pe->NextOfPE;
  }
  return (NIL);
}
Пример #13
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);
}
Пример #14
0
/******
      new user indexed predicate;
      the type right now is just rtrees, but in the future we'll have more.
      the second argument is the term.
******/
static Int
p_new_udi( USES_REGS1 )
{
  Term spec = Deref(ARG2), udi_type = Deref(ARG1);
  PredEntry *p;
  UdiControlBlock cmd;
  Atom udi_t;
  void *info;

/*  fprintf(stderr,"new pred babe\n");*/
  /* get the predicate from the spec, copied from cdmgr.c */
  if (IsVarTerm(spec)) {
    Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1");
    return FALSE;
  } else if (!IsApplTerm(spec)) {
    Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1");
    return FALSE;
  } else {
    Functor    fun = FunctorOfTerm(spec);
    Term tmod = CurrentModule;

    while (fun == FunctorModule) {
      tmod = ArgOfTerm(1,spec);
      if (IsVarTerm(tmod) ) {
	Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1");
	return FALSE;
      }
      if (!IsAtomTerm(tmod) ) {
	Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1");
	return FALSE;
      }
      spec = ArgOfTerm(2, spec);
      fun = FunctorOfTerm(spec);
    }
    p = RepPredProp(PredPropByFunc(fun, tmod));
  }
  if (!p)
    return FALSE;
  /* boring, boring, boring! */
  if ((p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) ||
      (p->ModuleOfPred == PROLOG_MODULE)) {
    Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2");
    return FALSE;
  }
  if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|TabledPredFlag)) {
    Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2");
    return FALSE;
  }
  /* just make sure we're looking at the right user type! */
  if (IsVarTerm(udi_type)) {
    Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1");
    return FALSE;
  } else if (!IsAtomTerm(udi_type)) {
    Yap_Error(TYPE_ERROR_ATOM,spec,"new user index/1");
    return FALSE;
  }
  udi_t = AtomOfTerm(udi_type);
  if (udi_t == AtomRTree) {
    cmd = &RtreeCmd;
  } else {
    Yap_Error(TYPE_ERROR_ATOM,spec,"new user index/1");
    return FALSE;
  }
  /* this is the real work */
  info = cmd->init(spec, (void *)p, p->ArityOfPE);
  if (!info)
    return FALSE;
  /* add to table */
  if (!add_udi_block(info, p, cmd)) {
    Yap_Error(OUT_OF_HEAP_ERROR, spec, "new user index/1");
    return FALSE;
  }
  p->PredFlags |= UDIPredFlag;
  return TRUE;
}
Пример #15
0
Файл: udi.c Проект: jfmc/yap-6.3
/*
 * New user indexed predicate:
 * the first argument is the term.
 */
static YAP_Int
p_new_udi( USES_REGS1 )
{
  Term spec = Deref(ARG1);

  PredEntry *p;
  UdiInfo blk;
  int info;

  /* get the predicate from the spec, copied from cdmgr.c */
  if (IsVarTerm(spec)) {
    Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1");
    return FALSE;
  } else if (!IsApplTerm(spec)) {
    Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1");
    return FALSE;
  } else {
    Functor fun = FunctorOfTerm(spec);
    Term tmod = CurrentModule;

    while (fun == FunctorModule) {
      tmod = ArgOfTerm(1,spec);
      if (IsVarTerm(tmod) ) {
	Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1");
	return FALSE;
      }
      if (!IsAtomTerm(tmod) ) {
	Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1");
	return FALSE;
      }
      spec = ArgOfTerm(2, spec);
      fun = FunctorOfTerm(spec);
    }
    p = RepPredProp(PredPropByFunc(fun, tmod));
  }
  if (!p)
    return FALSE;
  /* boring, boring, boring! */
  if ((p->PredFlags
       & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag))
      || (p->ModuleOfPred == PROLOG_MODULE)) {
    Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2");
    return FALSE;
  }
  if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|TabledPredFlag)) {
    Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2");
    return FALSE;
  }
  /* TODO: remove AtomRTree from atom list */

  /* this is the real work */
  blk = (UdiInfo) Yap_AllocCodeSpace(sizeof(struct udi_info));
  memset((void *) blk,0, sizeof(struct udi_info));
  if (!blk) {
	  Yap_Error(OUT_OF_HEAP_ERROR, spec, "new user index/1");
	  return FALSE;
  }

  /*Init UdiInfo */
  utarray_new(blk->args, &arg_icd);
  utarray_new(blk->clauselist, &cl_icd);
  blk->p = p;

  /*Now Init args list*/
  info = p_udi_args_init(spec, p->ArityOfPE, blk);
  if (!info)
  {
	  utarray_free(blk->args);
	  utarray_free(blk->clauselist);
	  Yap_FreeCodeSpace((char *) blk);
	  return FALSE;
  }

  /*Push into the hash*/
  HASH_ADD_UdiInfo(UdiControlBlocks, p, blk);

  p->PredFlags |= UDIPredFlag;

  return TRUE;
}
Пример #16
0
static Int p_table( USES_REGS1 ) {
  Term mod, t, list;
  PredEntry *pe;
  Atom at;
  int arity;
  tab_ent_ptr tab_ent;
#ifdef MODE_DIRECTED_TABLING
  int* mode_directed = NULL;
#endif /* MODE_DIRECTED_TABLING */
  
  mod = Deref(ARG1);
  t = Deref(ARG2);
  list = Deref(ARG3);

  if (IsAtomTerm(t)) {
    at = AtomOfTerm(t);
    pe = RepPredProp(PredPropByAtom(at, mod));
    arity = 0;
  } else if (IsApplTerm(t)) {
    at = NameOfFunctor(FunctorOfTerm(t));
    pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod));
    arity = ArityOfFunctor(FunctorOfTerm(t));
  } else
    return (FALSE);
  if (list != TermNil) {  /* non-empty list */
#ifndef MODE_DIRECTED_TABLING
    Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity);
    return(FALSE);
#else 
    /*************************************************************************************
      The mode operator declaration is reordered as follows:
         1. arguments with mode 'index'         (any number)
         2. arguments with mode 'min' and 'max' (any number, following the original order)
         3. arguments with mode 'all'           (any number)
         4. arguments with mode 'sum' or 'last' (only one of the two is allowed)
         5. arguments with mode 'first'         (any number)
    *************************************************************************************/
    int pos_index = 0;
    int pos_min_max = 0;
    int pos_all = 0;
    int pos_sum_last = 0;
    int pos_first = 0;
    int i;
    int *aux_mode_directed;

    aux_mode_directed = malloc(arity * sizeof(int));
    for (i = 0; i < arity; i++) {
      int mode = IntOfTerm(HeadOfTerm(list));
      if (mode == MODE_DIRECTED_INDEX)
        pos_index++;
      else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
        pos_min_max++;
      else if (mode == MODE_DIRECTED_ALL)
        pos_all++;
      else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) {
        if (pos_sum_last) {
          free(aux_mode_directed);
          Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity);
          return(FALSE);
        } else
          pos_sum_last = 1;
      }
      aux_mode_directed[i] = mode;
      list = TailOfTerm(list);
    }
    pos_first = pos_index + pos_min_max + pos_all + pos_sum_last;
    pos_sum_last = pos_index + pos_min_max + pos_all;
    pos_all = pos_index + pos_min_max;
    pos_min_max = pos_index;
    pos_index = 0;
    ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
    for (i = 0; i < arity; i++) {
      int aux_pos = 0;
      if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
        aux_pos = pos_index++;        
      else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX)
        aux_pos = pos_min_max++;
      else if (aux_mode_directed[i] == MODE_DIRECTED_ALL)
        aux_pos = pos_all++;                
      else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST)
        aux_pos = pos_sum_last++;        
      else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
        aux_pos = pos_first++;
      mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]);
    }
    free(aux_mode_directed);
#endif /* MODE_DIRECTED_TABLING */
  }
Пример #17
0
void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
                        CPredicate Start, CPredicate Cont, CPredicate Cut,
                        pred_flags_t flags) {
  CACHE_REGS
  PredEntry *pe = NULL;
  Atom atom = NIL;
  Functor f = NULL;

  while (atom == NIL) {
    atom = Yap_FullLookupAtom(Name);
    if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (Arity) {
    while (!f) {
      f = Yap_MkFunctor(atom, Arity);
      if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
        return;
      }
    }
  }
  while (pe == NULL) {
    if (Arity)
      pe = RepPredProp(PredPropByFunc(f, CurrentModule));
    else
      pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
    if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (pe->cs.p_code.FirstClause != NIL) {
    flags = update_flags_from_prolog(flags, pe);
    CleanBack(pe, Start, Cont, Cut);
  } else {
    StaticClause *cl;
    yamop *code = ((StaticClause *)NULL)->ClCode;
    UInt sz =
        (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code, OtapFs), OtapFs), OtapFs), l);
    if (flags & UserCPredFlag)
      pe->PredFlags = UserCPredFlag | BackCPredFlag | CompiledPredFlag | flags;
    else
      pe->PredFlags = CompiledPredFlag | StandardPredFlag | BackCPredFlag;

#ifdef YAPOR
    pe->PredFlags |= SequentialPredFlag;
#endif /* YAPOR */

    cl = (StaticClause *)Yap_AllocCodeSpace(sz);

    if (cl == NULL) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitCPredBack");
      return;
    }
    cl->ClFlags = StaticMask;
    cl->ClNext = NULL;
    Yap_ClauseSpace += sz;
    cl->ClSize =
        (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(code, OtapFs), OtapFs), OtapFs), e);
    cl->usc.ClLine = Yap_source_line_no();

    code = cl->ClCode;
    pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = pe->cs.p_code.FirstClause =
        pe->cs.p_code.LastClause = code;
    if (flags & UserCPredFlag)
      pe->OpcodeOfPred = code->opc = Yap_opcode(_try_userc);
    else
      pe->OpcodeOfPred = code->opc = Yap_opcode(_try_c);
    code->y_u.OtapFs.f = Start;
    code->y_u.OtapFs.p = pe;
    code->y_u.OtapFs.s = Arity;
    code->y_u.OtapFs.extra = Extra;
#ifdef YAPOR
    INIT_YAMOP_LTT(code, 2);
    PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
    code = NEXTOP(code, OtapFs);
    if (flags & UserCPredFlag)
      code->opc = Yap_opcode(_retry_userc);
    else
      code->opc = Yap_opcode(_retry_c);
    code->y_u.OtapFs.f = Cont;
    code->y_u.OtapFs.p = pe;
    code->y_u.OtapFs.s = Arity;
    code->y_u.OtapFs.extra = Extra;
#ifdef YAPOR
    INIT_YAMOP_LTT(code, 1);
    PUT_YAMOP_SEQ(code);
#endif /* YAPOR */
    code = NEXTOP(code, OtapFs);
    if (flags & UserCPredFlag)
      code->opc = Yap_opcode(_cut_userc);
    else
      code->opc = Yap_opcode(_cut_c);
    code->y_u.OtapFs.f = Cut;
    code->y_u.OtapFs.p = pe;
    code->y_u.OtapFs.s = Arity;
    code->y_u.OtapFs.extra = Extra;
    code = NEXTOP(code, OtapFs);
    code->opc = Yap_opcode(_Ystop);
    code->y_u.l.l = cl->ClCode;
  }
}
Пример #18
0
void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def,
                     pred_flags_t flags) {
  CACHE_REGS
  Atom atom = NIL;
  PredEntry *pe = NULL;
  Functor f = NULL;

  while (atom == NIL) {
    atom = Yap_FullLookupAtom(Name);
    if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (Arity) {
    while (!f) {
      f = Yap_MkFunctor(atom, Arity);
      if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
        return;
      }
    }
  }
  while (pe == NULL) {
    if (Arity)
      pe = RepPredProp(PredPropByFunc(f, CurrentModule));
    else
      pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
    if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  flags |= AsmPredFlag | StandardPredFlag | (code);
  if (pe->PredFlags & AsmPredFlag) {
    flags = update_flags_from_prolog(flags, pe);
    /* already exists */
  }
  pe->PredFlags = flags;
  pe->cs.f_code = def;
  pe->ModuleOfPred = CurrentModule;
  if (def != NULL) {
    yamop *p_code = ((StaticClause *)NULL)->ClCode;
    StaticClause *cl;

    if (pe->CodeOfPred == (yamop *)(&(pe->OpcodeOfPred))) {
      if (flags & SafePredFlag) {
        cl = (StaticClause *)Yap_AllocCodeSpace(
            (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l));
      } else {
        cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(
            NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), p),
            l));
      }
      if (!cl) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitAsmPred");
        return;
      }
      Yap_ClauseSpace +=
          (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l);
    } else {
      cl = ClauseCodeToStaticClause(pe->CodeOfPred);
    }
    cl->ClFlags = StaticMask;
    cl->ClNext = NULL;
    if (flags & SafePredFlag) {
      cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), e), e);
    } else {
      cl->ClSize = (CELL)NEXTOP(
          NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), e), e);
    }
    cl->usc.ClLine = Yap_source_line_no();
    p_code = cl->ClCode;
    pe->CodeOfPred = p_code;
    if (!(flags & SafePredFlag)) {
      p_code->opc = Yap_opcode(_allocate);
      p_code = NEXTOP(p_code, e);
    }
    p_code->opc = Yap_opcode(_call_cpred);
    p_code->y_u.Osbpp.bmap = NULL;
    p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
    p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
    p_code = NEXTOP(p_code, Osbpp);
    if (!(flags & SafePredFlag)) {
      p_code->opc = Yap_opcode(_deallocate);
      p_code->y_u.p.p = pe;
      p_code = NEXTOP(p_code, p);
    }
    p_code->opc = Yap_opcode(_procceed);
    p_code->y_u.p.p = pe;
    p_code = NEXTOP(p_code, p);
    p_code->opc = Yap_opcode(_Ystop);
    p_code->y_u.l.l = cl->ClCode;
    pe->OpcodeOfPred = pe->CodeOfPred->opc;
  } else {
    pe->OpcodeOfPred = Yap_opcode(_undef_p);
    pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
  }
}
Пример #19
0
void Yap_InitCmpPred(const char *Name, arity_t Arity, CmpPredicate cmp_code,
                     pred_flags_t flags) {
  CACHE_REGS
  Atom atom = NIL;
  PredEntry *pe = NULL;
  yamop *p_code = NULL;
  StaticClause *cl = NULL;
  Functor f = NULL;

  while (atom == NIL) {
    atom = Yap_FullLookupAtom(Name);
    if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (Arity) {
    while (!f) {
      f = Yap_MkFunctor(atom, Arity);
      if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
        return;
      }
    }
  }
  while (pe == NULL) {
    if (Arity)
      pe = RepPredProp(PredPropByFunc(f, CurrentModule));
    else
      pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
    if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (pe->PredFlags & BinaryPredFlag) {
    flags = update_flags_from_prolog(flags, pe);
    p_code = pe->CodeOfPred;
    /* already exists */
  } else {
    while (!cl) {
      UInt sz = sizeof(StaticClause) +
                (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)NULL), plxxs), p), l);
      cl = (StaticClause *)Yap_AllocCodeSpace(sz);
      if (!cl) {
        if (!Yap_growheap(FALSE, sz, NULL)) {
          Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s",
                    Name);
          return;
        }
      } else {
        Yap_ClauseSpace += sz;
        cl->ClFlags = StaticMask | StandardPredFlag;
        cl->ClNext = NULL;
        cl->ClSize = sz;
        cl->usc.ClLine = Yap_source_line_no();
        p_code = cl->ClCode;
        break;
      }
    }
  }
  // pe->PredFlags = flags | StandardPredFlag;
  pe->CodeOfPred = p_code;
  pe->cs.d_code = cmp_code;
  pe->ModuleOfPred = CurrentModule;
  p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_bfunc_xx);
  p_code->y_u.plxxs.p = pe;
  p_code->y_u.plxxs.f = FAILCODE;
  p_code->y_u.plxxs.x1 = Yap_emit_x(1);
  p_code->y_u.plxxs.x2 = Yap_emit_x(2);
  p_code->y_u.plxxs.flags = Yap_compile_cmp_flags(pe);
  p_code = NEXTOP(p_code, plxxs);
  p_code->opc = Yap_opcode(_procceed);
  p_code->y_u.p.p = pe;
  p_code = NEXTOP(p_code, p);
  p_code->opc = Yap_opcode(_Ystop);
  p_code->y_u.l.l = cl->ClCode;
}
Пример #20
0
void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code,
                   pred_flags_t flags) {
  CACHE_REGS
  Atom atom = NIL;
  PredEntry *pe = NULL;
  yamop *p_code;
  StaticClause *cl = NULL;
  Functor f = NULL;

  while (atom == NIL) {
    if (flags & UserCPredFlag)
      atom = Yap_LookupAtom(Name);
    else
      atom = Yap_FullLookupAtom(Name);
    if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (Arity) {
    while (!f) {
      f = Yap_MkFunctor(atom, Arity);
      if (!f && !Yap_growheap(FALSE, 0L, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
        return;
      }
    }
  }
  while (pe == NULL) {
    if (Arity)
      pe = RepPredProp(PredPropByFunc(f, CurrentModule));
    else
      pe = RepPredProp(PredPropByAtom(atom, CurrentModule));
    if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) {
      Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
      return;
    }
  }
  if (pe->PredFlags & CPredFlag) {
    /* already exists */
    flags = update_flags_from_prolog(flags, pe);
    cl = ClauseCodeToStaticClause(pe->CodeOfPred);
    if ((flags | StandardPredFlag | CPredFlag) != pe->PredFlags) {
      Yap_ClauseSpace -= cl->ClSize;
      Yap_FreeCodeSpace((ADDR)cl);
      cl = NULL;
    }
  }
  p_code = cl->ClCode;
  while (!cl) {
    UInt sz;

    if (flags & SafePredFlag) {
      sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code, Osbpp), p), l);
    } else {
      sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code, e), p), Osbpp), p),
                        l);
    }
    cl = (StaticClause *)Yap_AllocCodeSpace(sz);
    if (!cl) {
      if (!Yap_growheap(FALSE, sz, NULL)) {
        Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name);
        return;
      }
    } else {
      Yap_ClauseSpace += sz;
      cl->ClFlags = StaticMask;
      cl->ClNext = NULL;
      cl->ClSize = sz;
      cl->usc.ClLine = Yap_source_line_no();
      p_code = cl->ClCode;
    }
  }
  pe->CodeOfPred = p_code;
  pe->PredFlags = flags | StandardPredFlag | CPredFlag;
  pe->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1);
  pe->cs.f_code = code;
  if (!(flags & SafePredFlag)) {
    p_code->opc = Yap_opcode(_allocate);
    p_code = NEXTOP(p_code, e);
  }
  if (flags & UserCPredFlag)
    p_code->opc = Yap_opcode(_call_usercpred);
  else
    p_code->opc = Yap_opcode(_call_cpred);
  p_code->y_u.Osbpp.bmap = NULL;
  p_code->y_u.Osbpp.s = -Signed(RealEnvSize);
  p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe;
  p_code = NEXTOP(p_code, Osbpp);
  if (!(flags & SafePredFlag)) {
    p_code->opc = Yap_opcode(_deallocate);
    p_code->y_u.p.p = pe;
    p_code = NEXTOP(p_code, p);
  }
  p_code->opc = Yap_opcode(_procceed);
  p_code->y_u.p.p = pe;
  p_code = NEXTOP(p_code, p);
  p_code->opc = Yap_opcode(_Ystop);
  p_code->y_u.l.l = cl->ClCode;
  pe->OpcodeOfPred = pe->CodeOfPred->opc;
}
Пример #21
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);
}