BEAM for YAP update...

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

C/absmi.c

@@ -10,8 +10,11 @@
 *									 *
 * File:		absmi.c							 *
 * comments:	Portable abstract machine interpreter                    *
-* Last rev:     $Date: 2005-08-12 17:00:00 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-09-08 22:06:44 $,$Author: rslopes $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.175  2005/08/12 17:00:00  ricroc
+* TABLING FIX: support for incomplete tables
+*
 * Revision 1.174  2005/08/05 14:55:02  vsc
 * first steps to allow mavars with tabling
 * fix trailing for tabling with multiple get_cons
@@ -2686,6 +2689,17 @@ Yap_absmi(int inp)
 #endif /* TABLING */
 
 
+
+#ifdef BEAM
+ extern int eam_am(PredEntry *);
+     Op(run_eam, s);
+        if (!eam_am((PredEntry *) PREG->u.s.s)) FAIL();
+        PREG = NEXTOP(PREG, s);
+        GONext();
+      ENDOp();
+#endif
+
+
 /************************************************************************\
 *    Get Instructions							*
 \************************************************************************/
@@ -6649,6 +6663,7 @@ Yap_absmi(int inp)
 #ifdef FROZEN_STACKS
       { 
 	choiceptr top_b = PROTECT_FROZEN_B(B);
+
 #ifdef SBA
 	if (YREG > (CELL *) top_b || YREG < H) ASP = (CELL *)top_b;
 #else

C/adtdefs.c

@@ -528,6 +528,9 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
 #ifdef TABLING
   p->TableOfPred = NULL;
 #endif /* TABLING */
+#ifdef BEAM
+  p->beamTable = NULL;
+#endif  /* BEAM */
   /* careful that they don't cross MkFunctor */
   p->NextOfPE = fe->PropsOfFE;
   if (PRED_GOAL_EXPANSION_FUNC) {
@@ -568,6 +571,9 @@ Yap_NewThreadPred(PredEntry *ap)
 #ifdef TABLING
   p->TableOfPred = NULL;
 #endif /* TABLING */
+#ifdef BEAM
+  p->beamTable = NULL;
+#endif 
   /* careful that they don't cross MkFunctor */
   p->NextOfPE = AbsPredProp(ThreadHandle[worker_id].local_preds);
   ThreadHandle[worker_id].local_preds = p;
@@ -607,6 +613,9 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
 #ifdef TABLING
   p->TableOfPred = NULL;
 #endif /* TABLING */
+#ifdef BEAM
+  p->beamTable = NULL;
+#endif 
   /* careful that they don't cross MkFunctor */
   p->NextOfPE = ae->PropsOfAE;
   if (PRED_GOAL_EXPANSION_FUNC) {

C/amasm.c

@@ -11,8 +11,11 @@
 * File:		amasm.c							 *
 * comments:	abstract machine assembler				 *
 *									 *
-* Last rev:     $Date: 2005-08-02 03:09:49 $							 *
+* Last rev:     $Date: 2005-09-08 22:06:44 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.83  2005/08/02 03:09:49  vsc
+* fix debugger to do well nonsource predicates.
+*
 * Revision 1.82  2005/07/06 15:10:02  vsc
 * improvements to compiler: merged instructions and fixes for ->
 *
@@ -3076,6 +3079,14 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
     case nop_op:
     case name_op:
       break;
+#ifdef BEAM 
+    case body_op:
+    case endgoal_op:
+      break;
+    case run_op:
+      code_p=a_n(_run_eam,cip->cpc->rnd2,code_p,pass_no);
+      break;
+#endif
     default:
       Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "instruction %d found while assembling", (int) cip->cpc->op);
       save_machine_regs();

C/compiler.c

@@ -11,8 +11,11 @@
 * File:		compiler.c						 *
 * comments:	Clause compiler						 *
 *									 *
-* Last rev:     $Date: 2005-07-06 15:10:03 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-09-08 22:06:44 $,$Author: rslopes $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.68  2005/07/06 15:10:03  vsc
+* improvements to compiler: merged instructions and fixes for ->
+*
 * Revision 1.67  2005/05/25 21:43:32  vsc
 * fix compiler bug in 1 << X, found by Nuno Fonseca.
 * compiler internal errors get their own message.
@@ -103,6 +106,11 @@ static char SccsId[] = "%W% %G%";
 #include <string.h>
 #endif
 
+#ifdef BEAM
+extern int EAM;
+//extern PInstr *CodeStart, *ppc, *ppc1, *BodyStart, *ppc_body;
+#endif
+
 typedef struct branch_descriptor {
   int    id;                /* the branch id */
   Term   cm;               /* if a banch is associated with a commit */
@@ -397,6 +405,10 @@ optimize_ce(Term t, unsigned int arity, unsigned int level, compiler_struct *cgl
   CExpEntry *p = cglobs->common_exps;
   int cmp = 0;
 
+#ifdef BEAM
+  if (EAM) return t;
+#endif
+
   if (IsApplTerm(t) && IsExtensionFunctor(FunctorOfTerm(t)))
     return (t);
   while (p != NULL) {
@@ -810,6 +822,7 @@ c_bifun(Int Op, Term t1, Term t2, Term t3, int mod, compiler_struct *cglobs)
 {
   /* compile Z = X Op Y  arithmetic function */
   /* first we fetch the arguments */
+
   if (IsVarTerm(t1)) {
     if (IsNewVar(t1)) {
       char s[32];
@@ -1583,6 +1596,7 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
     }
     else if (p->PredFlags & AsmPredFlag) {
       int op = p->PredFlags & 0x7f;
+
       if (profiling)
 	Yap_emit(enter_profiling_op, (CELL)p, Zero, &cglobs->cint);
       else if (call_counting)
@@ -1635,8 +1649,13 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	c_args(Goal, 0, cglobs);
       }
     }
+#ifdef BEAM
+    else if (p->PredFlags & BinaryTestPredFlag && !EAM) {
+#else
     else if (p->PredFlags & BinaryTestPredFlag) {
+#endif
       Term a1 = ArgOfTerm(1,Goal);
+
       if (IsVarTerm(a1) && !IsNewVar(a1)) {
 	Term a2 = ArgOfTerm(2,Goal);
 	if (IsVarTerm(a2) && !IsNewVar(a2)) {
@@ -1659,7 +1678,6 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	    save_machine_regs();
 	    longjmp(cglobs->cint.CompilerBotch,4);
 	  }
-
 	  c_eq(t2, a2, cglobs);
 	  c_var(a1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
@@ -1673,8 +1691,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	  save_machine_regs();
 	  longjmp(cglobs->cint.CompilerBotch,4);
 	}
-
 	c_eq(t1, a1, cglobs);
+
 	if (IsVarTerm(a2) && !IsNewVar(a2)) {
 	  c_var(t1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
@@ -1687,7 +1705,6 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	    save_machine_regs();
 	    longjmp(cglobs->cint.CompilerBotch,4);
 	  }
-
 	  c_eq(t2, a2, cglobs);
 	  c_var(t1, bt1_flag, 2, 0, cglobs);
 	  cglobs->current_p0 = p0;
@@ -1817,9 +1834,22 @@ c_body(Term Body, int mod, compiler_struct *cglobs)
     }
     c_goal(ArgOfTerm(1, Body), mod, cglobs);
     Body = t2;
+#ifdef BEAM
+    if (EAM) Yap_emit(endgoal_op, Zero, Zero, &cglobs->cint);
+#endif
+
   }
   cglobs->onlast = TRUE;
   c_goal(Body, mod, cglobs);
+#ifdef BEAM
+    if (EAM && cglobs->goalno > 1) {
+      if (cglobs->cint.cpc->op==procceed_op) {
+  	cglobs->cint.cpc->op=endgoal_op;
+        Yap_emit(procceed_op, Zero, Zero, &cglobs->cint);
+      } else
+        Yap_emit(endgoal_op, Zero, Zero, &cglobs->cint);
+    }
+#endif
 }
 
 static void
@@ -1842,7 +1872,11 @@ c_head(Term t, compiler_struct *cglobs)
 }
 
 /* number of permanent variables in the clause */
+#ifdef BEAM
+int nperm;
+#else
 static int nperm;
+#endif
 
 inline static int
 usesvar(compiler_vm_op ic)
@@ -1936,6 +1970,16 @@ AssignPerm(PInstr *pc, compiler_struct *cglobs)
     uses_var = usesvar(pc->op);
     if (uses_var) {
       Ventry *v = (Ventry *) (pc->rnd1);
+
+#ifdef BEAM
+   if (EAM) {
+      if (v->NoOfVE == Unassigned || v->KindOfVE!=PermVar) {
+	v->NoOfVE = PermVar | (nperm++);
+	v->KindOfVE = PermVar;
+	v->FlagsOfVE |= PermFlag;	
+      }
+   }
+#endif
       if (v->NoOfVE == Unassigned) {
 	if ((v->AgeOfVE > 1 && (v->AgeOfVE > v->FirstOfVE))
 	    || v->KindOfVE == PermVar	/*
@@ -2454,6 +2498,11 @@ c_layout(compiler_struct *cglobs)
 
   rn_to_kill[0] = rn_to_kill[1] = 0;
   cglobs->cint.cpc = cglobs->BodyStart;
+  /*
+#ifdef BEAM
+  if (!cglobs->is_a_fact || EAM) {
+#else
+  */
   if (!cglobs->is_a_fact) {
     while (v != NIL) {
       if (v->FlagsOfVE & BranchVar) {
@@ -2467,7 +2516,11 @@ c_layout(compiler_struct *cglobs)
     }
     cglobs->cint.cpc->nextInst = savepc;
 
+#ifdef BEAM
+    if (cglobs->needs_env || EAM) {
+#else
     if (cglobs->needs_env) {
+#endif
       nperm = 0;
       AssignPerm(cglobs->cint.CodeStart, cglobs);
 #ifdef DEBUG
@@ -2485,6 +2538,7 @@ c_layout(compiler_struct *cglobs)
 #endif
     }
   }
+
   cglobs->MaxCTemps = cglobs->nvars + cglobs->max_args - cglobs->tmpreg + cglobs->n_common_exps + 2;
   if (cglobs->MaxCTemps >= MaxTemps)
     cglobs->MaxCTemps = MaxTemps;
@@ -2496,7 +2550,9 @@ c_layout(compiler_struct *cglobs)
       *cop++ = NIL;
     }
   }
+
   CheckVoids(cglobs);
+
   /* second scan: allocate registers                                       */
   cglobs->cint.cpc = cglobs->cint.CodeStart;
   while (cglobs->cint.cpc) {
@@ -2542,7 +2598,11 @@ c_layout(compiler_struct *cglobs)
     case get_var_op:
       --cglobs->Uses[rn];
       if (checktemp(arg, rn, ic, cglobs)) {
+#ifdef BEAM
+	if (cglobs->vreg == rn && !EAM)
+#else
 	if (cglobs->vreg == rn)
+#endif
 	  cglobs->cint.cpc->op = nop_op;
       }
       cglobs->Contents[rn] = cglobs->vadr;
@@ -2590,7 +2650,11 @@ c_layout(compiler_struct *cglobs)
     case put_val_op:
       rn = checkreg(arg, rn, ic, TRUE, cglobs);
       checktemp(arg, rn, ic, cglobs);
+#ifdef BEAM
+      if (cglobs->Contents[rn] == (Term)cglobs->vadr && !EAM)
+#else
       if (cglobs->Contents[rn] == (Term)cglobs->vadr)
+#endif
 	cglobs->cint.cpc->op = nop_op;
       cglobs->Contents[rn] = cglobs->vadr;
       ++cglobs->Uses[rn];
@@ -3042,6 +3106,7 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
   cglobs.is_a_fact = (body == MkAtomTerm(AtomTrue));
   /* phase 1 : produce skeleton code and variable information              */
   c_head(head, &cglobs);
+
   if (cglobs.is_a_fact && !cglobs.vtable) {
 #ifdef TABLING
     READ_LOCK(cglobs.cint.CurrentPred->PRWLock);
@@ -3070,12 +3135,19 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
     cglobs->cut_mark = cpc;
 #endif /* TABLING_INNER_CUTS */
     Yap_emit(allocate_op, Zero, Zero, &cglobs.cint);
+
+#ifdef BEAM
+  if (EAM) Yap_emit(body_op, Zero, Zero, &cglobs.cint);
+#endif
+
     c_body(body, mod, &cglobs);
     /* Insert blobs at the very end */ 
+
     if (cglobs.cint.BlobsStart != NULL) {
       cglobs.cint.cpc->nextInst = cglobs.cint.BlobsStart;
       cglobs.cint.BlobsStart = NULL;
     }
+
     reset_vars(cglobs.vtable);
     H = HB;
     if (B != NULL) {
@@ -3103,10 +3175,15 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
   if (Yap_Option['f' - 96])
     Yap_ShowCode(&cglobs.cint);
 #endif
+
+#ifdef BEAM
+  void codigo_eam(compiler_struct *);
+  if (EAM) codigo_eam(&cglobs);
+#endif
+
   /* phase 3: assemble code                                                */
   acode = Yap_assemble(ASSEMBLING_CLAUSE, src, cglobs.cint.CurrentPred, (cglobs.is_a_fact && !cglobs.hasdbrefs), &cglobs.cint);
 
-
   /* check first if there was space for us */
   if (acode == NULL) {
     return NULL;
@@ -3116,7 +3193,12 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
       Yap_inform_profiler_of_clause(acode, ProfEnd, cglobs.cint.CurrentPred,0);
     }
 #endif /* LOW_PROF */
+
     return(acode);
   }
 }
 
+#ifdef BEAM
+  #include "toeam.c"
+#endif
+

C/computils.c

@@ -11,8 +11,11 @@
 * File:		computils.c						 *
 * comments:	some useful routines for YAP's compiler			 *
 *									 *
-* Last rev:     $Date: 2005-07-06 15:10:04 $							 *
+* Last rev:     $Date: 2005-09-08 22:06:44 $							 *
 * $Log: not supported by cvs2svn $
+* Revision 1.27  2005/07/06 15:10:04  vsc
+* improvements to compiler: merged instructions and fixes for ->
+*
 * Revision 1.26  2005/01/04 02:50:21  vsc
 * - allow MegaClauses with blobs
 * - change Diffs to be thread specific
@@ -336,6 +339,14 @@ ShowOp (char *f, struct PSEUDO *cpc)
       if (ch == '%')
 	switch (ch = *f++)
 	  {
+#ifdef BEAM
+	case '1':
+		Yap_plwrite(MkIntTerm(rn), Yap_DebugPutc, 0);
+		break;
+	case '4':
+		Yap_plwrite(MkIntTerm(arg), Yap_DebugPutc, 0);
+		break;
+#endif
 	  case 'a':
 	  case 'n':
 	    Yap_plwrite ((Term) arg, Yap_DebugPutc, 0);
@@ -654,6 +665,31 @@ static char *opformat[] =
 #ifdef TABLING_INNER_CUTS
   "clause_with_cut",
 #endif /* TABLING_INNER_CUTS */
+#ifdef BEAM
+  "run_op %1,%4",
+  "body_op %1",
+  "endgoal_op",
+  "try_me_op %1,%4",
+  "retry_me_op %1,%4",
+  "trust_me_op %1,%4",
+  "only_1_clause_op %1,%4",
+  "create_first_box_op %1,%4",
+  "create_box_op %1,%4",
+  "create_last_box_op %1,%4",
+  "remove_box_op %1,%4",
+  "remove_last_box_op %1,%4",
+  "prepare_tries",
+  "std_base_op %1,%4",
+  "direct_safe_call",
+  "commit_op",
+  "skip_while_var_op",
+  "wait_while_var_op",
+  "force_wait_op",
+  "write_op",
+  "is_op",
+  "equal_op",
+  "exit",
+#endif
   "fetch_args_for_bccall\t%v",
   "binary_cfunc\t\t%v,%P",
   "blob\t%O"

C/eval.c

@@ -32,8 +32,8 @@ yap_error_number Yap_matherror = YAP_NO_ERROR;
 #define E_FUNC   blob_type
 #define E_ARGS   arith_retptr o
 #define USE_E_ARGS   o
-#define RBIG(v)     (o)->big = v; return(big_int_e)
 
+#define RBIG(v)     (o)->big = v; return(big_int_e)
 #define RINT(v)     (o)->Int = v; return(long_int_e)
 #define RFLOAT(v)   (o)->dbl = v; return(double_e)
 #define RERROR()    return(db_ref_e)
@@ -181,6 +181,22 @@ Yap_Eval(Term t, E_ARGS)
   }
 }
 
+#ifdef BEAM
+Int BEAM_is(void);
+
+Int
+BEAM_is(void)
+{				/* X is Y	 */
+  union arith_ret res;
+  blob_type bt;
+
+  bt = Eval(Deref(XREGS[2]), &res);
+  if (bt==db_ref_e) return (NULL);
+  return (EvalToTerm(bt,&res));
+}
+
+#endif
+
 static Int
 p_is(void)
 {				/* X is Y	 */

C/grow.c

@@ -769,6 +769,31 @@ fix_compiler_instructions(PInstr *pcpc)
     case table_new_answer_op:
     case table_try_single_op:
 #endif /* TABLING */
+#ifdef BEAM
+    case run_op:
+    case body_op:
+    case endgoal_op:
+    case try_me_op:
+    case retry_me_op:
+    case trust_me_op:
+    case only_1_clause_op:
+    case create_first_box_op:
+    case create_box_op:
+    case create_last_box_op:
+    case remove_box_op:
+    case remove_last_box_op:
+    case prepare_tries:
+    case std_base_op:
+    case direct_safe_call_op:
+    case commit_op:
+    case skip_while_var_op:
+    case wait_while_var_op:
+    case force_wait_op:
+    case write_op:
+    case is_op:
+    case equal_op:
+    case exit_op:
+#endif
       break;
     }
     if (ncpc != NULL) {

C/index.c

@@ -11,8 +11,11 @@
 * File:		index.c							 *
 * comments:	Indexing a Prolog predicate				 *
 *									 *
-* Last rev:     $Date: 2005-08-17 18:48:35 $,$Author: vsc $						 *
+* Last rev:     $Date: 2005-09-08 22:06:44 $,$Author: rslopes $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.144  2005/08/17 18:48:35  vsc
+* fix bug in processing overflows of expand_clauses.
+*
 * Revision 1.143  2005/08/02 03:09:50  vsc
 * fix debugger to do well nonsource predicates.
 *
@@ -2240,6 +2243,9 @@ add_info(ClauseDef *clause, UInt regno)
     case _trie_try_long:
     case _trie_retry_long:
 #endif /* TABLING */
+#ifdef BEAM
+    case _run_eam:
+#endif
       clause->Tag = (CELL)NULL;
       return;
     }

C/iopreds.c

@@ -2726,6 +2726,22 @@ p_current_output (void)
   }
 }
 
+
+#ifdef BEAM
+int beam_write (void)
+{
+  Yap_StartSlots();
+  Yap_plwrite (ARG1, Stream[Yap_c_output_stream].stream_putc, 0);
+  if (EX != 0L) {
+    Term ball = EX;
+    EX = 0L;
+    Yap_JumpToEnv(ball);
+    return(FALSE);
+  }
+  return (TRUE);
+}
+#endif
+
 static Int
 p_write (void)
 {				/* '$write'(+Flags,?Term) */

C/stdpreds.c

@@ -11,8 +11,11 @@
 * File:		stdpreds.c						 *
 * comments:	General-purpose C implemented system predicates		 *
 *									 *
-* Last rev:     $Date: 2005-08-04 15:45:53 $,$Author: ricroc $						 *
+* Last rev:     $Date: 2005-09-08 22:06:45 $,$Author: rslopes $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.93  2005/08/04 15:45:53  ricroc
+* TABLING NEW: support to limit the table space size
+*
 * Revision 1.92  2005/07/20 13:54:27  rslopes
 * solved warning: cast from pointer to integer of different size
 *
@@ -173,7 +176,11 @@ STD_PROTO(static Int p_number_chars, (void));
 STD_PROTO(static Int p_number_codes, (void));
 STD_PROTO(static Int p_univ, (void));
 STD_PROTO(static Int p_abort, (void));
+#ifdef BEAM
+STD_PROTO(Int p_halt, (void));
+#else
 STD_PROTO(static Int p_halt, (void));
+#endif
 STD_PROTO(static Int init_current_atom, (void));
 STD_PROTO(static Int cont_current_atom, (void));
 STD_PROTO(static Int init_current_predicate, (void));
@@ -208,6 +215,84 @@ STD_PROTO(static Int p_walltime, (void));
 STD_PROTO(static Int p_access_yap_flags, (void));
 STD_PROTO(static Int p_set_yap_flags, (void));
 
+#ifdef BEAM
+STD_PROTO(Int use_eam, (void));
+STD_PROTO(Int eager_split, (void));
+STD_PROTO(Int force_wait, (void));
+STD_PROTO(Int commit, (void));
+STD_PROTO(Int skip_while_var, (void));
+STD_PROTO(Int wait_while_var, (void));
+STD_PROTO(Int show_time, (void));
+STD_PROTO(Int start_eam, (void));
+STD_PROTO(Int cont_eam, (void));
+
+extern int EAM;
+extern int eam_am(PredEntry*);
+extern int showTime(void); 
+
+Int start_eam(void) {
+  if (eam_am((PredEntry *) 0x1)) return (TRUE); 
+  else { cut_fail(); return (FALSE); }
+}
+
+Int cont_eam(void) {
+  if (eam_am((PredEntry *) 0x2)) return (TRUE); 
+  else { cut_fail(); return (FALSE); }
+}
+
+Int use_eam(void) { 
+  if (EAM)  EAM=0;
+    else { Yap_PutValue(Yap_FullLookupAtom("$c_arith"),0); EAM=1; }
+  return(TRUE);
+}
+
+Int commit(void) { 
+  if (EAM) {
+  printf("Nao deveria ter sido chamado commit do stdpreds\n");
+  exit(1);
+  }
+  return(TRUE);
+}
+
+Int skip_while_var(void) { 
+  if (EAM) {
+  printf("Nao deveria ter sido chamado skip_while_var do stdpreds\n");
+  exit(1);
+  }
+  return(TRUE);
+}
+
+Int wait_while_var(void) { 
+  if (EAM) {
+  printf("Nao deveria ter sido chamado wait_while_var do stdpreds\n");
+  exit(1);
+  }
+  return(TRUE);
+}
+
+Int force_wait(void) {
+  if (EAM) {
+  printf("Nao deveria ter sido chamado force_wait do stdpreds\n");
+  exit(1);
+  }
+  return(TRUE);
+}
+
+Int eager_split(void) {
+  if (EAM) {
+  printf("Nao deveria ter sido chamado eager_split do stdpreds\n");
+  exit(1);
+  }
+  return(TRUE);
+}
+
+Int show_time(void)  /* MORE PRECISION */
+{
+  return (showTime());
+}
+
+#endif /* BEAM */ 
+
 
 #ifdef LOW_PROF
 
@@ -2055,12 +2140,22 @@ p_abort(void)
   return(FALSE);
 }
 
+#ifdef BEAM
+extern void exit_eam(char *s); 
+
+Int 
+#else
 static Int 
+#endif
 p_halt(void)
 {				/* halt				 */
   Term t = Deref(ARG1);
   Int out;
 
+#ifdef BEAM
+  if (EAM) exit_eam("\n\n[ Prolog execution halted ]\n");
+#endif
+
   if (IsVarTerm(t)) {
     Yap_Error(INSTANTIATION_ERROR,t,"halt/1");
     return(FALSE);
@@ -2871,6 +2966,16 @@ p_has_yap_or(void)
 #endif
 }
 
+static Int 
+p_has_eam(void)
+{
+#ifdef BEAM
+  return(TRUE);
+#else
+  return(FALSE);
+#endif
+}
+
 
 static Int
 p_set_yap_flags(void)
@@ -3106,6 +3211,11 @@ Yap_InitBackCPreds(void)
 		SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPredBack("current_op", 3, 3, init_current_op, cont_current_op,
 		SafePredFlag|SyncPredFlag);
+#ifdef BEAM
+  Yap_InitCPredBack("eam", 1, 0, start_eam, cont_eam,
+		SafePredFlag);
+#endif
+
   Yap_InitBackIO();
   Yap_InitBackDB();
   Yap_InitUserBacks();
@@ -3150,6 +3260,15 @@ Yap_InitCPreds(void)
   Yap_InitCPred("$access_yap_flags", 2, p_access_yap_flags, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$set_yap_flags", 2, p_set_yap_flags, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("abort", 0, p_abort, SyncPredFlag);
+#ifdef BEAM
+  Yap_InitCPred("@", 0, eager_split, SafePredFlag);
+  Yap_InitCPred(":", 0, force_wait, SafePredFlag);
+  Yap_InitCPred("/", 0, commit, SafePredFlag);
+  Yap_InitCPred("skip_while_var",1,skip_while_var,SafePredFlag);
+  Yap_InitCPred("wait_while_var",1,wait_while_var,SafePredFlag);
+  Yap_InitCPred("eamtime", 0, show_time, SafePredFlag);
+  Yap_InitCPred("eam", 0, use_eam, SafePredFlag);
+#endif
   Yap_InitCPred("$halt", 1, p_halt, SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$lock_system", 0, p_lock_system, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$unlock_system", 0, p_unlock_system, SafePredFlag|HiddenPredFlag);
@@ -3171,6 +3290,7 @@ Yap_InitCPreds(void)
   Yap_InitCPred("unhide", 1, p_unhide, SafePredFlag|SyncPredFlag);
   Yap_InitCPred("$hidden", 1, p_hidden, SafePredFlag|SyncPredFlag|HiddenPredFlag);
   Yap_InitCPred("$has_yap_or", 0, p_has_yap_or, SafePredFlag|SyncPredFlag|HiddenPredFlag);
+  Yap_InitCPred("$has_eam", 0, p_has_eam, SafePredFlag|SyncPredFlag|HiddenPredFlag);
 #ifdef LOW_PROF
   Yap_InitCPred("profinit",0, profinit, SafePredFlag);
   Yap_InitCPred("profend" ,0, profend, SafePredFlag);