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

call_cleanup in C plus indenting

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

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

3
C/absmi_insts.i
View File

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

199
C/c_interface.c
View File

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

174
C/cp_absmi_insts.h
View File

@ -42,7 +42,7 @@
restore_yaam_regs(PREG->y_u.Otapl.d);
restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -61,19 +61,18 @@
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
}
else
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.Otapl.s);
/* After trust, cut should be pointing at the new top
/* After trust, cut should be pointing at the new top
* choicepoint */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -112,13 +111,14 @@
CACHE_Y(YREG);
{
struct index_t *i = (struct index_t *)(PREG->y_u.lp.l);
S_YREG[-1] = (CELL)LINK_TO_ADDRESS(i,i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]);
S_YREG[-1] =
(CELL)LINK_TO_ADDRESS(i, i->links[EXO_ADDRESS_TO_OFFSET(i, SREG)]);
}
S_YREG--;
/* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0);
store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut.
*/
@ -128,7 +128,7 @@
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG);
ENDCACHE_Y();
GONext();
@ -147,7 +147,7 @@
/* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0);
store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut.
*/
@ -157,7 +157,7 @@
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG);
ENDCACHE_Y();
GONext();
@ -171,14 +171,12 @@
* register, but sometimes (X86) not. In this case, have a
* new register to point at YREG =*/
CACHE_Y(YREG);
{
S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */
}
{ S_YREG[-1] = (CELL)SREG; /* the udi code did S = (CELL*)judyp; */ }
S_YREG--;
/* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0);
store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut.
*/
@ -188,7 +186,7 @@
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG);
ENDCACHE_Y();
GONext();
@ -206,14 +204,14 @@
{
struct index_t *i = (struct index_t *)(PREG->y_u.lp.l);
SREG = i->cls;
S_YREG[-2] = (CELL)(SREG+i->arity);
S_YREG[-1] = (CELL)(SREG+i->arity*i->nels);
S_YREG[-2] = (CELL)(SREG + i->arity);
S_YREG[-1] = (CELL)(SREG + i->arity * i->nels);
}
S_YREG-=2;
S_YREG -= 2;
/* store arguments for procedure */
store_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
/* store abstract machine registers */
store_yaam_regs(NEXTOP(PREG,lp), 0);
store_yaam_regs(NEXTOP(PREG, lp), 0);
/* On a try_me, set cut to point at previous choicepoint,
* that is, to the B before the cut.
*/
@ -223,7 +221,7 @@
#ifdef YAPOR
SCH_set_load(B_YREG);
#endif /* YAPOR */
PREG = NEXTOP(NEXTOP(PREG, lp),lp);
PREG = NEXTOP(NEXTOP(PREG, lp), lp);
SET_BB(B_YREG);
ENDCACHE_Y();
GONext();
@ -235,9 +233,10 @@
CACHE_Y(B);
{
struct index_t *it = (struct index_t *)(PREG->y_u.lp.l);
BITS32 offset = ADDRESS_TO_LINK(it,(BITS32 *)((CELL *)(B+1))[it->arity]);
BITS32 offset =
ADDRESS_TO_LINK(it, (BITS32 *)((CELL *)(B + 1))[it->arity]);
d0 = it->links[offset];
((CELL *)(B+1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0);
((CELL *)(B + 1))[it->arity] = (CELL)LINK_TO_ADDRESS(it, d0);
SREG = EXO_OFFSET_TO_ADDRESS(it, offset);
}
if (d0) {
@ -246,7 +245,7 @@
restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -258,7 +257,7 @@
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
@ -266,10 +265,10 @@
{
pop_yaam_regs();
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 */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -299,7 +298,7 @@
restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -311,7 +310,7 @@
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
@ -319,10 +318,10 @@
{
pop_yaam_regs();
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 */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -338,7 +337,8 @@
BEGD(d0);
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 */
saveregs();
d0 = 0L; // Yap_UDI_NextAlt(jp);
@ -354,7 +354,7 @@
restore_yaam_regs(PREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -366,7 +366,7 @@
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.lp.p->ArityOfPE);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
@ -374,10 +374,10 @@
{
pop_yaam_regs();
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 */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -394,17 +394,17 @@
CACHE_Y(B);
{
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];
d0 = (SREG+arity != (CELL *)extras[arity+1]);
d0 = (SREG + arity != (CELL *)extras[arity + 1]);
if (d0) {
extras[arity] = (CELL)(SREG+arity);
extras[arity] = (CELL)(SREG + arity);
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */
restore_yaam_regs(PREG);
restore_at_least_one_arg(arity);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -416,7 +416,7 @@
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(arity);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
} else
@ -424,10 +424,10 @@
{
pop_yaam_regs();
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 */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -472,7 +472,7 @@
restore_yaam_regs(PREG->y_u.Otapl.d);
restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -491,19 +491,18 @@
SCH_last_alternative(PREG, B_YREG);
restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
}
else
} else
#endif /* YAPOR */
{
pop_yaam_regs();
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 */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -528,14 +527,14 @@
LOCAL_ReductionsCounter--;
if (LOCAL_ReductionsCounter == 0 && LOCAL_ReductionsCounterOn) {
saveregs();
Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(CALL_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
@ -553,7 +552,7 @@
/* act as if we had backtracked */
ENV = B->cp_env;
saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
@ -561,7 +560,7 @@
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
ENV = B->cp_env;
saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
@ -574,10 +573,10 @@
CACHE_Y(B);
restore_yaam_regs(PREG->y_u.Otapl.d);
restore_args(PREG->y_u.Otapl.s);
/* After retry, cut should be pointing at the parent
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -590,14 +589,14 @@
LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0 && LOCAL_RetriesCounterOn) {
saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0 && LOCAL_PredEntriesCounterOn) {
saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
@ -613,19 +612,18 @@
SCH_last_alternative(PREG, B_YREG);
restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
}
else
} else
#endif /* YAPOR */
{
pop_yaam_regs();
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 */
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
@ -634,14 +632,14 @@
LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0) {
saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0) {
saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
@ -662,24 +660,24 @@
Int sz = PREG->y_u.Osbpa.i;
UInt arity = PREG->y_u.Osbpa.p->ArityOfPE;
if (Unsigned(HR) + sz > Unsigned(YREG)-StackGap( PASS_REGS1 )) {
YENV[E_CP] = (CELL) CPREG;
YENV[E_E] = (CELL) ENV;
if (Unsigned(HR) + sz > Unsigned(YREG) - StackGap(PASS_REGS1)) {
YENV[E_CP] = (CELL)CPREG;
YENV[E_E] = (CELL)ENV;
#ifdef DEPTH_LIMIT
YENV[E_DEPTH] = DEPTH;
#endif /* DEPTH_LIMIT */
SET_ASP(YREG, PREG->y_u.Osbpa.s);
PREG = NEXTOP(PREG,Osbpa);
PREG = NEXTOP(PREG, Osbpa);
saveregs();
if (!Yap_gcl(sz, arity, YENV, PREG)) {
Yap_NilError(RESOURCE_ERROR_STACK,LOCAL_ErrorMessage);
Yap_NilError(RESOURCE_ERROR_STACK, LOCAL_ErrorMessage);
setregs();
FAIL();
} else {
setregs();
}
} else {
PREG = NEXTOP(PREG,Osbpa);
PREG = NEXTOP(PREG, Osbpa);
}
}
JMPNext();
@ -693,9 +691,9 @@
BOp(spy_or_trymark, Otapl);
PELOCK(5, ((PredEntry *)(PREG->y_u.Otapl.p)));
PREG = (yamop *)(&(((PredEntry *)(PREG->y_u.Otapl.p))->OpcodeOfPred));
UNLOCKPE(11,(PredEntry *)(PREG->y_u.Otapl.p));
UNLOCKPE(11, (PredEntry *)(PREG->y_u.Otapl.p));
saveregs();
spy_goal( PASS_REGS1 );
spy_goal(PASS_REGS1);
setregs();
ENDBOp();
@ -708,7 +706,7 @@
CUT_wait_leftmost();
#endif /* YAPOR */
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;
}
if (PREG->y_u.Otapl.p->CodeOfPred != PREG) {
@ -717,7 +715,7 @@
anything yet */
PP = NULL;
PREG = PREG->y_u.Otapl.p->CodeOfPred;
UNLOCKPE(12,PREG->y_u.Otapl.p);
UNLOCKPE(12, PREG->y_u.Otapl.p);
/* for profiler */
save_pc();
JMPNext();
@ -731,7 +729,7 @@
*/
LOCK(DynamicLock(PREG));
/* one can now mess around with the predicate */
UNLOCKPE(13,((PredEntry *)(PREG->y_u.Otapl.p)));
UNLOCKPE(13, ((PredEntry *)(PREG->y_u.Otapl.p)));
BEGD(d1);
d1 = PREG->y_u.Otapl.s;
store_args(d1);
@ -755,7 +753,7 @@
TRAIL_CLREF(ClauseCodeToDynamicClause(PREG));
}
#endif
PREG = NEXTOP(PREG,Otapl);
PREG = NEXTOP(PREG, Otapl);
JMPNext();
ENDBOp();
@ -764,14 +762,14 @@
LOCAL_RetriesCounter--;
if (LOCAL_RetriesCounter == 0) {
saveregs();
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(RETRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
LOCAL_PredEntriesCounter--;
if (LOCAL_PredEntriesCounter == 0) {
saveregs();
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT,"");
Yap_NilError(PRED_ENTRY_COUNTER_UNDERFLOW_EVENT, "");
setregs();
JMPNext();
}
@ -791,7 +789,7 @@
CUT_wait_leftmost();
#endif /* YAPOR */
/* need to make the DB stable until I get the new clause */
PELOCK(7,PREG->y_u.Otapl.p);
PELOCK(7, PREG->y_u.Otapl.p);
CACHE_Y(B);
PREG = PREG->y_u.Otapl.d;
LOCK(DynamicLock(PREG));
@ -799,7 +797,7 @@
restore_yaam_regs(PREG);
restore_args(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -821,7 +819,6 @@
JMPNext();
ENDBOp();
/************************************************************************\
* Try / Retry / Trust for main indexing blocks *
@ -915,7 +912,7 @@
restore_yaam_regs(NEXTOP(PREG, Otapl));
restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -933,7 +930,7 @@
ARG1 = B_YREG->cp_a1;
ARG2 = B_YREG->cp_a2;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -951,7 +948,7 @@
ARG2 = B_YREG->cp_a2;
ARG3 = B_YREG->cp_a3;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -970,7 +967,7 @@
ARG3 = B_YREG->cp_a3;
ARG4 = B_YREG->cp_a4;
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
@ -987,17 +984,16 @@
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
}
else
} else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(PREG->y_u.Otapl.s);
#ifdef FROZEN_STACKS
S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG);
S_YREG = (CELL *)PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}

31
C/errors.c
View File

@ -262,6 +262,18 @@ static void error_exit_yap(int value) {
#endif
}
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);
}
@ -370,7 +382,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
CELL nt[3];
Functor fun;
bool serious;
Term tf, error_t, comment, culprit = TermNil;
Term tf, error_t, comment;
char *format;
char s[MAXPATHLEN];
@ -470,8 +482,8 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
IsApplTerm(where) &&
FunctorOfTerm(where) == FunctorError) {
error_t = where;
Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE;
Yap_JumpToEnv(error_t);
LOCAL_PrologMode &= ~InErrorMode;
return P;
}
@ -596,25 +608,14 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode &= ~InErrorMode;
/* we might be in the middle of a critical region */
if (LOCAL_InterruptsDisabled) {
LOCAL_InterruptsDisabled = 0;
LOCAL_UncaughtThrow = TRUE;
Yap_RestartYap(1);
}
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
#endif
/* wait if we we are in user code,
it's up to her to decide */
fun = FunctorError;
if (LOCAL_PrologMode & UserCCallMode) {
error_t = Yap_MkApplTerm(fun, 2, nt);
if (!(EX = Yap_StoreTermInDB(error_t, 2))) {
/* fat chance */
Yap_RestartYap(1);
}
} else {
if (type == ABORT_EVENT) {
error_t = MkAtomTerm(AtomDAbort);
} else {
@ -622,7 +623,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
}
Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE;
}
LOCAL_PrologMode &= ~InErrorMode;
return P;

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

24
C/init.c
View File

@ -25,11 +25,12 @@ static char SccsId[] = "%W% %G%";
#define __INIT_C__ 1
#include <stdlib.h>
#include "Yap.h"
#include "alloc.h"
#include "clause.h"
#include "yapio.h"
#include "alloc.h"
#include <stdlib.h>
#include "Foreign.h"
#ifdef LOW_LEVEL_TRACER
@ -462,7 +463,7 @@ static UInt update_flags_from_prolog(UInt flags, PredEntry *pe) {
return flags;
}
void Yap_InitCPred(const char *Name, UInt Arity, CPredicate code,
void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code,
pred_flags_t flags) {
CACHE_REGS
Atom atom = NIL;
@ -606,7 +607,7 @@ bool Yap_AddCutToFli(PredEntry *pe, CPredicate CUT) {
}
}
void Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code,
void Yap_InitCmpPred(const char *Name, arity_t Arity, CmpPredicate cmp_code,
pred_flags_t flags) {
CACHE_REGS
Atom atom = NIL;
@ -685,7 +686,7 @@ void Yap_InitCmpPred(const char *Name, UInt Arity, CmpPredicate cmp_code,
p_code->y_u.l.l = cl->ClCode;
}
void Yap_InitAsmPred(const char *Name, UInt Arity, int code, CPredicate def,
void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def,
pred_flags_t flags) {
CACHE_REGS
Atom atom = NIL;
@ -825,18 +826,18 @@ static void CleanBack(PredEntry *pe, CPredicate Start, CPredicate Cont,
code->y_u.OtapFs.f = Cut;
}
void Yap_InitCPredBack(const char *Name, UInt Arity, unsigned int Extra,
CPredicate Start, CPredicate Cont, pred_flags_t flags) {
Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, NULL, flags);
void Yap_InitCPredBack(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Call, CPredicate Retry, pred_flags_t flags) {
Yap_InitCPredBack_(Name, Arity, Extra, Call, Retry, NULL, flags);
}
void Yap_InitCPredBackCut(const char *Name, UInt Arity, unsigned int Extra,
void Yap_InitCPredBackCut(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Start, CPredicate Cont, CPredicate Cut,
pred_flags_t flags) {
Yap_InitCPredBack_(Name, Arity, Extra, Start, Cont, Cut, flags);
}
void Yap_InitCPredBack_(const char *Name, UInt Arity, unsigned int Extra,
void Yap_InitCPredBack_(const char *Name, arity_t Arity, arity_t Extra,
CPredicate Start, CPredicate Cont, CPredicate Cut,
pred_flags_t flags) {
CACHE_REGS
@ -1022,8 +1023,7 @@ static void InitLogDBErasedMarker(void) {
LogDBErasedMarker->ClExt = NULL;
LogDBErasedMarker->ClPrev = NULL;
LogDBErasedMarker->ClNext = NULL;
LogDBErasedMarker->ClSize =
(UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e);
LogDBErasedMarker->ClSize = (UInt)NEXTOP(((LogUpdClause *)NULL)->ClCode, e);
LogDBErasedMarker->ClCode->opc = Yap_opcode(_op_fail);
INIT_CLREF_COUNT(LogDBErasedMarker);
}

65
C/modules.c
View File

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

433
C/qlyr.c
View File

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

15
C/save.c
View File

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

15
C/signals.c
View File

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

1
C/stdpreds.c
View File

@ -1415,6 +1415,7 @@ static Int p_break(USES_REGS1) {
return FALSE;
}
void Yap_InitBackCPreds(void) {
Yap_InitCPredBack("$current_predicate", 4, 1, current_predicate,
cont_current_predicate, SafePredFlag | SyncPredFlag);

9
C/tracer.c
View File

@ -19,12 +19,12 @@
#ifdef LOW_LEVEL_TRACER
#include "Yatom.h"
#include "YapHeap.h"
#include "Yatom.h"
#include "attvar.h"
#include "yapio.h"
#include "clause.h"
#include "tracer.h"
#include "yapio.h"
static void send_tracer_message(char *start, char *name, Int arity, char *mname,
CELL *args) {
@ -137,8 +137,8 @@ check_area(void)
}
*/
//PredEntry *old_p[10000];
//Term old_x1[10000], old_x2[10000], old_x3[10000];
// PredEntry *old_p[10000];
// Term old_x1[10000], old_x2[10000], old_x3[10000];
// static CELL oldv;
@ -321,6 +321,7 @@ void low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args) {
}
#endif
fprintf(stderr, "%lld %ld ", vsc_count, LCL0 - (CELL *)B);
fprintf(stderr, "%ld ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP);
#if defined(THREADS) || defined(YAPOR)
fprintf(stderr, "(%d)", worker_id);
#endif

71
C/write.c
View File

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