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 2001-10-30 20:35:19 +00:00
parent 2cd48bde1a
commit a543874856
7 changed files with 148 additions and 5 deletions

136
C/absmi.c
View File

@ -11244,6 +11244,142 @@ absmi(int inp)
} }
ENDBOp(); 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 #if !USE_THREADED_CODE
default: default:
PREG = Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode); PREG = Error(SYSTEM_ERROR, MkIntegerTerm(opcode), "trying to execute invalid YAAM instruction %d", opcode);

View File

@ -770,6 +770,8 @@ a_p(op_numbers opcode)
} else { } else {
if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod) if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteInMod)
code_p->opc = emit_op(_p_execute); code_p->opc = emit_op(_p_execute);
else if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteWithin)
code_p->opc = emit_op(_p_execute_within);
else else
code_p->opc = emit_op(_call_cpred); code_p->opc = emit_op(_call_cpred);
} }

View File

@ -548,7 +548,7 @@ InitCmpPred(char *Name, int Arity, CmpPredicate cmp_code, CPredicate code, int f
pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->PredFlags = flags | StandardPredFlag | CPredFlag;
p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code; p_code->u.sla.l = pe->TrueCodeOfPred = (CODEADDR) code;
pe->CodeOfPred = pe->FirstClause = pe->LastClause = (CODEADDR) p_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.l2 = (CELL)NIL;
p_code->u.sla.s = -Signed(RealEnvSize); p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.p = (CODEADDR)pe; 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].p = pe;
cmp_funcs[NUMBER_OF_CMPFUNCS].f = cmp_code; cmp_funcs[NUMBER_OF_CMPFUNCS].f = cmp_code;
NUMBER_OF_CMPFUNCS++; NUMBER_OF_CMPFUNCS++;
pe->OpcodeOfPred = opcode(_Ystop);
} }
void void
@ -945,6 +944,7 @@ InitCodes(void)
heap_regs->functor_csult = MkFunctor(AtomCsult, 1); heap_regs->functor_csult = MkFunctor(AtomCsult, 1);
heap_regs->functor_eq = MkFunctor(AtomEq, 2); heap_regs->functor_eq = MkFunctor(AtomEq, 2);
heap_regs->functor_execute_in_mod = MkFunctor(LookupAtom("$execute_in_mod"), 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_atom = MkFunctor(LookupAtom("atom"), 1);
heap_regs->functor_g_atomic = MkFunctor(LookupAtom("atomic"), 1); heap_regs->functor_g_atomic = MkFunctor(LookupAtom("atomic"), 1);
heap_regs->functor_g_compound = MkFunctor(LookupAtom("compound"), 1); heap_regs->functor_g_compound = MkFunctor(LookupAtom("compound"), 1);

View File

@ -1072,6 +1072,7 @@ restore_codes(void)
heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult); heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq); 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_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_atom = FuncAdjust(heap_regs->functor_g_atom);
heap_regs->functor_g_atomic = FuncAdjust(heap_regs->functor_g_atomic); heap_regs->functor_g_atomic = FuncAdjust(heap_regs->functor_g_atomic);
heap_regs->functor_g_compound = FuncAdjust(heap_regs->functor_g_compound); heap_regs->functor_g_compound = FuncAdjust(heap_regs->functor_g_compound);
@ -1729,6 +1730,7 @@ RestoreClause(Clause *Cl)
case _either: case _either:
case _or_else: case _or_else:
case _p_execute: case _p_execute:
case _p_execute_within:
#ifdef YAPOR #ifdef YAPOR
case _or_last: case _or_last:
#endif #endif

View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * 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 */ /* information that can be stored in Code Space */
@ -228,6 +228,7 @@ typedef struct various_codes {
functor_cut_by, functor_cut_by,
functor_eq, functor_eq,
functor_execute_in_mod, functor_execute_in_mod,
functor_execute_within,
functor_g_atom, functor_g_atom,
functor_g_atomic, functor_g_atomic,
functor_g_compound, functor_g_compound,
@ -416,6 +417,7 @@ typedef struct various_codes {
#define FunctorCutBy heap_regs->functor_cut_by #define FunctorCutBy heap_regs->functor_cut_by
#define FunctorEq heap_regs->functor_eq #define FunctorEq heap_regs->functor_eq
#define FunctorExecuteInMod heap_regs->functor_execute_in_mod #define FunctorExecuteInMod heap_regs->functor_execute_in_mod
#define FunctorExecuteWithin heap_regs->functor_execute_within
#define FunctorGAtom heap_regs->functor_g_atom #define FunctorGAtom heap_regs->functor_g_atom
#define FunctorGAtomic heap_regs->functor_g_atomic #define FunctorGAtomic heap_regs->functor_g_atomic
#define FunctorGCompound heap_regs->functor_g_compound #define FunctorGCompound heap_regs->functor_g_compound

View File

@ -354,5 +354,6 @@
OPCODE(p_func2f_xy ,xyx), OPCODE(p_func2f_xy ,xyx),
OPCODE(p_func2f_yx ,yxx), OPCODE(p_func2f_yx ,yxx),
OPCODE(p_func2f_yy ,yyx), OPCODE(p_func2f_yy ,yyx),
OPCODE(p_execute ,sla) OPCODE(p_execute ,sla),
OPCODE(p_execute_within ,sla)

View File

@ -54,7 +54,7 @@ typedef enum {
} op_numbers; } op_numbers;
#define _std_top _p_func2f_yy #define _std_top _p_execute_within
typedef enum { typedef enum {
_atom, _atom,