New metacall mechanism

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@169 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/absmi.c

@@ -1604,7 +1604,7 @@ absmi(int inp)
       ENDBOp();
 
     NoStackExecute:
-      SREG = (CELL *) (PREG->u.l.l);
+      SREG = (CELL *) pred_entry(PREG->u.l.l);
 #ifdef YAPOR
       /* abort_optyap("NoStackExecute in function absmi"); */
       if (HeapTop > GlobalBase - MinHeapGap)
@@ -1747,7 +1747,8 @@ absmi(int inp)
 
     NoStackCall:
       /* on X86 machines S will not actually be holding the pointer to pred */
-      SREG = (CELL *) (PREG->u.sla.l);
+      SREG = (CELL *) PREG->u.sla.p;
+    NoStackCallGotS:
 #ifdef YAPOR
       /* abort_optyap("NoStackCall in function absmi"); */
       if (HeapTop > GlobalBase - MinHeapGap)
@@ -1776,7 +1777,7 @@ absmi(int inp)
       if (ASP > (CELL *)B)
 	ASP = (CELL *)B;
       saveregs();
-      gc(PredArity(SREG), Y, NEXTOP(PREG, sla));
+      gc(((PredEntry *)SREG)->ArityOfPE, Y, NEXTOP(PREG, sla));
       setregs();
 
       JMPNext();
@@ -1788,7 +1789,7 @@ absmi(int inp)
     NoStackComitY:
       /* find something to fool S */
       if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
-	SREG = (CELL *)&(RepPredProp(GetPredProp(AtomRestoreRegs,2))->StateOfPred);
+	SREG = (CELL *)RepPredProp(GetPredProp(AtomRestoreRegs,2));
 	PREG = NEXTOP(PREG,x);
 	XREGS[0] = XREG(PREG->u.y.y);
 	goto creep_either;
@@ -1800,7 +1801,7 @@ absmi(int inp)
     NoStackComitX:
       /* find something to fool S */
       if (CFREG == Unsigned(LCL0) && ReadTimedVar(WokenGoals) != TermNil) {
-	SREG = (CELL *)&(RepPredProp(GetPredProp(AtomRestoreRegs,2))->StateOfPred);
+	SREG = (CELL *)RepPredProp(GetPredProp(AtomRestoreRegs,2));
 	PREG = NEXTOP(PREG,x);
 #if USE_THREADED_CODE
 	if (PREG->opc == (OPCODE)OpAddress[_fcall])
@@ -1826,7 +1827,7 @@ absmi(int inp)
       /* don't forget I cannot creep at ; */
     NoStackEither:
       /* find something to fool S */
-      SREG = (CELL *)&(RepPredProp(GetPredProp(AtomRestoreRegs,1))->StateOfPred);
+      SREG = (CELL *)RepPredProp(GetPredProp(AtomRestoreRegs,1));
 #ifdef YAPOR
       /* abort_optyap("NoStackCall in function absmi"); */
       if (HeapTop > GlobalBase - MinHeapGap)
@@ -1911,7 +1912,7 @@ absmi(int inp)
 
     NoStackDExecute:
       /* set SREG for next instructions */
-      SREG = (CELL *) (PREG->u.l.l);
+      SREG = (CELL *) pred_entry(PREG->u.l.l);
 #ifdef YAPOR
       /* abort_optyap("noStackDExecute in function absmi"); */
       if (HeapTop > GlobalBase - MinHeapGap)
@@ -1945,7 +1946,7 @@ absmi(int inp)
       if (ASP > (CELL *)B)
 	ASP = (CELL *)B;
       saveregs();
-      gc(PredArity(SREG), ENV, CPREG);
+      gc(((PredEntry *)(SREG))->ArityOfPE, ENV, CPREG);
       setregs();
       /* hopefully, gc will succeeded, and we will retry
        * the instruction */
@@ -2005,13 +2006,13 @@ absmi(int inp)
 	  S = SREG;
 #endif
 	  BEGD(d0);
-	  d0 = PredArity(SREG);
+	  d0 = ((PredEntry *)(SREG))->ArityOfPE;
 	  if (d0 == 0) {
-	    my_goal = MkAtomTerm((Atom) PredFunctor(SREG));
+	    my_goal = MkAtomTerm((Atom)((PredEntry *)(SREG))->FunctorOfPred);
 	  }
 	  else {
 	    my_goal = AbsAppl(H);
-	    *H = (CELL) PredFunctor(SREG);
+	    *H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
 	    H++;
 	    BEGP(pt1);
 	    pt1 = XREGS + 1;
@@ -2047,12 +2048,12 @@ absmi(int inp)
 	    ENDP(pt1);
 	  }
 	  ENDD(d0);
-	  H[0] = Module_Name((CODEADDR)pred_entry(SREG));
+	  H[0] = Module_Name((CODEADDR)SREG);
 	  H[1] = my_goal;
 	  ARG1 = AbsPair(H);
 	  H += 2;
 	  ARG2 = ListOfWokenGoals();
-	  SREG = (CELL *) (Unsigned(WakeUpCode) - sizeof(SMALLUNSGN));
+	  SREG = (CELL *) (WakeUpCode);
 
 	  /* no more goals to wake up */
 	  UpdateTimedVar(WokenGoals, TermNil);
@@ -2084,13 +2085,13 @@ absmi(int inp)
 	S = SREG;
 #endif
 	BEGD(d0);
-	d0 = PredArity(SREG);
+	d0 = ((PredEntry *)(SREG))->ArityOfPE;
 	if (d0 == 0) {
-	  H[1] = MkAtomTerm((Atom) PredFunctor(SREG));
+	  H[1] = MkAtomTerm((Atom) ((PredEntry *)(SREG))->FunctorOfPred);
 	}
 	else {
 	  H[d0 + 2] = AbsAppl(H);
-	  *H = (CELL) PredFunctor(SREG);
+	  *H = (CELL) ((PredEntry *)(SREG))->FunctorOfPred;
 	  H++;
 	  BEGP(pt1);
 	  pt1 = XREGS + 1;
@@ -2125,20 +2126,20 @@ absmi(int inp)
 	  ENDP(pt1);
 	}
 	ENDD(d0);
-	H[0] = Module_Name((CODEADDR)pred_entry(SREG));
+	H[0] = Module_Name(((CODEADDR)(SREG)));
 	ARG1 = (Term) AbsPair(H);
 
 	H += 2;
 	CFREG = CalculateStackGap();
-	SREG = (CELL *) (Unsigned(CreepCode) - sizeof(SMALLUNSGN));
+	SREG = (CELL *) CreepCode;
 #ifdef COROUTINING
       }
 #endif
 #ifdef LOW_LEVEL_TRACER
       if (do_low_level_trace)
-	low_level_trace(enter_pred,pred_entry(SREG),XREGS+1);
+	low_level_trace(enter_pred,(PredEntry *)(SREG),XREGS+1);
 #endif	/* LOW_LEVEL_TRACE */
-      PREG = (yamop *) PredCode(SREG);
+      PREG = (yamop *) ((PredEntry *)(SREG))->CodeOfPred;
       CACHE_A1();
       JMPNext();
 
@@ -5643,15 +5644,13 @@ absmi(int inp)
       d0 = (CELL) (PREG->u.sla.l);
       PREG = NEXTOP(PREG, sla);
       saveregs();
-      SREG = (CELL *) (*((Int (*)(void)) d0)) ();
+      d0 = (*((Int (*)(void)) d0)) ();
-      ENDD(d0);
-
-
       setregs();
-      if (!SREG) {
+      if (!d0) {
 	FAIL();
       }
       CACHE_A1();
+      ENDD(d0);
       JMPNext();
       ENDBOp();
       
@@ -5903,7 +5902,7 @@ absmi(int inp)
 	READ_UNLOCK(pe->PRWLock);
 	d0 = pe->ArityOfPE;
 	if (d0 == 0) {
-	  H[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
+	  H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
 	}
 	else {
 	  H[d0 + 2] = AbsAppl(H);
@@ -5957,12 +5956,12 @@ absmi(int inp)
 	    PredEntry *undefpe;
 	    undefpe = RepPredProp (p);
 	    READ_LOCK(undefpe->PRWLock);
-	    UndefCode = (CELL *) & (undefpe->CodeOfPred);
+	    UndefCode = undefpe;
 	    READ_UNLOCK(undefpe->PRWLock);
 	  }
 	}
       }
-      PREG = (yamop *)pred_entry_from_code(UndefCode)->CodeOfPred;
+      PREG = (yamop *)(UndefCode->CodeOfPred);
       CFREG = CalculateStackGap();
       CACHE_A1();
       JMPNext();
@@ -5987,7 +5986,7 @@ absmi(int inp)
 	d0 = pe->ArityOfPE;
       /* save S for ModuleName */
 	if (d0 == 0) {
-	  H[1] = MkAtomTerm(NameOfFunctor(pe->FunctorOfPred));
+	  H[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
 	} else {
 	  *H = (CELL) pe->FunctorOfPred;
 	  H[d0 + 2] = AbsAppl(H);
@@ -6026,16 +6025,17 @@ absmi(int inp)
       }
       ARG1 = (Term) AbsPair(H);
       H += 2;
-      BEGP(pt0);
+      {
-      pt0 = (CELL *) (Unsigned(SpyCode) - sizeof(SMALLUNSGN));
+	PredEntry *pt0;
+	pt0 = SpyCode;
 	P_before_spy = PREG;
-      PREG = (yamop *) PredCode(pt0);
+	PREG = (yamop *) (pt0->CodeOfPred);
 	CACHE_A1();
 #ifdef LOW_LEVEL_TRACER
 	if (do_low_level_trace)
-	low_level_trace(enter_pred,(PredEntry *)(PREG->u.sla.p),XREGS+1);
+	  low_level_trace(enter_pred,pt0,XREGS+1);
 #endif	/* LOW_LEVEL_TRACE */
-      ENDP(pt0);
+      }
       JMPNext();
 
 /************************************************************************\
@@ -11132,6 +11132,118 @@ absmi(int inp)
       ENDD(d0);
       ENDOp();
 
+      BOp(p_execute, sla);
+      { 
+	PredEntry *pen;
+
+	CACHE_Y_AS_ENV(Y);
+	CACHE_A1();
+	BEGD(d0);
+	d0 = ARG1;
+	if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
+	  d0 = ExecuteCallMetaCall();
+	}
+	deref_head(d0, execute_unk);
+      execute_nvar:
+	if (IsApplTerm(d0)) {
+	  Functor f = FunctorOfTerm(d0);
+	  if (IsExtensionFunctor(f)) {
+	    d0 = ExecuteCallMetaCall();
+	    goto execute_nvar;
+	  }
+	  pen = RepPredProp(PredPropByFunc(f, ARG2));
+	  if (pen->PredFlags & MetaPredFlag) {
+	    d0 = ExecuteCallMetaCall();
+	    goto execute_nvar;
+	  }
+	  BEGP(pt1);
+	  pt1 = RepAppl(d0);
+	  BEGD(d2);
+	  for (d2 = ArityOfFunctor(f); d2; d2--) {
+#if SBA
+	    BEGD(d1);
+	    d1 = pt1[d2];
+	    if (d1 == 0)
+	      XREGS[d2] = (CELL)(pt1+d2);
+	    else
+	      XREGS[d2] = d1;
+#else
+	    XREGS[d2] = pt1[d2];
+#endif
+	  }
+	  ENDD(d2);
+	  ENDP(pt1);
+	} else if (IsAtomTerm(d0)) {
+	  pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), ARG2));
+	} else {
+	  d0 = ExecuteCallMetaCall();
+	  goto execute_nvar;
+	}
+
+#ifndef NO_CHECKING
+	check_stack(NoStackPExec, H);
+#endif
+	/* code copied from call */
+	ENV = E_Y;
+	/* Try to preserve the environment */
+	E_Y = (CELL *) (((char *) Y) + PREG->u.sla.s);
+	CPREG =
+	  (yamop *) NEXTOP(PREG, sla);
+	ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
+	PREG = (yamop *) pen->CodeOfPred;
+#ifdef DEPTH_LIMIT
+	if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
+	  if (Module(pt0)) {
+	    if (DEPTH == MkIntTerm(0))
+	      FAIL();
+	    else DEPTH = RESET_DEPTH();
+	  }
+	} else if (Module(pt0))
+	  DEPTH -= MkIntConstant(2);
+#endif	/* DEPTH_LIMIT */
+#ifdef LOW_LEVEL_TRACER
+	if (do_low_level_trace)
+	  low_level_trace(enter_pred,pen,XREGS+1);
+#endif	/* LOW_LEVEL_TRACER */
+#ifdef FROZEN_REGS
+	{ 
+	  choiceptr top_b = PROTECT_FROZEN_B(B);
+#ifdef SBA
+	  if (E_Y > (CELL *) top_b || E_Y < H) E_Y = (CELL *) top_b;
+#else
+	  if (E_Y > (CELL *) top_b) E_Y = (CELL *) top_b;
+#endif
+	}
+#else
+	if (E_Y > (CELL *) B) {
+	  E_Y = (CELL *) B;
+	}
+#endif /* FROZEN_REGS */
+	WRITEBACK_Y_AS_ENV();
+	/* setup GB */
+	E_Y[E_CB] = (CELL) B;
+#ifdef YAPOR
+	SCH_check_requests();
+#endif	/* YAPOR */
+	ALWAYS_GONext();
+	ALWAYS_END_PREFETCH();
+
+	BEGP(pt1);
+	deref_body(d0, pt1, execute_unk, execute_nvar);
+	d0 = ExecuteCallMetaCall();
+	goto execute_nvar;
+	ENDP(pt1);
+	ENDD(d0);
+	ENDCACHE_Y_AS_ENV();
+
+    NoStackPExec:
+      /* on X86 machines S will not actually be holding the pointer to pred */
+      SREG = (CELL *) pen;
+      goto NoStackCallGotS;
+
+      }
+      ENDBOp();
+
 #if !USE_THREADED_CODE
     default:
       PREG = Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);

C/adtdefs.c

@@ -22,6 +22,8 @@ static char SccsId[] = "%W% %G%";
 #define ADTDEFS_C
 
 #include "Yap.h"
+Prop	STD_PROTO(PredPropByFunc,(Functor, Term));
+Prop	STD_PROTO(PredPropByAtom,(Atom, Term));
 #include "Yatom.h"
 #include "Heap.h"
 #include "yapio.h"
@@ -36,7 +38,7 @@ GetFunctorProp(AtomEntry *ae, unsigned int arity)
 {				/* look property list of atom a for kind  */
   FunctorEntry *pp;
 
-  pp = RepFunctorProp(ae->PropOfAE);
+  pp = RepFunctorProp(ae->PropsOfAE);
   while (!EndOfPAEntr(pp) &&
 	 (!IsFunctorProperty(pp->KindOfPE) ||
 	  pp->ArityOfFE != arity))
@@ -60,9 +62,9 @@ InlinedUnlockedMkFunctor(AtomEntry *ae, unsigned int arity)
   p->NameOfFE = AbsAtom(ae);
   p->ArityOfFE = arity;
   p->PropsOfFE = NIL;
-  p->NextOfPE = ae->PropOfAE;
+  p->NextOfPE = ae->PropsOfAE;
   INIT_RWLOCK(p->FRWLock);
-  ae->PropOfAE = AbsProp((PropEntry *) p);
+  ae->PropsOfAE = AbsProp((PropEntry *) p);
   return ((Functor) p);
 }
 
@@ -95,8 +97,8 @@ MkFunctorWithAddress(Atom ap, unsigned int arity, FunctorEntry *p)
   p->KindOfPE = FunctorProperty;
   p->NameOfFE = ap;
   p->ArityOfFE = arity;
-  p->NextOfPE = RepAtom(ap)->PropOfAE;
+  p->NextOfPE = RepAtom(ap)->PropsOfAE;
-  ae->PropOfAE = AbsProp((PropEntry *) p);
+  ae->PropsOfAE = AbsProp((PropEntry *) p);
   WRITE_UNLOCK(ae->ARWLock);
 }
 
@@ -156,7 +158,7 @@ LookupAtom(char *atom)
   a = AbsAtom(ae);
   ae->NextOfAE = HashChain[hash].Entry;
   HashChain[hash].Entry = a;
-  ae->PropOfAE = NIL;
+  ae->PropsOfAE = NIL;
   if (ae->StrOfAE != atom)
     strcpy(ae->StrOfAE, atom);
   INIT_RWLOCK(ae->ARWLock);
@@ -197,7 +199,7 @@ LookupAtomWithAddress(char *atom, AtomEntry *ae)
   /* add new atom to start of chain */
   ae->NextOfAE = a;
   HashChain[hash].Entry = AbsAtom(ae);
-  ae->PropOfAE = NIL;
+  ae->PropsOfAE = NIL;
   strcpy(ae->StrOfAE, atom);
   INIT_RWLOCK(ae->ARWLock);
   WRITE_UNLOCK(HashChain[hash].AERWLock);
@@ -232,20 +234,20 @@ ReleaseAtom(Atom atom)
 }
 
 static Prop
-StaticLockedGetAProp(AtomEntry *ae, PropFlags kind)
+StaticGetAPropHavingLock(AtomEntry *ae, PropFlags kind)
 {				/* look property list of atom a for kind  */
   PropEntry *pp;
 
-  pp = RepProp(ae->PropOfAE);
+  pp = RepProp(ae->PropsOfAE);
   while (!EndOfPAEntr(pp) && pp->KindOfPE != kind)
     pp = RepProp(pp->NextOfPE);
   return (AbsProp(pp));
 }
 
 Prop
-LockedGetAProp(AtomEntry *ae, PropFlags kind)
+GetAPropHavingLock(AtomEntry *ae, PropFlags kind)
 {				/* look property list of atom a for kind  */
-  return (StaticLockedGetAProp(ae,kind));
+  return (StaticGetAPropHavingLock(ae,kind));
 }
 
 Prop
@@ -255,13 +257,13 @@ GetAProp(Atom a, PropFlags kind)
   Prop out;
 
   READ_LOCK(ae->ARWLock);
-  out = StaticLockedGetAProp(ae, kind);
+  out = StaticGetAPropHavingLock(ae, kind);
   READ_UNLOCK(ae->ARWLock);
   return (out);
 }
 
-static Prop
+inline static Prop
-UnlockedFunctorGetPredProp(Functor f)
+UnlockedFunctorGetPredProp(Functor f, Term cur_mod)
      /* get predicate entry for ap/arity;               */
 {
   Prop p0;
@@ -269,13 +271,45 @@ UnlockedFunctorGetPredProp(Functor f)
   PredEntry *p;
 
   p = RepPredProp(p0 = fe->PropsOfFE);
-  while (p0 && (p->KindOfPE != PEProp ||
+  while (p0 && (/* p->KindOfPE != PEProp || only preds in here */
-		(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
+		(p->ModuleOfPred != cur_mod  && p->ModuleOfPred)))
     p = RepPredProp(p0 = p->NextOfPE);
   READ_UNLOCK(fe->FRWLock);
   return (p0);
 }
 
+inline static Prop
+GetPredPropByAtomHavingLock(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 || !pe->ModuleOfPred)) {
+      return(p0);
+    }
+    p0 = pe->NextOfPE;
+  }
+  return(NIL);
+}
+
+Prop
+GetPredPropByAtom(Atom at, Term cur_mod)
+/* get predicate entry for ap/arity; create it if neccessary.              */
+{
+  Prop p0;
+  AtomEntry *ae = RepAtom(at);
+
+  READ_LOCK(ae->ARWLock);
+  p0 = GetPredPropByAtomHavingLock(ae, cur_mod);
+  READ_UNLOCK(ae->ARWLock);
+  return(p0);
+}
+
+
 Prop
 GetPredProp(Atom ap, unsigned int arity)
      /* get predicate entry for ap/arity;               */
@@ -284,38 +318,43 @@ GetPredProp(Atom ap, unsigned int arity)
   AtomEntry *ae = RepAtom(ap);
   Functor f;
 
+  if (arity == 0)
+    return(GetPredPropByAtom(ap, *CurrentModulePtr));
   WRITE_LOCK(ae->ARWLock);
   f = InlinedUnlockedMkFunctor(ae, arity);
   WRITE_UNLOCK(ae->FRWLock);
   READ_LOCK(f->ARWLock);
-  p0 = UnlockedFunctorGetPredProp(f);
+  p0 = UnlockedFunctorGetPredProp(f, *CurrentModulePtr);
   READ_UNLOCK(f->FRWLock);
   return (p0);
 }
 
 Prop
-GetPredPropByFunc(Functor f)
+GetPredPropByFunc(Functor f, Term t)
      /* get predicate entry for ap/arity;               */
 {
   Prop p0;
 
   READ_LOCK(f->ARWLock);
-  p0 = UnlockedFunctorGetPredProp(f);
+  p0 = UnlockedFunctorGetPredProp(f, t);
   READ_UNLOCK(f->FRWLock);
   return (p0);
 }
 
 Prop
-LockedGetPredProp(Atom ap, unsigned int arity)
+GetPredPropHavingLock(Atom ap, unsigned int arity)
      /* get predicate entry for ap/arity;               */
 {
   Prop p0;
   AtomEntry *ae = RepAtom(ap);
   Functor f;
 
+  if (arity == 0) {
+    GetPredPropByAtomHavingLock(ae, *CurrentModulePtr);
+  }
   f = InlinedUnlockedMkFunctor(ae, arity);
   READ_LOCK(f->ARWLock);
-  p0 = UnlockedFunctorGetPredProp(f);
+  p0 = UnlockedFunctorGetPredProp(f, *CurrentModulePtr);
   READ_UNLOCK(f->FRWLock);
   return (p0);
 }
@@ -329,7 +368,7 @@ GetExpProp(Atom at, unsigned int arity)
   ExpEntry *p;
 
   READ_LOCK(ae->ARWLock);
-  p = RepExpProp(p0 = ae->PropOfAE);
+  p = RepExpProp(p0 = ae->PropsOfAE);
   while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity))
     p = RepExpProp(p0 = p->NextOfPE);
   READ_UNLOCK(ae->ARWLock);
@@ -338,37 +377,24 @@ GetExpProp(Atom at, unsigned int arity)
 
 /* get expression entry for at/arity, at is already locked;         */
 Prop
-LockedGetExpProp(AtomEntry *ae, unsigned int arity)
+GetExpPropHavingLock(AtomEntry *ae, unsigned int arity)
 {
   Prop p0;
   ExpEntry *p;
 
-  p = RepExpProp(p0 = ae->PropOfAE);
+  p = RepExpProp(p0 = ae->PropsOfAE);
   while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity))
     p = RepExpProp(p0 = p->NextOfPE);
   return (p0);
 }
 
 Prop
-PredPropByFunc(Functor f)
+NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
-     /* get predicate entry for ap/arity; create it if neccessary.              */
 {
   Prop p0;
-  FunctorEntry *fe = (FunctorEntry *)f;
+  PredEntry *p = (PredEntry *) AllocAtomSpace(sizeof(*p));
-  PredEntry *p;
+  Int m = IntOfTerm(cur_mod);
 
-  WRITE_LOCK(fe->FRWLock);
-  p = RepPredProp(p0 = fe->PropsOfFE);
-
-  while (p0 && (p->KindOfPE != 0 ||
-		(p->ModuleOfPred && p->ModuleOfPred != CurrentModule)))
-    p = RepPredProp(p0 = p->NextOfPE);
-
-  if (p0 != NIL) {
-    WRITE_UNLOCK(f->FRWLock);
-    return (p0);
-  }
-  p = (PredEntry *) AllocAtomSpace(sizeof(*p));
   INIT_RWLOCK(p->PRWLock);
   p->KindOfPE = PEProp;
   p->ArityOfPE = fe->ArityOfFE;
@@ -378,9 +404,12 @@ PredPropByFunc(Functor f)
   p->OwnerFile = AtomNil;
   p->OpcodeOfPred = UNDEF_OPCODE;
   p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); 
-  p->ModuleOfPred = CurrentModule;
+  if (m == 0)
-  p->NextPredOfModule = ModulePred[CurrentModule];
+    p->ModuleOfPred = 0;
-  ModulePred[CurrentModule] = p;
+  else
+    p->ModuleOfPred = cur_mod;
+  p->NextPredOfModule = ModulePred[m];
+  ModulePred[m] = p;
   INIT_LOCK(p->StatisticsForPred.lock);
   p->StatisticsForPred.NOfEntries = 0;
   p->StatisticsForPred.NOfHeadSuccesses = 0;
@@ -391,22 +420,63 @@ PredPropByFunc(Functor f)
   /* careful that they don't cross MkFunctor */
   p->NextOfPE = fe->PropsOfFE;
   fe->PropsOfFE = p0 = AbsPredProp(p);
-  p->FunctorOfPred = f;
+  p->FunctorOfPred = (Functor)fe;
   WRITE_UNLOCK(fe->FRWLock);
   return (p0);
 }
 
