interface speedups

bad error message in X is foo>>2.


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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2007-05-01 21:18:19 $,$Author: vsc $						 *
+* Last rev:     $Date: 2007-06-04 12:28:01 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.222  2007/05/01 21:18:19  vsc
+* fix bug in saving P at p_eq (obs from Frabrizio Riguzzi)
+*
 * Revision 1.221  2007/04/10 22:13:20  vsc
 * fix max modules limitation
 *
@@ -769,7 +772,6 @@ Yap_absmi(int inp)
       else {
 	ASP = YREG;
       }
-      Yap_StartSlots();
       saveregs();
 #if PUSH_REGS
       restore_absmi_regs(old_regs);
@@ -787,7 +789,6 @@ Yap_absmi(int inp)
       else {
 	ASP = YREG;
       }
-      Yap_StartSlots();
       saveregs();
 #if PUSH_REGS
       restore_absmi_regs(old_regs);

C/c_interface.c

@@ -10,8 +10,11 @@
 * File:		c_interface.c						 *
 * comments:	c_interface primitives definition 			 *
 *									 *
-* Last rev:	$Date: 2007-05-15 11:33:51 $,$Author: vsc $						 *
+* Last rev:	$Date: 2007-06-04 12:28:01 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.94  2007/05/15 11:33:51  vsc
+* fix min list
+*
 * Revision 1.93  2007/05/14 16:44:11  vsc
 * improve external interface
 *
@@ -298,6 +301,7 @@ X_API Term    STD_PROTO(YAP_MkApplTerm,(Functor,unsigned long int,Term *));
 X_API Term    STD_PROTO(YAP_MkNewApplTerm,(Functor,unsigned long int));
 X_API Functor STD_PROTO(YAP_FunctorOfTerm,(Term));
 X_API Term    STD_PROTO(YAP_ArgOfTerm,(Int,Term));
+X_API Term   *STD_PROTO(YAP_ArgsOfTerm,(Term));
 X_API Functor STD_PROTO(YAP_MkFunctor,(Atom,Int));
 X_API Atom    STD_PROTO(YAP_NameOfFunctor,(Functor));
 X_API Int     STD_PROTO(YAP_ArityOfFunctor,(Functor));
@@ -307,6 +311,8 @@ X_API Int     STD_PROTO(YAP_Unify,(Term,Term));
 X_API int     STD_PROTO(YAP_Reset,(void));
 X_API Int     STD_PROTO(YAP_Init,(YAP_init_args *));
 X_API Int     STD_PROTO(YAP_FastInit,(char *));
+X_API PredEntry *STD_PROTO(YAP_FunctorToPred,(Functor));
+X_API PredEntry *STD_PROTO(YAP_AtomToPred,(Atom));
 X_API Int     STD_PROTO(YAP_CallProlog,(Term));
 X_API void   *STD_PROTO(YAP_AllocSpaceFromYap,(unsigned int));
 X_API void    STD_PROTO(YAP_FreeSpaceFromYap,(void *));
@@ -318,6 +324,9 @@ X_API void    STD_PROTO(YAP_Error,(int, Term, char *, ...));
 X_API Term    STD_PROTO(YAP_RunGoal,(Term));
 X_API int     STD_PROTO(YAP_RestartGoal,(void));
 X_API int     STD_PROTO(YAP_ShutdownGoal,(int));
+X_API int     STD_PROTO(YAP_EnterGoal,(PredEntry *, Term *, YAP_dogoalinfo *));
+X_API int     STD_PROTO(YAP_RetryGoal,(YAP_dogoalinfo *));
+X_API int     STD_PROTO(YAP_LeaveGoal,(int, YAP_dogoalinfo *));
 X_API int     STD_PROTO(YAP_GoalHasException,(Term *));
 X_API void    STD_PROTO(YAP_ClearExceptions,(void));
 X_API int     STD_PROTO(YAP_ContinueGoal,(void));
@@ -699,7 +708,15 @@ YAP_ArgOfTerm(Int n, Term t)
   return (ArgOfTerm(n, t));
 }
 
