diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

== and \= should not need a choice-point in ->

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1321 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-06-01 20:25:23 +00:00
parent b2ecd33c89
commit 7af3eafd12
5 changed files with 133 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
C/absmi.c
View File

@ -10,8 +10,12 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-06-01 14:02:45 $,$Author: vsc $ *
* Last rev: $Date: 2005-06-01 20:25:22 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.165 2005/06/01 14:02:45 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
*
* Revision 1.164 2005/05/26 18:07:32 vsc
* fix warning
*
@ -10196,7 +10200,7 @@ Yap_absmi(int inp)
GONext();
ENDOp();
Op(p_dif, e);
Op(p_dif, l);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("\\="),2),0)),XREGS+1);
@ -10212,10 +10216,11 @@ Yap_absmi(int inp)
dif_nvar1_nvar2:
/* both arguments are bound */
if (d0 == d1) {
FAIL();
PREG = PREG->u.l.l;
GONext();
}
if (IsAtomOrIntTerm(d0) || IsAtomOrIntTerm(d1)) {
PREG = NEXTOP(PREG, e);
PREG = NEXTOP(PREG, l);
GONext();
}
{
@ -10244,11 +10249,12 @@ Yap_absmi(int inp)
save_hb();
if (Yap_IUnify(d0, d1) == TRUE) {
/* restore B, no need to restore HB */
PREG = PREG->u.l.l;
B = pt1;
FAIL();
GONext();
}
/* restore B, and later HB */
PREG = NEXTOP(PREG, e);
PREG = NEXTOP(PREG, l);
B = pt1;
SET_BB(PROTECT_FROZEN_B(pt1));
ENDCHO(pt1);
@ -10294,18 +10300,20 @@ Yap_absmi(int inp)
deref_body(d0, pt0, dif_unk1, dif_nvar1);
ENDP(pt0);
/* first argument is unbound */
FAIL();
PREG = PREG->u.l.l;
GONext();
BEGP(pt0);
deref_body(d1, pt0, dif_nvar1_unk2, dif_nvar1_nvar2);
ENDP(pt0);
/* second argument is unbound */
FAIL();
PREG = PREG->u.l.l;
GONext();
ENDD(d1);
ENDD(d0);
ENDOp();
Op(p_eq, e);
Op(p_eq, l);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(Yap_LookupAtom("=="),2),0)),XREGS+1);
@ -10321,22 +10329,24 @@ Yap_absmi(int inp)
p_eq_nvar1_nvar2:
/* both arguments are bound */
if (d0 == d1) {
PREG = NEXTOP(PREG, e);
PREG = NEXTOP(PREG, l);
GONext();
}
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
FAIL();
PREG = PREG->u.l.l;
GONext();
}
BEGD(d2);
always_save_pc();
d2 = iequ_complex(RepPair(d0)-1, RepPair(d0)+1,RepPair(d1)-1);
if (d2 == FALSE) {
FAIL();
PREG = PREG->u.l.l;
GONext();
}
ENDD(d2);
always_set_pc();
PREG = NEXTOP(PREG, e);
PREG = NEXTOP(PREG, l);
GONext();
}
if (IsApplTerm(d0)) {
@ -10345,46 +10355,73 @@ Yap_absmi(int inp)
/* f1 must be a compound term, even if it is a suspension */
if (!IsApplTerm(d1)) {
FAIL();
PREG = PREG->u.l.l;
GONext();
}
f1 = FunctorOfTerm(d1);
PREG = NEXTOP(PREG, e);
/* we now know f1 is true */
/* deref if a compound term */
if (IsExtensionFunctor(f0)) {
switch ((CELL)f0) {
case (CELL)FunctorDBRef:
if (d0 == d1) GONext();
FAIL();
if (d0 == d1) {
PREG = NEXTOP(PREG, l);
GONext();
}
PREG = PREG->u.l.l;
GONext();
case (CELL)FunctorLongInt:
if (f1 != FunctorLongInt) FAIL();
if (LongIntOfTerm(d0) == LongIntOfTerm(d1)) GONext();
FAIL();
if (f1 != FunctorLongInt) {
PREG = PREG->u.l.l;
GONext();
}
if (LongIntOfTerm(d0) == LongIntOfTerm(d1)) {
PREG = NEXTOP(PREG, l);
GONext();
}
PREG = PREG->u.l.l;
GONext();
#ifdef USE_GMP
case (CELL)FunctorBigInt:
if (f1 != FunctorBigInt) FAIL();
if (mpz_cmp(Yap_BigIntOfTerm(d0), Yap_BigIntOfTerm(d1)) == 0) GONext();
FAIL();
if (f1 != FunctorBigInt) {
PREG = PREG->u.l.l;
GONext();
}
if (mpz_cmp(Yap_BigIntOfTerm(d0), Yap_BigIntOfTerm(d1)) == 0) {
PREG = NEXTOP(PREG, l);
GONext();
}
PREG = PREG->u.l.l;
GONext();
#endif
case (CELL)FunctorDouble:
if (f1 != FunctorDouble) FAIL();
if (FloatOfTerm(d0) == FloatOfTerm(d1)) GONext();
FAIL();
if (f1 != FunctorDouble) {
PREG = PREG->u.l.l;
GONext();
}
if (FloatOfTerm(d0) == FloatOfTerm(d1)) {
PREG = NEXTOP(PREG, l);
GONext();
}
default:
FAIL();
PREG = PREG->u.l.l;
GONext();
}
}
if (f0 != f1) {
FAIL();
PREG = PREG->u.l.l;
GONext();
}
always_save_pc();
BEGD(d2);
d2 = iequ_complex(RepAppl(d0), RepAppl(d0)+ArityOfFunctor(f0), RepAppl(d1));
if (d2 == FALSE) {
FAIL();
PREG = PREG->u.l.l;
GONext();
}
ENDD(d2);
PREG = NEXTOP(PREG, l);
always_set_pc();
GONext();
}
@ -10397,7 +10434,8 @@ Yap_absmi(int inp)
/* second argument is unbound */
/* I don't need to worry about co-routining because an
unbound variable may never be == to a constrained variable!! */
FAIL();
PREG = PREG->u.l.l;
GONext();
ENDD(d1);
BEGP(pt0);
@ -10408,16 +10446,19 @@ Yap_absmi(int inp)
p_eq_var1_nvar2:
/* I don't need to worry about co-routining because an
unbound variable may never be == to a constrained variable!! */
FAIL();
PREG = PREG->u.l.l;
GONext();
BEGP(pt1);
deref_body(d1, pt1, p_eq_var1_unk2, p_eq_var1_nvar2);
/* first argument is unbound */
/* second argument is unbound */
if (pt1 != pt0) {
PREG = PREG->u.l.l;
GONext();
FAIL();
}
PREG = NEXTOP(PREG, e);
PREG = NEXTOP(PREG, l);
GONext();
ENDP(pt1);
ENDD(d1);