+Prop
+NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
+{
+  Prop p0;
+  PredEntry *p = (PredEntry *) AllocAtomSpace(sizeof(*p));
+  int m = IntOfTerm(cur_mod);
+
+  INIT_RWLOCK(p->PRWLock);
+  p->KindOfPE = PEProp;
+  p->ArityOfPE = 0;
+  p->FirstClause = p->LastClause = NIL;
+  p->PredFlags = 0L;
+  p->StateOfPred = 0;
+  p->OwnerFile = AtomNil;
+  p->OpcodeOfPred = UNDEF_OPCODE;
+  p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred)); 
+  if (!m)
+    p->ModuleOfPred = 0;
+  else
+    p->ModuleOfPred = cur_mod;
+  p->NextPredOfModule = ModulePred[m];
+  ModulePred[m] = 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 */
+  /* careful that they don't cross MkFunctor */
+  p->NextOfPE = ae->PropsOfAE;
+  ae->PropsOfAE = p0 = AbsPredProp(p);
+  p->FunctorOfPred = (Functor)AbsAtom(ae);
+  WRITE_UNLOCK(ae->ARWLock);
+  return (p0);
+}
+
 Prop
 PredProp(Atom ap, unsigned int arity)
      /* get predicate entry for ap/arity; create it if neccessary.              */
 {
   Prop p0;
-  AtomEntry *ae = RepAtom(ap);
+  AtomEntry *ae;
   Functor f;
 
+  if (arity == 0) {
+    return(PredPropByAtom(ap, *CurrentModulePtr));
+  }
+  ae = RepAtom(ap);
   WRITE_LOCK(ae->ARWLock);
   f = InlinedUnlockedMkFunctor(ae, arity);
-  p0 = PredPropByFunc(f);
+  p0 = PredPropByFunc(f, *CurrentModulePtr);
   WRITE_UNLOCK(ae->ARWLock);
   return(p0);
 }
@@ -433,15 +503,15 @@ PutValue(Atom a, Term v)
   ValEntry *p;
 
   WRITE_LOCK(ae->ARWLock);
-  p0 = LockedGetAProp(ae, ValProperty);
+  p0 = GetAPropHavingLock(ae, ValProperty);
   if (p0 != NIL) {
     p = RepValProp(p0);
     WRITE_LOCK(p->VRWLock);
     WRITE_UNLOCK(ae->ARWLock);
   } else {
     p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry));
-    p->NextOfPE = RepAtom(a)->PropOfAE;
+    p->NextOfPE = RepAtom(a)->PropsOfAE;
-    RepAtom(a)->PropOfAE = AbsValProp(p);
+    RepAtom(a)->PropsOfAE = AbsValProp(p);
     p->KindOfPE = ValProperty;
     /* take care that the lock for the property will be inited even
        if someone else searches for the property */

C/amasm.c

@@ -753,7 +753,7 @@ a_p(op_numbers opcode)
 	code_p->u.sdl.s =
 	  emit_count(-Signed(RealEnvSize) - CELLSIZE * cpc->rnd2);
 	code_p->u.sdl.d =
-	  emit_a((CELL) RepPredProp(fe)->CodeOfPred);
+	  emit_a((CELL) RepPredProp(fe)->TrueCodeOfPred);
 	code_p->u.sdl.l =
 	  emit_a(Unsigned(code_addr) + label_offset[comit_lab]);
 	code_p->u.sdl.p =
@@ -765,14 +765,18 @@ a_p(op_numbers opcode)
     }
     else {
       if (pass_no) {
-	if (Flags & UserCPredFlag)
+	if (Flags & UserCPredFlag) {
 	  code_p->opc = emit_op(_call_usercpred);
+	} else {
+	  if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod)
+	    code_p->opc = emit_op(_p_execute);
 	  else
 	    code_p->opc = emit_op(_call_cpred);
+	}
 	code_p->u.sla.s = emit_count(-Signed(RealEnvSize) - CELLSIZE
 				     * (cpc->rnd2));
 	code_p->u.sla.l = emit_a((CELL)
-				 RepPredProp(fe)->CodeOfPred);
+				 RepPredProp(fe)->TrueCodeOfPred);
 	code_p->u.sla.p = emit_a((CELL)
 				 RepPredProp(fe));
 	if (cpc->rnd2)

C/arith0.c

@@ -190,7 +190,7 @@ InitConstExps(void)
   for (i = 0; i < sizeof(InitConstTab)/sizeof(InitConstEntry); ++i) {
     AtomEntry *ae = RepAtom(LookupAtom(InitConstTab[i].OpName));
     WRITE_LOCK(ae->ARWLock);
-    if (LockedGetExpProp(ae, 0)) {
+    if (GetExpPropHavingLock(ae, 0)) {
       WRITE_UNLOCK(ae->ARWLock);
       break;
     }
@@ -199,8 +199,8 @@ InitConstExps(void)
     p->ArityOfEE = 0;
     p->ENoOfEE = 0;
     p->FOfEE.constant = InitConstTab[i].f;
-    p->NextOfPE = ae->PropOfAE;
+    p->NextOfPE = ae->PropsOfAE;
-    ae->PropOfAE = AbsExpProp(p);
+    ae->PropsOfAE = AbsExpProp(p);
     WRITE_UNLOCK(ae->ARWLock);
   }
 }
@@ -216,7 +216,7 @@ ReInitConstExps(void)
     AtomEntry *ae = RepAtom(FullLookupAtom(InitConstTab[i].OpName));
 
     WRITE_LOCK(ae->ARWLock);
-    if ((p = LockedGetExpProp(ae, 0)) == NULL) {
+    if ((p = GetExpPropHavingLock(ae, 0)) == NULL) {
       WRITE_UNLOCK(ae->ARWLock);
       return(FALSE);
     }

C/arith1.c

@@ -2007,7 +2007,7 @@ InitUnaryExps(void)
   for (i = 0; i < sizeof(InitUnTab)/sizeof(InitUnEntry); ++i) {
     AtomEntry *ae = RepAtom(LookupAtom(InitUnTab[i].OpName));
     WRITE_LOCK(ae->ARWLock);
-    if (LockedGetExpProp(ae, 1)) {
+    if (GetExpPropHavingLock(ae, 1)) {
       WRITE_UNLOCK(ae->ARWLock);
       break;
     }
@@ -2016,8 +2016,8 @@ InitUnaryExps(void)
     p->ArityOfEE = 1;
     p->ENoOfEE = 1;
     p->FOfEE.unary = InitUnTab[i].f;
-    p->NextOfPE = ae->PropOfAE;
+    p->NextOfPE = ae->PropsOfAE;
-    ae->PropOfAE = AbsExpProp(p);
+    ae->PropsOfAE = AbsExpProp(p);
     WRITE_UNLOCK(ae->ARWLock);
   }
   InitCPred("is", 3, p_unary_is, TestPredFlag | SafePredFlag);
@@ -2034,7 +2034,7 @@ ReInitUnaryExps(void)
     AtomEntry *ae = RepAtom(FullLookupAtom(InitUnTab[i].OpName));
 
     WRITE_LOCK(ae->ARWLock);
-    if ((p = LockedGetExpProp(ae, 1)) == NULL) {
+    if ((p = GetExpPropHavingLock(ae, 1)) == NULL) {
       WRITE_UNLOCK(ae->ARWLock);
       return(FALSE);
     }

C/arith2.c

@@ -1720,7 +1720,7 @@ InitBinaryExps(void)
   for (i = 0; i < sizeof(InitBinTab)/sizeof(InitBinEntry); ++i) {
     AtomEntry *ae = RepAtom(LookupAtom(InitBinTab[i].OpName));
     WRITE_LOCK(ae->ARWLock);
-    if (LockedGetExpProp(ae, 2)) {
+    if (GetExpPropHavingLock(ae, 2)) {
       WRITE_UNLOCK(ae->ARWLock);
       break;
     }
@@ -1729,8 +1729,8 @@ InitBinaryExps(void)
     p->ArityOfEE = 2;
     p->ENoOfEE = 2;
     p->FOfEE.binary = InitBinTab[i].f;
-    p->NextOfPE = ae->PropOfAE;
+    p->NextOfPE = ae->PropsOfAE;
-    ae->PropOfAE = AbsExpProp(p);
+    ae->PropsOfAE = AbsExpProp(p);
     WRITE_UNLOCK(ae->ARWLock);
   }
   InitCPred("is", 4, p_binary_is, TestPredFlag | SafePredFlag);
@@ -1747,7 +1747,7 @@ ReInitBinaryExps(void)
     AtomEntry *ae = RepAtom(FullLookupAtom(InitBinTab[i].OpName));
 
     WRITE_LOCK(ae->ARWLock);
-    if ((p = LockedGetExpProp(ae, 2)) == NULL) {
+    if ((p = GetExpPropHavingLock(ae, 2)) == NULL) {
       WRITE_UNLOCK(ae->ARWLock);
       return(FALSE);
     }

C/arrays.c

@@ -149,7 +149,7 @@ AccessNamedArray(Atom a, Int indx)
   ArrayEntry *pp; 
 
   READ_LOCK(ae->ARWLock);
-  pp = RepArrayProp(ae->PropOfAE);
+  pp = RepArrayProp(ae->PropsOfAE);
   while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
     pp = RepArrayProp(pp->NextOfPE);
   READ_UNLOCK(ae->ARWLock);
@@ -393,9 +393,9 @@ CreateNamedArray(PropEntry * pp, Int dim, AtomEntry *ae)
 
   p = (ArrayEntry *) AllocAtomSpace(sizeof(*p));
   p->KindOfPE = ArrayProperty;
-  p->NextOfPE = ae->PropOfAE;
+  p->NextOfPE = ae->PropsOfAE;
   INIT_RWLOCK(p->ArRWLock);
-  ae->PropOfAE = AbsArrayProp(p);
+  ae->PropsOfAE = AbsArrayProp(p);
 
   InitNamedArray(p, dim);
 
@@ -446,13 +446,13 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
   if (EndOfPAEntr(p)) {
     p = (StaticArrayEntry *) AllocAtomSpace(sizeof(*p));
     p->KindOfPE = ArrayProperty;
-    p->NextOfPE = ae->PropOfAE;
+    p->NextOfPE = ae->PropsOfAE;
     INIT_RWLOCK(p->ArRWLock);
     WRITE_LOCK(p->ArRWLock);
   }
   p->ArrayEArity = -dim;
   p->ArrayType = type;
-  ae->PropOfAE = AbsArrayProp((ArrayEntry *)p);
+  ae->PropsOfAE = AbsArrayProp((ArrayEntry *)p);
   WRITE_UNLOCK(ae->ARWLock);
   if (start_addr == NULL) {
     int i;
@@ -578,7 +578,7 @@ ClearNamedArray(CELL *pt0)
   AtomEntry *ae = (AtomEntry *)RepAppl(pt0[-1]);
 
   READ_LOCK(ae->ARWLock);
-  pp = RepProp(ae->PropOfAE);  
+  pp = RepProp(ae->PropsOfAE);  
   while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty) {
     pp = RepProp(pp->NextOfPE);
   }
@@ -649,7 +649,7 @@ p_create_array(void)
     PropEntry *pp;
 
     WRITE_LOCK(ae->ARWLock);
-    pp = RepProp(ae->PropOfAE);
+    pp = RepProp(ae->PropsOfAE);
     while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
       pp = RepProp(pp->NextOfPE);
     if (EndOfPAEntr(pp)) {
@@ -753,7 +753,7 @@ p_create_static_array(void)
     StaticArrayEntry *pp;
 
     WRITE_LOCK(ae->ARWLock);
-    pp = RepStaticArrayProp(ae->PropOfAE);
+    pp = RepStaticArrayProp(ae->PropsOfAE);
     WRITE_LOCK(pp->ArRWLock);
     while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
       pp = RepStaticArrayProp(pp->NextOfPE);
@@ -786,7 +786,7 @@ p_has_static_array(void)
     StaticArrayEntry *pp;
 
     READ_LOCK(ae->ARWLock);
-    pp = RepStaticArrayProp(ae->PropOfAE);
+    pp = RepStaticArrayProp(ae->PropsOfAE);
     while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
       pp = RepStaticArrayProp(pp->NextOfPE);
     if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
@@ -833,7 +833,7 @@ p_resize_static_array(void)
   else if (IsAtomTerm(t)) {
     /* resize a named array */
     Atom a = AtomOfTerm(t);
-    StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropOfAE);
+    StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);
 
     while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
       pp = RepStaticArrayProp(pp->NextOfPE);
@@ -868,7 +868,7 @@ p_close_static_array(void)
     PropEntry *pp;
 
     READ_LOCK(ae->ARWLock);
-    pp = RepProp(ae->PropOfAE);
+    pp = RepProp(ae->PropsOfAE);
     while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
       pp = RepProp(pp->NextOfPE);
     READ_UNLOCK(ae->ARWLock);
@@ -1101,7 +1101,7 @@ p_create_mmapped_array(void)
     StaticArrayEntry *pp;
 
     WRITE_LOCK(ae->ARWLock);
-    pp = RepStaticArrayProp(ae->PropOfAE);
+    pp = RepStaticArrayProp(ae->PropsOfAE);
     while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
       pp = RepStaticArrayProp(pp->NextOfPE);
     if (!EndOfPAEntr(pp)) {
@@ -1361,7 +1361,7 @@ p_assign_static(void)
     AtomEntry *ae = RepAtom(AtomOfTerm(t1));
 
     READ_LOCK(ae->ARWLock);
-    ptr =  RepStaticArrayProp(ae->PropOfAE);    
+    ptr =  RepStaticArrayProp(ae->PropsOfAE);    
     while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
       ptr = RepStaticArrayProp(ptr->NextOfPE);
     READ_UNLOCK(ae->ARWLock);
@@ -1611,7 +1611,7 @@ SetDBForThrow(Term Message)
   StaticArrayEntry *ptr;
   DBRef ref;
   READ_LOCK(ae->ARWLock);
-  ptr =  RepStaticArrayProp(ae->PropOfAE);    
+  ptr =  RepStaticArrayProp(ae->PropsOfAE);    
   while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
     ptr = RepStaticArrayProp(ptr->NextOfPE);
   READ_UNLOCK(ae->ARWLock);

C/bb.c

@@ -32,7 +32,7 @@ PutBBProp(AtomEntry *ae)		/* get BBentry for at; */
   BBProp        p;
 
   WRITE_LOCK(ae->ARWLock);
-  p = RepBBProp(p0 = ae->PropOfAE);
+  p = RepBBProp(p0 = ae->PropsOfAE);
   while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
 		(p->ModuleOfBB != CurrentModule))) {
     p = RepBBProp(p0 = p->NextOfPE);
@@ -44,8 +44,8 @@ PutBBProp(AtomEntry *ae)		/* get BBentry for at; */
       Error(SYSTEM_ERROR,ARG1,"could not allocate space in bb_put/2");
       return(NULL);
     }
-    p->NextOfPE = ae->PropOfAE;
+    p->NextOfPE = ae->PropsOfAE;
-    ae->PropOfAE = AbsBBProp(p);
+    ae->PropsOfAE = AbsBBProp(p);
     p->ModuleOfBB = CurrentModule;
     p->Element = NULL;
     p->KeyOfBB = AbsAtom(ae);
@@ -111,7 +111,7 @@ GetBBProp(AtomEntry *ae)		/* get BBentry for at; */
   BBProp        p;
 
   READ_LOCK(ae->ARWLock);
-  p = RepBBProp(p0 = ae->PropOfAE);
+  p = RepBBProp(p0 = ae->PropsOfAE);
   while (p0 != NIL && (!IsBBProperty(p->KindOfPE) ||
 		(p->ModuleOfBB != CurrentModule))) {
     p = RepBBProp(p0 = p->NextOfPE);

C/cdmgr.c

@@ -299,7 +299,7 @@ RemoveIndexation(PredEntry *ap)
       Error_Term = TermNil;
       Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
       if (Arity == 0)
-	sprintf(ErrorMessage, "predicate %s is in use", RepAtom(NameOfFunctor(ap->FunctorOfPred))->StrOfAE);
+	sprintf(ErrorMessage, "predicate %s is in use", RepAtom((Atom)(ap->FunctorOfPred))->StrOfAE);
       else
 	sprintf(ErrorMessage,
 #if SHORT_INTS
@@ -796,6 +796,8 @@ addclause(Term t, CODEADDR cp, int mode)
   Int             Arity;
   PredEntry      *p;
   int             spy_flag = FALSE;
+  SMALLUNSGN      mod = CurrentModule;
+
 
   if (IsApplTerm(t) && FunctorOfTerm(t) == FunctorAssert)
     t = ArgOfTerm(1, t);
@@ -810,39 +812,9 @@ addclause(Term t, CODEADDR cp, int mode)
   p = RepPredProp(PredProp(AbsAtom(ap), Arity));
   PutValue(AtomAbol, TermNil);
   WRITE_LOCK(p->PRWLock);
-  if (p->PredFlags & StandardPredFlag) {
+  /* we are redefining a prolog module predicate */
-    Term t, ti[2];
+  if (mod != 0 && p->ModuleOfPred == 0) {
-
+    addcl_permission_error(ap, Arity);
-    WRITE_UNLOCK(p->PRWLock);
-    ti[0] = MkAtomTerm(AbsAtom(ap));
-    ti[1] = MkIntegerTerm(Arity);
-    t = MkApplTerm(MkFunctor(LookupAtom("/"),2), 2, ti);
-    ErrorMessage = ErrorSay;
-    Error_Term = t;
-    Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
-#ifdef HAVE_SNPRINTF
-    if (Arity == 0)
-      snprintf(ErrorMessage, 256, "system predicate %s", ap->StrOfAE);
-    else
-      snprintf(ErrorMessage, 256,
-#if SHORT_INTS
-	      "system predicate %s/%ld",
-#else
-	      "system predicate %s/%d",
-#endif
-	      ap->StrOfAE, Arity);
-#else
-    if (Arity == 0)
-      sprintf(ErrorMessage, "system predicate %s", ap->StrOfAE);
-    else
-      sprintf(ErrorMessage,
-#if SHORT_INTS
-	      "system predicate %s/%ld",
-#else
-	      "system predicate %s/%d",
-#endif
-	      ap->StrOfAE, Arity);
-#endif
     return;
   }
   /* The only problem we have now is when we need to throw away
@@ -1183,7 +1155,7 @@ p_purge_clauses(void)
     pred = RepPredProp(PredProp(at, 0));
   } else if (IsApplTerm(t)) {
     Functor         fun = FunctorOfTerm(t);
-    pred = RepPredProp(PredPropByFunc(fun));
+    pred = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
   } else
     return (FALSE);
   WRITE_LOCK(pred->PRWLock);
@@ -1233,7 +1205,7 @@ p_setspy(void)
 
   at = FullLookupAtom("$spy");
   pred = RepPredProp(PredProp(at, 1));
-  SpyCode = CellPtr(&(pred->CodeOfPred));
+  SpyCode = pred;
   t = Deref(ARG1);
   if (IsVarTerm(t))
     return (FALSE);
@@ -1242,7 +1214,7 @@ p_setspy(void)
     pred = RepPredProp(PredProp(at, 0));
   } else if (IsApplTerm(t)) {
     Functor fun = FunctorOfTerm(t);
-    pred = RepPredProp(PredPropByFunc(fun));
+    pred = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
   } else {
     return (FALSE);
   }
@@ -1290,7 +1262,7 @@ p_rmspy(void)
     pred = RepPredProp(PredProp(at, 0));
   } else if (IsApplTerm(t)) {
     Functor fun = FunctorOfTerm(t);
-    pred = RepPredProp(PredPropByFunc(fun));
+    pred = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
   } else
     return (FALSE);
   WRITE_LOCK(pred->PRWLock);
@@ -1334,7 +1306,7 @@ p_number_of_clauses(void)
     pe = PredProp(a, 0);
   } else if (IsApplTerm(t)) {
     register Functor f = FunctorOfTerm(t);
-    pe = PredPropByFunc(f);
+    pe = PredPropByFunc(f, *CurrentModulePtr);
   } else
     return (FALSE);
   q = RepPredProp(pe)->FirstClause;
@@ -1372,7 +1344,7 @@ p_find_dynamic(void)
     pe = PredProp(a, 0);
   } else if (IsApplTerm(t)) {
     register Functor f = FunctorOfTerm(t);
-    pe = PredPropByFunc(f);
+    pe = PredPropByFunc(f, *CurrentModulePtr);
   } else
     return (FALSE);
   q = RepPredProp(pe)->FirstClause;
@@ -1427,7 +1399,7 @@ p_next_dynamic(void)
     pe = PredProp(a, 0);
   } else if (IsApplTerm(t)) {
     register Functor f = FunctorOfTerm(t);
-    pe = PredPropByFunc(f);
+    pe = PredPropByFunc(f, *CurrentModulePtr);
   } else
     return (FALSE);
   q = RepPredProp(pe)->FirstClause;
@@ -1462,7 +1434,7 @@ p_in_use(void)
     pe = RepPredProp(PredProp(at, 0));
   } else if (IsApplTerm(t)) {
     Functor         fun = FunctorOfTerm(t);
-    pe = RepPredProp(PredPropByFunc(fun));
+    pe = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
   } else
     return (FALSE);
   READ_LOCK(pe->PRWLock);
@@ -1576,7 +1548,7 @@ p_is_dynamic(void)
     pe = RepPredProp(PredProp(at, 0));
   } else if (IsApplTerm(t)) {
     Functor         fun = FunctorOfTerm(t);
-    pe = RepPredProp(PredPropByFunc(fun));
+    pe = RepPredProp(PredPropByFunc(fun, *CurrentModulePtr));
   } else
     return (FALSE);
   if (pe == NIL)
@@ -1609,7 +1581,13 @@ p_set_pred_module(void)
   if (pe == NIL)
     return (FALSE);
   WRITE_LOCK(pe->PRWLock);
-  pe->ModuleOfPred = LookupModule(Deref(ARG2));
+  {
+    SMALLUNSGN mod = LookupModule(Deref(ARG2));
+    if (mod)
+      pe->ModuleOfPred = MkIntTerm(mod);
+    else
+      pe->ModuleOfPred = 0;
+  }
   WRITE_UNLOCK(pe->PRWLock);
   return(TRUE);
 }
@@ -1619,34 +1597,37 @@ p_undefined(void)
 {				/* '$undefined'(P)	 */
   PredEntry      *pe;
   Term            t;
+  Term tmod = *CurrentModulePtr;
 
-  SMALLUNSGN omod = CurrentModule;
   t = Deref(ARG1);
  restart_undefined:
   if (IsVarTerm(t)) {
     Error(INSTANTIATION_ERROR,ARG1,"undefined/1");
-    *CurrentModulePtr = MkIntTerm(omod);
     return(FALSE);
   }
   if (IsAtomTerm(t)) {
     Atom at = AtomOfTerm(t);
-    pe = RepPredProp(GetPredProp(at,0));
+    pe = RepPredProp(GetPredPropByAtom(at,tmod));
   } else if (IsApplTerm(t)) {
     Functor         funt = FunctorOfTerm(t);
     if (funt == FunctorModule) {
       Term mod = ArgOfTerm(1, t);
-      if (!IsVarTerm(mod) ) {
+      if (IsVarTerm(mod) ) {
-	*CurrentModulePtr = MkIntTerm(LookupModule(mod));
+	Error(INSTANTIATION_ERROR,ARG1,"undefined/1");
+	return(FALSE);
+      }
+      if (!IsAtomTerm(mod) ) {
+	Error(TYPE_ERROR_ATOM,ARG1,"undefined/1");
+	return(FALSE);
+      }
+      tmod = MkIntTerm(LookupModule(mod));
       t = ArgOfTerm(2, t);
       goto restart_undefined;
     }
-    }
+    pe = RepPredProp(GetPredPropByFunc(funt, tmod));
-    pe = RepPredProp(GetPredPropByFunc(funt));
   } else {
-    *CurrentModulePtr = MkIntTerm(omod);
     return (FALSE);
   }
-  *CurrentModulePtr = MkIntTerm(omod);
   if (pe == RepPredProp(NIL))
     return (TRUE);
   READ_LOCK(pe->PRWLock);
@@ -1679,7 +1660,7 @@ p_kill_dynamic(void)
     pe = RepPredProp(PredProp(at, 0));
   } else if (IsApplTerm(t)) {
     Functor         funt = FunctorOfTerm(t);
-    pe = RepPredProp(PredPropByFunc(funt));
+    pe = RepPredProp(PredPropByFunc(funt, *CurrentModulePtr));
   } else
     return (FALSE);
   if (pe == NIL)
@@ -1880,7 +1861,7 @@ p_search_for_static_predicate_in_use(void)
     pe = RepPredProp(PredProp(at, 0));
   }  else if (IsApplTerm(t)) {
     Functor         funt = FunctorOfTerm(ARG1);
-    pe = RepPredProp(PredPropByFunc(funt));
+    pe = RepPredProp(PredPropByFunc(funt, *CurrentModulePtr));
   } else
     return(FALSE);
   /* do nothing if we are in consult */
@@ -1949,7 +1930,7 @@ NextPred(PredEntry *pp, AtomEntry *ae)
 static Int
 check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmodule) {
   PredEntry *pp;
-  for (pp = NextPred(RepPredProp(ae->PropOfAE),ae);
+  for (pp = NextPred(RepPredProp(ae->PropsOfAE),ae);
        !EndOfPAEntr(pp);
        pp = NextPred(RepPredProp(pp->NextOfPE),ae)) {
     CODEADDR clcode, cl;
@@ -1963,7 +1944,10 @@ check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmo
 	  codeptr > pp->TrueCodeOfPred &&
 	  codeptr <= pp->TrueCodeOfPred + SizeOfBlock(pp->TrueCodeOfPred)) {
 	*parity = pp->ArityOfPE;
+	if (pp->ModuleOfPred == 0)
 	  *pmodule = pp->ModuleOfPred;
+	else
+	  *pmodule = IntOfTerm(pp->ModuleOfPred);
 	READ_UNLOCK(pp->PRWLock);
 	return(-1);
       }	      
@@ -1972,7 +1956,10 @@ check_code_in_atom(AtomEntry *ae, CODEADDR codeptr, Int *parity, SMALLUNSGN *pmo
 	if (codeptr > cl && codeptr <= cl + SizeOfBlock(cl)) {
 	  /* we found it */
 	  *parity = pp->ArityOfPE;
+	  if (pp->ModuleOfPred == 0)
 	    *pmodule = pp->ModuleOfPred;
+	  else
+	    *pmodule = IntOfTerm(pp->ModuleOfPred);
 	  READ_UNLOCK(pp->PRWLock);
 	  return(i);
 	}
@@ -2137,6 +2124,40 @@ p_parent_pred(void)
 	 unify(ARG3, MkIntTerm(arity)));
 }
 
+static Int			/* $parent_pred(Module, Name, Arity) */
+p_system_pred(void)
+{
+  PredEntry      *pe;
+  Term mod       = *CurrentModulePtr;
+
+  Term t1 = Deref(ARG1);
+ restart:
+  if (IsVarTerm(t1))
+    return (FALSE);
+  if (IsAtomTerm(t1)) {
+    pe = RepPredProp(PredPropByAtom(AtomOfTerm(t1), mod));
+  } else if (IsApplTerm(t1)) {
+    Functor         funt = FunctorOfTerm(t1);
+    if (funt == FunctorModule) {
+      Term nmod = ArgOfTerm(1, t1);
+      if (IsVarTerm(nmod)) {
+	Error(INSTANTIATION_ERROR,ARG1,"system_predicate/1");
+	return(FALSE);
+      } 
+      if (!IsAtomTerm(nmod)) {
+	Error(TYPE_ERROR_ATOM,ARG1,"system_predicate/1");
+	return(FALSE);
+      }
+      mod = MkIntTerm(LookupModule(nmod));
+      t1 = ArgOfTerm(2, t1);
+      goto restart;
+    }
+    pe = RepPredProp(PredPropByFunc(funt, mod));
+  } else
+    return (FALSE);
+  return(pe->ModuleOfPred == 0);
+}
+
 void 
 InitCdMgr(void)
 {
@@ -2157,7 +2178,7 @@ InitCdMgr(void)
   InitCPred("$number_of_clauses", 2, p_number_of_clauses, SafePredFlag|SyncPredFlag);
   InitCPred("$find_dynamic", 3, p_find_dynamic, SafePredFlag|SyncPredFlag);
   InitCPred("$next_dynamic", 3, p_next_dynamic, SafePredFlag|SyncPredFlag);
-  InitCPred("$undefined", 1, p_undefined, SafePredFlag);
+  InitCPred("$undefined", 1, p_undefined, SafePredFlag|TestPredFlag);
   InitCPred("$optimizer_on", 0, p_optimizer_on, SafePredFlag|SyncPredFlag);
   InitCPred("$clean_up_dead_clauses", 0, p_clean_up_dead_clauses, SyncPredFlag);
   InitCPred("$optimizer_off", 0, p_optimizer_off, SafePredFlag|SyncPredFlag);
@@ -2174,4 +2195,6 @@ InitCdMgr(void)
   InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag);
   InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
   InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
+  InitCPred("$system_predicate", 1, p_system_pred, SafePredFlag);
 }
+

C/compiler.c

@@ -1095,7 +1095,7 @@ c_functor(Term Goal)
     c_var(t3,f_flag,(unsigned int)_functor);
   } else {
     Functor f = FunctorOfTerm(Goal);
-    Prop p0 = PredPropByFunc(f);
+    Prop p0 = PredPropByFunc(f, *CurrentModulePtr);
     if (profiling)
       emit(enter_profiling_op, (CELL)RepPredProp(p0), Zero);
     c_args(Goal);
@@ -1260,7 +1260,7 @@ c_goal(Term Goal)
   }
   else {
     f = FunctorOfTerm(Goal);
-    p = RepPredProp(p0 = PredPropByFunc(f));
+    p = RepPredProp(p0 = PredPropByFunc(f, *CurrentModulePtr));
     if (f == FunctorOr) {
       CELL l = ++labelno;
       CELL m = ++labelno;
@@ -1451,8 +1451,7 @@ c_goal(Term Goal)
       c_goal(ArgOfTerm(2, Goal));
       *CurrentModulePtr = MkIntTerm(save_CurrentModule);
       return;
-    }
+    } else if (f == FunctorEq) {
-    else if (f == FunctorEq) {
       if (profiling)
 	emit(enter_profiling_op, (CELL)p, Zero);
       c_eq(ArgOfTerm(1, Goal), ArgOfTerm(2, Goal));
@@ -2855,7 +2854,7 @@ cclause(Term inp_clause, int NOfArgs)
       Atom ap = AtomOfTerm(head);
       CurrentPred = RepPredProp(PredProp(ap, 0));
     } else {
-      CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head)));
+      CurrentPred = RepPredProp(PredPropByFunc(FunctorOfTerm(head),*CurrentModulePtr));
     }
     /* insert extra instructions to count calls */
     READ_LOCK(CurrentPred->PRWLock);

C/computils.c

@@ -82,9 +82,9 @@ is_a_test_pred (Term arg)
   else if (IsApplTerm (arg))
     {
       Functor f = FunctorOfTerm (arg);
-      if (RepPredProp (PredPropByFunc (f)) == NULL)
+      if (RepPredProp (PredPropByFunc (f, *CurrentModulePtr)) == NULL)
 	return (FALSE);
-      return (RepPredProp (PredPropByFunc (f))->PredFlags & TestPredFlag);
+      return (RepPredProp (PredPropByFunc (f, *CurrentModulePtr))->PredFlags & TestPredFlag);
     }
   else
     return (FALSE);
@@ -297,22 +297,36 @@ ShowOp (f)
 	    {
 	      PredEntry *p = RepPredProp ((Prop) arg);
 	      Functor f = p->FunctorOfPred;
-	      plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0);
+	      UInt arity = p->ArityOfPE;
+	      SMALLUNSGN mod = 0;
+
+	      if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
+	      plwrite (ModuleName[mod], DebugPutc, 0);
 	      DebugPutc (c_output_stream,':');
+	      if (arity == 0)
+		plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
+	      else
 		plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
 	      DebugPutc (c_output_stream,'/');
-	      plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0);
+	      plwrite (MkIntTerm (arity), DebugPutc, 0);
 	    }
 	    break;
 	  case 'P':
 	    {
 	      PredEntry *p = RepPredProp((Prop) rn);
 	      Functor f = p->FunctorOfPred;
-	      plwrite (ModuleName[p->ModuleOfPred], DebugPutc, 0);
+	      UInt arity = p->ArityOfPE;
+	      SMALLUNSGN mod = 0;
+
+	      if (p->ModuleOfPred) mod = IntOfTerm(p->ModuleOfPred);
+	      plwrite (ModuleName[mod], DebugPutc, 0);
 	      DebugPutc (c_output_stream,':');
+	      if (arity == 0)
+		plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
+	      else
 		plwrite (MkAtomTerm (NameOfFunctor (f)), DebugPutc, 0);
 	      DebugPutc (c_output_stream,'/');
-	      plwrite (MkIntTerm (ArityOfFunctor (f)), DebugPutc, 0);
+	      plwrite (MkIntTerm (arity), DebugPutc, 0);
 	    }
 	    break;
 	  case 'f':

