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

Merge ssh://ssh.dcc.fc.up.pt:31064/home/vsc/yap

This commit is contained in:
Vitor Santos Costa 2019-05-02 21:03:57 +01:00
parent dc5b90a643 86d6751c98
commit 644606d8bb
30 changed files with 746 additions and 547 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -215,3 +215,4 @@ cmake/docs/Doxyfile
*.stackdump
*.gz
.Rproj.user

82
C/c_interface.c
View File

@ -1,4 +1,4 @@
/************************************************************************* *
/************************************************************************* *
* YAP Prolog *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
@ -1142,6 +1142,8 @@ X_API Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
// if (pe->PredFlags & CArgsPredFlag) {
// CurrentModule = pe->ModuleOfPred;
//}
int lvl = push_text_stack();
yhandle_t hdl = Yap_CurrentHandle();
if (pe->PredFlags & SWIEnvPredFlag) {
CPredicateV codev = (CPredicateV)exec_code;
struct foreign_context ctx;
@ -1161,12 +1163,15 @@ X_API Int YAP_Execute(PredEntry *pe, CPredicate exec_code) {
// check for junk: open frames, etc */
if (ret)
complete_exit(((choiceptr)(LCL0 - OASP)), FALSE, FALSE PASS_REGS);
else
else {
complete_fail(((choiceptr)(LCL0 - OASP)), FALSE PASS_REGS);
}
// CurrentModule = omod;
if (!ret) {
Yap_RaiseException();
}
Yap_RecoverHandles(0, hdl);
pop_text_stack( lvl );
return ret;
}
@ -1739,17 +1744,18 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
CACHE_REGS
PredEntry *pe = ape;
bool out;
// fprintf(stderr,"EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// fprintf(stderr,"1EnterGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n",HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
BACKUP_MACHINE_REGS();
dgi->lvl = push_text_stack();
LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
LOCAL_PrologMode = UserMode;
dgi->p = P;
dgi->cp = CP;
dgi->b0 = LCL0 - (CELL *)B;
dgi->CurSlot = LOCAL_CurSlot;
dgi->env0 = LCL0 - ENV;
// ensure our current ENV receives current P.
Yap_PrepGoal(pe->ArityOfPE, nullptr, B PASS_REGS);
@ -1757,7 +1763,7 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
// __android_log_print(ANDROID_LOG_INFO, "YAP ", "ap=%p %d %x %x args=%x,%x
// slot=%d", pe, pe->CodeOfPred->opc, FAILCODE, Deref(ARG1), Deref(ARG2),
// LOCAL_CurSlot);
dgi->b = LCL0 - (CELL *)B;
dgi->b_entry = LCL0 - (CELL *)B;
dgi->h = HR - H0;
dgi->tr = (CELL *)TR - LCL0;
// fprintf(stderr,"PrepGoal: H=%d ENV=%p B=%d TR=%d P=%p CP=%p Slots=%d\n",
@ -1766,7 +1772,7 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
// fprintf(stderr,"EnterGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", out,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
dgi->b = LCL0 - (CELL *)B;
dgi->b_exit = LCL0 - (CELL *)B;
if (out) {
dgi->EndSlot = LOCAL_CurSlot;
Yap_StartSlots();
@ -1774,6 +1780,7 @@ X_API bool YAP_EnterGoal(YAP_PredEntryPtr ape, CELL *ptr, YAP_dogoalinfo *dgi) {
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
}
pop_text_stack(dgi->lvl);
RECOVER_MACHINE_REGS();
return out;
}
@ -1784,8 +1791,9 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
bool out;
BACKUP_MACHINE_REGS();
myB = (choiceptr)(LCL0 - dgi->b);
myB0 = (choiceptr)(LCL0 - dgi->b0);
dgi->lvl = push_text_stack();
myB = (choiceptr)(LCL0 - dgi->b_exit);
myB0 = (choiceptr)(LCL0 - dgi->b_entry);
CP = myB->cp_cp;
/* sanity check */
if (B >= myB0) {
@ -1804,52 +1812,49 @@ X_API bool YAP_RetryGoal(YAP_dogoalinfo *dgi) {
out = Yap_exec_absmi(true, true );
if (out) {
dgi->EndSlot = LOCAL_CurSlot;
dgi->b = LCL0 - (CELL *)B;
dgi->b_exit = LCL0 - (CELL *)B;
} else {
printf("F %ld\n", dgi->CurSlot);
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
}
pop_text_stack(dgi->lvl);
RECOVER_MACHINE_REGS();
return out;
}
X_API bool YAP_LeaveGoal(bool successful, YAP_dogoalinfo *dgi) {
CACHE_REGS
choiceptr myB, handler;
// fprintf(stderr,"LeaveGoal success=%d: H=%d ENV=%p B=%ld myB=%ld TR=%d
// P=%p CP=%p Slots=%d\n",
// successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,dgi->b0,(CELL*)TR-LCL0, P, CP,
// LOCAL_CurSlot);
BACKUP_MACHINE_REGS();
myB = (choiceptr)(LCL0 - dgi->b);
if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
handler = B;
while (handler &&
LCL0 - LOCAL_CBorder > (CELL *)handler
//&& handler->cp_ap != NOCODE
&& handler->cp_b != NULL && handler != myB) {
if (handler < myB) {
handler->cp_ap = TRUSTFAILCODE;
}
B = handler;
handler = handler->cp_b;
dgi->lvl = push_text_stack();
if (successful) {
choiceptr nB = (choiceptr)(LCL0 - dgi->b_entry);
if (B <= nB) {
B = nB;
}
Yap_TrimTrail();
} else if (!(LOCAL_PrologMode & AsyncIntMode)) {
P = FAILCODE;
Yap_exec_absmi(true, YAP_EXEC_ABSMI);
}
}
if (LOCAL_PrologMode & AsyncIntMode) {
B = B->cp_b;
} else if (LOCAL_PrologMode & AsyncIntMode) {
Yap_signal(YAP_FAIL_SIGNAL);
}
B = (choiceptr)(LCL0 - dgi->b0);
#ifdef DEPTH_LIMIT
DEPTH = B->cp_depth;
#endif
P = dgi->p;
CP = dgi->cp;
YENV = ENV = LCL0-dgi->env0;
LOCAL_CurSlot =
dgi->CurSlot; // ignore any slots created within the called goal
pop_text_stack(dgi->lvl);
RECOVER_MACHINE_REGS();
// fprintf(stderr,"LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// fprintf(stderr," LeftGoal success=%d: H=%d ENV=%p B=%d TR=%d P=%p CP=%p
// Slots=%d\n", successful,HR-H0,LCL0-ENV,LCL0-(CELL*)B,(CELL*)TR-LCL0, P,
// CP, LOCAL_CurSlot);
return TRUE;
@ -1861,6 +1866,8 @@ X_API Int YAP_RunGoal(Term t) {
yhandle_t cslot = LOCAL_CurSlot;
BACKUP_MACHINE_REGS();
int lvl = push_text_stack();
LOCAL_AllowRestart = FALSE;
LOCAL_PrologMode = UserMode;
out = Yap_RunTopGoal(t, true);
@ -1869,6 +1876,7 @@ X_API Int YAP_RunGoal(Term t) {
// We'll pass it through
RECOVER_MACHINE_REGS();
LOCAL_CurSlot = cslot;
pop_text_stack(lvl);
return out;
}
@ -1942,11 +1950,12 @@ X_API CELL *YAP_HeapStoreOpaqueTerm(Term t) {
X_API Int YAP_RunGoalOnce(Term t) {
CACHE_REGS
Term out;
yamop *old_CP = CP;
yamop *old_CP = CP, *old_P = P;
Int oldPrologMode = LOCAL_PrologMode;
yhandle_t CSlot;
BACKUP_MACHINE_REGS();
int lvl = push_text_stack();
CSlot = Yap_StartSlots();
LOCAL_PrologMode = UserMode;
// Yap_heap_regs->yap_do_low_level_trace=true;
@ -1955,6 +1964,7 @@ X_API Int YAP_RunGoalOnce(Term t) {
// Yap_CloseSlots(CSlot);
if (!(oldPrologMode & UserCCallMode)) {
/* called from top-level */
pop_text_stack( lvl);
LOCAL_AllowRestart = FALSE;
RECOVER_MACHINE_REGS();
return out;
@ -1989,13 +1999,14 @@ X_API Int YAP_RunGoalOnce(Term t) {
ASP = B->cp_env;
ENV = (CELL *)ASP[E_E];
B = (choiceptr)ASP[E_CB];
#ifdef DEPTH_LIMITxs
#ifdef DEPTH_LIMIT
DEPTH = ASP[E_DEPTH];
#endif
P = (yamop *)ASP[E_CP];
P = old_P;
CP = old_CP;
LOCAL_AllowRestart = FALSE;
RECOVER_MACHINE_REGS();
pop_text_stack( lvl);
return out;
}
@ -2078,7 +2089,7 @@ X_API void YAP_PruneGoal(YAP_dogoalinfo *gi) {
CACHE_REGS
BACKUP_B();
choiceptr myB = (choiceptr)(LCL0 - gi->b);
choiceptr myB = (choiceptr)(LCL0 - gi->b_entry);
while (B != myB) {
/* make sure we prune C-choicepoints */
if (POP_CHOICE_POINT(B->cp_b)) {
@ -2271,6 +2282,7 @@ X_API char *YAP_WriteBuffer(Term t, char *buf, size_t sze, int flags) {
} else {
RECOVER_MACHINE_REGS();
if (buf == out.val.c) {
pop_text_stack(l);
return buf;
} else {
if ( strlen(out.val.c ) < sze) {

12
C/exec.c
View File

@ -804,11 +804,11 @@ static Int execute_in_mod(USES_REGS1) { /* '$execute'(Goal) */
static void prune_inner_computation(choiceptr parent) {
/* code */
choiceptr cut_pt;
yamop *oP = P, *oCP = CP;
Int oENV = LCL0 - ENV;
cut_pt = B;
while (cut_pt && cut_pt->cp_b < parent) {
if (cut_pt->cp_ap == NOCODE)
break;
cut_pt = cut_pt->cp_b;
}
if (!cut_pt)
@ -819,9 +819,6 @@ static void prune_inner_computation(choiceptr parent) {
B = cut_pt;
Yap_TrimTrail();
LOCAL_AllowRestart = FALSE;
P = oP;
CP = oCP;
ENV = LCL0 - oENV;
B = parent;
}
@ -1062,8 +1059,6 @@ static Int cleanup_on_exit(USES_REGS1) {
complete_pt[0] = TermExit;
}
Yap_ignore(cleanup, false);
if (B0->cp_ap == NOCODE)
B0->cp_ap = TRUSTFAILCODE;
if (Yap_RaiseException()) {
return false;
}
@ -1617,7 +1612,6 @@ static bool exec_absmi(bool top, yap_reset_t reset_mode USES_REGS) {
CalculateStackGap(PASS_REGS1);
LOCAL_CBorder = OldBorder;
LOCAL_RestartEnv = sighold;
pop_text_stack(i + 1);
return out;
}
@ -2272,7 +2266,7 @@ void Yap_InitYaamRegs(int myworker_id, bool full_reset) {
REMOTE_AttsMutableList(myworker_id) = Yap_NewTimedVar(h0var);
#endif
size_t defsz = 128*1024;
Yap_AllocateDefaultArena(defsz, myworker_id);
Yap_AllocateDefaultArena(defsz, myworker_id, NULL);
} else {
HR = Yap_ArenaLimit(REMOTE_GlobalArena(myworker_id));
}

281
C/globals.c
View File

@ -78,7 +78,7 @@ assert/1 or recorda/3.
+ The value lives on the Prolog (global) stack. This implies
that lookup time is independent from the size of the term.
This is particulary interesting for large data structures
such as parsed XML documents or the CHR global constraint
qqqsuch as parsed XML documents or the CHR global constraint
store.
They support both global assignment using nb_setval/2 and
@ -139,6 +139,26 @@ threads that are created <em>after</em> the registration.
#define HEAP_ARENA 2
#define HEAP_START 3
/// A cell_space is a short code region, where we want bindings to proceed locally.
/// It is used in copy_term,,,,,,,,,,,,,,,,,,,,,,,
///
typedef struct cell_space {
struct cell_space *parent; //`
CELL *oASP, *oH, *oHB;
} cell_space_t;
INLINE_ONLY void enter_cell_space(cell_space_t *cs) {
cs->oH = HR;
cs->oHB = HB;
cs->oASP = ASP;
}
INLINE_ONLY void exit_cell_space(cell_space_t *cs) {
HR = cs->oH;
HB = cs->oHB;
ASP = cs->oASP;
}
#define MIN_ARENA_SIZE (1048L)
#define MAX_ARENA_SIZE (2048 * 16)
@ -186,33 +206,37 @@ static Term CreateNewArena(CELL *ptr, UInt size) {
return t;
}
static Term NewArena(UInt size, int wid, UInt arity, CELL *where) {
static Term NewArena(UInt size, int wid, UInt arity, CELL *where, struct cell_space *cellSpace) {
Term t;
UInt new_size;
WORKER_REGS(wid)
if (where == NULL || where == HR) {
while (HR + size > ASP - 1024) {
exit_cell_space(cellSpace);
// make sure we have enough room
while (HR + size > ASP - MIN_ARENA_SIZE) {
if (!Yap_gcl(size * sizeof(CELL), arity, ENV, P)) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return TermNil;
}
}
if (where == NULL || where == HR) {
t = CreateNewArena(HR, size);
HR += size;
new_size = size;
} else {
if ((new_size = Yap_InsertInGlobal(where, size * sizeof(CELL))) == 0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil,
"No Stack Space for Non-Backtrackable terms");
return TermNil;
}
size = new_size / sizeof(CELL);
t = CreateNewArena(where, size);
}
enter_cell_space(cellSpace);
return t;
}
static Int p_allocate_arena(USES_REGS1) {
cell_space_t cspace;
Term t = Deref(ARG1);
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t, "allocate_arena");
@ -221,15 +245,21 @@ static Int p_allocate_arena(USES_REGS1) {
Yap_Error(TYPE_ERROR_INTEGER, t, "allocate_arena");
return FALSE;
}
return Yap_unify(ARG2, NewArena(IntegerOfTerm(t), worker_id, 1, NULL));
enter_cell_space(&cspace);
return Yap_unify(ARG2, NewArena(IntegerOfTerm(t), worker_id, 1, NULL, &cspace));
}
static Int p_default_arena_size(USES_REGS1) {
return Yap_unify(ARG1, MkIntegerTerm(ArenaSz(LOCAL_GlobalArena)));
}
void Yap_AllocateDefaultArena(size_t gsize, int wid) {
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL);
void Yap_AllocateDefaultArena(size_t gsize, int wid, void *cs) {
cell_space_t ics;
if (cs == NULL) {
enter_cell_space(&ics);
cs = &ics;
}
REMOTE_GlobalArena(wid) = NewArena(gsize, wid, 2, NULL, cs);
}
static void adjust_cps(UInt size USES_REGS) {
@ -241,8 +271,9 @@ static void adjust_cps(UInt size USES_REGS) {
}
}
static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
UInt arity USES_REGS) {
static Term GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
UInt arity, cell_space_t *cspace USES_REGS) {
size_t sz;
LOCAL_ArenaOverflows++;
if (size == 0) {
if (old_size < 128 * 1024) {
@ -251,59 +282,52 @@ static int GrowArena(Term arena, CELL *pt, size_t old_size, size_t size,
size = old_size + 128 * 1024;
}
}
if (size < 4096) {
size = 4096;
if (size < 4*MIN_ARENA_SIZE) {
size = 4*MIN_ARENA_SIZE;
}
if (pt == HR) {
if (HR + size > ASP - 1024) {
exit_cell_space(cspace);
while (HR + size > ASP - MIN_ARENA_SIZE) {
XREGS[arity + 1] = arena;
if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return FALSE;
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
arena = XREGS[arity + 1];
/* we don't know if the GC added junk on top of the global */
pt = ArenaLimit(arena);
return GrowArena(arena, pt, old_size, size, arity PASS_REGS);
}
adjust_cps(size PASS_REGS);
HR += size;
} else {
XREGS[arity + 1] = arena;
/* try to recover some room */
Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP));
arena = XREGS[arity + 1];
pt = ArenaLimit(arena);
if ((size = Yap_InsertInGlobal(pt, size * sizeof(CELL))) == 0) {
return FALSE;
}
size = size / sizeof(CELL);
arena = XREGS[arity + 1];
adjust_cps(size PASS_REGS);
}
CreateNewArena(ArenaPt(arena), size + old_size);
return TRUE;
pt = ArenaLimit(arena)+1;
sz = old_size + size;
if (pt == HR) {
HR += size+1;
HR[ - 1] = EndSpecials;
} else {
if ((sz = Yap_InsertInGlobal(pt, size * sizeof(CELL))) == 0) {
return FALSE;
}
pt[size-1] = EndSpecials;
}
arena = XREGS[arity + 1];
MP_INT *dst = (MP_INT *)(RepAppl(arena) + 2);
dst->_mp_alloc+= size;
arena = XREGS[arity + 1];
return sz;
}
CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
CACHE_REGS
restart : {
Term arena = *arenap;
CELL *max = ArenaLimit(arena);
CELL *base = ArenaPt(arena);
CELL *newH;
UInt old_sz = ArenaSz(arena), new_size;
while(true) {
if (IN_BETWEEN(base, HR, max)) {
base = HR;
HR += cells;
return base;
}
if (base + cells > max - 1024) {
if (!GrowArena(arena, max, old_sz, old_sz + sizeof(CELL) * 1024,
arity PASS_REGS))
return NULL;
goto restart;
if (base + cells > ASP - 1024) {
continue;
}
newH = base + cells;
@ -313,17 +337,15 @@ restart : {
}
}
static void CloseArena(CELL *oldH, CELL *oldHB, CELL *oldASP, Term *oldArenaP,
static void CloseArena(cell_space_t *region, Term *oldArenaP,
UInt old_size USES_REGS) {
UInt new_size;
if (HR == oldH)
if (HR == region->oH)
return;
new_size = old_size - (HR - RepAppl(*oldArenaP));
*oldArenaP = CreateNewArena(HR, new_size);
HR = oldH;
HB = oldHB;
ASP = oldASP;
exit_cell_space( region );
}
static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) {
@ -474,7 +496,9 @@ loop:
HR += ap2[1] + 3;
break;
default: {
/* big int */
/* big int */
UInt sz = (sizeof(MP_INT) + 3 * CellSize +
((MP_INT *)(ap2 + 2))->_mp_alloc * sizeof(mp_limb_t)) /
CellSize,
@ -482,7 +506,7 @@ loop:
if (HR > ASP - (MIN_ARENA_SIZE + sz)) {
goto overflow;
}
}
*ptf++ = AbsAppl(HR);
HR[0] = (CELL)f;
for (i = 1; i < sz; i++) {
@ -494,6 +518,7 @@ loop:
continue;
}
*ptf = AbsAppl(HR);
ptf++;
/* store the terms to visit */
#ifdef RATIONAL_TREES
@ -643,9 +668,8 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
UInt arity, Term *newarena,
size_t min_grow USES_REGS) {
size_t old_size = ArenaSz(arena);
CELL *oldH = HR;
CELL *oldHB = HB;
CELL *oldASP = ASP;
cell_space_t cspace;
enter_cell_space( & cspace);
int res = 0;
Term tn;
@ -664,12 +688,12 @@ restart:
if ((res = copy_complex_term(Hi - 2, Hi - 1, share, copy_att_vars, Hi,
Hi PASS_REGS)) < 0)
goto error_handler;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return Hi[0];
}
#endif
if (share && VarOfTerm(t) > ArenaPt(arena)) {
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return t;
}
tn = MkVarTerm();
@ -677,7 +701,7 @@ restart:
res = -1;
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return tn;
} else if (IsAtomOrIntTerm(t)) {
return t;
@ -699,7 +723,7 @@ restart:
Hi PASS_REGS)) < 0) {
goto error_handler;
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return tf;
} else {
Functor f;
@ -720,7 +744,7 @@ restart:
if (IsExtensionFunctor(f)) {
switch ((CELL)f) {
case (CELL) FunctorDBRef:
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return t;
case (CELL) FunctorLongInt:
if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
@ -779,25 +803,23 @@ restart:
goto error_handler;
}
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
return tf;
}
error_handler:
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cspace, newarena, old_size PASS_REGS);
XREGS[arity + 1] = t;
XREGS[arity + 2] = arena;
XREGS[arity + 3] = (CELL)newarena;
{
CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP;
HR = oldH;
HB = oldHB;
exit_cell_space(&cspace);
switch (res) {
case -1:
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
if (!GrowArena(arena, old_top, old_size, min_grow, arity + 3 PASS_REGS)) {
if ((arena=GrowArena(arena, old_top, old_size, min_grow, arity + 3, &cspace PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return 0L;
}
@ -807,9 +829,7 @@ error_handler:
}
}
oldH = HR;
oldHB = HB;
oldASP = ASP;
enter_cell_space(&cspace);
newarena = (CELL *)XREGS[arity + 3];
arena = Deref(XREGS[arity + 2]);
t = XREGS[arity + 1];
@ -819,10 +839,9 @@ error_handler:
static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity,
Term *newarena, Term init USES_REGS) {
cell_space_t cells;
UInt old_size = ArenaSz(arena);
CELL *oldH = HR;
CELL *oldHB = HB;
CELL *oldASP = ASP;
enter_cell_space(&cells);
Term tf;
CELL *HB0;
Functor f = Yap_MkFunctor(Na, Nar);
@ -838,26 +857,20 @@ restart:
if (HR > ASP - MIN_ARENA_SIZE) {
/* overflow */
HR = HB;
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cells, newarena, old_size PASS_REGS);
XREGS[arity + 1] = arena;
XREGS[arity + 2] = (CELL)newarena;
{
CELL *old_top = ArenaLimit(*newarena);
ASP = oldASP;
HR = oldH;
HB = oldHB;
if (arena == LOCAL_GlobalArena)
LOCAL_GlobalArenaOverflows++;
if (!GrowArena(arena, old_top, old_size, Nar * sizeof(CELL),
arity + 2 PASS_REGS)) {
if ((arena=GrowArena(arena, old_top, old_size, Nar * sizeof(CELL),
arity + 2, &cells PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil,
"while creating large global term");
return 0L;
}
}
oldH = HR;
oldHB = HB;
oldASP = ASP;
newarena = (CELL *)XREGS[arity + 2];
arena = Deref(XREGS[arity + 1]);
old_size = ArenaSz(arena);
@ -872,7 +885,7 @@ restart:
HB0[i] = init;
}
}
CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
CloseArena(&cells, newarena, old_size PASS_REGS);
return tf;
}
@ -1534,9 +1547,10 @@ static Int p_nb_create2(USES_REGS1) {
static Int nb_queue(UInt arena_sz USES_REGS) {
cell_space_t cspace;
Term queue_arena, queue, ar[QUEUE_FUNCTOR_ARITY], *nar;
Term t = Deref(ARG1);
enter_cell_space(&cspace);
LOCAL_DepthArenas++;
if (!IsVarTerm(t)) {
if (!IsApplTerm(t)) {
@ -1549,9 +1563,9 @@ static Int nb_queue(UInt arena_sz USES_REGS) {
queue = Yap_MkApplTerm(FunctorNBQueue, QUEUE_FUNCTOR_ARITY, ar);
if (!Yap_unify(queue, ARG1))
return FALSE;
if (arena_sz < 4 * 1024)
arena_sz = 4 * 1024;
queue_arena = NewArena(arena_sz, worker_id, 1, NULL);
if (arena_sz < 32 * 1024)
arena_sz = 32 * 1024;
queue_arena = NewArena(arena_sz, worker_id, 1, NULL, &cspace);
if (queue_arena == 0L) {
return FALSE;
}
@ -1656,7 +1670,7 @@ static Int p_nb_queue_close(USES_REGS1) {
}
static Int p_nb_queue_enqueue(USES_REGS1) {
CELL *qd = GetQueue(ARG1, "enqueue"), *oldH, *oldHB;
CELL *qd = GetQueue(ARG1, "enqueue");
UInt old_sz;
Term arena, qsize, to;
UInt min_size;
@ -1675,37 +1689,15 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
min_size PASS_REGS);
if (to == 0L)
return FALSE;
cell_space_t cspace;
qd = GetQueue(ARG1, "enqueue");
arena = GetQueueArena(qd, "enqueue");
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = HR - RepPair(qd[QUEUE_HEAD]);
HR = oldH;
HB = oldHB;
if (gsiz > 1024 * 1024) {
gsiz = 1024 * 1024;
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
}
to = ARG3;
qd = RepAppl(Deref(ARG1)) + 1;
arena = GetQueueArena(qd, "enqueue");
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1);
if (qsize == 0) {
qd[QUEUE_HEAD] = AbsPair(HR);
@ -1716,7 +1708,7 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
RESET_VARIABLE(HR);
qd[QUEUE_TAIL] = (CELL)HR;
HR++;
CloseArena(oldH, oldHB, ASP, qd + QUEUE_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + QUEUE_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -1724,7 +1716,7 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
CELL *qd = GetQueue(ARG1, "dequeue");
UInt old_sz, qsz;
Term arena, out;
CELL *oldH, *oldHB;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -1738,10 +1730,9 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
out = HeadOfTerm(qd[QUEUE_HEAD]);
qd[QUEUE_HEAD] = TailOfTerm(qd[QUEUE_HEAD]);
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
CloseArena(&cspace, &arena, old_sz PASS_REGS);
return Yap_unify(out, ARG2);
}
@ -1838,6 +1829,7 @@ static Term MkZeroApplTerm(Functor f, UInt sz USES_REGS) {
static Int p_nb_heap(USES_REGS1) {
Term heap_arena, heap, *ar, *nar;
UInt hsize;
cell_space_t cspace;
Term tsize = Deref(ARG1);
UInt arena_sz = (ASP-HR) / 16;
@ -1868,7 +1860,7 @@ static Int p_nb_heap(USES_REGS1) {
ar[HEAP_MAX] = tsize;
if (arena_sz < 1024)
arena_sz = 1024;
heap_arena = NewArena(arena_sz, worker_id, 1, NULL);
heap_arena = NewArena(arena_sz, worker_id, 1, NULL, &cspace);
if (heap_arena == 0L) {
return FALSE;
}
@ -1946,10 +1938,11 @@ static void DelHeapRoot(CELL *pt, UInt sz) {
}
static Int p_nb_heap_add_to_heap(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "add_to_heap"), *oldH, *oldHB, *pt;
CELL *qd = GetHeap(ARG1, "add_to_heap"), *pt;
UInt hsize, hmsize, old_sz;
Term arena, to, key;
UInt mingrow;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -1971,7 +1964,8 @@ restart:
"No Stack Space for Non-Backtrackable terms");
return FALSE;
}
extra_size = extra_size / (2 * sizeof(CELL));
enter_cell_space(&cspace);
extra_size = extra_size / (2 * sizeof(CELL));
qd = GetHeap(ARG1, "add_to_heap");
hmsize += extra_size;
if (!qd)
@ -1986,11 +1980,9 @@ restart:
}
arena = qd[HEAP_ARENA];
old_sz = ArenaSz(arena);
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + HEAP_ARENA, old_sz PASS_REGS);
goto restart;
}
arena = qd[HEAP_ARENA];
@ -2010,30 +2002,25 @@ restart:
qd = GetHeap(ARG1, "add_to_heap");
arena = qd[HEAP_ARENA];
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize * 2;
HR = oldH;
HB = oldHB;
if (gsiz > 1024 * 1024) {
gsiz = 1024 * 1024;
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
if ((arena=GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3, &cspace PASS_REGS))==0) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
}
to = ARG3;
qd = RepAppl(Deref(ARG1)) + 1;
arena = qd[HEAP_ARENA];
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
@ -2042,7 +2029,7 @@ restart:
pt[2 * hsize + 1] = to;
PushHeap(pt, hsize);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + HEAP_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -2100,6 +2087,7 @@ static Int p_nb_heap_size(USES_REGS1) {
}
static Int p_nb_beam(USES_REGS1) {
cell_space_t cspace;
Term beam_arena, beam, *ar, *nar;
UInt hsize;
Term tsize = Deref(ARG1);
@ -2130,7 +2118,7 @@ static Int p_nb_beam(USES_REGS1) {
ar[HEAP_MAX] = tsize;
if (arena_sz < 1024)
arena_sz = 1024;
beam_arena = NewArena(arena_sz, worker_id, 1, NULL);
beam_arena = NewArena(arena_sz, worker_id, 1, NULL, &cspace);
if (beam_arena == 0L) {
return FALSE;
}
@ -2339,10 +2327,11 @@ static Term DelBeamMin(CELL *pt, CELL *pt2, UInt sz) {
}
static Int p_nb_beam_add_to_beam(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "add_to_beam"), *oldH, *oldHB, *pt;
CELL *qd = GetHeap(ARG1, "add_to_beam"), *pt;
UInt hsize, hmsize, old_sz;
Term arena, to, key;
Term arena, to, qsize, key;
UInt mingrow;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -2373,37 +2362,32 @@ static Int p_nb_beam_add_to_beam(USES_REGS1) {
qd = GetHeap(ARG1, "add_to_beam");
arena = qd[HEAP_ARENA];
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
while (old_sz < MIN_ARENA_SIZE) {
UInt gsiz = hsize * 2;
HR = oldH;
HB = oldHB;
UInt gsiz = HR - RepPair(qd[QUEUE_HEAD]);
if (gsiz > 1024 * 1024) {
gsiz = 1024 * 1024;
} else if (gsiz < 1024) {
gsiz = 1024;
}
ARG3 = to;
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3 PASS_REGS)) {
/* fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
if (!GrowArena(arena, ArenaLimit(arena), old_sz, gsiz, 3, &cspace PASS_REGS)) {
Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
return 0L;
}
to = ARG3;
qd = RepAppl(Deref(ARG1)) + 1;
arena = qd[HEAP_ARENA];
oldH = HR;
oldHB = HB;
HR = HB = ArenaPt(arena);
old_sz = ArenaSz(arena);
}
pt = qd + HEAP_START;
PushBeam(pt, pt + 2 * hmsize, hsize, key, to);
qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
CloseArena(oldH, oldHB, ASP, qd + HEAP_ARENA, old_sz PASS_REGS);
CloseArena(&cspace, qd + HEAP_ARENA, old_sz PASS_REGS);
return TRUE;
}
@ -2411,8 +2395,8 @@ static Int p_nb_beam_del(USES_REGS1) {
CELL *qd = GetHeap(ARG1, "debeam");
UInt old_sz, qsz;
Term arena;
CELL *oldH, *oldHB;
Term tk, tv;
cell_space_t cspace;
if (!qd)
return FALSE;
@ -2424,10 +2408,9 @@ static Int p_nb_beam_del(USES_REGS1) {
return FALSE;
old_sz = ArenaSz(arena);
/* garbage collection ? */
oldH = HR;
oldHB = HB;
enter_cell_space(&cspace);
qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
CloseArena(oldH, oldHB, ASP, &arena, old_sz PASS_REGS);
CloseArena(&cspace, &arena, old_sz PASS_REGS);
tk = qd[HEAP_START];
tv = DelBeamMin(qd + HEAP_START,
qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);

113
C/grow.c
View File

@ -324,15 +324,15 @@ MoveGlobalWithHole( USES_REGS1 )
}
static void
MoveHalfGlobal(CELL *OldPt USES_REGS)
MoveHalfGlobal(CELL *OldPt, size_t request USES_REGS)
{
/*
* cpcellsd(To,From,NOfCells) - copy the cells downwards - in
* absmi.asm
*/
UInt diff = LOCAL_OldH-OldPt;
CELL *NewPt = (CELL *)((char*)OldPt+LOCAL_GDiff);
CELL *IntPt = (CELL *)((char*)OldPt+LOCAL_GDiff0);
CELL *NewPt = IntPt+request/sizeof(CELL);
cpcellsd(NewPt, IntPt, diff);
}
@ -393,7 +393,7 @@ AdjustTrail(bool adjusting_heap, bool thread_copying USES_REGS)
register CELL reg = TrailTerm(ptt-1);
#ifdef FROZEN_STACKS
register CELL reg2 = TrailVal(ptt-1);
#endif
#endif
ptt--;
if (IsVarTerm(reg)) {
@ -436,6 +436,8 @@ fixPointerCells(CELL *pt, CELL *pt_bot, bool thread_copying USES_REGS)
{
while (pt > pt_bot) {
CELL reg = *--pt;
// if (pt-pt_bot> 4300 && pt-pt_bot < 4500)
// printf("%d %d %lx\n", pt-pt_bot, pt-LOCAL_GSplit, reg);
if (IsVarTerm(reg)) {
if (IsOldLocal(reg))
*pt = LocalAdjust(reg);
@ -450,6 +452,8 @@ fixPointerCells(CELL *pt, CELL *pt_bot, bool thread_copying USES_REGS)
} else if (IsPairTerm(reg)) {
*pt = AdjustPair(reg PASS_REGS);
}
// if (pt-pt_bot> 4300 && pt-pt_bot < 4500)
// printf("%lx\n", *pt);
}
}
@ -889,12 +893,14 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
char *omax = (char *)H0;
ADDR old_GlobalBase = LOCAL_GlobalBase;
UInt minimal_request = 0L;
Int size = request;
Int size = request/sizeof(CELL);
char vb_msg1 = '\0', *vb_msg2;
bool do_grow = true;
bool insert_in_delays = false;
printf("request=%ld at %p, shift %p, %ld <-> %ld\n",request, hsplit, ptr,hsplit-H0,HR-hsplit);
/*
request is the amount of memory we requested, in bytes;
request is the amount of memory we requesd, in bytes;
base_move is the shift in global stacks we had to do
size is how much space we allocate: it's negative if we just expand
the delay stack.
@ -902,55 +908,44 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
*/
if (hsplit) {
/* just a little bit of sanity checking */
if (hsplit < H0 && hsplit > (CELL *)LOCAL_GlobalBase) {
insert_in_delays = TRUE;
/* expanding attributed variables */
if (omax - size > LOCAL_GlobalBase+4096*sizeof(CELL)) {
/* we can just ask for more room */
size = 0;
do_grow = FALSE;
}
} else if (hsplit < (CELL*)omax ||
if (hsplit < H0 ||
hsplit > HR)
return FALSE;
else if (hsplit == (CELL *)omax)
return false;
if (hsplit == H0)
hsplit = NULL;
if (size < 0 ||
(Unsigned(HR)+size < Unsigned(ASP)-StackGap( PASS_REGS1 ) &&
hsplit > H0)) {
/* don't need to expand stacks */
insert_in_delays = FALSE;
do_grow = FALSE;
}
} else {
if (Unsigned(HR)+size < Unsigned(ASP)-CreepFlag) {
/* we can just ask for more room */
do_grow = FALSE;
if (hsplit == HR && Unsigned(HR)+request < Unsigned(ASP)-StackGap( PASS_REGS1 )) {
return request;
}
}
if (size < 0 ||
(Unsigned(HR)+request < Unsigned(ASP-StackGap( PASS_REGS1 )))) {
do_grow = false;
}
if (do_grow) {
if (size < YAP_ALLOC_SIZE)
size = YAP_ALLOC_SIZE;
size = AdjustPageSize(size);
if (request < YAP_ALLOC_SIZE)
request = YAP_ALLOC_SIZE;
request = AdjustPageSize(request);
}
printf("grow=%d\n", do_grow);
/* adjust to a multiple of 256) */
LOCAL_ErrorMessage = NULL;
LOCAL_PrologMode |= GrowStackMode;
start_growth_time = Yap_cputime();
if (do_grow) {
if (!GLOBAL_AllowGlobalExpansion) {
LOCAL_ErrorMessage = "Global Stack crashed against Local Stack";
LeaveGrowMode(GrowStackMode);
return 0;
}
if (!GLOBAL_AllowGlobalExpansion || !Yap_ExtendWorkSpace(size)) {
if (!GLOBAL_AllowGlobalExpansion || !Yap_ExtendWorkSpace(request)) {
/* always fails when using malloc */
LOCAL_ErrorMessage = NULL;
size += AdjustPageSize(((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)+MinHeapGap);
minimal_request = size;
size = Yap_ExtendWorkSpaceThroughHole(size);
if (size < 0) {
request += AdjustPageSize(((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)+MinHeapGap);
minimal_request = request;
request = Yap_ExtendWorkSpaceThroughHole(request);
if (request < 0) {
LOCAL_ErrorMessage = "Global Stack crashed against Local Stack";
LeaveGrowMode(GrowStackMode);
return 0;
@ -958,15 +953,11 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
}
}
gc_verbose = Yap_is_gc_verbose();
LOCAL_delay_overflows++;
if (gc_verbose) {
if (hsplit) {
if (hsplit > H0) {
vb_msg1 = 'H';
vb_msg2 = "Global Variable Space";
} else {
vb_msg1 = 'D';
vb_msg2 = "Global Variable Delay Space";
}
} else {
vb_msg1 = 'D';
@ -976,8 +967,9 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
fprintf(stderr, "%% Worker Id %d:\n", worker_id);
#endif
fprintf(stderr, "%% %cO %s Overflow %d\n", vb_msg1, vb_msg2, LOCAL_delay_overflows);
fprintf(stderr, "%% %cO growing the stacks " UInt_FORMAT " bytes\n", vb_msg1, size);
fprintf(stderr, "%% %cO growing the stacks " UInt_FORMAT " bytes\n", vb_msg1, request);
}
printf("grow=%d %p\n", do_grow, ASP);
ASP -= 256;
YAPEnterCriticalSection();
/* we always shift the local and the stack by the same amount */
@ -985,13 +977,13 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
/* we got over a hole */
if (minimal_request) {
/* we went over a hole */
LOCAL_BaseDiff = size+((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)-minimal_request;
LOCAL_LDiff = LOCAL_TrDiff = size;
LOCAL_BaseDiff = request+((CELL)LOCAL_TrailTop-(CELL)LOCAL_GlobalBase)-minimal_request;
LOCAL_LDiff = LOCAL_TrDiff = request;
} else {
/* we may still have an overflow */
LOCAL_BaseDiff = LOCAL_GlobalBase - old_GlobalBase;
/* if we grow, we need to move the stacks */
LOCAL_LDiff = LOCAL_TrDiff = LOCAL_BaseDiff+size;
LOCAL_LDiff = LOCAL_TrDiff = LOCAL_BaseDiff+request;
}
} else {
/* stay still */
@ -1002,25 +994,21 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
hole in global */
if (!hsplit) {
if (!do_grow) {
LOCAL_DelayDiff = LOCAL_GDiff = LOCAL_GDiff0 = size;
LOCAL_GDiff = LOCAL_GDiff0 = request;
request = 0L;
} else {
/* expand delay stack */
LOCAL_DelayDiff = LOCAL_GDiff = LOCAL_GDiff0 = LOCAL_LDiff;
}
} else if (insert_in_delays) {
/* we want to expand a hole for the delay stack */
LOCAL_DelayDiff = size-request;
LOCAL_GDiff = LOCAL_GDiff0 = size;
LOCAL_GDiff = LOCAL_GDiff0 = LOCAL_LDiff;
}
} else {
/* we want to expand a hole for the delay stack */
LOCAL_GDiff0 = LOCAL_DelayDiff = LOCAL_BaseDiff;
LOCAL_GDiff0 = LOCAL_BaseDiff;
LOCAL_GDiff = LOCAL_BaseDiff+request;
}
LOCAL_GSplit = hsplit;
LOCAL_XDiff = LOCAL_HDiff = 0;
LOCAL_GlobalBase = old_GlobalBase;
SetHeapRegs(FALSE PASS_REGS);
SetHeapRegs(FALSE PASS_REGS);
if (do_grow) {
MoveLocalAndTrail( PASS_REGS1 );
if (hsplit) {
@ -1042,17 +1030,13 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
*ptr = PtoLocAdjust(*ptr);
}
if (hsplit) {
if (insert_in_delays) {
/* we have things not quite where we want to have them */
cpcellsd((CELL *)(omax+LOCAL_DelayDiff), (CELL *)(omax+LOCAL_GDiff0), (ADDR)hsplit-omax);
} else {
MoveHalfGlobal(hsplit PASS_REGS);
}
MoveHalfGlobal(hsplit, request PASS_REGS);
printf("done\n");
}
YAPLeaveCriticalSection();
ASP += 256;
if (minimal_request) {
Yap_AllocHole(minimal_request, size);
Yap_AllocHole(minimal_request, request);
}
growth_time = Yap_cputime()-start_growth_time;
LOCAL_total_delay_overflow_time += growth_time;
@ -1063,8 +1047,9 @@ static_growglobal(size_t request, CELL **ptr, CELL *hsplit USES_REGS)
LeaveGrowMode(GrowStackMode);
if (hsplit) {
return request;
} else
} else {
return LOCAL_GDiff-LOCAL_BaseDiff;
}
}
static void
@ -1503,7 +1488,7 @@ Yap_growheap(bool fix_code, size_t in_size, void *cip)
int
Yap_growheap_in_parser(tr_fr_ptr *old_trp, TokEntry **tksp, VarEntry **vep)
{
CACHE_REGS
CACHE_REGS
int res;
res=do_growheap(FALSE, 0L, NULL, old_trp, tksp, vep PASS_REGS);
@ -1548,6 +1533,7 @@ UInt
Yap_InsertInGlobal(CELL *where, size_t howmuch)
{
CACHE_REGS
printf("where=%p, hm=%d\n",where,howmuch);
if ((howmuch = static_growglobal(howmuch, NULL, where PASS_REGS)) == 0)
return 0;
#ifdef TABLING
@ -1576,6 +1562,7 @@ Yap_growstack(size_t size)
int res;
LOCAL_PrologMode |= GrowStackMode;
printf("extra %dBs\n",size);
res=growstack(size PASS_REGS);
LeaveGrowMode(GrowStackMode);
return res;

5
C/heapgc.c
View File

@ -1,4 +1,4 @@
/**************************************************************************
/*************************************************************************
* *
* YAP Prolog *
* *
@ -4194,7 +4194,7 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS)
int gc_on = FALSE, gc_t = FALSE;
if (Yap_GetValue(AtomGc) != TermNil)
gc_on = TRUE;
gc_on = false;
if (IsIntegerTerm(Tgc_margin = Yap_GetValue(AtomGcMargin)) &&
gc_margin > 0) {
gc_margin = (UInt)IntegerOfTerm(Tgc_margin);
@ -4346,3 +4346,4 @@ Yap_inc_mark_variable()
CACHE_REGS
LOCAL_total_marked++;
}

2
C/index.c
View File

@ -2039,7 +2039,7 @@ static UInt suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap,
/* give it some slack */
tels = cls + 4;
} else {
tels = cls;
tels = cls+1;
}
sz = (UInt)NEXTOP((yamop *)NULL, sssllp) + tels * sizeof(yamop *);
if ((ncode = (yamop *)Yap_AllocCodeSpace(sz)) == NULL) {

130
C/prim_absmi_insts.h
View File

@ -1949,11 +1949,12 @@
Op(p_arg_vv, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x1);
HR[1] = XREG(PREG->y_u.xxx.x2);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.xxx.x1);
ts[1] = XREG(PREG->y_u.xxx.x2);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2045,12 +2046,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
Term ts[3];
Term t = MkIntegerTerm(PREG->y_u.xxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.xxn.xi);
RESET_VARIABLE(HR + 2);
ts[0] = t;
ts[1] = XREG(PREG->y_u.xxn.xi);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
HR = Ho;
}
#endif /* LOW_LEVEL_TRACE */
@ -2118,12 +2120,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_arg_y_vv, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x1);
HR[1] = XREG(PREG->y_u.yxx.x2);
HR[2] = YREG[PREG->y_u.yxx.y];
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.yxx.x1);
ts[1] = XREG(PREG->y_u.yxx.x2);
ts[2] = YREG[PREG->y_u.yxx.y];
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2216,13 +2219,14 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
CELL *Ho = HR;
Term ts[3];
Term t = MkIntegerTerm(PREG->y_u.yxn.c);
HR[0] = t;
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = YREG[PREG->y_u.yxn.y];
RESET_VARIABLE(HR + 2);
ts[0] = t;
ts[1] = XREG(PREG->y_u.yxn.xi);
ts[2] = YREG[PREG->y_u.yxn.y];
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), HR);
RepPredProp(Yap_GetPredPropByFunc(FunctorArg, 0)), ts);
HR = Ho;
}
#endif /* LOW_LEVEL_TRACE */
@ -2295,12 +2299,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxx.x1);
HR[2] = XREG(PREG->y_u.xxx.x2);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.xxx.x1);
ts[2] = XREG(PREG->y_u.xxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2412,12 +2417,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.xxc.c;
HR[2] = XREG(PREG->y_u.xxc.xi);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = PREG->y_u.xxc.c;
ts[2] = XREG(PREG->y_u.xxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -2517,15 +2523,16 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
Term ti;
Term ts[3];
CELL *hi = HR;
ti = MkIntegerTerm(PREG->y_u.xxn.c);
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.xxn.xi);
HR[2] = ti;
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.xxn.xi);
ts[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
HR = hi;
}
#endif /* LOW_LEVEL_TRACE */
@ -2611,12 +2618,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxx.x1);
HR[2] = XREG(PREG->y_u.yxx.x2);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.yxx.x1);
ts[2] = XREG(PREG->y_u.yxx.x2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2735,12 +2743,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
restart_func2s_y_cv:
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
RESET_VARIABLE(HR);
HR[1] = PREG->y_u.yxc.c;
HR[2] = XREG(PREG->y_u.yxc.xi);
Term ts[3];
RESET_VARIABLE(ts);
ts[1] = PREG->y_u.yxc.c;
ts[2] = XREG(PREG->y_u.yxc.xi);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
/* We have to build the structure */
@ -2847,14 +2856,15 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
if (Yap_do_low_level_trace) {
Term ti;
CELL *hi = HR;
Term ts[3];
ti = MkIntegerTerm((Int)(PREG->y_u.yxn.c));
RESET_VARIABLE(HR);
HR[1] = XREG(PREG->y_u.yxn.xi);
HR[2] = ti;
RESET_VARIABLE(ts);
ts[1] = XREG(PREG->y_u.yxn.xi);
ts[2] = ti;
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
HR = hi;
}
#endif /* LOW_LEVEL_TRACE */
@ -2952,12 +2962,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xx, xxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.xxx.x);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3000,12 +3011,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_xy, xxy);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.xxy.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.xxy.x);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3051,12 +3063,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yx, yxx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yxx.x2);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.yxx.x2);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);
@ -3102,12 +3115,13 @@ Yap_AsmError( DOMAIN_ERROR_NOT_LESS_THAN_ZERO );
Op(p_func2f_yy, yyx);
#ifdef LOW_LEVEL_TRACER
if (Yap_do_low_level_trace) {
HR[0] = XREG(PREG->y_u.yyx.x);
RESET_VARIABLE(HR + 1);
RESET_VARIABLE(HR + 2);
Term ts[3];
ts[0] = XREG(PREG->y_u.yyx.x);
RESET_VARIABLE(ts + 1);
RESET_VARIABLE(ts + 2);
low_level_trace(enter_pred,
RepPredProp(Yap_GetPredPropByFunc(FunctorFunctor, 0)),
HR);
ts);
}
#endif /* LOW_LEVEL_TRACE */
BEGD(d0);

91
C/scanner.c
View File

@ -1319,6 +1319,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
TokEntry *t, *l, *p;
enum TokenKinds kind;
int solo_flag = TRUE;
int lvl = push_text_stack();
int32_t ch, och = ' ';
struct qq_struct_t *cur_qq = NULL;
int sign = 1;
@ -1348,6 +1349,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
t->TokNext = NULL;
if (t == NULL) {
pop_text_stack(lvl);
return TrailSpaceError(p, l);
}
if (!l)
@ -1418,7 +1420,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
imgsz = Yap_Min(imgsz * 2, imgsz + MBYTE);
TokImage = Realloc(p0, imgsz);
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
charp =(unsigned char *) TokImage + (charp - p0);
}
@ -1427,7 +1430,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
while (ch == '\'' && isvar &&
trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
if (charp == (unsigned char *)AuxSp - 1024) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
add_ch_to_buff(ch);
ch = getchr(st);
@ -1438,7 +1442,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
/* don't do this in iso */
ae = Yap_LookupAtom(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->TokInfo = MkAtomTerm(ae);
if (ch == '(')
@ -1470,7 +1475,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokInfo = TermError;
}
/* serious error now */
return l;
pop_text_stack(lvl);
return l;
}
ch = cha;
if (cherr) {
@ -1480,7 +1486,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokLine = GetCurInpLine(st);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
} else {
e->TokNext = NULL;
@ -1506,7 +1513,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokLine = GetCurInpLine(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
} else {
e2->TokNext = NULL;
}
@ -1540,7 +1548,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokPos = GetCurInpPos(st);
e2 = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e2 == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
} else {
e2->TokNext = NULL;
}
@ -1570,7 +1579,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
size_t sz = charp-(unsigned char *)TokImage;
TokImage = Realloc(TokImage, (imgsz = Yap_Min(imgsz * 2, imgsz + MBYTE)));
if (TokImage == NULL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
charp = (unsigned char *)TokImage+sz;
break;
@ -1609,20 +1619,23 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokInfo = Yap_CharsToTDQ((char *)TokImage, CurrentModule,
LOCAL_encoding PASS_REGS);
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = String_tok);
} else if (quote == '`') {
t->TokInfo = Yap_CharsToTBQ((char *)TokImage, CurrentModule,
LOCAL_encoding PASS_REGS);
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = String_tok);
} else {
t->TokInfo = MkAtomTerm(Yap_LookupAtom(TokImage));
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1642,7 +1655,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->TokInfo = TermNewLine;
}
t->TokInfo = TermEof;
return l;
pop_text_stack(lvl);
return l;
} else
ch = getchr(st);
break;
@ -1656,9 +1670,11 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
// consume...
if (pch == '%') {
t->TokInfo = TermNewLine;
return l;
pop_text_stack(lvl);
return l;
}
return l;
pop_text_stack(lvl);
return l;
}
if (ch == '`')
goto quoted_string;
@ -1669,7 +1685,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = eot_tok);
if (ch == '%') {
t->TokInfo = TermNewLine;
return l;
pop_text_stack(lvl);
return l;
}
if (chtype(ch) == EF) {
mark_eof(st);
@ -1677,7 +1694,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else {
t->TokInfo = TermNewLine;
}
return l;
pop_text_stack(lvl);
return l;
}
}
if (och == '/' && ch == '*') {
@ -1726,7 +1744,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
t->Tok = Ord(kind = eot_tok);
if (ch == '%') {
t->TokInfo = TermNewLine;
return l;
pop_text_stack(lvl);
return l;
}
if (chtype(ch) == EF) {
mark_eof(st);
@ -1734,7 +1753,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
} else {
t->TokInfo = TermNl;
}
return l;
pop_text_stack(lvl);
return l;
} else {
Atom ae;
charp = (unsigned char *)TokImage;
@ -1744,8 +1764,10 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
size_t sz = charp - (unsigned char *)TokImage;
imgsz = Yap_Min(imgsz * 2, imgsz + MBYTE);
TokImage = Realloc(TokImage, imgsz);
if (!TokImage)
return CodeSpaceError(t, p, l);
if (!TokImage) {
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
charp = (unsigned char *)TokImage+sz;
}
add_ch_to_buff(ch);
@ -1753,11 +1775,13 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
add_ch_to_buff('\0');
ae = Yap_LookupAtom(TokImage);
if (ae == NIL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->TokInfo = MkAtomTerm(ae);
if (t->TokInfo == (CELL)NIL) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
t->Tok = Ord(kind = Name_tok);
if (ch == '(')
@ -1820,15 +1844,16 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
pop_text_stack(lvl);
return l;
}
if (cur_qq) {
LOCAL_ErrorMessage = "quasi quote in quasi quote";
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
Free(qq);
return l;
pop_text_stack(lvl);
return l;
} else {
cur_qq = qq;
}
@ -1865,7 +1890,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
cur_qq = NULL;
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermError;
return l;
pop_text_stack(lvl);
return l;
}
cur_qq = NULL;
t->TokInfo = (CELL)qq;
@ -1910,7 +1936,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
LOCAL_ErrorMessage = "not enough heap space to read in quasi quote";
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermOutOfHeapError;
return l;
pop_text_stack(lvl);
return l;
}
strncpy((char *)mp, (const char *)TokImage, len + 1);
qq->text = (unsigned char *)mp;
@ -1923,7 +1950,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
qq->end.linepos = st->linepos - 1;
qq->end.charno = st->charcount - 1;
if (!(t->TokInfo)) {
return CodeSpaceError(t, p, l);
pop_text_stack(lvl);
return CodeSpaceError(t, p, l);
}
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
solo_flag = FALSE;
@ -1936,7 +1964,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
mark_eof(st);
t->Tok = Ord(kind = eot_tok);
t->TokInfo = TermEof;
return l;
pop_text_stack(lvl);
return l;
default: {
kind = Error_tok;
@ -1951,7 +1980,8 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
/* insert an error token to inform the system of what happened */
TokEntry *e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
if (e == NULL) {
return TrailSpaceError(p, l);
pop_text_stack(lvl);
return TrailSpaceError(p, l);
}
p->TokNext = e;
e->Tok = Error_tok;
@ -1963,6 +1993,7 @@ TokEntry *Yap_tokenizer(struct stream_desc *st, bool store_comments,
p = e;
}
} while (kind != eot_tok);
pop_text_stack(lvl);
return (l);
}

76
CXX/yapi.cpp
View File

@ -411,6 +411,23 @@ std::vector<Term> YAPPairTerm::listToArray() {
return o;
}
std::vector<YAPTerm> YAPPairTerm::listToVector() {
Term *tailp;
Term t1 = gt();
Int l = Yap_SkipList(&t1, &tailp);
if (l < 0) {
throw YAPError(SOURCE(), TYPE_ERROR_LIST, (t), nullptr);
}
std::vector<YAPTerm> o = *new std::vector<YAPTerm>(l);
int i = 0;
Term t = gt();
while (t != TermNil) {
o[i++] = YAPTerm(HeadOfTerm(t));
t = TailOfTerm(t);
}
return o;
}
YAP_tag_t YAPTerm::tag() {
Term tt = gt();
if (IsVarTerm(tt)) {
@ -569,18 +586,18 @@ bool YAPEngine::call(YAPPredicate ap, YAPTerm ts[]) {
q.p = P;
q.cp = CP;
q.b0 = LCL0-CellPtr(B);
q.env0 = LCL0-ENV;
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i].term();
// allow Prolog style exceotion handling
// don't forget, on success these bindings will still be there);
result = YAP_LeaveGoal(true, &q);
result = YAP_EnterGoal(ap.ap, nullptr, &q);
YAP_LeaveGoal(result, &q);
YAPCatchError();
Yap_CloseHandles(q.CurSlot);
pop_text_stack(q.lvl + 1);
RECOVER_MACHINE_REGS();
return result;
}
@ -594,11 +611,14 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) {
// _save = PyEval_SaveThread();
#endif
CACHE_REGS
YAP_dogoalinfo q;
BACKUP_MACHINE_REGS();
Term *ts = nullptr;
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
Int oenv = LCL0-ENV;
Int oB = LCL0-CellPtr(B);
Term omod = CurrentModule;
PredEntry *ap = nullptr;
if (IsStringTerm(tmod))
@ -625,9 +645,10 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) {
//__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
result = (bool)YAP_EnterGoal(ap, nullptr, &q);
// std::cerr << "mgoal " << YAPTerm(tmod).text() << ":" << YAPTerm(t).text() << "\n";
// std::cerr << "mgoal " << YAPTerm(tmod).text() << ":" << YAPTerm(t).text() << "\n
YAP_LeaveGoal(result && !release, &q);
ENV = LCL0-oenv;
B = (choiceptr)(LCL0-oB);
CurrentModule = LOCAL_SourceModule = omod;
// PyEval_RestoreThread(_save);
RECOVER_MACHINE_REGS();
@ -640,19 +661,25 @@ bool YAPEngine::mgoal(Term t, Term tmod, bool release) {
void YAPEngine::release() {
BACKUP_MACHINE_REGS();
YAP_LeaveGoal(FALSE, &q);
// YAP_LeaveGoal(FALSE, &q);
RECOVER_MACHINE_REGS();
}
Term YAPEngine::fun(Term t) {
CACHE_REGS
BACKUP_MACHINE_REGS();
YAP_dogoalinfo q;
Term tmod = Yap_CurrentModule(), *ts = nullptr;
PredEntry *ap;
arity_t arity;
Functor f;
Atom name;
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
Int oenv = LCL0-ENV;
Int oB = LCL0-CellPtr(B);
if (IsApplTerm(t)) {
ts = RepAppl(t) + 1;
f = (Functor)ts[-1];
@ -684,9 +711,6 @@ Term YAPEngine::fun(Term t) {
Term g = (Yap_MkApplTerm(f, arity, ts));
ap = rewriteUndefEngineQuery(ap, g, (ap->ModuleOfPred));
}
q.CurSlot = Yap_StartSlots();
q.p = P;
q.cp = CP;
// make sure this is safe
// allow Prolog style exception handling
//__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "exec ");
@ -699,6 +723,8 @@ Term YAPEngine::fun(Term t) {
YAPCatchError();
{
YAP_LeaveGoal(result, &q);
ENV = LCL0-oenv;
B = (choiceptr)(LCL0-oB);
// PyEval_RestoreThread(_save);
RECOVER_MACHINE_REGS();
return ot;
@ -727,6 +753,27 @@ YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, YAPTerm ts[])
RECOVER_MACHINE_REGS();
}
YAPQuery::YAPQuery(YAPFunctor f, YAPTerm mod, Term ts[])
: YAPPredicate(f, mod) {
/* ignore flags for now */
BACKUP_MACHINE_REGS();
Term goal;
if (ts) {
size_t arity = f.arity();
goal = Yap_MkApplTerm(Yap_MkFunctor(f.name().asAtom(),arity), arity, ts);
nts = RepAppl(goal) + 1;
for (arity_t i = 0; i < arity; i++)
XREGS[i + 1] = ts[i];
} else {
goal = MkVarTerm();
}
openQuery();
names = YAPPairTerm(TermNil);
RECOVER_MACHINE_REGS();
}
#if 0
YAPQuery::YAPQuery(YAPFunctor f, YAPTerm ts[]) : YAPPredicate(f) {
/* ignore flags for now */
@ -766,6 +813,9 @@ bool YAPQuery::next() {
CACHE_REGS
bool result = false;
// std::cerr << "next " << YAPTerm(goal).text() << "\n";
q_h.CurSlot = Yap_StartSlots();
q_h.p = P;
q_h.cp = CP;
sigjmp_buf buf, *oldp = LOCAL_RestartEnv;
e = nullptr;
@ -827,7 +877,7 @@ bool YAPQuery::deterministic() {
BACKUP_MACHINE_REGS();
if (!q_open || q_state == 0)
return false;
choiceptr myB = (choiceptr)(LCL0 - q_h.b);
choiceptr myB = (choiceptr)(LCL0 - q_h.b_entry);
return (B >= myB);
RECOVER_MACHINE_REGS();
}
@ -1093,13 +1143,15 @@ std::stringstream s;
void YAPEngine::reSet() {
/* ignore flags for now */
if (B && B->cp_b && B->cp_ap != NOCODE)
YAP_LeaveGoal(false, &q);
// YAP_LeaveGoal(false, &q);
LOCAL_ActiveError->errorNo = YAP_NO_ERROR;
if (LOCAL_CommittedError) {
LOCAL_CommittedError->errorNo = YAP_NO_ERROR;
free(LOCAL_CommittedError);
LOCAL_CommittedError = NULL;
}
pop_text_stack(0);
LOCAL_CurSlot = 0;
}
Term YAPEngine::top_level(std::string s) {

8
CXX/yapq.hh
View File

@ -39,7 +39,6 @@ class X_API YAPQuery : public YAPPredicate {
bool q_open;
int q_state;
yhandle_t q_handles;
struct yami *q_p, *q_cp;
int q_flags;
YAP_dogoalinfo q_h;
YAPPairTerm names;
@ -54,10 +53,10 @@ class X_API YAPQuery : public YAPPredicate {
q_state = 0;
q_flags = true; // PL_Q_PASS_EXCEPTION;
q_p = P;
q_cp = CP;
q_h.p = P;
q_h.cp = CP;
// make sure this is safe
q_handles = LOCAL_CurSlot;
q_h.CurSlot = LOCAL_CurSlot;
};
void openQuery();
@ -321,7 +320,6 @@ private:
YAPCallback *_callback;
YAPError yerror;
void doInit(YAP_file_type_t BootMode, YAPEngineArgs *cargs);
YAP_dogoalinfo q;
YAPError e;
PredEntry *rewriteUndefEngineQuery(PredEntry *ap, Term &t, Term tmod);

1
H/Yap.h
View File

@ -91,7 +91,6 @@ typedef YAP_Term Term;
#define CellSize sizeof(CELL)
#define SmallSize sizeof(SMALLUNSGN)
typedef YAP_Int Int;
typedef YAP_Float Float;
typedef YAP_handle_t yhandle_t;

12
H/YapText.h
View File

@ -47,20 +47,20 @@ extern const void *MallocExportAsRO(const void *blk);
extern int AllocLevel(void);
#define push_text_stack() \
(/* fprintf(stderr, " + *** %d %s:%s:%d\n", AllocLevel(),*/ \
/* __FILE__, __FUNCTION__, __LINE__), */ \
( fprintf(stderr, " + *** %d %s:%s:%d\n", AllocLevel(), \
__FILE__, __FUNCTION__, __LINE__), \
push_text_stack__(PASS_REGS1))
extern int push_text_stack__(USES_REGS1);
#define pop_text_stack(lvl) \
(/* fprintf(stderr, " - *** %d %s:%s:%d\n", AllocLevel(), __FILE__,*/ \
/* __FUNCTION__, __LINE__), */ \
( fprintf(stderr, " - *** %d %s:%s:%d\n", AllocLevel(), __FILE__, \
__FUNCTION__, __LINE__), \
pop_text_stack__(lvl))
extern int pop_text_stack__(int lvl USES_REGS);
#define pop_output_text_stack(lvl,p) \
(/*fprintf(stderr, "-- *** %d %s:%s:%d\n", AllocLevel(), __FILE__,*/ \
/* __FUNCTION__, __LINE__),*/ \
(fprintf(stderr, "-- *** %d %s:%s:%d\n", AllocLevel(), __FILE__, \
__FUNCTION__, __LINE__), \
pop_output_text_stack__(lvl,p))
extern void *pop_output_text_stack__(int lvl, const void *ox USES_REGS);

2
H/Yapproto.h
View File

@ -247,7 +247,7 @@ extern Term Yap_SaveTerm(Term);
extern Term Yap_SetGlobalVal(Atom, Term);
extern Term Yap_GetGlobal(Atom);
extern Int Yap_DeleteGlobal(Atom);
extern void Yap_AllocateDefaultArena(size_t gsize, int wid);
extern void Yap_AllocateDefaultArena(size_t gsize, int wid, void *cs);
extern CELL *Yap_ArenaLimit(Term arena);
/* grow.c */

1
cmake/Config.cmake
View File

@ -297,6 +297,7 @@ check_function_exists(mkstemp HAVE_MKSTEMP)
check_function_exists(mktemp HAVE_MKTEMP)
check_function_exists(nanosleep HAVE_NANOSLEEP)
check_function_exists(mktime HAVE_MKTIME)
check_function_exists(mtrace HAVE_MTRACE)
check_function_exists(opendir HAVE_OPENDIR)
if (NOT APPLE)
check_function_exists(open_memstream HAVE_OPEN_MEMSTREAM)

1
cmake/Sources.cmake
View File

@ -31,6 +31,7 @@ set (ENGINE_SOURCES
C/corout.c
C/cut_c.c
C/dbase.c
C/dbload.c
C/dlmalloc.c
C/errors.c
C/eval.c

5
config.h.cmake
View File

@ -942,6 +942,11 @@ function. */
#cmakedefine HAVE_MPI_H ${HAVE_MPI_H}
#endif
/* Define to 1 if you have the <mtrace> glibc extension. */
#ifndef HAVE_MPI_H
#cmakedefine HAVE_MTRACE ${HAVE_TRACE}
#endif
/* Older versions of MPZ didn't have XOR */
#ifndef HAVE_MPZ_XOR
#cmakedefine HAVE_MPZ_XOR ${HAVE_MPZ_XOR}

3
include/YapDefs.h
View File

@ -138,12 +138,13 @@ typedef enum {
/* this should be opaque to the user */
typedef struct {
unsigned long b, b0; //> choice-point at entry
unsigned long b0, b_entry, b_exit; //> choice-point at entry
YAP_handle_t CurSlot; //> variables at entry
YAP_handle_t EndSlot; //> variables at successful execution
struct yami *p; //> Program Counter at entry
struct yami *cp; //> Continuation PC at entry
int lvl;
long env0;
unsigned long tr, h;
} YAP_dogoalinfo;

3
include/YapError.h
View File

@ -73,7 +73,8 @@ Yap_Error__(false, __FILE__, __FUNCTION__, __LINE__, id, TermNil, __VA_ARGS__)
{ if ( (TF = Yap_ensure_atom__(__FILE__, __FUNCTION__, __LINE__, T0 ) == 0L ) return false; \
}
INLINE_ONLY Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
//INLINE_ONLY
static Term Yap_ensure_atom__(const char *fu, const char *fi, int line,
Term in) {
Term t = Deref(in);
// Term Context = Deref(ARG2);

14
os/sysbits.c
View File

@ -1933,6 +1933,19 @@ static Int p_sleep(USES_REGS1) {
return FALSE:
#endif
}
static Int
p_mtrace()
{
#ifdef HAVE_MTRACE
Term t = Deref(ARG1);
if (t == TermTrue) mtrace();
else if (t == TermFalse) return muntrace();
else return false;
#endif
return true;
}
void Yap_InitSysPreds(void) {
Yap_InitCPred("log_event", 1, p_log_event, SafePredFlag | SyncPredFlag);
@ -1972,5 +1985,6 @@ void Yap_InitSysPreds(void) {
Yap_InitCPred("rmdir", 2, p_rmdir, SyncPredFlag);
Yap_InitCPred("sleep", 1, p_sleep, SyncPredFlag);
Yap_InitCPred("make_directory", 1, make_directory, SyncPredFlag);
Yap_InitCPred("mtrace", 1, p_mtrace, SyncPredFlag);
}

1
os/writeterm.c
View File

@ -729,6 +729,7 @@ char *Yap_TermToBuffer(Term t, int flags) {
t = Deref(t);
GLOBAL_Stream[sno].encoding = LOCAL_encoding;
GLOBAL_Stream[sno].status |= CloseOnException_Stream_f;
GLOBAL_Stream[sno].status &= ~FreeOnClose_Stream_f;
Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority);
char *new = Yap_MemExportStreamPtr(sno);

47
packages/bee/glucose-4/LICENCE Normal file
View File

@ -0,0 +1,47 @@
Glucose -- Copyright (c) 2009-2014, Gilles Audemard, Laurent Simon
CRIL - Univ. Artois, France
LRI - Univ. Paris Sud, France (2009-2013)
Labri - Univ. Bordeaux, France
Syrup (Glucose Parallel) -- Copyright (c) 2013-2014, Gilles Audemard, Laurent Simon
CRIL - Univ. Artois, France
Labri - Univ. Bordeaux, France
Glucose sources are based on MiniSat (see below MiniSat copyrights). Permissions and copyrights of
Glucose (sources until 2013, Glucose 3.0, single core) are exactly the same as Minisat on which it
is based on. (see below).
Glucose-Syrup sources are based on another copyright. Permissions and copyrights for the parallel
version of Glucose-Syrup (the "Software") are granted, free of charge, to deal with the Software
without restriction, including the rights to use, copy, modify, merge, publish, distribute,
sublicence, and/or sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
- The above and below copyrights notices and this permission notice shall be included in all
copies or substantial portions of the Software;
- The parallel version of Glucose (all files modified since Glucose 3.0 releases, 2013) cannot
be used in any competitive event (sat competitions/evaluations) without the express permission of
the authors (Gilles Audemard / Laurent Simon). This is also the case for any competitive event
using Glucose Parallel as an embedded SAT engine (single core or not).
--------------- Original Minisat Copyrights
Copyright (c) 2003-2006, Niklas Een, Niklas Sorensson
Copyright (c) 2007-2010, Niklas Sorensson
Permission is hereby granted, free of charge, to any person obtaining a copy of this software and
associated documentation files (the "Software"), to deal in the Software without restriction,
including without limitation the rights to use, copy, modify, merge, publish, distribute,
sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or
substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT
NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT
OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

24
packages/bee/glucose-4/README Normal file
View File

@ -0,0 +1,24 @@
Directory overview:
==================
mtl/ Minisat Template Library
core/ A core version of the solver glucose (no main here)
simp/ An extended solver with simplification capabilities
parallel/ A multicore version of glucose
README
LICENSE
Changelog
To build (release version: without assertions, statically linked, etc):
======================================================================
Like minisat....
cd { simp | parallel }
make rs
Usage:
======
in simp directory: ./glucose --help
in parallel directory: ./glucose-syrup --help

11
packages/python/pl2pl.c
View File

@ -114,7 +114,8 @@ static foreign_t array_to_python_view(term_t addr, term_t type, term_t szt,
static foreign_t prolog_list_to_python_list(term_t plist, term_t pyt, term_t tlen) {
size_t sz, i;
PyErr_Clear();
PyErr_Clear();
PyObject *pyl = term_to_python(pyt, true, NULL, true);
term_t targ = PL_new_term_ref();
@ -135,10 +136,10 @@ static foreign_t prolog_list_to_python_list(term_t plist, term_t pyt, term_t tle
PyList_SET_ITEM(pyl, i, t);
}
if (PL_is_variable(tlen)) {
PL_unify_int64(tlen, sz);
} else {
python_assign(tlen, PyLong_FromUnsignedLong(sz), NULL);
}
PL_unify_int64(tlen, sz);
} else {
python_assign(tlen, PyLong_FromUnsignedLong(sz), NULL);
}
pyErrorAndReturn( true);
}

281
packages/python/py2pl.c
View File

@ -76,15 +76,15 @@ static Term python_to_term__(PyObject *pVal) {
t[1] = MkFloatTerm(PyComplex_ImagAsDouble(pVal));
return Yap_MkApplTerm(FunctorI, 2, t);
}
else if (PyUnicode_Check(pVal)) {
}
else if (PyUnicode_Check(pVal)) {
#if PY_MAJOR_VERSION < 3
size_t sz = PyUnicode_GetSize(pVal) + 1;
wchar_t *s = malloc(sizeof(wchar_t) * sz);
sz = PyUnicode_AsWideChar((PyUnicodeObject *)pVal, a, sz - 1);
free(ptr);
size_t sz = PyUnicode_GetSize(pVal) + 1;
wchar_t *s = malloc(sizeof(wchar_t) * sz);
sz = PyUnicode_AsWideChar((PyUnicodeObject *)pVal, a, sz - 1);
free(ptr);
#else
const char *s = PyUnicode_AsUTF8(pVal);
const char *s = PyUnicode_AsUTF8(pVal);
#endif
#if 0
if (false && Yap_AtomInUse(s))
@ -92,72 +92,72 @@ else if (PyUnicode_Check(pVal)) {
else
#endif
if (pyStringToString)
return MkStringTerm(s);
return MkStringTerm(s);
else
return MkAtomTerm(Yap_LookupAtom(s));
}
else if (PyByteArray_Check(pVal)) {
return MkStringTerm(PyByteArray_AsString(pVal));
}
else if (PyByteArray_Check(pVal)) {
return MkStringTerm(PyByteArray_AsString(pVal));
#if PY_MAJOR_VERSION < 3
}
else if (PyString_Check(pVal)) {
return MkStringTerm(PyString_AsString(pVal));
}
else if (PyString_Check(pVal)) {
return MkStringTerm(PyString_AsString(pVal));
#endif
}
else if (PyTuple_Check(pVal)) {
Py_ssize_t sz = PyTuple_Size(pVal);
const char *s;
s = Py_TYPE(pVal)->tp_name;
if (s == NULL)
s = "t";
if (sz == 0) {
}
else if (PyTuple_Check(pVal)) {
Py_ssize_t sz = PyTuple_Size(pVal);
const char *s;
s = Py_TYPE(pVal)->tp_name;
if (s == NULL)
s = "t";
if (sz == 0) {
return MkAtomTerm(YAP_LookupAtom(Py_TYPE(pVal)->tp_name));
}
else {
Functor f = Yap_MkFunctor(Yap_LookupAtom(s), sz);
Term t = Yap_MkNewApplTerm(f, sz);
long i;
CELL *ptr = RepAppl(t) + 1;
for (i = 0; i < sz; i++) {
PyObject *p = PyTuple_GetItem(pVal, i);
if (p == NULL) {
PyErr_Clear();
return false;
}
*ptr++ = python_to_term__(p);
else {
Functor f = Yap_MkFunctor(Yap_LookupAtom(s), sz);
Term t = Yap_MkNewApplTerm(f, sz);
long i;
CELL *ptr = RepAppl(t) + 1;
for (i = 0; i < sz; i++) {
PyObject *p = PyTuple_GetItem(pVal, i);
if (p == NULL) {
PyErr_Clear();
return false;
}
*ptr++ = python_to_term__(p);
}
return t;
}
// PL_reset_term_refs(to);
// fputs(" ||*** ",stderr); Yap_DebugPlWrite(YAP_GetFromSlot(t)); fputs("
// ||***\n",stderr);
}
return t;
}
// PL_reset_term_refs(to);
// fputs(" ||*** ",stderr); Yap_DebugPlWrite(YAP_GetFromSlot(t)); fputs("
// ||***\n",stderr);
}
else if (PyList_Check(pVal)) {
Py_ssize_t i, sz = PyList_GET_SIZE(pVal);
if (sz == 0)
return repr_term(pVal);
Term t = TermNil;
for (i = sz; i > 0; ) {
-- i;
PyObject *p = PyList_GetItem(pVal, i);
if (p == NULL) {
PyErr_Clear();
return false;
}
if (!python_to_term__(p))
return false;
else if (PyList_Check(pVal)) {
Py_ssize_t i, sz = PyList_GET_SIZE(pVal);
if (sz == 0)
return repr_term(pVal);
Term t = TermNil;
for (i = sz; i > 0; ) {
-- i;
PyObject *p = PyList_GetItem(pVal, i);
if (p == NULL) {
PyErr_Clear();
return false;
}
if (!python_to_term__(p))
return false;
t = MkPairTerm(python_to_term__(p), t);
t = MkPairTerm(python_to_term__(p), t);
}
return t;
}
return t;
}
else if (PyDict_Check(pVal)) {
Py_ssize_t pos = 0, tot = PyDict_Size(pVal);
PyObject *key, *value;
Term f, *opt = &f, t, to;
if (tot == 0)
return MkAtomTerm( Yap_LookupAtom("{}"));
while (PyDict_Next(pVal, &pos, &key, &value)) {
else if (PyDict_Check(pVal)) {
Py_ssize_t pos = 0, tot = PyDict_Size(pVal);
PyObject *key, *value;
Term f, *opt = &f, t, to;
if (tot == 0)
return MkAtomTerm( Yap_LookupAtom("{}"));
while (PyDict_Next(pVal, &pos, &key, &value)) {
Term t0[2];
t0[0] = python_to_term__(key);
t0[1] = python_to_term__(value);
@ -169,9 +169,9 @@ else if (PyDict_Check(pVal)) {
*opt = t;
opt = pt+1;
} else {
if (pos == 0) {
return repr_term(pVal);
}
if (pos == 0) {
return repr_term(pVal);
}
*opt = to;
break;
@ -179,7 +179,7 @@ else if (PyDict_Check(pVal)) {
}
return Yap_MkApplTerm(FunctorBraces, 1, &f);
}
return repr_term(pVal);
return repr_term(pVal);
}
@ -197,11 +197,13 @@ X_API YAP_Term pythonToYAP(PyObject *pVal) {
/* fputs("***>>\n", stderr); */
if (pVal == NULL)
Yap_ThrowError(SYSTEM_ERROR_INTERNAL, 0, NULL);
yhandle_t h0 = Yap_CurrentHandle();
Term t = python_to_term__(pVal);
/* fputs("<< *** ", stderr); */
/* Yap_DebugPlWrite(t); */
/* fputs(" ***\n", stderr); */
// Py_DECREF(pVal);
Yap_CloseHandles(h0);
return t;
}
@ -225,13 +227,18 @@ PyObject *py_Local, *py_Global;
*python_assign.
*/
bool python_assign(term_t t, PyObject *exp, PyObject *context) {
PyErr_Print();
bool rc = true;
PyErr_Print();
term_t inp = Yap_CurrentHandle();
context = find_obj(context, t, false);
// Yap_DebugPlWriteln(yt);
switch (PL_term_type(t)) {
case PL_VARIABLE: {
if (context == NULL) // prevent a.V= N*N[N-1]
return python_to_term(exp, t);
PL_reset_term_refs(inp);
rc = python_to_term(exp, t);
break;
}
case PL_STRING: {
@ -240,24 +247,34 @@ bool python_assign(term_t t, PyObject *exp, PyObject *context) {
PL_get_string_chars(t, &s,&l);
if (!context)
context = py_Main;
if (PyObject_SetAttrString(context, s, exp) == 0)
return true;
PyErr_Print();
return false;
if (PyObject_SetAttrString(context, s, exp) == 0) {
PL_reset_term_refs(inp);
;
rc = true;
} else {
PyErr_Print();
PL_reset_term_refs(inp);
rc = false;
}
break;
}
case PL_ATOM: {
char *s = NULL;
PL_get_atom_chars(t, &s);
if (!context)
context = py_Main;
if (PyObject_SetAttrString(context, s, exp) == 0)
return true;
return false;
if (PyObject_SetAttrString(context, s, exp) == 0){
rc = true;
} else {
rc = false;
}
break;
}
case PL_INTEGER:
case PL_FLOAT:
// domain or type erro?
return false;
rc = false;
break;
default: {
term_t tail = PL_new_term_ref(), arg = PL_new_term_ref();
size_t len, i;
@ -271,90 +288,96 @@ bool python_assign(term_t t, PyObject *exp, PyObject *context) {
for (i = 0; i < len; i++) {
PyObject *p;
if (!PL_get_list(t, arg, t)) {
PL_reset_term_refs(tail);
p = Py_None;
}
if ((p = PySequence_GetItem(exp, i)) == NULL)
p = Py_None;
if (!python_assign(arg, p, context)) {
PL_reset_term_refs(tail);
rc = false;
} else {
if ((p = PySequence_GetItem(exp, i)) == NULL)
p = Py_None;
rc = rc && python_assign(arg, p, context);
}
}
} else {
while(PL_is_pair(t)) {
context = find_obj(context, t, false);
}
rc = python_assign(t, exp, context);
}
} else {
functor_t fun;
if (!PL_get_functor(t, &fun)) {
PL_reset_term_refs(tail);
return false;
rc = false;
}
if (fun == FUNCTOR_sqbrackets2) {
// tail is the object o
if (!PL_get_arg(2, t, tail)) {
PL_reset_term_refs(tail);
return false;
}
PyObject *o = term_to_python(tail, true, context, false);
// t now refers to the index
if (!PL_get_arg(1, t, t) || !PL_get_list(t, t, tail) ||
!PL_get_nil(tail)) {
PL_reset_term_refs(tail);
return false;
}
PyObject *i = term_to_python(t, true, NULL, false);
// check numeric
if (PySequence_Check(o) && PyLong_Check(i)) {
long int j;
j = PyLong_AsLong(i);
return PySequence_SetItem(o, j, exp) == 0;
}
rc = false;
} else {
PyObject *o = term_to_python(tail, true, context, false);
// t now refers to the index
if (!PL_get_arg(1, t, t) || !PL_get_list(t, t, tail) ||
!PL_get_nil(tail)) {
rc = false;
} else {
PyObject *i = term_to_python(t, true, NULL, false);
// check numeric
if (PySequence_Check(o) && PyLong_Check(i)) {
long int j;
j = PyLong_AsLong(i);
rc = PySequence_SetItem(o, j, exp) == 0;
}
#if PY_MAJOR_VERSION < 3
if (PySequence_Check(o) && PyInt_Check(i)) {
long int j;
j = PyInt_AsLong(i);
return PySequence_SetItem(o, i, exp) == 0;
}
if (PySequence_Check(o) && PyInt_Check(i)) {
long int j;
j = PyInt_AsLong(i);
szzb rc = PySequence_SetItem(o, i, exp) == 0;
} else
#endif
if (PyDict_Check(o)) {
if (PyDict_SetItem(o, i, exp) == 0) {
return true;
}
}
if (PyObject_SetAttr(o, i, exp) == 0) {
return true;
}
if (PyDict_Check(o)) {
if (PyDict_SetItem(o, i, exp) == 0) {
PL_reset_term_refs(inp);
;
rc = true;
}
}
if (PyObject_SetAttr(o, i, exp) == 0) {
PL_reset_term_refs(inp);
;
rc = true;
}
}
}
} else {
atom_t s;
int n, i;
PL_get_name_arity(t, &s, &n);
PyObject *o = term_to_python(t, true, context, true);
PyErr_Print();
PyErr_Print();
if (PySequence_Check(o) && PySequence_Length(o) == n) {
for (i = 1; i <= n; i++) {
PyObject *p;
if (!PL_get_arg(i, t, arg)) {
PL_reset_term_refs(tail);
o = false;
o = NULL;
p = Py_None;
}
if ((p = PySequence_GetItem(exp, i - 1)) == NULL)
p = Py_None;
else if (!python_assign(arg, p, NULL)) {
PL_reset_term_refs(tail);
o = NULL;
} else {
PyErr_Print();
}
rc = python_assign(arg, p, NULL);
}
return true;
}
}
}
PL_reset_term_refs(tail);
}
PyErr_Print();
return NULL;
}
PyErr_Print();
PL_reset_term_refs(inp);
return rc;
}

21
packages/python/py4yap.h
View File

@ -23,10 +23,14 @@
#undef _XOPEN_SOURCE // python does its own thing
#endif
#undef _POSIX_C_SOURCE
#include <Python.h>
#include <Yap.h>
#include <SWI-Prolog.h>
#ifdef HAVE_STAT
#undef HAVE_STATa
@ -95,7 +99,7 @@ extern PyObject *py_Sys;
extern X_API bool python_in_python;
extern bool pyStringToString;
extern bool python_release_GIL(term_t gstate);
extern bool python_release_GIL(term_t gstate);
extern term_t python_acquire_GIL(void);
static inline Py_ssize_t get_p_int(PyObject *o, Py_ssize_t def) {
@ -201,22 +205,21 @@ extern PyObject *YEC(PyObject *c,PyObject *a ,PyObject *d , int line, const char
extern void YEM(const char *ex, int line, const char *file, const char *code);
extern void pyErrorHandler__(int line, const char *file, const char *code);
#define pyErrorHandler() \
{ \
if (PyErr_Occurred()) { \
#define PyStart() PyErr_Clear()
#define pyErrorHandler() if (PyErr_Occurred()) { \
pyErrorHandler__(__LINE__, __FILE__, __FUNCTION__); \
} \
}
#define pyErrorAndReturn(x) \
{ \
if (PyErr_Occurred()) { \
pyErrorHandler__(__LINE__, __FILE__, __FUNCTION__); \
} \
return (x); \
}
return (x)
// #define pyErrorAndReturn( x, y ) return x
extern PyObject *compound_to_pyeval(term_t t, PyObject *context, bool cvt);
extern PyObject *compound_to_pytree(term_t t, PyObject *context, bool cvt);

8
packages/python/pybips.c
View File

@ -112,12 +112,12 @@ find_obj(PyObject *ob, term_t l, bool eval) {
YAP_Term hd, yt;
py_Context = NULL;
yt = YAP_GetFromSlot(l);
// Yap_DebugPlWriteln(yt);
while (YAP_IsPairTerm(yt)) {
if (l == 0)
return Py_None;
while (YAP_IsPairTerm((yt = YAP_GetFromSlot(l)))) {
hd = YAP_HeadOfTerm(yt);
yt = YAP_TailOfTerm(yt);
YAP_PutInSlot(l, yt);
Yap_PutInHandle(l, YAP_TailOfTerm(yt));
ob = yap_to_python(hd, true, ob, false);
if (!ob) {
return Py_None;

52
packages/python/pypreds.c
View File

@ -20,6 +20,7 @@ void pyErrorHandler__(int line, const char *file, const char *code) {
static foreign_t python_len(term_t tobj, term_t tf) {
Py_ssize_t len;
PyObject *o;
PyStart();
o = term_to_python(tobj, true, NULL, true);
if (o == NULL) {
@ -32,13 +33,14 @@ static foreign_t python_len(term_t tobj, term_t tf) {
static foreign_t python_represent( term_t name, term_t tobj) {
term_t stackp = python_acquire_GIL();
PyObject *e;
PyStart();
e = term_to_python(tobj, false, NULL, false);
if (e == NULL) {
python_release_GIL(stackp);
pyErrorAndReturn(false);
}
bool b = python_assign(name, e, NULL);
foreign_t b = python_assign(name, e, NULL);
python_release_GIL(stackp);
pyErrorAndReturn(b);
}
@ -53,6 +55,7 @@ static foreign_t python_clear_errors(void) {
static foreign_t python_dir(term_t tobj, term_t tf) {
PyObject *dir;
PyObject *o;
PyStart();
o = term_to_python(tobj, true, NULL, true);
if (o == NULL) {
@ -70,6 +73,7 @@ static foreign_t python_index(term_t tobj, term_t tindex, term_t val) {
PyObject *i;
PyObject *o;
PyObject *f;
PyStart();
o = term_to_python(tobj, true, NULL, true);
if (o == NULL) {
@ -96,6 +100,7 @@ static foreign_t python_index(term_t tobj, term_t tindex, term_t val) {
static foreign_t python_is(term_t tobj, term_t tf) {
PyObject *o;
PyStart();
term_t lim = python_acquire_GIL();
@ -112,13 +117,13 @@ static foreign_t python_is(term_t tobj, term_t tf) {
}
static foreign_t python_proc(term_t tobj) {
PyStart();
PyObject *o;
term_t lim = python_acquire_GIL();
o = term_to_python(tobj, true, NULL, true);
python_release_GIL(lim);
bool rc = o != NULL;
foreign_t rc = o != NULL;
pyErrorAndReturn(rc);
}
@ -134,9 +139,7 @@ static foreign_t python_slice(term_t parent, term_t indx, term_t tobj) {
p = term_to_python(parent, true, NULL, true);
// Exp
if (!pI || !p) {
{
pyErrorAndReturn(false);
}
pyErrorAndReturn(false);
} else if ((pF = PySequence_GetSlice(p, 0, 0)) == NULL) {
PyErr_Print();
{ pyErrorAndReturn(false); }
@ -153,6 +156,7 @@ static foreign_t python_slice(term_t parent, term_t indx, term_t tobj) {
static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
term_t tf) {
PyStart();
PyObject *pF;
PyObject *pArgs, *pKeywords;
PyObject *pValue;
@ -162,7 +166,6 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
term_t targ = PL_new_term_ref();
pF = term_to_python(tin, true, NULL, true);
PyErr_Clear();
if (pF == NULL) {
{
pyErrorAndReturn(false);
@ -237,6 +240,7 @@ static foreign_t python_apply(term_t tin, term_t targs, term_t keywds,
}
static foreign_t assign_python(term_t exp, term_t name) {
PyStart();
term_t stackp = python_acquire_GIL();
PyObject *e = term_to_python(exp, true, NULL, true);
@ -244,7 +248,7 @@ static foreign_t assign_python(term_t exp, term_t name) {
python_release_GIL(stackp);
pyErrorAndReturn(false);
}
bool b = python_assign(name, e, NULL);
foreign_t b = python_assign(name, e, NULL);
python_release_GIL(stackp);
pyErrorAndReturn(b);
}
@ -269,7 +273,7 @@ static foreign_t python_string_to(term_t f) {
}
static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
PyErr_Clear();
PyStart();
PyObject *pI, *pArgs, *pOut;
PyObject *env;
atom_t name;
@ -331,7 +335,7 @@ static foreign_t python_builtin_eval(term_t caller, term_t dict, term_t out) {
}
static foreign_t python_access(term_t obj, term_t f, term_t out) {
PyErr_Clear();
PyStart();
PyObject *o = term_to_python(obj, true, NULL, true), *pValue, *pArgs, *pF;
atom_t name;
char *s = NULL;
@ -400,7 +404,7 @@ static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
atom_t name;
char *s;
int arity;
PyStart();
if (!PL_get_name_arity(att, &name, &arity)) {
{
pyErrorAndReturn(false);
@ -448,14 +452,14 @@ static foreign_t python_field(term_t parent, term_t att, term_t tobj) {
static foreign_t python_main_module(term_t mod) {
{
foreign_t rc;
PyErr_Clear();
PyStart();
rc = address_to_term(py_Main, mod);
pyErrorAndReturn(rc);
}
}
static foreign_t python_function(term_t tobj) {
PyErr_Clear();
PyStart();
PyObject *obj = term_to_python(tobj, true, NULL, true);
foreign_t rc = PyFunction_Check(obj);
@ -465,7 +469,7 @@ static foreign_t python_function(term_t tobj) {
foreign_t python_builtin(term_t out) {
{
foreign_t rc;
PyErr_Clear();
PyStart();
rc = address_to_term(py_Builtin, out);
pyErrorAndReturn(rc);
}
@ -476,7 +480,7 @@ static foreign_t python_run_file(term_t file) {
size_t len;
char si[256];
s = si;
PyErr_Clear();
PyStart();
if (PL_get_nchars(file, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
#if PY_MAJOR_VERSION < 3
PyObject *PyFileObject = PyFile_FromString(si, "r");
@ -499,11 +503,11 @@ extern PyThreadState *YAP_save;
static foreign_t python_run_command(term_t cmd) {
char *s;
bool rc = false;
foreign_t rc = false;
size_t len;
char si[256];
PyErr_Clear();
PyStart();
s = si;
if (PL_get_nchars(cmd, &len, &s, CVT_ALL | CVT_EXCEPTION)) {
PyRun_SimpleString(s);
@ -519,7 +523,7 @@ static foreign_t python_run_script(term_t cmd, term_t fun) {
PyObject *pArgs = NULL, *pValue;
char *s;
PyErr_Clear();
PyStart();
s = si;
if (PL_get_nchars(cmd, &len, &s, CVT_ALL | CVT_EXCEPTION) &&
(s = sf) != NULL &&
@ -571,7 +575,7 @@ static foreign_t python_run_script(term_t cmd, term_t fun) {
static foreign_t python_export(term_t t, term_t pl) {
foreign_t rc = false;
PyErr_Clear();
PyStart();
if (PL_is_functor(t, FUNCTOR_pointer1)) {
void *ptr;
term_t targ = PL_new_term_ref();
@ -600,7 +604,8 @@ static foreign_t python_export(term_t t, term_t pl) {
*/
static int python_import(term_t mname, term_t mod) {
PyObject *pName;
bool do_as = false;
foreign_t do_as = false;
PyStart();
char s0[MAXPATHLEN], *s = s0;
s[0] = '\0';
@ -673,7 +678,7 @@ static int python_import(term_t mname, term_t mod) {
static foreign_t python_to_rhs(term_t inp, term_t t) {
PyObject *pVal;
PyErr_Clear();
PyStart();
pVal = term_to_python(inp, true, NULL, true);
if (pVal == NULL)
pyErrorAndReturn(false);
@ -681,7 +686,7 @@ static foreign_t python_to_rhs(term_t inp, term_t t) {
}
// static PyThreadState *_saveP = NULL;
static bool _threaded = true;
static foreign_t _threaded = true;
/*
static YAP_Int
@ -707,7 +712,7 @@ PyThreadState *tstate;
static YAP_Int p_python_threaded(void) {
PyErr_Clear();
PyStart();
// PyEval_ReleaseThread(tstate);
// _threaded = true;
// _locked = 0;
@ -730,7 +735,6 @@ term_t python_acquire_GIL(void) {
PL_put_integer(curSlot, gstatei++);
return curSlot;
}
bool python_release_GIL(term_t curBlock) {
int gstateix;
gstatei--;

3
pl/absf.yap
View File

@ -334,7 +334,7 @@ prolog_file_name(File, PrologFileName) :-
system:true_file_name(File, PrologFileName).
prolog_file_name(File, PrologFileName) :-
'$do_error'(type_error(atom,File), prolog_file_name(File, PrologFileName)).
:- start_low_level_trace.
/**
@pred path(-Directories:list) is det,deprecated
@ -344,6 +344,7 @@ prolog_file_name(File, PrologFileName) :-
*/
path(Path) :-
findall(X,'$in_path'(X),Path).
:- stop_low_level_trace.
'$in_path'(X) :-
recorded('$path',Path,_),

2
pl/undefined.yap
View File

@ -133,7 +133,7 @@ undefined_query(G0, M0, Cut) :-
% we found an import, and call again
% we have user code in the unknown_predicate
% we fail, output a message, and just generate an exception.
'$undefp'([M0|G0],ok) :-
'$undefp'([M0|G0],_) :-
'$search_undef'(M0:G0, M:G),
'$trace'(M:G).