replace if-then-else optimisation by the new mechanism.

C/amasm.c

@@ -211,7 +211,6 @@ typedef struct cmp_op_info_struct {
 
 typedef struct clause_info_struct {
   int alloc_found, dealloc_found;
-  CELL commit_lab;
   struct pred_entry *CurrentPred;
 } clause_info;
 
@@ -539,6 +538,16 @@ a_ue(op_numbers opcode, op_numbers opcodew, yamop *code_p, int pass_no)
   return code_p;
 }
 
+inline static yamop *
+emit_fail(struct intermediates *cip)
+{
+  if (cip->failure_handler) {
+    return emit_a(Unsigned(cip->code_addr) + cip->label_offset[cip->failure_handler]);
+  } else {
+    return FAILCODE;
+  }
+}
+
 inline static yamop *
 a_v(op_numbers opcodex, op_numbers opcodey, yamop *code_p, int pass_no, struct PSEUDO *cpc)
 {
@@ -1430,9 +1439,9 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
       longjmp(cip->CompilerBotch, 1);
     }
     if (is_test) {
-      if (clinfo->commit_lab) {
+      UInt lab;
-	UInt lab = clinfo->commit_lab;
+
-	clinfo->commit_lab = 0;
+      if ((lab = cip->failure_handler)) {
 	return a_l(lab, op, code_p, pass_no, cip);
       } else {
 	return a_il((CELL)FAILCODE, op, code_p, pass_no, cip);
@@ -1444,7 +1453,7 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
   if (Flags & CPredFlag &&
       opcode == _call) {
     code_p = check_alloc(clinfo, code_p, pass_no, cip);
-    if (clinfo->commit_lab && (Flags & TestPredFlag)) {
+    if (cip->failure_handler && (Flags & TestPredFlag)) {
       if (pass_no) {
 	if (Flags & UserCPredFlag) {
 	  Yap_Error(INTERNAL_COMPILER_ERROR, TermNil,
@@ -1455,13 +1464,11 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
 	  code_p->opc = emit_op(_call_c_wfail);
 	code_p->u.slp.s =
 	  emit_count(-Signed(RealEnvSize) - CELLSIZE * cip->cpc->rnd2);
-	code_p->u.slp.l =
+	code_p->u.slp.l =  emit_fail(cip);
-	  emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
 	code_p->u.slp.p =
 	  emit_pe(RepPredProp(fe));
       }
       GONEXT(slp);
-      clinfo->commit_lab = 0;
     } else {
       if (pass_no) {
 	if (Flags & UserCPredFlag) {
@@ -1638,33 +1645,21 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_yy);
 	code_p->u.plyys.p = RepPredProp(((Prop)pred));
-	if (clinfo->commit_lab) {
+	code_p->u.plyys.f = emit_fail(cip);
-	  code_p->u.plyys.f = 
-	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
-	} else {
-	  code_p->u.plyys.f = FAILCODE;
-	}
 	code_p->u.plyys.y1 = v1;
 	code_p->u.plyys.y2 = emit_yreg(var_offset);
 	code_p->u.plyys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
-      clinfo->commit_lab = 0;
       GONEXT(plyys);
     } else {
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_yx);
 	code_p->u.plxys.p = RepPredProp(((Prop)pred));
-	if (clinfo->commit_lab) {
+	code_p->u.plxys.f = emit_fail(cip);
-	  code_p->u.plxys.f = 
-	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
-	} else {
-	  code_p->u.plxys.f = FAILCODE;
-	}
 	code_p->u.plxys.x = emit_xreg(var_offset);
 	code_p->u.plxys.y = v1;
 	code_p->u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
-      clinfo->commit_lab = 0;
       GONEXT(plxys);
     }
   } else {
@@ -1679,33 +1674,21 @@ a_bfunc(CELL pred, clause_info *clinfo, yamop *code_p, int pass_no, struct inter
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_xy);
 	code_p->u.plxys.p = RepPredProp(((Prop)pred));
-	if (clinfo->commit_lab) {
+	code_p->u.plxys.f = emit_fail(cip);
-	  code_p->u.plxys.f = 
-	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
-	} else {
-	  code_p->u.plxys.f = FAILCODE;
-	}
 	code_p->u.plxys.x = x1;
 	code_p->u.plxys.y = emit_yreg(var_offset);
 	code_p->u.plxys.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
-      clinfo->commit_lab = 0;
       GONEXT(plxys);
     } else {
       if (pass_no) {
 	code_p->opc = emit_op(_call_bfunc_xx);
 	code_p->u.plxxs.p = RepPredProp(((Prop)pred));
-	if (clinfo->commit_lab) {
+	code_p->u.plxxs.f = emit_fail(cip);
-	  code_p->u.plxxs.f = 
-	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[clinfo->commit_lab]);
-	} else {
-	  code_p->u.plxxs.f = FAILCODE;
-	}
 	code_p->u.plxxs.x1 = x1;
 	code_p->u.plxxs.x2 = emit_xreg(var_offset);
 	code_p->u.plxxs.flags = compile_cmp_flags(RepAtom(NameOfFunctor(RepPredProp(((Prop)pred))->FunctorOfPred))->StrOfAE);
       }
-      clinfo->commit_lab = 0;
       GONEXT(plxxs);
     }
   }
@@ -2521,14 +2504,8 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
 	  code_p->opc = opcode(_p_primitive_y);
 	  break;
 	}
-	if (cmp_info->cl_info->commit_lab) {
+	code_p->u.yl.F = emit_fail(cip);
-	  code_p->u.yl.F = 
-	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[cmp_info->cl_info->commit_lab]);
-	} else {
-	  code_p->u.yl.F = FAILCODE;
-	}
       }
-      cmp_info->cl_info->commit_lab = 0;
       GONEXT(yl);
       return code_p;
     } else {
@@ -2569,14 +2546,8 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
 	  code_p->opc = opcode(_p_primitive_x);
 	  break;
 	}
