yap-6.3/C/meta_absmi_insts.h

#ifdef INDENT_CODE
{
  {
    {
#endif /* INDENT_CODE */

      /* join all the meta-call code into a single procedure with three entry points */
      {
	CACHE_Y_AS_ENV(YREG);
	BEGD(d0);       /* term to be meta-called */
	Term mod;       /* module to be used */
	PredEntry *pen;  /* predicate */
	choiceptr b_ptr;        /* cut point */
	Functor f;

	/* we are doing the rhs of a , */
	BOp(p_execute_tail, Osbmp);

	FETCH_Y_FROM_ENV(YREG);
	/* place to cut to */
	b_ptr = (choiceptr)ENV_YREG[E_CB];
	/* original goal */
	d0 = ENV_YREG[-EnvSizeInCells-1];
	/* predicate we had used */
	pen = RepPredProp(AddressOfTerm(ENV_YREG[-EnvSizeInCells-2]));
	/* current module at the time */
	mod = ENV_YREG[-EnvSizeInCells-3];
	/* set YREG */
	/* Try to preserve the environment */
	ENV_YREG = (CELL *) (((char *) YREG) + PREG->y_u.Osbmp.s);
#ifdef FROZEN_STACKS
	{
	  choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
	  if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b;
#else
	  if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
#endif /* YAPOR_SBA */
	}
#else
	if (ENV_YREG > (CELL *) B) {
	  ENV_YREG = (CELL *) B;
	}
#endif /* FROZEN_STACKS */
	/* now, jump to actual execution */
	if (pen->ArityOfPE) {
	  f = pen->FunctorOfPred;
	  /* reuse environment if we are continuining a comma, ie, (g1,g2,g3) */
	  /* can only do it deterministically */
	  /* broken
	     if (f == FunctorComma && (CELL *)B >= ENV) {
	     ENV_YREG = ENV;
	     ENV = (CELL *)ENV[E_E];
	     }
	  */
	  goto execute_pred_f;
	} else
	  goto execute_pred_a;
	ENDBOp();

	/* fetch the module from ARG2 */
	BOp(p_execute2, Osbpp);

	mod = ARG2;
	deref_head(mod, execute2_unk0);
      execute2_nvar0:
	if (!IsAtomTerm(mod)) {
	  saveregs();
	  Yap_Error(TYPE_ERROR_ATOM, mod, "call/2");
	  setregs();
	}
	goto start_execute;

	BEGP(pt1);
	deref_body(mod, pt1, execute2_unk0, execute2_nvar0);
	saveregs();
	Yap_Error(INSTANTIATION_ERROR, mod, "call/2");
	setregs();
	ENDP(pt1);
	/* Oops, second argument was unbound too */
	FAIL();
	ENDBOp();

	BOp(p_execute, Osbmp);
	/* fetch the module from PREG */
	mod = PREG->y_u.Osbmp.mod;
      start_execute:
	/* place to cut to */
	b_ptr = B;
	/* we have mod, and ARG1 has the goal, let us roll */
	/* Try to preserve the environment */
	ENV_YREG = (CELL *) (((char *) YREG) + PREG->y_u.Osbmp.s);
#ifdef FROZEN_STACKS
	{
	  choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
	  if (ENV_YREG > (CELL *) top_b || ENV_YREG < HR) ENV_YREG = (CELL *) top_b;
#else
	  if (ENV_YREG > (CELL *) top_b) ENV_YREG = (CELL *) top_b;
#endif /* YAPOR_SBA */
	}
#else
	if (ENV_YREG > (CELL *) B) {
	  ENV_YREG = (CELL *) B;
	}
#endif /* FROZEN_STACKS */
	d0 = ARG1;
      restart_execute:
	deref_head(d0, execute_unk);
      execute_nvar:
	if (IsApplTerm(d0)) {
	  f = FunctorOfTerm(d0);
	  if (IsExtensionFunctor(f)) {
	    goto execute_metacall;
	  }
	  pen = RepPredProp(PredPropByFunc(f, mod));
	execute_pred_f:
	  if (pen->PredFlags & (MetaPredFlag|UndefPredFlag)) {
	    /* just strip all of M:G */
	    if (f == FunctorModule) {
	      Term tmod = ArgOfTerm(1,d0);
	      /* loop on modules */
	      if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
		d0 = ArgOfTerm(2,d0);
		mod = tmod;
		goto execute_nvar;
	      }
	      goto execute_metacall;
	    }
	    if (f == FunctorComma) {
	      Term nmod = mod;

	      /* optimise conj */
	      SREG = RepAppl(d0);
	      BEGD(d1);
	      d1 = SREG[2];
	      /* create an environment to execute the call */
	      deref_head(d1, execute_comma_unk);
	    execute_comma_nvar:
	      if (IsAtomTerm(d1)) {
		/* atomic goal is simpler */
		ENV_YREG[-EnvSizeInCells-2]  = MkIntegerTerm((Int)PredPropByAtom(AtomOfTerm(d1),nmod));
	      } else if (IsApplTerm(d1)) {
		Functor f1 = FunctorOfTerm(d1);
		if (IsExtensionFunctor(f1)) {
		  goto execute_metacall;
		} else {
		  /* check for modules when looking up */
		  if (f1 == FunctorModule) {
		    Term tmod = ArgOfTerm(1,d1);
		    /* loop on modules */
		    if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
		      d1 = ArgOfTerm(2,d1);
		      nmod = tmod;
		      goto execute_comma_nvar;
		    }
		    goto execute_metacall;
		  }
		  ENV_YREG[-EnvSizeInCells-2]  = MkIntegerTerm((Int)PredPropByFunc(f1,nmod));
		}
	      } else {
		goto execute_metacall;
	      }
	      ENV_YREG[-EnvSizeInCells-3]  = mod;
	      /* now, we can create the new environment for the meta-call */
	      /* notice that we are at a call, so we should ignore CP */
	      ENV_YREG[E_CP] = (CELL)NEXTOP(PREG,Osbmp);
	      ENV_YREG[E_CB] = (CELL)b_ptr;
	      ENV_YREG[E_E]  = (CELL)ENV;
#ifdef DEPTH_LIMIT
	      ENV_YREG[E_DEPTH] = DEPTH;
#endif  /* DEPTH_LIMIT */
	      ENV_YREG[-EnvSizeInCells-1]  = d1;
	      ENV = ENV_YREG;
	      ENV_YREG -= EnvSizeInCells+3;
	      CPREG = NEXTOP(PREG, Osbmp);
	      PREG = COMMA_CODE;
	      /* for profiler */
	      save_pc();
	      d0 = SREG[1];
	      goto restart_execute;

	      BEGP(pt1);
	      deref_body(d1, pt1, execute_comma_unk, execute_comma_nvar);
	      goto execute_metacall;
	      ENDP(pt1);
	      ENDD(d1);
	    } else if (mod != CurrentModule) {
	      goto execute_metacall;
	    }
	  }

	  /* copy arguments of meta-call to XREGS */
	  BEGP(pt1);
	  pt1 = RepAppl(d0);
	  BEGD(d2);
	  for (d2 = ArityOfFunctor(f); d2; d2--) {
#ifdef YAPOR_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)) {
	  pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
	execute_pred_a:
	  /* handle extra pruning */
	  if (pen->FunctorOfPred == (Functor)AtomCut) {
	    if (b_ptr != B) {
	      saveregs();
	      prune(b_ptr PASS_REGS);
	      setregs();
	    }
	  }
	} else {
	  goto execute_metacall;
	}

	/* execute, but test first for interrupts */
      execute_end:
	/* code copied from call */
#ifndef NO_CHECKING
	check_stack(NoStackPExecute, HR);
#endif
      execute_stack_checked:
	CPREG = NEXTOP(PREG, Osbmp);
	ALWAYS_LOOKAHEAD(pen->OpcodeOfPred);
	PREG = pen->CodeOfPred;
	/* for profiler */
	save_pc();
#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 (Yap_do_low_level_trace)
	  low_level_trace(enter_pred,pen,XREGS+1);
#endif  /* LOW_LEVEL_TRACER */
	WRITEBACK_Y_AS_ENV();
	/* setup GB */
	ENV_YREG[E_CB] = (CELL) B;
#ifdef YAPOR
	SCH_check_requests();
#endif  /* YAPOR */
	CACHE_A1();
	ALWAYS_GONext();
	ALWAYS_END_PREFETCH();

	/* meta-call: Prolog to the rescue */
	BEGP(pt1);
	deref_body(d0, pt1, execute_unk, execute_nvar);
      execute_metacall:
	ARG1 = ARG3 = d0;
	pen = PredMetaCall;
	ARG2 = Yap_cp_as_integer(b_ptr);
	if (mod)
	  ARG4 = mod;
	else
	  ARG4 = TermProlog;
	goto execute_end;
	ENDP(pt1);

	/* at this point, we have the arguments all set in the argument registers, pen says who is the current predicate. don't remove. */
      NoStackPExecute:
	WRITEBACK_Y_AS_ENV();
#ifdef SHADOW_S
	Yap_REGS.S_ = SREG;
#endif
	saveregs_and_ycache();
	d0 = interrupt_pexecute( pen PASS_REGS );
	setregs_and_ycache();
#ifdef SHADOW_S
	SREG = Yap_REGS.S_;
#endif
	if (!d0) FAIL();
	if (d0 == 2) goto execute_stack_checked;
	goto execute_end;
	ENDBOp();

	ENDD(d0);
	ENDCACHE_Y_AS_ENV();
      }