63
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2005-06-01 16:42:30 $ *
* Last rev: $Date: 2005-06-01 20:25:23 $ *
* $Log: not supported by cvs2svn $
* Revision 1.79 2005/06/01 16:42:30 vsc
* put switch_list_nl back
*
* Revision 1.78 2005/06/01 14:02:47 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
@ -907,6 +910,28 @@ check_alloc(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediate
return code_p;
}
static yamop *
a_l(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.l.l = emit_a(Unsigned(cip->code_addr) + cip->label_offset[rnd1]);
}
GONEXT(l);
return code_p;
}
static yamop *
a_il(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.l.l = emit_ilabel(rnd1, cip);
}
GONEXT(l);
return code_p;
}
static yamop *
a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
{ /* emit opcode & predicate code address */
@ -914,6 +939,7 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
CELL Flags = RepPredProp(fe)->PredFlags;
if (Flags & AsmPredFlag) {
op_numbers op;
int is_test = FALSE;
code_p = check_alloc(clinfo, code_p, pass_no, cip);
switch (Flags & 0x7f) {
@ -922,9 +948,11 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
break;
case _dif:
op = _p_dif;
is_test = TRUE;
break;
case _eq:
op = _p_eq;
is_test = TRUE;
break;
case _functor:
op = _p_functor;
@ -935,8 +963,19 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
save_machine_regs();
longjmp(cip->CompilerBotch, 1);
}
if (is_test) {
UInt lab;
if (clinfo->commit_lab) {
lab = clinfo->commit_lab;
clinfo->commit_lab = 0;
} else {
lab = (CELL)FAILCODE;
}
return a_il(lab, op, code_p, pass_no, cip);
} else {
return a_e(op, code_p, pass_no);
}
}
if (Flags & CPredFlag) {
code_p = check_alloc(clinfo, code_p, pass_no, cip);
if (clinfo->commit_lab && (Flags & TestPredFlag)) {
@ -1056,28 +1095,6 @@ a_empty_call(clause_info *clinfo, yamop *code_p, int pass_no, struct intermedia
return code_p;
}
static yamop *
a_l(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.l.l = emit_a(Unsigned(cip->code_addr) + cip->label_offset[rnd1]);
}
GONEXT(l);
return code_p;
}
static yamop *
a_il(CELL rnd1, op_numbers opcode, yamop *code_p, int pass_no, struct intermediates *cip)
{
if (pass_no) {
code_p->opc = emit_op(opcode);
code_p->u.l.l = emit_ilabel(rnd1, cip);
}
GONEXT(l);
return code_p;
}
static yamop *
a_pl(op_numbers opcode, PredEntry *pred, yamop *code_p, int pass_no)
{

9
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-06-01 16:42:30 $,$Author: vsc $ *
* Last rev: $Date: 2005-06-01 20:25:23 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.134 2005/06/01 16:42:30 vsc
* put switch_list_nl back
*
* Revision 1.133 2005/06/01 14:02:50 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
@ -719,6 +722,8 @@ has_cut(yamop *pc)
case _retry2:
case _retry3:
case _retry4:
case _p_eq:
case _p_dif:
pc = NEXTOP(pc,l);
break;
case _jump_if_nonvar:
@ -749,8 +754,6 @@ has_cut(yamop *pc)
case _undef_p:
case _spy_pred:
case _p_equal:
case _p_dif:
case _p_eq:
case _p_functor:
case _p_execute_tail:
case _enter_a_profiling:

10
H/YapOpcodes.h
View File

@ -11,8 +11,12 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2005-06-01 14:02:52 $ *
* Last rev: $Date: 2005-06-01 20:25:23 $ *
* $Log: not supported by cvs2svn $
* Revision 1.27 2005/06/01 14:02:52 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
*
* Revision 1.26 2005/04/10 04:01:13 vsc
* bug fixes, I hope!
*
@ -334,8 +338,8 @@
OPCODE(p_primitive_x ,xF),
OPCODE(p_primitive_y ,yF),
OPCODE(p_equal ,e),
OPCODE(p_dif ,e),
OPCODE(p_eq ,e),
OPCODE(p_dif ,l),
OPCODE(p_eq ,l),
OPCODE(p_functor ,e),
OPCODE(p_plus_vv ,xxx),
OPCODE(p_plus_vc ,xxc),

8
H/rclause.h
View File

@ -12,8 +12,12 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2005-06-01 14:02:52 $,$Author: vsc $ *
* Last rev: $Date: 2005-06-01 20:25:23 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.4 2005/06/01 14:02:52 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
*
* Revision 1.3 2005/05/30 03:26:37 vsc
* add some atom gc fixes
*
@ -155,6 +159,7 @@ restore_opcodes(yamop *pc)
case _retry2:
case _retry3:
case _retry4:
case _p_eq:
pc->u.l.l = PtoOpAdjust(pc->u.l.l);
pc = NEXTOP(pc,l);
break;
@ -196,7 +201,6 @@ restore_opcodes(yamop *pc)
case _spy_pred:
case _p_equal:
case _p_dif:
case _p_eq:
case _p_functor:
case _enter_a_profiling:
case _count_a_call: