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

call_cleanup in C plus indenting

Browse Source
This commit is contained in:
Vítor Santos Costa 2016-03-29 01:55:12 +01:00
parent fa69950c67
commit 1be002558c
17 changed files with 2014 additions and 2306 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1438
C/absmi.c
View File

File diff suppressed because it is too large Load Diff

86
C/absmi_insts.h
View File

@ -8,9 +8,9 @@
{ {
#endif /* INDENT_CODE */ #endif /* INDENT_CODE */
BOp(Ystop, l);
BOp(Ystop, l); LOCAL_CBorder = 0;
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
/* make sure ASP is initialized */ /* make sure ASP is initialized */
saveregs(); saveregs();
@ -20,11 +20,12 @@ BOp(Ystop, l);
#if BP_FREE #if BP_FREE
P1REG = PCBACKUP; P1REG = PCBACKUP;
#endif #endif
LOCAL_CBorder = 0;
return 1; return 1;
ENDBOp(); ENDBOp();
BOp(Nstop, e); BOp(Nstop, e);
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
saveregs(); saveregs();
#if PUSH_REGS #if PUSH_REGS
restore_absmi_regs(old_regs); restore_absmi_regs(old_regs);
@ -32,55 +33,60 @@ BOp(Ystop, l);
#if BP_FREE #if BP_FREE
P1REG = PCBACKUP; P1REG = PCBACKUP;
#endif #endif
if (LOCAL_Error_TYPE == THROW_EVENT) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return 1;
}
return 0; return 0;
ENDBOp(); ENDBOp();
/************************************************************************\
* Native Code Execution *
/************************************************************************\
* Native Code Execution *
\************************************************************************/ \************************************************************************/
#if YAP_JIT #if YAP_JIT
static void *OpAddress_JIT[] = static void *OpAddress_JIT[] = {
{ #define OPCODE(OP, TYPE) &&_##OP
#define OPCODE(OP,TYPE) && _##OP
#include "YapOpcodes.h" #include "YapOpcodes.h"
#undef OPCODE #undef OPCODE
}; };
/* 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? */ /* native_me */
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) { 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 YAP_DBG_PREDS
if (ExpEnv.debug_struc.pprint_me.criticals != 0 && ExpEnv.debug_struc.pprint_me.criticals != 0x1) { if (ExpEnv.debug_struc.pprint_me.criticals != 0 &&
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); ExpEnv.debug_struc.pprint_me.criticals != 0x1) {
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.criticals); fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
} fprintf(stderr, "%s", (char *)ExpEnv.debug_struc.pprint_me.criticals);
#endif
traced_absmi();
} }
#if YAP_DBG_PREDS
print_main_when_head(PREG, ON_INTERPRETER);
#endif #endif
PREG = NEXTOP(PREG, J); traced_absmi();
JMPNext(); }
ENDBOp(); #if YAP_DBG_PREDS
print_main_when_head(PREG, ON_INTERPRETER);
#endif
PREG = NEXTOP(PREG, J);
JMPNext();
ENDBOp();
#endif #endif
#include "cp_absmi_insts.h"
#include "lu_absmi_insts.h"
#include "fail_absmi_insts.h"
#include "control_absmi_insts.h" #include "control_absmi_insts.h"
#include "unify_absmi_insts.h" #include "cp_absmi_insts.h"
#include "fail_absmi_insts.h"
#include "fli_absmi_insts.h" #include "fli_absmi_insts.h"
#include "or_absmi_insts.h" #include "index_absmi_insts.h"
#include "index_absmi_insts.h" #include "lu_absmi_insts.h"
#include "type_absmi_insts.h" #include "meta_absmi_insts.h"
#include "prim_absmi_insts.h" #include "or_absmi_insts.h"
#include "meta_absmi_insts.h" #include "prim_absmi_insts.h"
#include "type_absmi_insts.h"
#include "unify_absmi_insts.h"

3
C/absmi_insts.i
View File

@ -6440,7 +6440,8 @@
#endif /* YAPOR */ #endif /* YAPOR */
CACHE_Y(YREG); CACHE_Y(YREG);
/* Alocate space for the cut_c structure*/ /* Alocate space for the cut_c structure*/
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG);
S_YREG = S_YREG - PREG->y_u.OtapFs.extra; S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
store_args(PREG->y_u.OtapFs.s); store_args(PREG->y_u.OtapFs.s);
store_yaam_regs(NEXTOP(PREG, OtapFs), 0); store_yaam_regs(NEXTOP(PREG, OtapFs), 0);

217
C/c_interface.c
View File