C/corout.c

@@ -1159,7 +1159,7 @@ void InitCoroutPreds(void)
 #endif /* FIXED_STACKS */
   at = LookupAtom("$wake_up_goal");
   pred = RepPredProp(PredProp(at, 2));
-  WakeUpCode = (CELL *) & (pred->CodeOfPred);
+  WakeUpCode = (CELL *) pred;
   InitAttVarPreds();
 #endif /* COROUTINING */
   InitCPred("$read_svar_list", 2, p_read_svar_list, SafePredFlag);

C/dbase.c

@@ -392,12 +392,12 @@ int DBTrailOverflow(void)
 
 /* get DB entry for ap/arity; */
 static Prop 
-LockedFindDBProp(AtomEntry *ae, int CodeDB, unsigned int arity)
+FindDBPropHavingLock(AtomEntry *ae, int CodeDB, unsigned int arity)
 {
   Prop          p0;
   DBProp        p;
 
-  p = RepDBProp(p0 = ae->PropOfAE);
+  p = RepDBProp(p0 = ae->PropsOfAE);
   while (p0 && (((p->KindOfPE & ~0x1) != (CodeDB|DBProperty)) ||
 		(p->ArityOfDB != arity) ||
 		((CodeDB & MkCode) && p->ModuleOfDB && p->ModuleOfDB != DBModule ))) {
@@ -414,7 +414,7 @@ FindDBProp(AtomEntry *ae, int CodeDB, unsigned int arity)
   Prop out;
 
   READ_LOCK(ae->ARWLock);
-  out = LockedFindDBProp(ae, CodeDB, arity);
+  out = FindDBPropHavingLock(ae, CodeDB, arity);
   READ_UNLOCK(ae->ARWLock);
   return(out);
 }
@@ -2106,11 +2106,11 @@ FetchDBPropFromKey(Term twork, int flag, int new, char *error_mssg)
     AtomEntry *ae = RepAtom(At);
 
     WRITE_LOCK(ae->ARWLock);
-    if (EndOfPAEntr(p = RepDBProp(LockedFindDBProp(ae, flag, arity)))) {
+    if (EndOfPAEntr(p = RepDBProp(FindDBPropHavingLock(ae, flag, arity)))) {
      /* create a new DBProp				 */
       int OLD_UPDATE_MODE = UPDATE_MODE;
       if (flag & MkCode) {
-	PredEntry *pp = RepPredProp(LockedGetPredProp(At, arity));
+	PredEntry *pp = RepPredProp(GetPredPropHavingLock(At, arity));
 	if (!EndOfPAEntr(pp)) {
 	  READ_LOCK(pp->PRWLock);
 	  if(pp->PredFlags & LogUpdatePredFlag)
@@ -2146,8 +2146,8 @@ FetchDBPropFromKey(Term twork, int flag, int new, char *error_mssg)
 	p->FunctorOfDB = (Functor) At;
       else
 	p->FunctorOfDB = UnlockedMkFunctor(ae,arity);
-      p->NextOfPE = ae->PropOfAE;
+      p->NextOfPE = ae->PropsOfAE;
-      ae->PropOfAE = AbsDBProp(p);
+      ae->PropsOfAE = AbsDBProp(p);
     }
     WRITE_UNLOCK(ae->ARWLock);
     return(p);
@@ -3123,7 +3123,7 @@ MyEraseClause(Clause *clau)
       Atom name = (Atom) father->FunctorOfDB;
       pred = RepPredProp(PredProp(name, 0));
     } else {
-      pred = RepPredProp(PredPropByFunc(father->FunctorOfDB));
+      pred = RepPredProp(PredPropByFunc(father->FunctorOfDB, *CurrentModulePtr));
     }
     DBModule = father->ModuleOfDB;
     WRITE_LOCK(pred->PRWLock);
@@ -3317,7 +3317,7 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
       Atom name = (Atom) father->FunctorOfDB;
       pred = RepPredProp(PredProp(name, 0));
     } else {
-      pred = RepPredProp(PredPropByFunc(father->FunctorOfDB));
+      pred = RepPredProp(PredPropByFunc(father->FunctorOfDB, *CurrentModulePtr));
     }
     DBModule = father->ModuleOfDB;
     WRITE_LOCK(pred->PRWLock);
@@ -3598,7 +3598,7 @@ init_current_key(void)
     READ_UNLOCK(HashChain[i].AERWLock);
   }
   READ_LOCK(RepAtom(a)->ARWLock);
-  pp = NextDBProp(RepProp(RepAtom(a)->PropOfAE));
+  pp = NextDBProp(RepProp(RepAtom(a)->PropsOfAE));
   READ_UNLOCK(RepAtom(a)->ARWLock);
   EXTRA_CBACK_ARG(2,3) = MkAtomTerm(a);
   EXTRA_CBACK_ARG(2,2) = MkIntTerm(i);
@@ -3674,7 +3674,7 @@ cont_current_key(void)
       }
     }
     READ_LOCK(RepAtom(a)->ARWLock);
-    if (!EndOfPAEntr(pp = NextDBProp(RepProp(RepAtom(a)->PropOfAE))))
+    if (!EndOfPAEntr(pp = NextDBProp(RepProp(RepAtom(a)->PropsOfAE))))
       EXTRA_CBACK_ARG(2,3)  = (CELL) MkAtomTerm(a);
     READ_UNLOCK(RepAtom(a)->ARWLock);
   }

C/errors.c

@@ -107,13 +107,15 @@ DumpActiveGoals (void)
       if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag | FastPredFlag))
 	{
 	  Functor f;
+	  SMALLUNSGN mod = 0;
 
 	  f = pe->FunctorOfPred;
 	  if (pe->KindOfPE && hidden (NameOfFunctor (f)))
 	    goto next;
 	  if (first++ == 1)
 	    YP_fprintf(YP_stderr,"Active ancestors:\n");
-	  plwrite (ModuleName[pe->ModuleOfPred], DebugPutc, 0);
+	  if (pe->ModuleOfPred) mod = IntOfTerm(pe->ModuleOfPred);
+	  plwrite (ModuleName[mod], DebugPutc, 0);
 	  DebugPutc (c_output_stream,':');
 	  if (pe->ArityOfPE == 0) {
 	    plwrite (MkAtomTerm ((Atom)f), DebugPutc, 0);
@@ -161,9 +163,11 @@ DumpActiveGoals (void)
       READ_LOCK(pe->PRWLock);
       {
 	Functor f;
+	SMALLUNSGN mod = 0;
 
 	f = pe->FunctorOfPred;
-	plwrite (ModuleName[pe->ModuleOfPred], DebugPutc, 0);
+	if (pe->ModuleOfPred) mod = IntOfTerm(pe->ModuleOfPred);
+	plwrite (ModuleName[mod], DebugPutc, 0);
 	DebugPutc (c_output_stream,':');
 	if (pe->ArityOfPE == 0) {
 	  plwrite (MkAtomTerm (NameOfFunctor(f)), DebugPutc, 0);

C/exec.c

@@ -21,15 +21,22 @@ static char     SccsId[] = "@(#)cdmgr.c	1.1 05/02/98";
 #include "absmi.h"
 #include "yapio.h"
 
-
+STATIC_PROTO(Int  CallPredicate, (PredEntry *, choiceptr));
-STATIC_PROTO(Int  CallProlog, (PredEntry *, unsigned int, Int));
+STATIC_PROTO(Int  CallClause, (PredEntry *, unsigned int, Int));
 STATIC_PROTO(Int  p_save_cp, (void));
 STATIC_PROTO(Int  p_execute, (void));
 STATIC_PROTO(Int  p_execute0, (void));
 STATIC_PROTO(Int  p_at_execute, (void));
 
-static Int 
+static Term
-FastCallProlog(PredEntry *pen) {
+current_cp_as_integer(void)
+{
+  return(MkIntTerm(LCL0-(CELL *)B));
+}
+
+static inline Int
+CallPredicate(PredEntry *pen, choiceptr cut_pt) {
+  WRITE_LOCK(pen->PRWLock);
 #ifdef DEPTH_LIMIT
   if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
     if (pen->ModuleOfPred) {
@@ -44,31 +51,53 @@ FastCallProlog(PredEntry *pen) {
   if (do_low_level_trace)
     low_level_trace(enter_pred,pen,XREGS+1);
 #endif	/* LOW_LEVEL_TRACE */
-  if (pen->PredFlags & ProfiledPredFlag)
-    pen->StatisticsForPred.NOfEntries++;
   CP = P;
   P = (yamop *)(pen->CodeOfPred);
   WRITE_UNLOCK(pen->PRWLock);
   ENV = YENV;
   YENV = ASP;
-  YENV[E_CB] = (CELL) B;
+  YENV[E_CB] = (CELL) cut_pt;
-  return (Unsigned(&(pen->StateOfPred)));
+  return (TRUE);
+}
+
+inline static Int
+CallMetaCall(void) {
+  ARG2 = current_cp_as_integer(); /* p_save_cp */
+  ARG3 = ARG1;
+  WRITE_LOCK(PredMetaCall->PRWLock);
+  return (CallPredicate(PredMetaCall, B));
+}
+
+Term
+ExecuteCallMetaCall(void) {
+  Term ts[3];
+  ts[0] = ARG1;
+  ts[1] = current_cp_as_integer(); /* p_save_cp */
+  ts[2] = ARG1;
+  return(MkApplTerm(PredMetaCall->FunctorOfPred,3,ts));
 }
 
 static Int
-CallProlog(PredEntry *pen, unsigned int arity, Int position)
+CallError(yap_error_number err)
+{
+  if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+    return(CallMetaCall());
+  } else {
+    Error(err, ARG1, "call/1");
+    return(FALSE);
+  }
+}
+
+static Int 
+CallClause(PredEntry *pen, unsigned int arity, Int position)
 {
   CELL            flags;
 
-
+  if (position == -1) return(CallPredicate(pen, B));
   WRITE_LOCK(pen->PRWLock);
   flags = pen->PredFlags;
   if ((flags & (CompiledPredFlag | DynamicPredFlag)) ||
       pen->OpcodeOfPred == UNDEF_OPCODE) {
-    if (position == -1 ||
-	pen->OpcodeOfPred == UNDEF_OPCODE) {
-      return(FastCallProlog(pen));
-    } else {
     CODEADDR        q;
 #ifdef DEPTH_LIMIT
     if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
@@ -133,38 +162,12 @@ CallProlog(PredEntry *pen, unsigned int arity, Int position)
 	q = NextClause(q);
       P = NEXTOP((yamop *)(q),ld);
       WRITE_UNLOCK(pen->PRWLock);
-	return (Unsigned(&(pen->StateOfPred)));
+      return (Unsigned(pen));
-      }
-    }
-  }
-  if (flags & UserCPredFlag) {
-    Int(*p) (void) = (Int(*) (void)) pen->CodeOfPred;
-    Int out;
-    
-    WRITE_UNLOCK(pen->PRWLock);
-    save_machine_regs();
-    out = YapExecute(p);
-    restore_machine_regs();
-    return(out);
-  }
-  if (flags & CPredFlag) {
-    Int(*p) (void) = (Int(*) (void)) pen->CodeOfPred;
-    WRITE_UNLOCK(pen->PRWLock);
-    return ((*p) ());
-  } else if (flags & BasicPredFlag) {
-    if (pen->OpcodeOfPred != UNDEF_OPCODE) {
-      Int(*p) (void) = (Int(*) (void)) pen->CodeOfPred;
-      WRITE_UNLOCK(pen->PRWLock);
-      return (((*p) ()) != FALSE);
-    }
     }
+  } else {
+    Error(SYSTEM_ERROR,ARG1,"debugger tries to debug clause for builtin");    
     return (FALSE);
-}
+  }
-
-static Term
-current_cp_as_integer(void)
-{
-  return(MkIntTerm(LCL0-(CELL *)B));
 }
 
 static Int
@@ -186,89 +189,37 @@ p_save_cp(void)
   return(TRUE);
 }
 
-inline static int
-SpecialCallFunctor(Functor f) {
-  return(f == FunctorComma || f == FunctorOr || f == FunctorArrow ||
-	 f == FunctorVBar || f == FunctorNot || f == FunctorAltNot);
-}
-
-inline static Int
-CallMetaCall(void) {
-  ARG2 = current_cp_as_integer(); /* p_save_cp */
-  ARG3 = ARG1;
-  WRITE_LOCK(PredMetaCall->PRWLock);
-  return (FastCallProlog(PredMetaCall));
-}
-
 inline static Int
 EnterCreepMode(PredEntry *pen) {
-  PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy));
+  PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,*CurrentModulePtr));
   ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1);
   CreepFlag = CalculateStackGap();
   P_before_spy = P;
   WRITE_LOCK(PredSpy->PRWLock);
-  return (FastCallProlog(PredSpy));
+  return (CallPredicate(PredSpy, B));
 }
 
-static Int
+inline static Int
-p_execute(void)
+do_execute(Term t)
-{				/* '$execute'(Goal)	 */
+{
-  Term            t = Deref(ARG1);
-  Prop            pe;
-  Atom            a;
 
- restart_exec:
   if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
     return(CallMetaCall());
-  } else  if (IsVarTerm(t)) {
-    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
-      return(CallMetaCall());
-    } else {
-      Error(INSTANTIATION_ERROR,t,"call/1");    
-      return(FALSE);
   }
+  if (IsVarTerm(t)) {
+    return CallError(INSTANTIATION_ERROR);
   } else if (IsApplTerm(t)) {
     register Functor f = FunctorOfTerm(t);
-    register unsigned int    i;
     register CELL *pt;
-    unsigned int    arity;
+    PredEntry *pen;
+    unsigned int i, arity;
 
     if (IsExtensionFunctor(f)) {
-      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+      return CallError(TYPE_ERROR_CALLABLE);
-	return(CallMetaCall());
-      } else {
-	Error(TYPE_ERROR_CALLABLE,t,"call/1");    
-	return(FALSE);
     }
-    }
-    
-    if (SpecialCallFunctor(f)) {
-      return(CallMetaCall());
-    } else if (f == FunctorModule) {
-      Term mod = ArgOfTerm(1, t);
-      if (mod == ModuleName[CurrentModule]) {
-	/* we can skip this operation */
-	/* should catch most cases */
-	t = ArgOfTerm(2, t);
-	goto restart_exec;
-      } else {
-	/* I can't do better because I don't have a way of restoring the module */
-	return(CallMetaCall());
-      }
-    } else {
-      PredEntry *pen;
     arity = ArityOfFunctor(f);
-      a = NameOfFunctor(f);
     
-      if (CurrentModule)
+    pen = RepPredProp(PredPropByFunc(f, *CurrentModulePtr));
-	pe = PredPropByFunc(f);
-      else {
-	pe = GetPredPropByFunc(f);
-	if (pe == NIL) {
-	  return(CallMetaCall());
-	}
-      }
-      pen = RepPredProp(pe);
     /* You thought we would be over by now */
     /* but no meta calls require special preprocessing */
     if (pen->PredFlags & MetaPredFlag) {
@@ -282,7 +233,7 @@ p_execute(void)
        otherwise I would dereference the argument and
        might skip a svar */
     pt = RepAppl(t)+1;
-      for (i = 1; i <= arity; ++i) {
+    for (i = 1; i <= arity; i++) {
 #if SBA
       Term d0 = *pt++;
       if (d0 == 0)
@@ -293,47 +244,55 @@ p_execute(void)
       XREGS[i] = *pt++;
 #endif
     }
-      return (CallProlog(pen, arity, (Int) (-1)));
+    return (CallPredicate(pen, B));
-    }
+  } else if (IsAtomTerm(t)) { 
-  } else if (IsAtomOrIntTerm(t)) {
+    PredEntry            *pe;
-    if (IsIntTerm(t)) {
+    Atom a = AtomOfTerm(t);
-      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+
-	return (CallMetaCall());
-      } else {
-	Error(TYPE_ERROR_CALLABLE,t,"call/1");    
-	return(FALSE);
-      }
-    }    
-    a = AtomOfTerm(t);
     if (a == AtomTrue || a == AtomOtherwise || a == AtomCut)
       return(TRUE);
     else if (a == AtomFail || a == AtomFalse)
       return(FALSE);
     /* call may not define new system predicates!! */
-    if (CurrentModule)
+    pe = RepPredProp(PredPropByAtom(a, *CurrentModulePtr));
-      pe = PredProp(a, 0);
-    else {
-      pe = GetPredProp(a, 0);
-      if (pe == NIL) {
-	ARG1 = t;
-	return(CallMetaCall());
-      }
-    }
     if (yap_flags[SPY_CREEP_FLAG]) {
-      return(EnterCreepMode(RepPredProp(pe)));
+      return(EnterCreepMode(pe));
     }
-    return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
+    return (CallPredicate(pe, B));
+  } else if (IsIntTerm(t)) {
+    return CallError(TYPE_ERROR_CALLABLE);
   } else {
     /* Is Pair Term */
     return(CallMetaCall());
   }
 }
 
