memory handling
This commit is contained in:
parent
a40fbe420f
commit
46d997713f
1370
C/atomic.c
1370
C/atomic.c
File diff suppressed because it is too large
Load Diff
424
C/exec.c
424
C/exec.c
|
@ -2006,9 +2006,11 @@ static Int JumpToEnv() {
|
|||
handler->cp_b != NULL) {
|
||||
handler = handler->cp_b;
|
||||
}
|
||||
pop_text_stack(1);
|
||||
if (LOCAL_PrologMode & AsyncIntMode) {
|
||||
Yap_signal(YAP_FAIL_SIGNAL);
|
||||
}
|
||||
|
||||
B = handler;
|
||||
P = FAILCODE;
|
||||
return true;
|
||||
|
@ -2016,7 +2018,7 @@ static Int JumpToEnv() {
|
|||
|
||||
bool Yap_JumpToEnv(Term t) {
|
||||
CACHE_REGS
|
||||
LOCAL_BallTerm = Yap_StoreTermInDB(t, 0);
|
||||
LOCAL_BallTerm = Yap_StoreTermInDB(t, 0);
|
||||
if (!LOCAL_BallTerm)
|
||||
return false;
|
||||
if (LOCAL_PrologMode & TopGoalMode)
|
||||
|
@ -2038,259 +2040,259 @@ static Int jump_env(USES_REGS1) {
|
|||
Term t1 = ArgOfTerm(1, t);
|
||||
if (IsApplTerm(t1) && IsAtomTerm((t2 = ArgOfTerm(1, t1)))) {
|
||||
LOCAL_ActiveError->errorAsText = AtomOfTerm(t2);
|
||||
LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t1));
|
||||
} else if (IsAtomTerm(t)) {
|
||||
LOCAL_ActiveError->errorAsText = AtomOfTerm(t1);
|
||||
LOCAL_ActiveError->classAsText = NULL;
|
||||
}
|
||||
} else {
|
||||
LOCAL_ActiveError->classAsText = NameOfFunctor(FunctorOfTerm(t1));
|
||||
} else if (IsAtomTerm(t)) {
|
||||
LOCAL_ActiveError->errorAsText = AtomOfTerm(t1);
|
||||
LOCAL_ActiveError->classAsText = NULL;
|
||||
}
|
||||
} else {
|
||||
Yap_find_prolog_culprit(PASS_REGS1);
|
||||
LOCAL_ActiveError->errorAsText = NULL;
|
||||
LOCAL_ActiveError->classAsText = NULL;
|
||||
//return true;
|
||||
//return true;
|
||||
}
|
||||
LOCAL_ActiveError->prologPredName = NULL;
|
||||
Yap_PutException(t);
|
||||
bool out = JumpToEnv(PASS_REGS1);
|
||||
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
|
||||
LCL0 - (CELL *)B > LOCAL_CBorder) {
|
||||
// we're failing up to the top layer
|
||||
}
|
||||
return out;
|
||||
}
|
||||
LOCAL_ActiveError->prologPredName = NULL;
|
||||
Yap_PutException(t);
|
||||
bool out = JumpToEnv(PASS_REGS1);
|
||||
if (B != NULL && P == FAILCODE && B->cp_ap == NOCODE &&
|
||||
LCL0 - (CELL *)B > LOCAL_CBorder) {
|
||||
// we're failing up to the top layer
|
||||
|
||||
/* set up a meta-call based on . context info */
|
||||
static Int generate_pred_info(USES_REGS1) {
|
||||
ARG1 = ARG3 = ENV[-EnvSizeInCells - 1];
|
||||
ARG4 = ENV[-EnvSizeInCells - 3];
|
||||
ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS);
|
||||
return TRUE;
|
||||
}
|
||||
return out;
|
||||
}
|
||||
|
||||
/* set up a meta-call based on . context info */
|
||||
static Int generate_pred_info(USES_REGS1) {
|
||||
ARG1 = ARG3 = ENV[-EnvSizeInCells - 1];
|
||||
ARG4 = ENV[-EnvSizeInCells - 3];
|
||||
ARG2 = cp_as_integer((choiceptr)ENV[E_CB] PASS_REGS);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
void Yap_InitYaamRegs(int myworker_id) {
|
||||
Term h0var;
|
||||
// getchar();
|
||||
void Yap_InitYaamRegs(int myworker_id) {
|
||||
Term h0var;
|
||||
// getchar();
|
||||
#if PUSH_REGS
|
||||
/* Guarantee that after a longjmp we go back to the original abstract
|
||||
machine registers */
|
||||
/* Guarantee that after a longjmp we go back to the original abstract
|
||||
machine registers */
|
||||
#ifdef THREADS
|
||||
if (myworker_id) {
|
||||
REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
|
||||
pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
|
||||
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
|
||||
}
|
||||
/* may be run by worker_id on behalf on myworker_id */
|
||||
if (myworker_id) {
|
||||
REGSTORE *rs = REMOTE_ThreadHandle(myworker_id).default_yaam_regs;
|
||||
pthread_setspecific(Yap_yaamregs_key, (const void *)rs);
|
||||
REMOTE_ThreadHandle(myworker_id).current_yaam_regs = rs;
|
||||
}
|
||||
/* may be run by worker_id on behalf on myworker_id */
|
||||
#else
|
||||
Yap_regp = &Yap_standard_regs;
|
||||
Yap_regp = &Yap_standard_regs;
|
||||
#endif
|
||||
#endif /* PUSH_REGS */
|
||||
CACHE_REGS
|
||||
Yap_ResetException(worker_id);
|
||||
Yap_PutValue(AtomBreak, MkIntTerm(0));
|
||||
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) +
|
||||
1; // +1: hack to ensure the gc does not try to mark mistakenly
|
||||
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
|
||||
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
|
||||
/* notice that an initial choice-point and environment
|
||||
*must* be created for the garbage collector to work */
|
||||
B = NULL;
|
||||
ENV = NULL;
|
||||
P = CP = YESCODE;
|
||||
CACHE_REGS
|
||||
Yap_ResetException(worker_id);
|
||||
Yap_PutValue(AtomBreak, MkIntTerm(0));
|
||||
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
HR = H0 = ((CELL *)REMOTE_GlobalBase(myworker_id)) +
|
||||
1; // +1: hack to ensure the gc does not try to mark mistakenly
|
||||
LCL0 = ASP = (CELL *)REMOTE_LocalBase(myworker_id);
|
||||
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id) - MinTrailGap);
|
||||
/* notice that an initial choice-point and environment
|
||||
*must* be created for the garbage collector to work */
|
||||
B = NULL;
|
||||
ENV = NULL;
|
||||
P = CP = YESCODE;
|
||||
#ifdef DEPTH_LIMIT
|
||||
DEPTH = RESET_DEPTH();
|
||||
DEPTH = RESET_DEPTH();
|
||||
#endif
|
||||
STATIC_PREDICATES_MARKED = FALSE;
|
||||
if (REMOTE_GlobalArena(myworker_id) == 0L ||
|
||||
REMOTE_GlobalArena(myworker_id) == TermNil) {
|
||||
} else {
|
||||
HR = RepAppl(REMOTE_GlobalArena(myworker_id));
|
||||
}
|
||||
REMOTE_GlobalArena(myworker_id) = TermNil;
|
||||
Yap_InitPreAllocCodeSpace(myworker_id);
|
||||
STATIC_PREDICATES_MARKED = FALSE;
|
||||
if (REMOTE_GlobalArena(myworker_id) == 0L ||
|
||||
REMOTE_GlobalArena(myworker_id) == TermNil) {
|
||||
} else {
|
||||
HR = RepAppl(REMOTE_GlobalArena(myworker_id));
|
||||
}
|
||||
REMOTE_GlobalArena(myworker_id) = TermNil;
|
||||
Yap_InitPreAllocCodeSpace(myworker_id);
|
||||
#ifdef FROZEN_STACKS
|
||||
H_FZ = HR;
|
||||
H_FZ = HR;
|
||||
#ifdef YAPOR_SBA
|
||||
BSEG =
|
||||
BSEG =
|
||||
#endif /* YAPOR_SBA */
|
||||
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
#endif /* FROZEN_STACKS */
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
/* the first real choice-point will also have AP=FAIL */
|
||||
/* always have an empty slots for people to use */
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
/* the first real choice-point will also have AP=FAIL */
|
||||
/* always have an empty slots for people to use */
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
LOCAL = REMOTE(myworker_id);
|
||||
worker_id = myworker_id;
|
||||
LOCAL = REMOTE(myworker_id);
|
||||
worker_id = myworker_id;
|
||||
#endif /* THREADS */
|
||||
#if COROUTINING
|
||||
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
#endif
|
||||
Yap_RebootSlots(myworker_id);
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
REMOTE_GcCurrentPhase(myworker_id) = 0L;
|
||||
REMOTE_GcPhase(myworker_id) =
|
||||
Yap_RebootSlots(myworker_id);
|
||||
h0var = MkVarTerm();
|
||||
REMOTE_GcGeneration(myworker_id) = Yap_NewTimedVar(h0var);
|
||||
REMOTE_GcCurrentPhase(myworker_id) = 0L;
|
||||
REMOTE_GcPhase(myworker_id) =
|
||||
Yap_NewTimedVar(MkIntTerm(REMOTE_GcCurrentPhase(myworker_id)));
|
||||
#if defined(YAPOR) || defined(THREADS)
|
||||
PP = NULL;
|
||||
PREG_ADDR = NULL;
|
||||
PP = NULL;
|
||||
PREG_ADDR = NULL;
|
||||
#endif
|
||||
Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id);
|
||||
cut_c_initialize(myworker_id);
|
||||
Yap_PrepGoal(0, NULL, NULL PASS_REGS);
|
||||
Yap_AllocateDefaultArena(128 * 1024, 2, myworker_id);
|
||||
cut_c_initialize(myworker_id);
|
||||
Yap_PrepGoal(0, NULL, NULL PASS_REGS);
|
||||
#ifdef FROZEN_STACKS
|
||||
H_FZ = HR;
|
||||
H_FZ = HR;
|
||||
#ifdef YAPOR_SBA
|
||||
BSEG =
|
||||
BSEG =
|
||||
#endif /* YAPOR_SBA */
|
||||
BBREG = B_FZ = (choiceptr)REMOTE_LocalBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
TR = TR_FZ = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
|
||||
#endif /* FROZEN_STACKS */
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
CalculateStackGap(PASS_REGS1);
|
||||
#ifdef TABLING
|
||||
/* ensure that LOCAL_top_dep_fr is always valid */
|
||||
if (REMOTE_top_dep_fr(myworker_id))
|
||||
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
|
||||
/* ensure that LOCAL_top_dep_fr is always valid */
|
||||
if (REMOTE_top_dep_fr(myworker_id))
|
||||
DepFr_cons_cp(REMOTE_top_dep_fr(myworker_id)) = NORM_CP(B);
|
||||
#endif
|
||||
}
|
||||
|
||||
Term Yap_GetException(void) {
|
||||
CACHE_REGS
|
||||
Term t = 0;
|
||||
|
||||
if (LOCAL_BallTerm) {
|
||||
t = Yap_PopTermFromDB(LOCAL_BallTerm);
|
||||
}
|
||||
LOCAL_BallTerm = NULL;
|
||||
return t;
|
||||
}
|
||||
|
||||
Term Yap_PeekException(void) { return Yap_FetchTermFromDB(LOCAL_BallTerm); }
|
||||
Term Yap_GetException(void) {
|
||||
CACHE_REGS
|
||||
Term t = 0;
|
||||
|
||||
if (LOCAL_BallTerm) {
|
||||
t = Yap_PopTermFromDB(LOCAL_BallTerm);
|
||||
}
|
||||
LOCAL_BallTerm = NULL;
|
||||
return t;
|
||||
}
|
||||
|
||||
Term Yap_PeekException(void) { return Yap_FetchTermFromDB(LOCAL_BallTerm); }
|
||||
|
||||
bool Yap_RaiseException(void) {
|
||||
if (LOCAL_BallTerm == NULL)
|
||||
return false;
|
||||
return JumpToEnv();
|
||||
}
|
||||
|
||||
bool Yap_PutException(Term t) {
|
||||
CACHE_REGS
|
||||
if ((LOCAL_BallTerm = Yap_StoreTermInDB(t, 0)) != NULL)
|
||||
return true;
|
||||
|
||||
bool Yap_RaiseException(void) {
|
||||
if (LOCAL_BallTerm == NULL)
|
||||
return false;
|
||||
return JumpToEnv();
|
||||
}
|
||||
}
|
||||
|
||||
bool Yap_PutException(Term t) {
|
||||
CACHE_REGS
|
||||
if ((LOCAL_BallTerm = Yap_StoreTermInDB(t, 0)) != NULL)
|
||||
bool Yap_ResetException(int wid) {
|
||||
if (REMOTE_ActiveError(wid)->errorTerm) {
|
||||
Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm);
|
||||
}
|
||||
REMOTE_ActiveError(wid)->errorTerm = NULL;
|
||||
return true;
|
||||
|
||||
return false;
|
||||
}
|
||||
|
||||
bool Yap_ResetException(int wid) {
|
||||
if (REMOTE_ActiveError(wid)->errorTerm) {
|
||||
Yap_PopTermFromDB(REMOTE_ActiveError(wid)->errorTerm);
|
||||
}
|
||||
REMOTE_ActiveError(wid)->errorTerm = NULL;
|
||||
return true;
|
||||
}
|
||||
|
||||
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
|
||||
static Int reset_exception(USES_REGS1) { return Yap_ResetException(worker_id); }
|
||||
|
||||
static Int get_exception(USES_REGS1) {
|
||||
Term t = Yap_GetException();
|
||||
if (t == 0)
|
||||
return false;
|
||||
return Yap_unify(t, ARG1);
|
||||
}
|
||||
|
||||
int Yap_dogc(int extra_args, Term *tp USES_REGS) {
|
||||
UInt arity;
|
||||
yamop *nextpc;
|
||||
int i;
|
||||
|
||||
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
||||
nextpc = P;
|
||||
} else {
|
||||
arity = 0;
|
||||
nextpc = CP;
|
||||
static Int get_exception(USES_REGS1) {
|
||||
Term t = Yap_GetException();
|
||||
if (t == 0)
|
||||
return false;
|
||||
return Yap_unify(t, ARG1);
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
XREGS[arity + i + 1] = tp[i];
|
||||
}
|
||||
if (!Yap_gc(arity + extra_args, ENV, nextpc)) {
|
||||
return FALSE;
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
tp[i] = XREGS[arity + i + 1];
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
void Yap_InitExecFs(void) {
|
||||
CACHE_REGS
|
||||
YAP_opaque_handler_t catcher_ops;
|
||||
memset(&catcher_ops, 0, sizeof(catcher_ops));
|
||||
catcher_ops.cut_handler = watch_cut;
|
||||
catcher_ops.fail_handler = watch_retry;
|
||||
setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
|
||||
int Yap_dogc(int extra_args, Term *tp USES_REGS) {
|
||||
UInt arity;
|
||||
yamop *nextpc;
|
||||
int i;
|
||||
|
||||
Term cm = CurrentModule;
|
||||
Yap_InitComma();
|
||||
Yap_InitCPred("$execute", 1, execute, 0);
|
||||
Yap_InitCPred("$execute", 2, execute2, 0);
|
||||
Yap_InitCPred("$execute", 3, execute3, 0);
|
||||
Yap_InitCPred("$execute", 4, execute4, 0);
|
||||
Yap_InitCPred("$execute", 5, execute5, 0);
|
||||
Yap_InitCPred("$execute", 6, execute6, 0);
|
||||
Yap_InitCPred("$execute", 7, execute7, 0);
|
||||
Yap_InitCPred("$execute", 8, execute8, 0);
|
||||
Yap_InitCPred("$execute", 9, execute9, 0);
|
||||
Yap_InitCPred("$execute", 10, execute10, 0);
|
||||
Yap_InitCPred("$execute", 11, execute11, 0);
|
||||
Yap_InitCPred("$execute", 12, execute12, 0);
|
||||
Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("call_with_args", 1, execute_0, 0);
|
||||
Yap_InitCPred("call_with_args", 2, execute_1, 0);
|
||||
Yap_InitCPred("call_with_args", 3, execute_2, 0);
|
||||
Yap_InitCPred("call_with_args", 4, execute_3, 0);
|
||||
Yap_InitCPred("call_with_args", 5, execute_4, 0);
|
||||
Yap_InitCPred("call_with_args", 6, execute_5, 0);
|
||||
Yap_InitCPred("call_with_args", 7, execute_6, 0);
|
||||
Yap_InitCPred("call_with_args", 8, execute_7, 0);
|
||||
Yap_InitCPred("call_with_args", 9, execute_8, 0);
|
||||
Yap_InitCPred("call_with_args", 10, execute_9, 0);
|
||||
Yap_InitCPred("call_with_args", 11, execute_10, 0);
|
||||
if (P && PREVOP(P, Osbpp)->opc == Yap_opcode(_call_usercpred)) {
|
||||
arity = PREVOP(P, Osbpp)->y_u.Osbpp.p->ArityOfPE;
|
||||
nextpc = P;
|
||||
} else {
|
||||
arity = 0;
|
||||
nextpc = CP;
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
XREGS[arity + i + 1] = tp[i];
|
||||
}
|
||||
if (!Yap_gc(arity + extra_args, ENV, nextpc)) {
|
||||
return FALSE;
|
||||
}
|
||||
for (i = 0; i < extra_args; i++) {
|
||||
tp[i] = XREGS[arity + i + 1];
|
||||
}
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
void Yap_InitExecFs(void) {
|
||||
CACHE_REGS
|
||||
YAP_opaque_handler_t catcher_ops;
|
||||
memset(&catcher_ops, 0, sizeof(catcher_ops));
|
||||
catcher_ops.cut_handler = watch_cut;
|
||||
catcher_ops.fail_handler = watch_retry;
|
||||
setup_call_catcher_cleanup_tag = YAP_NewOpaqueType(&catcher_ops);
|
||||
|
||||
Term cm = CurrentModule;
|
||||
Yap_InitComma();
|
||||
Yap_InitCPred("$execute", 1, execute, 0);
|
||||
Yap_InitCPred("$execute", 2, execute2, 0);
|
||||
Yap_InitCPred("$execute", 3, execute3, 0);
|
||||
Yap_InitCPred("$execute", 4, execute4, 0);
|
||||
Yap_InitCPred("$execute", 5, execute5, 0);
|
||||
Yap_InitCPred("$execute", 6, execute6, 0);
|
||||
Yap_InitCPred("$execute", 7, execute7, 0);
|
||||
Yap_InitCPred("$execute", 8, execute8, 0);
|
||||
Yap_InitCPred("$execute", 9, execute9, 0);
|
||||
Yap_InitCPred("$execute", 10, execute10, 0);
|
||||
Yap_InitCPred("$execute", 11, execute11, 0);
|
||||
Yap_InitCPred("$execute", 12, execute12, 0);
|
||||
Yap_InitCPred("$execute_in_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("$execute_wo_mod", 2, execute_in_mod, 0);
|
||||
Yap_InitCPred("call_with_args", 1, execute_0, 0);
|
||||
Yap_InitCPred("call_with_args", 2, execute_1, 0);
|
||||
Yap_InitCPred("call_with_args", 3, execute_2, 0);
|
||||
Yap_InitCPred("call_with_args", 4, execute_3, 0);
|
||||
Yap_InitCPred("call_with_args", 5, execute_4, 0);
|
||||
Yap_InitCPred("call_with_args", 6, execute_5, 0);
|
||||
Yap_InitCPred("call_with_args", 7, execute_6, 0);
|
||||
Yap_InitCPred("call_with_args", 8, execute_7, 0);
|
||||
Yap_InitCPred("call_with_args", 9, execute_8, 0);
|
||||
Yap_InitCPred("call_with_args", 10, execute_9, 0);
|
||||
Yap_InitCPred("call_with_args", 11, execute_10, 0);
|
||||
#ifdef DEPTH_LIMIT
|
||||
Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0);
|
||||
Yap_InitCPred("$execute_under_depth_limit", 2, execute_depth_limit, 0);
|
||||
#endif
|
||||
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
|
||||
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
|
||||
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("$ ", 1,
|
||||
current_choice_point, 0);
|
||||
CurrentModule = HACKS_MODULE;
|
||||
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
|
||||
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
|
||||
CurrentModule = cm;
|
||||
Yap_InitCPred("$restore_regs", 1, restore_regs,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$restore_regs", 2, restore_regs2,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
|
||||
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
|
||||
SafePredFlag);
|
||||
Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0);
|
||||
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
|
||||
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
|
||||
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
|
||||
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
|
||||
Yap_InitCPred("$get_exception", 1, get_exception, 0);
|
||||
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
|
||||
0);
|
||||
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
|
||||
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
|
||||
}
|
||||
Yap_InitCPred("$execute0", 2, execute0, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_nonstop", 2, execute_nonstop, NoTracePredFlag);
|
||||
Yap_InitCPred("$creep_step", 2, creep_step, NoTracePredFlag);
|
||||
Yap_InitCPred("$execute_clause", 4, execute_clause, NoTracePredFlag);
|
||||
Yap_InitCPred("$current_choice_point", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("$ ", 1,
|
||||
current_choice_point, 0);
|
||||
CurrentModule = HACKS_MODULE;
|
||||
Yap_InitCPred("current_choice_point", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("current_choicepoint", 1, current_choice_point, 0);
|
||||
Yap_InitCPred("env_choice_point", 1, save_env_b, 0);
|
||||
Yap_InitCPred("cut_at", 1, clean_ifcp, SafePredFlag);
|
||||
CurrentModule = cm;
|
||||
Yap_InitCPred("$restore_regs", 1, restore_regs,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$restore_regs", 2, restore_regs2,
|
||||
NoTracePredFlag | SafePredFlag);
|
||||
Yap_InitCPred("$clean_ifcp", 1, clean_ifcp, SafePredFlag);
|
||||
Yap_InitCPred("qpack_clean_up_to_disjunction", 0, cut_up_to_next_disjunction,
|
||||
SafePredFlag);
|
||||
Yap_InitCPred("$jump_env_and_store_ball", 1, jump_env, 0);
|
||||
Yap_InitCPred("$generate_pred_info", 4, generate_pred_info, 0);
|
||||
Yap_InitCPred("$reset_exception", 1, reset_exception, 0);
|
||||
Yap_InitCPred("_user_expand_goal", 2, _user_expand_goal, 0);
|
||||
Yap_InitCPred("$do_term_expansion", 2, do_term_expansion, 0);
|
||||
Yap_InitCPred("$get_exception", 1, get_exception, 0);
|
||||
Yap_InitCPred("$setup_call_catcher_cleanup", 1, setup_call_catcher_cleanup,
|
||||
0);
|
||||
Yap_InitCPred("$cleanup_on_exit", 2, cleanup_on_exit, 0);
|
||||
Yap_InitCPred("$tag_cleanup", 2, tag_cleanup, 0);
|
||||
}
|
||||
|
|
52
C/tracer.c
52
C/tracer.c
|
@ -1,19 +1,19 @@
|
|||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog @(#)amidefs.h 1.3 3/15/90
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: tracer.h *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: definitions for low level tracer *
|
||||
* *
|
||||
*************************************************************************/
|
||||
* *
|
||||
* YAP Prolog @(#)amidefs.h 1.3 3/15/90
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: tracer.h *
|
||||
* Last rev: *
|
||||
* mods: *
|
||||
* comments: definitions for low level tracer *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
#include "Yap.h"
|
||||
|
||||
|
@ -48,7 +48,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
|
|||
s = s1;
|
||||
expand = false;
|
||||
}
|
||||
min = 1024;
|
||||
min = 1024;
|
||||
if (name == NULL) {
|
||||
#ifdef YAPOR
|
||||
d = snprintf(s, max, "(%d)%s", worker_id, start);
|
||||
|
@ -81,7 +81,7 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
|
|||
if (max > 16) {
|
||||
*s++ = ',';
|
||||
*s++ = ' ';
|
||||
max-=2;
|
||||
max -= 2;
|
||||
} else {
|
||||
expand = true;
|
||||
continue;
|
||||
|
@ -95,18 +95,18 @@ static char *send_tracer_message(char *start, char *name, arity_t arity,
|
|||
}
|
||||
sz = strlen(sn);
|
||||
if (max <= sz) {
|
||||
min = sz + 1024;
|
||||
min = sz + 1024;
|
||||
expand = true;
|
||||
continue;
|
||||
}
|
||||
strcpy(s, sn);
|
||||
s += sz;
|
||||
max -= sz;
|
||||
max -= sz;
|
||||
}
|
||||
if (arity) {
|
||||
*s++ = ' ';
|
||||
*s++ = ')';
|
||||
max -= 2;
|
||||
max -= 2;
|
||||
}
|
||||
}
|
||||
} while (expand);
|
||||
|
@ -346,7 +346,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
|
|||
if (p == pe) {
|
||||
UNLOCK(Yap_heap_regs->low_level_trace_lock);
|
||||
pop_text_stack(l);
|
||||
ReleaseAndReturn(true);
|
||||
return (true);
|
||||
}
|
||||
if (env_ptr != NULL)
|
||||
env_ptr = (CELL *)(env_ptr[E_E]);
|
||||
|
@ -354,7 +354,8 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
|
|||
printf("\n");
|
||||
}
|
||||
#endif
|
||||
b += snprintf(b, top - b, "%llud "UInt_FORMAT " ", vsc_count, LCL0 - (CELL *)B);
|
||||
b += snprintf(b, top - b, "%llud " UInt_FORMAT " ", vsc_count,
|
||||
LCL0 - (CELL *)B);
|
||||
b += snprintf(b, top - b, Int_FORMAT " ", LCL0 - (CELL *)Yap_REGS.CUT_C_TOP);
|
||||
#if defined(THREADS) || defined(YAPOR)
|
||||
b += snprintf(b, top - b, "(%d)", worker_id);
|
||||
|
@ -363,12 +364,13 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
|
|||
if (pred == NULL) {
|
||||
UNLOCK(Yap_low_level_trace_lock);
|
||||
pop_text_stack(l);
|
||||
ReleaseAndReturn(true);
|
||||
return (true);
|
||||
}
|
||||
if (pred->ModuleOfPred == PROLOG_MODULE) {
|
||||
if (!LOCAL_do_trace_primitives) {
|
||||
UNLOCK(Yap_low_level_trace_lock);
|
||||
ReleaseAndReturn(true);
|
||||
pop_text_stack(l);
|
||||
return (true);
|
||||
}
|
||||
mname = "prolog";
|
||||
} else {
|
||||
|
@ -460,7 +462,7 @@ bool low_level_trace__(yap_low_level_port port, PredEntry *pred, CELL *args) {
|
|||
fputs(buf, stderr);
|
||||
#endif
|
||||
pop_text_stack(l);
|
||||
ReleaseAndReturn(true);
|
||||
return (true);
|
||||
}
|
||||
|
||||
void toggle_low_level_trace(void) {
|
||||
|
|
|
@ -390,7 +390,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) {
|
|||
wglb.stream = GLOBAL_Stream + sno;
|
||||
wrputf(f, &wglb);
|
||||
so = Yap_MemExportStreamPtr(sno);
|
||||
*s = Malloc( strlen(so)+1 );
|
||||
*s = BaseMalloc( strlen(so)+1 );
|
||||
strcpy(*s, so );
|
||||
Yap_CloseStream(sno);
|
||||
return true;
|
||||
|
|
|
@ -406,7 +406,7 @@ YAPListTerm::YAPListTerm(YAPTerm ts[], arity_t n)
|
|||
}
|
||||
}
|
||||
|
||||
const char *YAPAtom::getName(void) { return Yap_AtomToUTF8Text(a, nullptr); }
|
||||
const char *YAPAtom::getName(void) { return Yap_AtomToUTF8Text(a); }
|
||||
|
||||
void YAPQuery::openQuery(Term *ts)
|
||||
{
|
||||
|
@ -691,7 +691,7 @@ YAPQuery::YAPQuery(YAPTerm t) : YAPPredicate(t)
|
|||
if (IsApplTerm(tt)) {
|
||||
Functor f = FunctorOfTerm(tt);
|
||||
if (IsExtensionFunctor(f))
|
||||
nts = nullptr;
|
||||
nts = nullptr;
|
||||
nts = RepAppl(goal.term())+1;
|
||||
} else if (IsPairTerm(tt)) {
|
||||
nts = RepPair(tt);
|
||||
|
|
55
H/YapText.h
55
H/YapText.h
|
@ -31,31 +31,14 @@
|
|||
#include "../utf8proc/utf8proc.h"
|
||||
#include "Yap.h"
|
||||
|
||||
#define ReleaseAndReturn(r) \
|
||||
{ \
|
||||
pop_text_stack(l); \
|
||||
return r; \
|
||||
}
|
||||
#define release_cut_fail() \
|
||||
{ \
|
||||
pop_text_stack(l); \
|
||||
cut_fail(); \
|
||||
}
|
||||
#define release_cut_succeed() \
|
||||
{ \
|
||||
pop_text_stack(l); \
|
||||
cut_succeed(); \
|
||||
}
|
||||
|
||||
/// allocate a temporary text block
|
||||
///
|
||||
extern void *Malloc(size_t sz USES_REGS);
|
||||
extern void *Realloc(void *buf, size_t sz USES_REGS);
|
||||
extern void Free(void *buf USES_REGS);
|
||||
|
||||
extern int push_text_stack(USES_REGS1);
|
||||
extern int pop_text_stack(int lvl USES_REGS);
|
||||
extern void *export_block(int lvl, void *exp USES_REGS);
|
||||
extern void *MallocAtLevel(size_t sz, int atL USES_REGS);
|
||||
#define BaseMalloc(sz) MallocAtLevel(sz, 1)
|
||||
|
||||
#ifndef Yap_Min
|
||||
#define Yap_Min(x, y) (x < y ? x : y)
|
||||
|
@ -65,6 +48,17 @@ extern void *export_block(int lvl, void *exp USES_REGS);
|
|||
#define MBYTE (1024 * 1024)
|
||||
|
||||
/* Character types for tokenizer and write.c */
|
||||
extern int AllocLevel(void);
|
||||
|
||||
#define push_text_stack() \
|
||||
(/* fprintf(stderr, "^ %*c %s:%s:%d\n", AllocLevel(), AllocLevel()+'0', __FILE__, __FUNCTION__, __LINE__), */ \
|
||||
push_text_stack__(PASS_REGS1))
|
||||
extern int push_text_stack__(USES_REGS1);
|
||||
|
||||
#define pop_text_stack(lvl) \
|
||||
(/*fprintf(stderr, "v %*c %s:%s:%d\n", AllocLevel(), ' ', __FILE__, __FUNCTION__, __LINE__),*/ \
|
||||
pop_text_stack__(lvl))
|
||||
extern int pop_text_stack__(int lvl USES_REGS);
|
||||
|
||||
/****************** character definition table **************************/
|
||||
|
||||
|
@ -878,24 +872,8 @@ static inline Term Yap_CharsToString(const char *s, encoding_t enc USES_REGS) {
|
|||
return out.val.t;
|
||||
}
|
||||
|
||||
static inline char *Yap_AtomToUTF8Text(Atom at, const char *s USES_REGS) {
|
||||
seq_tv_t inp, out;
|
||||
|
||||
inp.val.a = at;
|
||||
inp.type = YAP_STRING_ATOM;
|
||||
out.type = YAP_STRING_CHARS;
|
||||
out.val.uc = NULL;
|
||||
out.enc = ENC_ISO_UTF8;
|
||||
if (s) {
|
||||
out.val.c0 = s;
|
||||
out.type |= YAP_STRING_WITH_BUFFER;
|
||||
} else {
|
||||
out.type |= YAP_STRING_MALLOC;
|
||||
out.val.c = NULL;
|
||||
}
|
||||
if (!Yap_CVT_Text(&inp, &out PASS_REGS))
|
||||
return 0L;
|
||||
return out.val.c;
|
||||
static inline char *Yap_AtomToUTF8Text(Atom at USES_REGS) {
|
||||
return RepAtom(at)->StrOfAE;
|
||||
}
|
||||
|
||||
static inline Term Yap_CharsToTDQ(const char *s, Term mod,
|
||||
|
@ -1635,6 +1613,5 @@ static inline Term Yap_SubtractTailString(Term t1, Term th USES_REGS) {
|
|||
|
||||
#endif // ≈YAP_TEXT_H
|
||||
|
||||
const char *Yap_TextTermToText(Term t, char *bufwrite_Text,
|
||||
encoding_t e USES_REGS);
|
||||
const char *Yap_TextTermToText(Term t, char *s, encoding_t e USES_REGS);
|
||||
Term Yap_MkTextTerm(const char *s, encoding_t e, Term tguide);
|
||||
|
|
|
@ -223,12 +223,13 @@ X_API int PL_get_nchars(term_t l, size_t *lengthp, char **s, unsigned flags) {
|
|||
out.type |= YAP_STRING_NCHARS;
|
||||
out.max = *lengthp;
|
||||
}
|
||||
char *sf = malloc(strlen(out.val.c)+1);
|
||||
strcpy(sf, out.val.c);
|
||||
if (!Yap_CVT_Text(&inp, &out PASS_REGS)) {
|
||||
pop_text_stack(lvl);
|
||||
return false;
|
||||
}
|
||||
out.val.c = export_block(-1, out.val.c PASS_REGS);
|
||||
*s = out.val.c;
|
||||
*s = out.val.c = sf;
|
||||
return true;
|
||||
}
|
||||
|
||||
|
|
10
os/files.c
10
os/files.c
|
@ -453,23 +453,23 @@ static Int is_absolute_file_name(USES_REGS1) { /* file_base_name(Stream,N) */
|
|||
Term t = Deref(ARG1);
|
||||
Atom at;
|
||||
bool rc;
|
||||
|
||||
if (IsVarTerm(t)) {
|
||||
Yap_Error(INSTANTIATION_ERROR, t, "file_base_name/2");
|
||||
return false;
|
||||
}
|
||||
int l = push_text_stack();
|
||||
const char *buf = Yap_TextTermToText(t, NULL, LOCAL_encoding);
|
||||
if (buf) {
|
||||
rc = Yap_IsAbsolutePath(buf);
|
||||
} else {
|
||||
at = AtomOfTerm(t);
|
||||
at = AtomOfTerm(t);
|
||||
#if _WIN32
|
||||
rc = PathIsRelative(RepAtom(at)->StrOfAE);
|
||||
rc = PathIsRelative(RepAtom(at)->StrOfAE);
|
||||
#else
|
||||
rc = RepAtom(at)->StrOfAE[0] == '/';
|
||||
rc = RepAtom(at)->StrOfAE[0] == '/';
|
||||
#endif
|
||||
freeBuffer(buf);
|
||||
}
|
||||
pop_text_stack(l);
|
||||
return rc;
|
||||
}
|
||||
|
||||
|
|
904
os/format.c
904
os/format.c
File diff suppressed because it is too large
Load Diff
|
@ -18,6 +18,7 @@ typedef struct format_status {
|
|||
// number of characters
|
||||
int lstart;
|
||||
int gapi;
|
||||
int lvl;
|
||||
} format_info;
|
||||
|
||||
#define FORMAT_COPY_ARGS_ERROR -1
|
||||
|
|
33
os/sysbits.c
33
os/sysbits.c
|
@ -171,7 +171,7 @@ static const char *PlExpandVars(const char *source, const char *root,
|
|||
CACHE_REGS
|
||||
const char *src = source;
|
||||
if (!result)
|
||||
result = malloc(YAP_FILENAME_MAX + 1);
|
||||
result = BaseMalloc(YAP_FILENAME_MAX + 1);
|
||||
|
||||
if (strlen(source) >= YAP_FILENAME_MAX) {
|
||||
Yap_Error(SYSTEM_ERROR_OPERATING_SYSTEM, TermNil,
|
||||
|
@ -844,20 +844,23 @@ static Int expand_file_name3(USES_REGS1) {
|
|||
|
||||
static Int absolute_file_system_path(USES_REGS1) {
|
||||
Term t = Deref(ARG1);
|
||||
const char *fp;
|
||||
bool rc;
|
||||
char s[MAXPATHLEN + 1];
|
||||
const char *text = Yap_TextTermToText(t, s, LOCAL_encoding);
|
||||
int l = push_text_stack();
|
||||
const char *text = Yap_TextTermToText(t, NULL, LOCAL_encoding);
|
||||
const char *fp;
|
||||
bool rc;
|
||||
|
||||
if (text == NULL) {
|
||||
pop_text_stack(l);
|
||||
return false;
|
||||
}
|
||||
if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, true)))
|
||||
if (!(fp = Yap_AbsoluteFile(RepAtom(AtomOfTerm(t))->StrOfAE, NULL, true))) {
|
||||
pop_text_stack(l);
|
||||
return false;
|
||||
}
|
||||
pop_text_stack(l);
|
||||
|
||||
rc = Yap_unify(Yap_MkTextTerm(fp, LOCAL_encoding, t), ARG2);
|
||||
if (fp != s)
|
||||
freeBuffer((void *)fp);
|
||||
return rc;
|
||||
return rc;
|
||||
}
|
||||
|
||||
static Int prolog_to_os_filename(USES_REGS1) {
|
||||
|
@ -1359,14 +1362,18 @@ static Int p_expand_file_name(USES_REGS1) {
|
|||
Yap_Error(INSTANTIATION_ERROR, t, "argument to true_file_name unbound");
|
||||
return FALSE;
|
||||
}
|
||||
int l = push_text_stack();
|
||||
text = Yap_TextTermToText(t, NULL, LOCAL_encoding);
|
||||
if (!text)
|
||||
if (!text) {
|
||||
pop_text_stack(l);
|
||||
return false;
|
||||
if (!(text2 = PlExpandVars(text, NULL, NULL)))
|
||||
}
|
||||
if (!(text2 = PlExpandVars(text, NULL, NULL))) {
|
||||
pop_text_stack(l);
|
||||
return false;
|
||||
freeBuffer(text);
|
||||
}
|
||||
bool rc = Yap_unify(ARG2, Yap_MkTextTerm(text2, LOCAL_encoding, t));
|
||||
freeBuffer(text2);
|
||||
pop_text_stack(l);
|
||||
return rc;
|
||||
}
|
||||
|
||||
|
|
|
@ -38,7 +38,7 @@
|
|||
new_system_module( M ),
|
||||
fail.
|
||||
'$protect' :-
|
||||
'$current_predicate'(Name,M,P,_),
|
||||
'$current_predicate'(Name,M,P,_),
|
||||
'$is_system_module'(M),
|
||||
functor(P,Name,Arity),
|
||||
'$new_system_predicate'(Name,Arity,M),
|
||||
|
|
Reference in New Issue