diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

split for jit

Browse Source
This commit is contained in:
Vitor Santos Costa 2015-01-17 02:46:54 -08:00
parent 0c88265943
commit eeffeea9aa
12 changed files with 9823 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
C/absmi.c
View File

@ -532,6 +532,19 @@ Term Yap_XREGS[MaxTemps]; /* 29 */
#include "arith2.h"
// #include "print_preg.h"
//#include "sprint_op.hpp"
//#include "print_op.hpp"
#if YAP_JIT
#include "IsGround.h"
#include "yaam_macros.hpp"
#include "fprintblock.h"
#endif /* YAP_JIT */
#if YAP_DBG_PREDS
#include "debug_printers.h"
#endif
#ifdef COROUTINING
/*
Imagine we are interrupting the execution, say, because we have a spy
@ -751,6 +764,7 @@ interrupt_handler( PredEntry *pe USES_REGS )
return true;
}
// interrupt handling code that sets up the case when we do not have
// a guaranteed environment.
static int
@ -1552,6 +1566,43 @@ Yap_absmi(int inp)
* reason */
#define I_R (XREGS[0])
#if YAP_JIT
#if YAP_STAT_PREDS
struct timeval timstart, timend;
struct rusage rustart, ruend;
#endif
static void *control_labels[] = { &&fail, &&NoStackCut, &&NoStackCommitY, &&NoStackCutT, &&NoStackEither, &&NoStackExecute, &&NoStackCall, &&NoStackDExecute, &&NoStackDeallocate, &&notrailleft, &&NoStackFail, &&NoStackCommitX, &&dospy };
curtrace = NULL;
curpreg = NULL;
globalcurblock = NULL;
ineedredefinedest = 0;
NativeArea = (NativeContext*)malloc(sizeof(NativeContext));
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;
IntermediatecodeArea = (IntermediatecodeContext*)malloc(sizeof(IntermediatecodeContext));
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 */
#if USE_THREADED_CODE
/************************************************************************/
/* Abstract Machine Instruction Address Table */
@ -1565,8 +1616,18 @@ Yap_absmi(int inp)
#undef OPCODE
};
#if YAP_JIT
ExpEnv.config_struc.TOTAL_OF_OPCODES = sizeof(OpAddress)/(2*sizeof(void*));
#endif
#endif /* USE_THREADED_CODE */
/*static void* (*nat_glist_valx)(yamop**,yamop**,CELL**,void**,int*);
if (nat_glist_valx == NULL) {
nat_glist_valx = (void*(*)(yamop**,yamop**,CELL**,void**,int*))call_JIT_Compiler(J, _glist_valx);
}*/
#ifdef SHADOW_REGS
/* work with a local pointer to the registers */
@ -1735,8 +1796,12 @@ Yap_absmi(int inp)
// move instructions to separate file
// so that they are easier to analyse.
#include "absmi_insts.i"
#include "absmi_insts.h"
#if YAP_JIT
#include "traced_absmi_insts.i"
#endif
#if !USE_THREADED_CODE
default:
saveregs();

77
C/absmi_insts.h Normal file
View File

@ -0,0 +1,77 @@
/*****************************************************************
* INSTRUCTIONS *
*****************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
BOp(Ystop, l);
SET_ASP(YREG, E_CB*sizeof(CELL));
/* make sure ASP is initialised */
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
#endif
#if BP_FREE
P1REG = PCBACKUP;
#endif
return 1;
ENDBOp();
BOp(Nstop, e);
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
#endif
#if BP_FREE
P1REG = PCBACKUP;
#endif
return 0;
ENDBOp();
/************************************************************************\
* Native Code Execution *
\************************************************************************/
#if YAP_JIT
/* native_me */
BOp(jit_handler, J);
if (!PREG->y_u.J.jh->fi.bcst.c) PREG->y_u.J.jh->mf.isground = IsGround(PREG);
PREG->y_u.J.jh->fi.bcst.c++;
/* Did PREG reach threshold value to become critical? */
if (PREG->y_u.J.jh->fi.bcst.c == (COUNT)(ExpEnv.config_struc.frequency_bound*(ExpEnv.config_struc.profiling_startp)) && !PREG->y_u.J.jh->mf.isground) {
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.pprint_me.criticals != 0 && ExpEnv.debug_struc.pprint_me.criticals != 0x1) {
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.criticals);
}
#endif
goto critical_lbl;
}
#if YAP_DBG_PREDS
print_main_when_head(PREG, ON_INTERPRETER);
#endif
PREG = NEXTOP(PREG, J);
JMPNext();
ENDBOp();
#endif
#include "cp_absmi_insts.c"
#include "lu_absmi_insts.c"
#include "fail_absmi_insts.c"
#include "control_absmi_insts.c"
#include "unify_absmi_insts.c"
#include "fli_absmi_insts.c"
#include "or_absmi_insts.c"
#include "index_absmi_insts.c"
#include "prim_absmi_insts.c"
#include "meta_absmi_insts.c"

551
C/control_absmi_insts.h Normal file
View File