-
+X_API Term *
+YAP_ArgsOfTerm(Term t)
+{
+  if (IsApplTerm(t))
+    return RepAppl(t)+1;
+  else if (IsPairTerm(t))
+    return RepPair(t);
+  return NULL;
+}
 
 X_API Functor 
 YAP_MkFunctor(Atom a, Int n)
@@ -1023,6 +1040,22 @@ YAP_BufferToString(char *s)
   return t;
 }
 
+static int
+dogc(void)
+{
+  UInt arity;
+
+  if (P && PREVOP(P,sla)->opc == Yap_opcode(_call_usercpred)) {
+    arity = PREVOP(P,sla)->u.sla.sla_u.p->ArityOfPE;
+  } else {
+    arity = 0;
+  }
+  if (!Yap_gc(arity, ENV, CP)) {
+    return FALSE;
+  }
+  return TRUE;
+}
+
 /* copy a string to a buffer */
 X_API Term
 YAP_ReadBuffer(char *s, Term *tp)
@@ -1030,8 +1063,10 @@ YAP_ReadBuffer(char *s, Term *tp)
   Term t; 
   BACKUP_H();
 
-  t = Yap_StringToTerm(s,tp);
+  while ((t = Yap_StringToTerm(s,tp)) == 0L) {
-
+    if (!dogc())
+      return FALSE;
+  }
   RECOVER_H();
   return t;
 }
@@ -1081,6 +1116,136 @@ static int myputc (wchar_t ch)
   return ch;
 }
 
+X_API PredEntry *
+YAP_FunctorToPred(Functor func)
+{
+  return RepPredProp(PredPropByFunc(func, CurrentModule));
+}
+
+X_API PredEntry *
+YAP_AtomToPred(Atom at)
+{
+  return RepPredProp(PredPropByAtom(at, CurrentModule));  
+}
+
+
+static int
+run_emulator(YAP_dogoalinfo *dgi)
+{
+  choiceptr myB;
+  int out;
+
+  Yap_PrologMode = UserMode;
+  out = Yap_absmi(0);
+  Yap_PrologMode = UserCCallMode;
+  myB = (choiceptr)(LCL0-dgi->b);
+  CP = myB->cp_cp;
+  if (!out ) {
+    /* recover stack */
+    /* on failed computations */
+    TR = B->cp_tr;
+    H = B->cp_h;
+#ifdef DEPTH_LIMIT
+    DEPTH = B->cp_depth = DEPTH;
+#endif /* DEPTH_LIMIT */
+    YENV = ENV = B->cp_env;
+    ASP = (CELL *)(B+1);
+    B = B->cp_b;
+    HB = B->cp_h;
+  }
+  P = dgi->p;
+  RECOVER_MACHINE_REGS();
+  return out;
+}
+
+X_API int
+YAP_EnterGoal(PredEntry *pe, Term *ptr, YAP_dogoalinfo *dgi)
+{
+  UInt i;
+  choiceptr myB;
+
+  BACKUP_MACHINE_REGS();
+  dgi->p = P;
+  ptr--;
+  i = pe->ArityOfPE;
+  while (i>0) {
+    XREGS[i] = ptr[i];
+    i--;
+  }
+  P = pe->CodeOfPred;
+  /* create a choice-point to be tag new goal */
+  myB = (choiceptr)ASP;
+  myB--;
+  dgi->b = LCL0-(CELL *)myB;
+  myB->cp_tr = TR;
+  myB->cp_h = HB = H;
+  myB->cp_b = B;
+#ifdef DEPTH_LIMIT
+  myB->cp_depth = DEPTH;
+#endif /* DEPTH_LIMIT */
+  myB->cp_cp = CP;
+  myB->cp_ap = NOCODE;
+  myB->cp_env = ENV;
+  CP = YESCODE;
+  B = myB;
+  HB = H;
+#if defined(YAPOR) || defined(THREADS)
+  WPP = NULL;
+#endif
+  YENV[E_CB] = Unsigned (B);
+  ASP = YENV = (CELL *)B;
+  return run_emulator(dgi);
+}
+
+X_API int
+YAP_RetryGoal(YAP_dogoalinfo *dgi)
+{
+  choiceptr myB;
+
+  BACKUP_MACHINE_REGS();
+  myB = (choiceptr)(LCL0-dgi->b);
+  CP = myB->cp_cp;
+  /* sanity check */
+  if (B >= myB) {
+    return FALSE;
+  }
+  P = FAILCODE;
+  return run_emulator(dgi);
+}
+
+X_API int
+YAP_LeaveGoal(int backtrack, YAP_dogoalinfo *dgi)
+{
+  choiceptr myB;
+
+  myB = (choiceptr)(LCL0-dgi->b);
+  if (B >  myB) {
+    return FALSE;
+  }
+#ifdef YAPOR
+  CUT_prune_to(myB);
+#endif
+  B = myB;
+  if (backtrack) {
+    P = FAILCODE;
+    Yap_exec_absmi(TRUE);
+    /* recover stack space */
+    H = B->cp_h;
+    TR = B->cp_tr;
+#ifdef DEPTH_LIMIT
+    DEPTH = B->cp_depth;
+#endif /* DEPTH_LIMIT */
+    YENV = ENV = B->cp_env;
+  }
+  /* recover local stack */
+  ASP = (CELL *)(B+1);
+  B = B->cp_b;
+  HB = B->cp_h;
+  P = dgi->p;
+  RECOVER_MACHINE_REGS();
+  return TRUE;
+}
+
 X_API Term
 YAP_RunGoal(Term t)
 {

C/eval.c

@@ -116,8 +116,14 @@ Eval(Term t, E_ARGS)
     ExpEntry *p;
 
     if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
+      Term ti[2], terror;
+      
       /* error */
-      Yap_Error(TYPE_ERROR_EVALUABLE, t,
+      ti[0] = t;
+      ti[1] = MkIntegerTerm(0);
+      /* error */
+      terror = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti);
+      Yap_Error(TYPE_ERROR_EVALUABLE, terror,
 	    "atom %s for arithmetic expression",
 	    RepAtom(name)->StrOfAE);
       P = (yamop *)FAILCODE;
@@ -184,10 +190,16 @@ Yap_Eval(Term t, E_ARGS)
     ExpEntry *p;
 
     if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) {
+      Term ti[2], terror;
+      
       /* error */
-      Yap_Error(TYPE_ERROR_EVALUABLE, t,
+      ti[0] = t;
-	    "atom %s for arithmetic expression",
+      ti[1] = MkIntegerTerm(0);
-	    RepAtom(name)->StrOfAE);
+      /* error */
+      terror = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("/"),2), 2, ti);
+      Yap_Error(TYPE_ERROR_EVALUABLE, terror,
+	      "atom %s for arithmetic expression",
+	      RepAtom(name)->StrOfAE);
       P = (yamop *)FAILCODE;
       RERROR();
     }

