p_execute_within
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@172 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
2cd48bde1a
commit
a543874856
136
C/absmi.c
136
C/absmi.c
@ -11244,6 +11244,142 @@ absmi(int inp)
|
||||
}
|
||||
ENDBOp();
|
||||
|
||||
|
||||
BOp(p_execute_within, sla);
|
||||
{
|
||||
PredEntry *pen;
|
||||
|
||||
CACHE_Y_AS_ENV(Y);
|
||||
CACHE_A1();
|
||||
BEGD(d0);
|
||||
d0 = ARG1;
|
||||
if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) {
|
||||
d0 = ExecuteCallMetaCall();
|
||||
}
|
||||
deref_head(d0, execute_within_unk);
|
||||
execute_within_nvar:
|
||||
if (IsApplTerm(d0)) {
|
||||
Functor f = FunctorOfTerm(d0);
|
||||
if (IsExtensionFunctor(f)) {
|
||||
d0 = ExecuteCallMetaCall();
|
||||
goto execute_within_nvar;
|
||||
}
|
||||
pen = RepPredProp(PredPropByFunc(f, *CurrentModulePtr));
|
||||
if (pen->PredFlags & MetaPredFlag) {
|
||||
d0 = ExecuteCallMetaCall();
|
||||
goto execute_within_nvar;
|
||||
}
|
||||
BEGP(pt1);
|
||||
pt1 = RepAppl(d0);
|
||||
BEGD(d2);
|
||||
for (d2 = ArityOfFunctor(f); d2; d2--) {
|
||||
#if SBA
|
||||
BEGD(d1);
|
||||
d1 = pt1[d2];
|
||||
if (d1 == 0)
|
||||
XREGS[d2] = (CELL)(pt1+d2);
|
||||
else
|
||||
XREGS[d2] = d1;
|
||||
#else
|
||||
XREGS[d2] = pt1[d2];
|
||||
#endif
|
||||
}
|
||||
ENDD(d2);
|
||||
ENDP(pt1);
|
||||
} else if (IsAtomTerm(d0)) {
|
||||
if (AtomOfTerm(d0) == AtomCut) {
|
||||
choiceptr pt0;
|
||||
|
||||
pt0 = (choiceptr)(ENV[E_CB]);
|
||||
if (TopB != NULL && YOUNGER_CP(TopB,pt0)) {
|
||||
pt0 = TopB;
|
||||
if (DelayedB == NULL || YOUNGER_CP(pt0,DelayedB))
|
||||
DelayedB = pt0;
|
||||
}
|
||||
/* find where to cut to */
|
||||
if (SHOULD_CUT_UP_TO(B,pt0)) {
|
||||
#ifdef YAPOR
|
||||
/* Wow, we're gonna cut!!! */
|
||||
CUT_prune_to(pt0);
|
||||
#else
|
||||
/* Wow, we're gonna cut!!! */
|
||||
B = pt0;
|
||||
#endif /* YAPOR */
|
||||
HB = PROTECT_FROZEN_H(B);
|
||||
}
|
||||
PREG = NEXTOP(PREG, sla);
|
||||
JMPNext();
|
||||
}else
|
||||
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), *CurrentModulePtr));
|
||||
} else {
|
||||
d0 = ExecuteCallMetaCall();
|
||||
goto execute_within_nvar;
|
||||
}
|
||||
|
||||
#ifndef NO_CHECKING
|
||||
check_stack(NoStackPWExec, H);
|
||||
#endif
|
||||
/* code copied from call */
|
||||
ENV = E_Y;
|
||||
/* Try to preserve the environment */
|
||||
E_Y = (CELL *) (((char *) Y) + PREG->u.sla.s);
|
||||
CPREG =
|
||||
(yamop *) NEXTOP(PREG, sla);
|
||||
ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
|
||||
PREG = (yamop *) pen->CodeOfPred;
|
||||
#ifdef DEPTH_LIMIT
|
||||
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
|
||||
if (pen->ModuleOfPred) {
|
||||
if (DEPTH == MkIntTerm(0))
|
||||
FAIL();
|
||||
else DEPTH = RESET_DEPTH();
|
||||
}
|
||||
} else if (pen->ModuleOfPred)
|
||||
DEPTH -= MkIntConstant(2);
|
||||
#endif /* DEPTH_LIMIT */
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
if (do_low_level_trace)
|
||||
low_level_trace(enter_pred,pen,XREGS+1);
|
||||
#endif /* LOW_LEVEL_TRACER */
|
||||
#ifdef FROZEN_REGS
|
||||
{
|
||||
choiceptr top_b = PROTECT_FROZEN_B(B);
|
||||
#ifdef SBA
|
||||
if (E_Y > (CELL *) top_b || E_Y < H) E_Y = (CELL *) top_b;
|
||||
#else
|
||||
if (E_Y > (CELL *) top_b) E_Y = (CELL *) top_b;
|
||||
#endif
|
||||
}
|
||||
#else
|
||||
if (E_Y > (CELL *) B) {
|
||||
E_Y = (CELL *) B;
|
||||
}
|
||||
#endif /* FROZEN_REGS */
|
||||
WRITEBACK_Y_AS_ENV();
|
||||
/* setup GB */
|
||||
E_Y[E_CB] = ENV[E_CB];
|
||||
#ifdef YAPOR
|
||||
SCH_check_requests();
|
||||
#endif /* YAPOR */
|
||||
ALWAYS_GONext();
|
||||
ALWAYS_END_PREFETCH();
|
||||
|
||||
BEGP(pt1);
|
||||
deref_body(d0, pt1, execute_within_unk, execute_within_nvar);
|
||||
d0 = ExecuteCallMetaCall();
|
||||
goto execute_within_nvar;
|
||||
ENDP(pt1);
|
||||
ENDD(d0);
|
||||
ENDCACHE_Y_AS_ENV();
|
||||
|
||||
NoStackPWExec:
|
||||
/* on X86 machines S will not actually be holding the pointer to pred */
|
||||
SREG = (CELL *) pen;
|
||||
goto NoStackCallGotS;
|
||||
|
||||
}
|
||||
ENDBOp();
|
||||
|
||||
#if !USE_THREADED_CODE
|
||||
default:
|
||||
PREG = Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);
|
||||
|
||||
@ -770,6 +770,8 @@ a_p(op_numbers opcode)
|
||||
} else {
|
||||
if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod)
|
||||
code_p->opc = emit_op(_p_execute);
|
||||
else if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteWithin)
|
||||
code_p->opc = emit_op(_p_execute_within);
|
||||
else
|
||||
code_p->opc = emit_op(_call_cpred);
|
||||
}
|
||||
|
||||
4
C/init.c
4
C/init.c
@ -548,7 +548,7 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
|
||||
pe->PredFlags = flags | StandardPredFlag | CPredFlag;
|
||||
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
|
||||
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_code;
|
||||
p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
|
||||
p_code->opc = pe->OpcodeOfPred = opcode(_call_cpred);
|
||||
p_code->u.sla.l2 = (CELL)NIL;
|
||||
p_code->u.sla.s = -Signed(RealEnvSize);
|
||||
p_code->u.sla.p = (CODEADDR)pe;
|
||||
@ -561,7 +561,6 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
|
||||
cmp_funcs[NUMBER_OF_CMPFUNCS].p = pe;
|
||||
cmp_funcs[NUMBER_OF_CMPFUNCS].f = cmp_code;
|
||||
NUMBER_OF_CMPFUNCS++;
|
||||
pe->OpcodeOfPred = opcode(_Ystop);
|
||||
}
|
||||
|
||||
void
|
||||
@ -945,6 +944,7 @@ InitCodes(void)
|
||||
heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
|
||||
heap_regs->functor_eq = MkFunctor(AtomEq, 2);
|
||||
heap_regs->functor_execute_in_mod = MkFunctor(LookupAtom("$execute_in_mod"), 2);
|
||||
heap_regs->functor_execute_within = MkFunctor(LookupAtom("$execute_within"), 1);
|
||||
heap_regs->functor_g_atom = MkFunctor(LookupAtom("atom"), 1);
|
||||
heap_regs->functor_g_atomic = MkFunctor(LookupAtom("atomic"), 1);
|
||||
heap_regs->functor_g_compound = MkFunctor(LookupAtom("compound"), 1);
|
||||
|
||||
2
C/save.c
2
C/save.c
@ -1072,6 +1072,7 @@ restore_codes(void)
|
||||
heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
|
||||
heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq);
|
||||
heap_regs->functor_execute_in_mod = FuncAdjust(heap_regs->functor_execute_in_mod);
|
||||
heap_regs->functor_execute_within = FuncAdjust(heap_regs->functor_execute_within);
|
||||
heap_regs->functor_g_atom = FuncAdjust(heap_regs->functor_g_atom);
|
||||
heap_regs->functor_g_atomic = FuncAdjust(heap_regs->functor_g_atomic);
|
||||
heap_regs->functor_g_compound = FuncAdjust(heap_regs->functor_g_compound);
|
||||
@ -1729,6 +1730,7 @@ RestoreClause(Clause *Cl)
|
||||
case _either:
|
||||
case _or_else:
|
||||
case _p_execute:
|
||||
case _p_execute_within:
|
||||
#ifdef YAPOR
|
||||
case _or_last:
|
||||
#endif
|
||||
|
||||
4
H/Heap.h
4
H/Heap.h
@ -10,7 +10,7 @@
|
||||
* File: Heap.h *
|
||||
* mods: *
|
||||
* comments: Heap Init Structure *
|
||||
* version: $Id: Heap.h,v 1.10 2001-10-30 16:42:05 vsc Exp $ *
|
||||
* version: $Id: Heap.h,v 1.11 2001-10-30 20:35:19 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
/* information that can be stored in Code Space */
|
||||
@ -228,6 +228,7 @@ typedef struct various_codes {
|
||||
functor_cut_by,
|
||||
functor_eq,
|
||||
functor_execute_in_mod,
|
||||
functor_execute_within,
|
||||
functor_g_atom,
|
||||
functor_g_atomic,
|
||||
functor_g_compound,
|
||||
@ -416,6 +417,7 @@ typedef struct various_codes {
|
||||
#define FunctorCutBy heap_regs->functor_cut_by
|
||||
#define FunctorEq heap_regs->functor_eq
|
||||
#define FunctorExecuteInMod heap_regs->functor_execute_in_mod
|
||||
#define FunctorExecuteWithin heap_regs->functor_execute_within
|
||||
#define FunctorGAtom heap_regs->functor_g_atom
|
||||
#define FunctorGAtomic heap_regs->functor_g_atomic
|
||||
#define FunctorGCompound heap_regs->functor_g_compound
|
||||
|
||||
@ -354,5 +354,6 @@
|
||||
OPCODE(p_func2f_xy ,xyx),
|
||||
OPCODE(p_func2f_yx ,yxx),
|
||||
OPCODE(p_func2f_yy ,yyx),
|
||||
OPCODE(p_execute ,sla)
|
||||
OPCODE(p_execute ,sla),
|
||||
OPCODE(p_execute_within ,sla)
|
||||
|
||||
|
||||
@ -54,7 +54,7 @@ typedef enum {
|
||||
} op_numbers;
|
||||
|
||||
|
||||
#define _std_top _p_func2f_yy
|
||||
#define _std_top _p_execute_within
|
||||
|
||||
typedef enum {
|
||||
_atom,
|
||||
|
||||
Reference in New Issue
Block a user