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

1170
C/absmi.c
View File

File diff suppressed because it is too large Load Diff

50
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,38 +33,43 @@ 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 */ /* native_me */
BOp(jit_handler, J); BOp(jit_handler, J);
if (!PREG->y_u.J.jh->fi.bcst.c) PREG->y_u.J.jh->mf.isground = IsGround(PREG); 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++; PREG->y_u.J.jh->fi.bcst.c++;
/* Did PREG reach threshold value to become critical? */ /* 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 (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 &&
ExpEnv.debug_struc.pprint_me.criticals != 0x1) {
fprintf(stderr, "%s:%d\n", __FILE__, __LINE__); fprintf(stderr, "%s:%d\n", __FILE__, __LINE__);
fprintf(stderr, "%s", (char*)ExpEnv.debug_struc.pprint_me.criticals); fprintf(stderr, "%s", (char *)ExpEnv.debug_struc.pprint_me.criticals);
} }
#endif #endif
traced_absmi(); traced_absmi();
} }
#if YAP_DBG_PREDS #if YAP_DBG_PREDS
print_main_when_head(PREG, ON_INTERPRETER); print_main_when_head(PREG, ON_INTERPRETER);
@ -73,14 +79,14 @@ BOp(Ystop, l);
ENDBOp(); 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 "type_absmi_insts.h" #include "lu_absmi_insts.h"
#include "prim_absmi_insts.h"
#include "meta_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 */ #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);

199
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,14 +1066,7 @@ 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;
} }
@ -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,14 +1118,7 @@ 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,14 +1216,7 @@ 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,10 +3327,10 @@ 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);
@ -3438,8 +3367,8 @@ 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),

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);
} }

174
C/cp_absmi_insts.h
View File