-	if (cmp_info->cl_info->commit_lab) {
+	code_p->u.xl.F = emit_fail(cip);
-	  code_p->u.xl.F = 
-	    emit_a(Unsigned(cip->code_addr) + cip->label_offset[cmp_info->cl_info->commit_lab]);
-	} else {
-	  code_p->u.xl.F = FAILCODE;
-	}
       }
-      cmp_info->cl_info->commit_lab = 0;
       GONEXT(xl);
       return code_p;
     }
@@ -2925,20 +2896,38 @@ a_f2(int var, cmp_op_info *cmp_info, yamop *code_p, int pass_no, struct intermed
 static yamop *
 a_special_label(yamop *code_p, int pass_no, struct intermediates *cip)
 {
-  special_label_id lab_id = cip->cpc->rnd1;
+  special_label_op lab_op = cip->cpc->rnd1;
-  UInt             lab_val = cip->cpc->rnd2;
+  special_label_id lab_id = cip->cpc->rnd2;
+  UInt             lab_val = cip->cpc->rnd3;
 
-  switch (lab_id) {
+  switch (lab_op) {
-  case SPECIAL_LABEL_EXCEPTION:
+  case SPECIAL_LABEL_INIT:
-    cip->exception_handler = lab_val;
+    switch (lab_id) {
+    case SPECIAL_LABEL_EXCEPTION:
+      cip->exception_handler = lab_val;
+      break;
+    case SPECIAL_LABEL_SUCCESS:
+      cip->success_handler = lab_val;
+      break;
+    case SPECIAL_LABEL_FAILURE:
+      cip->failure_handler = lab_val;
+      break;
+    }
+  case SPECIAL_LABEL_SET:
     break;
-  case SPECIAL_LABEL_SUCCESS:
+  case SPECIAL_LABEL_CLEAR:
-    cip->success_handler = lab_val;
+    switch (lab_id) {
-    break;
+    case SPECIAL_LABEL_EXCEPTION:
-  case SPECIAL_LABEL_FAILURE:
+      cip->exception_handler = 0;
-    cip->failure_handler = lab_val;
+      break;
-    break;
+    case SPECIAL_LABEL_SUCCESS:
-  }
+      cip->success_handler = 0;
+      break;
+    case SPECIAL_LABEL_FAILURE:
+      cip->failure_handler = 0;
+      break;
+    }
+  }    
   return code_p;
 }
 
@@ -2975,7 +2964,6 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
   cip->cpc = cip->CodeStart;
   clinfo.alloc_found = 0;
   clinfo.dealloc_found = FALSE;
-  clinfo.commit_lab = 0L;
   clinfo.CurrentPred = cip->CurrentPred;
   cip->current_try_lab = NULL;
   cip->exception_handler = 0;
@@ -3780,9 +3768,6 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
       }
       code_p = a_bregs(code_p, pass_no, cip->cpc);
       break;
-    case commit_opt_op:
-      clinfo.commit_lab = cip->cpc->rnd1;
-      break;
     case fetch_args_vv_op:
       a_fetch_vv(&cmp_info, pass_no, cip);
       break;

C/compiler.c

@@ -649,9 +649,9 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
   if (IsVarTerm(t))
     c_var(t, argno, arity, level, cglobs);
   else if (IsAtomTerm(t)) {
-    if (level == 0)
+    if (level == 0) {      
       Yap_emit((cglobs->onhead ? get_atom_op : put_atom_op), (CELL) t, argno, &cglobs->cint);
-    else
+    } else
       Yap_emit((cglobs->onhead ? (argno == (Int)arity ? unify_last_atom_op
 		      : unify_atom_op) :
 	    write_atom_op), (CELL) t, Zero, &cglobs->cint);
@@ -870,6 +870,7 @@ c_eq(Term t1, Term t2, compiler_struct *cglobs)
       }
     }
   }
+  /* first argument is an unbound var */
   c_var(t1, 0, 0, 0, cglobs);
   cglobs->onhead = TRUE;
   if (IsVarTerm(t2)) {
@@ -1399,7 +1400,7 @@ emit_special_label(Term Goal, compiler_struct *cglobs)
       cglobs->cint.failure_handler = label_name;
       break;
     }
