This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/absmi.c

1468 lines
36 KiB
C
Raw Normal View History

/*************************************************************************
* *
* Yap Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
2017-03-23 12:24:51 +00:00
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
2016-03-29 01:55:12 +01:00
* Last rev: $Date: 2008-08-13 01:16:26 $,$Author: vsc $
**
* $Log: not supported by cvs2svn $
* Revision 1.246 2008/08/12 01:27:22 vsc
* *
* *
*************************************************************************/
2014-09-11 20:06:57 +01:00
/**
@file absmi.c
2017-06-26 01:17:51 +01:00
@{
2014-09-11 20:06:57 +01:00
We next discuss several issues on trying to make Prolog programs run
fast in YAP. We assume two different programming styles:
2017-06-26 01:17:51 +01:00
+ Execution of <em>deterministic</em> programs often
2014-09-11 20:06:57 +01:00
boils down to a recursive loop of the form:
~~~~~
2017-06-26 01:17:51 +01:00
loop(Done).
2014-09-11 20:06:57 +01:00
loop(Env) :-
do_something(Env,NewEnv),
loop(NewEnv).
~~~~~
2017-06-26 01:17:51 +01:00
or to the repeat-fail loop:
~~~~~
loop(Inp) :-
do_something(Inp,Out),
out_and_fail(Out).
~~~~~
@}
@defgroup Implementation Implementation Considerations
@ingroup YAPProgramming
This section is about the YAP implementation, and is mostly of
interest to hackers.
@{
@defgroup Emulator The Abstract Machine Emulator
@ingroup Implementation
2014-09-11 20:06:57 +01:00
*/
2017-06-26 01:17:51 +01:00
/// code belongs to the emulator
#define IN_ABSMI_C 1
2015-08-07 22:57:53 +01:00
#define _INATIVE 1
2017-06-26 01:17:51 +01:00
/// use tmp variables that are placed in registers
#define HAS_CACHE_REGS 1
#include "absmi.h"
#include "heapgc.h"
#include "cut_c.h"
#if YAP_JIT
#include "IsGround.h"
TraceContext **curtrace;
yamop *curpreg;
BlocksContext **globalcurblock;
COUNT ineedredefinedest;
2016-03-29 01:55:12 +01:00
yamop *headoftrace;
NativeContext *NativeArea;
IntermediatecodeContext *IntermediatecodeArea;
CELL l;
CELL nnexec;
Environment *Yap_ExpEnvP, Yap_ExpEnv;
void **Yap_ABSMI_ControlLabels;
2016-03-29 01:55:12 +01:00
static Int traced_absmi(void) { return Yap_traced_absmi(); }
#endif
#ifndef YREG
#define YREG YENV
#endif
void **Yap_ABSMI_OPCODES;
#ifdef PUSH_X
#else
/* keep X as a global variable */
2016-03-29 01:55:12 +01:00
Term Yap_XREGS[MaxTemps]; /* 29 */
#endif
#include "arith2.h"
2015-01-18 03:00:19 +00:00
// #include "print_preg.h"
//#include "sprint_op.hpp"
//#include "print_op.hpp"
#ifdef COROUTINING
/*
Imagine we are interrupting the execution, say, because we have a spy
point or because we have goals to wake up. This routine saves the current
live temporary registers into a structure pointed to by register ARG1.
The registers are then recovered by a nasty builtin
called
*/
2016-03-29 01:55:12 +01:00
static Term push_live_regs(yamop *pco) {
CACHE_REGS
2014-05-30 01:06:09 +01:00
CELL *lab = (CELL *)(pco->y_u.l.l);
CELL max = lab[0];
CELL curr = lab[1];
Term tp = MkIntegerTerm((Int)pco);
Term tcp = MkIntegerTerm((Int)CP);
2016-03-29 01:55:12 +01:00
Term tenv = MkIntegerTerm((Int)(LCL0 - ENV));
Term tyenv = MkIntegerTerm((Int)(LCL0 - YENV));
2014-01-19 21:15:05 +00:00
CELL *start = HR;
Int tot = 0;
HR++;
*HR++ = tp;
*HR++ = tcp;
*HR++ = tenv;
*HR++ = tyenv;
tot += 4;
{
2016-03-29 01:55:12 +01:00
CELL i;
lab += 2;
2016-03-29 01:55:12 +01:00
for (i = 0; i <= max; i++) {
if (i == 8 * CellSize) {
curr = lab[0];
lab++;
}
if (curr & 1) {
2016-03-29 01:55:12 +01:00
CELL d1;
2016-03-29 01:55:12 +01:00
tot += 2;
HR[0] = MkIntTerm(i);
d1 = XREGS[i];
deref_head(d1, wake_up_unk);
wake_up_nonvar:
2016-03-29 01:55:12 +01:00
/* just copy it to the heap */
HR[1] = d1;
HR += 2;
continue;
{
CELL *pt0;
deref_body(d1, pt0, wake_up_unk, wake_up_nonvar);
/* bind it, in case it is a local variable */
if (pt0 <= HR) {
/* variable is safe */
HR[1] = (CELL)pt0;
} else {
d1 = Unsigned(HR + 1);
RESET_VARIABLE(HR + 1);
Bind_Local(pt0, d1);
}
}
HR += 2;
}
curr >>= 1;
}
start[0] = (CELL)Yap_MkFunctor(AtomTrue, tot);
2016-03-29 01:55:12 +01:00
return (AbsAppl(start));
}
}
#endif
#if USE_THREADED_CODE && (defined(ANALYST) || defined(DEBUG))
2016-03-29 01:55:12 +01:00
char *Yap_op_names[] = {
#define OPCODE(OP, TYPE) #OP
#include "YapOpcodes.h"
2016-03-29 01:55:12 +01:00
#undef OPCODE
};
#endif
2016-03-29 01:55:12 +01:00
static int check_alarm_fail_int(int CONT USES_REGS) {
#if defined(_MSC_VER) || defined(__MINGW32__)
/* I need this for Windows and any system where SIGINT
2013-12-12 14:24:40 +00:00
is not proceesed by same thread as absmi */
2016-03-29 01:55:12 +01:00
if (LOCAL_PrologMode & (AbortMode | InterruptMode)) {
CalculateStackGap(PASS_REGS1);
return CONT;
}
2013-12-12 14:24:40 +00:00
#endif
2016-03-29 01:55:12 +01:00
if (Yap_get_signal(YAP_FAIL_SIGNAL)) {
return false;
2013-12-12 14:24:40 +00:00
}
2014-03-06 02:09:48 +00:00
if (!Yap_has_a_signal()) {
2016-03-29 01:55:12 +01:00
/* no need to look into GC */
CalculateStackGap(PASS_REGS1);
2014-03-06 02:09:48 +00:00
}
// fail even if there are more signals, they will have to be dealt later.
2013-12-16 13:05:08 +00:00
return -1;
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int stack_overflow(PredEntry *pe, CELL *env, yamop *cp,
2018-10-22 12:38:13 +01:00
arity_t nargs USES_REGS) {
2016-04-10 14:21:17 +01:00
if (Unsigned(YREG) - Unsigned(HR) < StackGap(PASS_REGS1) ||
2016-03-29 01:55:12 +01:00
Yap_get_signal(YAP_STOVF_SIGNAL)) {
S = (CELL *)pe;
2015-08-07 22:57:53 +01:00
if (!Yap_locked_gc(nargs, env, cp)) {
2018-10-22 12:38:13 +01:00
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
2014-03-11 15:33:38 +00:00
return 0;
2013-12-12 14:24:40 +00:00
}
return 1;
}
return -1;
}
2016-03-29 01:55:12 +01:00
static int code_overflow(CELL *yenv USES_REGS) {
if (Yap_get_signal(YAP_CDOVF_SIGNAL)) {
CELL cut_b = LCL0 - (CELL *)(yenv[E_CB]);
2013-12-12 14:24:40 +00:00
/* do a garbage collection first to check if we can recover memory */
2014-09-10 05:50:43 +01:00
if (!Yap_locked_growheap(false, 0, NULL)) {
2016-03-29 01:55:12 +01:00
Yap_NilError(RESOURCE_ERROR_HEAP, "YAP failed to grow heap: %s",
2018-10-22 12:38:13 +01:00
"malloc/mmap failed");
2013-12-12 14:24:40 +00:00
return 0;
}
CACHE_A1();
if (yenv == ASP) {
2016-03-29 01:55:12 +01:00
yenv[E_CB] = (CELL)(LCL0 - cut_b);
2013-12-12 14:24:40 +00:00
}
return 1;
}
return -1;
}
2016-03-29 01:55:12 +01:00
static int interrupt_handler(PredEntry *pe USES_REGS) {
// printf("D %lx %p\n", LOCAL_ActiveSignals, P);
2013-12-12 14:24:40 +00:00
/* tell whether we can creep or not, this is hard because we will
lose the info RSN
*/
BEGD(d0);
d0 = pe->ArityOfPE;
if (d0 == 0) {
2016-03-29 01:55:12 +01:00
HR[1] = MkAtomTerm((Atom)pe->FunctorOfPred);
} else {
2014-01-19 21:15:05 +00:00
HR[d0 + 2] = AbsAppl(HR);
2016-03-29 01:55:12 +01:00
*HR = (CELL)pe->FunctorOfPred;
2014-01-19 21:15:05 +00:00
HR++;
2013-12-12 14:24:40 +00:00
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1;
d1 = *pt0;
deref_head(d1, creep_unk);
creep_nonvar:
/* just copy it to the heap */
pt1++;
2014-01-19 21:15:05 +00:00
*HR++ = d1;
2013-12-12 14:24:40 +00:00
continue;
derefa_body(d1, pt0, creep_unk, creep_nonvar);
2014-01-19 21:15:05 +00:00
if (pt0 <= HR) {
2016-03-29 01:55:12 +01:00
/* variable is safe */
*HR++ = (CELL)pt0;
pt1++;
2013-12-12 14:24:40 +00:00
} else {
2016-03-29 01:55:12 +01:00
/* bind it, in case it is a local variable */
d1 = Unsigned(HR);
RESET_VARIABLE(HR);
pt1++;
HR += 1;
Bind_Local(pt0, d1);
2013-12-12 14:24:40 +00:00
}
ENDP(pt0);
ENDD(d1);
}
ENDP(pt1);
}
ENDD(d0);
2014-01-19 21:15:05 +00:00
HR[0] = Yap_Module_Name(pe);
2016-03-29 01:55:12 +01:00
ARG1 = (Term)AbsPair(HR);
2013-12-12 14:24:40 +00:00
2014-01-19 21:15:05 +00:00
HR += 2;
2013-12-12 14:24:40 +00:00
#ifdef COROUTINING
2016-03-29 01:55:12 +01:00
if (Yap_get_signal(YAP_WAKEUP_SIGNAL)) {
CalculateStackGap(PASS_REGS1);
2013-12-12 14:24:40 +00:00
ARG2 = Yap_ListOfWokenGoals();
pe = WakeUpCode;
/* no more goals to wake up */
2016-03-29 01:55:12 +01:00
Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil);
} else
2013-12-12 14:24:40 +00:00
#endif
2016-03-29 01:55:12 +01:00
{
CalculateStackGap(PASS_REGS1);
pe = CreepCode;
}
2013-12-12 14:24:40 +00:00
P = pe->CodeOfPred;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
2016-03-29 01:55:12 +01:00
low_level_trace(enter_pred, pe, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
2013-12-12 14:24:40 +00:00
/* for profiler */
CACHE_A1();
2014-09-10 05:50:43 +01:00
return true;
2013-12-12 14:24:40 +00:00
}
// interrupt handling code that sets up the case when we do not have
// a guaranteed environment.
2016-03-29 01:55:12 +01:00
static int safe_interrupt_handler(PredEntry *pe USES_REGS) {
CELL *npt = HR;
// printf("D %lx %p\n", LOCAL_ActiveSignals, P);
/* tell whether we can creep or not, this is hard because we will
lose the info RSN
*/
BEGD(d0);
S = (CELL *)pe;
d0 = pe->ArityOfPE;
if (d0 == 0) {
2016-03-29 01:55:12 +01:00
HR[1] = MkAtomTerm((Atom)pe->FunctorOfPred);
} else {
HR[d0 + 2] = AbsAppl(HR);
2016-03-29 01:55:12 +01:00
HR += d0 + 1 + 2;
*npt++ = (CELL)pe->FunctorOfPred;
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
BEGD(d1);
d1 = *pt1;
loop:
if (!IsVarTerm(d1)) {
2016-03-29 01:55:12 +01:00
/* just copy it to the heap */
pt1++;
*npt++ = d1;
} else {
2016-03-29 01:55:12 +01:00
if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) {
d1 = Deref(d1);
if (VarOfTerm(d1) < H0 || VarOfTerm(d1) > HR) {
Term v = MkVarTerm();
YapBind(VarOfTerm(d1), v);
} else {
goto loop;
}
} else {
*npt++ = d1;
}
}
ENDD(d1);
}
ENDP(pt1);
}
ENDD(d0);
npt[0] = Yap_Module_Name(pe);
ARG1 = AbsPair(npt);
HR += 2;
#ifdef COROUTINING
2016-03-29 01:55:12 +01:00
if (Yap_get_signal(YAP_WAKEUP_SIGNAL)) {
CalculateStackGap(PASS_REGS1);
ARG2 = Yap_ListOfWokenGoals();
pe = WakeUpCode;
/* no more goals to wake up */
2016-03-29 01:55:12 +01:00
Yap_UpdateTimedVar(LOCAL_WokenGoals, TermNil);
} else
#endif
2016-03-29 01:55:12 +01:00
{
CalculateStackGap(PASS_REGS1);
pe = CreepCode;
}
// allocate and fill out an environment
YENV = ASP;
CACHE_Y_AS_ENV(YREG);
2016-03-29 01:55:12 +01:00
ENV_YREG[E_CP] = (CELL)CP;
ENV_YREG[E_E] = (CELL)ENV;
#ifdef DEPTH_LIMIT
ENV_YREG[E_DEPTH] = DEPTH;
2016-03-29 01:55:12 +01:00
#endif /* DEPTH_LIMIT */
ENV = ENV_YREG;
ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CP));
WRITEBACK_Y_AS_ENV();
ENDCACHE_Y_AS_ENV();
CP = P;
P = pe->CodeOfPred;
#ifdef DEPTH_LIMIT
2016-03-29 01:55:12 +01:00
if (DEPTH <= MkIntTerm(1)) { /* I assume Module==0 is primitives */
if (pe->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
2016-03-29 01:55:12 +01:00
return false;
else
DEPTH = RESET_DEPTH();
}
} else if (pe->ModuleOfPred) {
DEPTH -= MkIntConstant(2);
}
2016-03-29 01:55:12 +01:00
#endif /* DEPTH_LIMIT */
2014-09-10 05:50:43 +01:00
return true;
}
2016-03-29 01:55:12 +01:00
static int interrupt_handlerc(PredEntry *pe USES_REGS) {
2013-12-12 14:24:40 +00:00
/* do creep in call */
ENV = YENV;
CP = NEXTOP(P, Osbpp);
2016-03-29 01:55:12 +01:00
YENV = (CELL *)(((char *)YENV) + P->y_u.Osbpp.s);
2013-12-12 14:24:40 +00:00
#ifdef FROZEN_STACKS
{
2013-12-12 14:24:40 +00:00
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)top_b || YENV < HR)
YENV = (CELL *)top_b;
2013-12-12 14:24:40 +00:00
#else
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)top_b)
YENV = (CELL *)top_b;
2013-12-12 14:24:40 +00:00
#endif /* YAPOR_SBA */
2016-03-29 01:55:12 +01:00
else
YENV = YENV + ENV_Size(CP);
2013-12-12 14:24:40 +00:00
}
#else
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)B)
YENV = (CELL *)B;
2013-12-12 14:24:40 +00:00
else
/* I am not sure about this */
YENV = YENV + ENV_Size(CP);
#endif /* FROZEN_STACKS */
/* setup GB */
2016-03-29 01:55:12 +01:00
YENV[E_CB] = (CELL)B;
return interrupt_handler(pe PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_handler_either(Term t_cut, PredEntry *pe USES_REGS) {
int rc;
2016-03-29 01:55:12 +01:00
ARG1 = push_live_regs(NEXTOP(P, Osbpp));
2013-12-12 14:24:40 +00:00
#ifdef FROZEN_STACKS
{
2013-12-12 14:24:40 +00:00
choiceptr top_b = PROTECT_FROZEN_B(B);
2016-03-29 01:55:12 +01:00
// protect registers before we mess about.
// recompute YENV and get ASP
2013-12-12 14:24:40 +00:00
#ifdef YAPOR_SBA
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)top_b || YENV < HR)
YENV = (CELL *)top_b;
2013-12-12 14:24:40 +00:00
#else
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)top_b)
YENV = (CELL *)top_b;
2013-12-12 14:24:40 +00:00
#endif /* YAPOR_SBA */
2016-03-29 01:55:12 +01:00
else
YENV = YENV + ENV_Size(CP);
2013-12-12 14:24:40 +00:00
}
#else
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)B)
YENV = (CELL *)B;
2013-12-12 14:24:40 +00:00
#endif /* FROZEN_STACKS */
P = NEXTOP(P, Osbpp);
// should we cut? If t_cut == INT(0) no
ARG2 = t_cut;
// ASP
2016-03-29 01:55:12 +01:00
SET_ASP(YENV, E_CB * sizeof(CELL));
// do the work.
rc = safe_interrupt_handler(pe PASS_REGS);
return rc;
2013-12-12 14:24:40 +00:00
}
/* to trace interrupt calls */
// #define DEBUG_INTERRUPTS 1
2013-12-14 12:35:18 +00:00
2013-12-15 08:35:44 +00:00
#ifdef DEBUG_INTERRUPTS
2014-09-10 05:50:43 +01:00
static int trace_interrupts = true;
2013-12-15 08:35:44 +00:00
#endif
2016-03-29 01:55:12 +01:00
static int interrupt_fail(USES_REGS1) {
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n",
worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal,
__FUNCTION__, __LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
check_alarm_fail_int(false PASS_REGS);
2013-12-12 14:24:40 +00:00
/* don't do debugging and stack expansion here: space will
be recovered. automatically by fail, so
better wait.
*/
2016-03-29 01:55:12 +01:00
if (Yap_has_signal(YAP_CREEP_SIGNAL)) {
2014-09-10 05:50:43 +01:00
return false;
2014-09-08 23:12:05 +01:00
}
2016-03-29 01:55:12 +01:00
if (Yap_has_signal(YAP_CDOVF_SIGNAL)) {
2014-09-10 05:50:43 +01:00
return false;
2013-12-12 14:24:40 +00:00
}
/* make sure we have the correct environment for continuation */
ENV = B->cp_env;
2016-03-29 01:55:12 +01:00
YENV = (CELL *)B;
return interrupt_handler(RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0))
PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_execute(USES_REGS1) {
2013-12-12 14:24:40 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(true PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
PP = P->y_u.Osbpp.p0;
if ((P->y_u.Osbpp.p->PredFlags & (NoTracePredFlag | HiddenPredFlag)) &&
2016-03-29 01:55:12 +01:00
Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
2013-12-12 14:24:40 +00:00
return 2;
}
2016-03-29 01:55:12 +01:00
SET_ASP(YENV, E_CB * sizeof(CELL));
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow(P->y_u.Osbpp.p, ENV, CP,
P->y_u.Osbpp.p->ArityOfPE PASS_REGS)) >= 0) {
return v;
}
return interrupt_handler(P->y_u.Osbpp.p PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_call(USES_REGS1) {
2013-12-12 14:24:40 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n",
worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal,
__FUNCTION__, __LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(true PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
2014-05-30 01:06:09 +01:00
PP = P->y_u.Osbpp.p0;
2014-03-06 02:09:48 +00:00
if (Yap_only_has_signal(YAP_CREEP_SIGNAL) &&
2016-03-29 01:55:12 +01:00
(P->y_u.Osbpp.p->PredFlags & (NoTracePredFlag | HiddenPredFlag))) {
2013-12-12 14:24:40 +00:00
return 2;
}
2014-05-30 01:06:09 +01:00
SET_ASP(YENV, P->y_u.Osbpp.s);
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
2016-03-29 01:55:12 +01:00
if ((v = stack_overflow(P->y_u.Osbpp.p, YENV, NEXTOP(P, Osbpp),
P->y_u.Osbpp.p->ArityOfPE PASS_REGS)) >= 0) {
return v;
}
2016-03-29 01:55:12 +01:00
return interrupt_handlerc(P->y_u.Osbpp.p PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_pexecute(PredEntry *pen USES_REGS) {
2013-12-12 14:24:40 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n",
worker_id, LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal,
__FUNCTION__, __LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
2013-12-12 14:24:40 +00:00
PP = NULL;
if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
return 2; /* keep on creeping */
}
2016-03-29 01:55:12 +01:00
SET_ASP(YENV, E_CB * sizeof(CELL));
2013-12-12 14:24:40 +00:00
/* setup GB */
2016-03-29 01:55:12 +01:00
YENV[E_CB] = (CELL)B;
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
2016-03-29 01:55:12 +01:00
if ((v = stack_overflow(pen, ENV, NEXTOP(P, Osbmp),
pen->ArityOfPE PASS_REGS)) >= 0) {
return v;
}
2013-12-12 14:24:40 +00:00
CP = NEXTOP(P, Osbmp);
2016-03-29 01:55:12 +01:00
return interrupt_handler(pen PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static void execute_dealloc(USES_REGS1) {
/* other instructions do depend on S being set by deallocate
*/
CELL *ENVYREG = YENV;
S = ENVYREG;
2016-03-29 01:55:12 +01:00
CP = (yamop *)ENVYREG[E_CP];
ENV = ENVYREG = (CELL *)ENVYREG[E_E];
#ifdef DEPTH_LIMIT
DEPTH = ENVYREG[E_DEPTH];
2016-03-29 01:55:12 +01:00
#endif /* DEPTH_LIMIT */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
2016-03-29 01:55:12 +01:00
if (ENVYREG > (CELL *)top_b || ENVYREG < HR)
ENVYREG = (CELL *)top_b;
#else
2016-03-29 01:55:12 +01:00
if (ENVYREG > (CELL *)top_b)
ENVYREG = (CELL *)top_b;
#endif /* YAPOR_SBA */
2016-03-29 01:55:12 +01:00
else
ENVYREG = (CELL *)((CELL)ENVYREG + ENV_Size(CP));
}
#else
2016-03-29 01:55:12 +01:00
if (ENVYREG > (CELL *)B)
ENVYREG = (CELL *)B;
else
ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CP));
#endif /* FROZEN_STACKS */
YENV = ENVYREG;
2016-03-29 01:55:12 +01:00
P = NEXTOP(P, p);
}
2016-03-29 01:55:12 +01:00
/* don't forget I cannot creep at deallocate (where to?) */
/* also, this is unusual in that I have already done deallocate,
so I don't need to redo it.
*/
static int interrupt_deallocate(USES_REGS1) {
2013-12-12 14:24:40 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(true PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
/*
2013-12-12 14:24:40 +00:00
don't do a creep here; also, if our instruction is followed by
a execute_c, just wait a bit more */
2016-03-30 01:24:34 +01:00
if (Yap_only_has_signals(YAP_CREEP_SIGNAL, YAP_WAKEUP_SIGNAL) ||
2016-03-29 01:55:12 +01:00
/* keep on going if there is something else */
(P->opc != Yap_opcode(_procceed) && P->opc != Yap_opcode(_cut_e))) {
execute_dealloc(PASS_REGS1);
2013-12-12 14:24:40 +00:00
return 1;
} else {
2016-03-29 01:55:12 +01:00
CELL cut_b = LCL0 - (CELL *)(S[E_CB]);
2013-12-12 14:24:40 +00:00
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
PP = PREVOP(P, p)->y_u.p.p;
ASP = YENV + E_CB;
2013-12-12 14:24:40 +00:00
/* cut_e */
2016-03-29 01:55:12 +01:00
SET_ASP(YENV, E_CB * sizeof(CELL));
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
2014-03-06 02:09:48 +00:00
if (Yap_has_a_signal()) {
2016-03-29 01:55:12 +01:00
PredEntry *pe;
2013-12-12 14:24:40 +00:00
if (Yap_op_from_opcode(P->opc) == _cut_e) {
2016-03-29 01:55:12 +01:00
/* followed by a cut */
ARG1 = MkIntegerTerm(LCL0 - (CELL *)S[E_CB]);
pe = RepPredProp(Yap_GetPredPropByFunc(FunctorCutBy, 1));
2013-12-12 14:24:40 +00:00
} else {
2016-03-29 01:55:12 +01:00
pe = RepPredProp(Yap_GetPredPropByAtom(AtomTrue, 0));
2013-12-12 14:24:40 +00:00
}
2016-03-30 01:24:34 +01:00
// deallocate moves P one step forward.
bool rc = interrupt_handler(pe PASS_REGS);
P = NEXTOP(P,p);
return rc;
2013-12-12 14:24:40 +00:00
}
2016-01-06 12:30:33 +00:00
if (!Yap_locked_gc(0, ENV, YESCODE)) {
2018-10-22 12:38:13 +01:00
Yap_NilError(RESOURCE_ERROR_STACK, "stack overflow: gc failed");
2013-12-12 14:24:40 +00:00
}
S = ASP;
2016-03-29 01:55:12 +01:00
S[E_CB] = (CELL)(LCL0 - cut_b);
2013-12-12 14:24:40 +00:00
}
return 1;
}
2016-03-29 01:55:12 +01:00
static int interrupt_cut(USES_REGS1) {
Term t_cut = MkIntegerTerm(LCL0 - (CELL *)YENV[E_CB]);
2013-12-16 13:05:08 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2016-03-29 01:55:12 +01:00
if (!Yap_has_a_signal() ||
Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
2013-12-12 14:24:40 +00:00
return 2;
}
/* find something to fool S */
2016-03-29 01:55:12 +01:00
P = NEXTOP(P, s);
return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_cut_t(USES_REGS1) {
Term t_cut = MkIntegerTerm(LCL0 - (CELL *)YENV[E_CB]);
2013-12-16 13:05:08 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2016-03-29 01:55:12 +01:00
if (!Yap_has_a_signal() ||
Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
2013-12-12 14:24:40 +00:00
return 2;
}
/* find something to fool S */
2016-03-29 01:55:12 +01:00
P = NEXTOP(P, s);
return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_cut_e(USES_REGS1) {
Term t_cut = MkIntegerTerm(LCL0 - (CELL *)S[E_CB]);
2013-12-16 13:05:08 +00:00
int v;
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2018-10-24 21:45:41 +01:00
if (Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
2014-03-06 02:09:48 +00:00
return 2;
}
2013-12-12 14:24:40 +00:00
/* find something to fool S */
2016-03-29 01:55:12 +01:00
P = NEXTOP(P, s);
return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS);
}
2016-03-29 01:55:12 +01:00
static int interrupt_commit_y(USES_REGS1) {
int v;
2014-05-30 01:06:09 +01:00
Term t_cut = YENV[P->y_u.yps.y];
2016-03-29 01:55:12 +01:00
#ifdef DEBUG_INTERRUPTS
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
return v;
}
2016-03-29 01:55:12 +01:00
if (!Yap_has_a_signal() ||
Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
return 2;
}
/* find something to fool S */
2016-03-29 01:55:12 +01:00
P = NEXTOP(P, yps);
return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_commit_x(USES_REGS1) {
2013-12-16 13:05:08 +00:00
int v;
2014-05-30 01:06:09 +01:00
Term t_cut = XREG(P->y_u.xps.x);
2016-03-29 01:55:12 +01:00
#ifdef DEBUG_INTERRUPTS
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s:%d (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
2016-03-29 01:55:12 +01:00
if (Yap_only_has_signals(YAP_CDOVF_SIGNAL, YAP_CREEP_SIGNAL)) {
2013-12-12 14:24:40 +00:00
return 2;
}
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
2014-05-30 01:06:09 +01:00
PP = P->y_u.xps.p0;
2013-12-12 14:24:40 +00:00
/* find something to fool S */
if (P->opc == Yap_opcode(_fcall)) {
/* fill it up */
CACHE_Y_AS_ENV(YREG);
2016-03-29 01:55:12 +01:00
ENV_YREG[E_CP] = (CELL)CP;
ENV_YREG[E_E] = (CELL)ENV;
2013-12-12 14:24:40 +00:00
#ifdef DEPTH_LIMIT
ENV_YREG[E_DEPTH] = DEPTH;
2016-03-29 01:55:12 +01:00
#endif /* DEPTH_LIMIT */
2013-12-12 14:24:40 +00:00
ENDCACHE_Y_AS_ENV();
}
2016-03-29 01:55:12 +01:00
P = NEXTOP(P, xps);
return interrupt_handler_either(t_cut, PredRestoreRegs PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_either(USES_REGS1) {
2013-12-12 14:24:40 +00:00
int v;
#ifdef DEBUGX
2016-03-29 01:55:12 +01:00
// if (trace_interrupts)
fprintf(stderr, "[%d] %s:%d: (YENV=%p ENV=%p ASP=%p)\n", worker_id,
__FUNCTION__, __LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if ((v = check_alarm_fail_int(2 PASS_REGS)) >= 0) {
2013-12-16 13:05:08 +00:00
return v;
}
if (Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
2013-12-12 14:24:40 +00:00
return 2;
}
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
2014-05-30 01:06:09 +01:00
PP = P->y_u.Osblp.p0;
2013-12-12 14:24:40 +00:00
/* find something to fool S */
2014-05-30 01:06:09 +01:00
SET_ASP(YENV, P->y_u.Osbpp.s);
2013-12-12 14:24:40 +00:00
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
2016-03-29 01:55:12 +01:00
// P = NEXTOP(P, Osblp);
if ((v = stack_overflow(
RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1, 0)), YENV,
NEXTOP(P, Osblp), 0 PASS_REGS)) >= 0) {
// P = PREVOP(P, Osblp);
return v;
}
// P = PREVOP(P, Osblp);
2016-03-29 01:55:12 +01:00
return interrupt_handler_either(
MkIntTerm(0),
RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs1, 0)) PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static int interrupt_dexecute(USES_REGS1) {
2013-12-12 14:24:40 +00:00
int v;
PredEntry *pe;
2013-12-12 14:24:40 +00:00
2013-12-14 12:35:18 +00:00
#ifdef DEBUG_INTERRUPTS
2016-03-29 01:55:12 +01:00
if (trace_interrupts)
fprintf(stderr, "[%d] %lu--%lu %s/%d (YENV=%p ENV=%p ASP=%p)\n", worker_id,
LOCAL_FirstActiveSignal, LOCAL_LastActiveSignal, __FUNCTION__,
__LINE__, YENV, ENV, ASP);
2013-12-14 12:35:18 +00:00
#endif
2016-03-29 01:55:12 +01:00
if (PP)
UNLOCKPE(1, PP);
PP = P->y_u.Osbpp.p0;
pe = P->y_u.Osbpp.p;
2016-03-29 01:55:12 +01:00
if ((pe->PredFlags & (NoTracePredFlag | HiddenPredFlag)) &&
Yap_only_has_signal(YAP_CREEP_SIGNAL)) {
2013-12-12 14:24:40 +00:00
return 2;
}
/* set S for next instructions */
2016-03-29 01:55:12 +01:00
ASP = YENV + E_CB;
2013-12-12 14:24:40 +00:00
if (ASP > (CELL *)PROTECT_FROZEN_B(B))
ASP = (CELL *)PROTECT_FROZEN_B(B);
if ((v = code_overflow(YENV PASS_REGS)) >= 0) {
return v;
}
if ((v = stack_overflow(P->y_u.Osbpp.p, (CELL *)YENV[E_E], (yamop *)YENV[E_CP],
P->y_u.Osbpp.p->ArityOfPE PASS_REGS)) >= 0) {
2016-03-29 01:55:12 +01:00
return v;
}
2016-03-29 01:55:12 +01:00
/* first, deallocate */
CP = (yamop *)YENV[E_CP];
ENV = YENV = (CELL *)YENV[E_E];
2013-12-12 14:24:40 +00:00
#ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH;
2016-03-29 01:55:12 +01:00
#endif /* DEPTH_LIMIT */
2013-12-12 14:24:40 +00:00
#ifdef FROZEN_STACKS
{
2013-12-12 14:24:40 +00:00
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)top_b || YENV < HR)
YENV = (CELL *)top_b;
2013-12-12 14:24:40 +00:00
#else
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)top_b)
YENV = (CELL *)top_b;
2013-12-12 14:24:40 +00:00
#endif /* YAPOR_SBA */
2016-03-29 01:55:12 +01:00
else
YENV = (CELL *)((CELL)YENV + ENV_Size(CPREG));
2013-12-12 14:24:40 +00:00
}
#else
2016-03-29 01:55:12 +01:00
if (YENV > (CELL *)B) {
YENV = (CELL *)B;
} else {
YENV = (CELL *)((CELL)YENV + ENV_Size(CPREG));
2013-12-12 14:24:40 +00:00
}
#endif /* FROZEN_STACKS */
/* setup GB */
2016-03-29 01:55:12 +01:00
YENV[E_CB] = (CELL)B;
2013-12-12 14:24:40 +00:00
/* and now CREEP */
2016-03-29 01:55:12 +01:00
return interrupt_handler(pe PASS_REGS);
2013-12-12 14:24:40 +00:00
}
2016-03-29 01:55:12 +01:00
static void undef_goal(USES_REGS1) {
2014-10-22 10:10:43 +01:00
PredEntry *pe = PredFromDefCode(P);
2019-04-24 12:10:06 +01:00
BEGD(d0);
/* avoid trouble with undefined dynamic procedures */
/* I assume they were not locked beforehand */
#if defined(YAPOR) || defined(THREADS)
2014-10-22 10:10:43 +01:00
if (!PP) {
2016-03-29 01:55:12 +01:00
PELOCK(19, pe);
2014-10-22 10:10:43 +01:00
PP = pe;
}
#endif
2019-04-24 12:10:06 +01:00
if (pe->PredFlags & (DynamicPredFlag | LogUpdatePredFlag | MultiFileFlag) ) {
2018-03-23 18:48:16 +00:00
#if defined(YAPOR) || defined(THREADS)
UNLOCKPE(19, PP);
PP = NULL;
#endif
CalculateStackGap(PASS_REGS1);
P = FAILCODE;
return;
}
2018-01-18 14:47:27 +00:00
if (UndefCode == NULL || UndefCode->OpcodeOfPred == UNDEF_OPCODE) {
fprintf(stderr,"call to undefined Predicates %s ->", IndicatorOfPred(pe));
Yap_DebugPlWriteln(ARG1);
2018-01-19 14:38:26 +00:00
fputc(':', stderr);
Yap_DebugPlWriteln(ARG2);
2018-01-18 14:47:27 +00:00
fprintf(stderr," error handler not available, failing\n");
2014-10-22 10:10:43 +01:00
#if defined(YAPOR) || defined(THREADS)
2016-03-29 01:55:12 +01:00
UNLOCKPE(19, PP);
2014-10-22 10:10:43 +01:00
PP = NULL;
2018-01-18 14:47:27 +00:00
#endif
CalculateStackGap(PASS_REGS1);
2014-10-22 10:10:43 +01:00
P = FAILCODE;
return;
}
#if defined(YAPOR) || defined(THREADS)
2016-03-29 01:55:12 +01:00
UNLOCKPE(19, PP);
2014-10-22 10:10:43 +01:00
PP = NULL;
2019-04-24 12:10:06 +01:00
#endif
2018-03-23 18:48:16 +00:00
if (pe->ArityOfPE == 0) {
2019-04-24 12:10:06 +01:00
d0 = MkAtomTerm((Atom)(pe->FunctorOfPred));
2018-02-01 01:44:34 +00:00
} else {
2019-04-24 12:10:06 +01:00
d0 = AbsAppl(HR);
2018-01-18 14:47:27 +00:00
*HR++ = (CELL)pe->FunctorOfPred;
2018-11-02 15:32:05 +00:00
CELL *ip=HR;
UInt imax = pe->ArityOfPE;
HR += imax;
UInt i = 1;
for (; i <= imax; ip++, i++) {
2014-10-22 10:10:43 +01:00
BEGD(d1);
BEGP(pt0);
2018-11-02 15:32:05 +00:00
d1 = XREGS[i];
2014-10-22 10:10:43 +01:00
deref_head(d1, undef_unk);
undef_nonvar:
/* just copy it to the heap */
2018-03-23 18:48:16 +00:00
*ip = d1;
2014-10-22 10:10:43 +01:00
continue;
2018-11-17 23:39:55 +00:00
deref_body(d1, pt0, undef_unk, undef_nonvar);
2018-11-02 15:32:05 +00:00
if (pt0 < HR) {
2016-03-29 01:55:12 +01:00
/* variable is safe */
2018-03-23 18:48:16 +00:00
*ip = (CELL)pt0;
2014-10-22 10:10:43 +01:00
} else {
2016-03-29 01:55:12 +01:00
/* bind it, in case it is a local variable */
2018-03-23 18:48:16 +00:00
RESET_VARIABLE(ip);
2018-11-02 15:32:05 +00:00
Bind_Local(pt0, Unsigned(ip));
2014-10-22 10:10:43 +01:00
}
ENDP(pt0);
ENDD(d1);
}
}
2019-04-24 12:10:06 +01:00
ARG1 = AbsPair(HR);
HR[1] = d0;
ENDD(d0);
if (pe->ModuleOfPred == PROLOG_MODULE) {
if (CurrentModule == PROLOG_MODULE)
HR[0] = TermProlog;
else
HR[0] = CurrentModule;
} else {
HR[0] = Yap_Module_Name(pe);
}
ARG2 = Yap_getUnknownModule(Yap_GetModuleEntry(HR[0]));
HR += 2;
2018-03-23 18:48:16 +00:00
2014-10-22 10:10:43 +01:00
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
2016-03-29 01:55:12 +01:00
low_level_trace(enter_pred, UndefCode, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
2014-10-22 10:10:43 +01:00
P = UndefCode->CodeOfPred;
}
2016-03-29 01:55:12 +01:00
static void spy_goal(USES_REGS1) {
2014-10-22 10:10:43 +01:00
PredEntry *pe = PredFromDefCode(P);
2019-04-24 12:10:06 +01:00
2014-10-22 10:10:43 +01:00
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
2016-03-29 01:55:12 +01:00
PELOCK(14, pe);
2014-10-22 10:10:43 +01:00
PP = pe;
2015-01-18 03:00:19 +00:00
}
2014-10-22 10:10:43 +01:00
#endif
BEGD(d0);
2016-03-29 01:55:12 +01:00
if (!(pe->PredFlags & IndexedPredFlag) && pe->cs.p_code.NOfClauses > 1) {
2014-10-22 10:10:43 +01:00
/* update ASP before calling IPred */
2016-03-29 01:55:12 +01:00
SET_ASP(YREG, E_CB * sizeof(CELL));
2014-10-22 10:10:43 +01:00
Yap_IPred(pe, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */
if (P == FAILCODE) {
#if defined(YAPOR) || defined(THREADS)
2016-03-29 01:55:12 +01:00
if (PP && !(PP->PredFlags & LogUpdatePredFlag)) {
UNLOCKPE(20, pe);
PP = NULL;
2014-10-22 10:10:43 +01:00
}
#endif
return;
}
}
/* first check if we need to increase the counter */
if ((pe->PredFlags & CountPredFlag)) {
2015-04-21 23:09:43 +01:00
LOCK(pe->StatisticsForPred->lock);
pe->StatisticsForPred->NOfEntries++;
UNLOCK(pe->StatisticsForPred->lock);
2014-10-22 10:10:43 +01:00
LOCAL_ReductionsCounter--;
if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) {
#if defined(YAPOR) || defined(THREADS)
if (PP) {
2016-03-29 01:55:12 +01:00
UNLOCKPE(20, pe);
PP = NULL;
2014-10-22 10:10:43 +01:00
}
#endif
2016-03-29 01:55:12 +01:00
Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, "");
2014-10-22 10:10:43 +01:00
return;
}
LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
#if defined(YAPOR) || defined(THREADS)
if (PP) {
2016-03-29 01:55:12 +01:00
UNLOCKPE(21, pe);
PP = NULL;
2014-10-22 10:10:43 +01:00
}
#endif
2016-03-29 01:55:12 +01:00
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
2014-10-22 10:10:43 +01:00
return;
}
2016-03-29 01:55:12 +01:00
if ((pe->PredFlags & (CountPredFlag | ProfiledPredFlag | SpiedPredFlag)) ==
CountPredFlag) {
2014-10-22 10:10:43 +01:00
#if defined(YAPOR) || defined(THREADS)
if (PP) {
2016-03-29 01:55:12 +01:00
UNLOCKPE(22, pe);
PP = NULL;
2014-10-22 10:10:43 +01:00
}
#endif
P = pe->cs.p_code.TrueCodeOfPred;
return;
}
}
/* standard profiler */
if ((pe->PredFlags & ProfiledPredFlag)) {
2016-05-13 11:41:19 +01:00
if (!pe->StatisticsForPred)
Yap_initProfiler(pe);
2015-04-21 23:09:43 +01:00
LOCK(pe->StatisticsForPred->lock);
pe->StatisticsForPred->NOfEntries++;
UNLOCK(pe->StatisticsForPred->lock);
2014-10-22 10:10:43 +01:00
if (!(pe->PredFlags & SpiedPredFlag)) {
P = pe->cs.p_code.TrueCodeOfPred;
#if defined(YAPOR) || defined(THREADS)
if (PP) {
2016-03-29 01:55:12 +01:00
UNLOCKPE(23, pe);
PP = NULL;
2014-10-22 10:10:43 +01:00
}
#endif
return;
}
}
#if defined(YAPOR) || defined(THREADS)
if (PP) {
2016-03-29 01:55:12 +01:00
UNLOCKPE(25, pe);
2014-10-22 10:10:43 +01:00
PP = NULL;
}
#endif
d0 = pe->ArityOfPE;
/* save S for ModuleName */
if (d0 == 0) {
HR[1] = MkAtomTerm((Atom)(pe->FunctorOfPred));
} else {
2016-03-29 01:55:12 +01:00
*HR = (CELL)pe->FunctorOfPred;
2014-10-22 10:10:43 +01:00
HR[d0 + 2] = AbsAppl(HR);
HR++;
BEGP(pt1);
pt1 = XREGS + 1;
for (; d0 > 0; --d0) {
BEGD(d1);
BEGP(pt0);
pt0 = pt1++;
d1 = *pt0;
deref_head(d1, dospy_unk);
dospy_nonvar:
/* just copy it to the heap */
*HR++ = d1;
continue;
derefa_body(d1, pt0, dospy_unk, dospy_nonvar);
if (pt0 <= HR) {
2016-03-29 01:55:12 +01:00
/* variable is safe */
*HR++ = (CELL)pt0;
2014-10-22 10:10:43 +01:00
} else {
2016-03-29 01:55:12 +01:00
/* bind it, in case it is a local variable */
d1 = Unsigned(HR);
RESET_VARIABLE(HR);
HR += 1;
Bind_Local(pt0, d1);
2014-10-22 10:10:43 +01:00
}
ENDP(pt0);
ENDD(d1);
}
ENDP(pt1);
}
ENDD(d0);
HR[0] = Yap_Module_Name(pe);
2016-03-29 01:55:12 +01:00
ARG1 = (Term)AbsPair(HR);
2014-10-22 10:10:43 +01:00
HR += 2;
{
PredEntry *pt0;
2014-11-14 16:51:42 +00:00
#if THREADS
2014-10-22 10:10:43 +01:00
LOCK(GLOBAL_ThreadHandlesLock);
2014-11-14 16:51:42 +00:00
#endif
2014-10-22 10:10:43 +01:00
pt0 = SpyCode;
P_before_spy = P;
P = pt0->CodeOfPred;
2016-03-29 01:55:12 +01:00
/* for profiler */
2014-11-14 16:51:42 +00:00
#if THREADS
2014-10-22 10:10:43 +01:00
UNLOCK(GLOBAL_ThreadHandlesLock);
2014-11-14 16:51:42 +00:00
#endif
2014-10-22 10:10:43 +01:00
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
2016-03-29 01:55:12 +01:00
low_level_trace(enter_pred, pt0, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */
2014-10-22 10:10:43 +01:00
}
}
2016-03-29 01:55:12 +01:00
Int Yap_absmi(int inp) {
CACHE_REGS
#if BP_FREE
/* some function might be using bp for an internal variable, it is the
callee's responsability to save it */
2016-03-29 01:55:12 +01:00
yamop *PCBACKUP = P1REG;
#endif
#ifdef LONG_LIVED_REGISTERS
register CELL d0, d1;
register CELL *pt0, *pt1;
#endif /* LONG_LIVED_REGISTERS */
#ifdef SHADOW_P
register yamop *PREG = P;
#endif /* SHADOW_P */
#ifdef SHADOW_CP
register yamop *CPREG = CP;
#endif /* SHADOW_CP */
#ifdef SHADOW_HB
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
#ifdef SHADOW_Y
register CELL *YREG = Yap_REGS.YENV_;
#endif /* SHADOW_Y */
#ifdef SHADOW_S
register CELL *SREG = Yap_REGS.S_;
#else
#endif /* SHADOW_S */
2016-03-29 01:55:12 +01:00
/* The indexing register so that we will not destroy ARG1 without
* reason */
#define I_R (XREGS[0])
2015-01-18 03:00:19 +00:00
#if YAP_JIT
2016-03-29 01:55:12 +01:00
Yap_ExpEnvP = &Yap_ExpEnv;
static void *control_labels[] = {
&&fail, &&NoStackCut, &&NoStackCommitY,
&&NoStackCutT, &&NoStackEither, &&NoStackExecute,
&&NoStackCall, &&NoStackDExecute, &&NoStackDeallocate,
&&notrailleft, &&NoStackFail, &&NoStackCommitX};
2015-01-18 03:00:19 +00:00
curtrace = NULL;
curpreg = NULL;
globalcurblock = NULL;
ineedredefinedest = 0;
2016-03-29 01:55:12 +01:00
NativeArea = (NativeContext *)malloc(sizeof(NativeContext));
2015-01-18 03:00:19 +00:00
NativeArea->area.p = NULL;
NativeArea->area.ok = NULL;
NativeArea->area.pc = NULL;
#if YAP_STAT_PREDS
NativeArea->area.nrecomp = NULL;
NativeArea->area.compilation_time = NULL;
NativeArea->area.native_size_bytes = NULL;
NativeArea->area.trace_size_bytes = NULL;
NativeArea->success = NULL;
NativeArea->runs = NULL;
NativeArea->t_runs = NULL;
#endif
NativeArea->n = 0;
2016-03-29 01:55:12 +01:00
IntermediatecodeArea =
(IntermediatecodeContext *)malloc(sizeof(IntermediatecodeContext));
2015-01-18 03:00:19 +00:00
IntermediatecodeArea->area.t = NULL;
IntermediatecodeArea->area.ok = NULL;
IntermediatecodeArea->area.isactive = NULL;
IntermediatecodeArea->area.lastblock = NULL;
#if YAP_STAT_PREDS
IntermediatecodeArea->area.profiling_time = NULL;
#endif
IntermediatecodeArea->n = 0;
nnexec = 0;
l = 0;
#endif /* YAP_JIT */
2015-04-13 13:14:36 +01:00
#if USE_THREADED_CODE
2016-03-29 01:55:12 +01:00
/************************************************************************/
/* Abstract Machine Instruction Address Table */
/* This must be declared inside the function. We use the asm directive */
/* to make it available outside this function */
/************************************************************************/
static void *OpAddress[] = {
#define OPCODE(OP, TYPE) &&_##OP
#include "YapOpcodes.h"
2016-03-29 01:55:12 +01:00
#undef OPCODE
};
2015-01-18 03:00:19 +00:00
#if YAP_JIT
ExpEnv.config_struc.TOTAL_OF_OPCODES =
2016-03-29 01:55:12 +01:00
sizeof(OpAddress) / (2 * sizeof(void *));
2015-01-18 03:00:19 +00:00
#endif
2015-04-13 13:14:36 +01:00
#endif /* USE_THREADED_CODE */
2016-03-29 01:55:12 +01:00
/*static void* (*nat_glist_valx)(yamop**,yamop**,CELL**,void**,int*);
2015-04-13 13:14:36 +01:00
2016-03-29 01:55:12 +01:00
if (nat_glist_valx == NULL) {
nat_glist_valx =
(void*(*)(yamop**,yamop**,CELL**,void**,int*))call_JIT_Compiler(J,
_glist_valx);
}*/
2015-04-13 13:14:36 +01:00
#ifdef SHADOW_REGS
/* work with a local pointer to the registers */
register REGSTORE *regp = &Yap_REGS;
#endif /* SHADOW_REGS */
#if PUSH_REGS
2016-03-29 01:55:12 +01:00
/* useful on a X86 with -fomit-frame-pointer optimisation */
/* The idea is to push REGS onto the X86 stack frame */
/* first allocate local space */
REGSTORE absmi_regs;
REGSTORE *old_regs = Yap_regp;
#endif /* PUSH_REGS */
#ifdef BEAM
2016-03-29 01:55:12 +01:00
CELL OLD_B = B;
extern PredEntry *bpEntry;
2016-03-29 01:55:12 +01:00
if (inp == -9000) {
#if PUSH_REGS
old_regs = &Yap_REGS;
init_absmi_regs(&absmi_regs);
#if THREADS
2016-03-29 01:55:12 +01:00
regcache = Yap_regp LOCAL_PL_local_data_p->reg_cache = regcache;
#else
Yap_regp = &absmi_regs;
#endif
#endif
CACHE_A1();
2016-03-29 01:55:12 +01:00
PREG = bpEntry->CodeOfPred;
JMPNext(); /* go execute instruction at PREG */
}
#endif
#if USE_THREADED_CODE
/* absmadr */
if (inp > 0) {
2015-02-07 01:08:32 +00:00
Yap_ABSMI_OPCODES = OpAddress;
#if YAP_JIT
Yap_ABSMI_ControlLabels = control_labels;
#endif
#if BP_FREE
P1REG = PCBACKUP;
#endif
2016-03-29 01:55:12 +01:00
return (0);
}
#endif /* USE_THREADED_CODE */
#if PUSH_REGS
2019-04-24 12:10:06 +01:00
old_regs = &Yap_REGS;
2015-11-05 15:04:12 +00:00
/* done, let us now initialize this space */
init_absmi_regs(&absmi_regs);
2019-04-24 12:10:06 +01:00
2016-03-29 01:55:12 +01:00
/* the registers are all set up, let's swap */
#ifdef THREADS
pthread_setspecific(Yap_yaamregs_key, (const void *)&absmi_regs);
LOCAL_ThreadHandle.current_yaam_regs = &absmi_regs;
regcache = &absmi_regs;
2016-03-29 01:55:12 +01:00
// LOCAL_PL_local_data_p->reg_cache = regcache;
#else
Yap_regp = &absmi_regs;
#endif
#undef Yap_REGS
#define Yap_REGS absmi_regs
#endif /* PUSH_REGS */
#ifdef SHADOW_REGS
/* use regp as a copy of REGS */
regp = &Yap_REGS;
#ifdef REGS
#undef REGS
#endif
#define REGS (*regp)
#endif /* SHADOW_REGS */
setregs();
CACHE_A1();
2016-03-29 01:55:12 +01:00
reset_absmi:
SP = SP0;
#if USE_THREADED_CODE
2016-03-29 01:55:12 +01:00
//___androidlog_print(ANDROID_LOG_INFO, "YAP ", "%s",
// Yap_op_names[Yap_op_from_opcode(PREG->opc)]);
2015-04-13 13:14:36 +01:00
2016-03-29 01:55:12 +01:00
JMPNext(); /* go execute instruction at P */
#else
/* when we start we are not in write mode */
{
op_numbers opcode = _Ystop;
op_numbers old_op;
#ifdef DEBUG_XX
unsigned long ops_done;
#endif
goto nextop;
nextop_write:
old_op = opcode;
2014-05-30 01:06:09 +01:00
opcode = PREG->y_u.o.opcw;
goto op_switch;
nextop:
old_op = opcode;
opcode = PREG->opc;
op_switch:
#ifdef ANALYST
GLOBAL_opcount[opcode]++;
GLOBAL_2opcount[old_op][opcode]++;
#ifdef DEBUG_XX
ops_done++;
2016-03-29 01:55:12 +01:00
/* if (B->cp_b > 0x103fff90)
fprintf(stderr,"(%ld) doing %s, done %s, B is %p, HB is %p, H is %p\n",
ops_done,Yap_op_names[opcode],Yap_op_names[old_op],B,B->cp_h,HR);*/
#endif
#endif /* ANALYST */
switch (opcode) {
#endif /* USE_THREADED_CODE */
#if !OS_HANDLES_TR_OVERFLOW
2016-03-29 01:55:12 +01:00
notrailleft:
/* if we are within indexing code, the system may have to
* update a S */
{
CELL cut_b;
#ifdef SHADOW_S
2016-03-29 01:55:12 +01:00
S = SREG;
#endif
2016-03-29 01:55:12 +01:00
/* YREG was pointing to where we were going to build the
* next choice-point. The stack shifter will need to know this
* to move the local stack */
SET_ASP(YREG, E_CB * sizeof(CELL));
cut_b = LCL0 - (CELL *)(ASP[E_CB]);
saveregs();
if (!Yap_growtrail(0, false)) {
Yap_NilError(RESOURCE_ERROR_TRAIL,
"YAP failed to reserve %ld bytes in growtrail",
sizeof(CELL) * K16);
setregs();
FAIL();
}
setregs();
#ifdef SHADOW_S
2016-03-29 01:55:12 +01:00
SREG = S;
#endif
2016-03-29 01:55:12 +01:00
if (SREG == ASP) {
SREG[E_CB] = (CELL)(LCL0 - cut_b);
}
}
goto reset_absmi;
#endif /* OS_HANDLES_TR_OVERFLOW */
2015-01-18 03:00:19 +00:00
// move instructions to separate file
// so that they are easier to analyse.
#include "absmi_insts.h"
#if !USE_THREADED_CODE
2016-03-29 01:55:12 +01:00
default:
saveregs();
Yap_Error(SYSTEM_ERROR_INTERNAL, MkIntegerTerm(opcode),
"trying to execute invalid YAAM instruction %d", opcode);
setregs();
FAIL();
}
}
2013-12-12 14:24:40 +00:00
#else
#if PUSH_REGS
2016-03-29 01:55:12 +01:00
restore_absmi_regs(old_regs);
#endif
2013-12-12 14:24:40 +00:00
#if BP_FREE
2016-03-29 01:55:12 +01:00
P1REG = PCBACKUP;
#endif
2013-12-12 14:24:40 +00:00
2016-03-29 01:55:12 +01:00
return (0);
#endif
}
/* dummy function that is needed for profiler */
2016-03-29 01:55:12 +01:00
int Yap_absmiEND(void) { return 1; }
2017-06-26 01:17:51 +01:00
/// @}
/// @}