+static Int
+p_execute(void)
+{				/* '$execute'(Goal)	 */
+  Term            t = Deref(ARG1);
+  return(do_execute(t));
+}
+
+static Int
+p_execute_in_mod(void)
+{				/* '$execute'(Goal)	 */
+  if (ARG2 != ModuleName[CurrentModule]) {
+    /* switch modules, but do it in Prolog */
+    Term ts[2];
+
+    ts[0] = ARG2;
+    ts[1] = ARG1;
+    ARG1 = MkApplTerm(FunctorModule, 2, ts);
+  }
+  return(do_execute(Deref(ARG1)));
+}
+
 inline static Int
 CallMetaCallWithin(void)
 {
   WRITE_LOCK(PredMetaCall->PRWLock);
-  return (FastCallProlog(PredMetaCall));
+  return (CallPredicate(PredMetaCall, B));
 }
 
 /* '$execute_within'(Goal,CutPt,OrigGoal)	 */
@@ -349,29 +308,17 @@ p_execute_within(void)
   if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
     return(CallMetaCallWithin());
   } else  if (IsVarTerm(t)) {
-    if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+    return CallError(INSTANTIATION_ERROR);
-      return(CallMetaCallWithin());
-    } else {
-      Error(INSTANTIATION_ERROR,t,"call/1");    
-      return(FALSE);
-    }
   } else if (IsApplTerm(t)) {
     register Functor f = FunctorOfTerm(t);
     register unsigned int    i;
     register CELL *pt;
 
     if (IsExtensionFunctor(f)) {
-      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+      return CallError(TYPE_ERROR_CALLABLE);
-	return(CallMetaCallWithin());
-      } else {
-	Error(TYPE_ERROR_CALLABLE,t,"call/1");    
-	return(FALSE);
-      }
     }
     
-    if (SpecialCallFunctor(f)) {
+    if (f == FunctorModule) {
-      return(CallMetaCallWithin());
-    } else if (f == FunctorModule) {
       Term mod = ArgOfTerm(1, t);
       if (mod == ModuleName[CurrentModule]) {
 	/* we can skip this operation */
@@ -388,9 +335,9 @@ p_execute_within(void)
       a = NameOfFunctor(f);
 
       if (CurrentModule)
-	pe = PredPropByFunc(f);
+	pe = PredPropByFunc(f, *CurrentModulePtr);
       else {
-	pe = GetPredPropByFunc(f);
+	pe = GetPredPropByFunc(f, *CurrentModulePtr);
 	if (pe == NIL) {
 	  return(CallMetaCallWithin());
 	}
@@ -421,16 +368,11 @@ p_execute_within(void)
 	XREGS[i] = *pt++;
 #endif
       }
-      return (CallProlog(pen, arity, (Int) (-1)));
+      return (CallPredicate(pen, B));
     }
   } else if (IsAtomOrIntTerm(t)) {
     if (IsIntTerm(t)) {
-      if (yap_flags[LANGUAGE_MODE_FLAG] == 1) {
+      return CallError(TYPE_ERROR_CALLABLE);
-	return (CallMetaCallWithin());
-      } else {
-	Error(TYPE_ERROR_CALLABLE,t,"call/1");    
-	return(FALSE);
-      }
     }    
     a = AtomOfTerm(t);
     if (a == AtomTrue || a == AtomOtherwise)
@@ -447,34 +389,125 @@ p_execute_within(void)
 	  DelayedB = pt0;
       }
       /* find where to cut to */
-#ifdef YAPOR
       if (SHOULD_CUT_UP_TO(B,pt0)) {
+#ifdef YAPOR
 	/* Wow, we're gonna cut!!! */
 	CUT_prune_to(pt0);
 #else
-      if (SHOULD_CUT_UP_TO(B,pt0)) {
 	/* Wow, we're gonna cut!!! */
 	B = pt0;
 #endif /* YAPOR */
 	HB = PROTECT_FROZEN_H(B);
       }
       return(TRUE);
-    } else if (a == AtomFail || a == AtomFalse)
+    } else if (a == AtomFail || a == AtomFalse) {
       return(FALSE);
+    } else {
       /* call may not define new system predicates!! */
-    if (CurrentModule)
+      pe = PredPropByAtom(a, *CurrentModulePtr);
-      pe = PredProp(a, 0);
-    else {
-      pe = GetPredProp(a, 0);
-      if (pe == NIL) {
-	ARG1 = t;
-	return(CallMetaCallWithin());
-      }
-    }
       if (yap_flags[SPY_CREEP_FLAG]) {
 	return(EnterCreepMode(RepPredProp(pe)));
       }
-    return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
+      return (CallPredicate(RepPredProp(pe), B));
+    }
+  } else {
+    /* Is Pair Term */
+    return(CallMetaCallWithin());
+  }
+}
+
+/* '$execute_within2'(Goal)	 */
+static Int
+p_execute_within2(void)
+{ 
+  Term            t = Deref(ARG1);
+  Prop            pe;
+
+  if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
+    return(CallMetaCallWithin());
+  } else  if (IsVarTerm(t)) {
+    return CallError(INSTANTIATION_ERROR);
+  } else if (IsApplTerm(t)) {
+    register Functor f = FunctorOfTerm(t);
+
+    if (IsExtensionFunctor(f)) {
+      return CallError(TYPE_ERROR_CALLABLE);
+    }
+    
+    {
+      PredEntry *pen;
+      CELL *dest;
+      register CELL *pt;
+      register unsigned int    i;
+      unsigned int arity = ArityOfFunctor(f);
+
+      pe = PredPropByFunc(f, *CurrentModulePtr);
+      pen = RepPredProp(pe);
+      /* You thought we would be over by now */
+      /* but no meta calls require special preprocessing */
+      if (pen->PredFlags & MetaPredFlag) {
+	return(CallMetaCallWithin());
+      }
+      /* at this point check if we should enter creep mode */ 
+      if (yap_flags[SPY_CREEP_FLAG]) {
+	return(EnterCreepMode(pen));
+      }
+      /* now let us do what we wanted to do from the beginning !! */
+      /* I cannot use the standard macro here because
+	 otherwise I would dereference the argument and
+	 might skip a svar */
+      pt = RepAppl(t)+1;
+      dest = XREGS+1;
+      for (i = 0; i < arity; ++i) {
+#if SBA
+	Term d0 = *pt++;
+	if (d0 == 0)
+	  *dest++ = (CELL)(pt-1);
+	else
+	  *dest++ = d0;
+#else
+	*dest++ = *pt++;
+#endif
+      }
+      return (CallPredicate(pen, (choiceptr)(ENV[E_CB])));
+    }
+  } else if (IsAtomTerm(t)) {
+    Atom a = AtomOfTerm(t);
+    
+    if (a == AtomTrue || a == AtomOtherwise)
+      return(TRUE);
+    else if (a == AtomCut) {
+      choiceptr pt0;
+
+      pt0 = (choiceptr)(ENV[E_CB]);
+      if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {  
+	pt0 = TopB;
+	if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
+	  DelayedB = pt0;
+      }
+      /* find where to cut to */
+      if (SHOULD_CUT_UP_TO(B,pt0)) {
+#ifdef YAPOR
+	/* Wow, we're gonna cut!!! */
+	CUT_prune_to(pt0);
+#else
+	/* Wow, we're gonna cut!!! */
+	B = pt0;
+#endif /* YAPOR */
+	HB = PROTECT_FROZEN_H(B);
+      }
+      return(TRUE);
+    } else if (a == AtomFail || a == AtomFalse) {
+      return(FALSE);
+    }
+    /* call may not define new system predicates!! */
+    pe = PredPropByAtom(a, *CurrentModulePtr);
+    if (yap_flags[SPY_CREEP_FLAG]) {
+      return(EnterCreepMode(RepPredProp(pe)));
+    }
+    return (CallPredicate(RepPredProp(pe), B));
+  } else if (IsIntTerm(t)) {
+    return CallError(TYPE_ERROR_CALLABLE);
   } else {
     /* Is Pair Term */
     return(CallMetaCallWithin());
@@ -491,14 +524,7 @@ p_execute0(void)
 
   if (IsAtomTerm(t)) {
     Atom a = AtomOfTerm(t);
-    arity = 0;
+    pe = PredPropByAtom(a, *CurrentModulePtr);
-    if (CurrentModule)
-      pe = PredProp(a, arity);
-    else {
-      pe = GetPredProp(a, arity);
-      if (pe == NIL)
-	return(FALSE);
-    }
   } else if (IsApplTerm(t)) {
     register Functor f = FunctorOfTerm(t);
     register unsigned int    i;
@@ -511,30 +537,23 @@ p_execute0(void)
        otherwise I would dereference the argument and
        might skip a svar */
     pt = RepAppl(t)+1;
-    for (i = 1; i <= arity; ++i)
+    for (i = 1; i <= arity; ++i) {
 #if SBA
-      {
 	Term d0 = *pt++;
 	if (d0 == 0)
 	  XREGS[i] = (CELL)(pt-1);
 	else
 	  XREGS[i] = d0;
-      }
 #else
       XREGS[i] = *pt++;
 #endif
-    if (CurrentModule)
-      pe = PredPropByFunc(f);
-    else {
-      pe = GetPredPropByFunc(f);
-      if (pe == NIL)
-	return(FALSE);
     }
+    pe = GetPredPropByFunc(f, *CurrentModulePtr);
   } else
     return (FALSE);	/* for the moment */
   /*	N = arity; */
   /* call may not define new system predicates!! */
-  return (CallProlog(RepPredProp(pe), arity, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -545,15 +564,8 @@ p_execute_0(void)
   Atom            a;
 
   a = AtomOfTerm(t);
-  if (CurrentModule)
+  pe = PredPropByAtom(a, *CurrentModulePtr);
-    pe = PredProp(a, 0);
+  return (CallPredicate(RepPredProp(pe), B));
-  else {
-    pe = GetPredProp(a, 0);
-    if (pe == NIL)
-      return(FALSE);
-  }
-  return (CallProlog(RepPredProp(pe), 0, (Int) (-1)));
-
 }
 
 static Int
@@ -572,7 +584,7 @@ p_execute_1(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 1, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -592,7 +604,7 @@ p_execute_2(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 2, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -613,7 +625,7 @@ p_execute_3(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 3, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -635,7 +647,7 @@ p_execute_4(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 4, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -658,7 +670,7 @@ p_execute_5(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 5, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -682,7 +694,7 @@ p_execute_6(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 6, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -707,7 +719,7 @@ p_execute_7(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 7, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -733,7 +745,7 @@ p_execute_8(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 8, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -760,7 +772,7 @@ p_execute_9(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 9, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 static Int
@@ -788,7 +800,7 @@ p_execute_10(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), 10, (Int) (-1)));
+  return (CallPredicate(RepPredProp(pe), B));
 }
 
 #ifdef DEPTH_LIMIT
@@ -861,7 +873,7 @@ p_at_execute(void)
     if (pe == NIL)
       return(FALSE);
   }
-  return (CallProlog(RepPredProp(pe), arity, IntOfTerm(t2)));
+  return (CallClause(RepPredProp(pe), arity, IntOfTerm(t2)));
 }
 
 int
@@ -979,7 +991,7 @@ do_goal(CODEADDR CodeAdr, int arity, CELL *pt, int args_to_save, int top)
   HB = H;
   YENV[E_CB] = Unsigned (B);
   P = (yamop *) CodeAdr;
-  S = CellPtr (&(RepPredProp (PredProp (AtomCall, 1))->StateOfPred));	/* A1 mishaps */
+  S = CellPtr (RepPredProp (PredProp (AtomCall, 1)));	/* A1 mishaps */
   TopB = B;
 
   return(exec_absmi(top));
@@ -1012,7 +1024,7 @@ execute_goal(Term t, int nargs)
   if (IsAtomTerm(t)) {
     Atom a = AtomOfTerm(t);
     pt = NULL;
-    pe = GetPredProp(a, 0);
+    pe = PredPropByAtom(a, *CurrentModulePtr);
   } else if (IsApplTerm(t)) {
     Functor f = FunctorOfTerm(t);
 
@@ -1024,7 +1036,7 @@ execute_goal(Term t, int nargs)
        otherwise I would dereference the argument and
        might skip a svar */
     pt = RepAppl(t)+1;
-    pe = GetPredPropByFunc(f);
+    pe = GetPredPropByFunc(f, *CurrentModulePtr);
   } else {
     Error(TYPE_ERROR_CALLABLE,t,"call/1");
     return(FALSE);
@@ -1043,12 +1055,12 @@ execute_goal(Term t, int nargs)
   }
   if (IsAtomTerm(t)) {
     Atom at = AtomOfTerm(t);
-    CodeAdr = RepPredProp (PredProp (at, 0))->CodeOfPred;
+    CodeAdr = RepPredProp (PredPropByAtom(at, *CurrentModulePtr))->CodeOfPred;
     READ_UNLOCK(ppe->PRWLock);
     out = do_goal(CodeAdr, 0, pt, nargs, FALSE);
   } else {
     Functor f = FunctorOfTerm(t);
-    CodeAdr = RepPredProp (PredPropByFunc (f))->CodeOfPred;
+    CodeAdr = RepPredProp (PredPropByFunc (f, *CurrentModulePtr))->CodeOfPred;
     READ_UNLOCK(ppe->PRWLock);
     out = do_goal(CodeAdr, ArityOfFunctor(f), pt, nargs, FALSE);
   }
@@ -1172,7 +1184,7 @@ RunTopGoal(Term t)
   if (IsAtomTerm(t)) {
     Atom a = AtomOfTerm(t);
     pt = NULL;
-    pe = GetPredProp(a, 0);
+    pe = PredPropByAtom(a, *CurrentModulePtr);
     arity = 0;
   } else if (IsApplTerm(t)) {
     Functor f = FunctorOfTerm(t);
@@ -1184,7 +1196,7 @@ RunTopGoal(Term t)
     /* I cannot use the standard macro here because
        otherwise I would dereference the argument and
        might skip a svar */
-    pe = GetPredPropByFunc(f);
+    pe = GetPredPropByFunc(f, *CurrentModulePtr);
     pt = RepAppl(t)+1;
     arity = ArityOfFunctor(f); 
   } else {
@@ -1315,7 +1327,9 @@ void
 InitExecFs(void)
 {
   InitCPred("$execute", 1, p_execute, 0);
+  InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0);
   InitCPred("$execute_within", 3, p_execute_within, 0);
+  InitCPred("$execute_within", 1, p_execute_within2, 0);
   InitCPred("$execute", 2, p_at_execute, 0);
   InitCPred("$call_with_args", 1, p_execute_0, 0);
   InitCPred("$call_with_args", 2, p_execute_1, 0);

C/init.c

@@ -312,12 +312,12 @@ OpDec(int p, char *type, Atom a)
       p |= DcrrpFlag;
   }
   WRITE_LOCK(ae->ARWLock);
-  info = RepOpProp(LockedGetAProp(ae, OpProperty));
+  info = RepOpProp(GetAPropHavingLock(ae, OpProperty));
   if (EndOfPAEntr(info)) {
     info = (OpEntry *) AllocAtomSpace(sizeof(OpEntry));
     info->KindOfPE = Ord(OpProperty);
-    info->NextOfPE = RepAtom(a)->PropOfAE;
+    info->NextOfPE = RepAtom(a)->PropsOfAE;
-    RepAtom(a)->PropOfAE = AbsOpProp(info);
+    RepAtom(a)->PropsOfAE = AbsOpProp(info);
     INIT_RWLOCK(info->OpRWLock);
     WRITE_LOCK(info->OpRWLock);
     WRITE_UNLOCK(ae->ARWLock);
@@ -507,17 +507,30 @@ InitDebug(void)
   PutValue(At, MkIntTerm(10));
 }
 
-
 void 
 InitCPred(char *Name, int Arity, CPredicate code, int flags)
 {
   Atom            atom = LookupAtom(Name);
   PredEntry      *pe = RepPredProp(PredProp(atom, Arity));
+  yamop          *p_code = (yamop *)AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)NULL),sla),e));
 
   pe->PredFlags = flags | StandardPredFlag | CPredFlag;
-  pe->TrueCodeOfPred = pe->CodeOfPred = (CODEADDR) code;
+  p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
-  pe->OpcodeOfPred = opcode(_Ystop);
+  pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
-  pe->ModuleOfPred = CurrentModule;
+  if (flags & UserCPredFlag)
+    p_code->opc = pe->OpcodeOfPred = opcode(_call_usercpred);
+  else
+    p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
+  p_code->u.sla.l2 = (CELL)NIL;
+  p_code->u.sla.s = -Signed(RealEnvSize);
+  p_code->u.sla.p = (CODEADDR)pe;
+  p_code = NEXTOP(p_code,sla);
+  p_code->opc = opcode(_procceed);
+  { 
+    Term mod = CurrentModule;
+    if (mod) mod = MkIntTerm(mod);
+    pe->ModuleOfPred = mod;
+  }
   if (!(flags & UserCPredFlag)) {
     c_predicates[NUMBER_OF_CPREDS] = code;
     pe->StateOfPred = NUMBER_OF_CPREDS;
@@ -530,9 +543,17 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
 {
   Atom            atom = LookupAtom(Name);
   PredEntry      *pe = RepPredProp(PredProp(atom, Arity));
+  yamop          *p_code = (yamop *)AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)NULL),sla),e));
 
   pe->PredFlags = flags | StandardPredFlag | CPredFlag;
-  pe->CodeOfPred = (CODEADDR) code;
+  p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
+  pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
+    p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
+  p_code->u.sla.l2 = (CELL)NIL;
+  p_code->u.sla.s = -Signed(RealEnvSize);
+  p_code->u.sla.p = (CODEADDR)pe;
+  p_code = NEXTOP(p_code,sla);
+  p_code->opc = opcode(_procceed);
   c_predicates[NUMBER_OF_CPREDS] = code;
   pe->StateOfPred = NUMBER_OF_CPREDS;
   NUMBER_OF_CPREDS++;
@@ -550,14 +571,22 @@ InitAsmPred(char *Name,  int Arity, int code, CPredicate def, int flags)
   PredEntry      *pe = RepPredProp(PredProp(atom, Arity));
 	
   pe->PredFlags = flags | StandardPredFlag | (code);
-  pe->FirstClause = pe->LastClause = NIL;
   if (def != NULL) {
-    pe->CodeOfPred = pe->TrueCodeOfPred = (CODEADDR)def;
+    yamop          *p_code = (yamop *)AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)NULL),sla),e));
+
+    p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) def;
+    pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
+    p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
+    p_code->u.sla.l2 = (CELL)NIL;
+    p_code->u.sla.s = -Signed(RealEnvSize);
+    p_code->u.sla.p = (CODEADDR)pe;
+    p_code = NEXTOP(p_code,sla);
+    p_code->opc = opcode(_procceed);
     c_predicates[NUMBER_OF_CPREDS] = def;
     pe->StateOfPred = NUMBER_OF_CPREDS;
     NUMBER_OF_CPREDS++;
-    pe->OpcodeOfPred = opcode(_Ystop);
   } else {
+    pe->FirstClause = pe->LastClause = NIL;
     pe->OpcodeOfPred = opcode(_undef_p);
     pe->TrueCodeOfPred = pe->CodeOfPred =
       (CODEADDR)(&(pe->OpcodeOfPred)); 
@@ -915,6 +944,7 @@ InitCodes(void)
   heap_regs->functor_comma = MkFunctor(AtomComma, 2);
   heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
   heap_regs->functor_eq = MkFunctor(AtomEq, 2);
+  heap_regs->functor_execute_in_mod = MkFunctor(LookupAtom("$execute_in_mod"), 2);
   heap_regs->functor_g_atom = MkFunctor(LookupAtom("atom"), 1);
   heap_regs->functor_g_atomic = MkFunctor(LookupAtom("atomic"), 1);
   heap_regs->functor_g_compound = MkFunctor(LookupAtom("compound"), 1);
@@ -947,6 +977,7 @@ InitCodes(void)
 #ifdef EUROTRA
   heap_regs->term_dollar_u = MkAtomTerm(LookupAtom("$u"));
 #endif
+  heap_regs->term_prolog = MkAtomTerm(LookupAtom("prolog"));
   heap_regs->term_refound_var = MkAtomTerm(LookupAtom("$I_FOUND_THE_VARIABLE_AGAIN"));
   heap_regs->n_of_file_aliases = 0;
   heap_regs->file_aliases = NULL;
@@ -955,10 +986,10 @@ InitCodes(void)
   heap_regs->size_of_overflow  = 0;
   /* make sure no one else can use these two atoms */
   *CurrentModulePtr = MkIntTerm(1);
-  heap_regs->pred_goal_expansion = RepPredProp(PredProp(LookupAtom("goal_expansion"),3));
+  heap_regs->pred_goal_expansion = RepPredProp(PredPropByFunc(MkFunctor(LookupAtom("goal_expansion"),3),MkIntTerm(1)));
   *CurrentModulePtr = MkIntTerm(0);
   heap_regs->dead_clauses = NULL;
-  heap_regs->pred_meta_call = RepPredProp(PredProp(heap_regs->atom_meta_call,3));
+  heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(heap_regs->atom_meta_call,3),MkIntTerm(0)));
   ReleaseAtom(AtomOfTerm(heap_regs->term_refound_var));
 }
 
@@ -1005,7 +1036,7 @@ InitYaamRegs(void)
       UndefCode = NULL;
     } else {
       undefpe = RepPredProp (p);
-      UndefCode = (CELL *) & (undefpe->CodeOfPred);
+      UndefCode = undefpe;
     }
   }
   STATIC_PREDICATES_MARKED = FALSE;
@@ -1136,6 +1167,7 @@ InitStacks(int Heap,
 #else
   InitAbsmi();
 #endif
+  InitModules();
   InitCodes();
   InitOps();
   InitDebug();

C/modules.c

@@ -41,8 +41,11 @@ Module_Name(CODEADDR cap)
        predicate is a meta-call. Otherwise it will still work.
     */
     return(ModuleName[CurrentModule]);
-  else
+  else {
+    if (ap->ModuleOfPred)
+      return (ModuleName[IntOfTerm(ap->ModuleOfPred)]);
     return (ModuleName[ap->ModuleOfPred]);
+  }
 }
 
 int 
@@ -94,6 +97,13 @@ p_change_module(void)
   return (TRUE);
 }
 
+static Int
+p_module_number(void)
+{				/* $change_module(New)		 */
+  Term t = MkIntTerm(LookupModule(Deref(ARG1)));
+  return (unify(ARG2,t));
+}
+
 void 
 InitModules(void)
 {
@@ -104,4 +114,5 @@ InitModules(void)
   InitCPred("$current_module", 2, p_current_module, SafePredFlag|SyncPredFlag);
   InitCPred("$current_module", 1, p_current_module1, SafePredFlag|SyncPredFlag);
   InitCPred("$change_module", 1, p_change_module, SafePredFlag|SyncPredFlag);
+  InitCPred("$module_number", 2, p_module_number, SafePredFlag|SyncPredFlag);
 }

C/save.c

@@ -1071,6 +1071,7 @@ restore_codes(void)
   heap_regs->functor_comma = FuncAdjust(heap_regs->functor_comma);
   heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
   heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq);
+  heap_regs->functor_execute_in_mod = FuncAdjust(heap_regs->functor_execute_in_mod);
   heap_regs->functor_g_atom = FuncAdjust(heap_regs->functor_g_atom);
   heap_regs->functor_g_atomic = FuncAdjust(heap_regs->functor_g_atomic);
   heap_regs->functor_g_compound = FuncAdjust(heap_regs->functor_g_compound);
@@ -1102,6 +1103,7 @@ restore_codes(void)
 #ifdef EUROTRA
   heap_regs->term_dollar_u = AtomTermAdjust(heap_regs->term_dollar_u);
 #endif
+  heap_regs->term_prolog = AtomTermAdjust(heap_regs->term_prolog);
   heap_regs->term_refound_var = AtomTermAdjust(heap_regs->term_refound_var);
   heap_regs->file_aliases =
     (struct AliasDescS *)AddrAdjust((ADDR)heap_regs->file_aliases);
@@ -1112,15 +1114,15 @@ restore_codes(void)
   heap_regs->pred_meta_call =
     (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_meta_call);
   if (heap_regs->undef_code != NULL)
-    heap_regs->undef_code = PtoHeapCellAdjust(heap_regs->undef_code);
+    heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->undef_code));
   if (heap_regs->creep_code != NULL)
-    heap_regs->creep_code = PtoHeapCellAdjust(heap_regs->creep_code);
+    heap_regs->creep_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->creep_code));
   if (heap_regs->spy_code != NULL)
-    heap_regs->spy_code = PtoHeapCellAdjust(heap_regs->spy_code);
+    heap_regs->spy_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->spy_code));
 #ifdef COROUTINING
 #ifdef MULTI_ASSIGNMENT_VARIABLES
     if (heap_regs->wake_up_code != NULL)
-      heap_regs->wake_up_code = PtoHeapCellAdjust(heap_regs->wake_up_code);
+      heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->wake_up_code));
     heap_regs->mutable_list =
       AbsAppl(PtoGloAdjust(RepAppl(heap_regs->mutable_list)));
     heap_regs->atts_mutable_list =
@@ -1726,6 +1728,7 @@ RestoreClause(Clause *Cl)
     case _call:
     case _either:
     case _or_else:
+    case _p_execute:
 #ifdef YAPOR
     case _or_last:
 #endif
@@ -2408,7 +2411,10 @@ CleanCode(PredEntry *pp)
   CODEADDR        FirstC, LastC;
 
   /* Init takes care of the first 2 cases */