-    Yap_emit(label_ctl_op, lab_op, label_name, &cglobs->cint);
+    Yap_emit_3ops(label_ctl_op, lab_op, lab_id, label_name, &cglobs->cint);
     break;
   case SPECIAL_LABEL_SET:
     switch (lab_id) {
@@ -1598,8 +1599,9 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	     * let them think they are still the
 	     * first 
 	     */
-	    Yap_emit(commit_opt_op, l, Zero, &cglobs->cint);
+	    //	    Yap_emit(commit_opt_op, l, Zero, &cglobs->cint);
 	    optimizing_commit = TRUE;
+	    Yap_emit_3ops(label_ctl_op, SPECIAL_LABEL_INIT, SPECIAL_LABEL_FAILURE, l, &cglobs->cint);
 	  }
 	  else {
 	    optimizing_commit = FALSE;
@@ -1656,6 +1658,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	  if (!optimizing_commit) {
 	    c_var((Term) commitvar, commit_b_flag,
 		  1, 0, cglobs);
+	  } else {
+	    Yap_emit_3ops(label_ctl_op, SPECIAL_LABEL_CLEAR, SPECIAL_LABEL_FAILURE, l, &cglobs->cint);
 	  }
 	  cglobs->onlast = save;
 	  c_goal(ArgOfTerm(2, arg), mod, cglobs);
@@ -1666,6 +1670,8 @@ c_goal(Term Goal, int mod, compiler_struct *cglobs)
 	}
 	if (!cglobs->onlast) {
 	  Yap_emit(jump_op, m, Zero, &cglobs->cint);
+	} else {
+	  
 	}
 	if (!optimizing_commit || !cglobs->onlast) {
 	  cglobs->goalno = savegoalno + 1;

C/computils.c

@@ -107,33 +107,53 @@ Yap_AllocCMem (int size, struct intermediates *cip)
   return(AllocCMem(size, cip));
 }
 
-int
+static int
-Yap_is_a_test_pred (Term arg, Term mod)
+is_a_test(Term arg, Term mod)
 {
   if (IsVarTerm (arg)) {
     return FALSE;
-  } else if (IsAtomTerm (arg)) {
+  }
+  if (IsVarTerm (arg) || !IsAtomTerm(mod)) {
+    return FALSE;
+  }
+  if (IsAtomTerm (arg)) {
       Atom At = AtomOfTerm (arg);
       PredEntry *pe = RepPredProp(PredPropByAtom(At, mod));
       if (EndOfPAEntr(pe))
 	return FALSE;
       return pe->PredFlags & TestPredFlag;
-  } else if (IsApplTerm (arg)) {
-    Functor f = FunctorOfTerm (arg);
-    PredEntry *pe = RepPredProp(PredPropByFunc(f, mod));
-    if (EndOfPAEntr(pe))
-      return FALSE;
-    if (pe->PredFlags & AsmPredFlag) {
-      int op = pe->PredFlags & 0x7f;
-      if (op >= _atom && op <= _eq) {
-	return TRUE;
-      }
-      return FALSE;
-    }      
-    return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
-  } else {
-    return FALSE;
   }
+  if (IsApplTerm (arg)) {
+    Functor f = FunctorOfTerm (arg);
+
+    if (f == FunctorModule) {
+      return is_a_test(ArgOfTerm(2,arg), ArgOfTerm(1,arg));
+    } else if (f == FunctorComma) {
+      return
+	is_a_test(ArgOfTerm(1,arg), mod) &&
+	is_a_test(ArgOfTerm(2,arg), mod);
+    } else {
+      PredEntry *pe = RepPredProp(PredPropByFunc(f, mod));
+
+      if (EndOfPAEntr(pe))
+	return FALSE;
+      if (pe->PredFlags & AsmPredFlag) {
+	int op = pe->PredFlags & 0x7f;
+	if (op >= _atom && op <= _eq) {
+	  return TRUE;
+	}
+	return FALSE;
+      }      
+      return pe->PredFlags & (TestPredFlag|BinaryTestPredFlag);
+    }
+  }
+  return FALSE;
+}
+
+int
+Yap_is_a_test_pred (Term arg, Term mod)
+{
+  return is_a_test(arg, mod);
 }
 
 void
@@ -709,7 +729,6 @@ static char *opformat[] =
   "prepare_tries",
   "std_base_op %1,%4",
   "direct_safe_call",
-  "commit_op",
   "skip_while_var_op",
   "wait_while_var_op",
   "force_wait_op",

C/grow.c

@@ -1068,7 +1068,6 @@ fix_compiler_instructions(PInstr *pcpc)
     case index_dbref_op:
     case index_blob_op:
     case if_nonvar_op:
-    case commit_opt_op:
     case unify_last_list_op:
     case write_last_list_op:
     case unify_last_struct_op:

H/compile.h

@@ -108,7 +108,6 @@ typedef enum compiler_op {
   if_nonvar_op,
   save_pair_op,
   save_appl_op,
-  commit_opt_op,
   unify_local_op,
   write_local_op,
   unify_last_list_op,