further optimisations to execute a,b.

cleanups.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@176 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

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);

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);
 	}

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);

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

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

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

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)
 

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"

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,

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) ;