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

step towards better emulation of SWI in backtrackable predicates.

Browse Source
This commit is contained in:
Vitor Santos Costa 2009-06-01 15:32:36 -05:00
parent 45a1544307
commit 0bd3c910dd
1 changed files with 152 additions and 80 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
C/c_interface.c
View File

@ -1084,7 +1084,7 @@ typedef enum
FRG_REDO = 2 /* Normal redo */ FRG_REDO = 2 /* Normal redo */
} frg_code; } frg_code;
typedef struct context typedef struct foreign_context
{ int * context; /* context value */ { int * context; /* context value */
frg_code control; /* FRG_* action */ frg_code control; /* FRG_* action */
struct PL_local_data *engine; /* invoking engine */ struct PL_local_data *engine; /* invoking engine */
@ -1098,18 +1098,11 @@ typedef Int (*CPredicate5)(long,long,long,long,long);
typedef Int (*CPredicate6)(long,long,long,long,long,long); typedef Int (*CPredicate6)(long,long,long,long,long,long);
typedef Int (*CPredicate7)(long,long,long,long,long,long,long); typedef Int (*CPredicate7)(long,long,long,long,long,long,long);
typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long); typedef Int (*CPredicate8)(long,long,long,long,long,long,long,long);
typedef Int (*CPredicateV)(Int,Int,struct context *); typedef Int (*CPredicateV)(Int,Int,struct foreign_context *);
Int static Int
YAP_Execute(PredEntry *pe, CPredicate exec_code) execute_cargs(PredEntry *pe, CPredicate exec_code)
{ {
if (pe->PredFlags & SWIEnvPredFlag) {
CPredicateV codev = (CPredicateV)exec_code;
struct context ctx;
return ((codev)((&ARG1)-LCL0,0,&ctx));
}
if (pe->PredFlags & CArgsPredFlag) {
switch (pe->ArityOfPE) { switch (pe->ArityOfPE) {
case 0: case 0:
{ {
@ -1119,79 +1112,158 @@ YAP_Execute(PredEntry *pe, CPredicate exec_code)
case 1: case 1:
{ {
CPredicate1 code1 = (CPredicate1)exec_code; CPredicate1 code1 = (CPredicate1)exec_code;
return ((code1)(YAP_InitSlot(Deref(ARG1)))); return ((code1)(Yap_InitSlot(Deref(ARG1))));
} }
case 2: case 2:
{ {
CPredicate2 code2 = (CPredicate2)exec_code; CPredicate2 code2 = (CPredicate2)exec_code;
return ((code2)(YAP_InitSlot(Deref(ARG1)), return ((code2)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)))); Yap_InitSlot(Deref(ARG2))));
} }
case 3: case 3:
{ {
CPredicate3 code3 = (CPredicate3)exec_code; CPredicate3 code3 = (CPredicate3)exec_code;
return ((code3)(YAP_InitSlot(Deref(ARG1)), return ((code3)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)), Yap_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)))); Yap_InitSlot(Deref(ARG3))));
} }
case 4: case 4:
{ {
CPredicate4 code4 = (CPredicate4)exec_code; CPredicate4 code4 = (CPredicate4)exec_code;
return ((code4)(YAP_InitSlot(Deref(ARG1)), return ((code4)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)), Yap_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)), Yap_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)))); Yap_InitSlot(Deref(ARG4))));
} }
case 5: case 5:
{ {
CPredicate5 code5 = (CPredicate5)exec_code; CPredicate5 code5 = (CPredicate5)exec_code;
return ((code5)(YAP_InitSlot(Deref(ARG1)), return ((code5)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)), Yap_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)), Yap_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)), Yap_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)))); Yap_InitSlot(Deref(ARG5))));
} }
case 6: case 6:
{ {
CPredicate6 code6 = (CPredicate6)exec_code; CPredicate6 code6 = (CPredicate6)exec_code;
return ((code6)(YAP_InitSlot(Deref(ARG1)), return ((code6)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)), Yap_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)), Yap_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)), Yap_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)), Yap_InitSlot(Deref(ARG5)),
YAP_InitSlot(Deref(ARG6)))); Yap_InitSlot(Deref(ARG6))));
} }
case 7: case 7:
{ {
CPredicate7 code7 = (CPredicate7)exec_code; CPredicate7 code7 = (CPredicate7)exec_code;
return ((code7)(YAP_InitSlot(Deref(ARG1)), return ((code7)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)), Yap_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)), Yap_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)), Yap_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)), Yap_InitSlot(Deref(ARG5)),
YAP_InitSlot(Deref(ARG6)), Yap_InitSlot(Deref(ARG6)),
YAP_InitSlot(Deref(ARG7)))); Yap_InitSlot(Deref(ARG7))));
} }
case 8: case 8:
{ {
CPredicate8 code8 = (CPredicate8)exec_code; CPredicate8 code8 = (CPredicate8)exec_code;
return ((code8)(YAP_InitSlot(Deref(ARG1)), return ((code8)(Yap_InitSlot(Deref(ARG1)),
YAP_InitSlot(Deref(ARG2)), Yap_InitSlot(Deref(ARG2)),
YAP_InitSlot(Deref(ARG3)), Yap_InitSlot(Deref(ARG3)),
YAP_InitSlot(Deref(ARG4)), Yap_InitSlot(Deref(ARG4)),
YAP_InitSlot(Deref(ARG5)), Yap_InitSlot(Deref(ARG5)),
YAP_InitSlot(Deref(ARG6)), Yap_InitSlot(Deref(ARG6)),
YAP_InitSlot(Deref(ARG7)), Yap_InitSlot(Deref(ARG7)),
YAP_InitSlot(Deref(ARG8)))); Yap_InitSlot(Deref(ARG8))));
} }
default: default:
return(FALSE); return(FALSE);
} }
}
Int
YAP_Execute(PredEntry *pe, CPredicate exec_code)
{
if (pe->PredFlags & SWIEnvPredFlag) {
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context ctx;
ctx.engine = (struct PL_local_data *)Yap_regp;
return ((codev)((&ARG1)-LCL0,0,&ctx));
}
if (pe->PredFlags & CArgsPredFlag) {
return execute_cargs(pe, exec_code);
} else { } else {
return((exec_code)()); return((exec_code)());
} }
} }
#define FRG_REDO_MASK 0x00000003L
#define FRG_REDO_BITS 2
#define REDO_INT 0x02 /* Returned an integer */
#define REDO_PTR 0x03 /* returned a pointer */
Int
YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code)
{
if (pe->PredFlags & SWIEnvPredFlag) {
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
ctx->control = FRG_FIRST_CALL;
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
ctx->context = NULL;
val = ((codev)((&ARG1)-LCL0,0,ctx));
if (val == 0) {
cut_fail();
} else if (val == 1) { /* TRUE */
cut_succeed();
} else {
if ((val & REDO_PTR) == REDO_PTR)
ctx->context = (int *)(val & ~REDO_PTR);
else
ctx->context = (int *)((val & ~REDO_PTR)>>FRG_REDO_BITS);
}
}
if (pe->PredFlags & CArgsPredFlag) {
return execute_cargs(pe, exec_code);
} else {
return (exec_code)();
}
}
Int
YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code)
{
if (pe->PredFlags & SWIEnvPredFlag) {
Int val;
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context *ctx = (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE,1));
ctx->control = FRG_REDO;
val = ((codev)((&ARG1)-LCL0,0,ctx));
if (val == 0) {
cut_fail();
} else if (val == 1) { /* TRUE */
cut_succeed();
} else {
if ((val & REDO_PTR) == REDO_PTR)
ctx->context = (int *)(val & ~REDO_PTR);
else
ctx->context = (int *)((val & ~REDO_PTR)>>FRG_REDO_BITS);
}
}
if (pe->PredFlags & CArgsPredFlag) {
return execute_cargs(pe, exec_code);
} else {
return (exec_code)();
}
}
X_API Int X_API Int
YAP_CallProlog(Term t) YAP_CallProlog(Term t)
{ {