@ -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);
@ -61,19 +61,18 @@
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);
/* 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);
} }
@ -112,13 +111,14 @@
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.
*/ */
@ -128,7 +128,7 @@
#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.
*/ */
@ -157,7 +157,7 @@
#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.
*/ */
@ -188,7 +186,7 @@
#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();
@ -206,14 +204,14 @@
{ {
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.
*/ */
@ -223,7 +221,7 @@
#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();
@ -235,9 +233,10 @@
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 =
ADDRESS_TO_LINK(it, (BITS32 *)((CELL *)(B + 1))[it->arity]);
d0 = it->links[offset]; d0 = it->links[offset];
((CELL *)(B+1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0); ((CELL *)(B + 1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0);
SREG = EXO_OFFSET_TO_ADDRESS(it, offset); SREG = EXO_OFFSET_TO_ADDRESS(it, offset);
} }
if (d0) { if (d0) {
@ -246,7 +245,7 @@
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);
@ -258,7 +257,7 @@
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
@ -266,10 +265,10 @@
{ {
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);
} }
@ -299,7 +298,7 @@
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);
@ -311,7 +310,7 @@
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
@ -319,10 +318,10 @@
{ {
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);
} }
@ -338,7 +337,8 @@
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
// *)(B+1))[it->arity];
/* operation has a side-effect: S = (CELL*)NextClause */ /* operation has a side-effect: S = (CELL*)NextClause */
saveregs(); saveregs();
d0 = 0L; // Yap_UDI_NextAlt(jp); d0 = 0L; // Yap_UDI_NextAlt(jp);
@ -354,7 +354,7 @@
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);
@ -366,7 +366,7 @@
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
@ -374,10 +374,10 @@
{ {
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);
} }
@ -394,17 +394,17 @@
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);
@ -416,7 +416,7 @@
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
@ -424,10 +424,10 @@
{ {
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);
} }
@ -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);
@ -491,19 +491,18 @@
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
else
#endif /* YAPOR */ #endif /* YAPOR */
{ {
pop_yaam_regs(); pop_yaam_regs();
pop_args(PREG->y_u.Otapl.s); pop_args(PREG->y_u.Otapl.s);
/* 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);
} }
@ -528,14 +527,14 @@
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();
} }
@ -553,7 +552,7 @@
/* 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();
} }
@ -561,7 +560,7 @@
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();
} }
@ -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);
@ -590,14 +589,14 @@
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();
} }
@ -613,19 +612,18 @@
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
else
#endif /* YAPOR */ #endif /* YAPOR */
{ {
pop_yaam_regs(); pop_yaam_regs();
pop_args(PREG->y_u.Otapl.s); pop_args(PREG->y_u.Otapl.s);
/* 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);
} }
@ -634,14 +632,14 @@
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();
} }
@ -662,24 +660,24 @@
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();
@ -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,7 +706,7 @@
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) {
@ -717,7 +715,7 @@
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();
@ -731,7 +729,7 @@
*/ */
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);
@ -755,7 +753,7 @@
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG)); TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
} }
#endif #endif
PREG = NEXTOP(PREG,Otapl); PREG = NEXTOP(PREG, Otapl);
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
@ -764,14 +762,14 @@
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();
} }
@ -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);
@ -821,7 +819,6 @@
JMPNext(); JMPNext();
ENDBOp(); ENDBOp();
/************************************************************************\ /************************************************************************\
* Try / Retry / Trust for main indexing blocks * * Try / Retry / Trust for main indexing blocks *
@ -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,17 +984,16 @@
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);
} }

31
C/errors.c
View File

@ -262,6 +262,18 @@ static void error_exit_yap(int value) {
#endif #endif
} }
fprintf(stderr, "\n Exiting ....\n"); fprintf(stderr, "\n Exiting ....\n");
#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); Yap_exit(value);
} }
@ -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;

771
C/exec.c
View File

File diff suppressed because it is too large Load Diff

170
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,7 +10,8 @@
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;
@ -20,33 +20,37 @@
} }
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;
@ -79,27 +83,30 @@
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();
@ -110,11 +117,11 @@
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();
} }
} }
@ -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,10 +290,10 @@
#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);
@ -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,15 +594,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 == 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();
} }
@ -600,7 +614,7 @@
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();
@ -610,7 +624,7 @@
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();

24
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
@ -1022,8 +1023,7 @@ static void InitLogDBErasedMarker(void) {
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);
} }

65
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,16 +36,15 @@ 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);
@ -54,7 +53,7 @@ initMod( AtomEntry *toname, AtomEntry *ae) {
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) mt = TermProlog; if (mt == PROLOG_MODULE)
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);
@ -334,8 +324,7 @@ 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
@ -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;
} }

433
C/qlyr.c
View File

@ -17,11 +17,11 @@
*************************************************************************/ *************************************************************************/
#include "absmi.h" #include "absmi.h"
#include "Foreign.h"
#include "alloc.h" #include "alloc.h"
#include "yapio.h"
#include "iopreds.h"
#include "attvar.h" #include "attvar.h"
#include "iopreds.h"
#include "yapio.h"
#include <Foreign.h>
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
@ -29,7 +29,7 @@
#include "qly.h" #include "qly.h"
static void RestoreEntries(PropEntry *, int USES_REGS); static void RestoreEntries(PropEntry *, int USES_REGS);
static void CleanCode(PredEntry * USES_REGS); static void CleanCode(PredEntry *USES_REGS);
typedef enum { typedef enum {
OUT_OF_TEMP_SPACE = 0, OUT_OF_TEMP_SPACE = 0,
@ -47,8 +47,8 @@ typedef enum {
BAD_HEADER = 12 BAD_HEADER = 12
} qlfr_err_t; } qlfr_err_t;
static char * static char *qlyr_error[] = {
qlyr_error[] = { "out of temporary space", "out of temporary space",
"out of temporary space", "out of temporary space",
"out of code space", "out of code space",
"unknown atom in saved space", "unknown atom in saved space",
@ -59,11 +59,9 @@ qlyr_error[] = { "out of temporary space",
"corrupted atom in saved space", "corrupted atom in saved space",
"formatting mismatch in saved space", "formatting mismatch in saved space",
"foreign predicate has different definition in saved space", "foreign predicate has different definition in saved space",
"bad read" }; "bad read"};
static char * static char *Yap_AlwaysAllocCodeSpace(UInt size) {
Yap_AlwaysAllocCodeSpace(UInt size)
{
char *out; char *out;
while (!(out = Yap_AllocCodeSpace(size))) { while (!(out = Yap_AllocCodeSpace(size))) {
if (!Yap_growheap(FALSE, size, NULL)) { if (!Yap_growheap(FALSE, size, NULL)) {
@ -73,17 +71,15 @@ Yap_AlwaysAllocCodeSpace(UInt size)
return out; return out;
} }
static void static void QLYR_ERROR(qlfr_err_t my_err) {
QLYR_ERROR(qlfr_err_t my_err) // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state
{ // %s",GLOBAL_RestoreFile, qlyr_error[my_err]);
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); Yap_Error(SYSTEM_ERROR_SAVED_STATE, TermNil, "error %s in saved state %s",
Yap_Error(SYSTEM_ERROR_SAVED_STATE,TermNil,"error %s in saved state %s",GLOBAL_RestoreFile, qlyr_error[my_err]); GLOBAL_RestoreFile, qlyr_error[my_err]);
Yap_exit(1); Yap_exit(1);
} }
static Atom static Atom LookupAtom(Atom oat) {
LookupAtom(Atom oat)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize; CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
import_atom_hash_entry_t *a; import_atom_hash_entry_t *a;
@ -95,14 +91,13 @@ LookupAtom(Atom oat)
} }
a = a->next; a = a->next;
} }
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ", oat); // __android_log_print(ANDROID_LOG_INFO, "YAP ", "error %p in saved state ",
// oat);
QLYR_ERROR(UNKNOWN_ATOM); QLYR_ERROR(UNKNOWN_ATOM);
return NIL; return NIL;
} }
static void static void InsertAtom(Atom oat, Atom at) {
InsertAtom(Atom oat, Atom at)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize; CELL hash = (CELL)(oat) % LOCAL_ImportAtomHashTableSize;
import_atom_hash_entry_t *a; import_atom_hash_entry_t *a;
@ -124,9 +119,7 @@ InsertAtom(Atom oat, Atom at)
LOCAL_ImportAtomHashChain[hash] = a; LOCAL_ImportAtomHashChain[hash] = a;
} }
static Functor static Functor LookupFunctor(Functor ofun) {
LookupFunctor(Functor ofun)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize; CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize;
import_functor_hash_entry_t *f; import_functor_hash_entry_t *f;
@ -142,9 +135,7 @@ LookupFunctor(Functor ofun)
return NIL; return NIL;
} }
static void static void InsertFunctor(Functor ofun, Functor fun) {
InsertFunctor(Functor ofun, Functor fun)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize; CELL hash = (CELL)(ofun) % LOCAL_ImportFunctorHashTableSize;
import_functor_hash_entry_t *f; import_functor_hash_entry_t *f;
@ -156,7 +147,8 @@ InsertFunctor(Functor ofun, Functor fun)
} }
f = f->next; f = f->next;
} }
f = (import_functor_hash_entry_t *)malloc(sizeof(import_functor_hash_entry_t)); f = (import_functor_hash_entry_t *)malloc(
sizeof(import_functor_hash_entry_t));
if (!f) { if (!f) {
return; return;
} }
@ -166,9 +158,7 @@ InsertFunctor(Functor ofun, Functor fun)
LOCAL_ImportFunctorHashChain[hash] = f; LOCAL_ImportFunctorHashChain[hash] = f;
} }
static PredEntry * static PredEntry *LookupPredEntry(PredEntry *op) {
LookupPredEntry(PredEntry *op)
{
CACHE_REGS CACHE_REGS
CELL hash; CELL hash;
import_pred_entry_hash_entry_t *p; import_pred_entry_hash_entry_t *p;
@ -187,9 +177,7 @@ LookupPredEntry(PredEntry *op)
return NIL; return NIL;
} }
static void static void InsertPredEntry(PredEntry *op, PredEntry *pe) {
InsertPredEntry(PredEntry *op, PredEntry *pe)
{
CACHE_REGS CACHE_REGS
CELL hash; CELL hash;
import_pred_entry_hash_entry_t *p; import_pred_entry_hash_entry_t *p;
@ -204,7 +192,8 @@ InsertPredEntry(PredEntry *op, PredEntry *pe)
} }
p = p->next; p = p->next;
} }
p = (import_pred_entry_hash_entry_t *)malloc(sizeof(import_pred_entry_hash_entry_t)); p = (import_pred_entry_hash_entry_t *)malloc(
sizeof(import_pred_entry_hash_entry_t));
if (!p) { if (!p) {
return; return;
} }
@ -214,9 +203,7 @@ InsertPredEntry(PredEntry *op, PredEntry *pe)
LOCAL_ImportPredEntryHashChain[hash] = p; LOCAL_ImportPredEntryHashChain[hash] = p;
} }
static OPCODE static OPCODE LookupOPCODE(OPCODE op) {
LookupOPCODE(OPCODE op)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize; CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
import_opcode_hash_entry_t *f; import_opcode_hash_entry_t *f;
@ -232,9 +219,7 @@ LookupOPCODE(OPCODE op)
return NIL; return NIL;
} }
static int static int OpcodeID(OPCODE op) {
OpcodeID(OPCODE op)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize; CELL hash = (CELL)(op) % LOCAL_ImportOPCODEHashTableSize;
import_opcode_hash_entry_t *f; import_opcode_hash_entry_t *f;
@ -250,9 +235,7 @@ OpcodeID(OPCODE op)
return NIL; return NIL;
} }
static void static void InsertOPCODE(OPCODE op0, int i, OPCODE op) {
InsertOPCODE(OPCODE op0, int i, OPCODE op)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(op0) % LOCAL_ImportOPCODEHashTableSize; CELL hash = (CELL)(op0) % LOCAL_ImportOPCODEHashTableSize;
import_opcode_hash_entry_t *f; import_opcode_hash_entry_t *f;
@ -274,9 +257,7 @@ InsertOPCODE(OPCODE op0, int i, OPCODE op)
LOCAL_ImportOPCODEHashChain[hash] = f; LOCAL_ImportOPCODEHashChain[hash] = f;
} }
static DBRef static DBRef LookupDBRef(DBRef dbr, int inc_ref) {
LookupDBRef(DBRef dbr, int inc_ref)
{
CACHE_REGS CACHE_REGS
CELL hash; CELL hash;
import_dbref_hash_entry_t *p; import_dbref_hash_entry_t *p;
@ -298,9 +279,7 @@ LookupDBRef(DBRef dbr, int inc_ref)
return NIL; return NIL;
} }
static LogUpdClause * static LogUpdClause *LookupMayFailDBRef(DBRef dbr) {
LookupMayFailDBRef(DBRef dbr)
{
CACHE_REGS CACHE_REGS
CELL hash; CELL hash;
import_dbref_hash_entry_t *p; import_dbref_hash_entry_t *p;
@ -319,9 +298,7 @@ LookupMayFailDBRef(DBRef dbr)
return NULL; return NULL;
} }
static void static void InsertDBRef(DBRef dbr0, DBRef dbr) {
InsertDBRef(DBRef dbr0, DBRef dbr)
{
CACHE_REGS CACHE_REGS
CELL hash = (CELL)(dbr0) % LOCAL_ImportDBRefHashTableSize; CELL hash = (CELL)(dbr0) % LOCAL_ImportDBRefHashTableSize;
import_dbref_hash_entry_t *p; import_dbref_hash_entry_t *p;
@ -344,20 +321,18 @@ InsertDBRef(DBRef dbr0, DBRef dbr)
LOCAL_ImportDBRefHashChain[hash] = p; LOCAL_ImportDBRefHashChain[hash] = p;
} }
static void static void InitHash(void) {
InitHash(void)
{
CACHE_REGS CACHE_REGS
LOCAL_ImportOPCODEHashTableSize = EXPORT_OPCODE_TABLE_SIZE; LOCAL_ImportOPCODEHashTableSize = EXPORT_OPCODE_TABLE_SIZE;
LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc(1, sizeof(import_opcode_hash_entry_t *)* LOCAL_ImportOPCODEHashTableSize); LOCAL_ImportOPCODEHashChain = (import_opcode_hash_entry_t **)calloc(
1,
sizeof(import_opcode_hash_entry_t *) * LOCAL_ImportOPCODEHashTableSize);
} }
static void static void CloseHash(void) {
CloseHash(void)
{
CACHE_REGS CACHE_REGS
UInt i; UInt i;
for (i=0; i < LOCAL_ImportFunctorHashTableSize; i++) { for (i = 0; i < LOCAL_ImportFunctorHashTableSize; i++) {
import_functor_hash_entry_t *a = LOCAL_ImportFunctorHashChain[i]; import_functor_hash_entry_t *a = LOCAL_ImportFunctorHashChain[i];
while (a) { while (a) {
import_functor_hash_entry_t *a0 = a; import_functor_hash_entry_t *a0 = a;
@ -368,7 +343,7 @@ CloseHash(void)
LOCAL_ImportFunctorHashTableSize = 0; LOCAL_ImportFunctorHashTableSize = 0;
free(LOCAL_ImportFunctorHashChain); free(LOCAL_ImportFunctorHashChain);
LOCAL_ImportFunctorHashChain = NULL; LOCAL_ImportFunctorHashChain = NULL;
for (i=0; i < LOCAL_ImportAtomHashTableSize; i++) { for (i = 0; i < LOCAL_ImportAtomHashTableSize; i++) {
import_atom_hash_entry_t *a = LOCAL_ImportAtomHashChain[i]; import_atom_hash_entry_t *a = LOCAL_ImportAtomHashChain[i];
while (a) { while (a) {
import_atom_hash_entry_t *a0 = a; import_atom_hash_entry_t *a0 = a;
@ -379,7 +354,7 @@ CloseHash(void)
LOCAL_ImportAtomHashTableSize = 0; LOCAL_ImportAtomHashTableSize = 0;
free(LOCAL_ImportAtomHashChain); free(LOCAL_ImportAtomHashChain);
LOCAL_ImportAtomHashChain = NULL; LOCAL_ImportAtomHashChain = NULL;
for (i=0; i < LOCAL_ImportOPCODEHashTableSize; i++) { for (i = 0; i < LOCAL_ImportOPCODEHashTableSize; i++) {
import_opcode_hash_entry_t *a = LOCAL_ImportOPCODEHashChain[i]; import_opcode_hash_entry_t *a = LOCAL_ImportOPCODEHashChain[i];
while (a) { while (a) {
import_opcode_hash_entry_t *a0 = a; import_opcode_hash_entry_t *a0 = a;
@ -390,7 +365,7 @@ CloseHash(void)
LOCAL_ImportOPCODEHashTableSize = 0; LOCAL_ImportOPCODEHashTableSize = 0;
free(LOCAL_ImportOPCODEHashChain); free(LOCAL_ImportOPCODEHashChain);
LOCAL_ImportOPCODEHashChain = NULL; LOCAL_ImportOPCODEHashChain = NULL;
for (i=0; i < LOCAL_ImportPredEntryHashTableSize; i++) { for (i = 0; i < LOCAL_ImportPredEntryHashTableSize; i++) {
import_pred_entry_hash_entry_t *a = LOCAL_ImportPredEntryHashChain[i]; import_pred_entry_hash_entry_t *a = LOCAL_ImportPredEntryHashChain[i];
while (a) { while (a) {
import_pred_entry_hash_entry_t *a0 = a; import_pred_entry_hash_entry_t *a0 = a;
@ -401,13 +376,13 @@ CloseHash(void)
LOCAL_ImportPredEntryHashTableSize = 0; LOCAL_ImportPredEntryHashTableSize = 0;
free(LOCAL_ImportPredEntryHashChain); free(LOCAL_ImportPredEntryHashChain);
LOCAL_ImportPredEntryHashChain = NULL; LOCAL_ImportPredEntryHashChain = NULL;
for (i=0; i < LOCAL_ImportDBRefHashTableSize; i++) { for (i = 0; i < LOCAL_ImportDBRefHashTableSize; i++) {
import_dbref_hash_entry_t *a = LOCAL_ImportDBRefHashChain[i]; import_dbref_hash_entry_t *a = LOCAL_ImportDBRefHashChain[i];
while (a) { while (a) {
import_dbref_hash_entry_t *a0 = a; import_dbref_hash_entry_t *a0 = a;
#ifdef DEBUG #ifdef DEBUG
if (!a->count) { if (!a->count) {
fprintf(stderr,"WARNING: unused reference %p %p\n",a->val, a->oval); fprintf(stderr, "WARNING: unused reference %p %p\n", a->val, a->oval);
} }
#endif #endif
a = a->next; a = a->next;
@ -419,29 +394,18 @@ CloseHash(void)
LOCAL_ImportDBRefHashChain = NULL; LOCAL_ImportDBRefHashChain = NULL;
} }
static inline Atom static inline Atom AtomAdjust(Atom a) { return LookupAtom(a); }
AtomAdjust(Atom a)
{
return LookupAtom(a);
}
static inline Functor static inline Functor FuncAdjust(Functor f) {
FuncAdjust(Functor f)
{
return LookupFunctor(f); return LookupFunctor(f);
return f; return f;
} }
static inline Term AtomTermAdjust(Term t) {
static inline Term
AtomTermAdjust(Term t)
{
return MkAtomTerm(LookupAtom(AtomOfTerm(t))); return MkAtomTerm(LookupAtom(AtomOfTerm(t)));
} }
static inline Term static inline Term TermToGlobalOrAtomAdjust(Term t) {
TermToGlobalOrAtomAdjust(Term t)
{
if (t && IsAtomTerm(t)) if (t && IsAtomTerm(t))
return AtomTermAdjust(t); return AtomTermAdjust(t);
return t; return t;
@ -471,9 +435,7 @@ TermToGlobalOrAtomAdjust(Term t)
#define MFileAdjust(P) (P) #define MFileAdjust(P) (P)
#define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS) #define CodeVarAdjust(P) CodeVarAdjust__(P PASS_REGS)
static inline Term static inline Term CodeVarAdjust__(Term var USES_REGS) {
CodeVarAdjust__ (Term var USES_REGS)
{
if (var == 0L) if (var == 0L)
return var; return var;
return (Term)(CharP(var) + LOCAL_HDiff); return (Term)(CharP(var) + LOCAL_HDiff);
@ -484,25 +446,17 @@ CodeVarAdjust__ (Term var USES_REGS)
#define DoubleInCodeAdjust(P) #define DoubleInCodeAdjust(P)
#define IntegerInCodeAdjust(Pxb) #define IntegerInCodeAdjust(Pxb)
static inline PredEntry * static inline PredEntry *PtoPredAdjust(PredEntry *p) {
PtoPredAdjust(PredEntry *p)
{
return LookupPredEntry(p); return LookupPredEntry(p);
} }
static inline PredEntry * static inline PredEntry *PredEntryAdjust(PredEntry *p) {
PredEntryAdjust(PredEntry *p)
{
return LookupPredEntry(p); return LookupPredEntry(p);
} }
static inline OPCODE static inline OPCODE OpcodeAdjust(OPCODE OP) { return LookupOPCODE(OP); }
OpcodeAdjust(OPCODE OP) {
return LookupOPCODE(OP);
}
static inline Term static inline Term ModuleAdjust(Term M) {
ModuleAdjust(Term M) {
if (!M) if (!M)
return M; return M;
return AtomTermAdjust(M); return AtomTermAdjust(M);
@ -515,30 +469,22 @@ ModuleAdjust(Term M) {
#define GlobalEntryAdjust(P) (P) #define GlobalEntryAdjust(P) (P)
#define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS) #define BlobTermInCodeAdjust(P) BlobTermInCodeAdjust__(P PASS_REGS)
#if TAGS_FAST_OPS #if TAGS_FAST_OPS
static inline Term static inline Term BlobTermInCodeAdjust__(Term t USES_REGS) {
BlobTermInCodeAdjust__ (Term t USES_REGS) return (Term)((char *)(t)-LOCAL_HDiff);
{
return (Term) ((char *)(t) - LOCAL_HDiff);
} }
#else #else
static inline Term static inline Term BlobTermInCodeAdjust__(Term t USES_REGS) {
BlobTermInCodeAdjust__ (Term t USES_REGS) return (Term)((char *)(t) + LOCAL_HDiff);
{
return (Term) ((char *)(t) + LOCAL_HDiff);
} }
#endif #endif
#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS) #define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS)
static inline DBTerm * static inline DBTerm *DBTermAdjust__(DBTerm *dbtp USES_REGS) {
DBTermAdjust__ (DBTerm * dbtp USES_REGS) return (DBTerm *)(CharP(dbtp) + LOCAL_HDiff);
{
return (DBTerm *) (CharP (dbtp) + LOCAL_HDiff);
} }
#define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS) #define CellPtoHeapAdjust(P) CellPtoHeapAdjust__(P PASS_REGS)
static inline CELL * static inline CELL *CellPtoHeapAdjust__(CELL *dbtp USES_REGS) {
CellPtoHeapAdjust__ (CELL * dbtp USES_REGS) return (CELL *)(CharP(dbtp) + LOCAL_HDiff);
{
return (CELL *) (CharP (dbtp) + LOCAL_HDiff);
} }
#define PtoAtomHashEntryAdjust(P) (P) #define PtoAtomHashEntryAdjust(P) (P)
@ -551,17 +497,13 @@ CellPtoHeapAdjust__ (CELL * dbtp USES_REGS)
#define GlobalAdjust(P) (P) #define GlobalAdjust(P) (P)
#define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS) #define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS)
static inline DBRef static inline DBRef DBRefAdjust__(DBRef dbtp, int do_reference USES_REGS) {
DBRefAdjust__ (DBRef dbtp, int do_reference USES_REGS)
{
return LookupDBRef(dbtp, do_reference); return LookupDBRef(dbtp, do_reference);
} }
#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS) #define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)
static inline DBRef * static inline DBRef *DBRefPAdjust__(DBRef *dbtp USES_REGS) {
DBRefPAdjust__ (DBRef * dbtp USES_REGS) return (DBRef *)((char *)(dbtp) + LOCAL_HDiff);
{
return (DBRef *) ((char *)(dbtp) + LOCAL_HDiff);
} }
#define LUIndexAdjust(P) (P) #define LUIndexAdjust(P) (P)
@ -572,10 +514,8 @@ DBRefPAdjust__ (DBRef * dbtp USES_REGS)
#define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS) #define PtoLUCAdjust(P) PtoLUCAdjust__(P PASS_REGS)
#define PtoLUClauseAdjust(P) PtoLUCAdjust__(P PASS_REGS) #define PtoLUClauseAdjust(P) PtoLUCAdjust__(P PASS_REGS)
static inline LogUpdClause * static inline LogUpdClause *PtoLUCAdjust__(LogUpdClause *dbtp USES_REGS) {
PtoLUCAdjust__ (LogUpdClause * dbtp USES_REGS) return (LogUpdClause *)((char *)(dbtp) + LOCAL_HDiff);
{
return (LogUpdClause *) ((char *)(dbtp) + LOCAL_HDiff);
} }
#define PtoStCAdjust(P) (P) #define PtoStCAdjust(P) (P)
@ -587,13 +527,11 @@ PtoLUCAdjust__ (LogUpdClause * dbtp USES_REGS)
#define PtoLocAdjust(P) (P) #define PtoLocAdjust(P) (P)
#define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS) #define PtoHeapCellAdjust(P) PtoHeapCellAdjust__(P PASS_REGS)
static inline CELL * static inline CELL *PtoHeapCellAdjust__(CELL *ptr USES_REGS) {
PtoHeapCellAdjust__ (CELL * ptr USES_REGS)
{
LogUpdClause *out; LogUpdClause *out;
if ((out = LookupMayFailDBRef((DBRef)ptr))) if ((out = LookupMayFailDBRef((DBRef)ptr)))
return (CELL *)out; return (CELL *)out;
return (CELL *) (CharP (ptr) + LOCAL_HDiff); return (CELL *)(CharP(ptr) + LOCAL_HDiff);
} }
#define TermToGlobalAdjust(P) (P) #define TermToGlobalAdjust(P) (P)
@ -602,7 +540,7 @@ static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) {
if (ptr) { if (ptr) {
if (ptr == LOCAL_ImportFAILCODE) if (ptr == LOCAL_ImportFAILCODE)
return FAILCODE; return FAILCODE;
return (yamop *) ((char *) (ptr) + LOCAL_HDiff); return (yamop *)((char *)(ptr) + LOCAL_HDiff);
} }
return ptr; return ptr;
} }
@ -615,10 +553,8 @@ static inline yamop *PtoOpAdjust__(yamop *ptr USES_REGS) {
#define TrailAddrAdjust(P) (P) #define TrailAddrAdjust(P) (P)
#if PRECOMPUTE_REGADDRESS #if PRECOMPUTE_REGADDRESS
#define XAdjust(P) XAdjust__(P PASS_REGS) #define XAdjust(P) XAdjust__(P PASS_REGS)
static inline wamreg static inline wamreg XAdjust__(wamreg reg USES_REGS) {
XAdjust__ (wamreg reg USES_REGS) return (wamreg)((wamreg)((reg) + LOCAL_XDiff));
{
return (wamreg) ((wamreg) ((reg) + LOCAL_XDiff));
} }
#else #else
#define XAdjust(X) (X) #define XAdjust(X) (X)
@ -638,144 +574,115 @@ XAdjust__ (wamreg reg USES_REGS)
#define Yap_op_from_opcode(OP) OpcodeID(OP) #define Yap_op_from_opcode(OP) OpcodeID(OP)
static void RestoreFlags( UInt NFlags ) static void RestoreFlags(UInt NFlags) {}
{
}
#include "rheap.h" #include "rheap.h"
static void static void RestoreHashPreds(USES_REGS1) {}
RestoreHashPreds( USES_REGS1 )
{
}
static void RestoreAtomList(Atom atm USES_REGS) {}
static void static size_t read_bytes(FILE *stream, void *ptr, size_t sz) {
RestoreAtomList(Atom atm USES_REGS)
{
}
static size_t
read_bytes(FILE *stream, void *ptr, size_t sz)
{
return fread(ptr, sz, 1, stream); return fread(ptr, sz, 1, stream);
} }
static unsigned char static unsigned char read_byte(FILE *stream) { return getc(stream); }
read_byte(FILE *stream)
{
return getc(stream);
}
static BITS16 static BITS16 read_bits16(FILE *stream) {
read_bits16(FILE *stream)
{
BITS16 v; BITS16 v;
read_bytes(stream, &v, sizeof(BITS16)); read_bytes(stream, &v, sizeof(BITS16));
return v; return v;
} }
static UInt static UInt read_UInt(FILE *stream) {
read_UInt(FILE *stream)
{
UInt v; UInt v;
read_bytes(stream, &v, sizeof(UInt)); read_bytes(stream, &v, sizeof(UInt));
return v; return v;
} }
static Int static Int read_Int(FILE *stream) {
read_Int(FILE *stream)
{
Int v; Int v;
read_bytes(stream, &v, sizeof(Int)); read_bytes(stream, &v, sizeof(Int));
return v; return v;
} }
static qlf_tag_t static qlf_tag_t read_tag(FILE *stream) {
read_tag(FILE *stream)
{
int ch = read_byte(stream); int ch = read_byte(stream);
return ch; return ch;
} }
static pred_flags_t static pred_flags_t read_predFlags(FILE *stream) {
read_predFlags(FILE *stream)
{
pred_flags_t v; pred_flags_t v;
read_bytes(stream, &v, sizeof(pred_flags_t)); read_bytes(stream, &v, sizeof(pred_flags_t));
return v; return v;
} }
static bool static bool checkChars(FILE *stream, char s[]) {
checkChars(FILE *stream, char s[])
{
int ch, c; int ch, c;
char *p = s; char *p = s;
while ((ch = *p++)) { while ((ch = *p++)) {
if ((c = read_byte(stream)) != ch ) { if ((c = read_byte(stream)) != ch) {
return false; return false;
} }
} }
return TRUE; return TRUE;
} }
static Atom static Atom do_header(FILE *stream) {
do_header(FILE *stream)
{
char s[256], *p = s, ch; char s[256], *p = s, ch;
Atom at; Atom at;
if (!checkChars( stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-" )) if (!checkChars(stream, "#!/bin/sh\nexec_dir=${YAPBINDIR:-"))
return NIL; return NIL;
while ((ch = read_byte(stream)) != '\n'); while ((ch = read_byte(stream)) != '\n')
if (!checkChars( stream, "exec $exec_dir/yap $0 \"$@\"\nsaved " )) ;
if (!checkChars(stream, "exec $exec_dir/yap $0 \"$@\"\nsaved "))
return NIL; return NIL;
while ((ch = read_byte(stream)) != ',') while ((ch = read_byte(stream)) != ',')
*p++ = ch; *p++ = ch;
*p++ = '\0'; *p++ = '\0';
at = Yap_LookupAtom( s ); at = Yap_LookupAtom(s);
while ((ch = read_byte(stream))); while ((ch = read_byte(stream)))
;
return at; return at;
} }
static Int static Int get_header(USES_REGS1) {
get_header( USES_REGS1 )
{
FILE *stream; FILE *stream;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
Atom at; Atom at;
Int rc; Int rc;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3"); Yap_Error(INSTANTIATION_ERROR, t1, "read_program/3");
return FALSE; return FALSE;
} }
if (!(stream = Yap_GetInputStream(t1, "header scanning in qload")) ) { if (!(stream = Yap_GetInputStream(t1, "header scanning in qload"))) {
return FALSE; return FALSE;
} }
if ((at = do_header( stream )) == NIL) if ((at = do_header(stream)) == NIL)
rc = FALSE; rc = FALSE;
else rc = Yap_unify( ARG2, MkAtomTerm( at ) ); else
rc = Yap_unify(ARG2, MkAtomTerm(at));
return rc; return rc;
} }
static void static void ReadHash(FILE *stream) {
ReadHash(FILE *stream)
{
CACHE_REGS CACHE_REGS
UInt i; UInt i;
RCHECK(read_tag(stream) == QLY_START_X); RCHECK(read_tag(stream) == QLY_START_X);
LOCAL_XDiff = (char *)(&ARG1) - (char *)read_UInt(stream); LOCAL_XDiff = (char *)(&ARG1) - (char *)read_UInt(stream);
RCHECK(read_tag(stream) == QLY_START_OPCODES); RCHECK(read_tag(stream) == QLY_START_OPCODES);
RCHECK(read_Int(stream) == _std_top); RCHECK(read_Int(stream) == _std_top);
for (i= 0; i <= _std_top; i++) { for (i = 0; i <= _std_top; i++) {
InsertOPCODE((OPCODE)read_UInt(stream), i, Yap_opcode(i)); InsertOPCODE((OPCODE)read_UInt(stream), i, Yap_opcode(i));
} }
RCHECK(read_tag(stream) == QLY_START_ATOMS); RCHECK(read_tag(stream) == QLY_START_ATOMS);
LOCAL_ImportAtomHashTableNum = read_UInt(stream); LOCAL_ImportAtomHashTableNum = read_UInt(stream);
LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum*2; LOCAL_ImportAtomHashTableSize = LOCAL_ImportAtomHashTableNum * 2;
LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *)); LOCAL_ImportAtomHashChain = (import_atom_hash_entry_t **)calloc(
LOCAL_ImportAtomHashTableSize, sizeof(import_atom_hash_entry_t *));
for (i = 0; i < LOCAL_ImportAtomHashTableNum; i++) { for (i = 0; i < LOCAL_ImportAtomHashTableNum; i++) {
Atom oat = (Atom)read_UInt(stream); Atom oat = (Atom)read_UInt(stream);
Atom at; Atom at;
@ -786,27 +693,31 @@ ReadHash(FILE *stream)
UInt len; UInt len;
len = read_UInt(stream); len = read_UInt(stream);
if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE); if (!EnoughTempSpace(len))
read_bytes(stream, rep, (len+1)*sizeof(wchar_t)); QLYR_ERROR(OUT_OF_TEMP_SPACE);
read_bytes(stream, rep, (len + 1) * sizeof(wchar_t));
while (!(at = Yap_LookupWideAtom(rep))) { while (!(at = Yap_LookupWideAtom(rep))) {
if (!Yap_growheap(FALSE, 0, NULL)) { if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1); exit(1);
} }
} }
if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE); if (at == NIL)
QLYR_ERROR(OUT_OF_ATOM_SPACE);
} else if (tg == QLY_ATOM) { } else if (tg == QLY_ATOM) {
char *rep = (char *)AllocTempSpace(); char *rep = (char *)AllocTempSpace();
UInt len; UInt len;
len = read_UInt(stream); len = read_UInt(stream);
if (!EnoughTempSpace(len)) QLYR_ERROR(OUT_OF_TEMP_SPACE); if (!EnoughTempSpace(len))
read_bytes(stream, rep, (len+1)*sizeof(char)); QLYR_ERROR(OUT_OF_TEMP_SPACE);
read_bytes(stream, rep, (len + 1) * sizeof(char));
while (!(at = Yap_FullLookupAtom(rep))) { while (!(at = Yap_FullLookupAtom(rep))) {
if (!Yap_growheap(FALSE, 0, NULL)) { if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1); exit(1);
} }
} }
if (at == NIL) QLYR_ERROR(OUT_OF_ATOM_SPACE); if (at == NIL)
QLYR_ERROR(OUT_OF_ATOM_SPACE);
} else { } else {
QLYR_ERROR(BAD_ATOM); QLYR_ERROR(BAD_ATOM);
return; return;
@ -816,8 +727,9 @@ ReadHash(FILE *stream)
/* functors */ /* functors */
RCHECK(read_tag(stream) == QLY_START_FUNCTORS); RCHECK(read_tag(stream) == QLY_START_FUNCTORS);
LOCAL_ImportFunctorHashTableNum = read_UInt(stream); LOCAL_ImportFunctorHashTableNum = read_UInt(stream);
LOCAL_ImportFunctorHashTableSize = 2*LOCAL_ImportFunctorHashTableNum; LOCAL_ImportFunctorHashTableSize = 2 * LOCAL_ImportFunctorHashTableNum;
LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *)); LOCAL_ImportFunctorHashChain = (import_functor_hash_entry_t **)calloc(
LOCAL_ImportFunctorHashTableSize, sizeof(import_functor_hash_entry_t *));
for (i = 0; i < LOCAL_ImportFunctorHashTableNum; i++) { for (i = 0; i < LOCAL_ImportFunctorHashTableNum; i++) {
Functor of = (Functor)read_UInt(stream); Functor of = (Functor)read_UInt(stream);
UInt arity = read_UInt(stream); UInt arity = read_UInt(stream);
@ -833,8 +745,10 @@ ReadHash(FILE *stream)
} }
RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES); RCHECK(read_tag(stream) == QLY_START_PRED_ENTRIES);
LOCAL_ImportPredEntryHashTableNum = read_UInt(stream); LOCAL_ImportPredEntryHashTableNum = read_UInt(stream);
LOCAL_ImportPredEntryHashTableSize = 2*LOCAL_ImportPredEntryHashTableNum; LOCAL_ImportPredEntryHashTableSize = 2 * LOCAL_ImportPredEntryHashTableNum;
LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc( LOCAL_ImportPredEntryHashTableSize, sizeof(import_pred_entry_hash_entry_t *)); LOCAL_ImportPredEntryHashChain = (import_pred_entry_hash_entry_t **)calloc(
LOCAL_ImportPredEntryHashTableSize,
sizeof(import_pred_entry_hash_entry_t *));
for (i = 0; i < LOCAL_ImportPredEntryHashTableNum; i++) { for (i = 0; i < LOCAL_ImportPredEntryHashTableNum; i++) {
PredEntry *ope = (PredEntry *)read_UInt(stream), *pe; PredEntry *ope = (PredEntry *)read_UInt(stream), *pe;
UInt arity = read_UInt(stream); UInt arity = read_UInt(stream);
@ -843,7 +757,8 @@ ReadHash(FILE *stream)
if (omod) { if (omod) {
mod = MkAtomTerm(AtomAdjust(omod)); mod = MkAtomTerm(AtomAdjust(omod));
if (mod == TermProlog) mod = 0; if (mod == TermProlog)
mod = 0;
} else { } else {
mod = TermProlog; mod = TermProlog;
} }
@ -852,7 +767,7 @@ ReadHash(FILE *stream)
if (arity) { if (arity) {
Functor of = (Functor)read_UInt(stream); Functor of = (Functor)read_UInt(stream);
Functor f = LookupFunctor(of); Functor f = LookupFunctor(of);
while(!(pe = RepPredProp(PredPropByFuncAndMod(f,mod)))) { while (!(pe = RepPredProp(PredPropByFuncAndMod(f, mod)))) {
if (!Yap_growheap(FALSE, 0, NULL)) { if (!Yap_growheap(FALSE, 0, NULL)) {
exit(1); exit(1);
} }
@ -860,7 +775,7 @@ ReadHash(FILE *stream)
} else { } else {
Atom oa = (Atom)read_UInt(stream); Atom oa = (Atom)read_UInt(stream);
Atom a = LookupAtom(oa); Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtomAndMod(a,mod)); pe = RepPredProp(PredPropByAtomAndMod(a, mod));
} }
} else { } else {
/* IDB */ /* IDB */
@ -870,12 +785,12 @@ ReadHash(FILE *stream)
} else if (arity == (UInt)(-2)) { } else if (arity == (UInt)(-2)) {
Atom oa = (Atom)read_UInt(stream); Atom oa = (Atom)read_UInt(stream);
Atom a = LookupAtom(oa); Atom a = LookupAtom(oa);
pe = RepPredProp(PredPropByAtomAndMod(a,mod)); pe = RepPredProp(PredPropByAtomAndMod(a, mod));
pe->PredFlags |= AtomDBPredFlag; pe->PredFlags |= AtomDBPredFlag;
} else { } else {
Functor of = (Functor)read_UInt(stream); Functor of = (Functor)read_UInt(stream);
Functor f = LookupFunctor(of); Functor f = LookupFunctor(of);
pe = RepPredProp(PredPropByFuncAndMod(f,mod)); pe = RepPredProp(PredPropByFuncAndMod(f, mod));
} }
pe->PredFlags |= LogUpdatePredFlag; pe->PredFlags |= LogUpdatePredFlag;
pe->ArityOfPE = 3; pe->ArityOfPE = 3;
@ -888,8 +803,9 @@ ReadHash(FILE *stream)
} }
RCHECK(read_tag(stream) == QLY_START_DBREFS); RCHECK(read_tag(stream) == QLY_START_DBREFS);
LOCAL_ImportDBRefHashTableNum = read_UInt(stream); LOCAL_ImportDBRefHashTableNum = read_UInt(stream);
LOCAL_ImportDBRefHashTableSize = 2*LOCAL_ImportDBRefHashTableNum+17; LOCAL_ImportDBRefHashTableSize = 2 * LOCAL_ImportDBRefHashTableNum + 17;
LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *)); LOCAL_ImportDBRefHashChain = (import_dbref_hash_entry_t **)calloc(
LOCAL_ImportDBRefHashTableSize, sizeof(import_dbref_hash_entry_t *));
for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) { for (i = 0; i < LOCAL_ImportDBRefHashTableNum; i++) {
LogUpdClause *ocl = (LogUpdClause *)read_UInt(stream); LogUpdClause *ocl = (LogUpdClause *)read_UInt(stream);
UInt sz = read_UInt(stream); UInt sz = read_UInt(stream);
@ -900,14 +816,14 @@ ReadHash(FILE *stream)
} }
ncl->Id = FunctorDBRef; ncl->Id = FunctorDBRef;
ncl->ClRefCount = nrefs; ncl->ClRefCount = nrefs;
InsertDBRef((DBRef)ocl,(DBRef)ncl); InsertDBRef((DBRef)ocl, (DBRef)ncl);
} }
RCHECK(read_tag(stream) == QLY_FAILCODE); RCHECK(read_tag(stream) == QLY_FAILCODE);
LOCAL_ImportFAILCODE = (yamop *)read_UInt(stream); LOCAL_ImportFAILCODE = (yamop *)read_UInt(stream);
} }
static void static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) { pred_flags_t flags) {
CACHE_REGS CACHE_REGS
if (flags & LogUpdatePredFlag) { if (flags & LogUpdatePredFlag) {
/* first, clean up whatever was there */ /* first, clean up whatever was there */
@ -937,7 +853,7 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
read_bytes(stream, cl, size); read_bytes(stream, cl, size);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
cl->ClRefCount = nrefs; cl->ClRefCount = nrefs;
LOCAL_HDiff = (char *)cl-base; LOCAL_HDiff = (char *)cl - base;
RestoreLUClause(cl, pp PASS_REGS); RestoreLUClause(cl, pp PASS_REGS);
Yap_AssertzClause(pp, cl->ClCode); Yap_AssertzClause(pp, cl->ClCode);
} }
@ -951,12 +867,10 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
if (nclauses) { if (nclauses) {
Yap_Abolish(pp); Yap_Abolish(pp);
} }
LOCAL_HDiff = (char *)cl-base; LOCAL_HDiff = (char *)cl - base;
read_bytes(stream, cl, size); read_bytes(stream, cl, size);
cl->ClFlags = mask; cl->ClFlags = mask;
pp->cs.p_code.FirstClause = pp->cs.p_code.FirstClause = pp->cs.p_code.LastClause = cl->ClCode;
pp->cs.p_code.LastClause =
cl->ClCode;
pp->PredFlags |= MegaClausePredFlag; pp->PredFlags |= MegaClausePredFlag;
/* enter index mode */ /* enter index mode */
if (mask & ExoMask) { if (mask & ExoMask) {
@ -967,7 +881,8 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
} else { } else {
pp->OpcodeOfPred = INDEX_OPCODE; pp->OpcodeOfPred = INDEX_OPCODE;
} }
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred)); pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred =
(yamop *)(&(pp->OpcodeOfPred));
/* This must be set for restoremegaclause */ /* This must be set for restoremegaclause */
pp->cs.p_code.NOfClauses = nclauses; pp->cs.p_code.NOfClauses = nclauses;
RestoreMegaClause(cl PASS_REGS); RestoreMegaClause(cl PASS_REGS);
@ -979,7 +894,7 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
UInt size = read_UInt(stream); UInt size = read_UInt(stream);
DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size); DynamicClause *cl = (DynamicClause *)Yap_AlwaysAllocCodeSpace(size);
LOCAL_HDiff = (char *)cl-base; LOCAL_HDiff = (char *)cl - base;
read_bytes(stream, cl, size); read_bytes(stream, cl, size);
INIT_LOCK(cl->ClLock); INIT_LOCK(cl->ClLock);
RestoreDynamicClause(cl, pp PASS_REGS); RestoreDynamicClause(cl, pp PASS_REGS);
@ -989,7 +904,6 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
} else { } else {
UInt i; UInt i;
if (flags & SYSTEM_PRED_FLAGS) { if (flags & SYSTEM_PRED_FLAGS) {
if (nclauses) { if (nclauses) {
QLYR_ERROR(INCONSISTENT_CPRED); QLYR_ERROR(INCONSISTENT_CPRED);
@ -1002,7 +916,7 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
UInt size = read_UInt(stream); UInt size = read_UInt(stream);
StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size); StaticClause *cl = (StaticClause *)Yap_AlwaysAllocCodeSpace(size);
LOCAL_HDiff = (char *)cl-base; LOCAL_HDiff = (char *)cl - base;
read_bytes(stream, cl, size); read_bytes(stream, cl, size);
RestoreStaticClause(cl PASS_REGS); RestoreStaticClause(cl PASS_REGS);
Yap_AssertzClause(pp, cl->ClCode); Yap_AssertzClause(pp, cl->ClCode);
@ -1010,9 +924,8 @@ read_clauses(FILE *stream, PredEntry *pp, UInt nclauses, pred_flags_t flags) {
} }
} }
static void static void read_pred(FILE *stream, Term mod) {
read_pred(FILE *stream, Term mod) { pred_flags_t flags;
pred_flags_t flags, fl1;
UInt nclauses; UInt nclauses;
PredEntry *ap; PredEntry *ap;
@ -1039,8 +952,8 @@ read_pred(FILE *stream, Term mod) {
if (ap->PredFlags & IndexedPredFlag) { if (ap->PredFlags & IndexedPredFlag) {
Yap_RemoveIndexation(ap); Yap_RemoveIndexation(ap);
} }
//fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); // fl1 = flags & ((pred_flags_t)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
//ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS); // ap->PredFlags &= ~((UInt)STATIC_PRED_FLAGS|(UInt)EXTRA_PRED_FLAGS);
ap->PredFlags = flags & ~StatePredFlags; ap->PredFlags = flags & ~StatePredFlags;
if (flags & NumberDBPredFlag) { if (flags & NumberDBPredFlag) {
ap->src.IndxId = read_UInt(stream); ap->src.IndxId = read_UInt(stream);
@ -1059,7 +972,7 @@ read_pred(FILE *stream, Term mod) {
if (nclauses) if (nclauses)
read_clauses(stream, ap, nclauses, flags); read_clauses(stream, ap, nclauses, flags);
#if DEBUG #if DEBUG
//Yap_PrintPredName( ap ); // Yap_PrintPredName( ap );
#endif #endif
if (flags & HiddenPredFlag) { if (flags & HiddenPredFlag) {
@ -1067,8 +980,7 @@ read_pred(FILE *stream, Term mod) {
} }
} }
static void static void read_ops(FILE *stream) {
read_ops(FILE *stream) {
Int x; Int x;
while ((x = read_tag(stream)) != QLY_END_OPS) { while ((x = read_tag(stream)) != QLY_END_OPS) {
Atom at = (Atom)read_UInt(stream); Atom at = (Atom)read_UInt(stream);
@ -1086,9 +998,7 @@ read_ops(FILE *stream) {
} }
} }
static void read_module(FILE *stream) {
static void
read_module(FILE *stream) {
qlf_tag_t x; qlf_tag_t x;
InitHash(); InitHash();
@ -1107,84 +1017,75 @@ read_module(FILE *stream) {
CloseHash(); CloseHash();
} }
static Int static Int p_read_module_preds(USES_REGS1) {
p_read_module_preds( USES_REGS1 )
{
FILE *stream; FILE *stream;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"read_qly/3"); Yap_Error(INSTANTIATION_ERROR, t1, "read_qly/3");
return FALSE; return FALSE;
} }
if (!IsAtomTerm(t1)) { if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM,t1,"read_qly/3"); Yap_Error(TYPE_ERROR_ATOM, t1, "read_qly/3");
return(FALSE); return (FALSE);
} }
if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules")) ) { if (!(stream = Yap_GetInputStream(t1, "scanning preducate modules"))) {
return FALSE; return FALSE;
} }
read_module(stream); read_module(stream);
return TRUE; return TRUE;
} }
static void static void ReInitProlog(void) {
ReInitProlog(void)
{
Term t = MkAtomTerm(AtomInitProlog); Term t = MkAtomTerm(AtomInitProlog);
YAP_RunGoalOnce(t); YAP_RunGoalOnce(t);
} }
static Int qload_program(USES_REGS1) {
static Int
qload_program( USES_REGS1 )
{
FILE *stream; FILE *stream;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR,t1,"read_program/3"); Yap_Error(INSTANTIATION_ERROR, t1, "read_program/3");
return FALSE; return FALSE;
} }
if ((stream = Yap_GetInputStream(t1, "from read_program")) ) { if ((stream = Yap_GetInputStream(t1, "from read_program"))) {
return FALSE; return FALSE;
} }
Yap_Reset( YAP_RESET_FROM_RESTORE ); Yap_Reset(YAP_RESET_FROM_RESTORE);
if (do_header( stream ) == NIL) if (do_header(stream) == NIL)
return FALSE; return FALSE;
read_module(stream); read_module(stream);
fclose( stream ); fclose(stream);
/* back to the top level we go */ /* back to the top level we go */
ReInitProlog(); ReInitProlog();
return true; return true;
} }
int int Yap_Restore(const char *s, char *lib_dir) {
Yap_Restore(const char *s, char *lib_dir)
{
CACHE_REGS CACHE_REGS
FILE *stream = Yap_OpenRestore(s, lib_dir); FILE *stream = Yap_OpenRestore(s, lib_dir);
if (!stream) if (!stream)
return -1; return -1;
GLOBAL_RestoreFile = s; GLOBAL_RestoreFile = s;
if (do_header( stream ) == NIL) if (do_header(stream) == NIL)
return FALSE; return FALSE;
read_module(stream); read_module(stream);
fclose( stream ); fclose(stream);
GLOBAL_RestoreFile = NULL; GLOBAL_RestoreFile = NULL;
CurrentModule = USER_MODULE; LOCAL_SourceModule = CurrentModule = USER_MODULE;
return DO_ONLY_CODE; return DO_ONLY_CODE;
} }
void Yap_InitQLYR(void) {
void Yap_InitQLYR(void) Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds,
{ SyncPredFlag | UserCPredFlag | HiddenPredFlag);
Yap_InitCPred("$qload_module_preds", 1, p_read_module_preds, SyncPredFlag|UserCPredFlag|HiddenPredFlag); Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds,
Yap_InitCPred("$qload_file_preds", 1, p_read_module_preds, SyncPredFlag|HiddenPredFlag); SyncPredFlag | HiddenPredFlag);
Yap_InitCPred("$qload_program", 1, qload_program, SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$qload_program", 1, qload_program,
Yap_InitCPred("$q_header", 2, get_header, SyncPredFlag|HiddenPredFlag); SyncPredFlag | HiddenPredFlag);
Yap_InitCPred("$q_header", 2, get_header, SyncPredFlag | HiddenPredFlag);
if (FALSE) { if (FALSE) {
restore_codes(); restore_codes();
} }

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.
*/ */

1
C/stdpreds.c
View File

@ -1415,6 +1415,7 @@ 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);

9
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

71
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;
@ -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;
} }