@ -0,0 +1,551 @@
/************************************************************************\
* Cut & Commit Instructions *
\************************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
/* cut */
Op(cut, s);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCut, HR);
ENDCACHE_Y_AS_ENV();
do_cut:
#endif
SET_ASP(YREG, PREG->y_u.s.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
/* assume cut is always in stack */
saveregs();
prune((choiceptr)YREG[E_CB] PASS_REGS);
setregs();
GONext();
#ifdef COROUTINING
NoStackCut:
PROCESS_INT(interrupt_cut, do_cut);
#endif
ENDOp();
/* cut_t */
/* cut_t does the same as cut */
Op(cut_t, s);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCutT, HR);
ENDCACHE_Y_AS_ENV();
do_cut_t:
#endif
SET_ASP(YREG, PREG->y_u.s.s);
/* assume cut is always in stack */
saveregs();
prune((choiceptr)YREG[E_CB] PASS_REGS);
setregs();
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
GONext();
#ifdef COROUTINING
NoStackCutT:
PROCESS_INT(interrupt_cut_t, do_cut_t);
#endif
ENDOp();
/* cut_e */
Op(cut_e, s);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCutE, HR);
ENDCACHE_Y_AS_ENV();
do_cut_e:
#endif
SET_ASP(YREG, PREG->y_u.s.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, s),Osbpp),l);
saveregs();
prune((choiceptr)SREG[E_CB] PASS_REGS);
setregs();
GONext();
#ifdef COROUTINING
NoStackCutE:
PROCESS_INT(interrupt_cut_e, do_cut_e);
#endif
ENDOp();
/* save_b_x Xi */
Op(save_b_x, x);
BEGD(d0);
d0 = PREG->y_u.x.x;
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
XREG(d0) = MkIntegerTerm((Int)B);
#else
XREG(d0) = MkIntegerTerm(LCL0-(CELL *) (B));
#endif /* YAPOR_SBA && FROZEN_STACKS */
PREG = NEXTOP(PREG, x);
ENDD(d0);
GONext();
ENDOp();
/* save_b_y Yi */
Op(save_b_y, y);
#if defined(YAPOR_SBA)
INITIALIZE_PERMVAR(YREG+PREG->y_u.y.y,MkIntegerTerm((Int)B));
#else
INITIALIZE_PERMVAR(YREG+PREG->y_u.y.y,MkIntegerTerm(LCL0-(CELL *)(B)));
#endif /* YAPOR_SBA*/
PREG = NEXTOP(PREG, y);
GONext();
ENDOp();
/* commit_b_x Xi */
Op(commit_b_x, xps);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCommitX, HR);
ENDCACHE_Y_AS_ENV();
do_commit_b_x:
#endif
BEGD(d0);
d0 = XREG(PREG->y_u.xps.x);
deref_head(d0, commit_b_x_unk);
commit_b_x_nvar:
/* skip a void call and a label */
SET_ASP(YREG, PREG->y_u.xps.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, xps),Osbpp),l);
{
choiceptr pt0;
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
pt0 = (choiceptr)IntegerOfTerm(d0);
#else
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
#endif /* YAPOR_SBA && FROZEN_STACKS */
saveregs();
prune(pt0 PASS_REGS);
setregs();
}
GONext();
BEGP(pt1);
deref_body(d0, pt1, commit_b_x_unk, commit_b_x_nvar);
ENDP(pt1);
/* never cut to a variable */
/* Abort */
FAIL();
ENDD(d0);
#ifdef COROUTINING
/* Problem: have I got an environment or not? */
NoStackCommitX:
PROCESS_INT(interrupt_commit_x, do_commit_b_x);
#endif
ENDOp();
/* commit_b_y Yi */
Op(commit_b_y, yps);
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCommitY, HR);
ENDCACHE_Y_AS_ENV();
do_commit_b_y:
#endif
BEGD(d0);
d0 = YREG[PREG->y_u.yps.y];
deref_head(d0, commit_b_y_unk);
commit_b_y_nvar:
SET_ASP(YREG, PREG->y_u.yps.s);
PREG = NEXTOP(NEXTOP(NEXTOP(PREG, yps),Osbpp),l);
{
choiceptr pt0;
#if defined(YAPOR_SBA) && defined(FROZEN_STACKS)
pt0 = (choiceptr)IntegerOfTerm(d0);
#else
pt0 = (choiceptr)(LCL0-IntegerOfTerm(d0));
#endif
saveregs();
prune(pt0 PASS_REGS);
setregs();
}
GONext();
BEGP(pt1);
deref_body(d0, pt1, commit_b_y_unk, commit_b_y_nvar);
ENDP(pt1);
/* never cut to a variable */
/* Abort */
FAIL();
ENDD(d0);
#ifdef COROUTINING
/* This is easier: I know there is an environment so I cannot do allocate */
NoStackCommitY:
PROCESS_INT(interrupt_commit_y, do_commit_b_y);
#endif
ENDOp();
/*************************************************************************
* Call / Proceed instructions *
*************************************************************************/
/* Macros for stack trimming */
/* execute Label */
BOp(execute, pp);
{
PredEntry *pt0;
CACHE_Y_AS_ENV(YREG);
pt0 = PREG->y_u.pp.p;
#ifndef NO_CHECKING
check_stack(NoStackExecute, HR);
goto skip_do_execute;
#endif
do_execute:
FETCH_Y_FROM_ENV(YREG);
pt0 = PREG->y_u.pp.p;
skip_do_execute:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
CACHE_A1();
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
BEGD(d0);
d0 = (CELL)B;
PREG = pt0->CodeOfPred;
/* for profiler */
save_pc();
ENV_YREG[E_CB] = d0;
ENDD(d0);
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
/* this is the equivalent to setting up the stack */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
}
NoStackExecute:
PROCESS_INT(interrupt_execute, do_execute);
ENDBOp();
/* dexecute Label */
/* joint deallocate and execute */
BOp(dexecute, pp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->y_u.pp.p,XREGS+1);
#endif /* LOW_LEVEL_TRACER */
CACHE_Y_AS_ENV(YREG);
{
PredEntry *pt0;
CACHE_A1();
pt0 = PREG->y_u.pp.p;
#ifndef NO_CHECKING
/* check stacks */
check_stack(NoStackDExecute, HR);
goto skip_dexecute;
#endif
continue_dexecute:
FETCH_Y_FROM_ENV(YREG);
pt0 = PREG->y_u.pp.p;
skip_dexecute:
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt0->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
PREG = pt0->CodeOfPred;
/* for profiler */
save_pc();
ALWAYS_LOOKAHEAD(pt0->OpcodeOfPred);
/* do deallocate */
CPREG = (yamop *) ENV_YREG[E_CP];
ENV_YREG = ENV = (CELL *) ENV_YREG[E_E];
#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 ENV_YREG = (CELL *)((CELL)ENV_YREG + ENV_Size(CPREG));
}
#else
if (ENV_YREG > (CELL *)B) {
ENV_YREG = (CELL *)B;
}
else {
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
}
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV();
/* setup GB */
ENV_YREG[E_CB] = (CELL) B;
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
}
ENDCACHE_Y_AS_ENV();
NoStackDExecute:
PROCESS_INT(interrupt_dexecute, continue_dexecute);
ENDBOp();
BOp(fcall, Osbpp);
CACHE_Y_AS_ENV(YREG);
ENV_YREG[E_CP] = (CELL) CPREG;
ENV_YREG[E_E] = (CELL) ENV;
#ifdef DEPTH_LIMIT
ENV_YREG[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
ENDCACHE_Y_AS_ENV();
ENDBOp();
BOp(call, Osbpp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1);
}
#endif /* LOW_LEVEL_TRACER */
CACHE_Y_AS_ENV(YREG);
{
PredEntry *pt;
CACHE_A1();
pt = PREG->y_u.Osbpp.p;
#ifndef NO_CHECKING
check_stack(NoStackCall, HR);
goto skip_call;
#endif
call_body:
/* external jump if we don;t want to creep */
FETCH_Y_FROM_ENV(YREG);
pt = PREG->y_u.Osbpp.p;
skip_call:
ENV = ENV_YREG;
/* Try to preserve the environment */
ENV_YREG = (CELL *) (((char *) ENV_YREG) + PREG->y_u.Osbpp.s);
CPREG = NEXTOP(PREG, Osbpp);
ALWAYS_LOOKAHEAD(pt->OpcodeOfPred);
PREG = pt->CodeOfPred;
/* for profiler */
save_pc();
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */
if (pt->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt->ModuleOfPred)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#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 */
WRITEBACK_Y_AS_ENV();
/* setup GB */
ENV_YREG[E_CB] = (CELL) B;
#ifdef YAPOR
SCH_check_requests();
#endif /* YAPOR */
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
}
ENDCACHE_Y_AS_ENV();
ENDBOp();
BOp(procceed, p);
CACHE_Y_AS_ENV(YREG);
ALWAYS_LOOKAHEAD(CPREG->opc);
PREG = CPREG;
/* for profiler */
save_pc();
ENV_YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = ENV_YREG[E_DEPTH];
#endif
WRITEBACK_Y_AS_ENV();
ALWAYS_GONext();
ALWAYS_END_PREFETCH();
ENDCACHE_Y_AS_ENV();
NoStackCall:
PROCESS_INT(interrupt_call, call_body);
ENDBOp();
Op(allocate, e);
CACHE_Y_AS_ENV(YREG);
PREG = NEXTOP(PREG, e);
ENV_YREG[E_CP] = (CELL) CPREG;
ENV_YREG[E_E] = (CELL) ENV;
#ifdef DEPTH_LIMIT
ENV_YREG[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
ENV = ENV_YREG;
ENDCACHE_Y_AS_ENV();
GONext();
ENDOp();
Op(deallocate, p);
CACHE_Y_AS_ENV(YREG);
check_trail(TR);
PREG = NEXTOP(PREG, p);
/* other instructions do depend on S being set by deallocate
:-( */
SREG = YREG;
CPREG = (yamop *) ENV_YREG[E_CP];
ENV = ENV_YREG = (CELL *) ENV_YREG[E_E];
#ifdef DEPTH_LIMIT
DEPTH = ENV_YREG[E_DEPTH];
#endif /* DEPTH_LIMIT */
#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 ENV_YREG = (CELL *)((CELL) ENV_YREG + ENV_Size(CPREG));
}
#else
if (ENV_YREG > (CELL *) B)
ENV_YREG = (CELL *) B;
else
ENV_YREG = (CELL *) ((CELL) ENV_YREG + ENV_Size(CPREG));
#endif /* FROZEN_STACKS */
WRITEBACK_Y_AS_ENV();
#ifndef NO_CHECKING
/* check stacks */
check_stack(NoStackDeallocate, HR);
#endif
ENDCACHE_Y_AS_ENV();
GONext();
NoStackDeallocate:
BEGD(d0);
#ifdef SHADOW_S
Yap_REGS.S_ = SREG;
#endif
saveregs();
d0 = interrupt_deallocate( PASS_REGS1 );
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
#endif
if (!d0) FAIL();
JMPNext();
ENDD(d0);
ENDOp();
/**********************************************
* OPTYap instructions *
**********************************************/
#ifdef YAPOR
#include "or.insts.i"
#endif /* YAPOR */
#ifdef TABLING
#include "tab.insts.i"
#include "tab.tries.insts.i"
#endif /* TABLING */
#ifdef BEAM
extern int eam_am(PredEntry *);
Op(retry_eam, e);
printf("Aqui estou eu..................\n");
if (!eam_am(2)) {
abort_eam("Falhei\n");
FAIL();
}
goto procceed;
PREG = NEXTOP(PREG, e);
GONext();
ENDOp();
Op(run_eam, os);
if (inp==-9000) { /* use indexing to find out valid alternatives */
extern CELL *beam_ALTERNATIVES;
*beam_ALTERNATIVES= (CELL *) PREG->y_u.os.opcw;
beam_ALTERNATIVES++;
if (OLD_B!=B) goto fail;
#if PUSH_REGS
Yap_regp=old_regs;
#endif
return(0);
}
saveregs();
if (!eam_am((PredEntry *) PREG->y_u.os.s)) FAIL();
setregs();
/* cut */
BACKUP_B();
while (POP_CHOICE_POINT(B->cp_b)) {
POP_EXECUTE();
}
B = B->cp_b; /* cut_fail */
HB = B->cp_h; /* cut_fail */
RECOVER_B();
if (0) { register choiceptr ccp;
/* initialize ccp */
#define NORM_CP(CP) ((choiceptr)(CP))
YREG = (CELL *) (NORM_CP(YREG) - 1);
ccp = NORM_CP(YREG);
store_yaam_reg_cpdepth(ccp);
ccp->cp_tr = TR;
ccp->cp_ap = BEAM_RETRY_CODE;
ccp->cp_h = HR;
ccp->cp_b = B;
ccp->cp_env= ENV;
ccp->cp_cp = CPREG;
B = ccp;
SET_BB(B);
}
goto procceed;
PREG = NEXTOP(PREG, os);
GONext();
ENDOp();
#endif