@ -25,12 +25,12 @@
#define C_INTERFACE_C 1 #define C_INTERFACE_C 1
#include <stdlib.h>
#include "Yap.h" #include "Yap.h"
#include "attvar.h"
#include "clause.h" #include "clause.h"
#include "yapio.h" #include "yapio.h"
#include "Foreign.h" #include <stdlib.h>
#include "attvar.h"
#if HAVE_UNISTD_H #if HAVE_UNISTD_H
#include <unistd.h> #include <unistd.h>
#endif #endif
@ -53,8 +53,8 @@
#ifdef YAPOR #ifdef YAPOR
#include "or.macros.h" #include "or.macros.h"
#endif /* YAPOR */ #endif /* YAPOR */
#include "threads.h"
#include "cut_c.h" #include "cut_c.h"
#include "threads.h"
#if HAVE_MALLOC_H #if HAVE_MALLOC_H
#include <malloc.h> #include <malloc.h>
#endif #endif
@ -62,11 +62,11 @@
typedef void *atom_t; typedef void *atom_t;
typedef void *functor_t; typedef void *functor_t;
typedef enum { typedef enum {
FRG_FIRST_CALL = 0, /* Initial call */ FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */ FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */ FRG_REDO = 2 /* Normal redo */
} frg_code; } frg_code;
struct foreign_context { struct foreign_context {
uintptr_t context; /* context value */ uintptr_t context; /* context value */
@ -987,7 +987,7 @@ static uintptr_t execute_cargs_back(PredEntry *pe, CPredicate exec_code,
static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) { static uintptr_t complete_fail(choiceptr ptr, int has_cp USES_REGS) {
// this case is easy, jut be sure to throw everything // this case is easy, jut be sure to throw everything
// after the old B; // after the old B;
while (B != ptr) { while (B && B->cp_b && B->cp_b <= ptr) {
B = B->cp_b; B = B->cp_b;
} }
if (has_cp) if (has_cp)
@ -1066,16 +1066,9 @@ Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS); complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS);
// CurrentModule = omod; // CurrentModule = omod;
if (!ret) { if (!ret) {
Term t; Yap_RaiseException();
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
} }
} return ret;
return ret;
} }
#define FRG_REDO_MASK 0x00000003L #define FRG_REDO_MASK 0x00000003L
@ -1107,15 +1100,8 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
Yap_CloseSlots(CurSlot); Yap_CloseSlots(CurSlot);
PP = NULL; PP = NULL;
if (val == 0) { if (val == 0) {
Term t; if (Yap_RaiseException()) {
return false;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
B = B->cp_b;
Yap_JumpToEnv(t);
return FALSE;
} }
return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS); return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
} else if (val == 1) { /* TRUE */ } else if (val == 1) { /* TRUE */
@ -1132,15 +1118,8 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
Int ret = (exec_code)(PASS_REGS1); Int ret = (exec_code)(PASS_REGS1);
Yap_CloseSlots(CurSlot); Yap_CloseSlots(CurSlot);
if (!ret) { if (!ret) {
Term t; Yap_RaiseException();
}
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
return ret; return ret;
} }
} }
@ -1148,13 +1127,16 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code, Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
struct cut_c_str *top) { struct cut_c_str *top) {
CACHE_REGS CACHE_REGS
choiceptr oB = B; Int oB = LCL0-(CELL*)B;
Int val; Int val;
/* for slots to work */ /* for slots to work */
yhandle_t CurSlot = Yap_StartSlots(); yhandle_t CurSlot = Yap_StartSlots();
/* find out where we belong */ /* find out where we belong */
while (B->cp_b < (choiceptr)top) while (B < (choiceptr)top) {
oB = LCL0 - (CELL *)B;
B = B->cp_b; B = B->cp_b;
}
PP = pe; PP = pe;
if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) { if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) {
// SWI Emulation // SWI Emulation
@ -1163,7 +1145,7 @@ Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
(struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1)); (struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1));
CELL *args = B->cp_args; CELL *args = B->cp_args;
B = oB; B = (choiceptr)(LCL0 - oB);
ctx->control = FRG_CUTTED; ctx->control = FRG_CUTTED;
ctx->engine = NULL; //(PL_local_data *)Yap_regp; ctx->engine = NULL; //(PL_local_data *)Yap_regp;
if (pe->PredFlags & CArgsPredFlag) { if (pe->PredFlags & CArgsPredFlag) {
@ -1172,27 +1154,22 @@ Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
val = codev(Yap_InitSlots(pe->ArityOfPE, args), 0, ctx); val = codev(Yap_InitSlots(pe->ArityOfPE, args), 0, ctx);
} }
} else { } else {
Int oYENV = LCL0 - YENV;
yamop *oP = P, *oCP = CP;
// YAP Native // YAP Native
B = (choiceptr)(LCL0 - oB);
val = exec_code(PASS_REGS1); val = exec_code(PASS_REGS1);
B = oB; YENV = LCL0 - oYENV;
P = oP;
CP = oCP;
} }
Yap_CloseSlots(CurSlot); Yap_CloseSlots(CurSlot);
PP = NULL; PP = NULL;
// B = LCL0-(CELL*)oB; // B = LCL0-(CELL*)oB;
if (val == 0) { if (false && Yap_RaiseException()) {
Term t; return false;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
Yap_JumpToEnv(t);
return FALSE;
}
return FALSE;
} else { /* TRUE */ } else { /* TRUE */
return TRUE; return true;
} }
} }
@ -1220,14 +1197,7 @@ Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) {
/* make sure we clean up the frames left by the user */ /* make sure we clean up the frames left by the user */
PP = NULL; PP = NULL;
if (val == 0) { if (val == 0) {
Term t; if (Yap_RaiseException()) {
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
B = B->cp_b;
Yap_JumpToEnv(t);
return FALSE; return FALSE;
} else { } else {
return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS); return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
@ -1246,15 +1216,8 @@ Int YAP_ExecuteNext(PredEntry *pe, CPredicate exec_code) {
Int ret = (exec_code)(PASS_REGS1); Int ret = (exec_code)(PASS_REGS1);
Yap_CloseSlots(CurSlot); Yap_CloseSlots(CurSlot);
if (!ret) { if (!ret) {
Term t; Yap_RaiseException();
}
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
return ret; return ret;
} }
} }
@ -1292,6 +1255,7 @@ X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) {
RECOVER_MACHINE_REGS(); RECOVER_MACHINE_REGS();
return new_ptr; return new_ptr;
} }
X_API void *YAP_AllocSpaceFromYap(size_t size) { X_API void *YAP_AllocSpaceFromYap(size_t size) {
CACHE_REGS CACHE_REGS
void *ptr; void *ptr;
@ -1531,8 +1495,8 @@ X_API Term YAP_NWideBufferToAtomList(const wchar_t *s, size_t len) {
} }
/* copy a string of size len to a buffer */ /* copy a string of size len to a buffer */
X_API Term X_API Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0,
YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) { size_t len) {
Term t; Term t;
BACKUP_H(); BACKUP_H();
@ -1802,16 +1766,11 @@ X_API Int YAP_RunGoal(Term t) {
LOCAL_AllowRestart = FALSE; LOCAL_AllowRestart = FALSE;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
out = Yap_RunTopGoal(t); out = Yap_RunTopGoal(t, true);
LOCAL_PrologMode = UserCCallMode; LOCAL_PrologMode = UserCCallMode;
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
if (EX) { Yap_RaiseException();
Term ball = Yap_PopTermFromDB(EX);
EX = NULL;
Yap_JumpToEnv(ball);
return FALSE;
}
if (out) { if (out) {
P = (yamop *)ENV[E_CP]; P = (yamop *)ENV[E_CP];
ENV = (CELL *)ENV[E_E]; ENV = (CELL *)ENV[E_E];
@ -1896,7 +1855,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
CSlot = Yap_StartSlots(); CSlot = Yap_StartSlots();
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
// Yap_heap_regs->yap_do_low_level_trace=true; // Yap_heap_regs->yap_do_low_level_trace=true;
out = Yap_RunTopGoal(t); out = Yap_RunTopGoal(t, true);
LOCAL_PrologMode = oldPrologMode; LOCAL_PrologMode = oldPrologMode;
Yap_CloseSlots(CSlot); Yap_CloseSlots(CSlot);
if (!(oldPrologMode & UserCCallMode)) { if (!(oldPrologMode & UserCCallMode)) {
@ -1907,12 +1866,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
} }
// should we catch the exception or pass it through? // should we catch the exception or pass it through?
// We'll pass it through // We'll pass it through
if (EX) { Yap_RaiseException();
Term ball = Yap_PopTermFromDB(EX);
EX = NULL;
Yap_JumpToEnv(ball);
return FALSE;
}
if (out) { if (out) {
choiceptr cut_pt, ob; choiceptr cut_pt, ob;
@ -2044,47 +1998,16 @@ X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) {
X_API bool YAP_GoalHasException(Term *t) { X_API bool YAP_GoalHasException(Term *t) {
CACHE_REGS CACHE_REGS
int out = FALSE;
BACKUP_MACHINE_REGS(); BACKUP_MACHINE_REGS();
if (EX) { if (t)
do { *t = Yap_PeekException();
LOCAL_Error_TYPE = YAP_NO_ERROR; return Yap_PeekException();
*t = Yap_FetchTermFromDB(EX); }
if (LOCAL_Error_TYPE == YAP_NO_ERROR) {
RECOVER_MACHINE_REGS();
return TRUE;
} else if (LOCAL_Error_TYPE == RESOURCE_ERROR_ATTRIBUTED_VARIABLES) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
Yap_Error(RESOURCE_ERROR_ATTRIBUTED_VARIABLES, TermNil,
LOCAL_ErrorMessage);
RECOVER_MACHINE_REGS();
return FALSE;
}
} else {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growstack(EX->NOfCells * CellSize)) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
RECOVER_MACHINE_REGS();
return FALSE;
}
}
} while (*t == (CELL)0);
out = TRUE;
}
RECOVER_MACHINE_REGS();
return out;
}
X_API void YAP_ClearExceptions(void) { X_API void YAP_ClearExceptions(void) {
CACHE_REGS CACHE_REGS
if (EX) { Yap_ResetException(worker_id);
LOCAL_BallTerm = EX;
}
EX = NULL;
Yap_ResetExceptionTerm(0);
LOCAL_UncaughtThrow = FALSE;
} }
X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) { X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) {
@ -2101,11 +2024,11 @@ X_API int YAP_InitConsult(int mode, const char *filename, int *osnop) {
const char *full = Yap_AbsoluteFile(filename, true); const char *full = Yap_AbsoluteFile(filename, true);
if (!full) if (!full)
return -1; return -1;
f = fopen( full, "r"); f = fopen(full, "r");
if (!f) if (!f)
return -1; return -1;
else else
free( (char *)full ); free((char *)full);
sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f); sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f);
*osnop = Yap_CheckAlias(AtomLoopStream); *osnop = Yap_CheckAlias(AtomLoopStream);
if (!Yap_AddAlias(AtomLoopStream, sno)) { if (!Yap_AddAlias(AtomLoopStream, sno)) {
@ -2154,7 +2077,6 @@ X_API Term YAP_Read(FILE *f) {
return o; return o;
} }
X_API Term YAP_ReadFromStream(int sno) { X_API Term YAP_ReadFromStream(int sno) {
Term o; Term o;
@ -2283,7 +2205,7 @@ static void do_bootfile(char *bootfilename USES_REGS) {
YAP_Reset(YAP_FULL_RESET); YAP_Reset(YAP_FULL_RESET);
Yap_StartSlots(); Yap_StartSlots();
t = YAP_ReadClauseFromStream(bootfile); t = YAP_ReadClauseFromStream(bootfile);
// Yap_DebugPlWrite(t);fprintf(stderr, "\n"); //Yap_DebugPlWriteln(t);
if (t == 0) { if (t == 0) {
fprintf(stderr, fprintf(stderr,
"[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n", "[ SYNTAX ERROR: while parsing bootfile %s at line %d ]\n",
@ -2349,7 +2271,7 @@ Int YAP_Init(YAP_init_args *yap_init) {
int restore_result; int restore_result;
int do_bootstrap = (yap_init->YapPrologBootFile != NULL); int do_bootstrap = (yap_init->YapPrologBootFile != NULL);
CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0; CELL Trail = 0, Stack = 0, Heap = 0, Atts = 0;
char boot_file[YAP_FILENAME_MAX+1]; char boot_file[YAP_FILENAME_MAX + 1];
static int initialized = FALSE; static int initialized = FALSE;
/* ignore repeated calls to YAP_Init */ /* ignore repeated calls to YAP_Init */
@ -2368,7 +2290,8 @@ Int YAP_Init(YAP_init_args *yap_init) {
GLOBAL_argc = yap_init->Argc; GLOBAL_argc = yap_init->Argc;
#if BOOT_FROM_SAVED_STATE #if BOOT_FROM_SAVED_STATE
if (!yap_init->SavedState) { if (!yap_init->SavedState) {
yap_init->SavedState = Yap_locateFile(YAP_STARTUP, boot_file, sizeof(boot_file)-1); yap_init->SavedState =
Yap_locateFile(YAP_STARTUP, boot_file, sizeof(boot_file) - 1);
} }
#else #else
@ -2717,24 +2640,30 @@ X_API void YAP_PredicateInfo(void *p, Atom *a, UInt *arity, Term *m) {
*m = TermProlog; *m = TermProlog;
} }
X_API void YAP_UserCPredicate(const char *name, CPredicate def, UInt arity) { X_API void YAP_UserCPredicate(const char *name, CPredicate def, arity_t arity) {
Yap_InitCPred(name, arity, def, UserCPredFlag); Yap_InitCPred(name, arity, def, UserCPredFlag);
} }
X_API void YAP_UserBackCPredicate(const char *name, CPredicate init, X_API void YAP_UserBackCPredicate_(const char *name, CPredicate init,
CPredicate cont, UInt arity, CPredicate cont, arity_t arity,
unsigned int extra) { arity_t extra) {
Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag); Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag);
} }
X_API void YAP_UserBackCutCPredicate(const char *name, CPredicate init, X_API void YAP_UserBackCutCPredicate(const char *name, CPredicate init,
CPredicate cont, CPredicate cut, CPredicate cont, CPredicate cut,
UInt arity, unsigned int extra) { arity_t arity, arity_t extra) {
Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag); Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag);
} }
X_API void YAP_UserCPredicateWithArgs(const char *a, CPredicate f, UInt arity, X_API void YAP_UserBackCPredicate(const char *name, CPredicate init,
Term mod) { CPredicate cont, arity_t arity,
arity_t extra) {
Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag);
}
X_API void YAP_UserCPredicateWithArgs(const char *a, CPredicate f,
arity_t arity, Term mod) {
CACHE_REGS CACHE_REGS
PredEntry *pe; PredEntry *pe;
Term cm = CurrentModule; Term cm = CurrentModule;
@ -3398,11 +3327,11 @@ X_API int YAP_RequiresExtraStack(size_t sz) {
return TRUE; return TRUE;
} }
atom_t *TR_Atoms; atom_t *TR_Atoms;
functor_t *TR_Functors; functor_t *TR_Functors;
size_t AtomTranslations, MaxAtomTranslations; size_t AtomTranslations, MaxAtomTranslations;
size_t FunctorTranslations, MaxFunctorTranslations; size_t FunctorTranslations, MaxFunctorTranslations;
X_API Int YAP_AtomToInt(Atom At) { X_API Int YAP_AtomToInt(Atom At) {
TranslationEntry *te = Yap_GetTranslationProp(At, 0); TranslationEntry *te = Yap_GetTranslationProp(At, 0);
if (te != NIL) if (te != NIL)
@ -3438,9 +3367,9 @@ X_API Int YAP_FunctorToInt(Functor f) {
Yap_PutAtomTranslation(At, arity, FunctorTranslations); Yap_PutAtomTranslation(At, arity, FunctorTranslations);
FunctorTranslations++; FunctorTranslations++;
if (FunctorTranslations == MaxFunctorTranslations) { if (FunctorTranslations == MaxFunctorTranslations) {
functor_t *nt = functor_t *nt = (functor_t *)malloc(sizeof(functor_t) * 2 *
(functor_t *)malloc(sizeof(functor_t) * 2 * MaxFunctorTranslations), MaxFunctorTranslations),
*ot = TR_Functors; *ot = TR_Functors;
if (nt == NULL) { if (nt == NULL) {
Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At), Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
"No more room for translations"); "No more room for translations");

19
C/cdmgr.c
View File

@ -20,9 +20,9 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "Yap.h" #include "Yap.h"
#include "clause.h" #include "clause.h"
#include "yapio.h"
#include "eval.h" #include "eval.h"
#include "tracer.h" #include "tracer.h"
#include "yapio.h"
#ifdef YAPOR #ifdef YAPOR
#include "or.macros.h" #include "or.macros.h"
#endif /* YAPOR */ #endif /* YAPOR */
@ -32,9 +32,9 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
#include <assert.h>
#include <heapgc.h> #include <heapgc.h>
#include <iopreds.h> #include <iopreds.h>
#include <assert.h>
static void retract_all(PredEntry *, int); static void retract_all(PredEntry *, int);
static void add_first_static(PredEntry *, yamop *, int); static void add_first_static(PredEntry *, yamop *, int);
@ -63,7 +63,6 @@ static Int p_optimizer_on(USES_REGS1);
static Int p_optimizer_off(USES_REGS1); static Int p_optimizer_off(USES_REGS1);
static Int p_is_dynamic(USES_REGS1); static Int p_is_dynamic(USES_REGS1);
static Int p_kill_dynamic(USES_REGS1); static Int p_kill_dynamic(USES_REGS1);
static Int p_compile_mode(USES_REGS1);
static Int p_is_profiled(USES_REGS1); static Int p_is_profiled(USES_REGS1);
static Int p_profile_info(USES_REGS1); static Int p_profile_info(USES_REGS1);
static Int p_profile_reset(USES_REGS1); static Int p_profile_reset(USES_REGS1);
@ -1936,7 +1935,6 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
Term t1 = Deref(ARG2); Term t1 = Deref(ARG2);
Term mod = Deref(ARG4); Term mod = Deref(ARG4);
yamop *code_adr; yamop *code_adr;
int mode;
if (IsVarTerm(t1) || !IsAtomicTerm(t1)) if (IsVarTerm(t1) || !IsAtomicTerm(t1))
return false; return false;
@ -2712,18 +2710,6 @@ static Int p_optimizer_off(USES_REGS1) { /* '$optimizer_off' */
return (TRUE); return (TRUE);
} }
static Int p_compile_mode(USES_REGS1) { /* $compile_mode(Old,New) */
Term t2, t3 = MkIntTerm(compile_mode);
if (!Yap_unify_constant(ARG1, t3))
return (FALSE);
t2 = Deref(ARG2);
if (IsVarTerm(t2) || !IsIntTerm(t2))
return (FALSE);
compile_mode = IntOfTerm(t2) & 1;
return (TRUE);
}
static Int p_is_profiled(USES_REGS1) { static Int p_is_profiled(USES_REGS1) {
Term t = Deref(ARG1); Term t = Deref(ARG1);
char *s; char *s;
@ -2908,7 +2894,6 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
} }
void Yap_HidePred(PredEntry *pe) { void Yap_HidePred(PredEntry *pe) {
Prop p0 = AbsPredProp(pe);
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag); pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
} }

614
C/cp_absmi_insts.h
View File

@ -27,7 +27,7 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
PREG = NEXTOP(PREG, Otapl); PREG = NEXTOP(PREG, Otapl);
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
@ -42,7 +42,7 @@
restore_yaam_regs(PREG->y_u.Otapl.d); restore_yaam_regs(PREG->y_u.Otapl.d);
restore_at_least_one_arg(PREG->y_u.Otapl.s); restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -58,25 +58,24 @@
CACHE_Y(B); CACHE_Y(B);
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.Otapl.s); restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
} }
else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
PREG = NEXTOP(PREG, Otapl); PREG = NEXTOP(PREG, Otapl);
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
@ -89,14 +88,14 @@
/* enter_exo Pred,Label */ /* enter_exo Pred,Label */
BOp(enter_exo, e); BOp(enter_exo, e);
{ {
yamop *pt; yamop *pt;
saveregs(); saveregs();
pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS); pt = Yap_ExoLookup(PredFromDefCode(PREG) PASS_REGS);
setregs(); setregs();
#ifdef SHADOW_S #ifdef SHADOW_S
SREG = S; SREG = S;
#endif #endif
PREG = pt; PREG = pt;
} }
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -111,14 +110,15 @@
* new register to point at YREG =*/ * new register to point at YREG =*/
CACHE_Y(YREG); CACHE_Y(YREG);
{ {
struct index_t *i = (struct index_t *)(PREG->y_u.lp.l); struct index_t *i = (struct index_t *)(PREG->y_u.lp.l);
S_YREG[-1] = (CELL)LINK_TO_ADDRESS(i,i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]); S_YREG[-1] =
(CELL)LINK_TO_ADDRESS(i, i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]);
} }
S_YREG--; S_YREG--;
/* store arguments for procedure */ /* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */ /* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0); store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint, /* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut. * that is, to the B before the cut.
*/ */
@ -127,8 +127,8 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp); PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
GONext(); GONext();
@ -147,7 +147,7 @@
/* store arguments for procedure */ /* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */ /* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0); store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint, /* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut. * that is, to the B before the cut.
*/ */
@ -156,8 +156,8 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp); PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
GONext(); GONext();
@ -171,14 +171,12 @@
* register, but sometimes (X86) not. In this case, have a * register, but sometimes (X86) not. In this case, have a
* new register to point at YREG =*/ * new register to point at YREG =*/
CACHE_Y(YREG); CACHE_Y(YREG);
{ { S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */ }
S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */
}
S_YREG--; S_YREG--;
/* store arguments for procedure */ /* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */ /* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0); store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint, /* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut. * that is, to the B before the cut.
*/ */
@ -187,8 +185,8 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp); PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
GONext(); GONext();
@ -204,16 +202,16 @@
* new register to point at YREG =*/ * new register to point at YREG =*/
CACHE_Y(YREG); CACHE_Y(YREG);
{ {
struct index_t *i = (struct index_t *)(PREG->y_u.lp.l); struct index_t *i = (struct index_t *)(PREG->y_u.lp.l);
SREG = i->cls; SREG = i->cls;
S_YREG[-2] = (CELL)(SREG+i->arity); S_YREG[-2] = (CELL)(SREG + i->arity);
S_YREG[-1] = (CELL)(SREG+i->arity*i->nels); S_YREG[-1] = (CELL)(SREG + i->arity * i->nels);
} }
S_YREG-=2; S_YREG -= 2;
/* store arguments for procedure */ /* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */ /* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0); store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint, /* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut. * that is, to the B before the cut.
*/ */
@ -222,8 +220,8 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp); PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
GONext(); GONext();
@ -234,45 +232,46 @@
BEGD(d0); BEGD(d0);
CACHE_Y(B); CACHE_Y(B);
{ {
struct index_t *it = (struct index_t *)(PREG->y_u.lp.l); struct index_t *it = (struct index_t *)(PREG->y_u.lp.l);
BITS32 offset = ADDRESS_TO_LINK(it,(BITS32 *)((CELL *)(B+1))[it->arity]); BITS32 offset =
d0 = it->links[offset]; ADDRESS_TO_LINK(it, (BITS32 *)((CELL *)(B + 1))[it->arity]);
((CELL *)(B+1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0); d0 = it->links[offset];
SREG = EXO_OFFSET_TO_ADDRESS(it, offset); ((CELL *)(B + 1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0);
SREG = EXO_OFFSET_TO_ADDRESS(it, offset);
} }
if (d0) { if (d0) {
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
restore_yaam_regs(PREG); restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
SET_BB(B_YREG); SET_BB(B_YREG);
} else { } else {
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else } else
#endif /* YAPOR */ #endif /* YAPOR */
{ {
pop_yaam_regs(); pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
} }
PREG = NEXTOP(PREG, lp); PREG = NEXTOP(PREG, lp);
ENDCACHE_Y(); ENDCACHE_Y();
@ -285,47 +284,47 @@
BEGD(d0); BEGD(d0);
CACHE_Y(B); CACHE_Y(B);
{ {
struct index_t *it = (struct index_t *)(PREG->y_u.lp.l); struct index_t *it = (struct index_t *)(PREG->y_u.lp.l);
saveregs(); saveregs();
d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS); d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS);
setregs(); setregs();
#ifdef SHADOW_S #ifdef SHADOW_S
SREG = S; SREG = S;
#endif #endif
} }
if (d0) { if (d0) {
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
restore_yaam_regs(PREG); restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
SET_BB(B_YREG); SET_BB(B_YREG);
} else { } else {
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else } else
#endif /* YAPOR */ #endif /* YAPOR */
{ {
pop_yaam_regs(); pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
} }
PREG = NEXTOP(PREG, lp); PREG = NEXTOP(PREG, lp);
ENDCACHE_Y(); ENDCACHE_Y();
@ -338,49 +337,50 @@
BEGD(d0); BEGD(d0);
CACHE_Y(B); CACHE_Y(B);
{ {
// struct udi_index_t *jp = (struct udi_index_t *)((CELL *)(B+1))[it->arity]; // struct udi_index_t *jp = (struct udi_index_t *)((CELL
/* operation has a side-effect: S = (CELL*)NextClause */ // *)(B+1))[it->arity];
saveregs(); /* operation has a side-effect: S = (CELL*)NextClause */
d0 = 0L; // Yap_UDI_NextAlt(jp); saveregs();
setregs(); d0 = 0L; // Yap_UDI_NextAlt(jp);
setregs();
#ifdef SHADOW_S #ifdef SHADOW_S
SREG = S; SREG = S;
#endif #endif
/* d0 says if we're last */ /* d0 says if we're last */
} }
if (d0) { if (d0) {
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
restore_yaam_regs(PREG); restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
SET_BB(B_YREG); SET_BB(B_YREG);
} else { } else {
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else } else
#endif /* YAPOR */ #endif /* YAPOR */
{ {
pop_yaam_regs(); pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE); pop_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
} }
PREG = (yamop *)SREG; PREG = (yamop *)SREG;
ENDCACHE_Y(); ENDCACHE_Y();
@ -393,45 +393,45 @@
BEGD(d0); BEGD(d0);
CACHE_Y(B); CACHE_Y(B);
{ {
UInt arity = ((struct index_t *)PREG->y_u.lp.l)->arity; UInt arity = ((struct index_t *)PREG->y_u.lp.l)->arity;
CELL *extras = (CELL *)(B+1); CELL *extras = (CELL *)(B + 1);
SREG = (CELL *)extras[arity]; SREG = (CELL *)extras[arity];
d0 = (SREG+arity != (CELL *)extras[arity+1]); d0 = (SREG + arity != (CELL *)extras[arity + 1]);
if (d0) { if (d0) {
extras[arity] = (CELL)(SREG+arity); extras[arity] = (CELL)(SREG + arity);
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
restore_yaam_regs(PREG); restore_yaam_regs(PREG);
restore_at_least_one_arg(arity); restore_at_least_one_arg(arity);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
SET_BB(B_YREG); SET_BB(B_YREG);
} else { } else {
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(arity); restore_at_least_one_arg(arity);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else } else
#endif /* YAPOR */ #endif /* YAPOR */
{ {
pop_yaam_regs(); pop_yaam_regs();
pop_at_least_one_arg(arity); pop_at_least_one_arg(arity);
/* After trust, cut should be pointing at the new top /* After trust, cut should be pointing at the new top
* choicepoint */ * choicepoint */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
} }
} }
PREG = NEXTOP(PREG, lp); PREG = NEXTOP(PREG, lp);
ENDCACHE_Y(); ENDCACHE_Y();
@ -472,7 +472,7 @@
restore_yaam_regs(PREG->y_u.Otapl.d); restore_yaam_regs(PREG->y_u.Otapl.d);
restore_args(PREG->y_u.Otapl.s); restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -488,25 +488,24 @@
CACHE_Y(B); CACHE_Y(B);
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_args(PREG->y_u.Otapl.s); restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_args(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
} }
else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_args(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
LOCK(PREG->y_u.Otapl.p->StatisticsForPred->lock); LOCK(PREG->y_u.Otapl.p->StatisticsForPred->lock);
@ -516,9 +515,9 @@
GONext(); GONext();
ENDOp(); ENDOp();
/***************************************************************** /*****************************************************************
* Call count instructions * * Call count instructions *
*****************************************************************/ *****************************************************************/
/* count_enter_me Label,NArgs */ /* count_enter_me Label,NArgs */
Op(count_call, p); Op(count_call, p);
@ -527,17 +526,17 @@
UNLOCK(PREG->y_u.p.p->StatisticsForPred->lock); UNLOCK(PREG->y_u.p.p->StatisticsForPred->lock);
LOCAL_ReductionsCounter--; LOCAL_ReductionsCounter--;
if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) { if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) {
saveregs(); saveregs();
Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
LOCAL_PredEntriesCounter--; LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
saveregs(); saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
PREG = NEXTOP(PREG, p); PREG = NEXTOP(PREG, p);
GONext(); GONext();
@ -550,20 +549,20 @@
UNLOCK(PREG->y_u.p.p->StatisticsForPred->lock); UNLOCK(PREG->y_u.p.p->StatisticsForPred->lock);
LOCAL_RetriesCounter--; LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) { if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) {
/* act as if we had backtracked */ /* act as if we had backtracked */
ENV = B->cp_env; ENV = B->cp_env;
saveregs(); saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
LOCAL_PredEntriesCounter--; LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
ENV = B->cp_env; ENV = B->cp_env;
saveregs(); saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
PREG = NEXTOP(PREG, p); PREG = NEXTOP(PREG, p);
GONext(); GONext();
@ -574,10 +573,10 @@
CACHE_Y(B); CACHE_Y(B);
restore_yaam_regs(PREG->y_u.Otapl.d); restore_yaam_regs(PREG->y_u.Otapl.d);
restore_args(PREG->y_u.Otapl.s); restore_args(PREG->y_u.Otapl.s);
/* After retry, cut should be pointing at the parent /* After retry, cut should be pointing at the parent
* choicepoint for the current B */ * choicepoint for the current B */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -589,17 +588,17 @@
UNLOCK(((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->lock); UNLOCK(((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->lock);
LOCAL_RetriesCounter--; LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) { if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) {
saveregs(); saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
LOCAL_PredEntriesCounter--; LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) { if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
saveregs(); saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
PREG = NEXTOP(PREG, Otapl); PREG = NEXTOP(PREG, Otapl);
GONext(); GONext();
@ -610,40 +609,39 @@
CACHE_Y(B); CACHE_Y(B);
#ifdef YAPOR #ifdef YAPOR
if (SCH_top_shared_cp(B)) { if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_args(PREG->y_u.Otapl.s); restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_args(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
} }
else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_args(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
LOCAL_RetriesCounter--; LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0) { if (LOCAL_RetriesCounter == 0) {
saveregs(); saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
LOCAL_PredEntriesCounter--; LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0) { if (LOCAL_PredEntriesCounter == 0) {
saveregs(); saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
LOCK(((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->lock); LOCK(((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->lock);
((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->NOfRetries++; ((PredEntry *)(PREG->y_u.Otapl.p))->StatisticsForPred->NOfRetries++;
@ -659,28 +657,28 @@
/* ensure_space */ /* ensure_space */
BOp(ensure_space, Osbpa); BOp(ensure_space, Osbpa);
{ {
Int sz = PREG->y_u.Osbpa.i; Int sz = PREG->y_u.Osbpa.i;
UInt arity = PREG->y_u.Osbpa.p->ArityOfPE; UInt arity = PREG->y_u.Osbpa.p->ArityOfPE;
if (Unsigned(HR) + sz > Unsigned(YREG)-StackGap( PASS_REGS1 )) { if (Unsigned(HR) + sz > Unsigned(YREG) - StackGap(PASS_REGS1)) {
YENV[E_CP] = (CELL) CPREG; YENV[E_CP] = (CELL)CPREG;
YENV[E_E] = (CELL) ENV; YENV[E_E] = (CELL)ENV;
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH; YENV[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
SET_ASP(YREG, PREG->y_u.Osbpa.s); SET_ASP(YREG, PREG->y_u.Osbpa.s);
PREG = NEXTOP(PREG,Osbpa); PREG = NEXTOP(PREG, Osbpa);
saveregs(); saveregs();
if (!Yap_gcl(sz, arity, YENV, PREG)) { if (!Yap_gcl(sz, arity, YENV, PREG)) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage); Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
setregs(); setregs();
FAIL(); FAIL();
} else { } else {
setregs(); setregs();
} }
} else { } else {
PREG = NEXTOP(PREG,Osbpa); PREG = NEXTOP(PREG, Osbpa);
} }
} }
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -693,9 +691,9 @@
BOp(spy_or_trymark, Otapl); BOp(spy_or_trymark, Otapl);
PELOCK(5, ((PredEntry *)(PREG->y_u.Otapl.p))); PELOCK(5, ((PredEntry *)(PREG->y_u.Otapl.p)));
PREG = (yamop *)(&(((PredEntry *)(PREG->y_u.Otapl.p))->OpcodeOfPred)); PREG = (yamop *)(&(((PredEntry *)(PREG->y_u.Otapl.p))->OpcodeOfPred));
UNLOCKPE(11,(PredEntry *)(PREG->y_u.Otapl.p)); UNLOCKPE(11, (PredEntry *)(PREG->y_u.Otapl.p));
saveregs(); saveregs();
spy_goal( PASS_REGS1 ); spy_goal(PASS_REGS1);
setregs(); setregs();
ENDBOp(); ENDBOp();
@ -708,30 +706,30 @@
CUT_wait_leftmost(); CUT_wait_leftmost();
#endif /* YAPOR */ #endif /* YAPOR */
if (PREG->y_u.Otapl.p->PredFlags & LogUpdatePredFlag) { if (PREG->y_u.Otapl.p->PredFlags & LogUpdatePredFlag) {
PELOCK(6,PREG->y_u.Otapl.p); PELOCK(6, PREG->y_u.Otapl.p);
PP = PREG->y_u.Otapl.p; PP = PREG->y_u.Otapl.p;
} }
if (PREG->y_u.Otapl.p->CodeOfPred != PREG) { if (PREG->y_u.Otapl.p->CodeOfPred != PREG) {
/* oops, someone changed the procedure under our feet, /* oops, someone changed the procedure under our feet,
fortunately this is no big deal because we haven't done fortunately this is no big deal because we haven't done
anything yet */ anything yet */
PP = NULL; PP = NULL;
PREG = PREG->y_u.Otapl.p->CodeOfPred; PREG = PREG->y_u.Otapl.p->CodeOfPred;
UNLOCKPE(12,PREG->y_u.Otapl.p); UNLOCKPE(12, PREG->y_u.Otapl.p);
/* for profiler */ /* for profiler */
save_pc(); save_pc();
JMPNext(); JMPNext();
} }
#endif #endif
CACHE_Y(YREG); CACHE_Y(YREG);
PREG = PREG->y_u.Otapl.d; PREG = PREG->y_u.Otapl.d;
/* /*
I've got a read lock on the DB, so I don't need to care... I've got a read lock on the DB, so I don't need to care...
niaaahh.... niahhhh... niaaahh.... niahhhh...
*/ */
LOCK(DynamicLock(PREG)); LOCK(DynamicLock(PREG));
/* one can now mess around with the predicate */ /* one can now mess around with the predicate */
UNLOCKPE(13,((PredEntry *)(PREG->y_u.Otapl.p))); UNLOCKPE(13, ((PredEntry *)(PREG->y_u.Otapl.p)));
BEGD(d1); BEGD(d1);
d1 = PREG->y_u.Otapl.s; d1 = PREG->y_u.Otapl.s;
store_args(d1); store_args(d1);
@ -741,7 +739,7 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
#if MULTIPLE_STACKS #if MULTIPLE_STACKS
@ -751,11 +749,11 @@
#else #else
if (FlagOff(InUseMask, DynamicFlags(PREG))) { if (FlagOff(InUseMask, DynamicFlags(PREG))) {
SetFlag(InUseMask, DynamicFlags(PREG)); SetFlag(InUseMask, DynamicFlags(PREG));
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
} }
#endif #endif
PREG = NEXTOP(PREG,Otapl); PREG = NEXTOP(PREG, Otapl);
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -763,17 +761,17 @@
BOp(count_retry_and_mark, Otapl); BOp(count_retry_and_mark, Otapl);
LOCAL_RetriesCounter--; LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0) { if (LOCAL_RetriesCounter == 0) {
saveregs(); saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
LOCAL_PredEntriesCounter--; LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0) { if (LOCAL_PredEntriesCounter == 0) {
saveregs(); saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,""); Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs(); setregs();
JMPNext(); JMPNext();
} }
/* enter a retry dynamic */ /* enter a retry dynamic */
ENDBOp(); ENDBOp();
@ -791,7 +789,7 @@
CUT_wait_leftmost(); CUT_wait_leftmost();
#endif /* YAPOR */ #endif /* YAPOR */
/* need to make the DB stable until I get the new clause */ /* need to make the DB stable until I get the new clause */
PELOCK(7,PREG->y_u.Otapl.p); PELOCK(7, PREG->y_u.Otapl.p);
CACHE_Y(B); CACHE_Y(B);
PREG = PREG->y_u.Otapl.d; PREG = PREG->y_u.Otapl.d;
LOCK(DynamicLock(PREG)); LOCK(DynamicLock(PREG));
@ -799,7 +797,7 @@
restore_yaam_regs(PREG); restore_yaam_regs(PREG);
restore_args(PREG->y_u.Otapl.s); restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -813,15 +811,14 @@
#else #else
if (FlagOff(InUseMask, DynamicFlags(PREG))) { if (FlagOff(InUseMask, DynamicFlags(PREG))) {
SetFlag(InUseMask, DynamicFlags(PREG)); SetFlag(InUseMask, DynamicFlags(PREG));
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
} }
#endif #endif
PREG = NEXTOP(PREG, Otapl); PREG = NEXTOP(PREG, Otapl);
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
/************************************************************************\ /************************************************************************\
* Try / Retry / Trust for main indexing blocks * * Try / Retry / Trust for main indexing blocks *
@ -838,7 +835,7 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
JMPNext(); JMPNext();
@ -861,7 +858,7 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
JMPNext(); JMPNext();
@ -882,7 +879,7 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
JMPNext(); JMPNext();
@ -904,7 +901,7 @@
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
JMPNext(); JMPNext();
@ -915,7 +912,7 @@
restore_yaam_regs(NEXTOP(PREG, Otapl)); restore_yaam_regs(NEXTOP(PREG, Otapl));
restore_at_least_one_arg(PREG->y_u.Otapl.s); restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -933,7 +930,7 @@
ARG1 = B_YREG->cp_a1; ARG1 = B_YREG->cp_a1;
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -951,7 +948,7 @@
ARG2 = B_YREG->cp_a2; ARG2 = B_YREG->cp_a2;
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -970,7 +967,7 @@
ARG3 = B_YREG->cp_a3; ARG3 = B_YREG->cp_a3;
ARG4 = B_YREG->cp_a4; ARG4 = B_YREG->cp_a4;
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
#else #else
set_cut(S_YREG, B_YREG->cp_b); set_cut(S_YREG, B_YREG->cp_b);
@ -987,20 +984,19 @@
SCH_last_alternative(PREG, B_YREG); SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.Otapl.s); restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b); set_cut(S_YREG, B->cp_b);
} } else
else #endif /* YAPOR */
#endif /* YAPOR */ {
{ pop_yaam_regs();
pop_yaam_regs(); pop_at_least_one_arg(PREG->y_u.Otapl.s);
pop_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
set_cut(S_YREG, B); set_cut(S_YREG, B);
} }
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
PREG = PREG->y_u.Otapl.d; PREG = PREG->y_u.Otapl.d;

35
C/errors.c
View File

@ -262,7 +262,19 @@ static void error_exit_yap(int value) {
#endif #endif
} }
fprintf(stderr, "\n Exiting ....\n"); fprintf(stderr, "\n Exiting ....\n");
Yap_exit(value); #if HAVE_BACKTRACE
void *callstack[256];
int i;
int frames = backtrace(callstack, 256);
char** strs = backtrace_symbols(callstack, frames);
fprintf(stderr, "Execution stack:\n");
for (i = 0; i < frames; ++i) {
fprintf(stderr, " %s\n", strs[i]);
}
free(strs);
#endif
Yap_exit(value);
} }
/* This needs to be a static because I can't trust the stack (WIN32), and /* This needs to be a static because I can't trust the stack (WIN32), and
@ -370,7 +382,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
CELL nt[3]; CELL nt[3];
Functor fun; Functor fun;
bool serious; bool serious;
Term tf, error_t, comment, culprit = TermNil; Term tf, error_t, comment;
char *format; char *format;
char s[MAXPATHLEN]; char s[MAXPATHLEN];
@ -470,8 +482,8 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
IsApplTerm(where) && IsApplTerm(where) &&
FunctorOfTerm(where) == FunctorError) { FunctorOfTerm(where) == FunctorError) {
error_t = where; error_t = where;
Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
Yap_JumpToEnv(error_t);
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
return P; return P;
} }
@ -596,25 +608,14 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
LOCAL_Signals = 0; LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1); CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
/* we might be in the middle of a critical region */
if (LOCAL_InterruptsDisabled) {
LOCAL_InterruptsDisabled = 0;
LOCAL_UncaughtThrow = TRUE;
Yap_RestartYap(1);
}
#if DEBUG #if DEBUG
// DumpActiveGoals( PASS_REGS1 ); // DumpActiveGoals( PASS_REGS1 );
#endif #endif
/* wait if we we are in user code, /* wait if we we are in user code,
it's up to her to decide */ it's up to her to decide */
fun = FunctorError; fun = FunctorError;
if (LOCAL_PrologMode & UserCCallMode) { error_t = Yap_MkApplTerm(fun, 2, nt);
error_t = Yap_MkApplTerm(fun, 2, nt);
if (!(EX = Yap_StoreTermInDB(error_t, 2))) {
/* fat chance */
Yap_RestartYap(1);
}
} else {
if (type == ABORT_EVENT) { if (type == ABORT_EVENT) {
error_t = MkAtomTerm(AtomDAbort); error_t = MkAtomTerm(AtomDAbort);
} else { } else {
@ -622,7 +623,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
} }
Yap_JumpToEnv(error_t); Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
}
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
return P; return P;

849
C/exec.c
View File

File diff suppressed because it is too large Load Diff

222
C/fli_absmi_insts.h
View File

@ -2,7 +2,6 @@
* Call C predicates instructions * * Call C predicates instructions *
\************************************************************************/ \************************************************************************/
#ifdef INDENT_CODE #ifdef INDENT_CODE
{ {
{ {
@ -11,43 +10,48 @@
BOp(call_cpred, Osbpp); BOp(call_cpred, Osbpp);
#if __ANDROID__ && STRONG_DEBUG #if __ANDROID__ && STRONG_DEBUG
char *s; Atom name; char *s;
Atom name;
if (PREG->y_u.Osbpp.p->ArityOfPE) { if (PREG->y_u.Osbpp.p->ArityOfPE) {
Functor f = PREG->y_u.Osbpp.p->FunctorOfPred; Functor f = PREG->y_u.Osbpp.p->FunctorOfPred;
name = f->NameOfFE; name = f->NameOfFE;
} else { } else {
name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred); name = (Atom)(PREG->y_u.Osbpp.p->FunctorOfPred);
} }
s = name->StrOfAE; s = name->StrOfAE;
LOG( " %s ", s); LOG(" %s ", s);
#endif #endif
check_trail(TR); check_trail(TR);
if (!(PREG->y_u.Osbpp.p->PredFlags & (SafePredFlag|NoTracePredFlag|HiddenPredFlag))) { if (!(PREG->y_u.Osbpp.p->PredFlags &
(SafePredFlag | NoTracePredFlag | HiddenPredFlag))) {
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
check_stack(NoStackCCall, HR); check_stack(NoStackCCall, HR);
ENDCACHE_Y_AS_ENV(); ENDCACHE_Y_AS_ENV();
} }
do_c_call: do_c_call :
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b; if (YREG > (CELL *)top_b || YREG < HR)
ASP = (CELL *)top_b;
#else #else
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b; if (YREG > (CELL *)top_b)
ASP = (CELL *)top_b;
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s); else
} ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s);
}
#else #else
SET_ASP(YREG, PREG->y_u.Osbpp.s); SET_ASP(YREG, PREG->y_u.Osbpp.s);
/* for slots to work */ /* for slots to work */
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) if (Yap_do_low_level_trace)
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1); low_level_trace(enter_pred, PREG->y_u.Osbpp.p, XREGS + 1);
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
BEGD(d0); BEGD(d0);
CPredicate f = PREG->y_u.Osbpp.p->cs.f_code; CPredicate f = PREG->y_u.Osbpp.p->cs.f_code;
PREG = NEXTOP(PREG, Osbpp); PREG = NEXTOP(PREG, Osbpp);
@ -79,29 +83,32 @@
CACHE_Y_AS_ENV(YREG); CACHE_Y_AS_ENV(YREG);
#ifndef NO_CHECKING #ifndef NO_CHECKING
check_stack(NoStackExecuteC, HR); check_stack(NoStackExecuteC, HR);
do_executec: do_executec :
#endif #endif
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *)top_b; if (YREG > (CELL *)top_b || YREG < HR)
ASP = (CELL *)top_b;
#else #else
if (YREG > (CELL *) top_b) ASP = (CELL *)top_b; if (YREG > (CELL *)top_b)
ASP = (CELL *)top_b;
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
else ASP = YREG+E_CB; else
} ASP = YREG + E_CB;
}
#else #else
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
/* for slots to work */ /* for slots to work */
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
pt0 = PREG->y_u.pp.p; pt0 = PREG->y_u.pp.p;
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) { if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,pt0,XREGS+1); low_level_trace(enter_pred, pt0, XREGS + 1);
} }
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
CACHE_A1(); CACHE_A1();
BEGD(d0); BEGD(d0);
d0 = (CELL)B; d0 = (CELL)B;
@ -110,18 +117,18 @@
ENV_YREG[E_CB] = d0; ENV_YREG[E_CB] = d0;
ENDD(d0); ENDD(d0);
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is prolog */ if (DEPTH <= MkIntTerm(1)) { /* I assume Module==0 is prolog */
if (pt0->ModuleOfPred) { if (pt0->ModuleOfPred) {
if (DEPTH == MkIntTerm(0)) { if (DEPTH == MkIntTerm(0)) {
FAIL(); FAIL();
} else{ } else {
DEPTH = RESET_DEPTH(); DEPTH = RESET_DEPTH();
} }
} }
} else if (pt0->ModuleOfPred) { } else if (pt0->ModuleOfPred) {
DEPTH -= MkIntConstant(2); DEPTH -= MkIntConstant(2);
} }
#endif /* DEPTH_LIMIT */ #endif /* DEPTH_LIMIT */
/* now call C-Code */ /* now call C-Code */
{ {
CPredicate f = PREG->y_u.pp.p->cs.f_code; CPredicate f = PREG->y_u.pp.p->cs.f_code;
@ -169,25 +176,29 @@
do_user_call: do_user_call:
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) { if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,PREG->y_u.Osbpp.p,XREGS+1); low_level_trace(enter_pred, PREG->y_u.Osbpp.p, XREGS + 1);
} }
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b; if (YREG > (CELL *)top_b || YREG < HR)
ASP = (CELL *)top_b;
#else #else
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b; if (YREG > (CELL *)top_b)
ASP = (CELL *)top_b;
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
else ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s); else
ASP = (CELL *)(((char *)YREG) + PREG->y_u.Osbpp.s);
} }
#else #else
SET_ASP(YREG, PREG->y_u.Osbpp.s); SET_ASP(YREG, PREG->y_u.Osbpp.s);
/* for slots to work */ /* for slots to work */
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
{ {
/* make sure that we can still have access to our old PREG after calling user defined goals and backtracking or failing */ /* make sure that we can still have access to our old PREG after calling
* user defined goals and backtracking or failing */
yamop *savedP; yamop *savedP;
LOCAL_PrologMode |= UserCCallMode; LOCAL_PrologMode |= UserCCallMode;
@ -199,17 +210,15 @@
saveregs(); saveregs();
save_machine_regs(); save_machine_regs();
SREG = (CELL *) YAP_Execute(p, p->cs.f_code); SREG = (CELL *)YAP_Execute(p, p->cs.f_code);
} }
setregs(); setregs();
LOCAL_PrologMode &= ~UserCCallMode; LOCAL_PrologMode &= ~UserCCallMode;
restore_machine_regs(); restore_machine_regs();
PREG = savedP; PREG = savedP;
} }
if (EX) { if (Yap_HasException()) {
struct DB_TERM *exp = EX; Yap_RaiseException();
EX = NULL;
Yap_JumpToEnv(Yap_PopTermFromDB(exp));
SREG = NULL; SREG = NULL;
} }
if (!SREG) { if (!SREG) {
@ -228,16 +237,18 @@
BOp(call_c_wfail, slpp); BOp(call_c_wfail, slpp);
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) { if (Yap_do_low_level_trace) {
low_level_trace(enter_pred,PREG->y_u.slpp.p,XREGS+1); low_level_trace(enter_pred, PREG->y_u.slpp.p, XREGS + 1);
} }
#endif /* LOW_LEVEL_TRACE */ #endif /* LOW_LEVEL_TRACE */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B); choiceptr top_b = PROTECT_FROZEN_B(B);
#ifdef YAPOR_SBA #ifdef YAPOR_SBA
if (YREG > (CELL *) top_b || YREG < HR) ASP = (CELL *) top_b; if (YREG > (CELL *)top_b || YREG < HR)
ASP = (CELL *)top_b;
#else #else
if (YREG > (CELL *) top_b) ASP = (CELL *) top_b; if (YREG > (CELL *)top_b)
ASP = (CELL *)top_b;
#endif /* YAPOR_SBA */ #endif /* YAPOR_SBA */
else { else {
BEGD(d0); BEGD(d0);
@ -247,12 +258,12 @@
} }
} }
#else #else
if (YREG > (CELL *) B) if (YREG > (CELL *)B)
ASP = (CELL *) B; ASP = (CELL *)B;
else { else {
BEGD(d0); BEGD(d0);
d0 = PREG->y_u.slpp.s; d0 = PREG->y_u.slpp.s;
ASP = ((CELL *) YREG) + d0; ASP = ((CELL *)YREG) + d0;
ENDD(d0); ENDD(d0);
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
@ -279,14 +290,14 @@
#endif /* YAPOR */ #endif /* YAPOR */
CACHE_Y(YREG); CACHE_Y(YREG);
/* Alocate space for the cut_c structure*/ /* Alocate space for the cut_c structure*/
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG); CUT_C_PUSH(NEXTOP(NEXTOP(PREG, OtapFs), OtapFs), S_YREG);
S_YREG = S_YREG - PREG->y_u.OtapFs.extra; S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
store_args(PREG->y_u.OtapFs.s); store_args(PREG->y_u.OtapFs.s);
store_yaam_regs(NEXTOP(PREG, OtapFs), 0); store_yaam_regs(NEXTOP(P, OtapFs), 0);
B = B_YREG; B = B_YREG;
#ifdef YAPOR #ifdef YAPOR
SCH_set_load(B_YREG); SCH_set_load(B_YREG);
#endif /* YAPOR */ #endif /* YAPOR */
SET_BB(B_YREG); SET_BB(B_YREG);
ENDCACHE_Y(); ENDCACHE_Y();
@ -295,9 +306,9 @@
{ {
CPredicate f = (CPredicate)(PREG->y_u.OtapFs.f); CPredicate f = (CPredicate)(PREG->y_u.OtapFs.f);
saveregs(); saveregs();
SREG = (CELL *) ((f) (PASS_REGS1)); SREG = (CELL *)((f)(PASS_REGS1));
/* This last instruction changes B B*/ /* This last instruction changes B B*/
while (POP_CHOICE_POINT(B)){ while (POP_CHOICE_POINT(B)) {
cut_c_pop(); cut_c_pop();
} }
setregs(); setregs();
@ -306,11 +317,11 @@
/* Removes the cut functions from the stack /* Removes the cut functions from the stack
without executing them because we have fail without executing them because we have fail
and not cuted the predicate*/ and not cuted the predicate*/
while(POP_CHOICE_POINT(B)) while (POP_CHOICE_POINT(B))
cut_c_pop(); cut_c_pop();
FAIL(); FAIL();
} }
if ((CELL *) B == YREG && ASP != (CELL *) B) { if ((CELL *)B == YREG && ASP != (CELL *)B) {
/* as Luis says, the predicate that did the try C might /* as Luis says, the predicate that did the try C might
* have left some data on the stack. We should preserve * have left some data on the stack. We should preserve
* it, unless the builtin also did cut */ * it, unless the builtin also did cut */
@ -332,7 +343,7 @@
ENV = B_YREG->cp_env; ENV = B_YREG->cp_env;
HR = PROTECT_FROZEN_H(B); HR = PROTECT_FROZEN_H(B);
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH =B->cp_depth; DEPTH = B->cp_depth;
#endif #endif
HBREG = HR; HBREG = HR;
restore_args(PREG->y_u.OtapFs.s); restore_args(PREG->y_u.OtapFs.s);
@ -341,11 +352,12 @@
ENDBOp(); ENDBOp();
BOp(cut_c, OtapFs); BOp(cut_c, OtapFs);
/*This is a phantom instruction. This is not executed by the WAM*/ /*This is a phantom instruction. This is not executed by the WAM*/
#ifdef DEBUG #ifdef DEBUG
/*If WAM executes this instruction, probably there's an error /*If WAM executes this instruction, probably there's an error
when we put this instruction, cut_c, after retry_c*/ when we put this instruction, cut_c, after retry_c*/
printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__); printf("ERROR: Should not print this message FILE: absmi.c %d\n",
__LINE__);
#endif /*DEBUG*/ #endif /*DEBUG*/
ENDBOp(); ENDBOp();
@ -355,7 +367,7 @@
#endif /* YAPOR */ #endif /* YAPOR */
CACHE_Y(YREG); CACHE_Y(YREG);
/* Alocate space for the cut_c structure*/ /* Alocate space for the cut_c structure*/
CUT_C_PUSH(NEXTOP(NEXTOP(PREG,OtapFs),OtapFs),S_YREG); CUT_C_PUSH(NEXTOP(NEXTOP(PREG, OtapFs), OtapFs), S_YREG);
S_YREG = S_YREG - PREG->y_u.OtapFs.extra; S_YREG = S_YREG - PREG->y_u.OtapFs.extra;
store_args(PREG->y_u.OtapFs.s); store_args(PREG->y_u.OtapFs.s);
store_yaam_regs(NEXTOP(PREG, OtapFs), 0); store_yaam_regs(NEXTOP(PREG, OtapFs), 0);
@ -369,15 +381,16 @@
ASP = YREG; ASP = YREG;
saveregs(); saveregs();
save_machine_regs(); save_machine_regs();
SREG = (CELL *) YAP_ExecuteFirst(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f)); SREG = (CELL *)YAP_ExecuteFirst(PREG->y_u.OtapFs.p,
EX = NULL; (CPredicate)(PREG->y_u.OtapFs.f));
Yap_ResetException( worker_id );
restore_machine_regs(); restore_machine_regs();
setregs(); setregs();
LOCAL_PrologMode &= UserMode; LOCAL_PrologMode &= UserMode;
if (!SREG) { if (!SREG) {
FAIL(); FAIL();
} }
if ((CELL *) B == YREG && ASP != (CELL *) B) { if ((CELL *)B == YREG && ASP != (CELL *)B) {
/* as Luis says, the predicate that did the try C might /* as Luis says, the predicate that did the try C might
* have left some data on the stack. We should preserve * have left some data on the stack. We should preserve
* it, unless the builtin also did cut */ * it, unless the builtin also did cut */
@ -399,18 +412,19 @@
ENV = B_YREG->cp_env; ENV = B_YREG->cp_env;
HR = PROTECT_FROZEN_H(B); HR = PROTECT_FROZEN_H(B);
#ifdef DEPTH_LIMIT #ifdef DEPTH_LIMIT
DEPTH =B->cp_depth; DEPTH = B->cp_depth;
#endif #endif
HBREG = HR; HBREG = HR;
restore_args(PREG->y_u.OtapFs.s); restore_args(PREG->y_u.OtapFs.s);
ENDCACHE_Y(); ENDCACHE_Y();
LOCAL_PrologMode |= UserCCallMode; LOCAL_PrologMode |= UserCCallMode;
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
saveregs(); saveregs();
save_machine_regs(); save_machine_regs();
SREG = (CELL *) YAP_ExecuteNext(PREG->y_u.OtapFs.p, (CPredicate)(PREG->y_u.OtapFs.f)); SREG = (CELL *)YAP_ExecuteNext(PREG->y_u.OtapFs.p,
EX = NULL; (CPredicate)(PREG->y_u.OtapFs.f));
Yap_ResetException( worker_id);
restore_machine_regs(); restore_machine_regs();
setregs(); setregs();
LOCAL_PrologMode &= ~UserCCallMode; LOCAL_PrologMode &= ~UserCCallMode;
@ -418,11 +432,11 @@
/* Removes the cut functions from the stack /* Removes the cut functions from the stack
without executing them because we have fail without executing them because we have fail
and not cuted the predicate*/ and not cuted the predicate*/
while(POP_CHOICE_POINT(B)) while (POP_CHOICE_POINT(B))
cut_c_pop(); cut_c_pop();
FAIL(); FAIL();
} }
if ((CELL *) B == YREG && ASP != (CELL *) B) { if ((CELL *)B == YREG && ASP != (CELL *)B) {
/* as Luis says, the predicate that did the try C might /* as Luis says, the predicate that did the try C might
* have left some data on the stack. We should preserve * have left some data on the stack. We should preserve
* it, unless the builtin also did cut */ * it, unless the builtin also did cut */
@ -436,17 +450,17 @@
ENDBOp(); ENDBOp();
BOp(cut_userc, OtapFs); BOp(cut_userc, OtapFs);
/*This is a phantom instruction. This is not executed by the WAM*/ /*This is a phantom instruction. This is not executed by the WAM*/
#ifdef DEBUG #ifdef DEBUG
/*If WAM executes this instruction, probably there's an error /*If WAM executes this instruction, probably there's an error
when we put this instruction, cut_userc, after retry_userc*/ when we put this instruction, cut_userc, after retry_userc*/
printf ("ERROR: Should not print this message FILE: absmi.c %d\n",__LINE__); printf("ERROR: Should not print this message FILE: absmi.c %d\n",
__LINE__);
#endif /*DEBUG*/ #endif /*DEBUG*/
CACHE_A1(); CACHE_A1();
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
/************************************************************************\ /************************************************************************\
* support instructions * * support instructions *
\************************************************************************/ \************************************************************************/
@ -454,10 +468,10 @@
BOp(lock_pred, e); BOp(lock_pred, e);
{ {
PredEntry *ap = PredFromDefCode(PREG); PredEntry *ap = PredFromDefCode(PREG);
PELOCK(10,ap); PELOCK(10, ap);
PP = ap; PP = ap;
if (!ap->cs.p_code.NOfClauses) { if (!ap->cs.p_code.NOfClauses) {
UNLOCKPE(11,ap); UNLOCKPE(11, ap);
FAIL(); FAIL();
} }
/* /*
@ -467,10 +481,11 @@
if (ap->cs.p_code.NOfClauses > 1 && if (ap->cs.p_code.NOfClauses > 1 &&
!(ap->PredFlags & IndexedPredFlag)) { !(ap->PredFlags & IndexedPredFlag)) {
/* update ASP before calling IPred */ /* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
saveregs(); saveregs();
Yap_IPred(ap, 0, CP); Yap_IPred(ap, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */ /* IPred can generate errors, it thus must get rid of the lock itself
*/
setregs(); setregs();
CACHE_A1(); CACHE_A1();
/* for profiler */ /* for profiler */
@ -490,12 +505,12 @@
we must take extra care here we must take extra care here
*/ */
if (!PP) { if (!PP) {
PELOCK(11,ap); PELOCK(11, ap);
} }
if (ap->OpcodeOfPred != INDEX_OPCODE) { if (ap->OpcodeOfPred != INDEX_OPCODE) {
/* someone was here before we were */ /* someone was here before we were */
if (!PP) { if (!PP) {
UNLOCKPE(11,ap); UNLOCKPE(11, ap);
} }
PREG = ap->CodeOfPred; PREG = ap->CodeOfPred;
/* for profiler */ /* for profiler */
@ -504,7 +519,7 @@
} }
#endif #endif
/* update ASP before calling IPred */ /* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
saveregs(); saveregs();
Yap_IPred(ap, 0, CP); Yap_IPred(ap, 0, CP);
/* IPred can generate errors, it thus must get rid of the lock itself */ /* IPred can generate errors, it thus must get rid of the lock itself */
@ -516,8 +531,7 @@
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (!PP) if (!PP)
#endif #endif
UNLOCKPE(14,ap); UNLOCKPE(14, ap);
} }
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -541,15 +555,15 @@
yamop *pt0; yamop *pt0;
/* update ASP before calling IPred */ /* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (!PP) { if (!PP) {
PELOCK(12,pe); PELOCK(12, pe);
} }
if (!same_lu_block(PREG_ADDR, PREG)) { if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR; PREG = *PREG_ADDR;
if (!PP) { if (!PP) {
UNLOCKPE(15,pe); UNLOCKPE(15, pe);
} }
JMPNext(); JMPNext();
} }
@ -567,7 +581,7 @@
PREG = pt0; PREG = pt0;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (!PP) { if (!PP) {
UNLOCKPE(12,pe); UNLOCKPE(12, pe);
} }
#endif #endif
JMPNext(); JMPNext();
@ -580,37 +594,37 @@
yamop *pt0; yamop *pt0;
/* update ASP before calling IPred */ /* update ASP before calling IPred */
SET_ASP(YREG, E_CB*sizeof(CELL)); SET_ASP(YREG, E_CB * sizeof(CELL));
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (PP == NULL) { if (PP == NULL) {
PELOCK(13,pe); PELOCK(13, pe);
} }
if (!same_lu_block(PREG_ADDR, PREG)) { if (!same_lu_block(PREG_ADDR, PREG)) {
PREG = *PREG_ADDR; PREG = *PREG_ADDR;
if (!PP) { if (!PP) {
UNLOCKPE(16,pe); UNLOCKPE(16, pe);
} }
JMPNext(); JMPNext();
} }
#endif #endif
saveregs(); saveregs();
pt0 = Yap_ExpandIndex(pe, 0); pt0 = Yap_ExpandIndex(pe, 0);
/* restart index */ /* restart index */
setregs(); setregs();
PREG = pt0; PREG = pt0;
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
if (!PP) { if (!PP) {
UNLOCKPE(18,pe); UNLOCKPE(18, pe);
} }
#endif #endif
JMPNext(); JMPNext();
} }
ENDBOp(); ENDBOp();
BOp(undef_p, e); BOp(undef_p, e);
/* save S for module name */ /* save S for module name */
saveregs(); saveregs();
undef_goal( PASS_REGS1 ); undef_goal(PASS_REGS1);
setregs(); setregs();
/* for profiler */ /* for profiler */
CACHE_A1(); CACHE_A1();
@ -619,10 +633,8 @@
BOp(spy_pred, e); BOp(spy_pred, e);
saveregs(); saveregs();
spy_goal( PASS_REGS1 ); spy_goal(PASS_REGS1);
setregs(); setregs();
CACHE_A1(); CACHE_A1();
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();

54
C/init.c
View File

@ -25,11 +25,12 @@ static char SccsId[] = "%W% %G%";
#define __INIT_C__ 1 #define __INIT_C__ 1
#include <stdlib.h>
#include "Yap.h" #include "Yap.h"
#include "alloc.h"
#include "clause.h" #include "clause.h"
#include "yapio.h" #include "yapio.h"
#include "alloc.h" #include <stdlib.h>
#include "Foreign.h" #include "Foreign.h"
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
@ -462,7 +463,7 @@ static UInt update_flags_from_prolog(UInt flags, PredEntry *pe) {
return flags; return flags;
} }
void Yap_InitCPred(const char *Name, UInt Arity, CPredicate code, void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code,
pred_flags_t flags) { pred_flags_t flags) {
CACHE_REGS CACHE_REGS
Atom atom = NIL; Atom atom = NIL;
@ -606,7 +607,7 @@ bool Yap_AddCutToFli(PredEntry *pe, CPredicate CUT) {
} }
} }
void Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code, void Yap_InitCmpPred(const char *Name, arity_t Arity, CmpPredicate cmp_code,
pred_flags_t flags) { pred_flags_t flags) {
CACHE_REGS CACHE_REGS
Atom atom = NIL; Atom atom = NIL;
@ -685,7 +686,7 @@ void Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code,
p_code->y_u.l.l = cl->ClCode; p_code->y_u.l.l = cl->ClCode;
} }
void Yap_InitAsmPred(const char *Name, UInt Arity, int code, CPredicate def, void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def,
pred_flags_t flags) { pred_flags_t flags) {
CACHE_REGS CACHE_REGS
Atom atom = NIL; Atom atom = NIL;
@ -825,18 +826,18 @@ static void CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont,
code->y_u.OtapFs.f = Cut; code->y_u.OtapFs.f = Cut;
} }
void Yap_InitCPredBack(const char *Name, UInt Arity, unsigned int Extra, void Yap_InitCPredBack(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Start, CPredicate Cont, pred_flags_t flags) { CPredicate Call, CPredicate Retry, pred_flags_t flags) {
Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, NULL, flags); Yap_InitCPredBack_(Name, Arity, Extra, Call, Retry, NULL, flags);
} }
void Yap_InitCPredBackCut(const char *Name, UInt Arity, unsigned int Extra, void Yap_InitCPredBackCut(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Start, CPredicate Cont, CPredicate Cut, CPredicate Start, CPredicate Cont, CPredicate Cut,
pred_flags_t flags) { pred_flags_t flags) {
Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, Cut, flags); Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, Cut, flags);
} }
void Yap_InitCPredBack_(const char *Name, UInt Arity, unsigned int Extra, void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Start, CPredicate Cont, CPredicate Cut, CPredicate Start, CPredicate Cont, CPredicate Cut,
pred_flags_t flags) { pred_flags_t flags) {
CACHE_REGS CACHE_REGS
@ -1002,29 +1003,28 @@ static void InitOtaplInst(yamop start[1], OPCODE opc, PredEntry *pe) {
} }
static void InitDBErasedMarker(void) { static void InitDBErasedMarker(void) {
DBErasedMarker = (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct)); DBErasedMarker = (DBRef)Yap_AllocCodeSpace(sizeof(DBStruct));
Yap_LUClauseSpace += sizeof(DBStruct); Yap_LUClauseSpace += sizeof(DBStruct);
DBErasedMarker->id = FunctorDBRef; DBErasedMarker->id = FunctorDBRef;
DBErasedMarker->Flags = ErasedMask; DBErasedMarker->Flags = ErasedMask;
DBErasedMarker->Code = NULL; DBErasedMarker->Code = NULL;
DBErasedMarker->DBT.DBRefs = NULL; DBErasedMarker->DBT.DBRefs = NULL;
DBErasedMarker->Parent = NULL; DBErasedMarker->Parent = NULL;
} }
static void InitLogDBErasedMarker(void) { static void InitLogDBErasedMarker(void) {
LogDBErasedMarker = (LogUpdClause *)Yap_AllocCodeSpace( LogDBErasedMarker = (LogUpdClause *)Yap_AllocCodeSpace(
sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e)); sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e));
Yap_LUClauseSpace += sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e); Yap_LUClauseSpace += sizeof(LogUpdClause) + (UInt)NEXTOP((yamop *)NULL, e);
LogDBErasedMarker->Id = FunctorDBRef; LogDBErasedMarker->Id = FunctorDBRef;
LogDBErasedMarker->ClFlags = ErasedMask | LogUpdMask; LogDBErasedMarker->ClFlags = ErasedMask | LogUpdMask;
LogDBErasedMarker->lusl.ClSource = NULL; LogDBErasedMarker->lusl.ClSource = NULL;
LogDBErasedMarker->ClRefCount = 0; LogDBErasedMarker->ClRefCount = 0;
LogDBErasedMarker->ClExt = NULL; LogDBErasedMarker->ClExt = NULL;
LogDBErasedMarker->ClPrev = NULL; LogDBErasedMarker->ClPrev = NULL;
LogDBErasedMarker->ClNext = NULL; LogDBErasedMarker->ClNext = NULL;
LogDBErasedMarker->ClSize = LogDBErasedMarker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e);
(UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e); LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail);
LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail);
INIT_CLREF_COUNT(LogDBErasedMarker); INIT_CLREF_COUNT(LogDBErasedMarker);
} }

109
C/modules.c
View File

@ -19,8 +19,8 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#include "Yap.h" #include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "Yatom.h"
static Int current_module(USES_REGS1); static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1); static Int current_module1(USES_REGS1);
@ -36,28 +36,27 @@ static ModEntry *FetchModuleEntry(Atom at);
* @param ae module name. * @param ae module name.
* *
* @return a new module structure * @return a new module structure
*//** */ */ /** */
static ModEntry * static ModEntry *initMod(AtomEntry *toname, AtomEntry *ae) {
initMod( AtomEntry *toname, AtomEntry *ae) { CACHE_REGS
CACHE_REGS ModEntry *n, *parent;
ModEntry *n, *parent;
if (toname == NULL) if (toname == NULL)
parent = NULL; parent = NULL;
else { else {
parent = FetchModuleEntry( toname ); parent = FetchModuleEntry(toname);
} }
n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n)); n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n));
INIT_RWLOCK(n->ModRWLock); INIT_RWLOCK(n->ModRWLock);
n->KindOfPE = ModProperty; n->KindOfPE = ModProperty;
n->PredForME = NULL; n->PredForME = NULL;
n->NextME = CurrentModules; n->NextME = CurrentModules;
CurrentModules = n; CurrentModules = n;
n->AtomOfME = ae; n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile( PASS_REGS1); n->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)n); AddPropToAtom(ae, (PropEntry *)n);
Yap_setModuleFlags(n, parent); Yap_setModuleFlags(n, parent);
return n; return n;
} }
/** /**
@ -67,8 +66,7 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
* *
* @return module descriptorxs * @return module descriptorxs
*/ */
static ModEntry *GetModuleEntry(Atom at USES_REGS) static ModEntry *GetModuleEntry(Atom at USES_REGS) {
{
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(at); AtomEntry *ae = RepAtom(at);
@ -84,12 +82,12 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
} }
READ_UNLOCK(ae->ARWLock); READ_UNLOCK(ae->ARWLock);
return initMod( ( CurrentModule == PROLOG_MODULE ? NULL : AtomOfTerm( CurrentModule ) ), at ); return initMod(
(CurrentModule == PROLOG_MODULE ? NULL : AtomOfTerm(CurrentModule)), at);
} }
/** get entry for ap/arity; assumes one is there. */ /** get entry for ap/arity; assumes one is there. */
static ModEntry *FetchModuleEntry(Atom at) static ModEntry *FetchModuleEntry(Atom at) {
{
Prop p0; Prop p0;
AtomEntry *ae = RepAtom(at); AtomEntry *ae = RepAtom(at);
@ -119,19 +117,18 @@ Term Yap_getUnknownModule(ModEntry *m) {
} }
} }
bool Yap_getUnknown ( Term mod) { bool Yap_getUnknown(Term mod) {
ModEntry *m = LookupModule( mod ); ModEntry *m = LookupModule(mod);
return Yap_getUnknownModule( m ); return Yap_getUnknownModule(m);
} }
bool Yap_CharacterEscapes(Term mt) {
bool Yap_CharacterEscapes(Term mt) { CACHE_REGS
CACHE_REGS if (mt == PROLOG_MODULE)
if (mt == PROLOG_MODULE) mt = TermProlog; mt = TermProlog;
return GetModuleEntry(AtomOfTerm(mt) PASS_REGS)->flags & M_CHARESCAPE; return GetModuleEntry(AtomOfTerm(mt) PASS_REGS)->flags & M_CHARESCAPE;
} }
#define ByteAdr(X) ((char *)&(X)) #define ByteAdr(X) ((char *)&(X))
Term Yap_Module_Name(PredEntry *ap) { Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS CACHE_REGS
@ -150,7 +147,6 @@ Term Yap_Module_Name(PredEntry *ap) {
else { else {
return ap->ModuleOfPred; return ap->ModuleOfPred;
} }
} }
static ModEntry *LookupSystemModule(Term a) { static ModEntry *LookupSystemModule(Term a) {
@ -158,7 +154,6 @@ static ModEntry *LookupSystemModule(Term a) {
Atom at; Atom at;
ModEntry *me; ModEntry *me;
/* prolog module */ /* prolog module */
if (a == 0) { if (a == 0) {
a = TermProlog; a = TermProlog;
@ -168,11 +163,10 @@ static ModEntry *LookupSystemModule(Term a) {
if (!me) if (!me)
return NULL; return NULL;
me->flags |= M_SYSTEM; me->flags |= M_SYSTEM;
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 ); me->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
return me; return me;
} }
static ModEntry *LookupModule(Term a) { static ModEntry *LookupModule(Term a) {
CACHE_REGS CACHE_REGS
Atom at; Atom at;
@ -189,9 +183,7 @@ static ModEntry *LookupModule(Term a) {
bool Yap_isSystemModule(Term a) { bool Yap_isSystemModule(Term a) {
ModEntry *me = LookupModule(a); ModEntry *me = LookupModule(a);
return return me != NULL && me->flags & M_SYSTEM;
me != NULL &&
me->flags & M_SYSTEM;
} }
Term Yap_Module(Term tmod) { Term Yap_Module(Term tmod) {
@ -204,7 +196,6 @@ ModEntry *Yap_GetModuleEntry(Term mod) {
if (!(me = LookupModule(mod))) if (!(me = LookupModule(mod)))
return NULL; return NULL;
return me; return me;
} }
Term Yap_GetModuleFromEntry(ModEntry *me) { Term Yap_GetModuleFromEntry(ModEntry *me) {
@ -270,7 +261,6 @@ static Int current_module1(USES_REGS1) { /* $current_module(Old)
return Yap_unify_constant(ARG1, TermProlog); return Yap_unify_constant(ARG1, TermProlog);
} }
static Int cont_current_module(USES_REGS1) { static Int cont_current_module(USES_REGS1) {
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next; ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next;
Term t = MkAtomTerm(imod->AtomOfME); Term t = MkAtomTerm(imod->AtomOfME);
@ -313,7 +303,7 @@ static Int cont_ground_module(USES_REGS1) {
} }
static Int init_ground_module(USES_REGS1) { static Int init_ground_module(USES_REGS1) {
/* current_module(?ModuleName) */ /* current_module(?ModuleName) */
Term t1 = Deref(ARG1), tmod = CurrentModule, t3; Term t1 = Deref(ARG1), tmod = CurrentModule, t3;
if (tmod == PROLOG_MODULE) { if (tmod == PROLOG_MODULE) {
tmod = TermProlog; tmod = TermProlog;
@ -334,11 +324,10 @@ static Int init_ground_module(USES_REGS1) {
} }
cut_fail(); cut_fail();
} }
if (!Yap_unify(ARG2, tmod) || if (!Yap_unify(ARG2, tmod) || !Yap_unify(ARG3, t3)) {
!Yap_unify(ARG3, t3) ) { cut_fail();
cut_fail(); }
} // make sure we keep the binding
// make sure we keep the binding
B->cp_tr = TR; B->cp_tr = TR;
B->cp_h = HR; B->cp_h = HR;
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules); EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules);
@ -352,33 +341,31 @@ static Int init_ground_module(USES_REGS1) {
* *
* @return * @return
*/ */
static Int is_system_module( USES_REGS1 ) static Int is_system_module(USES_REGS1) {
{
Term t; Term t;
if (IsVarTerm(t = Deref (ARG1))) { if (IsVarTerm(t = Deref(ARG1))) {
return false; return false;
} }
if (!IsAtomTerm(t)) { if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "load_files/2"); Yap_Error(TYPE_ERROR_ATOM, t, "load_files/2");
return false; return false;
} }
return Yap_isSystemModule( t ); return Yap_isSystemModule(t);
} }
static Int new_system_module( USES_REGS1 ) static Int new_system_module(USES_REGS1) {
{
ModEntry *me; ModEntry *me;
Term t; Term t;
if (IsVarTerm(t = Deref (ARG1))) { if (IsVarTerm(t = Deref(ARG1))) {
Yap_Error( INSTANTIATION_ERROR, t, NULL); Yap_Error(INSTANTIATION_ERROR, t, NULL);
return false; return false;
} }
if (!IsAtomTerm(t)) { if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, NULL); Yap_Error(TYPE_ERROR_ATOM, t, NULL);
return false; return false;
} }
if ((me = LookupSystemModule( t ) )) if ((me = LookupSystemModule(t)))
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1); me->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
return me != NULL; return me != NULL;
} }
@ -477,7 +464,7 @@ static Int source_module(USES_REGS1) {
Term Yap_StripModule(Term t, Term *modp) { Term Yap_StripModule(Term t, Term *modp) {
CACHE_REGS CACHE_REGS
Term tmod; Term tmod;
if (modp) if (modp)
tmod = *modp; tmod = *modp;

547
C/qlyr.c
View File

File diff suppressed because it is too large Load Diff

15
C/save.c
View File

@ -413,8 +413,6 @@ save_regs(int mode USES_REGS)
return -1; return -1;
if (putout(EventFlag) < 0) if (putout(EventFlag) < 0)
return -1; return -1;
if (putcellptr((CELL *)EX) < 0)
return -1;
#if defined(YAPOR_SBA) || defined(TABLING) #if defined(YAPOR_SBA) || defined(TABLING)
if (putcellptr(H_FZ) < 0) if (putcellptr(H_FZ) < 0)
return -1; return -1;
@ -859,9 +857,6 @@ get_regs(int flag USES_REGS)
EventFlag = get_cell(); EventFlag = get_cell();
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
return -1; return -1;
EX = (struct DB_TERM *)get_cellptr();
if (LOCAL_ErrorMessage)
return -1;
#if defined(YAPOR_SBA) || defined(TABLING) #if defined(YAPOR_SBA) || defined(TABLING)
H_FZ = get_cellptr(); H_FZ = get_cellptr();
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
@ -1067,10 +1062,6 @@ restore_regs(int flag USES_REGS)
HB = PtoLocAdjust(HB); HB = PtoLocAdjust(HB);
YENV = PtoLocAdjust(YENV); YENV = PtoLocAdjust(YENV);
S = PtoGloAdjust(S); S = PtoGloAdjust(S);
if (EX) {
EX = DBTermAdjust(EX);
RestoreDBTerm(EX, false, TRUE PASS_REGS);
}
LOCAL_WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(LOCAL_WokenGoals))); LOCAL_WokenGoals = AbsAppl(PtoGloAdjust(RepAppl(LOCAL_WokenGoals)));
} }
} }
@ -1203,12 +1194,6 @@ rehash(CELL *oldcode, int NOfE, int KindOfEntries USES_REGS)
} }
} }
static void
RestoreSWIHash(void)
{
// Yap_InitSWIHash();
}
static void RestoreFlags( UInt NFlags ) static void RestoreFlags( UInt NFlags )
{ {

15
C/signals.c
View File

@ -183,6 +183,21 @@ inline static bool get_signal(yap_signals sig USES_REGS) {
#endif #endif
} }
bool Yap_DisableInterrupts(int wid)
{
LOCAL_InterruptsDisabled = true;
YAPEnterCriticalSection();
return true;
}
bool Yap_EnableInterrupts(int wid)
{
LOCAL_InterruptsDisabled = false;
YAPLeaveCriticalSection();
return true;
}
/** /**
Function called to handle delayed interrupts. Function called to handle delayed interrupts.
*/ */

3
C/stdpreds.c
View File

@ -1415,8 +1415,9 @@ static Int p_break(USES_REGS1) {
return FALSE; return FALSE;
} }
void Yap_InitBackCPreds(void) { void Yap_InitBackCPreds(void) {
Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate, Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate,
cont_current_predicate, SafePredFlag | SyncPredFlag); cont_current_predicate, SafePredFlag | SyncPredFlag);
Yap_InitCPredBack("$current_op", 5, 1, init_current_op, cont_current_op, Yap_InitCPredBack("$current_op", 5, 1, init_current_op, cont_current_op,
SafePredFlag | SyncPredFlag); SafePredFlag | SyncPredFlag);

15
C/tracer.c
View File

@ -19,12 +19,12 @@
#ifdef LOW_LEVEL_TRACER #ifdef LOW_LEVEL_TRACER
#include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "Yatom.h"
#include "attvar.h" #include "attvar.h"
#include "yapio.h"
#include "clause.h" #include "clause.h"
#include "tracer.h" #include "tracer.h"
#include "yapio.h"
static void send_tracer_message(char *start, char *name, Int arity, char *mname, static void send_tracer_message(char *start, char *name, Int arity, char *mname,
CELL *args) { CELL *args) {
@ -137,8 +137,8 @@ check_area(void)
} }
*/ */
//PredEntry *old_p[10000]; // PredEntry *old_p[10000];
//Term old_x1[10000], old_x2[10000], old_x3[10000]; // Term old_x1[10000], old_x2[10000], old_x3[10000];
// static CELL oldv; // static CELL oldv;
@ -321,6 +321,7 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) {
} }
#endif #endif
fprintf(stderr, "%lld %ld ", vsc_count, LCL0 - (CELL *)B); fprintf(stderr, "%lld %ld ", vsc_count, LCL0 - (CELL *)B);
fprintf(stderr, "%ld ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP);
#if defined(THREADS) || defined(YAPOR) #if defined(THREADS) || defined(YAPOR)
fprintf(stderr, "(%d)", worker_id); fprintf(stderr, "(%d)", worker_id);
#endif #endif
@ -331,12 +332,12 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) {
} }
if (pred->ModuleOfPred == PROLOG_MODULE) { if (pred->ModuleOfPred == PROLOG_MODULE) {
if (!LOCAL_do_trace_primitives) { if (!LOCAL_do_trace_primitives) {
UNLOCK(Yap_low_level_trace_lock); UNLOCK(Yap_low_level_trace_lock);
return; return;
} }
mname = "prolog"; mname = "prolog";
} else { } else {
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE; mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
} }
switch (port) { switch (port) {
case enter_pred: case enter_pred:

79
C/write.c
View File

@ -19,14 +19,14 @@
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
#include <stdlib.h>
#include <math.h>
#include "Yap.h" #include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h" #include "YapHeap.h"
#include "YapText.h" #include "YapText.h"
#include "yapio.h" #include "Yatom.h"
#include "clause.h" #include "clause.h"
#include "yapio.h"
#include <math.h>
#include <stdlib.h>
#if COROUTINING #if COROUTINING
#include "attvar.h" #include "attvar.h"
#endif #endif
@ -88,21 +88,21 @@ static bool callPortray(Term t, struct DB_TERM **old_EXp, int sno USES_REGS) {
PredEntry *pe; PredEntry *pe;
Int b0 = LCL0 - (CELL *)B; Int b0 = LCL0 - (CELL *)B;
EX = NULL; *old_EXp = Yap_RefToException();
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) && if ((pe = RepPredProp(Yap_GetPredPropByFunc(FunctorPortray, USER_MODULE))) &&
pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE && pe->OpcodeOfPred != FAIL_OPCODE && pe->OpcodeOfPred != UNDEF_OPCODE &&
Yap_execute_pred(pe, &t, true PASS_REGS)) { Yap_execute_pred(pe, &t, true PASS_REGS)) {
choiceptr B0 = (choiceptr)(LCL0 - b0); choiceptr B0 = (choiceptr)(LCL0 - b0);
if (EX && !*old_EXp) if (Yap_HasException() && !*old_EXp)
*old_EXp = EX; *old_EXp = Yap_RefToException();
Yap_fail_all(B0 PASS_REGS); Yap_fail_all(B0 PASS_REGS);
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
return true; return true;
} }
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
if (EX && !*old_EXp) if (Yap_HasException() && !*old_EXp)
*old_EXp = EX; *old_EXp = Yap_RefToException();
return false; return false;
} }
@ -472,9 +472,7 @@ static wtype
AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
{ {
int ch; int ch;
if ( Yap_chtype[(int)s[0]] == SL && if (Yap_chtype[(int)s[0]] == SL && s[1] == '\0')
s[1] == '\0'
)
return (separator); return (separator);
while ((ch = *s++) != '\0') { while ((ch = *s++) != '\0') {
if (Yap_chtype[ch] != SY) if (Yap_chtype[ch] != SY)
@ -738,8 +736,8 @@ static CELL *restore_from_write(struct rewind_term *rwt,
CELL *ptr; CELL *ptr;
if (wglb->Keep_terms) { if (wglb->Keep_terms) {
ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr ); ptr = Yap_GetPtrFromSlot(rwt->u_sd.s.ptr);
Yap_RecoverSlots(2, rwt->u_sd.s.old ); Yap_RecoverSlots(2, rwt->u_sd.s.old);
// printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ; // printf("leak=%d %d\n", LOCALCurSlot,rwt->u_sd.s.old) ;
} else { } else {
ptr = rwt->u_sd.d.ptr; ptr = rwt->u_sd.d.ptr;
@ -875,9 +873,9 @@ static void write_list(Term t, int direction, int depth,
} }
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
} else if (ti != MkAtomTerm(AtomNil)) { } else if (ti != MkAtomTerm(AtomNil)) {
if (lastw == symbol || lastw == separator) { if (lastw == symbol || lastw == separator) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
wrputc('|', wglb->stream); wrputc('|', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE, writeTerm(from_pointer(RepPair(t) + 1, &nrwt, wglb), 999, depth, FALSE,
@ -901,8 +899,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
putAtom(Atom3Dots, wglb->Quote_illegal, wglb); putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
return; return;
} }
DBTerm *oEX = EX; DBTerm *ex;
EX = NULL; Yap_ResetException(worker_id);
t = Deref(t); t = Deref(t);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
write_var((CELL *)t, wglb, &nrwt); write_var((CELL *)t, wglb, &nrwt);
@ -924,12 +922,12 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
FALSE, wglb, &nrwt); FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
EX = oEX;
return; return;
} }
if (wglb->Use_portray) if (wglb->Use_portray)
if (callPortray(t, &EX, wglb->stream - GLOBAL_Stream PASS_REGS)) { if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) {
EX = oEX; Yap_CopyException(ex);
Yap_RaiseException();
return; return;
} }
if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) { if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
@ -950,19 +948,19 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (IsExtensionFunctor(functor)) { if (IsExtensionFunctor(functor)) {
switch ((CELL)functor) { switch ((CELL)functor) {
case (CELL) FunctorDouble: case (CELL)FunctorDouble:
wrputf(FloatOfTerm(t), wglb); wrputf(FloatOfTerm(t), wglb);
return; return;
case (CELL) FunctorString: case (CELL)FunctorString:
write_string(UStringOfTerm(t), wglb); write_string(UStringOfTerm(t), wglb);
return; return;
case (CELL) FunctorAttVar: case (CELL)FunctorAttVar:
write_var(RepAppl(t) + 1, wglb, &nrwt); write_var(RepAppl(t) + 1, wglb, &nrwt);
return; return;
case (CELL) FunctorDBRef: case (CELL)FunctorDBRef:
wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb); wrputref(RefOfTerm(t), wglb->Quote_illegal, wglb);
return; return;
case (CELL) FunctorLongInt: case (CELL)FunctorLongInt:
wrputn(LongIntOfTerm(t), wglb); wrputn(LongIntOfTerm(t), wglb);
return; return;
/* case (CELL)FunctorBigInt: */ /* case (CELL)FunctorBigInt: */
@ -1002,8 +1000,9 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} }
#endif #endif
if (wglb->Use_portray) { if (wglb->Use_portray) {
if (callPortray(t, &EX, wglb->stream - GLOBAL_Stream PASS_REGS)) { if (callPortray(t, &ex, wglb->stream - GLOBAL_Stream PASS_REGS)) {
EX = oEX; Yap_CopyException(ex);
Yap_RaiseException();
return; return;
} }
} }
@ -1133,17 +1132,14 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
if (op > p) { if (op > p) {
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} else if ( functor == FunctorDollarVar) { } else if (functor == FunctorDollarVar) {
Term ti = ArgOfTerm(1, t); Term ti = ArgOfTerm(1, t);
if (lastw == alphanum) { if (lastw == alphanum) {
wrputc(' ', wglb->stream); wrputc(' ', wglb->stream);
} }
if (wglb->Handle_vars && if (wglb->Handle_vars && !IsVarTerm(ti) &&
!IsVarTerm(ti) && (IsIntTerm(ti) || IsCodesTerm(ti) || IsAtomTerm(ti) ||
(IsIntTerm(ti) || IsStringTerm(ti))) {
IsCodesTerm(ti) ||
IsAtomTerm(ti) ||
IsStringTerm(ti) )) {
if (IsIntTerm(ti)) { if (IsIntTerm(ti)) {
Int k = IntOfTerm(ti); Int k = IntOfTerm(ti);
if (k == -1) { if (k == -1) {
@ -1177,8 +1173,8 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
} else if (!wglb->Ignore_ops && functor == FunctorBraces) { } else if (!wglb->Ignore_ops && functor == FunctorBraces) {
wrputc('{', wglb->stream); wrputc('{', wglb->stream);
lastw = separator; lastw = separator;
writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), GLOBAL_MaxPriority, depth + 1, writeTerm(from_pointer(RepAppl(t) + 1, &nrwt, wglb), GLOBAL_MaxPriority,
FALSE, wglb, &nrwt); depth + 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb); restore_from_write(&nrwt, wglb);
wrputc('}', wglb->stream); wrputc('}', wglb->stream);
lastw = separator; lastw = separator;
@ -1222,7 +1218,6 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
wrclose_bracket(wglb, TRUE); wrclose_bracket(wglb, TRUE);
} }
} }
EX = oEX;
} }
void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
@ -1292,7 +1287,7 @@ char *Yap_TermToString(Term t, char *s, size_t sz, size_t *length,
s = Yap_MemExportStreamPtr(sno); s = Yap_MemExportStreamPtr(sno);
Yap_CloseStream(sno); Yap_CloseStream(sno);
LOCAL_c_output_stream = old_output_stream; LOCAL_c_output_stream = old_output_stream;
if (EX == 0) if (Yap_HasException())
return s; return NULL;
return NULL; return s;
} }