+  if (pp->ArityOfPE)
     pp->FunctorOfPred = FuncAdjust(pp->FunctorOfPred);
+  else
+    pp->FunctorOfPred = (Functor)AtomAdjust((Atom)(pp->FunctorOfPred));
   if (pp->OwnerFile)
     pp->OwnerFile = AtomAdjust(pp->OwnerFile);
   pp->OpcodeOfPred = opcode(op_from_opcode(pp->OpcodeOfPred));
@@ -2555,7 +2561,7 @@ RestoreInvisibleAtoms(void)
 #ifdef DEBUG_RESTORE2		/* useful during debug */
     YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
 #endif
-    RestoreEntries(RepProp(at->PropOfAE));
+    RestoreEntries(RepProp(at->PropsOfAE));
     atm = at->NextOfAE;
     at->NextOfAE = atm = AtomAdjust(atm);
     at = RepAtom(atm);
@@ -2646,7 +2652,7 @@ restore_heap(void)
 #ifdef DEBUG_RESTORE2			/* useful during debug */
 	YP_fprintf(errout, "Restoring %s\n", at->StrOfAE);
 #endif
-	RestoreEntries(RepProp(at->PropOfAE));
+	RestoreEntries(RepProp(at->PropsOfAE));
 	atm = at->NextOfAE = AtomAdjust(at->NextOfAE);
 	at = RepAtom(atm);
       } while (!EndOfPAEntr(at));
@@ -2680,7 +2686,7 @@ ShowAtoms()
       at = RepAtom(HashPtr->Entry);
       do {
 	YP_fprintf(YP_stderr,"Passei ao %s em %x\n", at->StrOfAE, at);
-	ShowEntries(RepProp(at->PropOfAE));
+	ShowEntries(RepProp(at->PropsOfAE));
       } while (!EndOfPAEntr(at = RepAtom(at->NextOfAE)));
     }
     HashPtr++;

C/stdpreds.c

@@ -141,7 +141,7 @@ p_flipflop(void)
 
   at = FullLookupAtom("$spy");
   pred = RepPredProp(PredProp(at, 1));
-  SpyCode = CellPtr(&(pred->CodeOfPred));
+  SpyCode = pred;
   return ((int) (FlipFlop = (1 - FlipFlop)));
 }
 
@@ -165,7 +165,7 @@ p_creep(void)
 
   at = FullLookupAtom("$creep");
   pred = RepPredProp(PredProp(at, 1));
-  CreepCode = (CELL *) & (pred->CodeOfPred);
+  CreepCode = pred;
   CreepFlag = Unsigned(LCL0)-Unsigned(H0);
   return (TRUE);
 }
@@ -192,7 +192,7 @@ FindAtom(codeToFind, arity)
       register PredEntry *pp;
       AtomEntry *ae = RepAtom(a);
       READ_LOCK(ae->ARWLock);
-      pp = RepPredProp(RepAtom(a)->PropOfAE);
+      pp = RepPredProp(RepAtom(a)->PropsOfAE);
       while (!EndOfPAEntr(pp) && ((pp->KindOfPE & 0x8000)
 				  || (pp->CodeOfPred != codeToFind)))
 	pp = RepPredProp(pp->NextOfPE);
@@ -1370,7 +1370,10 @@ cont_current_predicate(void)
     cut_fail();
   EXTRA_CBACK_ARG(2,1) = (CELL)MkIntegerTerm((Int)(pp->NextPredOfModule));
   Arity = pp->ArityOfPE;
+  if (Arity)
     name = NameOfFunctor(pp->FunctorOfPred);
+  else
+    name = (Atom)pp->FunctorOfPred;
   return (unify(ARG1,MkAtomTerm(name)) &&
 	  unify(ARG2, MkIntegerTerm(Arity)));
 }
@@ -1406,7 +1409,7 @@ cont_current_op(void)
   if (fix > 3) {
     a = AtomOfTerm(Deref(ARG3));
     READ_LOCK(RepAtom(a)->ARWLock);
-    if (EndOfPAEntr(pp = NextOp(RepOpProp(RepAtom(a)->PropOfAE)))) {
+    if (EndOfPAEntr(pp = NextOp(RepOpProp(RepAtom(a)->PropsOfAE)))) {
       READ_UNLOCK(RepAtom(a)->ARWLock);
       cut_fail();
     }
@@ -1453,13 +1456,13 @@ cont_current_op(void)
       }
       at = RepAtom(a);
       READ_LOCK(at->ARWLock);
-      pp = NextOp(RepOpProp(at->PropOfAE));
+      pp = NextOp(RepOpProp(at->PropsOfAE));
       READ_UNLOCK(at->ARWLock);
     } while (EndOfPAEntr(pp));
     fix = 0;
     EXTRA_CBACK_ARG(3,1) = (CELL) MkAtomTerm(a);
   } else {
-    pp = NextOp(RepOpProp(at->PropOfAE));
+    pp = NextOp(RepOpProp(at->PropsOfAE));
   }
   READ_LOCK(pp->OpRWLock);
   if (fix == 0 && pp->Prefix == 0)