1014
C/cp_absmi_insts.h Normal file
View File

File diff suppressed because it is too large Load Diff

414
C/fail_absmi_insts.h Normal file
View File

@ -0,0 +1,414 @@
/*****************************************************************
* Failure *
*****************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
/* trust_fail */
BOp(trust_fail, e);
{
while (POP_CHOICE_POINT(B->cp_b))
{
POP_EXECUTE();
}
}
#ifdef YAPOR
{
choiceptr cut_pt;
cut_pt = B->cp_b;
CUT_prune_to(cut_pt);
B = cut_pt;
}
#else
B = B->cp_b;
#endif /* YAPOR */
goto fail;
ENDBOp();
#ifdef YAPOR
shared_fail:
B = Get_LOCAL_top_cp();
SET_BB(PROTECT_FROZEN_B(B));
goto fail;
#endif /* YAPOR */
/* fail */
PBOp(op_fail, e);
if (PP) {
UNLOCK(PP->PELock);
PP = NULL;
}
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackFail, HR);
ENDCACHE_Y_AS_ENV();
#endif
fail:
{
register tr_fr_ptr pt0 = TR;
#if defined(YAPOR) || defined(THREADS)
if (PP) {
UNLOCK(PP->PELock);
PP = NULL;
}
#endif
PREG = B->cp_ap;
save_pc();
CACHE_TR(B->cp_tr);
PREFETCH_OP(PREG);
failloop:
if (pt0 == S_TR) {
SP = SP0;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
int go_on = true;
yamop *ipc = PREG;
while (go_on) {
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
go_on = false;
switch (opnum) {
#ifdef TABLING
case _table_load_answer:
low_level_trace(retry_table_loader, LOAD_CP(B)->cp_pred_entry, NULL);
break;
case _table_try_answer:
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
case _table_completion:
#ifdef THREADS_CONSUMER_SHARING
case _table_answer_resolution_completion:
#endif /* THREADS_CONSUMER_SHARING */
#ifdef DETERMINISTIC_TABLING
if (IS_DET_GEN_CP(B))
low_level_trace(retry_table_generator, DET_GEN_CP(B)->cp_pred_entry, NULL);
else
#endif /* DETERMINISTIC_TABLING */
low_level_trace(retry_table_generator, GEN_CP(B)->cp_pred_entry, (CELL *)(GEN_CP(B) + 1));
break;
case _table_answer_resolution:
low_level_trace(retry_table_consumer, CONS_CP(B)->cp_pred_entry, NULL);
break;
case _trie_trust_var:
case _trie_retry_var:
case _trie_trust_var_in_pair:
case _trie_retry_var_in_pair:
case _trie_trust_val:
case _trie_retry_val:
case _trie_trust_val_in_pair:
case _trie_retry_val_in_pair:
case _trie_trust_atom:
case _trie_retry_atom:
case _trie_trust_atom_in_pair:
case _trie_retry_atom_in_pair:
case _trie_trust_null:
case _trie_retry_null:
case _trie_trust_null_in_pair:
case _trie_retry_null_in_pair:
case _trie_trust_pair:
case _trie_retry_pair:
case _trie_trust_appl:
case _trie_retry_appl:
case _trie_trust_appl_in_pair:
case _trie_retry_appl_in_pair:
case _trie_trust_extension:
case _trie_retry_extension:
case _trie_trust_double:
case _trie_retry_double:
case _trie_trust_longint:
case _trie_retry_longint:
case _trie_trust_gterm:
case _trie_retry_gterm:
low_level_trace(retry_table_loader, UndefCode, NULL);
break;
#endif /* TABLING */
case _or_else:
case _or_last:
low_level_trace(retry_or, (PredEntry *)ipc, &(B->cp_a1));
break;
case _retry2:
case _retry3:
case _retry4:
ipc = NEXTOP(ipc,l);
go_on = true;
break;
case _jump:
ipc = ipc->y_u.l.l;
go_on = true;
break;
case _retry_c:
case _retry_userc:
low_level_trace(retry_pred, ipc->y_u.OtapFs.p, B->cp_args);
break;
case _retry_profiled:
case _count_retry:
ipc = NEXTOP(ipc,p);
go_on = true;
break;
case _retry_me:
case _trust_me:
case _count_retry_me:
case _count_trust_me:
case _profiled_retry_me:
case _profiled_trust_me:
case _retry_and_mark:
case _profiled_retry_and_mark:
case _retry:
case _trust:
low_level_trace(retry_pred, ipc->y_u.Otapl.p, B->cp_args);
break;
case _try_logical:
case _retry_logical:
case _profiled_retry_logical:
case _count_retry_logical:
case _trust_logical:
case _profiled_trust_logical:
case _count_trust_logical:
low_level_trace(retry_pred, ipc->y_u.OtILl.d->ClPred, B->cp_args);
break;
case _Nstop:
case _Ystop:
low_level_trace(retry_pred, NULL, B->cp_args);
break;
default:
break;
}
}
}
#endif /* LOW_LEVEL_TRACER */
#ifdef FROZEN_STACKS
#ifdef YAPOR_SBA
if (pt0 < TR_FZ || pt0 > (ADDR)CurrentTrailTop+MinTrailGap)
#else
if (pt0 < TR_FZ)
#endif /* YAPOR_SBA */
{
TR = TR_FZ;
TRAIL_LINK(pt0);
} else
#endif /* FROZEN_STACKS */
RESTORE_TR();
GONext();
}
BEGD(d1);
d1 = TrailTerm(pt0-1);
pt0--;
if (IsVarTerm(d1)) {
#if defined(YAPOR_SBA) && defined(YAPOR)
/* clean up the trail when we backtrack */
if (Unsigned((Int)(d1)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(d1));
} else
#endif
/* normal variable */
RESET_VARIABLE(d1);
goto failloop;
}
/* pointer to code space */
/* or updatable variable */
#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) || defined(MULTI_ASSIGNMENT_VARIABLES)
if (IsPairTerm(d1))
#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
{
register CELL flags;
CELL *pt1 = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR) pt1 == LOCAL_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt0);
TrailTerm(pt0) = AbsPair((CELL *)(pt0 - 1));
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr);
goto failloop;
}
#endif /* LIMIT_TABLING */
#ifdef FROZEN_STACKS /* TRAIL */
/* avoid frozen segments */
if (
#ifdef YAPOR_SBA
(ADDR) pt1 >= HeapTop
#else
IN_BETWEEN(LOCAL_TrailBase, pt1, (ADDR)CurrentTrailTop+MinTrailGap)
#endif /* YAPOR_SBA */
)
{
pt0 = (tr_fr_ptr) pt1;
goto failloop;
} else
#endif /* FROZEN_STACKS */
if (IN_BETWEEN(H0,pt1,HR)) {
if (IsAttVar(pt1)) {
goto failloop;
} else if (*pt1 == (CELL)FunctorBigInt) {
Yap_CleanOpaqueVariable(pt1);
goto failloop;
}
}
#ifdef FROZEN_STACKS /* TRAIL */
/* don't reset frozen variables */
if (pt0 < TR_FZ)
goto failloop;
#endif
flags = *pt1;
#if MULTIPLE_STACKS
if (FlagOn(DBClMask, flags)) {
DBRef dbr = DBStructFlagsToDBStruct(pt1);
int erase;
LOCK(dbr->lock);
DEC_DBREF_COUNT(dbr);
erase = (dbr->Flags & ErasedMask) && (dbr->ref_count == 0);
UNLOCK(dbr->lock);
if (erase) {
saveregs();
Yap_ErDBE(dbr);
setregs();
}
} else {
if (flags & LogUpdMask) {
if (flags & IndexMask) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
PELOCK(8,ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdIndex(cl);
setregs();
} else if (cl->ClFlags & DirtyMask) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_CleanUpIndex(cl);
setregs();
}
UNLOCK(ap->PELock);
} else {
LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
int erase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
/* BB support */
if (ap) {
PELOCK(9,ap);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErLogUpdCl(cl);
setregs();
}
UNLOCK(ap->PELock);
}
}
} else {
DynamicClause *cl = ClauseFlagsToDynamicClause(pt1);
int erase;
LOCK(cl->ClLock);
DEC_CLREF_COUNT(cl);
erase = (cl->ClFlags & ErasedMask) && !(cl->ClRefCount);
UNLOCK(cl->ClLock);
if (erase) {
saveregs();
/* at this point,
we are the only ones accessing the clause,
hence we don't need to have a lock it */
Yap_ErCl(cl);
setregs();
}
}
}
#else
ResetFlag(InUseMask, flags);
*pt1 = flags;
if (FlagOn((ErasedMask|DirtyMask), flags)) {
if (FlagOn(DBClMask, flags)) {
saveregs();
Yap_ErDBE(DBStructFlagsToDBStruct(pt1));
setregs();
} else {
saveregs();
if (flags & LogUpdMask) {
if (flags & IndexMask) {
if (FlagOn(ErasedMask, flags)) {
Yap_ErLogUpdIndex(ClauseFlagsToLogUpdIndex(pt1));
} else {
Yap_CleanUpIndex(ClauseFlagsToLogUpdIndex(pt1));
}
} else {
Yap_ErLogUpdCl(ClauseFlagsToLogUpdClause(pt1));
}
} else {
Yap_ErCl(ClauseFlagsToDynamicClause(pt1));
}
setregs();
}
}
#endif
goto failloop;
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
else /* if (IsApplTerm(d1)) */ {
CELL *pt = RepAppl(d1);
/* AbsAppl means */
/* multi-assignment variable */
/* so the next cell is the old value */
#ifdef FROZEN_STACKS
--pt0;
pt[0] = TrailVal(pt0);
#else
pt[0] = TrailTerm(pt0-1);
pt0 -= 2;
#endif /* FROZEN_STACKS */
goto failloop;
}
#endif
ENDD(d1);
ENDCACHE_TR();
}
#ifdef COROUTINING
NoStackFail:
BEGD(d0);
#ifdef SHADOW_S
Yap_REGS.S_ = SREG;
#endif
saveregs();
d0 = interrupt_fail( PASS_REGS1 );
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
#endif
if (!d0) FAIL();
JMPNext();
ENDD(d0);
#endif /* COROUTINING */
ENDPBOp();

614
C/fli_absmi_insts.h Normal file
View File

@ -0,0 +1,614 @@
/************************************************************************\
* Call C predicates instructions *
\************************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
BOp(call_cpred, Osbpp);
check_trail(TR);
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) {
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCCall, HR);
ENDCACHE_Y_AS_ENV();
}
do_c_call:
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b;
#else
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
#endif /* YAPOR_SBA */
else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s);
}
#else
SET_ASP(YREG, PREG->y_u.Osbpp.s);
/* for slots to work */
#endif /* FROZEN_STACKS */
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1);
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
CPredicate f = PREG->y_u.Osbpp.p->cs.f_code;
PREG = NEXTOP(PREG, Osbpp);
saveregs();
d0 = (f)(PASS_REGS1);
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
#endif
if (!d0) {
FAIL();
}
CACHE_A1();
ENDD(d0);
JMPNext();
NoStackCCall:
PROCESS_INT(interrupt_call, do_c_call);
ENDBOp();
/* execute Label */
BOp(execute_cpred, pp);
check_trail(TR);
{
PredEntry *pt0;
BEGD(d0);
CACHE_Y_AS_ENV(YREG);
#ifndef NO_CHECKING
check_stack(NoStackExecuteC, HR);
do_executec:
#endif
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b;
#else
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b;
#endif /* YAPOR_SBA */
else ASP = YREG+E_CB;
}
#else
SET_ASP(YREG, E_CB*sizeof(CELL));
/* for slots to work */
#endif /* FROZEN_STACKS */
pt0 = PREG->y_u.pp.p;
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
CACHE_A1();
BEGD(d0);
d0 = (CELL)B;
/* for profiler */
save_pc();
ENV_YREG[E_CB] = d0;
ENDD(d0);
#ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */
if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0))
FAIL();
else DEPTH = RESET_DEPTH();
}
} else if (pt0->ModuleOfPred) {
DEPTH -= MkIntConstant(2);
}
#endif /* DEPTH_LIMIT */
/* now call C-Code */
{
CPredicate f = PREG->y_u.pp.p->cs.f_code;
yamop *oldPREG = PREG;
saveregs();
d0 = (f)(PASS_REGS1);
setregs();
#ifdef SHADOW_S
SREG = Yap_REGS.S_;
#endif
if (!d0) {
FAIL();
}
if (oldPREG == PREG) {
/* we did not update PREG */
/* we can proceed */
PREG = CPREG;
ENV_YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = ENV_YREG[E_DEPTH];
#endif
WRITEBACK_Y_AS_ENV();
} else {
/* call the new code */
CACHE_A1();
}
}
JMPNext();
ENDCACHE_Y_AS_ENV();
ENDD(d0);
}
NoStackExecuteC:
PROCESS_INT(interrupt_execute, do_executec);
ENDBOp();
/* Like previous, the only difference is that we do not */
/* trust the C-function we are calling and hence we must */
/* guarantee that *all* machine registers are saved and */
/* restored */
BOp(call_usercpred, Osbpp);
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackUserCall, HR);
ENDCACHE_Y_AS_ENV();
do_user_call:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b;
#else
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b;
#endif /* YAPOR_SBA */
else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s);
}
#else
SET_ASP(YREG, PREG->y_u.Osbpp.s);
/* for slots to work */
#endif /* FROZEN_STACKS */
{
/* make sure that we can still have access to our old PREG after calling user defined goals and backtracking or failing */
yamop *savedP;
LOCAL_PrologMode |= UserCCallMode;
{
PredEntry *p = PREG->y_u.Osbpp.p;
PREG = NEXTOP(PREG, Osbpp);
savedP = PREG;
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_Execute(p, p->cs.f_code);
}
setregs();
LOCAL_PrologMode &= ~UserCCallMode;
restore_machine_regs();
PREG = savedP;
}
if (EX) {
struct DB_TERM *exp = EX;
EX = NULL;
Yap_JumpToEnv(Yap_PopTermFromDB(exp));
SREG = NULL;
}
if (!SREG) {
FAIL();
}
/* in case we call Execute */
YENV = ENV;
YREG = ENV;
JMPNext();
NoStackUserCall:
PROCESS_INT(interrupt_call, do_user_call);
ENDBOp();
BOp(call_c_wfail, slp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,PREG->y_u.slp.p,XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b;
#else
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b;
#endif /* YAPOR_SBA */
else {
BEGD(d0);
d0 = PREG->y_u.slp.s;
ASP = ((CELL *)YREG) + d0;
ENDD(d0);
}
}
#else
if (YREG > (CELL *) B)
ASP = (CELL *) B;
else {
BEGD(d0);
d0 = PREG->y_u.slp.s;
ASP = ((CELL *) YREG) + d0;
ENDD(d0);
}
#endif /* FROZEN_STACKS */
{
CPredicate f = PREG->y_u.slp.p->cs.f_code;
saveregs();
SREG = (CELL *)((f)(PASS_REGS1));
setregs();
}
if (!SREG) {
/* be careful about error handling */
if (PREG != FAILCODE)
PREG = PREG->y_u.slp.l;
} else {
PREG = NEXTOP(PREG, slp);
}
CACHE_A1();
JMPNext();
ENDBOp();
BOp(try_c, OtapFs);
#ifdef YAPOR
CUT_wait_leftmost();
#endif /* YAPOR */
CACHE_Y(YREG);
/* Alocate space for the cut_c structure*/
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
store_args(PREG->y_u.OtapFs.s);
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
B = B_YREG;
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
SET_BB(B_YREG);
ENDCACHE_Y();
TRYCC:
ASP = (CELL *)B;
{
CPredicate f = (CPredicate)(PREG->y_u.OtapFs.f);
saveregs();
SREG = (CELL *) ((f) (PASS_REGS1));
/* This last instruction changes B B*/
while (POP_CHOICE_POINT(B)){
cut_c_pop();
}
setregs();
}
if (!SREG) {
/* Removes the cut functions from the stack
without executing them because we have fail
and not cuted the predicate*/
while(POP_CHOICE_POINT(B))
cut_c_pop();
FAIL();
}
if ((CELL *) B == YREG && ASP != (CELL *) B) {
/* as Luis says, the predicate that did the try C might
* have left some data on the stack. We should preserve
* it, unless the builtin also did cut */
YREG = ASP;
HBREG = PROTECT_FROZEN_H(B);
SET_BB(B);
}
PREG = CPREG;
YREG = ENV;
JMPNext();
ENDBOp();
BOp(retry_c, OtapFs);
#ifdef YAPOR
CUT_wait_leftmost();
#endif /* YAPOR */
CACHE_Y(B);
CPREG = B_YREG->cp_cp;
ENV = B_YREG->cp_env;
HR = PROTECT_FROZEN_H(B);
#ifdef DEPTH_LIMIT
DEPTH =B->cp_depth;
#endif
HBREG = HR;
restore_args(PREG->y_u.OtapFs.s);
ENDCACHE_Y();
goto TRYCC;
ENDBOp();
BOp(cut_c, OtapFs);
/*This is a phantom instruction. This is not executed by the WAM*/
#ifdef DEBUG
/*If WAM executes this instruction, probably there's an error
when we put this instruction, cut_c, after retry_c*/
printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__);
#endif /*DEBUG*/
ENDBOp();
BOp(try_userc, OtapFs);
#ifdef YAPOR
CUT_wait_leftmost();
#endif /* YAPOR */
CACHE_Y(YREG);
/* Alocate space for the cut_c structure*/
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
store_args(PREG->y_u.OtapFs.s);
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
B = B_YREG;
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif
SET_BB(B_YREG);
ENDCACHE_Y();
LOCAL_PrologMode |= UserCCallMode;
ASP = YREG;
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_ExecuteFirst(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f));
EX = NULL;
restore_machine_regs();
setregs();
LOCAL_PrologMode &= ~UserCCallMode;
if (!SREG) {
FAIL();
}
if ((CELL *) B == YREG && ASP != (CELL *) B) {
/* as Luis says, the predicate that did the try C might
* have left some data on the stack. We should preserve
* it, unless the builtin also did cut */
YREG = ASP;
HBREG = PROTECT_FROZEN_H(B);
}
PREG = CPREG;
YREG = ENV;
CACHE_A1();
JMPNext();
ENDBOp();
BOp(retry_userc, OtapFs);
#ifdef YAPOR
CUT_wait_leftmost();
#endif /* YAPOR */
CACHE_Y(B);
CPREG = B_YREG->cp_cp;
ENV = B_YREG->cp_env;
HR = PROTECT_FROZEN_H(B);
#ifdef DEPTH_LIMIT
DEPTH =B->cp_depth;
#endif
HBREG = HR;
restore_args(PREG->y_u.OtapFs.s);
ENDCACHE_Y();
LOCAL_PrologMode |= UserCCallMode;
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
save_machine_regs();
SREG = (CELL *) YAP_ExecuteNext(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f));
EX = NULL;
restore_machine_regs();
setregs();
LOCAL_PrologMode &= ~UserCCallMode;
if (!SREG) {
/* Removes the cut functions from the stack
without executing them because we have fail
and not cuted the predicate*/
while(POP_CHOICE_POINT(B))
cut_c_pop();
FAIL();
}
if ((CELL *) B == YREG && ASP != (CELL *) B) {
/* as Luis says, the predicate that did the try C might
* have left some data on the stack. We should preserve
* it, unless the builtin also did cut */
YREG = ASP;
HBREG = PROTECT_FROZEN_H(B);
}
PREG = CPREG;
YREG = ENV;
CACHE_A1();
JMPNext();
ENDBOp();
BOp(cut_userc, OtapFs);
/*This is a phantom instruction. This is not executed by the WAM*/
#ifdef DEBUG
/*If WAM executes this instruction, probably there's an error
when we put this instruction, cut_userc, after retry_userc*/
printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__);
#endif /*DEBUG*/
CACHE_A1();
JMPNext();
ENDBOp();
/************************************************************************\
* support instructions *
\************************************************************************/
BOp(lock_pred, e);
{
PredEntry *ap = PredFromDefCode(PREG);
PELOCK(10,ap);
PP = ap;
if (!ap->cs.p_code.NOfClauses) {
UNLOCKPE(11,ap);
FAIL();
}
/*
we do not lock access to the predicate,
we must take extra care here
*/
if (ap->cs.p_code.NOfClauses > 1 &&
!(ap->PredFlags & IndexedPredFlag)) {
/* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
Yap_IPred(ap, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();
CACHE_A1();
/* for profiler */
save_pc();
}
PREG = ap->cs.p_code.TrueCodeOfPred;
}
JMPNext();
ENDBOp();
BOp(index_pred, e);
{
PredEntry *ap = PredFromDefCode(PREG);
#if defined(YAPOR) || defined(THREADS)
/*
we do not lock access to the predicate,
we must take extra care here
*/
if (!PP) {
PELOCK(11,ap);
}
if (ap->OpcodeOfPred != INDEX_OPCODE) {
/* someone was here before we were */
if (!PP) {
UNLOCKPE(11,ap);
}
PREG = ap->CodeOfPred;
/* for profiler */
save_pc();
JMPNext();
}
#endif
/* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
Yap_IPred(ap, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();
CACHE_A1();
PREG = ap->CodeOfPred;
/* for profiler */
save_pc();
#if defined(YAPOR) || defined(THREADS)
if (!PP)
#endif
UNLOCKPE(14,ap);
}
JMPNext();
ENDBOp();
#if THREADS
BOp(thread_local, e);
{
PredEntry *ap = PredFromDefCode(PREG);
ap = Yap_GetThreadPred(ap PASS_REGS);
PREG = ap->CodeOfPred;
/* for profiler */
save_pc();
}
JMPNext();
ENDBOp();
#endif
BOp(expand_index, e);
{
PredEntry *pe = PredFromExpandCode(PREG);
yamop *pt0;
/* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL));
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
PELOCK(12,pe);
}
if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR;
if (!PP) {
UNLOCKPE(15,pe);
}
JMPNext();
}
#endif
#ifdef SHADOW_S
S = SREG;
#endif /* SHADOW_S */
saveregs();
pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */
setregs();
#ifdef SHADOW_S
SREG = S;
#endif /* SHADOW_S */
PREG = pt0;
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
UNLOCKPE(12,pe);
}
#endif
JMPNext();
}
ENDBOp();
BOp(expand_clauses, sssllp);
{
PredEntry *pe = PREG->y_u.sssllp.p;
yamop *pt0;
/* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL));
#if defined(YAPOR) || defined(THREADS)
if (PP == NULL) {
PELOCK(13,pe);
}
if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR;
if (!PP) {
UNLOCKPE(16,pe);
}
JMPNext();
}
#endif
saveregs();
pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */
setregs();
PREG = pt0;
#if defined(YAPOR) || defined(THREADS)
if (!PP) {
UNLOCKPE(18,pe);
}
#endif
JMPNext();
}
ENDBOp();
BOp(undef_p, e);
/* save S for module name */
saveregs();
undef_goal( PASS_REGS1 );
setregs();
/* for profiler */
CACHE_A1();
JMPNext();
ENDBOp();
BOp(spy_pred, e);
saveregs();
spy_goal( PASS_REGS1 );
setregs();
CACHE_A1();
JMPNext();
ENDBOp();

459
C/index_absmi_insts.h Normal file
View File

@ -0,0 +1,459 @@
/************************************************************************\
* Indexing in ARG1 *
\************************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
BOp(user_switch, lp);
{
yamop *new = Yap_udi_search(PREG->y_u.lp.p);
if (!new) {
PREG = PREG->y_u.lp.l;
JMPNext();
}
PREG = new;
JMPNext();
}
ENDBOp();
BOp(switch_on_type, llll);
BEGD(d0);
d0 = CACHED_A1();
deref_head(d0, swt_unk);
/* nonvar */
swt_nvar:
if (IsPairTerm(d0)) {
/* pair */
SREG = RepPair(d0);
copy_jmp_address(PREG->y_u.llll.l1);
PREG = PREG->y_u.llll.l1;
JMPNext();
}
else if (!IsApplTerm(d0)) {
/* constant */
copy_jmp_address(PREG->y_u.llll.l2);
PREG = PREG->y_u.llll.l2;
I_R = d0;
JMPNext();
}
else {
/* appl */
copy_jmp_address(PREG->y_u.llll.l3);
PREG = PREG->y_u.llll.l3;
SREG = RepAppl(d0);
JMPNext();
}
BEGP(pt0);
deref_body(d0, pt0, swt_unk, swt_nvar);
/* variable */
copy_jmp_address(PREG->y_u.llll.l4);
PREG = PREG->y_u.llll.l4;
JMPNext();
ENDP(pt0);
ENDD(d0);
ENDBOp();
/* specialised case where the arguments may be:
* a list;
* the empty list;
* some other atom;
* a variable;
*
*/
BOp(switch_list_nl, ollll);
ALWAYS_LOOKAHEAD(PREG->y_u.ollll.pop);
BEGD(d0);
d0 = CACHED_A1();
#if UNIQUE_TAG_FOR_PAIRS
deref_list_head(d0, swlnl_unk_p);
swlnl_list_p:
{
#else
deref_head(d0, swlnl_unk_p);
/* non variable */
swlnl_nvar_p:
if (__builtin_expect(IsPairTerm(d0),1)) {
/* pair */
#endif
copy_jmp_address(PREG->y_u.ollll.l1);
PREG = PREG->y_u.ollll.l1;
SREG = RepPair(d0);
ALWAYS_GONext();
}
#if UNIQUE_TAG_FOR_PAIRS
swlnl_nlist_p:
#endif
if (d0 == TermNil) {
/* empty list */
PREG = PREG->y_u.ollll.l2;
JMPNext();
}
else {
/* appl or constant */
if (IsApplTerm(d0)) {
copy_jmp_address(PREG->y_u.ollll.l3);
PREG = PREG->y_u.ollll.l3;
SREG = RepAppl(d0);
JMPNext();
} else {
copy_jmp_address(PREG->y_u.ollll.l3);
PREG = PREG->y_u.ollll.l3;
I_R = d0;
JMPNext();
}
}
BEGP(pt0);
#if UNIQUE_TAG_FOR_PAIRS
swlnl_unk_p:
deref_list_body(d0, pt0, swlnl_list_p, swlnl_nlist_p);
#else
deref_body(d0, pt0, swlnl_unk_p, swlnl_nvar_p);
#endif
ENDP(pt0);
/* variable */
copy_jmp_address(PREG->y_u.ollll.l4);
PREG = PREG->y_u.ollll.l4;
JMPNext();
ENDD(d0);
}
ENDBOp();
BOp(switch_on_arg_type, xllll);
BEGD(d0);
d0 = XREG(PREG->y_u.xllll.x);
deref_head(d0, arg_swt_unk);
/* nonvar */
arg_swt_nvar:
if (IsPairTerm(d0)) {
/* pair */
copy_jmp_address(PREG->y_u.xllll.l1);
PREG = PREG->y_u.xllll.l1;
SREG = RepPair(d0);
JMPNext();
}
else if (!IsApplTerm(d0)) {
/* constant */
copy_jmp_address(PREG->y_u.xllll.l2);
PREG = PREG->y_u.xllll.l2;
I_R = d0;
JMPNext();
}
else {
/* appl */
copy_jmp_address(PREG->y_u.xllll.l3);
PREG = PREG->y_u.xllll.l3;
SREG = RepAppl(d0);
JMPNext();
}
BEGP(pt0);
deref_body(d0, pt0, arg_swt_unk, arg_swt_nvar);
/* variable */
copy_jmp_address(PREG->y_u.xllll.l4);
PREG = PREG->y_u.xllll.l4;
JMPNext();
ENDP(pt0);
ENDD(d0);
ENDBOp();
BOp(switch_on_sub_arg_type, sllll);
BEGD(d0);
d0 = SREG[PREG->y_u.sllll.s];
deref_head(d0, sub_arg_swt_unk);
/* nonvar */
sub_arg_swt_nvar:
if (IsPairTerm(d0)) {
/* pair */
copy_jmp_address(PREG->y_u.sllll.l1);
PREG = PREG->y_u.sllll.l1;
SREG = RepPair(d0);
JMPNext();
}
else if (!IsApplTerm(d0)) {
/* constant */
copy_jmp_address(PREG->y_u.sllll.l2);
PREG = PREG->y_u.sllll.l2;
I_R = d0;
JMPNext();
}
else {
/* appl */
copy_jmp_address(PREG->y_u.sllll.l3);
PREG = PREG->y_u.sllll.l3;
SREG = RepAppl(d0);
JMPNext();
}
BEGP(pt0);
deref_body(d0, pt0, sub_arg_swt_unk, sub_arg_swt_nvar);
/* variable */
copy_jmp_address(PREG->y_u.sllll.l4);
PREG = PREG->y_u.sllll.l4;
JMPNext();
ENDP(pt0);
ENDD(d0);
ENDBOp();
BOp(jump_if_var, l);
BEGD(d0);
d0 = CACHED_A1();
deref_head(d0, jump_if_unk);
/* non var */
jump0_if_nonvar:
PREG = NEXTOP(PREG, l);
JMPNext();
BEGP(pt0);
deref_body(d0, pt0, jump_if_unk, jump0_if_nonvar);
/* variable */
copy_jmp_address(PREG->y_u.l.l);
PREG = PREG->y_u.l.l;
ENDP(pt0);
JMPNext();
ENDD(d0);
ENDBOp();
BOp(jump_if_nonvar, xll);
BEGD(d0);
d0 = XREG(PREG->y_u.xll.x);
deref_head(d0, jump2_if_unk);
/* non var */
jump2_if_nonvar:
copy_jmp_address(PREG->y_u.xll.l1);
PREG = PREG->y_u.xll.l1;
JMPNext();
BEGP(pt0);
deref_body(d0, pt0, jump2_if_unk, jump2_if_nonvar);
/* variable */
PREG = NEXTOP(PREG, xll);
ENDP(pt0);
JMPNext();
ENDD(d0);
ENDBOp();
BOp(if_not_then, clll);
BEGD(d0);
d0 = CACHED_A1();
deref_head(d0, if_n_unk);
if_n_nvar:
/* not variable */
if (d0 == PREG->y_u.clll.c) {
/* equal to test value */
copy_jmp_address(PREG->y_u.clll.l2);
PREG = PREG->y_u.clll.l2;
JMPNext();
}
else {
/* different from test value */
/* the case to optimise */
copy_jmp_address(PREG->y_u.clll.l1);
PREG = PREG->y_u.clll.l1;
JMPNext();
}
BEGP(pt0);
deref_body(d0, pt0, if_n_unk, if_n_nvar);
ENDP(pt0);
/* variable */
copy_jmp_address(PREG->y_u.clll.l3);
PREG = PREG->y_u.clll.l3;
JMPNext();
ENDD(d0);
ENDBOp();
/************************************************************************\
* Indexing on ARG1 *
\************************************************************************/
#define HASH_SHIFT 6
BOp(switch_on_func, sssl);
BEGD(d1);
d1 = *SREG++;
/* we use a very simple hash function to find elements in a
* switch table */
{
CELL
/* first, calculate the mask */
Mask = (PREG->y_u.sssl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask;
CELL *base;
base = (CELL *)PREG->y_u.sssl.l;
/* PREG now points at the beginning of the hash table */
BEGP(pt0);
/* pt0 will always point at the item */
pt0 = base + hash;
BEGD(d0);
d0 = pt0[0];
/* a match happens either if we found the value, or if we
* found an empty slot */
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
}
else {
/* ooops, collision, look for other items */
register CELL d = ((d1 | 1) << 1) & Mask;
while (1) {
hash = (hash + d) & Mask;
pt0 = base + hash;
d0 = pt0[0];
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) pt0[1];
JMPNext();
}
}
}
ENDD(d0);
ENDP(pt0);
}
ENDD(d1);
ENDBOp();
BOp(switch_on_cons, sssl);
BEGD(d1);
d1 = I_R;
/* we use a very simple hash function to find elements in a
* switch table */
{
CELL
/* first, calculate the mask */
Mask = (PREG->y_u.sssl.s - 1) << 1, /* next, calculate the hash function */
hash = d1 >> (HASH_SHIFT - 1) & Mask;
CELL *base;
base = (CELL *)PREG->y_u.sssl.l;
/* PREG now points at the beginning of the hash table */
BEGP(pt0);
/* pt0 will always point at the item */
pt0 = base + hash;
BEGD(d0);
d0 = pt0[0];
/* a match happens either if we found the value, or if we
* found an empty slot */
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
}
else {
/* ooops, collision, look for other items */
register CELL d = ((d1 | 1) << 1) & Mask;
while (1) {
hash = (hash + d) & Mask;
pt0 = base + hash;
d0 = pt0[0];
if (d0 == d1 || d0 == 0) {
copy_jmp_addressa(pt0+1);
PREG = (yamop *) pt0[1];
JMPNext();
}
}
}
ENDD(d0);
ENDP(pt0);
}
ENDD(d1);
ENDBOp();
BOp(go_on_func, sssl);
BEGD(d0);
{
CELL *pt = (CELL *)(PREG->y_u.sssl.l);
d0 = *SREG++;
if (d0 == pt[0]) {
copy_jmp_addressa(pt+1);
PREG = (yamop *) pt[1];
JMPNext();
} else {
copy_jmp_addressa(pt+3);
PREG = (yamop *) pt[3];
JMPNext();
}
}
ENDD(d0);
ENDBOp();
BOp(go_on_cons, sssl);
BEGD(d0);
{
CELL *pt = (CELL *)(PREG->y_u.sssl.l);
d0 = I_R;
if (d0 == pt[0]) {
copy_jmp_addressa(pt+1);
PREG = (yamop *) pt[1];
JMPNext();
} else {
copy_jmp_addressa(pt+3);
PREG = (yamop *) pt[3];
JMPNext();
}
}
ENDD(d0);
ENDBOp();
BOp(if_func, sssl);
BEGD(d1);
BEGP(pt0);
pt0 = (CELL *) PREG->y_u.sssl.l;
d1 = *SREG++;
while (pt0[0] != d1 && pt0[0] != (CELL)NULL ) {
pt0 += 2;
}
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
ENDP(pt0);
ENDD(d1);
ENDBOp();
BOp(if_cons, sssl);
BEGD(d1);
BEGP(pt0);
pt0 = (CELL *) PREG->y_u.sssl.l;
d1 = I_R;
while (pt0[0] != d1 && pt0[0] != 0L ) {
pt0 += 2;
}
copy_jmp_addressa(pt0+1);
PREG = (yamop *) (pt0[1]);
JMPNext();
ENDP(pt0);
ENDD(d1);
ENDBOp();
Op(index_dbref, e);
PREG = NEXTOP(PREG, e);
I_R = AbsAppl(SREG-1);
GONext();
ENDOp();
Op(index_blob, e);
PREG = NEXTOP(PREG, e);
I_R = Yap_DoubleP_key(SREG);
GONext();
ENDOp();
Op(index_long, e);
PREG = NEXTOP(PREG, e);
I_R = Yap_IntP_key(SREG);
GONext();
ENDOp();

368
C/lu_absmi_insts.h Normal file
View File

@ -0,0 +1,368 @@
/************************************************************************\
* Logical Updates *
\************************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
BOp(profiled_retry_logical, OtaLl);
check_trail(TR);
{
UInt timestamp;
CACHE_Y(B);
#if defined(YAPOR) || defined(THREADS)
if (PP != PREG->y_u.OtaLl.d->ClPred) {
if (PP) UNLOCKPE(15,PP);
PP = PREG->y_u.OtaLl.d->ClPred;
PELOCK(15,PP);
}
#endif
timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[PREG->y_u.OtaLl.s]);
if (!VALID_TIMESTAMP(timestamp, PREG->y_u.OtaLl.d)) {
/* jump to next instruction */
PREG=PREG->y_u.OtaLl.n;
JMPNext();
}
restore_yaam_regs(PREG->y_u.OtaLl.n);
restore_args(PREG->y_u.OtaLl.s);
LOCK(PREG->y_u.OtaLl.d->ClPred->StatisticsForPred.lock);
PREG->y_u.OtaLl.d->ClPred->StatisticsForPred.NOfRetries++;
UNLOCK(PREG->y_u.OtaLl.d->ClPred->StatisticsForPred.lock);
#ifdef THREADS
PP = PREG->y_u.OtaLl.d->ClPred;
#endif
PREG = PREG->y_u.OtaLl.d->ClCode;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */
SET_BB(B_YREG);
ENDCACHE_Y();
}
JMPNext();
ENDBOp();
BOp(profiled_trust_logical, OtILl);
CACHE_Y(B);
{
LogUpdIndex *cl = PREG->y_u.OtILl.block;
PredEntry *ap = cl->ClPred;
LogUpdClause *lcl = PREG->y_u.OtILl.d;
UInt timestamp = IntegerOfTerm(((CELL *)(B_YREG+1))[ap->ArityOfPE]);
#if defined(YAPOR) || defined(THREADS)
if (PP != ap) {
if (PP) UNLOCKPE(16,PP);
PP = ap;
PELOCK(16,PP);
}
#endif
if (!VALID_TIMESTAMP(timestamp, lcl)) {
/* jump to next alternative */
PREG = FAILCODE;
} else {
LOCK(ap->StatisticsForPred.lock);
ap->StatisticsForPred.NOfRetries++;
UNLOCK(ap->StatisticsForPred.lock);
PREG = lcl->ClCode;
}
/* HEY, leave indexing block alone!! */
/* check if we are the ones using this code */
#if MULTIPLE_STACKS
DEC_CLREF_COUNT(cl);
/* clear the entry from the trail */
B->cp_tr--;
TR = B->cp_tr;
/* actually get rid of the code */
if (cl->ClRefCount == 0 && (cl->ClFlags & (ErasedMask|DirtyMask))) {
if (PREG != FAILCODE) {
/* I am the last one using this clause, hence I don't need a lock
to dispose of it
*/
if (lcl->ClRefCount == 1) {
/* make sure the clause isn't destroyed */
/* always add an extra reference */
INC_CLREF_COUNT(lcl);
TRAIL_CLREF(lcl);
}
}
if (cl->ClFlags & ErasedMask) {
saveregs();
Yap_ErLogUpdIndex(cl);
setregs();
} else {
saveregs();
Yap_CleanUpIndex(cl);
setregs();
}
save_pc();
}
#else
if (TrailTerm(B->cp_tr-1) == CLREF_TO_TRENTRY(cl) &&
B->cp_tr != B->cp_b->cp_tr) {
cl->ClFlags &= ~InUseMask;
--B->cp_tr;
#if FROZEN_STACKS
if (B->cp_tr > TR_FZ)
#endif
{
TR = B->cp_tr;
}
/* next, recover space for the indexing code if it was erased */
if (cl->ClFlags & (ErasedMask|DirtyMask)) {
if (PREG != FAILCODE) {
/* make sure we don't erase the clause we are jumping to,
notice that we can erase a number of refs in one go. */
if (!(lcl->ClFlags & InUseMask)) {
lcl->ClFlags |= InUseMask;
TRAIL_CLREF(lcl);
}
}
if (cl->ClFlags & ErasedMask) {
saveregs();
Yap_ErLogUpdIndex(cl);
setregs();
} else {
saveregs();
Yap_CleanUpIndex(cl);
setregs();
}
save_pc();
}
}
#endif
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG);
restore_args(ap->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#else
S_YREG++;
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_args(ap->ArityOfPE);
S_YREG--;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG);
ENDCACHE_Y();
JMPNext();
}
ENDBOp();
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG);
ENDCACHE_Y();
JMPNext();
}
ENDBOp();
/*****************************************************************
* enter a logical semantics dynamic predicate *
*****************************************************************/
/* only meaningful with THREADS on! */
/* lock logical updates predicate. */
Op(lock_lu, p);
#if PARALLEL_YAP
if (PP) {
GONext();
}
PP = PREG->y_u.p.p;
PELOCK(3, PP);
#endif
PREG = NEXTOP(PREG, p);
GONext();
ENDOp();
/* only meaningful with THREADS on! */
/* lock logical updates predicate. */
Op(unlock_lu, e);
#if defined(YAPOR) || defined(THREADS)
if (PP) {
UNLOCKPE(1,PP);
PP = NULL;
}
#endif
PREG = NEXTOP(PREG, e);
GONext();
ENDOp();
/* enter logical pred */
BOp(alloc_for_logical_pred, L);
check_trail(TR);
/* say that an environment is using this clause */
/* we have our own copy for the clause */
#if MULTIPLE_STACKS
{
LogUpdClause *cl = PREG->y_u.L.ClBase;
#if PARALLEL_YAP
PredEntry *ap = cl->ClPred;
#endif
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCKPE(2,ap);
PP = NULL;
}
#else
{
LogUpdClause *cl = (LogUpdClause *)PREG->y_u.L.ClBase;
if (!(cl->ClFlags & InUseMask)) {
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
}
#endif
PREG = NEXTOP(PREG, L);
JMPNext();
ENDBOp();
/* copy database term */
BOp(copy_idb_term, e);
{
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
Term t;
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
while ((t = Yap_FetchTermFromDB(cl->lusl.ClSource)) == 0L) {
if (PP) UNLOCKPE(3,PP);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
Yap_NilError(OUT_OF_ATTVARS_ERROR, LOCAL_ErrorMessage);
FAIL();
}
} else {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_gc(3, ENV, CP)) {
Yap_NilError(OUT_OF_STACK_ERROR, LOCAL_ErrorMessage);
FAIL();
}
}
#if defined(YAPOR) || defined(THREADS)
PELOCK(5,ClauseCodeToLogUpdClause(PREG)->ClPred);
PP = ClauseCodeToLogUpdClause(PREG)->ClPred;
#endif
}
if (!Yap_IUnify(ARG2, t)) {
setregs();
#if defined(YAPOR) || defined(THREADS)
if (PP) UNLOCKPE(6,PP);
PP = NULL;
#endif
FAIL();
}
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
setregs();
#if defined(YAPOR) || defined(THREADS)
if (PP) UNLOCKPE(5,PP);
PP = NULL;
#endif
FAIL();
}
setregs();
#if MULTIPLE_STACKS
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
if (PP) UNLOCKPE(7,PP);
PP = NULL;
#else
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->y_u.EC.ClBase;
PREG->y_u.EC.ClTrail = TR-(tr_fr_ptr)LOCAL_TrailBase;
PREG->y_u.EC.ClENV = LCL0-YREG;*/
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
#endif
}
PREG = CPREG;
YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = YREG[E_DEPTH];
#endif
JMPNext();
ENDBOp();
/* unify with database term */
BOp(unify_idb_term, e);
{
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
saveregs();
if (!Yap_IUnify(ARG2, cl->lusl.ClSource->Entry)) {
setregs();
UNLOCKPE(8,PP);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
FAIL();
}
if (!Yap_IUnify(ARG3, MkDBRefTerm((DBRef)cl))) {
setregs();
UNLOCKPE(9,PP);
#if defined(YAPOR) || defined(THREADS)
PP = NULL;
#endif
FAIL();
}
setregs();
/* say that an environment is using this clause */
/* we have our own copy for the clause */
#if MULTIPLE_STACKS
/* always add an extra reference */
INC_CLREF_COUNT(cl);
TRAIL_CLREF(cl);
UNLOCKPE(10,PP);
PP = NULL;
#else
if (!(cl->ClFlags & InUseMask)) {
/* Clause *cl = (Clause *)PREG->y_u.EC.ClBase;
PREG->y_u.EC.ClTrail = TR-(tr_fr_ptr)LOCAL_TrailBase;
PREG->y_u.EC.ClENV = LCL0-YREG;*/
cl->ClFlags |= InUseMask;
TRAIL_CLREF(cl);
}
#endif
}
PREG = CPREG;
YREG = ENV;
#ifdef DEPTH_LIMIT
DEPTH = YREG[E_DEPTH];
#endif
JMPNext();
ENDBOp();

301
C/meta_absmi_insts.h Normal file
View File

@ -0,0 +1,301 @@
#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((Prop)IntegerOfTerm(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;
if (PRED_GOAL_EXPANSION_ALL) {
goto execute_metacall;
}
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|GoalExPredFlag)) {
/* 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();
}

192
C/or_absmi_insts.h Normal file
View File

@ -0,0 +1,192 @@
/************************************************************************ \
* Instructions for implemeting 'or;' *
\************************************************************************/
#ifdef INDENT_CODE
{
{
{
#endif /* INDENT_CODE */
BOp(jump, l);
PREG = PREG->y_u.l.l;
JMPNext();
ENDBOp();
/* This instruction is called when the previous goal
was interrupted when waking up goals
*/
BOp(move_back, l);
PREG = (yamop *)(((char *)PREG)-(Int)(NEXTOP((yamop *)NULL,Osbpp)));
JMPNext();
ENDBOp();
/* This instruction is called when the previous goal
was interrupted when waking up goals
*/
BOp(skip, l);
PREG = NEXTOP(PREG,l);
JMPNext();
ENDBOp();
Op(either, Osblp);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
low_level_trace(try_or, (PredEntry *)PREG, NULL);
}
#endif
#ifdef COROUTINING
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackEither, HR);
ENDCACHE_Y_AS_ENV();
either_notest:
#endif
BEGD(d0);
/* Try to preserve the environment */
d0 = PREG->y_u.Osblp.s;
BEGCHO(pt1);
pt1 = (choiceptr) ((char *) YREG + (yslot) d0);
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA
if (pt1 > top_b || pt1 < (choiceptr)HR) pt1 = top_b;
#else
if (pt1 > top_b) pt1 = top_b;
#endif /* YAPOR_SBA */
}
#else
if (pt1 > B) {
pt1 = B;
}
#endif /* FROZEN_STACKS */
pt1 = (choiceptr)(((CELL *) pt1)-1);
*(CELL **) pt1 = YREG;
store_yaam_regs_for_either(PREG->y_u.Osblp.l, PREG);
SREG = (CELL *) (B = pt1);
#ifdef YAPOR
SCH_set_load(pt1);
#endif /* YAPOR */
SET_BB(pt1);
ENDCHO(pt1);
/* skip the current instruction plus the next one */
PREG = NEXTOP(NEXTOP(PREG, Osblp),l);
GONext();
ENDD(d0);
#ifdef COROUTINING
NoStackEither:
PROCESS_INT(interrupt_either, either_notest);
#endif
ENDOp();
Op(or_else, Osblp);
HR = HBREG = PROTECT_FROZEN_H(B);
ENV = B->cp_env;
B->cp_cp = PREG;
#ifdef DEPTH_LIMIT
DEPTH = B->cp_depth;
#endif /* DEPTH_LIMIT */
SET_BB(PROTECT_FROZEN_B(B));
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_new_alternative(PREG, PREG->y_u.Osblp.l);
} else
#endif /* YAPOR */
B->cp_ap = PREG->y_u.Osblp.l;
PREG = NEXTOP(PREG, Osblp);
YREG = (CELL *) B->cp_a1;
GONext();
ENDOp();
#ifdef YAPOR
Op(or_last, Osblp);
#else
Op(or_last, p);
#endif /* YAPOR */
BEGCHO(pt0);
pt0 = B;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
HR = HBREG = PROTECT_FROZEN_H(pt0);
YREG = (CELL *) pt0->cp_a1;
ENV = pt0->cp_env;
#ifdef DEPTH_LIMIT
DEPTH = pt0->cp_depth;
#endif /* DEPTH_LIMIT */
SCH_new_alternative(PREG, NULL);
}
else
#endif /* YAPOR */
{
B = pt0->cp_b;
HR = PROTECT_FROZEN_H(pt0);
YREG = (CELL *) pt0->cp_a1;
ENV = pt0->cp_env;
#ifdef DEPTH_LIMIT
DEPTH = pt0->cp_depth;
#endif /* DEPTH_LIMIT */
HBREG = PROTECT_FROZEN_H(B);
}
#ifdef YAPOR
PREG = NEXTOP(PREG, Osblp);
#else
PREG = NEXTOP(PREG, p);
#endif /* YAPOR */
SET_BB(PROTECT_FROZEN_B(B));
GONext();
ENDCHO(pt0);
ENDOp();
/************************************************************************\
* Pop operations *
\************************************************************************/
OpRW(pop_n, s);
/* write mode might have been called from read mode */
BEGD(d0);
d0 = PREG->y_u.os.s;
SP = (CELL *) (((char *) SP) + d0);
ENDD(d0);
BEGD(d0);
d0 = SP[0];
if (d0) {
START_PREFETCH(s);
SREG = (CELL *) (SP[1]);
SP += 2;
PREG = NEXTOP(PREG, s);
GONext();
END_PREFETCH();
}
else {
START_PREFETCH_W(s);
SREG = (CELL *) (SP[1]);
SP += 2;
PREG = NEXTOP(PREG, s);
GONextW();
END_PREFETCH_W();
}
ENDD(d0);
ENDOpRW();
OpRW(pop, e);
BEGD(d0);
d0 = SP[0];
SREG = (CELL *) (SP[1]);
SP += 2;
if (d0) {
START_PREFETCH(e);
PREG = NEXTOP(PREG, e);
GONext();
END_PREFETCH();
}
else {
START_PREFETCH_W(e);
PREG = NEXTOP(PREG, e);
GONextW();
END_PREFETCH_W();
}
ENDD(d0);
ENDOpRW();

2185
C/prim_absmi_insts.h Normal file
View File

File diff suppressed because it is too large Load Diff

3582
C/unify_absmi_insts.h Normal file
View File

File diff suppressed because it is too large Load Diff