diff --git a/C/absmi.c b/C/absmi.c index 414878396..568ca9095 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -11380,6 +11380,129 @@ absmi(int inp) } ENDBOp(); + BOp(p_last_execute_within, sla); + { + PredEntry *pen; + + CACHE_Y_AS_ENV(Y); + BEGD(d0); + d0 = ARG1; + if (PredGoalExpansion->OpcodeOfPred != UNDEF_OPCODE) { + d0 = ExecuteCallMetaCall(); + } + deref_head(d0, last_execute_within_unk); + last_execute_within_nvar: + if (IsApplTerm(d0)) { + Functor f = FunctorOfTerm(d0); + if (IsExtensionFunctor(f)) { + d0 = ExecuteCallMetaCall(); + goto last_execute_within_nvar; + } + pen = RepPredProp(PredPropByFunc(f, *CurrentModulePtr)); + if (pen->PredFlags & MetaPredFlag) { + d0 = ExecuteCallMetaCall(); + goto last_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); + CACHE_A1(); + } 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 last_execute_within_nvar; + } + + ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); + BEGD(d0); + d0 = ENV[E_CB]; +#ifndef NO_CHECKING + check_stack(NoStackPWLExec, H); +#endif + PREG = (yamop *) pen->CodeOfPred; + /* do deallocate */ + CPREG = (yamop *) E_Y[E_CP]; + E_Y = ENV = (CELL *) E_Y[E_E]; +#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 E_Y = (CELL *)((CELL)E_Y + ENV_Size(CPREG)); + } +#else + if (E_Y > (CELL *)B) { + E_Y = (CELL *)B; + } + else { + E_Y = (CELL *) ((CELL) E_Y + ENV_Size(CPREG)); + } +#endif /* FROZEN_REGS */ + WRITEBACK_Y_AS_ENV(); + /* setup GB */ + E_Y[E_CB] = d0; + ENDD(d0); + ALWAYS_GONext(); + ALWAYS_END_PREFETCH(); + + BEGP(pt1); + deref_body(d0, pt1, last_execute_within_unk, last_execute_within_nvar); + d0 = ExecuteCallMetaCall(); + goto last_execute_within_nvar; + ENDP(pt1); + ENDD(d0); + ENDCACHE_Y_AS_ENV(); + + NoStackPWLExec: + /* 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); diff --git a/C/amasm.c b/C/amasm.c index ac55b1f60..096615637 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -772,6 +772,8 @@ a_p(op_numbers opcode) code_p->opc = emit_op(_p_execute); else if (RepPredProp(fe)->FunctorOfPred == FunctorExecuteWithin) code_p->opc = emit_op(_p_execute_within); + else if (RepPredProp(fe)->FunctorOfPred == FunctorLastExecuteWithin) + code_p->opc = emit_op(_p_last_execute_within); else code_p->opc = emit_op(_call_cpred); } diff --git a/C/exec.c b/C/exec.c index 5ff4447de..ea2306b86 100644 --- a/C/exec.c +++ b/C/exec.c @@ -64,7 +64,6 @@ inline static Int CallMetaCall(void) { ARG2 = current_cp_as_integer(); /* p_save_cp */ ARG3 = ARG1; - WRITE_LOCK(PredMetaCall->PRWLock); return (CallPredicate(PredMetaCall, B)); } @@ -195,7 +194,6 @@ EnterCreepMode(PredEntry *pen) { ARG1 = MkPairTerm(Module_Name((CODEADDR)(pen)),ARG1); CreepFlag = CalculateStackGap(); P_before_spy = P; - WRITE_LOCK(PredSpy->PRWLock); return (CallPredicate(PredSpy, B)); } @@ -291,7 +289,6 @@ p_execute_in_mod(void) inline static Int CallMetaCallWithin(void) { - WRITE_LOCK(PredMetaCall->PRWLock); return (CallPredicate(PredMetaCall, B)); } @@ -1330,6 +1327,7 @@ InitExecFs(void) InitCPred("$execute_in_mod", 2, p_execute_in_mod, 0); InitCPred("$execute_within", 3, p_execute_within, 0); InitCPred("$execute_within", 1, p_execute_within2, 0); + InitCPred("$last_execute_within", 1, p_execute_within2, 0); InitCPred("$execute", 2, p_at_execute, 0); InitCPred("$call_with_args", 1, p_execute_0, 0); InitCPred("$call_with_args", 2, p_execute_1, 0); diff --git a/C/init.c b/C/init.c index 23269aab0..50a469bc4 100644 --- a/C/init.c +++ b/C/init.c @@ -722,7 +722,7 @@ InitFlags(void) yap_flags[SOURCE_MODE_FLAG] = FALSE; yap_flags[CHARACTER_ESCAPE_FLAG] = ISO_CHARACTER_ESCAPES; yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE; -#if (defined(YAPOR) || defined(THREADS)) && PURE_YAPOR +#if (defined(YAPOR) || defined(THREADS)) && PUREe_YAPOR yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = FALSE; #else yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE; @@ -953,6 +953,7 @@ InitCodes(void) heap_regs->functor_g_number = MkFunctor(LookupAtom("number"), 1); heap_regs->functor_g_primitive = MkFunctor(LookupAtom("primitive"), 1); heap_regs->functor_g_var = MkFunctor(AtomGVar, 1); + heap_regs->functor_last_execute_within = MkFunctor(LookupAtom("$last_execute_within"), 1); heap_regs->functor_list = MkFunctor(LookupAtom("."), 2); heap_regs->functor_module = MkFunctor(LookupAtom(":"), 2); #ifdef MULTI_ASSIGNMENT_VARIABLES diff --git a/C/save.c b/C/save.c index 9e4015f73..3c4cd6961 100644 --- a/C/save.c +++ b/C/save.c @@ -1081,6 +1081,7 @@ restore_codes(void) heap_regs->functor_g_number = FuncAdjust(heap_regs->functor_g_number); heap_regs->functor_g_primitive = FuncAdjust(heap_regs->functor_g_primitive); heap_regs->functor_g_var = FuncAdjust(heap_regs->functor_g_var); + heap_regs->functor_last_execute_within = FuncAdjust(heap_regs->functor_last_execute_within); heap_regs->functor_list = FuncAdjust(heap_regs->functor_list); heap_regs->functor_module = FuncAdjust(heap_regs->functor_module); #ifdef MULTI_ASSIGNMENT_VARIABLES @@ -1731,6 +1732,7 @@ RestoreClause(Clause *Cl) case _or_else: case _p_execute: case _p_execute_within: + case _p_last_execute_within: #ifdef YAPOR case _or_last: #endif diff --git a/H/Heap.h b/H/Heap.h index 7cca5ea02..e305f75e0 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.11 2001-10-30 20:35:19 vsc Exp $ * +* version: $Id: Heap.h,v 1.12 2001-10-31 20:16:48 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -237,6 +237,7 @@ typedef struct various_codes { functor_g_number, functor_g_primitive, functor_g_var, + functor_last_execute_within, functor_list, functor_module, #ifdef MULTI_ASSIGNMENT_VARIABLES @@ -426,6 +427,7 @@ typedef struct various_codes { #define FunctorGNumber heap_regs->functor_g_number #define FunctorGPrimitive heap_regs->functor_g_primitive #define FunctorGVar heap_regs->functor_g_var +#define FunctorLastExecuteWithin heap_regs->functor_last_execute_within #define FunctorList heap_regs->functor_list #define FunctorModule heap_regs->functor_module #ifdef MULTI_ASSIGNMENT_VARIABLES diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index f6f1eaac5..78f8b4b56 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -355,5 +355,6 @@ OPCODE(p_func2f_yx ,yxx), OPCODE(p_func2f_yy ,yyx), OPCODE(p_execute ,sla), - OPCODE(p_execute_within ,sla) + OPCODE(p_execute_within ,sla), + OPCODE(p_last_execute_within ,sla) diff --git a/H/absmi.h b/H/absmi.h index b90a94df4..0bf277981 100644 --- a/H/absmi.h +++ b/H/absmi.h @@ -151,7 +151,7 @@ int STD_PROTO(iequ_complex, (CELL *, CELL *,CELL *)); #ifdef ANALYST -static char *op_names[_p_execute_within + 1] = +static char *op_names[_std_top + 1] = { #define OPCODE(OP,TYPE) #OP #include "YapOpcodes.h" diff --git a/H/amidefs.h b/H/amidefs.h index de14a10e1..6595c64e1 100644 --- a/H/amidefs.h +++ b/H/amidefs.h @@ -54,7 +54,7 @@ typedef enum { } op_numbers; -#define _std_top _p_execute_within +#define _std_top _p_last_execute_within typedef enum { _atom, diff --git a/pl/boot.yap b/pl/boot.yap index 4f2a097b8..2b17e2998 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -643,7 +643,7 @@ incore(G) :- '$execute'(G). ','(A,B) :- '$execute_within'(A), - '$execute_within'(B). + '$last_execute_within'(B). ';'(A,B) :- ( '$execute_within'(A) ;