C/exec.c

@@ -1384,7 +1384,7 @@ p_pred_goal_expansion_on(void) {
 static int
 exec_absmi(int top)
 {
-  int lval;
+  int lval, out;
   if (top && (lval = sigsetjmp (Yap_RestartEnv, 1)) != 0) {
     switch(lval) {
     case 1:
@@ -1427,15 +1427,15 @@ exec_absmi(int top)
   } else {
     Yap_PrologMode = UserMode;
   }
-  return(Yap_absmi(0));
+  out = Yap_absmi(0);
+  Yap_StartSlots();
+  return out;
 }
 
-static Term
-do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top)
-{
-  choiceptr saved_b = B;
-  Term out = 0L;
 
+static  void
+init_stack(int arity, CELL *pt, int top, choiceptr saved_b)
+{
   /* create an initial pseudo environment so that when garbage
      collection is going up in the environment chain it doesn't get
      confused */
@@ -1481,8 +1481,19 @@ do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top)
   WPP = NULL;
 #endif
   YENV[E_CB] = Unsigned (B);
-  P = (yamop *) CodeAdr;
   CP = YESCODE;
+
+}
+
+static Term
+do_goal(Term t, yamop *CodeAdr, int arity, CELL *pt, int top)
+{
+  choiceptr saved_b = B;
+  Term out = 0L;
+
+  init_stack(arity, pt, top, saved_b);
+  P = (yamop *) CodeAdr;
+  S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0)));	/* A1 mishaps */
   S = CellPtr (RepPredProp (PredPropByFunc (Yap_MkFunctor(AtomCall, 1),0)));	/* A1 mishaps */
 
   out = exec_absmi(top);
