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

63
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * 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 $ * $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 * Revision 1.78 2005/06/01 14:02:47 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not * get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays. * significantly used nowadays.
@ -907,6 +910,28 @@ check_alloc(clause_info *clinfo, yamop *code_p, int pass_no, struct intermediate
return code_p; 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 * static yamop *
a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip) a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct intermediates *cip)
{ /* emit opcode & predicate code address */ { /* 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; CELL Flags = RepPredProp(fe)->PredFlags;
if (Flags & AsmPredFlag) { if (Flags & AsmPredFlag) {
op_numbers op; op_numbers op;
int is_test = FALSE;
code_p = check_alloc(clinfo, code_p, pass_no, cip); code_p = check_alloc(clinfo, code_p, pass_no, cip);
switch (Flags & 0x7f) { switch (Flags & 0x7f) {
@ -922,9 +948,11 @@ a_p(op_numbers opcode, clause_info *clinfo, yamop *code_p, int pass_no, struct i
break; break;
case _dif: case _dif:
op = _p_dif; op = _p_dif;
is_test = TRUE;
break; break;
case _eq: case _eq:
op = _p_eq; op = _p_eq;
is_test = TRUE;
break; break;
case _functor: case _functor:
op = _p_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(); save_machine_regs();
longjmp(cip->CompilerBotch, 1); 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); return a_e(op, code_p, pass_no);
} }
}
if (Flags & CPredFlag) { if (Flags & CPredFlag) {
code_p = check_alloc(clinfo, code_p, pass_no, cip); code_p = check_alloc(clinfo, code_p, pass_no, cip);
if (clinfo->commit_lab && (Flags & TestPredFlag)) { 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; 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 * static yamop *
a_pl(op_numbers opcode, PredEntry *pred, yamop *code_p, int pass_no) 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 * * File: index.c *
* comments: Indexing a Prolog predicate * * 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 $ * $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 * Revision 1.133 2005/06/01 14:02:50 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not * get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays. * significantly used nowadays.
@ -719,6 +722,8 @@ has_cut(yamop *pc)
case _retry2: case _retry2:
case _retry3: case _retry3:
case _retry4: case _retry4:
case _p_eq:
case _p_dif:
pc = NEXTOP(pc,l); pc = NEXTOP(pc,l);
break; break;
case _jump_if_nonvar: case _jump_if_nonvar:
@ -749,8 +754,6 @@ has_cut(yamop *pc)
case _undef_p: case _undef_p:
case _spy_pred: case _spy_pred:
case _p_equal: case _p_equal:
case _p_dif:
case _p_eq:
case _p_functor: case _p_functor:
case _p_execute_tail: case _p_execute_tail:
case _enter_a_profiling: case _enter_a_profiling:

10
H/YapOpcodes.h
View File

@ -11,8 +11,12 @@
* File: YapOpcodes.h * * File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes * * 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 $ * $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 * Revision 1.26 2005/04/10 04:01:13 vsc
* bug fixes, I hope! * bug fixes, I hope!
* *
@ -334,8 +338,8 @@
OPCODE(p_primitive_x ,xF), OPCODE(p_primitive_x ,xF),
OPCODE(p_primitive_y ,yF), OPCODE(p_primitive_y ,yF),
OPCODE(p_equal ,e), OPCODE(p_equal ,e),
OPCODE(p_dif ,e), OPCODE(p_dif ,l),
OPCODE(p_eq ,e), OPCODE(p_eq ,l),
OPCODE(p_functor ,e), OPCODE(p_functor ,e),
OPCODE(p_plus_vv ,xxx), OPCODE(p_plus_vv ,xxx),
OPCODE(p_plus_vc ,xxc), OPCODE(p_plus_vc ,xxc),

8
H/rclause.h
View File

@ -12,8 +12,12 @@
* File: rclause.h * * File: rclause.h *
* comments: walk through a clause * * 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 $ * $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 * Revision 1.3 2005/05/30 03:26:37 vsc
* add some atom gc fixes * add some atom gc fixes
* *
@ -155,6 +159,7 @@ restore_opcodes(yamop *pc)
case _retry2: case _retry2:
case _retry3: case _retry3:
case _retry4: case _retry4:
case _p_eq:
pc->u.l.l = PtoOpAdjust(pc->u.l.l); pc->u.l.l = PtoOpAdjust(pc->u.l.l);
pc = NEXTOP(pc,l); pc = NEXTOP(pc,l);
break; break;
@ -196,7 +201,6 @@ restore_opcodes(yamop *pc)
case _spy_pred: case _spy_pred:
case _p_equal: case _p_equal:
case _p_dif: case _p_dif:
case _p_eq:
case _p_functor: case _p_functor:
case _enter_a_profiling: case _enter_a_profiling:
case _count_a_call: case _count_a_call: