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

call_cleanup in C plus indenting

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 */
BOp(Ystop, l);
SET_ASP(YREG, E_CB*sizeof(CELL));
BOp(Ystop, l);
LOCAL_CBorder = 0;
SET_ASP(YREG, E_CB * sizeof(CELL));
/* make sure ASP is initialized */
saveregs();
@ -20,11 +20,12 @@ BOp(Ystop, l);
#if BP_FREE
P1REG = PCBACKUP;
#endif
LOCAL_CBorder = 0;
return 1;
ENDBOp();
BOp(Nstop, e);
SET_ASP(YREG, E_CB*sizeof(CELL));
SET_ASP(YREG, E_CB * sizeof(CELL));
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
@ -32,55 +33,60 @@ BOp(Ystop, l);
#if BP_FREE
P1REG = PCBACKUP;
#endif
if (LOCAL_Error_TYPE == THROW_EVENT) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return 1;
}
return 0;
ENDBOp();
/************************************************************************\
* Native Code Execution *
/************************************************************************\
* Native Code Execution *
\************************************************************************/
#if YAP_JIT
static void *OpAddress_JIT[] =
{
#define OPCODE(OP,TYPE) && _##OP
static void *OpAddress_JIT[] = {
#define OPCODE(OP, TYPE) &&_##OP
#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? */
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) {
/* native_me */
BOp(jit_handler, J);
if (!PREG->y_u.J.jh->fi.bcst.c)
PREG->y_u.J.jh->mf.isground = IsGround(PREG);
PREG->y_u.J.jh->fi.bcst.c++;
/* Did PREG reach threshold value to become critical? */
if (PREG->y_u.J.jh->fi.bcst.c ==
(COUNT)(ExpEnv.config_struc.frequency_bound *
(ExpEnv.config_struc.profiling_startp)) &&
!PREG->y_u.J.jh->mf.isground) {
#if YAP_DBG_PREDS
if (ExpEnv.debug_struc.pprint_me.criticals != 0 && ExpEnv.debug_struc.pprint_me.criticals != 0x1) {
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.criticals);
}
#endif
traced_absmi();
if (ExpEnv.debug_struc.pprint_me.criticals != 0 &&
ExpEnv.debug_struc.pprint_me.criticals != 0x1) {
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
fprintf(stderr, "%s", (char *)ExpEnv.debug_struc.pprint_me.criticals);
}
#if YAP_DBG_PREDS
print_main_when_head(PREG, ON_INTERPRETER);
#endif
PREG = NEXTOP(PREG, J);
JMPNext();
ENDBOp();
traced_absmi();
}
#if YAP_DBG_PREDS
print_main_when_head(PREG, ON_INTERPRETER);
#endif
PREG = NEXTOP(PREG, J);
JMPNext();
ENDBOp();
#endif
#include "cp_absmi_insts.h"
#include "lu_absmi_insts.h"
#include "fail_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 "or_absmi_insts.h"
#include "index_absmi_insts.h"
#include "type_absmi_insts.h"
#include "prim_absmi_insts.h"
#include "meta_absmi_insts.h"
#include "index_absmi_insts.h"
#include "lu_absmi_insts.h"
#include "meta_absmi_insts.h"
#include "or_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 */
CACHE_Y(YREG);
/* 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;
store_args(PREG->y_u.OtapFs.s);
store_yaam_regs(NEXTOP(PREG, OtapFs), 0);

217
C/c_interface.c
View File

@ -25,12 +25,12 @@
#define C_INTERFACE_C 1
#include <stdlib.h>
#include "Yap.h"
#include "attvar.h"
#include "clause.h"
#include "yapio.h"
#include "Foreign.h"
#include "attvar.h"
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
@ -53,8 +53,8 @@
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#include "threads.h"
#include "cut_c.h"
#include "threads.h"
#if HAVE_MALLOC_H
#include <malloc.h>
#endif
@ -62,11 +62,11 @@
typedef void *atom_t;
typedef void *functor_t;
typedef enum {
FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
} frg_code;
typedef enum {
FRG_FIRST_CALL = 0, /* Initial call */
FRG_CUTTED = 1, /* Context was cutted */
FRG_REDO = 2 /* Normal redo */
} frg_code;
struct foreign_context {
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) {
// this case is easy, jut be sure to throw everything
// after the old B;
while (B != ptr) {
while (B && B->cp_b && B->cp_b <= ptr) {
B = B->cp_b;
}
if (has_cp)
@ -1066,16 +1066,9 @@ Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS);
// CurrentModule = omod;
if (!ret) {
Term t;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
Yap_RaiseException();
}
}
return ret;
return ret;
}
#define FRG_REDO_MASK 0x00000003L
@ -1107,15 +1100,8 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
Yap_CloseSlots(CurSlot);
PP = NULL;
if (val == 0) {
Term t;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
B = B->cp_b;
Yap_JumpToEnv(t);
return FALSE;
if (Yap_RaiseException()) {
return false;
}
return complete_fail(((choiceptr)(LCL0 - ocp)), TRUE PASS_REGS);
} else if (val == 1) { /* TRUE */
@ -1132,15 +1118,8 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
Int ret = (exec_code)(PASS_REGS1);
Yap_CloseSlots(CurSlot);
if (!ret) {
Term t;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
Yap_RaiseException();
}
return ret;
}
}
@ -1148,13 +1127,16 @@ Int YAP_ExecuteFirst(PredEntry *pe, CPredicate exec_code) {
Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
struct cut_c_str *top) {
CACHE_REGS
choiceptr oB = B;
Int oB = LCL0-(CELL*)B;
Int val;
/* for slots to work */
yhandle_t CurSlot = Yap_StartSlots();
/* find out where we belong */
while (B->cp_b < (choiceptr)top)
while (B < (choiceptr)top) {
oB = LCL0 - (CELL *)B;
B = B->cp_b;
}
PP = pe;
if (pe->PredFlags & (SWIEnvPredFlag | CArgsPredFlag)) {
// SWI Emulation
@ -1163,7 +1145,7 @@ Int YAP_ExecuteOnCut(PredEntry *pe, CPredicate exec_code,
(struct foreign_context *)(&EXTRA_CBACK_ARG(pe->ArityOfPE, 1));
CELL *args = B->cp_args;
B = oB;
B = (choiceptr)(LCL0 - oB);
ctx->control = FRG_CUTTED;
ctx->engine = NULL; //(PL_local_data *)Yap_regp;
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);
}
} else {
Int oYENV = LCL0 - YENV;
yamop *oP = P, *oCP = CP;
// YAP Native
B = (choiceptr)(LCL0 - oB);
val = exec_code(PASS_REGS1);
B = oB;
YENV = LCL0 - oYENV;
P = oP;
CP = oCP;
}
Yap_CloseSlots(CurSlot);
PP = NULL;
// B = LCL0-(CELL*)oB;
if (val == 0) {
Term t;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
Yap_JumpToEnv(t);
return FALSE;
}
return FALSE;
if (false && Yap_RaiseException()) {
return false;
} 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 */
PP = NULL;
if (val == 0) {
Term t;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
cut_c_pop();
B = B->cp_b;
Yap_JumpToEnv(t);
if (Yap_RaiseException()) {
return FALSE;
} else {
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);
Yap_CloseSlots(CurSlot);
if (!ret) {
Term t;
LOCAL_BallTerm = EX;
EX = NULL;
if ((t = Yap_GetException())) {
Yap_JumpToEnv(t);
return FALSE;
}
}
Yap_RaiseException();
}
return ret;
}
}
@ -1292,6 +1255,7 @@ X_API void *YAP_ReallocSpaceFromYap(void *ptr, size_t size) {
RECOVER_MACHINE_REGS();
return new_ptr;
}
X_API void *YAP_AllocSpaceFromYap(size_t size) {
CACHE_REGS
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 */
X_API Term
YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0, size_t len) {
X_API Term YAP_NWideBufferToAtomDiffList(const wchar_t *s, Term t0,
size_t len) {
Term t;
BACKUP_H();
@ -1802,16 +1766,11 @@ X_API Int YAP_RunGoal(Term t) {
LOCAL_AllowRestart = FALSE;
LOCAL_PrologMode = UserMode;
out = Yap_RunTopGoal(t);
out = Yap_RunTopGoal(t, true);
LOCAL_PrologMode = UserCCallMode;
// should we catch the exception or pass it through?
// We'll pass it through
if (EX) {
Term ball = Yap_PopTermFromDB(EX);
EX = NULL;
Yap_JumpToEnv(ball);
return FALSE;
}
Yap_RaiseException();
if (out) {
P = (yamop *)ENV[E_CP];
ENV = (CELL *)ENV[E_E];
@ -1896,7 +1855,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
CSlot = Yap_StartSlots();
LOCAL_PrologMode = UserMode;
// Yap_heap_regs->yap_do_low_level_trace=true;
out = Yap_RunTopGoal(t);
out = Yap_RunTopGoal(t, true);
LOCAL_PrologMode = oldPrologMode;
Yap_CloseSlots(CSlot);
if (!(oldPrologMode & UserCCallMode)) {
@ -1907,12 +1866,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
}
// should we catch the exception or pass it through?
// We'll pass it through
if (EX) {
Term ball = Yap_PopTermFromDB(EX);
EX = NULL;
Yap_JumpToEnv(ball);
return FALSE;
}
Yap_RaiseException();
if (out) {
choiceptr cut_pt, ob;
@ -2044,47 +1998,16 @@ X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) {
X_API bool YAP_GoalHasException(Term *t) {
CACHE_REGS
int out = FALSE;
BACKUP_MACHINE_REGS();
if (EX) {
do {
LOCAL_Error_TYPE = YAP_NO_ERROR;
*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;
}
if (t)
*t = Yap_PeekException();
return Yap_PeekException();
}
X_API void YAP_ClearExceptions(void) {
CACHE_REGS
if (EX) {
LOCAL_BallTerm = EX;
}
EX = NULL;
Yap_ResetExceptionTerm(0);
LOCAL_UncaughtThrow = FALSE;
Yap_ResetException(worker_id);
}
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);
if (!full)
return -1;
f = fopen( full, "r");
f = fopen(full, "r");
if (!f)
return -1;
else
free( (char *)full );
free((char *)full);
sno = Yap_OpenStream(f, NULL, TermNil, Input_Stream_f);
*osnop = Yap_CheckAlias(AtomLoopStream);
if (!Yap_AddAlias(AtomLoopStream, sno)) {
@ -2154,7 +2077,6 @@ X_API Term YAP_Read(FILE *f) {
return o;
}
X_API Term YAP_ReadFromStream(int sno) {
Term o;
@ -2283,7 +2205,7 @@ static void do_bootfile(char *bootfilename USES_REGS) {
YAP_Reset(YAP_FULL_RESET);
Yap_StartSlots();
t = YAP_ReadClauseFromStream(bootfile);
// Yap_DebugPlWrite(t);fprintf(stderr, "\n");
//Yap_DebugPlWriteln(t);
if (t == 0) {
fprintf(stderr,
"[ 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 do_bootstrap = (yap_init->YapPrologBootFile != NULL);
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;
/* ignore repeated calls to YAP_Init */
@ -2368,7 +2290,8 @@ Int YAP_Init(YAP_init_args *yap_init) {
GLOBAL_argc = yap_init->Argc;
#if BOOT_FROM_SAVED_STATE
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
@ -2717,24 +2640,30 @@ X_API void YAP_PredicateInfo(void *p, Atom *a, UInt *arity, Term *m) {
*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);
}
X_API void YAP_UserBackCPredicate(const char *name, CPredicate init,
CPredicate cont, UInt arity,
unsigned int extra) {
X_API void YAP_UserBackCPredicate_(const char *name, CPredicate init,
CPredicate cont, arity_t arity,
arity_t extra) {
Yap_InitCPredBackCut(name, arity, extra, init, cont, NULL, UserCPredFlag);
}
X_API void YAP_UserBackCutCPredicate(const char *name, CPredicate init,
CPredicate cont, CPredicate cut,
UInt arity, unsigned int extra) {
arity_t arity, arity_t extra) {
Yap_InitCPredBackCut(name, arity, extra, init, cont, cut, UserCPredFlag);
}
X_API void YAP_UserCPredicateWithArgs(const char *a, CPredicate f, UInt arity,
Term mod) {
X_API void YAP_UserBackCPredicate(const char *name, CPredicate init,
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
PredEntry *pe;
Term cm = CurrentModule;
@ -3398,11 +3327,11 @@ X_API int YAP_RequiresExtraStack(size_t sz) {
return TRUE;
}
atom_t *TR_Atoms;
functor_t *TR_Functors;
size_t AtomTranslations, MaxAtomTranslations;
size_t FunctorTranslations, MaxFunctorTranslations;
atom_t *TR_Atoms;
functor_t *TR_Functors;
size_t AtomTranslations, MaxAtomTranslations;
size_t FunctorTranslations, MaxFunctorTranslations;
X_API Int YAP_AtomToInt(Atom At) {
TranslationEntry *te = Yap_GetTranslationProp(At, 0);
if (te != NIL)
@ -3438,9 +3367,9 @@ X_API Int YAP_FunctorToInt(Functor f) {
Yap_PutAtomTranslation(At, arity, FunctorTranslations);
FunctorTranslations++;
if (FunctorTranslations == MaxFunctorTranslations) {
functor_t *nt =
(functor_t *)malloc(sizeof(functor_t) * 2 * MaxFunctorTranslations),
*ot = TR_Functors;
functor_t *nt = (functor_t *)malloc(sizeof(functor_t) * 2 *
MaxFunctorTranslations),
*ot = TR_Functors;
if (nt == NULL) {
Yap_Error(SYSTEM_ERROR_INTERNAL, MkAtomTerm(At),
"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 "clause.h"
#include "yapio.h"
#include "eval.h"
#include "tracer.h"
#include "yapio.h"
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
@ -32,9 +32,9 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#if HAVE_STRING_H
#include <string.h>
#endif
#include <assert.h>
#include <heapgc.h>
#include <iopreds.h>
#include <assert.h>
static void retract_all(PredEntry *, 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_is_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_profile_info(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 mod = Deref(ARG4);
yamop *code_adr;
int mode;
if (IsVarTerm(t1) || !IsAtomicTerm(t1))
return false;
@ -2712,18 +2710,6 @@ static Int p_optimizer_off(USES_REGS1) { /* '$optimizer_off' */
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) {
Term t = Deref(ARG1);
char *s;
@ -2908,7 +2894,6 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
}
void Yap_HidePred(PredEntry *pe) {
Prop p0 = AbsPredProp(pe);
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
}

614
C/cp_absmi_insts.h
View File

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

35
C/errors.c
View File

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

54
C/init.c
View File

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

109
C/modules.c
View File

@ -19,8 +19,8 @@ static char SccsId[] = "%W% %G%";
#endif
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "Yatom.h"
static Int current_module(USES_REGS1);
static Int current_module1(USES_REGS1);
@ -36,28 +36,27 @@ static ModEntry *FetchModuleEntry(Atom at);
* @param ae module name.
*
* @return a new module structure
*//** */
static ModEntry *
initMod( AtomEntry *toname, AtomEntry *ae) {
CACHE_REGS
ModEntry *n, *parent;
*/ /** */
static ModEntry *initMod(AtomEntry *toname, AtomEntry *ae) {
CACHE_REGS
ModEntry *n, *parent;
if (toname == NULL)
parent = NULL;
else {
parent = FetchModuleEntry( toname );
}
n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n));
INIT_RWLOCK(n->ModRWLock);
n->KindOfPE = ModProperty;
n->PredForME = NULL;
n->NextME = CurrentModules;
CurrentModules = n;
n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)n);
Yap_setModuleFlags(n, parent);
return n;
if (toname == NULL)
parent = NULL;
else {
parent = FetchModuleEntry(toname);
}
n = (ModEntry *)Yap_AllocAtomSpace(sizeof(*n));
INIT_RWLOCK(n->ModRWLock);
n->KindOfPE = ModProperty;
n->PredForME = NULL;
n->NextME = CurrentModules;
CurrentModules = n;
n->AtomOfME = ae;
n->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
AddPropToAtom(ae, (PropEntry *)n);
Yap_setModuleFlags(n, parent);
return n;
}
/**
@ -67,8 +66,7 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
*
* @return module descriptorxs
*/
static ModEntry *GetModuleEntry(Atom at USES_REGS)
{
static ModEntry *GetModuleEntry(Atom at USES_REGS) {
Prop p0;
AtomEntry *ae = RepAtom(at);
@ -84,12 +82,12 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
}
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. */
static ModEntry *FetchModuleEntry(Atom at)
{
static ModEntry *FetchModuleEntry(Atom at) {
Prop p0;
AtomEntry *ae = RepAtom(at);
@ -119,19 +117,18 @@ Term Yap_getUnknownModule(ModEntry *m) {
}
}
bool Yap_getUnknown ( Term mod) {
ModEntry *m = LookupModule( mod );
return Yap_getUnknownModule( m );
bool Yap_getUnknown(Term mod) {
ModEntry *m = LookupModule(mod);
return Yap_getUnknownModule(m);
}
bool Yap_CharacterEscapes(Term mt) {
CACHE_REGS
if (mt == PROLOG_MODULE) mt = TermProlog;
bool Yap_CharacterEscapes(Term mt) {
CACHE_REGS
if (mt == PROLOG_MODULE)
mt = TermProlog;
return GetModuleEntry(AtomOfTerm(mt) PASS_REGS)->flags & M_CHARESCAPE;
}
#define ByteAdr(X) ((char *)&(X))
Term Yap_Module_Name(PredEntry *ap) {
CACHE_REGS
@ -150,7 +147,6 @@ Term Yap_Module_Name(PredEntry *ap) {
else {
return ap->ModuleOfPred;
}
}
static ModEntry *LookupSystemModule(Term a) {
@ -158,7 +154,6 @@ static ModEntry *LookupSystemModule(Term a) {
Atom at;
ModEntry *me;
/* prolog module */
if (a == 0) {
a = TermProlog;
@ -168,11 +163,10 @@ static ModEntry *LookupSystemModule(Term a) {
if (!me)
return NULL;
me->flags |= M_SYSTEM;
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1 );
me->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
return me;
}
static ModEntry *LookupModule(Term a) {
CACHE_REGS
Atom at;
@ -189,9 +183,7 @@ static ModEntry *LookupModule(Term a) {
bool Yap_isSystemModule(Term a) {
ModEntry *me = LookupModule(a);
return
me != NULL &&
me->flags & M_SYSTEM;
return me != NULL && me->flags & M_SYSTEM;
}
Term Yap_Module(Term tmod) {
@ -204,7 +196,6 @@ ModEntry *Yap_GetModuleEntry(Term mod) {
if (!(me = LookupModule(mod)))
return NULL;
return 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);
}
static Int cont_current_module(USES_REGS1) {
ModEntry *imod = AddressOfTerm(EXTRA_CBACK_ARG(1, 1)), *next;
Term t = MkAtomTerm(imod->AtomOfME);
@ -313,7 +303,7 @@ static Int cont_ground_module(USES_REGS1) {
}
static Int init_ground_module(USES_REGS1) {
/* current_module(?ModuleName) */
/* current_module(?ModuleName) */
Term t1 = Deref(ARG1), tmod = CurrentModule, t3;
if (tmod == PROLOG_MODULE) {
tmod = TermProlog;
@ -334,11 +324,10 @@ static Int init_ground_module(USES_REGS1) {
}
cut_fail();
}
if (!Yap_unify(ARG2, tmod) ||
!Yap_unify(ARG3, t3) ) {
cut_fail();
}
// make sure we keep the binding
if (!Yap_unify(ARG2, tmod) || !Yap_unify(ARG3, t3)) {
cut_fail();
}
// make sure we keep the binding
B->cp_tr = TR;
B->cp_h = HR;
EXTRA_CBACK_ARG(3, 1) = MkAddressTerm(CurrentModules);
@ -352,33 +341,31 @@ static Int init_ground_module(USES_REGS1) {
*
* @return
*/
static Int is_system_module( USES_REGS1 )
{
static Int is_system_module(USES_REGS1) {
Term t;
if (IsVarTerm(t = Deref (ARG1))) {
if (IsVarTerm(t = Deref(ARG1))) {
return false;
}
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, "load_files/2");
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;
Term t;
if (IsVarTerm(t = Deref (ARG1))) {
Yap_Error( INSTANTIATION_ERROR, t, NULL);
if (IsVarTerm(t = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t, NULL);
return false;
}
if (!IsAtomTerm(t)) {
Yap_Error(TYPE_ERROR_ATOM, t, NULL);
return false;
}
if ((me = LookupSystemModule( t ) ))
me->OwnerFile = Yap_ConsultingFile( PASS_REGS1);
if ((me = LookupSystemModule(t)))
me->OwnerFile = Yap_ConsultingFile(PASS_REGS1);
return me != NULL;
}
@ -477,7 +464,7 @@ static Int source_module(USES_REGS1) {
Term Yap_StripModule(Term t, Term *modp) {
CACHE_REGS
Term tmod;
Term tmod;
if (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;
if (putout(EventFlag) < 0)
return -1;
if (putcellptr((CELL *)EX) < 0)
return -1;
#if defined(YAPOR_SBA) || defined(TABLING)
if (putcellptr(H_FZ) < 0)
return -1;
@ -859,9 +857,6 @@ get_regs(int flag USES_REGS)
EventFlag = get_cell();
if (LOCAL_ErrorMessage)
return -1;
EX = (struct DB_TERM *)get_cellptr();
if (LOCAL_ErrorMessage)
return -1;
#if defined(YAPOR_SBA) || defined(TABLING)
H_FZ = get_cellptr();
if (LOCAL_ErrorMessage)
@ -1067,10 +1062,6 @@ restore_regs(int flag USES_REGS)
HB = PtoLocAdjust(HB);
YENV = PtoLocAdjust(YENV);
S = PtoGloAdjust(S);
if (EX) {
EX = DBTermAdjust(EX);
RestoreDBTerm(EX, false, TRUE PASS_REGS);
}
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 )
{

15
C/signals.c
View File

@ -183,6 +183,21 @@ inline static bool get_signal(yap_signals sig USES_REGS) {
#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.
*/

3
C/stdpreds.c
View File

@ -1415,8 +1415,9 @@ static Int p_break(USES_REGS1) {
return FALSE;
}
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);
Yap_InitCPredBack("$current_op", 5, 1, init_current_op, cont_current_op,
SafePredFlag | SyncPredFlag);

15
C/tracer.c
View File

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

79
C/write.c
View File

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