(core) new '$yield'/0 predicate to suspend the current wam() function

This predicate stops the running wam() function. When called from the
foreign interface, it can be resume the execution with
ciao_query_resume().

Src-commit: 15de6888d0f406c73a2377de75fb8357e453e9ca

core/engine/ciao_prolog.c

@@ -973,11 +973,13 @@ ciao_bool ciao_query_next(ciao_query *query) {
 
 ciao_bool ciao_query_ok(ciao_query *query) {
   try_node_t *next_alt;
+  ciao_ctx ctx = query->ctx;
+  worker_t *w = ctx->worker_registers;
 
-  next_alt = query->ctx->worker_registers->next_alt;
-
-  if (next_alt == &nullgoal_alt ||
-      (next_alt == NULL && query->ctx->worker_registers->choice->next_alt == &nullgoal_alt)) {
+  next_alt = w->next_alt;
+  if (next_alt == NULL) next_alt = w->choice->next_alt;
+
+  if (next_alt == &nullgoal_alt) {
     return FALSE;
   } else {
     return TRUE;
@@ -1098,6 +1100,25 @@ ciao_bool ciao_commit_call(const char *name, int arity, ...) {
 
 /* ------------------------------------------------------------------------- */
 
+/* True if this query has been suspended with internals:'$yield'/0 [EXPERIMENTAL] */
+bool_t ciao_query_suspended(ciao_query *query) {
+  goal_descriptor_t *ctx = query->ctx;
+  worker_t *w = ctx->worker_registers;
+  return IsSuspendedGoal(w);
+}
+
+/* Resume the execution of query suspended with internals:'$yield'/0 [EXPERIMENTAL] */
+void ciao_query_resume(ciao_query *query) {
+  goal_descriptor_t *ctx = query->ctx;
+  worker_t *w = ctx->worker_registers;
+  Stop_This_Goal(w) = FALSE;
+  SetSuspendedGoal(w, FALSE);
+  UnsetEvent(); // TODO: SetEvent() usage
+  wam(w, ctx); // (continue with '$yield' alternative, resume execution)
+}
+
+/* ------------------------------------------------------------------------- */
+
 jmp_buf ciao_gluecode_jmpbuf;
 
 void ciao_raise_exception_s(ciao_ctx ctx, ciao_term exception) {

core/engine/ciao_prolog.h

@@ -284,6 +284,10 @@ ciao_bool ciao_commit_call(const char *name, int arity, ...);
 ciao_bool ciao_commit_call_term_s(ciao_ctx ctx, ciao_term goal);
 ciao_bool ciao_commit_call_term(ciao_term goal);
 
+/* (experimental for '$yield'/0) */
+bool_t ciao_query_suspended(ciao_query *query);
+void ciao_query_resume(ciao_query *query);
+
 /* Helper functions */
 
 ciao_term ciao_copy_term_s(ciao_ctx src_desc, ciao_term src_term, ciao_ctx dst_desc);

core/engine/eng.h

@@ -393,6 +393,10 @@
 
 #define Stop_This_Goal(w) (w->misc->stop_this_goal)
 
+// TODO: better place to store this bit?
+#define IsSuspendedGoal(w) ((bool_t)((intptr_t)(w->dummy0)))
+#define SetSuspendedGoal(w,S) (w->dummy0 = (void *)(S))
+
 /* Global variables */
 
 #define GLOBVAR(i) w->misc->globalvar[i]
@@ -1385,7 +1389,7 @@ struct worker_ {
   intmach_t atom_buffer_length;
 
   /* dummy */
-  void *dummy0;
+  void *dummy0; /* TODO: experimental, used for suspended goals */
   void *dummy1;
   void *dummy2;
 
@@ -2218,6 +2222,7 @@ extern try_node_t *address_nd_fake_choicept;
 extern try_node_t *address_nd_suspension_point;
 extern bcp_t restart_point_insn;
 #endif
+extern try_node_t *address_nd_yield;
 
 extern definition_t *address_true;
 extern definition_t *address_fail;

core/engine/eng_registry.c

@@ -320,6 +320,8 @@ try_node_t *address_nd_suspension_point;
 bcp_t restart_point_insn;
 #endif
 
+try_node_t *address_nd_yield;
+
 definition_t *address_true;
 definition_t *address_fail;
 definition_t *address_call;
@@ -1794,6 +1796,8 @@ void init_once(void)
   define_c_mod_predicate("internals","$close_predicate",1,close_predicate);
   define_c_mod_predicate("internals","$open_predicate",1,open_predicate);
   define_c_mod_predicate("runtime_control", "new_atom", 1, prolog_new_atom);
+  // (experimental)
+  define_c_mod_predicate("internals", "$yield", 0, prolog_yield);
 
 #if defined(GAUGE)
   /* gauge.c */
@@ -1842,6 +1846,7 @@ void init_once(void)
     EMIT_o(RESTART_POINT);
   }
 #endif
+  address_nd_yield = def_retry_c(nd_yield,0);
 
 #include "eng_static_mod.c"
 

core/engine/internals.pl

@@ -198,6 +198,11 @@
 
 % ---------------------------------------------------------------------------
 
+:- export('$yield'/0). % (see ciao_query_resume())
+:- impl_defined('$yield'/0). 
+
+% ---------------------------------------------------------------------------
+
 :- export('$exit'/1).
 :- trust pred '$exit'(A) => int(A).
 :- impl_defined('$exit'/1).

core/engine/runtime_control.c

@@ -79,6 +79,23 @@ CBOOL__PROTO(nd_fake_choicept)
 }
 #endif
 
+/* internals:'$yield'/0: force exit of the wam function (continue with ciao_query_resume()) */
+CBOOL__PROTO(prolog_yield) {
+  // TODO: try a more direct way, do not create choice points */
+  push_choicept(w,address_nd_yield);
+  Stop_This_Goal(w) = TRUE;
+  SetEvent(); // TODO: see concurrency.c using "SetWakeCount(1);" instead
+  goal_descriptor_t *ctx = w->misc->goal_desc_ptr;
+  SetSuspendedGoal(w, TRUE);
+  ctx->action = BACKTRACKING | KEEP_STACKS; // continue on alternative
+  CBOOL__PROCEED;
+}
+
+CBOOL__PROTO(nd_yield) {
+  pop_choicept(w);
+  CBOOL__PROCEED;
+}
+
 /* ------------------------------------------------------------------
    THE BUILTIN C-PREDICATE       CURRENT_ATOM/1
    -----------------------------------------------------------------------*/

core/engine/runtime_control.h

@@ -9,9 +9,6 @@
 #ifndef _CIAO_RUNTIME_CONTROL_H
 #define _CIAO_RUNTIME_CONTROL_H
 
-#if defined(TABLING)
-CBOOL__PROTO(nd_fake_choicept);
-#endif
 CVOID__PROTO(pop_choicept);
 CVOID__PROTO(push_choicept, try_node_t *alt);
 CBOOL__PROTO(current_atom);
@@ -21,6 +18,12 @@ CBOOL__PROTO(prolog_repeat);
 CBOOL__PROTO(nd_repeat);
 CBOOL__PROTO(module_is_static);
 
+#if defined(TABLING)
+CBOOL__PROTO(nd_fake_choicept);
+#endif
+CBOOL__PROTO(prolog_yield);
+CBOOL__PROTO(nd_yield);
+
 CBOOL__PROTO(prolog_new_atom);
 
 #endif /* _CIAO_RUNTIME_CONTROL_H */