@@ -1553,23 +1556,19 @@ p_debug()
 static Int 
 p_flags(void)
 {				/* $flags(+Functor,?OldFlags,?NewFlags) */
-  Atom            at;
-  int             arity;
   PredEntry      *pe;
   Int             newFl;
 
   Term t1 = Deref(ARG1);
   if (IsVarTerm(t1))
     return (FALSE);
-  if (IsAtomTerm(t1))
+  if (IsAtomTerm(t1)) {
-    at = AtomOfTerm(t1), arity = 0;
+    pe = RepPredProp(PredProp(AtomOfTerm(t1), 0));
-  else if (IsApplTerm(t1)) {
+  } else if (IsApplTerm(t1)) {
     Functor         funt = FunctorOfTerm(t1);
-    at = NameOfFunctor(funt);
+    pe = RepPredProp(PredPropByFunc(funt, *CurrentModulePtr));
-    arity = ArityOfFunctor(funt);
   } else
     return (FALSE);
-  pe = RepPredProp(PredProp(at, arity));
   if (EndOfPAEntr(pe))
     return (FALSE);
   WRITE_LOCK(pe->PRWLock);
@@ -1685,7 +1684,7 @@ p_unhide(void)
   }
   atom = RepAtom(AtomOfTerm(t1));
   WRITE_LOCK(atom->ARWLock);
-  if (atom->PropOfAE != NIL) {
+  if (atom->PropsOfAE != NIL) {
     Error(SYSTEM_ERROR,t1,"cannot unhide an atom in use");
     return(FALSE);
   }
@@ -1698,7 +1697,7 @@ p_unhide(void)
   }
   if (EndOfPAEntr(chain))
     return (FALSE);
-  atom->PropOfAE = chain->PropOfAE;
+  atom->PropsOfAE = chain->PropsOfAE;
   if (old == NIL)
     INVISIBLECHAIN.Entry = chain->NextOfAE;
   else

C/tracer.c

@@ -133,7 +133,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   /*  if (vsc_count < 24) return; */
   /* if (vsc_count > 500000) exit(0); */
   /* if (gc_calls < 1) return;*/
-  YP_fprintf(YP_stderr,"%lu (%d)", vsc_count, CurrentModule);
+  YP_fprintf(YP_stderr,"%lu %p (%d)", vsc_count, B, CurrentModule);
   /* check_trail_consistency(); */
   if (pred == NULL) {
     return;
@@ -145,6 +145,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   case enter_pred:
     mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
     arity = pred->ArityOfPE;
+    if (arity == 0)
+      s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
+      else
     s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
     /*    if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
 	  return;       */
@@ -165,6 +168,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
     } else {
       mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
       arity = pred->ArityOfPE;
+      if (arity == 0)
+	s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
+      else
 	s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
       /*    if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
 	    return;      */
@@ -179,6 +185,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
     } else {
       mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
       arity = pred->ArityOfPE;
+      if (arity == 0)
+	s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
+      else
 	s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
       /*    if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
 	    return;      */
@@ -188,6 +197,9 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
   case retry_pred:
     mname = RepAtom(AtomOfTerm(Module_Name((CODEADDR)pred)))->StrOfAE;
     arity = pred->ArityOfPE;
+    if (arity == 0)
+      s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
+    else
       s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
     /*    if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
 	  return;      */

C/userpreds.c

@@ -690,9 +690,9 @@ p_softfunctor()
   WRITE_LOCK(RepAtom(a)->ARWLock);
   if ((p0 = GetAProp(a, SFProperty)) == NIL) {
     pe = (SFEntry *) AllocAtomSpace(sizeof(*pe));
-    pe->NextOfPE = RepAtom(a)->PropOfAE;
+    pe->NextOfPE = RepAtom(a)->PropsOfAE;
     pe->KindOfPE = SFProperty;
-    RepAtom(a)->PropOfAE = AbsSFProp(pe);
+    RepAtom(a)->PropsOfAE = AbsSFProp(pe);
   } else
     pe = RepSFProp(p0);
   WRITE_UNLOCK(RepAtom(a)->ARWLock);

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.9 2001-10-03 13:39:14 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.10 2001-10-30 16:42:05 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -99,9 +99,9 @@ typedef struct various_codes {
 #endif
   CELL  *wake_up_code;
 #endif
-  CELL  *creep_code;
+  struct pred_entry  *creep_code;
-  CELL  *undef_code;
+  struct pred_entry  *undef_code;
-  CELL  *spy_code;
+  struct pred_entry  *spy_code;
   int   profiling;
   AtomHashEntry invisiblechain;
   OPCODE dummycode;
@@ -227,6 +227,7 @@ typedef struct various_codes {
     functor_csult,
     functor_cut_by,
     functor_eq,
+    functor_execute_in_mod,
     functor_g_atom,
     functor_g_atomic,
     functor_g_compound,
@@ -259,6 +260,7 @@ typedef struct various_codes {
 #ifdef EUROTRA
     term_dollar_u,
 #endif
+    term_prolog,
     term_refound_var;
   void *last_wtime;
   PredEntry *pred_goal_expansion;
@@ -291,6 +293,7 @@ typedef struct various_codes {
 #define  ANSWER_RESOLUTION        ((yamop *)&(heap_regs->tableanswerresolutioncode ))
 #endif /* TABLING */
 #define  FAILCODE                 ((CODEADDR)&(heap_regs->failcode       ))
+#define  FAILCODE                 ((CODEADDR)&(heap_regs->failcode       ))
 #define  TRUSTFAILCODE            ((CODEADDR)&(heap_regs->trustfailcode  ))
 #define  TRUSTFAILCODE            ((CODEADDR)&(heap_regs->trustfailcode  ))
 #define  YESCODE                  ((CODEADDR)&(heap_regs->yescode        ))
@@ -412,6 +415,7 @@ typedef struct various_codes {
 #define  FunctorCsult             heap_regs->functor_csult
 #define  FunctorCutBy             heap_regs->functor_cut_by
 #define  FunctorEq                heap_regs->functor_eq
+#define  FunctorExecuteInMod      heap_regs->functor_execute_in_mod
 #define  FunctorGAtom             heap_regs->functor_g_atom
 #define  FunctorGAtomic           heap_regs->functor_g_atomic
 #define  FunctorGCompound         heap_regs->functor_g_compound
@@ -441,6 +445,7 @@ typedef struct various_codes {
 #define  FunctorVBar              heap_regs->functor_v_bar
 #define  FunctorVar               heap_regs->functor_var
 #define  TermDollarU              heap_regs->term_dollar_u
+#define  TermProlog               heap_regs->term_prolog
 #define  TermReFoundVar           heap_regs->term_refound_var
 #define  PredGoalExpansion        heap_regs->pred_goal_expansion
 #define  PredMetaCall             heap_regs->pred_meta_call

H/YapOpcodes.h

@@ -353,5 +353,6 @@
     OPCODE(p_func2f_xx             ,xxx),
     OPCODE(p_func2f_xy             ,xyx),
     OPCODE(p_func2f_yx             ,yxx),
-    OPCODE(p_func2f_yy             ,yyx)
+    OPCODE(p_func2f_yy             ,yyx),
+    OPCODE(p_execute               ,sla)
 

H/Yapproto.h

@@ -10,7 +10,7 @@
 * File:		Yap.proto						 *
 * mods:									 *
 * comments:	Function declarations for YAP				 *
-* version:      $Id: Yapproto.h,v 1.3 2001-10-03 13:39:14 vsc Exp $	 *
+* version:      $Id: Yapproto.h,v 1.4 2001-10-30 16:42:05 vsc Exp $	 *
 *************************************************************************/
 
 /* prototype file for Yap */
@@ -36,6 +36,8 @@ Atom	STD_PROTO(LookupAtom,(char *));
 Atom	STD_PROTO(FullLookupAtom,(char *));
 void	STD_PROTO(LookupAtomWithAddress,(char *,AtomEntry *));
 Term	STD_PROTO(MkApplTerm,(Functor,unsigned int,Term *));
+Prop	STD_PROTO(NewPredPropByFunctor,(struct FunctorEntryStruct *, Term));
+Prop	STD_PROTO(NewPredPropByAtom,(struct AtomEntryStruct *, Term));
 Functor	STD_PROTO(UnlockedMkFunctor,(AtomEntry *,unsigned int));
 Functor	STD_PROTO(MkFunctor,(Atom,unsigned int));
 void	STD_PROTO(MkFunctorWithAddress,(Atom,unsigned int,FunctorEntry *));
@@ -52,10 +54,11 @@ CELL	STD_PROTO(*ArgsOfSFTerm,(Term));
 
 int	STD_PROTO(LookupModule,(Term));
 Prop	STD_PROTO(GetPredProp,(Atom,unsigned int));
-Prop	STD_PROTO(GetPredPropByFunc,(Functor));
+Prop	STD_PROTO(GetPredPropByAtom,(Atom, Term));
-Prop	STD_PROTO(LockedGetPredProp,(Atom,unsigned int));
+Prop	STD_PROTO(GetPredPropByFunc,(Functor, Term));
+Prop	STD_PROTO(GetPredPropHavingLock,(Atom,unsigned int));
 Prop	STD_PROTO(GetExpProp,(Atom,unsigned int));
-Prop	STD_PROTO(LockedGetExpProp,(AtomEntry *,unsigned int));
+Prop	STD_PROTO(GetExpPropHavingLock,(AtomEntry *,unsigned int));
 Term    STD_PROTO(Module_Name, (CODEADDR));
 
 
@@ -146,10 +149,11 @@ void	STD_PROTO(InitEval,(void));
 Int	STD_PROTO(EvFArt,(Term));
 
 /* exec.c */
+Term	STD_PROTO(ExecuteCallMetaCall,(void));
+void	STD_PROTO(InitExecFs,(void));
+int	STD_PROTO(RunTopGoal,(Term));
 Int	STD_PROTO(execute_goal,(Term, int));
 int	STD_PROTO(exec_absmi,(int));
-int	STD_PROTO(RunTopGoal,(Term));
-void	STD_PROTO(InitExecFs,(void));
 
 
 /* grow.c */

H/absmi.h

@@ -151,7 +151,7 @@ int  STD_PROTO(iequ_complex, (CELL *, CELL *,CELL *));
 
 #ifdef ANALYST
 
-static char *op_names[_std_top + 1] =
+static char *op_names[_p_execute + 1] =
 {
 #define OPCODE(OP,TYPE) #OP
 #include "YapOpcodes.h"

H/eval.h

@@ -34,7 +34,7 @@
 #ifdef LONG_MIN
 #define Int_MIN  LONG_MIN
 #else
-#define Int_MIN  (-CELL_MAX-(CELL)1)
+#define Int_MIN  (-Int_MAX-(CELL)1)
 #endif
 
 typedef union arith_ret {

changes4.3.html

@@ -16,6 +16,7 @@
 
 <h2>Yap-4.3.20:</h2>
 <ul>
+	<li>CLEANUP: don't use state of Pred.</li>
 	<li>SPEEDUP: improve predicate access by linking predicates to
 	functors.</li>
 	<li>FIXED: listing broke when current_predicate became meta.</li>

m4/Atoms.h.m4

@@ -41,7 +41,7 @@ typedef struct PropEntryStruct *Prop;
 /*		 atom structure						*/
 typedef struct AtomEntryStruct {
   Atom            NextOfAE;	/* used	to build hash chains			*/
-  Prop            PropOfAE;	/* property list for this atom			*/
+  Prop            PropsOfAE;	/* property list for this atom			*/
 #if defined(YAPOR) || defined(THREADS)
   rwlock_t        ARWLock;
 #endif

m4/Yatom.h.m4

@@ -203,12 +203,12 @@ typedef	struct pred_entry {
   Prop	NextOfPE;	/* used to chain properties	    	*/
   PropFlags	KindOfPE;	/* kind of property		    	*/
   unsigned int  ArityOfPE;	/* arity of property		    	*/
-  SMALLUNSGN	StateOfPred;	/* actual state of predicate 		*/
+  Term		ModuleOfPred;	/* module for this definition		*/
+  CELL	        PredFlags;
   CODEADDR	CodeOfPred;	/* code address		    		*/
   CODEADDR	TrueCodeOfPred;	/* if needing to spy or to lock 	*/
   Functor       FunctorOfPred;	/* functor for Predicate        	*/
   CODEADDR	FirstClause, LastClause;
-  CELL	PredFlags;
   Atom	        OwnerFile;	/* File where the predicate was defined */
   struct pred_entry *NextPredOfModule; /* next pred for same module   */
 #if defined(YAPOR) || defined(THREADS)
@@ -219,7 +219,7 @@ typedef	struct pred_entry {
 #endif /* TABLING */
   OPCODE        OpcodeOfPred;	/* undefcode, indexcode, spycode, ....  */
   profile_data  StatisticsForPred; /* enable profiling for predicate  */
-  SMALLUNSGN	ModuleOfPred;	/* module for this definition		*/
+  SMALLUNSGN	StateOfPred;	/* actual state of predicate 		*/
 } PredEntry;
 #define PEProp   ((PropFlags)(0x0000))
 
@@ -493,86 +493,52 @@ CODEADDR	STD_PROTO(PredIsIndexable,(PredEntry *));
 /* init.c */
 Atom		STD_PROTO(GetOp,(OpEntry *,int *,int));
 
-#ifdef XX_ADTDEFS_C
-#ifndef inline
-
-/* look property list of atom a for kind  */
-EXTERN inline  Prop GetAProp(a,kind)
-Atom a;
-PropFlags kind;
-{	register PropEntry  *pp = RepProp(RepAtom(a)->PropOfAE);
-	while( !EndOfPAEntr(pp) && pp->KindOfPE!=kind) pp=RepProp(pp->NextOfPE);
-	return(AbsProp(pp));
-}
-
-/* get predicate entry for ap/arity; create it if neccessary.		*/
-EXTERN inline  Prop PredProp(ap,arity)
-Atom ap;
-unsigned int arity;
-{
-    Prop p0;
-    PredEntry *p = RepPredProp(p0=RepAtom(ap)->PropOfAE);
-    while(p0 && (p->KindOfPE != 00 || p->ArityOfPE != arity ||
-    		(p->ModuleOfPred &&  p->ModuleOfPred != CurrentModule)))
-    	 p = RepPredProp(p0=p->NextOfPE);
-    if(p0) return(p0);    
-    YAPEnterCriticalSection();
-    p = (PredEntry *) AllocAtomSpace(sizeof(*p));
-    p->KindOfPE = PEProp;
-    p->ArityOfPE = arity;
-    p->FirstClause = p->LastClause = NIL;
-    p->PredFlags = 0L;
-    p->StateOfPred = 0;
-    p->OwnerFile = AtomNil;
-    p->ModuleOfPred = CurrentModule;
-    p->OpcodeOfPred = opcode(_undef_p);
-    p->StatisticsForPred.NOfEntries = 0;
-    p->StatisticsForPred.NOfHeadSuccesses = 0;
-    p->StatisticsForPred.NOfRetries = 0;
-    p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->DefaultCodeOfPred)); 
-    if (arity==0) p->FunctorOfPred = (Functor) ap;
-    else p->FunctorOfPred = MkFunctor(ap,arity);
-    p->NextOfPE = RepAtom(ap)->PropOfAE;
-    RepAtom(ap)->PropOfAE = p0 = AbsPredProp(p);
-    YAPLeaveCriticalSection();
-    return(p0);
-}
-
-EXTERN inline  Term GetValue(a)
-Atom a;
-{
-    Prop p0 = GetAProp(a,ValProperty);
-    if(p0==0) return(MkAtomTerm(AtomNil));
-    return(RepValProp(p0)->ValueOfVE);
-}
-
-
-EXTERN inline  void PutValue(a,v)
-Atom a; Term v;
-{
-    Prop p0 = GetAProp(a,ValProperty);
-    if(p0) RepValProp(p0)->ValueOfVE = v;
-    else {
-    	ValEntry *p;
-	YAPEnterCriticalSection();
-	p = (ValEntry *) AllocAtomSpace(sizeof(ValEntry));
-	p->KindOfPE = ValProperty;
-	p->ValueOfVE = v;
-	p->NextOfPE = RepAtom(a)->PropOfAE;
-	RepAtom(a)->PropOfAE = AbsValProp(p);
-	YAPLeaveCriticalSection();
-     }
-}
-
-#endif /* inline */
-#else
 /* vsc: redefined to GetAProp to avoid conflicts with Windows header files */
 Prop	STD_PROTO(GetAProp,(Atom,PropFlags));
-Prop	STD_PROTO(LockedGetAProp,(AtomEntry *,PropFlags));
+Prop	STD_PROTO(GetAPropHavingLock,(AtomEntry *,PropFlags));
 Prop	STD_PROTO(PredProp,(Atom,unsigned int));
-Prop	STD_PROTO(PredPropByFunc,(Functor));
-#endif /* ADTDEFS_C */
 
+EXTERN inline Prop
+PredPropByFunc(Functor f, Term cur_mod)
+/* get predicate entry for ap/arity; create it if neccessary.              */
+{
+  Prop p0;
+  FunctorEntry *fe = (FunctorEntry *)f;
+
+  WRITE_LOCK(fe->FRWLock);
+  p0 = fe->PropsOfFE;
+  while (p0) {
+    PredEntry *p = RepPredProp(p0);
+    if (/* p->KindOfPE != 0 || only props */
+	(p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) {
+      WRITE_UNLOCK(f->FRWLock);
+      return (p0);
+    }
+    p0 = p->NextOfPE;
+  }
+  return(NewPredPropByFunctor(fe,cur_mod));
+}
+
+EXTERN inline Prop
+PredPropByAtom(Atom at, Term cur_mod)
+/* get predicate entry for ap/arity; create it if neccessary.              */
+{
+  Prop p0;
+  AtomEntry *ae = RepAtom(at);
+
+  WRITE_LOCK(ae->ARWLock);
+  p0 = ae->PropsOfAE;
+  while (p0) {
+    PredEntry *pe = RepPredProp(p0);
+    if ( pe->KindOfPE == PEProp && 
+	 (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) {
+      WRITE_UNLOCK(ae->ARWLock);
+      return(p0);
+    }
+    p0 = pe->NextOfPE;
+  }
+  return(NewPredPropByAtom(ae,cur_mod));
+}
 
 #if defined(YAPOR) || defined(THREADS)
 void    STD_PROTO(ReleasePreAllocCodeSpace, (ADDR));

pl/arith.yap

@@ -36,11 +36,20 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
 '$c_built_in'(IN, IN).
 
 
+'$do_c_built_in'(Mod:G, Mod:GN) :- !,
+	'$do_c_built_in'(G, GN).
 '$do_c_built_in'(\+ G, OUT) :-
 	nonvar(G),
 	G = (A = B),
 	!,
 	OUT = (A \= B).
+'$do_c_built_in'(call(G), OUT) :-
+	nonvar(G),
+	G = (Mod:G1),
+	atom(Mod),
+	!,
+	'$module_number'(Mod,MNum),
+	OUT = '$execute_in_mod'(G1,MNum).
 '$do_c_built_in'(recorded(K,T,R), OUT) :-
 	nonvar(K),
 	!,
@@ -153,8 +162,7 @@ do_not_compile_expressions :- '$set_value'('$c_arith',[]).
 '$expand_expr'(/\, X, Y, O, Q, P) :- !,
 	'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
 	'$do_and'(E, '$and'(X1,Y1,O), F),
-	'$do_and'(Q, F, P),
+	'$do_and'(Q, F, P).
-	'$do_and'(Q, '$and'(X,Y,O), P).
 '$expand_expr'(\/, X, Y, O, Q, P) :- !,
 	'$preprocess_args_for_commutative'(X, Y, X1, Y1, E),
 	'$do_and'(E, '$or'(X1,Y1,O), F),

pl/boot.yap

@@ -641,13 +641,35 @@ incore(G) :- '$execute'(G).
 	'$iso_check_goal'(G,G0),
 	'$call'(G, CP,G0).
 
+
+','(A,B) :-
+	'$execute_within'(A),
+	'$execute_within'(B).
+
+';'(A,B) :-
+	( '$execute_within'(A) ;
+	  '$execute_within'(B) ).
+
+'|'(A,B) :-
+	( '$execute_within'(A) ;
+	  '$execute_within'(B) ).
+
+'->'(A,B) :-
+	( '$execute_within'(A) ->
+	  '$execute_within'(B) ).
+
+\+(A) :-
+	\+ '$execute_within'(A).
+
+not(A) :-
+	\+ '$execute_within'(A).
+
+Mod:G :- '$mod_switch'(Mod,'$execute_within'(G)).
+
 '$call'(M:_,_,G0) :- var(M), !,
 	throw(error(instantiation_error,call(G0))).
 '$call'(M:G,CP,G0) :- !,
         '$mod_switch'(M,'$call'(G,CP,G0)).
-'$call'((A,B),CP,G0) :- !,
-	'$execute_within'(A,CP,G0),
-	'$execute_within'(B,CP,G0).
 '$call'((X->Y),CP,G0) :- !,
 	(
 	    '$execute_within'(X,CP,G0)

pl/checker.yap

@@ -35,7 +35,7 @@ style_check([]).
 style_check([H|T]) :- style_check(H), style_check(T).
 
 no_style_check(V) :- var(V), !, fail.
-no_style_check(all) :- $syntax_check_mode(_,off),
+no_style_check(all) :- '$syntax_check_mode'(_,off),
 	'$syntax_check_single_var'(_,off),
 	'$syntax_check_discontiguous'(_,off),
 	'$syntax_check_multiple'(_,off).
@@ -98,10 +98,10 @@ no_style_check([H|T]) :- no_style_check(H), no_style_check(T).
 	'$sv_list'(T,L).
 	
 
-$sv_warning([],_) :- !.
+'$sv_warning'([],_) :- !.
-$sv_warning(SVs,T) :- 
+'$sv_warning'(SVs,T) :- 
 	'$xtract_head'(T,H,Name,Arity),
-	write(user_error,'[ Warning: singleton variable '),
+	write(user_error,'[ Warning: singleton variable'),
 	'$write_svs'(SVs),
 	write(user_error,' in '),
 	write(user_error,Name/Arity),
@@ -123,7 +123,7 @@ $sv_warning(SVs,T) :-
 '$xtract_head'((H,_),H1,Name,Arity) :- !,
 	'$xtract_head'(H,H1,Name,Arity).
 '$xtract_head'((H-->_),HL,Name,Arity) :- !,
-	'$xtract_head'(H,H1,Name,A1),
+	'$xtract_head'(H,_,Name,A1),
 	Arity is A1+2,
 	functor(HL,Name,Arity).
 '$xtract_head'(H,H,Name,Arity) :-
@@ -158,7 +158,7 @@ $sv_warning(SVs,T) :-
 
 '$handle_multiple'(F,A) :-
 	\+ '$first_clause_in_file'(F,A), !.
-'$handle_multiple'(F,A) :-
+'$handle_multiple'(_,_) :-
 	'$get_value'('$consulting',true), !.
 '$handle_multiple'(F,A) :-
 	'$current_module'(M),

pl/consult.yap

@@ -28,9 +28,9 @@ ensure_loaded(V) :-
 	'$find_in_path'(X,Y),
 	( open(Y,'$csult',Stream), !,
 	     ( '$loaded'(Stream) ->
-		(  $consulting_file_name(Stream,TFN),
+		(  '$consulting_file_name'(Stream,TFN),
 		    '$recorded'('$module','$module'(TFN,M,P),_) ->
-			$current_module(T), '$import'(P,M,T)
+			'$current_module'(T), '$import'(P,M,T)
 		;
 		   true
 		)
@@ -51,7 +51,7 @@ ensure_loaded(V) :-
 	     ( '$loaded'(Stream) ->
 		(  '$consulting_file_name'(Stream,TFN),
 		    '$recorded'('$module','$module'(TFN,M,P),_) ->
-			'$current_module'(T), $import(P,M,T)
+			'$current_module'(T), '$import'(P,M,T)
 		;
 		   true
 		)
@@ -158,9 +158,9 @@ reconsult(Fs) :-
 'EMACS_FILE'(F,File0) :-
 	format('''EMACS_RECONSULT''(~w).~n',[File0]),
 	'$getcwd'(OldD),
-	open(F,$csult,Stream),
+	open(F,'$csult',Stream),
 	'$find_in_path'(File0,File),
-	open(File,$csult,Stream0),
+	open(File,'$csult',Stream0),
 	'$get_value'('$consulting_file',OldF),
 	'$set_consulting_file'(Stream0),
 	H0 is heapused, T0 is cputime,
@@ -177,7 +177,7 @@ reconsult(Fs) :-
 	'$end_consult',
 	'$clear_reconsulting',
 	( LC == 0 -> prompt(_,'   |: ') ; true),
-	( '$get_value'($verbose,on) ->
+	( '$get_value'('$verbose',on) ->
 		tab(user_error,LC) ;
 	true ),	
 	H is heapused-H0, T is cputime-T0,
@@ -243,10 +243,10 @@ reconsult(Fs) :-
 	'$peek_byte'(Stream, 0'#), !, % 35 is ASCII for #
 	'$get0_line_codes'(Stream, _),
 	'$skip_unix_comments'(Stream).
-'$skip_unix_comments'(Stream).
+'$skip_unix_comments'(_).
 
 
-prolog_load_context(_, X) :-
+prolog_load_context(_, _) :-
 	'$get_value'('$consulting_file',[]), !, fail.
 prolog_load_context(directory, DirName) :- 
 	'$get_value'('$consulting_file',FileName),

pl/corout.yap

@@ -116,7 +116,7 @@ freeze(_, G) :-
 '$freeze_goal'(V,VG) :-
 	var(VG), !,
 	'$current_module'(M),
-	'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
+	'$freeze'(V, '$redo_freeze'(_Done,V,M:VG)).
 '$freeze_goal'(V,M:G) :- !,
 	'$freeze'(V, '$redo_freeze'(_Done,V,M:G)).
 '$freeze_goal'(V,G) :-
@@ -161,7 +161,7 @@ freeze(_, G) :-
 %
 dif(X, Y) :- '$can_unify'(X, Y, LVars), !,
 	LVars = [_|_],
-	'$dif_suspend_on_lvars'(LVars, '$redo_dif'(Done, X, Y)).
+	'$dif_suspend_on_lvars'(LVars, '$redo_dif'(_Done, X, Y)).
 dif(_, _).
 
 
@@ -179,8 +179,8 @@ dif(_, _).
 % we try to increase the number of suspensions; last, the two terms
 % did not unify, we are done, so we succeed and bind the Done variable.
 %
-'$redo_dif'(Done, X, Y, G) :- nonvar(Done), !.
+'$redo_dif'(Done, _, _, _) :- nonvar(Done), !.
-'$redo_dif'(Done, X, Y, G) :-
+'$redo_dif'(_, X, Y, G) :-
 	'$can_unify'(X, Y, LVars), !,
 	LVars = [_|_],
 	'$dif_suspend_on_lvars'(LVars, G).
@@ -191,7 +191,7 @@ dif(_, _).
 %
 % someone else (that is Cond had ;) did the work, do nothing
 %
-'$redo_freeze'(Done, Goal) :- nonvar(Done), !.
+'$redo_freeze'(Done, _) :- nonvar(Done), !.
 %
 % We still have some more conditions: continue the analysis.
 %
@@ -208,8 +208,8 @@ dif(_, _).
 
 %
 % eq is a combination of dif and freeze
-'$redo_eq'(Done, X, Y, Goal, G) :- nonvar(Done), !.
+'$redo_eq'(Done, _, _, _, _) :- nonvar(Done), !.
-'$redo_eq'(Done, X, Y, _, G) :-
+'$redo_eq'(_, X, Y, _, G) :-
 	'$can_unify'(X, Y, LVars),
 	LVars = [_|_], !,
 	'$dif_suspend_on_lvars'(LVars, G).
@@ -220,7 +220,7 @@ dif(_, _).
 
 %
 % ground is similar to freeze
-'$redo_ground'(Done, X, Goal) :- nonvar(Done), !.
+'$redo_ground'(Done, _, _) :- nonvar(Done), !.
 '$redo_ground'(Done, X, Goal) :-
 	'$non_ground'(X, Var), !,
 	'$freeze'(Var, '$redo_ground'(Done, X, Goal)).
@@ -313,7 +313,7 @@ when(_,Goal) :-
 	'$when'(Cond, G, Done, [], LG),
 	!,
 	'$suspend_when_goals'(LG, Done).
-'$when'(Cond, G, '$done') :-
+'$when'(_, G, '$done') :-
 	'$execute'(G).
 
 %
@@ -360,7 +360,7 @@ when(_,Goal) :-
 '$suspend_when_goals'(['$dif_suspend_on_lvars'(LVars, G)|LG], Done) :-
 	var(Done), !,
 	'$dif_suspend_on_lvars'(LVars, G),
-	'$suspend_when_goals'(Ls, Done).
+	'$suspend_when_goals'(LG, Done).
 '$suspend_when_goals'([_|_], _).
 
 %
@@ -377,7 +377,7 @@ when(_,Goal) :-
 % significant as the remaining overheads.
 %
 '$block'(Conds) :-
-	'$generate_blocking_code'(Conds, G, Code),
+	'$generate_blocking_code'(Conds, _, Code),
 	'$$compile'(Code, Code, 5), fail.
 '$block'(_).
 
@@ -397,7 +397,7 @@ when(_,Goal) :-
 %
 % find out what we are blocking on.
 %
-'$extract_head_for_block'((C1, C2), G) :- !,
+'$extract_head_for_block'((C1, _), G) :- !,
 	'$extract_head_for_block'(C1, G).
 '$extract_head_for_block'(C, G) :-
 	functor(C, Na, Ar),
@@ -528,7 +528,7 @@ frozen(V, LG) :-
 	'$process_when'(G, NG).
 '$process_when'(G, G).
 
-'$convert_frozen_goal'(V, LV, _, V, Gs) :- '$is_att_variable'(V), !.
+'$convert_frozen_goal'(V, _, _, V, _) :- '$is_att_variable'(V), !.
 '$convert_frozen_goal'('$redo_dif'(Done, X, Y), LV, Done, [X,Y|LV], dif(X,Y)).
 '$convert_frozen_goal'('$redo_freeze'(Done, FV, G), LV, Done, [FV|LV], G).
 '$convert_frozen_goal'('$redo_eq'(Done, X, Y, G), LV, Done, [X,Y|LV], G).
@@ -578,9 +578,9 @@ call_residue(Goal,Residue) :-
 	'$show_frozen'(Goal,LIV,Residue).
 
 '$purge_and_set_done_goals'([], L, L).
-'$purge_and_set_done_goals'([AttV|G0], [LVars-GS|GF], Atts) :-
+'$purge_and_set_done_goals'([AttV|G0], [_-GS|GF], Atts) :-
 	'$is_att_variable'(AttV), !,
-	attributes:convert_att_var(AttV, Gs),
+	attributes:convert_att_var(AttV, GS),
 	'$purge_and_set_done_goals'(G0, GF, Atts).
 '$purge_and_set_done_goals'(['$redo_dif'(Done, X , Y)|G0], [LVars-dif(X,Y)|GF], Atts) :-
 	var(Done),
@@ -600,15 +600,14 @@ call_residue(Goal,Residue) :-
 	var(Done), !,
 	Done = '$done',
 	'$purge_and_set_done_goals'(G0, GF, Atts).
-'$purge_and_set_done_goals'([G|G0], GF, Atts) :-
+'$purge_and_set_done_goals'([_|G0], GF, Atts) :-
-	Done = '$done',
 	'$purge_and_set_done_goals'(G0, GF, Atts).
 
 
 '$project'(true,_,_,Gs,Gs) :- !.
 '$project'(_,_,_,Gs,Gs) :-
 	'$undefined'(attributes:modules_with_attributes(_)), !.
-'$project'(G,LIV,LAV,Gs,Gs0) :-
+'$project'(_,LIV,LAV,Gs,Gs0) :-
 	attributes:modules_with_attributes(LMods),
 	(LAV = [] ->
 	  Gs = Gs0
@@ -631,24 +630,24 @@ call_residue(Goal,Residue) :-
 	'$execute'(Mod:project_attributes(LIV, LAV)), !,
 	'$all_attvars'(NLAV),
 	'$project_module'(LMods,LIV,NLAV).
-'$project_module'([Mod|LMods], LIV, LAV) :-
+'$project_module'([_|LMods], LIV, LAV) :-
 	'$project_module'(LMods,LIV,LAV).
 
-'$convert_att_vars'([], LIV, L, L).
+'$convert_att_vars'([], _, L, L).
 '$convert_att_vars'([V|LAV], LIV, NGs, NGs0) :-
 	var(V),
 	attributes:convert_att_var(V, G),
 	G \= true,
-	'$variables_in_term'(G,[],GV0),
+%	'$variables_in_term'(G,[],GV0),
         % I'm allowing goals without variables to go through
-	'$sort'(GV0,GV),
+%	'$sort'(GV0,GV),
 %	( GV0 = [] -> true ;
 %	'$sort'(LIV,NLIV), % notice that ordering changes as we introduce constraints
 %	'$vars_interset_for_constr'(GV,NLIV) ), !,
 	!,
 	'$split_goals_for_catv'(G,V,NGs,IGs),
 	'$convert_att_vars'(LAV, LIV, IGs, NGs0).
-'$convert_att_vars'([V|LAV], LIV, Gs, NGs0) :-
+'$convert_att_vars'([_|LAV], LIV, Gs, NGs0) :-
 	'$convert_att_vars'(LAV, LIV, Gs, NGs0).
 
 '$split_goals_for_catv'((G,NG),V,Gs,Gs0) :- !,
@@ -660,7 +659,7 @@ call_residue(Goal,Residue) :-
 '$vars_interset_for_constr'([V1|GV],[V2|LIV]) :-
 	V1 @< V2, !,
 	'$vars_interset_for_constr'(GV,[V2|LIV]).
-'$vars_interset_for_constr'([V1|GV],[V2|LIV]) :-
+'$vars_interset_for_constr'([V1|GV],[_|LIV]) :-
 	'$vars_interset_for_constr'([V1|GV],LIV).
 
 

pl/debug.yap

@@ -28,10 +28,8 @@
 % $suspy does most of the work
 '$suspy'(V,S) :- var(V) , !,
 	throw(error(instantiation_error,spy(V,S))).
-'$suspy'(M:S,P) :- !,
+'$suspy'((M:S),P) :- !,
-    '$current_module'(Old,M),
+    '$mod_switch'(M, '$suspy'(S,P)).
-    ('$suspy'(S,P),fail ; true), !,
-    '$change_module'(Old).
 '$suspy'([],_) :- !.
 '$suspy'([F|L],M) :- !, ( '$suspy'(F,M) ; '$suspy'(L,M) ).
 '$suspy'(F/N,M) :- !, functor(T,F,N),
@@ -46,8 +44,9 @@
 	throw(error(existence_error(procedure,A),spy(A))).
 '$suspy'(A,nospy) :- '$noclausesfor'(A), !,
 	throw(error(existence_error(procedure,A),nospy(A))).
-'$suspy'(A,M) :- current_predicate(A,T), functor(T,F,N),
+'$suspy'(A,M) :- current_predicate(A,T),
-	\+ '$undefined'(T), \+ '$system_predicate'(T),
+	\+ '$undefined'(T), \+ '$system_predicate'(T), !,
+	 functor(T,F,N),
 	'$suspy2'(M,F,N,T).
 
 '$noclausesfor'(A) :- current_predicate(A,T),
@@ -56,12 +55,12 @@
 '$noclausesfor'(_).
 
 '$suspy2'(spy,F,N,T) :- 
-	$current_module(M),
+	'$current_module'(M),
 	'$recorded'('$spy','$spy'(T,M),_), !,
 	format('[ Warning: there is already a spy point on ~w ]~n',M:F/N).
 '$suspy2'(spy,F,N,T) :- !,
 	'$warn_if_undef'(T,F,N),
-	$current_module(M),
+	'$current_module'(M),
 	'$recorda'('$spy','$spy'(T,M),_), 
 	'$set_value'('$spypoint_added', true), 
 	'$set_spy'(T),
@@ -74,7 +73,7 @@
 	'$rm_spy'(T),
 	write(user_error,'[ Spy point on '), write(user_error,F/N), write(user_error,' removed ]'),
 	nl(user_error).
-'$suspy2'(nospy,F,N,T) :-
+'$suspy2'(nospy,F,N,_) :-
 	write(user_error,'[ Warning: there is no spy-point on '),
 	write(user_error,F/N), write(user_error,' ]'), nl(user_error).
 
@@ -84,15 +83,16 @@
 '$warn_if_undef'(_,_,_).
 
 '$pred_being_spied'(G) :-
-	 $current_module(M),'$recorded'('$spy','$spy'(G,M),_),!.
+	'$current_module'(M),
+	'$recorded'('$spy','$spy'(G,M),_), !.
 
-spy L :- '$set_value'('$spypoint_added', false), fail.
+spy _ :- '$set_value'('$spypoint_added', false), fail.
 spy L :- '$suspy'(L,spy), fail.
-spy L :- '$get_value'('$spypoint_added', false), !.
+spy _ :- '$get_value'('$spypoint_added', false), !.
-spy L :- debug.
+spy _ :- debug.
 
 nospy L :- '$suspy'(L,nospy), fail.
-nospy L.
+nospy _.
 
 nospyall :- '$recorded'('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(M:F/N,nospy), fail.
 nospyall.
@@ -148,10 +148,10 @@ leash(X) :-
 	'$show_leash_bit'(WasWritten,2'0001,L,fail),
 	write(user_error,') ]'), nl(user_error).
 
-'$show_leash_bit'(Was,Bit,Code,_) :- Bit /\ Code =:= 0, !.
+'$show_leash_bit'(_,Bit,Code,_) :- Bit /\ Code =:= 0, !.
 '$show_leash_bit'(Was,_,_,Name) :- var(Was), !,
 	Was = yes, write(user_error,Name).
-'$show_leash_bit'(Was,_,_,Name) :-
+'$show_leash_bit'(_,_,_,Name) :-
 	write(user_error,','), write(user_error,Name).
 
 '$leashcode'(full,2'1111) :- !.
@@ -249,11 +249,11 @@ debugging :-
 	'$awoken_goals'(LG), !,
 	'$creep',
 	'$wake_up_goal'(G, LG).
-'$spy'([Module|G]) :-
+'$spy'([_Module|G]) :-
 %    '$format'(user_error,"$spym(~w,~w)~n",[Module,G]),
          ( '$hidden'(G)
 	 ;
-	'$parent_pred'(O,A1,A2),
+	'$parent_pred'(0,_,_),
         '$system_predicate'(G)
 	 ),
          !,
@@ -268,7 +268,7 @@ debugging :-
 	'$awoken_goals'(LG), !,
 	'$creep',
 	'$wake_up_goal'(G, LG).
-'$direct_spy'([Module|G]) :-
+'$direct_spy'([_|G]) :-
          '$hidden'(G),
          !,
 	 /* called from prolog module   */
@@ -328,7 +328,7 @@ debugging :-
 	  '$cont_creep';		/* exit				*/
 		/* we get here when we want to redo a goal		*/
 		'$set_value'(spy_cl,Cla),/* restore clause no. to try	*/
-		$current_module(_,Module),
+		'$current_module'(_,Module),
 		'$trace'(redo,G,L),	/* inform user_error		*/
 		fail			/* to backtrack to spycalls	*/
 	).
@@ -349,18 +349,18 @@ debugging :-
 '$spycalls'(Mod:G,Res) :-
 	!,
 	'$mod_switch'(Mod,'$spycalls'(G,Res)).
-'$spycalls'(repeat,Res) :-
+'$spycalls'(repeat,_) :-
 	!,
 	repeat.
-'$spycalls'(fail,Res) :-
+'$spycalls'(fail,_) :-
 	!,
 	fail.
-'$spycalls'(false,Res) :-
+'$spycalls'(false,_) :-
 	!,
 	false.
-'$spycalls'(true,Res) :-
+'$spycalls'(true,_) :-
 	!.
-'$spycalls'(otherwise,Res) :-
+'$spycalls'(otherwise,_) :-
 	!.
 '$spycalls'(\+ G,Res) :-
 	!,
@@ -476,7 +476,7 @@ debugging :-
 '$spycall_stdpred'(G) :-
 	functor(G,F,N),
 	(
-	    '$recorded'('$meta_predicate','$meta_predicate'(Mod,F,N,D),_) ->
+	    '$recorded'('$meta_predicate','$meta_predicate'(_,F,N,_),_) ->
 	    '$setflop'(1),
 	    '$creep',
 	    '$execute0'(G)
@@ -752,25 +752,25 @@ debugging :-
 	'$direct_spy'([M|'!'(CP)]),
 	% clean up any garbage left here by the debugger.
 	'$$cut_by'(CP).
-'$creep_call'('$cut_by'(X),CP) :- !,
+'$creep_call'('$cut_by'(X),_) :- !,
 	'$$cut_by'(X).
 '$creep_call'(repeat,_) :- !,
-	'$current_module'(M),
+	'$current_module'(Module),
 	'$direct_spy'([Module|repeat]).
 '$creep_call'([A|B],_) :- !,
-	'$current_module'(M),
+	'$current_module'(Module),
 	'$direct_spy'([Module|[A|B]]).
 '$creep_call'(A,CP) :-
 	'$undefined'(A), !,
 	'$creep_call_undefined'(A,CP).
-'$creep_call'(A,CP) :-
+'$creep_call'(A,_) :-
 	'$current_module'(Module),
 	'$direct_spy'([Module|A]).
 
 '$creep_call_undefined'(A,CP) :-
 	functor(A,F,N),
 	'$current_module'(M),
-	'$recorded'($import,$import(S,M,F,N),_), !,
+	'$recorded'('$import','$import'(S,M,F,N),_), !,
 	'$creep_call'(S:A,CP).
 '$creep_call_undefined'(G, _) :-
 	( \+ '$undefined'(user:unknown_predicate_handler(_,_,_)),
@@ -792,7 +792,7 @@ debugging :-
 	    true
 	),
 	'$execute'(M:Goal).
-'$creep'(G) :-
+'$creep'(_) :-
 	'$get_value'('$throw', true), !,
 	'$set_value'('$throw', false),
 	abort.
@@ -823,7 +823,7 @@ debugging :-
 		( SL = L -> write(user_error,'>') ; write(user_error,' ')),
 		write(user_error,' ('), write(user_error,L), write(user_error,') '),
 		write(user_error,P), write(user_error,': '),
-		( $current_module(Module), Module\=prolog,
+		( '$current_module'(Module), Module\=prolog,
 			Module\=user -> write(user_error,Module),write(user_error,':');
 		   true
 		),
@@ -979,7 +979,7 @@ debugging :-
 	'$deb_get_sterm_in_g'(L,G,A),
 	recorda('$debug_sub_skel',L,_),
 	nl(user_error), write(user_error,A), nl(user_error), nl(user_error).
-'$print_deb_sterm'(G) :- '$skipeol'(94).
+'$print_deb_sterm'(_) :- '$skipeol'(94).
 
 '$get_sterm_list'(L) :-
 	get0(user_input,C),

pl/depth_bound.yap

@@ -20,15 +20,15 @@
 depth_bound_call(A,D) :-
 	'$execute_under_depth_limit'(A,D).
 
-$old_depth_bound_call(A,D) :-
+'$old_depth_bound_call'(A,D) :-
 	'$check_callable'(A,A),
 	'$user_call_depth_limited'(A, D).
 
-'$user_call_depth_limited'(V,D) :- var(V), !,
+'$user_call_depth_limited'(V,_) :- var(V), !,
 	throw(error(instantiation_error,V)).
-'$user_call_depth_limited'(A,D) :- number(A), !,
+'$user_call_depth_limited'(A,_) :- number(A), !,
-	throw(error(type_error(callable,A),A,D)).
+	throw(error(type_error(callable,A),A)).
-'$user_call_depth_limited'(R,D) :- db_reference(R), !,
+'$user_call_depth_limited'(R,_) :- db_reference(R), !,
 	throw(error(type_error(callable,R),R)).
 '$user_call_depth_limited'(A,D) :-
 	'$access_yap_flags'(10,V),
@@ -100,13 +100,13 @@ $old_depth_bound_call(A,D) :-
 '$call_depth_limited'(not X,CP,D) :- !,
 	'$check_callable'(X, not X),
 	\+ '$call_depth_limited'(X,CP,D).
-'$call_depth_limited'(!,CP,_) :- $$cut_by(CP).
+'$call_depth_limited'(!,CP,_) :- '$$cut_by'(CP).
-'$call_depth_limited'(repeat,_,_) :- !, $repeat.
+'$call_depth_limited'(repeat,_,_) :- !, '$repeat'.
 '$call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
 '$call_depth_limited'(A,CP,D) :-
 	( '$undefined'(A) ->
-		functor(A,F,N), $current_module(M),
+		functor(A,F,N), '$current_module'(M),
-		( '$recorded'($import,$import(S,M,F,N),_) ->
+		( '$recorded'('$import','$import'(S,M,F,N),_) ->
 		  '$call_depth_limited'(S:A,CP,D) ;
 		  get_depth_limit(D0),
 		  '$set_depth_limit'(D),
@@ -179,13 +179,13 @@ $old_depth_bound_call(A,D) :-
 '$spied_call_depth_limited'(not X,CP,D) :- !,
 	'$check_callable'(X, not X),
 	\+ '$spied_call_depth_limited'(X,CP,D).
-'$spied_call_depth_limited'(!,CP,_) :- $$cut_by(CP).
+'$spied_call_depth_limited'(!,CP,_) :- '$$cut_by'(CP).
 '$spied_call_depth_limited'(repeat,_,_) :- !, '$repeat'.
 '$spied_call_depth_limited'([A|B],_,_) :- !, '$csult'([A|B]).
 '$spied_call_depth_limited'(A,CP,D) :-
 	( '$undefined'(A) ->
-		functor(A,F,N), $current_module(M),
+		functor(A,F,N), '$current_module'(M),
-		( '$recorded'($import,$import(S,M,F,N),_) ->
+		( '$recorded'('$import','$import'(S,M,F,N),_) ->
 		  '$spied_call_depth_limited'(S:A,CP,D) ;
 		  get_depth_limit(D0),
 		  '$set_depth_limit'(D),

pl/directives.yap

@@ -287,46 +287,6 @@ yap_flag(language,X) :-
 yap_flag(language,X) :-
 	throw(error(domain_error(flag_value,language+X),yap_flag(language,X))).
 
-'$trans_to_lang_flag'(0,cprolog).
-'$trans_to_lang_flag'(1,iso).
-'$trans_to_lang_flag'(2,sicstus).
-
-'$adjust_language'(cprolog) :-
-	'$switch_log_upd'(0),
-	'$syntax_check_mode'(_,off),
-	'$syntax_check_single_var'(_,off),
-	'$syntax_check_discontiguous'(_,off),
-	'$syntax_check_multiple'(_,off),
-	'$transl_to_on_off'(Y,off), % disable character escapes.
-	'$set_yap_flags'(12,Y),
-	'$set_yap_flags'(14,1),
-	unknown(_,error).
-'$adjust_language'(sicstus) :-
-	'$switch_log_upd'(1),
-	leash(full),
-	'$syntax_check_mode'(_,on),
-	'$syntax_check_single_var'(_,on),
-	'$syntax_check_discontiguous'(_,on),
-	'$syntax_check_multiple'(_,on),
-	'$transl_to_on_off'(X1,on),
-	'$set_yap_flags'(5,X1),
-	'$force_char_conversion',
-	'$set_yap_flags'(14,0),
-	unknown(_,error).
-'$adjust_language'(iso) :-
-	'$switch_log_upd'(2),
-	'$syntax_check_mode'(_,on),
-	'$syntax_check_single_var'(_,on),
-	'$syntax_check_discontiguous'(_,on),
-	'$syntax_check_multiple'(_,on),
-	'$set_yap_flags'(7,1),
-	fileerrors,
-	'$transl_to_on_off'(X1,on),
-	'$set_yap_flags'(5,X1),
-	'$force_char_conversion',
-	'$set_yap_flags'(14,0),
-	unknown(_,error).
-
 yap_flag(debug,X) :-
 	var(X), !,
 	('$get_value'(debug,1) ->
@@ -417,12 +377,6 @@ yap_flag(character_escapes,X) :- !,
 yap_flag(character_escapes,X) :-
 	throw(error(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X))).
 
-'$transl_to_character_escape_modes'(0,off) :- !.
-'$transl_to_character_escape_modes'(0,cprolog).
-'$transl_to_character_escape_modes'(1,on) :- !.
-'$transl_to_character_escape_modes'(1,iso).
-'$transl_to_character_escape_modes'(2,sicstus).
-
 yap_flag(update_semantics,X) :-
 	var(X), !,
 	( '$log_upd'(I) -> '$convert_upd_sem'(I,X) ).
@@ -480,9 +434,6 @@ yap_flag(user_error,OUT) :-
 yap_flag(user_error,Stream) :-
 	'$change_alias_to_stream'(user_error,Stream).
 
-'$flag_check_alias'(OUT, Alias) :-
-	stream_property(OUT,[alias(Alias)]), !.
-	
 yap_flag(debugger_print_options,OUT) :-
 	var(OUT),
 	'$recorded'('$print_options','$debugger'(OUT),_), !.
@@ -501,30 +452,6 @@ yap_flag(toplevel_print_options,Opts) :- !,
 
 :- '$recorda'('$print_options','$toplevel'([quoted(true),numbervars(true),portrayed(true)]),_).
 
-'$convert_upd_sem'(0,immediate).
-'$convert_upd_sem'(1,logical).
-'$convert_upd_sem'(2,logical_assert).
-
-'$transl_to_true_false'(0,false).
-'$transl_to_true_false'(1,true).
-
-'$transl_to_on_off'(0,off).
-'$transl_to_on_off'(1,on).
-
-'$transl_to_arity'(X1,X) :- X1 < 0, !, X = unbounded.
-'$transl_to_arity'(X,X).
-
-'$transl_to_rounding_function'(0,down).
-'$transl_to_rounding_function'(1,toward_zero).
-
-'$transl_to_trl_types'(0,chars).
-'$transl_to_trl_types'(1,codes).
-'$transl_to_trl_types'(2,atom).
-
-'$yap_flag_show_tracing'(true, _, on) :- !.
-'$yap_flag_show_tracing'(_, true, verbose) :- !.
-'$yap_flag_show_tracing'(_, _, off).
-
 yap_flag(host_type,X) :-
 	'$host_type'(X).
 
@@ -570,6 +497,79 @@ yap_flag(host_type,X) :-
 	),
 	yap_flag(V, Out).
 
+'$trans_to_lang_flag'(0,cprolog).
+'$trans_to_lang_flag'(1,iso).
+'$trans_to_lang_flag'(2,sicstus).
+
+'$adjust_language'(cprolog) :-
+	'$switch_log_upd'(0),
+	'$syntax_check_mode'(_,off),
+	'$syntax_check_single_var'(_,off),
+	'$syntax_check_discontiguous'(_,off),
+	'$syntax_check_multiple'(_,off),
+	'$transl_to_on_off'(Y,off), % disable character escapes.
+	'$set_yap_flags'(12,Y),
+	'$set_yap_flags'(14,1),
+	unknown(_,error).
+'$adjust_language'(sicstus) :-
+	'$switch_log_upd'(1),
+	leash(full),
+	'$syntax_check_mode'(_,on),
+	'$syntax_check_single_var'(_,on),
+	'$syntax_check_discontiguous'(_,on),
+	'$syntax_check_multiple'(_,on),
+	'$transl_to_on_off'(X1,on),
+	'$set_yap_flags'(5,X1),
+	'$force_char_conversion',
+	'$set_yap_flags'(14,0),
+	unknown(_,error).
+'$adjust_language'(iso) :-
+	'$switch_log_upd'(2),
+	'$syntax_check_mode'(_,on),
+	'$syntax_check_single_var'(_,on),
+	'$syntax_check_discontiguous'(_,on),
+	'$syntax_check_multiple'(_,on),
+	'$set_yap_flags'(7,1),
+	fileerrors,
+	'$transl_to_on_off'(X1,on),
+	'$set_yap_flags'(5,X1),
+	'$force_char_conversion',
+	'$set_yap_flags'(14,0),
+	unknown(_,error).
+
+'$transl_to_character_escape_modes'(0,off) :- !.
+'$transl_to_character_escape_modes'(0,cprolog).
+'$transl_to_character_escape_modes'(1,on) :- !.
+'$transl_to_character_escape_modes'(1,iso).
+'$transl_to_character_escape_modes'(2,sicstus).
+
+'$convert_upd_sem'(0,immediate).
+'$convert_upd_sem'(1,logical).
+'$convert_upd_sem'(2,logical_assert).
+
+'$transl_to_true_false'(0,false).
+'$transl_to_true_false'(1,true).
+
+'$transl_to_on_off'(0,off).
+'$transl_to_on_off'(1,on).
+
+'$transl_to_arity'(X1,X) :- X1 < 0, !, X = unbounded.
+'$transl_to_arity'(X,X).
+
+'$transl_to_rounding_function'(0,down).
+'$transl_to_rounding_function'(1,toward_zero).
+
+'$transl_to_trl_types'(0,chars).
+'$transl_to_trl_types'(1,codes).
+'$transl_to_trl_types'(2,atom).
+
+'$yap_flag_show_tracing'(true, _, on) :- !.
+'$yap_flag_show_tracing'(_, true, verbose) :- !.
+'$yap_flag_show_tracing'(_, _, off).
+
+'$flag_check_alias'(OUT, Alias) :-
+	stream_property(OUT,[alias(Alias)]), !.
+	
 current_prolog_flag(V,Out) :-
 	(var(V) ; atom(V) ), !,
 	'$show_yap_flag_opts'(V,NOut),
@@ -594,7 +594,7 @@ prolog_flag(F, Old, New) :-
 	throw(error(instantiation_error,prolog_flag(F,Old,New))).
 prolog_flag(F, Old, New) :-
 	current_prolog_flag(F, Old),
-	set_prolog_flag(F, Old).
+	set_prolog_flag(F, New).
 
 prolog_flag(F, Old) :-
 	current_prolog_flag(F, Old).

pl/errors.yap

@@ -56,7 +56,7 @@
 '$process_error'(Throw) :-
 	print_message(error,Throw).
 
-print_message(force(Severity), Msg) :- !,
+print_message(force(_Severity), Msg) :- !,
 	print(user_error,Msg).
 print_message(Severity, Msg) :-
 	\+ '$undefined'(user: portray_message(Severity, Msg)),
@@ -290,7 +290,7 @@ print_message(help,M) :-
 '$output_error_message'(system_error(Message), Where) :-
 	format(user_error,"[ SYSTEM ERROR- ~w at ~w]~n",
 	[Message,Where]).
-'$output_error_message'(type_error(T,_,Err,M), Where) :-
+'$output_error_message'(type_error(T,_,Err,M), _Where) :-
 	format(user_error,"[ TYPE ERROR- ~w: expected ~w, got ~w ]~n",
 	[T,Err,M]).
 '$output_error_message'(type_error(array,W), Where) :-

pl/grammar.yap

@@ -64,10 +64,10 @@
 '$t_body'((T->R), ToFill, Last, S, SR, (Tt->Rt)) :- !,
 	'$t_body'(T, ToFill, not_last, S, SR1, Tt),
 	'$t_body'(R, ToFill, Last, SR1, SR, Rt).
-'$t_body'((T;R), _ToFill, _Last, S, SR, (Tt;Rt)) :- !,
+'$t_body'((T;R), ToFill, _Last, S, SR, (Tt;Rt)) :- !,
 	copy_term(ToFill,OtherToFill),
-	'$t_body'(T, _, last, S, SR, Tt),
+	'$t_body'(T, OtherToFill, last, S, SR, Tt),
-	'$t_body'(R, _, last, S, SR, Rt).
+	'$t_body'(R, ToFill, last, S, SR, Rt).
 '$t_body'(M:G, ToFill, Last, S, SR, M:NG) :- !,
 	'$t_body'(G, ToFill, Last, S, SR, NG).
 '$t_body'(T, filled_in, _, S, SR, Tt) :-

pl/init.yap

@@ -20,16 +20,10 @@
 
 % These are pseudo declarations
 % so that the user will get a redefining system predicate
-G1 ; G2 :- '$execute'((G1;G2)).
-G1 | G2 :- '$execute'((G1;G2)).
-G1 -> G2 :- '$execute'((G1->G2)).
-','(G1,G2) :- '$execute'((G1,G2)).
 otherwise.
 fail :- fail.
 false :- false.
 !.
-\+ G :- \+ G.
-not(G) :- not(G).
 (:- G) :- '$execute'(G), !.
 '$$!'(CP) :- '$cut_by'(CP).
 

pl/listing.yap

@@ -86,7 +86,7 @@ portray_clause(Pred) :-
         put(","),
         '$aftercomma'(T,IO,I),
         '$write_body'(Q,I,',').
-'$write_body'((P->Q;S),I,T) :-
+'$write_body'((P->Q;S),I,_) :-
 	!,
 	nl, tab(I-2), put("("),
 	'$write_body'(P,I,'('),
@@ -95,7 +95,7 @@ portray_clause(Pred) :-
 	put(";"),
 	'$write_body'(S,I,';'),
 	tab(1), put(")").
-'$write_body'((P->Q|S),I,T) :-
+'$write_body'((P->Q|S),I,_) :-
 	!,
 	nl, tab(I-2), put("("),
 	'$write_body'(P,I,'('),
@@ -104,35 +104,28 @@ portray_clause(Pred) :-
 	put("|"),
 	'$write_body'(S,I,'|'),
 	tab(1), put(")").
-'$write_body'((P->Q),I,T) :-
+'$write_body'((P->Q),I,_) :-
 	!,
 	nl, tab(I-2), put("("),
         '$write_body'(P,I,'('),
         put("-"), put(">"),
         '$write_body'(Q,I,'->'),
         tab(1), put(")").
-'$write_body'((P;Q),I,T) :-
+'$write_body'((P;Q),I,_) :-
         !,
         nl, tab(I-2), put("("),
         '$write_body'(P,I,'('),
         put(";"),
         '$write_body'(Q,I,';'),
         tab(1), put(")").
-'$write_body'((P;Q),I,T) :-
+'$write_body'((P|Q),I,_) :-
-        !,
-        nl, tab(I-2), put("("),
-        '$write_body'(P,I,'('),
-        put(";"),
-        '$write_body'(Q,I,';'),
-        tab(1), put(")").
-'$write_body'((P|Q),I,T) :-
         !,
         nl, tab(I-2), put("("),
         '$write_body'(P,I,'('),
         put("|"),
         '$write_body'(Q,I,'|'),
         tab(1), put(")").
-'$write_body'((P|Q),I,T) :-
+'$write_body'((P|Q),I,_) :-
         !,
         nl, tab(I-2), put("("),
         '$write_body'(P,I,'('),
@@ -169,4 +162,4 @@ portray_clause(Pred) :-
 '$list_transform'([X,Y|L],M) :- X == Y, X = '$VAR'(M), !, N is M+1,
 			'$list_transform'(L,N).
 '$list_transform'('$VAR'(-1).L,M) :- !, '$list_transform'(L,M).
-'$list_transform'(X.L,M) :- '$list_transform'(L,M).
+'$list_transform'(_.L,M) :- '$list_transform'(L,M).

pl/modules.yap

@@ -41,7 +41,7 @@ use_module(File,Imports) :-
 	atom(File), !,
 	'$current_module'(M),
 	'$find_in_path'(File,X),
-	( open(X,$csult,Stream), !,
+	( open(X,'$csult',Stream), !,
 	'$consulting_file_name'(Stream,TrueFileName),
 	( '$loaded'(Stream) -> true
 	     ;
@@ -53,7 +53,7 @@ use_module(File,Imports) :-
 	 close(Stream),
 	 ( var(R) -> true; erased(R) -> true; erase(R)),
 	 ( '$recorded'('$module','$module'(TrueFileName,Mod,Publics),_) ->
-	     $use_preds(Imports,Publics,Mod,M)
+	     '$use_preds'(Imports,Publics,Mod,M)
 	 ;
 	 format(user_error,'[ use_module/2 can not find a module in file ~w]~n',File),
 	 fail
@@ -64,7 +64,7 @@ use_module(File,Imports) :-
 use_module(library(File),Imports) :- !,
 	'$current_module'(M),
 	'$find_in_path'(library(File),X),
-	( open(X,$csult,Stream), !,
+	( open(X,'$csult',Stream), !,
 	'$consulting_file_name'(Stream,TrueFileName),
 	( '$loaded'(Stream) -> true
 	     ;
@@ -76,7 +76,7 @@ use_module(library(File),Imports) :- !,
 	 close(Stream),
 	 ( var(R) -> true; erased(R) -> true; erase(R)),
 	 ( '$recorded'('$module','$module'(TrueFileName,Mod,Publics),_) ->
-	     $use_preds(Imports,Publics,Mod,M)
+	     '$use_preds'(Imports,Publics,Mod,M)
 	 ;
 	 format(user_error,'[ use_module/2 can not find a module in file ~w]~n',[File]),
 	 fail
@@ -177,7 +177,7 @@ module(N) :-
 	throw(error(instantiation_error,module(N))).
 module(N) :-
 	atom(N), !,
-	'$current_module'(Old,N),
+	'$current_module'(_,N),
 	'$get_value'('$consulting_file',F),
 	( recordzifnot('$module','$module'(N),_) -> true; true),
 	( recorded('$module','$module'(F,N,[]),_) ->
@@ -188,8 +188,8 @@ module(N) :-
 	throw(error(type_error(atom,N),module(N))).
 
 '$module_dec'(N,P) :-
-	$current_module(Old,N),
+	'$current_module'(Old,N),
-	$get_value('$consulting_file',F),
+	'$get_value'('$consulting_file',F),
 	( recordzifnot('$module','$module'(N),_) -> true; true),
 	recorda('$module','$module'(F,N,P),_),
 	( '$recorded'('$importing','$importing'(F),_) ->
@@ -201,7 +201,7 @@ module(N) :-
 '$import'([],_,_) :- !.
 '$import'([N/K|L],M,T) :-
 	integer(K), atom(N), !,
-	( $check_import(M,T,N,K) ->
+	( '$check_import'(M,T,N,K) ->
 %	    format(user_error,'[Importing ~w to ~w]~n',[M:N/K,T]),
 	     ( T = user ->
 	       recordz('$import','$import'(M,_,N,K),_)
@@ -216,17 +216,17 @@ module(N) :-
 	format(user_error,'[Illegal pred specification(~w) in module declaration for module ~w]~n',[PS,M]),
 	'$import'(L,M,T).
 
-$check_import(M,T,N,K) :-
+'$check_import'(M,T,N,K) :-
     '$recorded'('$import','$import'(M1,T0,N,K),R), T0 == T, M1 \= M, /* ZP */ !,
     format(user_error,'NAME CLASH: ~w was already imported to module ~w;~n',[M1:N/K,T]),
     format(user_error,'            Do you want to import it from ~w ? [y or n] ',M),
     repeat,
-	get0(C), $skipeol(C),
+	get0(C), '$skipeol'(C),
 	( C is "y" -> erase(R), !;
 	  C is "n" -> !, fail;
 	  write(user_error, ' Please answer with ''y'' or ''n'' '), fail
 	).
-$check_import(_,_,_,_).
+'$check_import'(_,_,_,_).
 
 % $use_preds(Imports,Publics,Mod,M)
 '$use_preds'([],_,_,_) :- !.
@@ -299,7 +299,7 @@ $check_import(_,_,_,_).
 	tell('P0:debug'),
 	write(X),nl,
 	tell(F), fail.
-'$trace_module'(X).
+'$trace_module'(_).
 
 '$trace_module'(X,Y) :- X==Y, !.
 '$trace_module'(X,Y) :-
@@ -309,7 +309,7 @@ $check_import(_,_,_,_).
 	portray_clause(X),
 	portray_clause(Y),
 	tell(F),fail.
-$trace_module(X,Y).
+'$trace_module'(_,_).
 
 %
 % calling the meta-call expansion facility and expand_goal from
@@ -338,7 +338,7 @@ $trace_module(X,Y).
 %       current module for fixing up meta-call arguments
 %       current module for predicate
 %       head variables.
-'$module_expansion'(V,call(MM:V),call(MM:V),M,MM,TM,HVars) :- var(V), !.
+'$module_expansion'(V,call(MM:V),call(MM:V),_M,MM,_TM,_) :- var(V), !.
 '$module_expansion'((A,B),(A1,B1),(AO,BO),M,MM,TM,HVars) :- !,
 	'$module_expansion'(A,A1,AO,M,MM,TM,HVars),
 	'$module_expansion'(B,B1,BO,M,MM,TM,HVars).
@@ -353,9 +353,9 @@ $trace_module(X,Y).
 '$module_expansion'(false,false,false,_,_,_,_) :- !.
 % if I don't know what the module is, I cannot do anything to the goal,
 % so I just put a call for later on.
-'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,HVars) :- var(M), !.
+'$module_expansion'(M:G,call(M:G),call(M:G),_,_,_,_) :- var(M), !.
 % if M1 is given explicitly process G within M1's context.
-'$module_expansion'(M:G,G1,GO,Mod,MM,TM,HVars) :- !,
+'$module_expansion'(M:G,G1,GO,_Mod,_MM,TM,HVars) :- !,
 	% is this imported from some other module M1?
 	( '$imported_pred'(G, M, M1) ->
 	    % continue recursively...
@@ -435,7 +435,7 @@ $trace_module(X,Y).
 %	'$recorded'('$meta_predicate','$meta_predicate'(M,F,N,D),_), !,
 	'$meta_predicate'(F,M,N,D), !,
 	'$module_u_vars'(N,D,H,UVars).
-'$module_u_vars'(H,[]).
+'$module_u_vars'(_,[]).
 
 '$module_u_vars'(0,_,_,[]) :- !.
 '$module_u_vars'(I,D,H,[Y|L]) :-
@@ -475,14 +475,14 @@ $trace_module(X,Y).
 
 % check if an argument should be expanded
 '$do_expand'(V,HVars) :- var(V), !, '$not_in_vars'(V,HVars).
-'$do_expand'(M:F,_) :- !, fail.
+'$do_expand'(_:_,_) :- !, fail.
-'$do_expand'(X,_).
+'$do_expand'(_,_).
 
-$not_in_vars(_,[]).
+'$not_in_vars'(_,[]).
-$not_in_vars(V,[X|L]) :- X\==V, $not_in_vars(V,L).
+'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
 
 current_module(Mod) :- 
-	'$recorded'($module,'$module'(Mod),_).
+	'$recorded'('$module','$module'(Mod),_).
 
 current_module(Mod,TFN) :-
 	'$recorded'('$module','$module'(TFN,Mod,_Publics),_).

pl/preds.yap

@@ -30,9 +30,8 @@ assert(V) :- var(V), !,
 	throw(error(instantiation_error,assert(V))).
 assert(C) :- '$assert'(C,last,_,assert(C)).
 
-'$assert'(V,Where,R,P) :- var(V), !,
+'$assert'(V,_,_,_) :- var(V), !,
-	'$current_module'(M),
+	throw(error(instantiation_error,assert(V))).
-	throw(error(instantiation_error,P)).
 '$assert'(M:C,Where,R,P) :- !,
 	'$mod_switch'(M,'$assert'(C,Where,R,P)).
 '$assert'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ;  H=M:C), !,
@@ -62,9 +61,8 @@ assert(C) :- '$assert'(C,last,_,assert(C)).
 	).
 
 
-'$assert_dynamic'(V,Where,R,P) :- var(V), !,
+'$assert_dynamic'(V,_,_,_) :- var(V), !,
-	'$current_module'(M),
+	throw(error(instantiation_error,assert(V))).
-	throw(error(instantiation_error,P)).
 '$assert_dynamic'(M:C,Where,R,P) :- !,
 	'$mod_switch'(M,'$assert_dynamic'(C,Where,R,P)).
 '$assert_dynamic'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ;  H=M:C), !,
@@ -103,9 +101,8 @@ assertz_static(V) :- var(V), !,
 assertz_static(C) :-
 	'$assert_static'(C,last,_,assertz_static(C)).
 
-'$assert_static'(V,Where,R,P) :- var(V), !,
+'$assert_static'(V,_,_,_) :- var(V), !,
-	'$current_module'(M),
+	throw(error(instantiation_error,assert(V))).
-	throw(error(instantiation_error,P)).
 '$assert_static'(M:C,Where,R,P) :- !,
 	'$mod_switch'(M,'$assert_static'(C,Where,R,P)).
 '$assert_static'((H:-G),Where,R,P) :- (var(H) -> throw(error(instantiation_error,P)) ;  H=M:C), !,
@@ -133,6 +130,7 @@ assertz_static(C) :-
 	'$compile_dynamic'((Head:-Body),2,CR),
          ( '$get_value'('$abol',true)
            ->
+            '$flags'(H,Fl,Fl),
 	    ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H) ; true ),
 	    ( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Fl) ; true )
           ;
@@ -152,6 +150,7 @@ assertz_static(C) :-
 	'$compile_dynamic'((Head:-Body),0,CR),
          ( '$get_value'('$abol',true)
            ->
+            '$flags'(H,Fl,Fl),
             ( Fl /\ 16'400000 =\= 0 -> '$erase_source'(H) ; true ),
 	    ( Fl /\ 16'040000 =\= 0 -> '$check_multifile_pred'(H,Fl) ; true )
           ;
@@ -248,6 +247,7 @@ clause(P,Q,R) :-
 	 ( '$is_dynamic'(P) ->
 	 	'$recordedp'(P,(P:-Q),R)
 	 ;
+	        functor(P,N,A),
 		throw(error(permission_error(access,private_procedure,N/A),
 			clause(P,Q,R)))
 	 ).
@@ -278,8 +278,8 @@ retract(C,R) :-
 	var(R),
 	'$recordedp'(H,(H:-B),R),
 	erase(R).
-retract(C,R) :-
+retract(C,_) :-
-	'$fetch_predicate_indicator_from_clause'(C, PI).
+	'$fetch_predicate_indicator_from_clause'(C, PI),
 	throw(error(permission_error(modify,static_procedure,PI),retract(C))).
 
 '$fetch_predicate_indicator_from_clause'((C :- _), Na/Ar) :- !,
@@ -305,7 +305,7 @@ retractall(T) :-
 '$erase_all_clauses_for_dynamic'(T) :-
 	'$recordedp'(T,(T :- _),R), erase(R), fail.
 '$erase_all_clauses_for_dynamic'(T) :-
-	'$recordedp'(T,C,R), fail.
+	'$recordedp'(T,_,_), fail.
 '$erase_all_clauses_for_dynamic'(_).
 
 abolish(N,A) :- var(N), !,
@@ -358,19 +358,19 @@ abolish(X) :-
 '$check_error_in_predicate_indicator'(S, Msg) :-
 	S \= _/_, !,
 	throw(error(type_error(predicate_indicator,S), Msg)).
-'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
+'$check_error_in_predicate_indicator'(Na/_, Msg) :-
 	var(Na), !,
 	throw(error(instantiation_error, Msg)).
-'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
+'$check_error_in_predicate_indicator'(Na/_, Msg) :-
 	\+ atom(Na), !,
 	throw(error(type_error(atom,Na), Msg)).
-'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
+'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
 	var(Ar), !,
 	throw(error(instantiation_error, Msg)).
-'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
+'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
 	\+ integer(Ar), !,
 	throw(error(type_error(integer,Ar), Msg)).
-'$check_error_in_predicate_indicator'(Na/Ar, Msg) :-
+'$check_error_in_predicate_indicator'(_/Ar, Msg) :-
 	Ar < 0, !,
 	throw(error(domain_error(not_less_than_zero,Ar), Msg)).
 % not yet implemented!
@@ -383,7 +383,7 @@ abolish(X) :-
 	throw(error(instantiation_error, Msg)).
 '$check_error_in_module'(M, Msg) :-
 	\+ atom(M), !,
-	throw(error(type_error(atom,Na), Msg)).
+	throw(error(type_error(atom,M), Msg)).
 
 '$old_abolish'(V) :- var(V), !,
 	'$abolish_all_old'.
@@ -422,6 +422,7 @@ abolish(X) :-
 % this code has to be here because of abolish/2
 '$abolishs'(G) :-
 	'$has_yap_or', !,
+        functor(G,A,N),
 	throw(error(permission_error(modify,static_procedure,A/N),abolish(G))).
 '$abolishs'(G) :-
 	'$purge_clauses'(G),
@@ -455,13 +456,13 @@ dynamic(X) :-
 	    F /\ 16'400 =:= 16'400, '$undefined'(T) -> F1 is F /\ \(0x600), NF is F1 \/ 16'2000, '$flags'(T,F,NF);
 	    F/\16'8 =:= 16'8 -> true ;
 	    throw(error(permission_error(modify,static_procedure,A/N),dynamic(A/N)))
-	), $flags(T,F1,F1).
+	), '$flags'(T,F1,F1).
 '$dynamic2'(X) :- 
 	throw(error(type_error(callable,X),dynamic(X))).
 
 
 '$logical_updatable'(A/N) :- integer(N), atom(A), !,
-	functor(T,A,N), $flags(T,F,F),
+	functor(T,A,N), '$flags'(T,F,F),
 	( F/\16'9bc88 =:= 0 -> NF is F \/ 16'408, '$flags'(T,F,NF);
 	    '$is_dynamic'(T)  -> true;
 	    F /\ 16'400 =:= 16'400 , '$undefined'(T) -> NF is F \/ 0x8,  '$flags'(T,F,NF);

pl/setof.yap

@@ -23,7 +23,7 @@
 
 :- op(50,xfx,same).
 
-Variable^Goal :-
+_^Goal :-
 	'$execute'(Goal).
 
 
@@ -75,11 +75,11 @@ findall(Template, Generator, Answers, SoFar) :-
 % by getting all answers
 '$collect_with_common_vars'(Ref, VarList, SoFar, Solution) :-
 	'$db_dequeue'(Ref, BDEntry), !,
-	BDEntry =  Key-Term,
+	BDEntry =  Key-_,
 	Solution = [BDEntry|Answers],
 	'$variables_in_term'(Key, _, VarList),
 	'$collect_with_common_vars'(Ref, VarList, SoFar, Answers).
-'$collect_with_common_vars'(Ref, VarList, Solution, Solution).
+'$collect_with_common_vars'(_, _, Solution, Solution).
 
 % This is the setof predicate
 
@@ -154,11 +154,11 @@ bagof(Template, Generator, Bag) :-
 '$excess_vars'(bagof(X,P,S), Y, L0, L) :- !,
 	'$variables_in_term'(X+Y, [], NY),
 	'$excess_vars'((P,S), NY, L0, L).
-'$excess_vars'(findall(X,P,S), Y, L0, L) :- !,
+'$excess_vars'(findall(_,_,S), Y, L0, L) :- !,
 	'$excess_vars'(S, Y, L0, L).
-'$excess_vars'(findall(X,P,S0,S), Y, L0, L) :- !,
+'$excess_vars'(findall(_,_,_,S), Y, L0, L) :- !,
 	'$excess_vars'(S, Y, L0, L).
-'$excess_vars'(\+G, _, L0, LF) :- !,
+'$excess_vars'(\+_, _, L0, LF) :- !,
 	L0 = LF.
 '$excess_vars'(_:G, Y, L0, LF) :- !,
 	'$excess_vars'(G, Y, L0, LF).
@@ -171,7 +171,7 @@ bagof(Template, Generator, Bag) :-
 	'$excess_vars'(T1, X, L0, L1),
 	'$recurse_for_excess_vars'(LArgs, X, L1, L).
 
-'$doesnt_include'([], X).
+'$doesnt_include'([], _).
 '$doesnt_include'([Y|L], X) :-
 	Y \== X,
 	'$doesnt_include'(L, X).

pl/sockets.yap

@@ -35,7 +35,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
 '$check_list'(V,G) :- var(V), !,
 	throw(error(instantiation_error,G)).
 '$check_list'([],_) :- !.
-'$check_list'([Opt|T],G) :- !,
+'$check_list'([_|T],G) :- !,
  	'$check_list'(T,G).
 '$check_io_opts'(T,G) :-
 	throw(error(type_error(list,T),G)).
@@ -44,13 +44,13 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
 '$select_cp_fds'([_-Fd|L], Fds0, [Fd|Fds]) :-
 	'$select_cp_fds'(L, Fds0, Fds).
 
-'$check_select_time'(V, Sec, USec, Goal) :-
+'$check_select_time'(V, _, _, Goal) :-
 	var(V), !,
-	throw(error(instantiation_error,G)).
+	throw(error(instantiation_error,Goal)).
 '$check_select_time'(off, -1, -1, _).
-'$check_select_time'(Sec0:Usec0, Sec, USec, _) :-
+'$check_select_time'(Sec0:USec0, Sec, USec, _) :-
 	Sec is Sec0,
-	Usec0 is Usec,
+	USec is USec0,
 	Sec > 0, USec > 0.
 	
 '$cp_socket_fds'([], Fds, [], Fds).
@@ -60,7 +60,7 @@ socket_select(Socks, OutSocks, TimeOut, Streams, OutStreams) :-
 	socket_accept(Socket, Client, Stream),
 	'$cp_socket_fds'(Scks, Fds, Out, StrFds).
 
-'$cp_stream_fds'([], Fds, []).
+'$cp_stream_fds'([], _, []).
 '$cp_stream_fds'([_|Strs], [[]|Fds], Out) :- !,
 	'$cp_stream_fds'(Strs, Fds, Out).
 '$cp_stream_fds'([Stream|Strs], [Stream|Fds], [Stream|Out]) :-
@@ -75,7 +75,7 @@ socket_buffering(Sock, Flag, InSize, OutSize) :-
 	'$convert_sock_buff'(OutSize, OutNumb).
 
 '$convert_sock_buff'(unbuf, 1) :- !.
-'$convert_sock_buff'(fullbuf, InNumb).
+'$convert_sock_buff'(fullbuf, _).
 
 
 

pl/strict_iso.yap

@@ -12,10 +12,10 @@
 '$iso_check_goal'((G1;G2),G0) :- !,
 	'$iso_check_a_goal'(G1,(G1;G2),G0),
 	'$iso_check_a_goal'(G2,(G1;G2),G0).
-'$iso_check_goal'((G1->G2),(G1->G2),G0) :- !,
+'$iso_check_goal'((G1->G2),G0) :- !,
 	'$iso_check_a_goal'(G1,(G1->G2),G0),
 	'$iso_check_a_goal'(G2,(G1->G2),G0).
-'$iso_check_goal'(!,G0) :- !.
+'$iso_check_goal'(!,_) :- !.
 '$iso_check_goal'((G1|G2),G0) :-
 	'$access_yap_flags'(9,1), !,
 	throw(error(domain_error(builtin_procedure,(G1|G2)), call(G0))).
@@ -30,7 +30,7 @@
 	->
 	    true
 	;
-	    throw(error(domain_error(builtin_procedure,G), G))
+	    throw(error(domain_error(builtin_procedure,G), call(G0)))
 	).
 '$iso_check_goal'(_,_).
 
@@ -55,7 +55,7 @@
 '$iso_check_a_goal'((_|_),E,G0) :-
 	'$access_yap_flags'(9,1), !,
 	throw(error(domain_error(builtin_procedure,E), call(G0))).
-'$iso_check_a_goal'((G1|G2),_,G0) :- !.
+'$iso_check_a_goal'((_|_),_,_) :- !.
 '$iso_check_a_goal'(G,_,G0) :- 
 	'$access_yap_flags'(9,1),
 	'$system_predicate'(G),
@@ -64,13 +64,13 @@
 	->
 	    true
 	;
-	    throw(error(domain_error(builtin_procedure,G), G))
+	    throw(error(domain_error(builtin_procedure,G), call(G0)))
 	).
 '$iso_check_a_goal'(_,_,_).
 
-'$check_iso_strict_clause'((G:-B)) :- !,
+'$check_iso_strict_clause'((_:-B)) :- !,
 	'$check_iso_strict_body'(B).
-'$check_iso_strict_clause'(G).
+'$check_iso_strict_clause'(_).
 
 '$check_iso_strict_body'((B1,B2)) :- !,
 	'$check_iso_strict_body'(B1),

pl/tabling.yap

@@ -21,7 +21,7 @@ table(X) :- var(X), !,
             fail.
 table((A,B)) :- !, table(A), table(B).
 table(A/N) :- integer(N), atom(A), !,
-              functor(T,A,N), $flags(T,F,F),
+              functor(T,A,N), '$flags'(T,F,F),
               (
                 X is F /\ 8'000100, X =\= 0, !,
                 write(user_error, '[ Warning: '),
@@ -29,7 +29,7 @@ table(A/N) :- integer(N), atom(A), !,
                 write(user_error, ' is already declared as table ]'),
                 nl(user_error)
               ;
-                X is F /\ 8'170000, X =:= 0, !, $table(T)
+                X is F /\ 8'170000, X =:= 0, !, '$table'(T)
               ;
                 write(user_error, '[ Error: '),
                 write(user_error, A/N),
@@ -49,9 +49,9 @@ show_trie(X) :- var(X), !,
                 nl(user_error),
                 fail.
 show_trie(A/N) :- integer(N), atom(A), !,
-                  functor(T,A,N), $flags(T,F,F),
+                  functor(T,A,N), '$flags'(T,F,F),
                   (
-                    X is F /\ 8'000100, X =\= 0, !, $show_trie(T,_)
+                    X is F /\ 8'000100, X =\= 0, !, '$show_trie'(T,_)
                   ;
                     write(user_error, '[ Error: '),
                     write(user_error, A/N),
@@ -71,9 +71,9 @@ abolish_trie(X)   :- var(X), !,
                      nl(user_error),
                      fail.
 abolish_trie(A/N) :- integer(N), atom(A), !,
-                     functor(T,A,N), $flags(T,F,F),
+                     functor(T,A,N), '$flags'(T,F,F),
                      (
-                       X is F /\ 8'000100, X =\= 0, !, $abolish_trie(T)
+                       X is F /\ 8'000100, X =\= 0, !, '$abolish_trie'(T)
                      ;
                        write(user_error, '[ Error: '),
                        write(user_error, A/N),

pl/utils.yap

@@ -17,12 +17,12 @@
 
 once(G) :- '$execute'(G), !.
 
-if(X,Y,Z) :-
+if(X,Y,_Z) :-
 	CP is '$last_choice_pt',
 	'$execute'(X),
 	'$clean_ifcp'(CP),
 	'$execute'(Y).
-if(X,Y,Z) :-
+if(_X,_Y,Z) :-
 	'$execute'(Z).
 	
 
@@ -341,6 +341,8 @@ current_atom(A) :-				% check
 current_atom(A) :-				% generate
 	'$current_atom'(A).
 
+current_predicate(A,T) :- var(T), !,		% only for the predicate
+	'$current_predicate_no_modules'(A,T).
 current_predicate(A,M:T) :-			% module specified
 	var(M), !,
 	current_module(M),
@@ -352,6 +354,8 @@ current_predicate(A,M:T) :- % module specified
 current_predicate(A,T) :-			% only for the predicate
 	'$current_predicate_no_modules'(A,T).
 
+current_predicate(F) :-	var(F), !,		% only for the predicate
+	'$current_predicate3'(F).
 current_predicate(M:F) :-			% module specified
 	var(M), !,
 	current_module(M),
@@ -364,13 +368,9 @@ current_predicate(F) :-			% only for the predicate
 	'$current_predicate3'(F).
 
 system_predicate(A,P) :-
-	'$mod_switch'(prolog,'$current_predicate_no_modules'(A,T)),
+	'$mod_switch'(prolog,'$current_predicate_no_modules'(A,P)),
 	\+ '$hidden'(A).
 
-'$system_predicate'(Pred) :-
-	'$flags'(Pred,Flags,_),
-	 Flags /\ 8'40000 =\= 0.
-
 system_predicate(P) :- '$system_predicate'(P).
 
 '$current_predicate_no_modules'(A,T) :-
@@ -402,7 +402,7 @@ statistics :-
 	'$inform_gc'(NOfGC,TotGCTime,TotGCSize),
 	'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize).
 
-'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,HpMax,TrlSpa, TrlInUse,TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize) :-
+'$statistics'(Runtime,CPUtime,Walltime,HpSpa,HpInUse,_HpMax,TrlSpa, TrlInUse,_TrlMax,StkSpa, GlobInU, LocInU,GlobMax,LocMax,NOfHO,TotHOTime,NOfSO,TotSOTime,NOfTO,TotTOTime,NOfGC,TotGCTime,TotGCSize) :-
 	TotalMemory is HpSpa+StkSpa+TrlSpa,
 	format(user_error,"memory (total)~t~d bytes~35+~n", [TotalMemory]),
 	format(user_error,"   program space~t~d bytes~35+", [HpSpa]),
@@ -573,15 +573,15 @@ predicate_property(Pred,Prop) :-
 	'$is_multifile'(N,A).
 '$predicate_property'(P,imported_from(Mod)) :-
 	functor(P,N,A),
-	'$recorded'($module,$module(_TFN,Mod,Publics),_),
+	'$recorded'('$module','$module'(_TFN,Mod,Publics),_),
-	$member(N/A,Publics).	/* defined in modules.yap */
+	'$member'(N/A,Publics).	/* defined in modules.yap */
 '$predicate_property'(P,public) :-
 	'$is_public'(P).
 '$predicate_property'(P,exported) :-
 	functor(P,N,A),
-	$current_module(M),
+	'$current_module'(M),
-	'$recorded'($module,$module(_TFN,M,Publics),_),
+	'$recorded'('$module','$module'(_TFN,M,Publics),_),
-	$member(N/A,Publics).	/* defined in modules.yap */
+	'$member'(N/A,Publics).	/* defined in modules.yap */
 
 %%% Some "dirty" predicates
 
@@ -593,8 +593,8 @@ predicate_property(Pred,Prop) :-
 '$pred_exists'(Pred) :- \+ '$undefined'(Pred).
 
 
-grow_heap(X) :- $grow_heap(X).
+grow_heap(X) :- '$grow_heap'(X).
-grow_stack(X) :- $grow_stack(X).
+grow_stack(X) :- '$grow_stack'(X).
 
 %
 % gc() expects to be called from "call". Make sure it has an
@@ -615,7 +615,7 @@ profile_data(P, Parm, Data) :- var(P), !,
 profile_data(M:P, Parm, Data) :- var(M), !,
 	throw(error(instantiation_error,profile_data(M:P, Parm, Data))).
 profile_data(M:P, Parm, Data) :- var(M), !,
-	'$mod_switch'(Mod,'$profile_data'(P, Parm, Data)).
+	'$mod_switch'(M,'$profile_data'(P, Parm, Data)).
 profile_data(P, Parm, Data) :-
 	'$profile_data'(P, Parm, Data).
 
@@ -735,21 +735,6 @@ sub_atom(At, Bef, Size, After, SubAt) :-
 	X11 is X1+1,
 	'$range_var'(X11,X2,XF).
 
-
-current_predicate(V) :- var(V), !,
-	current_predicate(_,S),
-	functor(S,Na,Ar),
-	V = Na/Ar.
-current_predicate(Na/Ar) :- !,
-	current_predicate(Na,S),
-	\+ '$system_predicate'(S),
-	functor(S,Na,Ar).
-current_predicate(M:X) :- !,
-	'$mod_switch'(M,current_predicate(X)).
-current_predicate(T) :-
-	throw(error(type_error(predicate_indicator,T),current_predicate(T))).
-
-
 '$singletons_in_term'(T,VL) :-
 	'$variables_in_term'(T,[],V10),
 	'$sort'(V10, V1),

pl/yapor.yap

@@ -15,8 +15,9 @@
 *									 *
 *************************************************************************/
 
-'$parallel_query'(G,[]) :- !, '$start_yapor', '$execute'(G), !, $parallel_yes_answer.
+'$parallel_query'(G,[]) :- !, '$start_yapor', '$execute'(G), !,
-'$parallel_query'(G,V)  :- '$start_yapor', '$execute'(G), $parallel_new_answer(V).
+'$parallel_yes_answer'.
+'$parallel_query'(G,V)  :- '$start_yapor', '$execute'(G), '$parallel_new_answer'(V).
 
 % ***************************
 % * -------- YAPOR -------- *
@@ -79,7 +80,7 @@ parallel(A/N) :- integer(N), atom(A), !,
                      write(user_error, ' is already declared as sequential ]'),
                      nl(user_error)
                    ;
-                     X is F /\ 8'170000, X =:= 0, !, $sequential(T)
+                     X is F /\ 8'170000, X =:= 0, !, '$sequential'(T)
                    ;
                      write(user_error, '[ Error: '),
                      write(user_error, A/N),

pl/yio.yap

@@ -215,16 +215,10 @@ open(F,T,S,Opts) :-
 	throw(error(instantiation_error,G)).
 '$check_open_eof_action_arg'(error,_) :- !.
 '$check_open_eof_action_arg'(eof_code,_) :- !.
-'$check_open_eof_action_arg'(reset,G) :- !.
+'$check_open_eof_action_arg'(reset,_) :- !.
 '$check_open_eof_action_arg'(X,G) :-
 	throw(error(domain_error(io_mode,eof_action(X)),G)).
 
-'$check_open_alias_arg'(T, G) :- var(X), !,
-	throw(error(instantiation_error,G)).
-'$check_open_eof_action_arg'(T,_) :- atom(T), !.
-'$check_open_alias_arg'(T, G) :- var(X), !,
-	throw(error(type_error(atom,T),G)).
-
 '$check_read_syntax_errors_arg'(X, G) :- var(X), !,
 	throw(error(instantiation_error,G)).
 '$check_read_syntax_errors_arg'(dec10,_) :- !.
@@ -265,7 +259,7 @@ open(F,T,S,Opts) :-
 '$check_write_max_depth'(X, G) :- var(X), !,
 	throw(error(instantiation_error,G)).
 '$check_write_max_depth'(I,_) :- integer(I), I > 0, !.
-'$check_write_portrayed'(X,G) :-
+'$check_write_max_depth'(X,G) :-
 	throw(error(domain_error(write_option,max_depth(X)),G)).
 
 set_input(Stream) :-
@@ -343,7 +337,7 @@ read_term(Stream, T, Options) :-
 %
 '$preprocess_read_terms_options'([]).
 '$preprocess_read_terms_options'([syntax_errors(NewVal)|L]) :- !,
-	'$get_read_error_handler'(OldVal).
+	'$get_read_error_handler'(OldVal),
 	'$set_value'('$read_term_error_handler', OldVal),
 	'$set_read_error_handler'(NewVal),
 	'$preprocess_read_terms_options'(L).
@@ -363,12 +357,12 @@ read_term(Stream, T, Options) :-
 '$postprocess_read_terms_option'(syntax_errors(_), _, _) :-
 	'$get_value'('$read_term_error_handler', OldVal),
 	'$set_read_error_handler'(OldVal).
-'$postprocess_read_terms_option'(variable_names(Vars), T, VL) :-
+'$postprocess_read_terms_option'(variable_names(Vars), _, VL) :-
 	'$read_term_non_anonymous'(VL, Vars).
 '$postprocess_read_terms_option'(singletons(Val), T, VL) :-
 	'$singletons_in_term'(T, Val1),
 	'$fetch_singleton_names'(Val1,VL,Val).
-'$postprocess_read_terms_option'(variables(Val), T, VL) :-
+'$postprocess_read_terms_option'(variables(Val), T, _) :-
 	'$variables_in_term'(T, [], Val).
 %'$postprocess_read_terms_option'(cycles(Val), _, _).
 
@@ -393,7 +387,7 @@ read_term(Stream, T, Options) :-
 %	V1 @> V2,
 	'$fetch_singleton_names'(Ss, Ns, NSs).
 
-'$add_singleton_if_no_underscore'([95|_],V2,NSs,NSs) :- !.
+'$add_singleton_if_no_underscore'([95|_],_,NSs,NSs) :- !.
 '$add_singleton_if_no_underscore'(Na,V2,NSs,[(Name=V2)|NSs]) :-
 	atom_codes(Name, Na).
 
@@ -459,25 +453,25 @@ write_term(_,_,_).
 	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([quoted(false)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 /\ 14,
-	'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
+	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([ignore_ops(true)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 \/ 2,
 	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([ignore_ops(false)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 /\ 13,
-	'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
+	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([numbervars(true)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 \/ 4,
 	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([numbervars(false)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 /\ 11,
-	'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
+	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([portrayed(true)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 \/ 8,
 	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([portrayed(false)|Opts], Flag0, Flag, CallBacks) :-
 	FlagI is Flag0 /\ 7,
-	'$process_wt_opts'(Opts, Flag0, Flag, CallBacks).
+	'$process_wt_opts'(Opts, FlagI, Flag, CallBacks).
 '$process_wt_opts'([max_depth(D)|Opts], Flag0, Flag, [max_depth(D1,D0)|CallBacks]) :-
 	write_depth(D1,D0),
 	write_depth(D,D),
@@ -751,7 +745,7 @@ stream_position(A,N,M) :-
 	atom(A),
 	current_stream(_,_,S), '$user_file_name'(S,A), !,
 	'$stream_position'(S,N,M).
-stream_position(S,N) :-
+stream_position(S,N,M) :-
 	'$stream_position'(S,N,M).
 
 '$stream_position'(S,N,M) :-
@@ -812,7 +806,7 @@ stream_property(Stream, Props) :-
 '$check_stream_props'(Prop, [Prop]).
 
 
-'$process_stream_properties'([], Stream, F, Mode).
+'$process_stream_properties'([], _, _, _).
 '$process_stream_properties'([file_name(F)|Props], Stream, F, Mode) :-
 	'$process_stream_properties'(Props, Stream, F, Mode).
 '$process_stream_properties'([mode(Mode)|Props], Stream, F, Mode) :-
@@ -849,21 +843,21 @@ stream_property(Stream, Props) :-
 	'$past_eof'(Stream), !.
 '$show_stream_eof'(Stream, at) :-
 	'$peek'(Stream,N), N = -1, !.
-'$show_stream_eof'(Stream, not).
+'$show_stream_eof'(_, not).
 	
 '$show_stream_eof_action'(Fl, error) :-
 	Fl /\ 16'0200 =:= 16'0200, !.
 '$show_stream_eof_action'(Fl, reset) :-
 	Fl /\ 16'0400 =:= 16'0400, !.
-'$show_stream_eof_action'(Fl, eof_code).
+'$show_stream_eof_action'(_, eof_code).
 
 '$show_stream_reposition'(Fl, true) :-
 	Fl /\ 16'2000 =:= 16'2000, !.
-'$show_stream_reposition'(Fl, false).
+'$show_stream_reposition'(_, false).
 
 '$show_stream_type'(Fl, binary) :-
 	Fl /\ 16'0100 =:= 16'0100, !.
-'$show_stream_type'(Fl, text).
+'$show_stream_type'(_, text).
 
 at_end_of_stream :-
 	current_input(S),