@@ -1974,6 +1985,7 @@ Yap_InitYaamRegs(void)
   CreepFlag = CalculateStackGap();
   UNLOCK(SignalLock);
   EX = 0L;
+  init_stack(0, NULL, TRUE, NULL);
   /* for slots to work */
   Yap_StartSlots();
   GlobalArena = TermNil;

changes-5.1.html

@@ -16,6 +16,7 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> FIXED: error with atoms in arithmetic messages (obs from Paulo Moura).</li>
 <li> FIXED: bug in meta-calls to external C code (obs from Bernd Gutmann).</li>
 <li> NEW: matlab interface.</li>
 <li> FIXED: search for libraries right.</li>

docs/yap.tex

@@ -12179,6 +12179,7 @@ fetch the head or the tail.
 @findex YAP_MkApplTerm (C-Interface function)
 @findex YAP_MkNewApplTerm (C-Interface function)
 @findex YAP_ArgOfTerm (C-Interface function)
+@findex YAP_ArgsOfTerm (C-Interface function)
 @findex YAP_FunctorOfTerm (C-Interface function)
 A @i{compound} term consists of a @i{functor} and a sequence of terms with
 length equal to the @i{arity} of the functor. A functor, described in C by
@@ -12189,6 +12190,7 @@ functors
       YAP_Term     YAP_MkApplTerm(YAP_Functor @var{f}, unsigned long int @var{n}, YAP_Term[] @var{args})
       YAP_Term     YAP_MkNewApplTerm(YAP_Functor @var{f}, int @var{n})
       YAP_Term     YAP_ArgOfTerm(int argno,YAP_Term @var{ts})
+      YAP_Term    *YAP_ArgsOfTerm(YAP_Term @var{ts})
       YAP_Functor  YAP_FunctorOfTerm(YAP_Term @var{ts})
 @end example
 @noindent
@@ -12198,7 +12200,8 @@ terms with @var{n} equal to the arity of the
 functor. @code{YAP_MkNewApplTerm} builds up a compound term whose
 arguments are unbound variables. @code{YAP_ArgOfTerm} gives an argument
 to a compound term. @code{argno} should be greater or equal to 1 and
-less or equal to the arity of the functor.
+less or equal to the arity of the functor.  @code{YAP_ArgsOfTerm}
+returns a pinter to an array of arguments.
 
 YAP allows one to manipulate the functors of compound term. The function
 @code{YAP_FunctorOfTerm} allows one to obtain a variable of type
@@ -12820,6 +12823,54 @@ space pointed to by @var{tp}
 @findex YAP_ClearExceptions/0
 Reset any exceptions left over by the system.
 
+@item  @code{YAP_PredEntryPtr} YAP_FunctorToPred(@code{YAP_Functor} @var{f},
+@findex YAP_FunctorToPred/1
+Return the predicate whose main functor is @var{f}.
+
+@item  @code{YAP_PredEntryPtr} YAP_AtomToPred(@code{YAP_Atom} @var{at},
+@findex YAP_AtomToPred/1
+Return the arity 0 predicate whose name is @var{at}.
+
+@item  @code{YAP_Bool} YAP_EnterGoal(@code{YAP_PredEntryPtr} @var{pe},
+@code{YAP_Term *} @var{array}, @code{YAP_dogoalinfo *} @var{infop})
+@findex YAP_EnterGoal/3
+Execute a  query for predicate @var{pe}. The query is given as an
+array of terms @var{Array}. @var{infop} is the address of a goal
+handle that can be used to backtrack and to recover space. Succeeds if
+a solution was found.
+
+Notice that you cannot create new slots if an YAP_EnterGoal goal is open.
+
+@item  @code{YAP_Bool} YAP_RetryGoal(@code{YAP_dogoalinfo *} @var{infop})
+@findex YAP_RetryGoal/1
+Backtrack to a query created by @code{YAP_EnterGoal}. The query is
+given by the handle @var{infop}. Returns whether a new solution could
+be be found.
+
+@item  @code{YAP_Bool} YAP_LeaveGoal(@code{YAP_Bool} @var{backtrack},
+@code{YAP_dogoalinfo *} @var{infop})
+@findex YAP_LeaveGoal/2
+Exit a query query created by @code{YAP_EnterGoal}. If
+@code{backtrack} is @code{TRUE}, variable bindings are undone and Heap
+space is recovered.  Otherwise, stack space is recovered.
+
+Next, follows an example of how to use @code{YAP_EnterGoal}:
+@example
+void
+runall(YAP_Term g)
+@{
+    YAP_dogoalinfo goalInfo;
+    YAP_Term *goalArgs = YAP_ArraysOfTerm(g);
+    YAP_Functor *goalFunctor = YAP_FunctorOfTerm(g);
+    YAP_PredEntryPtr goalPred = YAP_FunctorToGoal(goalFunctor);
+    
+    result = YAP_EnterGoal( goalPred, goalArgs, &goalInfo );
+    while (result)
+       result = YAP_RetryGoal( &goalInfo );
+    YAP_LeaveGoal(TRUE, &goalInfo);
+@}
+@end example
+
 @item  @code{YAP_Term} YAP_Write(@code{YAP_Term} @var{t})
 @findex  YAP_CopyTerm/1
 Copy a Term @var{t} and all associated constraints. May call the garbage

include/YapInterface.h

@@ -166,6 +166,9 @@ extern X_API YAP_Functor PROTO(YAP_FunctorOfTerm,(YAP_Term));
 /*    YAP_Term     ArgOfTerm(unsigned int argno,YAP_Term t) */
 extern X_API YAP_Term PROTO(YAP_ArgOfTerm,(unsigned int,YAP_Term));
 
+/*    YAP_Term    *ArgsOfTerm(YAP_Term t) */
+extern X_API YAP_Term *PROTO(YAP_ArgsOfTerm,(YAP_Term));
+
 /*    YAP_Functor  MkFunctor(YAP_Atom a,int arity) */
 extern X_API YAP_Functor PROTO(YAP_MkFunctor,(YAP_Atom,unsigned int));
 
@@ -228,9 +231,25 @@ extern X_API YAP_Bool PROTO(YAP_ShutdownGoal,(int));
 /*  int YAP_ContinueGoal(void) */
 extern X_API YAP_Bool PROTO(YAP_ContinueGoal,(void));
 
+
 /*  void YAP_PruneGoal(void) */
 extern X_API void PROTO(YAP_PruneGoal,(void));
 
+/*  int YAP_FunctorToPred(struct pred_entry *, YAP_Term *) */
+extern X_API YAP_PredEntryPtr PROTO(YAP_FunctorToPred,(YAP_Functor));
+
+/*  int YAP_AtomToPred(struct pred_entry *, YAP_Term *) */
+extern X_API YAP_PredEntryPtr PROTO(YAP_AtomToPred,(YAP_Atom));
+
+/*  int YAP_EnterGoal(void) */
+extern X_API YAP_Bool PROTO(YAP_EnterGoal,(YAP_PredEntryPtr, YAP_Term *, YAP_dogoalinfo *));
+
+/*  int YAP_RetryGoal(void) */
+extern X_API YAP_Bool PROTO(YAP_RetryGoal,(YAP_dogoalinfo *));
+
+/*  int YAP_LeaveGoal(void) */
+extern X_API YAP_Bool PROTO(YAP_LeaveGoal,(int, YAP_dogoalinfo *));
+
 /*  int YAP_GoalHasException(YAP_Term *) */
 extern X_API YAP_Bool PROTO(YAP_GoalHasException,(YAP_Term *));
 

include/yap_structs.h

@@ -138,3 +138,11 @@ typedef struct {
   int		   (*cancel)(int);
 } YAP_thread_attr;
 
+typedef struct YAP_pred_entry *YAP_PredEntryPtr;
+
+/* this should be opaque to the user */ 
+typedef struct {
+  unsigned long  b;
+  struct yami *p;
+} YAP_dogoalinfo;
+