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

try to reduce overheads when running with goal expansion enabled. 

CLPBN fixes
Handle overflows when allocating big clauses properly.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1193 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-12-05 05:01:45 +00:00
parent 94af3000fe
commit 5143aebb01
27 changed files with 396 additions and 339 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-11-19 22:08:35 $,$Author: vsc $ *
* Last rev: $Date: 2004-12-05 05:01:21 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.153 2004/11/19 22:08:35 vsc
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
*
* Revision 1.152 2004/11/19 17:14:12 vsc
* a few fixes for 64 bit compiling.
*
@ -2391,7 +2394,7 @@ Yap_absmi(int inp)
NoStackCall:
/* on X86 machines S will not actually be holding the pointer to pred */
if (ActiveSignals == YAP_CREEP_SIGNAL) {
if (ActiveSignals & YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.sla.sla_u.p;
if (ap->PredFlags & HiddenPredFlag) {
CACHE_Y_AS_ENV(YREG);
@ -2458,7 +2461,7 @@ Yap_absmi(int inp)
so I don't need to redo it.
*/
NoStackDeallocate:
if (ActiveSignals == YAP_CREEP_SIGNAL) {
if (ActiveSignals & YAP_CREEP_SIGNAL) {
GONext();
}
ASP = YREG;
@ -2494,7 +2497,7 @@ Yap_absmi(int inp)
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_y;
}
if (ActiveSignals != YAP_CREEP_SIGNAL) {
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
XREGS[0] = YREG[PREG->u.y.y];
PREG = NEXTOP(PREG,y);
@ -2509,7 +2512,7 @@ Yap_absmi(int inp)
if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_x;
}
if (ActiveSignals != YAP_CREEP_SIGNAL) {
if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(Yap_MkFunctor(AtomRestoreRegs,2),0));
#if USE_THREADED_CODE
if (PREG->opc == (OPCODE)OpAddress[_fcall])
@ -2535,7 +2538,7 @@ Yap_absmi(int inp)
/* don't forget I cannot creep at ; */
NoStackEither:
if (ActiveSignals == YAP_CREEP_SIGNAL) {
if (ActiveSignals & YAP_CREEP_SIGNAL) {
goto either_notest;
}
/* find something to fool S */
@ -2611,7 +2614,7 @@ Yap_absmi(int inp)
goto creep;
NoStackDExecute:
if (ActiveSignals == YAP_CREEP_SIGNAL) {
if (ActiveSignals & YAP_CREEP_SIGNAL) {
PredEntry *ap = PREG->u.p.p;
if (ap->PredFlags & HiddenPredFlag) {
@ -12237,7 +12240,7 @@ Yap_absmi(int inp)
goto execute_metacall;
}
pen = RepPredProp(PredPropByFunc(f, mod));
if (pen->PredFlags & MetaPredFlag) {
if (pen->PredFlags & (MetaPredFlag|GoalExPredFlag)) {
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,d0);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
@ -12289,7 +12292,7 @@ Yap_absmi(int inp)
goto execute_metacall;
}
}
if (PRED_GOAL_EXPANSION_ON) {
if (PRED_GOAL_EXPANSION_ALL) {
goto execute_metacall;
}
@ -12313,7 +12316,7 @@ Yap_absmi(int inp)
ENDP(pt1);
CACHE_A1();
} else if (IsAtomTerm(d0)) {
if (PRED_GOAL_EXPANSION_ON) {
if (PRED_GOAL_EXPANSION_ALL) {
goto execute_metacall;
} else {
pen = RepPredProp(PredPropByAtom(AtomOfTerm(d0), mod));
@ -12424,7 +12427,7 @@ Yap_absmi(int inp)
}
#endif /* FROZEN_STACKS */
arity = pen->ArityOfPE;
if (pen->PredFlags & MetaPredFlag) {
if (pen->PredFlags & (MetaPredFlag|GoalExPredFlag)) {
mod = pt0[-EnvSizeInCells-3];
if (pen->FunctorOfPred == FunctorComma) {
SREG = RepAppl(d0);
@ -12502,7 +12505,7 @@ Yap_absmi(int inp)
goto execute_comma_comma2;
} else {
pen = RepPredProp(PredPropByFunc(f,mod));
if (pen->PredFlags & MetaPredFlag) {
if (pen->PredFlags & (MetaPredFlag|GoalExPredFlag)) {
goto execute_metacall_after_comma;
}
arity = pen->ArityOfPE;

25
C/adtdefs.c
View File

@ -526,10 +526,16 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
#endif /* TABLING */
/* careful that they don't cross MkFunctor */
p->NextOfPE = fe->PropsOfFE;
if (PRED_GOAL_EXPANSION_FUNC) {
if (fe->PropsOfFE &&
(RepPredProp(fe->PropsOfFE)->PredFlags & GoalExPredFlag)) {
p->PredFlags |= GoalExPredFlag;
}
}
fe->PropsOfFE = p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)fe;
WRITE_UNLOCK(fe->FRWLock);
return (p0);
return p0;
}
#if THREADS
@ -599,10 +605,25 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
#endif /* TABLING */
/* careful that they don't cross MkFunctor */
p->NextOfPE = ae->PropsOfAE;
if (PRED_GOAL_EXPANSION_FUNC) {
Prop p1 = ae->PropsOfAE;
while (p1) {
PredEntry *pe = RepPredProp(p1);
if (pe->KindOfPE == PEProp) {
if (pe->PredFlags & GoalExPredFlag) {
p->PredFlags |= GoalExPredFlag;
}
break;
}
p1 = pe->NextOfPE;
}
}
ae->PropsOfAE = p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
WRITE_UNLOCK(ae->ARWLock);
return (p0);
return p0;
}
Prop

10
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: *
* mods: *
* comments: allocating space *
* version:$Id: alloc.c,v 1.67 2004-12-02 06:06:45 vsc Exp $ *
* version:$Id: alloc.c,v 1.68 2004-12-05 05:01:22 vsc Exp $ *
*************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
@ -111,7 +111,7 @@ Yap_InitPreAllocCodeSpace(void)
}
ADDR
Yap_ExpandPreAllocCodeSpace(UInt sz0)
Yap_ExpandPreAllocCodeSpace(UInt sz0, void *cip)
{
char *ptr;
UInt sz = ScratchPad.msz;
@ -123,7 +123,7 @@ Yap_ExpandPreAllocCodeSpace(UInt sz0)
while (!(ptr = realloc(ScratchPad.ptr, sz))) {
#if USE_DL_MALLOC
if (!Yap_growheap(FALSE, sz, NULL)) {
if (!Yap_growheap((cip!=NULL), sz, cip)) {
return NULL;
}
#else
@ -572,9 +572,9 @@ Yap_AllocCodeSpace(unsigned int size)
}
ADDR
Yap_ExpandPreAllocCodeSpace(UInt sz)
Yap_ExpandPreAllocCodeSpace(UInt sz, void *cip)
{
if (!Yap_growheap(FALSE, sz, NULL)) {
if (!Yap_growheap((cip!=NULL), sz, cip)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return NULL;
}

107
C/amasm.c
View File

@ -11,8 +11,11 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2004-11-19 22:08:41 $ *
* Last rev: $Date: 2004-12-05 05:01:23 $ *
* $Log: not supported by cvs2svn $
* Revision 1.66 2004/11/19 22:08:41 vsc
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
*
* Revision 1.65 2004/10/26 20:15:48 vsc
* More bug fixes for overflow handling
*
@ -2938,6 +2941,63 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
return code_p;
}
static DBTerm *
fetch_clause_space(Term* tp, UInt size, struct intermediates *cip)
{
CELL *h0 = H;
DBTerm *x;
/* This stuff should be just about fetching the space from the data-base,
unfortunately we have to do all sorts of error handling :-( */
H = (CELL *)cip->freep;
while ((x = Yap_StoreTermInDBPlusExtraSpace(*tp, size)) == NULL) {
H = h0;
switch (Yap_Error_TYPE) {
case OUT_OF_STACK_ERROR:
Yap_Error_Size = 256+((char *)cip->freep - (char *)H);
save_machine_regs();
longjmp(cip->CompilerBotch,3);
case OUT_OF_TRAIL_ERROR:
/* don't just return NULL */
ARG1 = *tp;
if (!Yap_growtrail(64 * 1024L)) {
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
*tp = ARG1;
break;
case OUT_OF_AUXSPACE_ERROR:
ARG1 = *tp;
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, (void *)cip)) {
H = (CELL *)H[-1];
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
*tp = ARG1;
break;
case OUT_OF_HEAP_ERROR:
/* don't just return NULL */
ARG1 = *tp;
if (!Yap_growheap(TRUE, size, cip)) {
H = (CELL *)H[-1];
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
*tp = ARG1;
break;
default:
return NULL;
}
h0 = H;
H = (CELL *)cip->freep;
}
H = h0;
return x;
}
yamop *
Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates *cip)
{
@ -2965,18 +3025,9 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
!is_fact) {
DBTerm *x;
LogUpdClause *cl;
CELL *h0 = H;
H = (CELL *)cip->freep;
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
*H++ = (CELL)h0;
if (!Yap_growheap(TRUE, size, cip)) {
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
return NULL;
}
h0 = (CELL *)*--H;
}
H = h0;
if(!(x = fetch_clause_space(&t,size,cip)))
return NULL;
cl = (LogUpdClause *)((CODEADDR)x-(UInt)size);
cl->ClSource = x;
cip->code_addr = (yamop *)cl;
@ -2986,36 +3037,8 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
!is_fact) {
DBTerm *x;
StaticClause *cl;
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
switch (Yap_Error_TYPE) {
case OUT_OF_STACK_ERROR:
Yap_Error_Size = 256+((char *)cip->freep - (char *)H);
save_machine_regs();
longjmp(cip->CompilerBotch,3);
case OUT_OF_TRAIL_ERROR:
/* don't just return NULL */
ARG1 = t;
if (!Yap_growtrail(64 * 1024L)) {
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
t = ARG1;
break;
case OUT_OF_HEAP_ERROR:
/* don't just return NULL */
ARG1 = t;
if (!Yap_growheap(TRUE, size, cip)) {
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
t = ARG1;
break;
default:
return NULL;
}
}
if(!(x = fetch_clause_space(&t,size,cip)))
return NULL;
cl = (StaticClause *)((CODEADDR)x-(UInt)size);
cip->code_addr = (yamop *)cl;
code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, cip, size);

155
C/cdmgr.c
View File

@ -11,8 +11,13 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2004-11-18 22:32:31 $,$Author: vsc $ *
* Last rev: $Date: 2004-12-05 05:01:23 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.142 2004/11/18 22:32:31 vsc
* fix situation where we might assume nonextsing double initialisation of C predicates (use
* Hidden Pred Flag).
* $host_type was double initialised.
*
* Revision 1.141 2004/11/04 18:22:31 vsc
* don't ever use memory that has been freed (that was done by LU).
* generic fixes for WIN32 libraries
@ -306,7 +311,6 @@ static_in_use(PredEntry *p, int check_everything)
#define is_dynamic(pe) (pe->PredFlags & DynamicPredFlag)
#define is_static(pe) (pe->PredFlags & CompiledPredFlag)
#define is_fast(pe) (pe->PredFlags & FastPredFlag)
#define is_logupd(pe) (pe->PredFlags & LogUpdatePredFlag)
#ifdef TABLING
#define is_tabled(pe) (pe->PredFlags & TabledPredFlag)
@ -1580,6 +1584,64 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
}
if (pflags & SpiedPredFlag)
spy_flag = TRUE;
if (p == PredGoalExpansion) {
Term tg = ArgOfTerm(1, tf);
Term tm = ArgOfTerm(2, tf);
if (IsVarTerm(tg) || IsVarTerm(tm)) {
if (!IsVarTerm(tg)) {
/* this is the complicated case, first I need to inform
predicates for this functor */
PRED_GOAL_EXPANSION_FUNC = TRUE;
if (IsAtomTerm(tg)) {
AtomEntry *ae = RepAtom(AtomOfTerm(tg));
Prop p0 = ae->PropsOfAE;
int found = FALSE;
while (p0) {
PredEntry *pe = RepPredProp(p0);
if (pe->KindOfPE == PEProp) {
pe->PredFlags |= GoalExPredFlag;
found = TRUE;
}
p0 = pe->NextOfPE;
}
if (!found) {
PredEntry *npe = RepPredProp(PredPropByAtom(AtomOfTerm(tg),IDB_MODULE));
npe->PredFlags |= GoalExPredFlag;
}
} else if (IsApplTerm(tg)) {
FunctorEntry *fe = (FunctorEntry *)FunctorOfTerm(tg);
Prop p0;
int found = FALSE;
p0 = fe->PropsOfFE;
while (p0) {
PredEntry *pe = RepPredProp(p0);
pe->PredFlags |= GoalExPredFlag;
found = TRUE;
}
if (!found) {
PredEntry *npe = RepPredProp(PredPropByFunc(fe,IDB_MODULE));
npe->PredFlags |= GoalExPredFlag;
}
}
} else {
PRED_GOAL_EXPANSION_ALL = TRUE;
}
} else {
if (IsAtomTerm(tm)) {
if (IsAtomTerm(tg)) {
PredEntry *p = RepPredProp(PredPropByAtom(AtomOfTerm(tg), tm));
p->PredFlags |= GoalExPredFlag;
} else if (IsApplTerm(tg)) {
PredEntry *p = RepPredProp(PredPropByFunc(FunctorOfTerm(tg), tm));
p->PredFlags |= GoalExPredFlag;
}
}
}
}
if (mode == consult)
not_was_reconsulted(p, t, TRUE);
/* always check if we have a valid error first */
@ -2437,6 +2499,91 @@ p_is_dynamic(void)
return(out);
}
static Int
p_is_metapredicate(void)
{ /* '$is_metapredicate'(+P) */
PredEntry *pe;
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
Int out;
if (IsVarTerm(t)) {
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
} else
return (FALSE);
if (EndOfPAEntr(pe))
return FALSE;
READ_LOCK(pe->PRWLock);
out = (pe->PredFlags & MetaPredFlag);
READ_UNLOCK(pe->PRWLock);
return out;
}
static Int
p_is_expandgoalormetapredicate(void)
{ /* '$is_expand_goal_predicate'(+P) */
PredEntry *pe;
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
Int out;
if (PRED_GOAL_EXPANSION_ALL)
return TRUE;
if (IsVarTerm(t)) {
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(Yap_GetPredPropByAtom(at, mod));
if (EndOfPAEntr(pe)) {
if (PRED_GOAL_EXPANSION_FUNC) {
Prop p1 = RepAtom(at)->PropsOfAE;
while (p1) {
PredEntry *pe = RepPredProp(p1);
if (pe->KindOfPE == PEProp) {
if (pe->PredFlags & GoalExPredFlag) {
PredPropByAtom(at, mod);
return TRUE;
} else {
return FALSE;
}
}
p1 = pe->NextOfPE;
}
}
return FALSE;
}
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
if (EndOfPAEntr(pe)) {
if (PRED_GOAL_EXPANSION_FUNC) {
FunctorEntry *fe = (FunctorEntry *)fun;
if (fe->PropsOfFE &&
(RepPredProp(fe->PropsOfFE)->PredFlags & GoalExPredFlag)) {
PredPropByFunc(fun, mod);
return TRUE;
}
}
return FALSE;
}
} else {
return FALSE;
}
READ_LOCK(pe->PRWLock);
out = (pe->PredFlags & (GoalExPredFlag|MetaPredFlag));
READ_UNLOCK(pe->PRWLock);
return(out);
}
static Int
p_pred_exists(void)
{ /* '$pred_exists'(+P,+M) */
@ -2610,7 +2757,7 @@ p_kill_dynamic(void)
pe->cs.p_code.LastClause = pe->cs.p_code.FirstClause = NIL;
pe->OpcodeOfPred = UNDEF_OPCODE;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
pe->PredFlags = 0L;
pe->PredFlags = pe->PredFlags & GoalExPredFlag;
WRITE_UNLOCK(pe->PRWLock);
return (TRUE);
}
@ -4184,6 +4331,8 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$purge_clauses", 2, p_purge_clauses, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$is_dynamic", 2, p_is_dynamic, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_metapredicate", 2, p_is_metapredicate, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag|HiddenPredFlag);

33
C/compiler.c
View File

@ -11,8 +11,11 @@
* File: compiler.c *
* comments: Clause compiler *
* *
* Last rev: $Date: 2004-11-19 22:08:41 $,$Author: vsc $ *
* Last rev: $Date: 2004-12-05 05:01:23 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.54 2004/11/19 22:08:41 vsc
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
*
* Revision 1.53 2004/09/03 03:11:08 vsc
* memory management fixes
*
@ -2742,44 +2745,44 @@ c_optimize(PInstr *pc)
}
yamop *
Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
{ /* compile a prolog clause, copy of clause myst be in ARG1 */
/* returns address of code for clause */
Term head, body;
yamop *acode;
Term my_clause;
volatile int maxvnum = 512;
int botch_why;
volatile Term my_clause = inp_clause;
/* may botch while doing a different module */
/* first, initialise cglobs->cint.CompilerBotch to handle all cases of interruptions */
compiler_struct cglobs;
compiler_struct cglobs;
Yap_ErrorMessage = NULL;
Yap_Error_Size = 0;
/* make sure we know there was no error yet */
Yap_ErrorMessage = NULL;
if ((botch_why = setjmp(cglobs.cint.CompilerBotch)) == 3) {
/* out of local stack, just duplicate the stack */
restore_machine_regs();
reset_vars(cglobs.vtable);
{
Int osize = 2*sizeof(CELL)*(ASP-H);
ARG1 = my_clause;
*H++ = src;
ARG1 = inp_clause;
ARG3 = src;
YAPLeaveCriticalSection();
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
if (!Yap_gcl(Yap_Error_Size, 3, ENV, P)) {
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Term = my_clause;
Yap_Error_Term = inp_clause;
}
if (osize > ASP-H) {
if (!Yap_growstack(2*sizeof(CELL)*(ASP-H))) {
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Term = my_clause;
Yap_Error_Term = inp_clause;
}
}
YAPEnterCriticalSection();
src = *--H;
my_clause = ARG1;
src = ARG3;
inp_clause = ARG1;
}
} else if (botch_why == 4) {
/* out of temporary cells */
@ -2799,12 +2802,15 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
return(0);
}
restart_compilation:
my_clause = inp_clause;
if (Yap_ErrorMessage != NULL) {
reset_vars(cglobs.vtable);
return (0);
}
HB = H;
Yap_ErrorMessage = NULL;
Yap_Error_Size = 0;
Yap_Error_TYPE = YAP_NO_ERROR;
/* initialize variables for code generation */
cglobs.cint.CodeStart = cglobs.cint.cpc = NULL;
@ -2939,7 +2945,6 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
/* check first if there was space for us */
if (acode == NULL) {
/* make sure we have enough space */
reset_vars(cglobs.vtable);
if (!Yap_growheap(FALSE, Yap_Error_Size, NULL)) {
save_machine_regs();
my_clause = Deref(ARG1);

2
C/dbase.c
View File

@ -288,7 +288,7 @@ recover_from_record_error(int nargs)
}
goto recover_record;
case OUT_OF_AUXSPACE_ERROR:
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size)) {
if (!Yap_ExpandPreAllocCodeSpace(Yap_Error_Size, NULL)) {
Yap_Error(OUT_OF_AUXSPACE_ERROR, Yap_Error_Term, Yap_ErrorMessage);
return FALSE;
}

2
C/errors.c
View File

@ -104,7 +104,7 @@ DumpActiveGoals (void)
READ_UNLOCK(pe->PRWLock);
break;
}
if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag | FastPredFlag))
if (pe->PredFlags & (CompiledPredFlag | DynamicPredFlag))
{
Functor f;
Term mod = TermProlog;

12
C/exec.c
View File

@ -130,13 +130,12 @@ do_execute(Term t, Term mod)
{
/* first do predicate expansion, even before you process signals.
This way you don't get to spy goal_expansion(). */
if (PRED_GOAL_EXPANSION_ON) {
if (PRED_GOAL_EXPANSION_ALL) {
LOCK(SignalLock);
/* disable creeping when we do goal expansion */
if (ActiveSignals & YAP_CREEP_SIGNAL) {
ActiveSignals &= ~YAP_CREEP_SIGNAL;
CreepFlag = CalculateStackGap();
DelayedTrace = TRUE;
}
UNLOCK(SignalLock);
return CallMetaCall(mod);
@ -161,7 +160,7 @@ do_execute(Term t, Term mod)
pen = RepPredProp(PredPropByFunc(f, mod));
/* You thought we would be over by now */
/* but no meta calls require special preprocessing */
if (pen->PredFlags & MetaPredFlag) {
if (pen->PredFlags & (GoalExPredFlag|MetaPredFlag)) {
if (f == FunctorModule) {
Term tmod = ArgOfTerm(1,t);
if (!IsVarTerm(tmod) && IsAtomTerm(tmod)) {
@ -256,11 +255,7 @@ p_execute0(void)
unsigned int arity;
Prop pe;
if (ActiveSignals || DelayedTrace) {
if (DelayedTrace) {
DelayedTrace = FALSE;
ActiveSignals |= YAP_CREEP_SIGNAL;
}
if (ActiveSignals) {
return EnterCreepMode(t, mod);
}
restart_exec:
@ -1537,7 +1532,6 @@ Yap_InitYaamRegs(void)
WPP = NULL;
PREG_ADDR = NULL;
#endif
DelayedTrace = FALSE;
}
static Int

2
C/grow.c
View File

@ -1279,7 +1279,7 @@ Yap_shift_visit(CELL **to_visit, CELL ***to_visit_maxp)
CELL **to_visit_max = *to_visit_maxp;
Int sz1 = (CELL)to_visit_max-(CELL)to_visit;
Int sz0 = AuxTop - (ADDR)to_visit_maxp, sz, dsz;
char *newb = Yap_ExpandPreAllocCodeSpace(0);
char *newb = Yap_ExpandPreAllocCodeSpace(0, NULL);
/* check new size */
sz = AuxTop-newb;

2
C/heapgc.c
View File

@ -3417,7 +3417,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
if (bp+alloc_sz > (char *)AuxSp) {
/* not enough space */
*--ASP = (CELL)current_env;
bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz);
bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL);
current_env = (CELL *)*ASP;
ASP++;
}

11
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2004-11-19 22:08:42 $,$Author: vsc $ *
* Last rev: $Date: 2004-12-05 05:01:24 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.108 2004/11/19 22:08:42 vsc
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
*
* Revision 1.107 2004/11/19 17:14:14 vsc
* a few fixes for 64 bit compiling.
*
@ -7864,10 +7867,8 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
break;
#endif
case _spy_pred:
if (!(ap->PredFlags & MetaPredFlag)) {
ipc = ap->cs.p_code.TrueCodeOfPred;
break;
}
ipc = ap->cs.p_code.TrueCodeOfPred;
break;
case _index_pred:
XREGS[ap->ArityOfPE+1] = (CELL)s_reg;
XREGS[ap->ArityOfPE+2] = (CELL)t;

2
C/init.c
View File

@ -881,6 +881,8 @@ InitCodes(void)
}
Yap_heap_regs->system_profiling = FALSE;
Yap_heap_regs->system_call_counting = FALSE;
Yap_heap_regs->system_pred_goal_expansion_all = FALSE;
Yap_heap_regs->system_pred_goal_expansion_func = FALSE;
Yap_heap_regs->system_pred_goal_expansion_on = FALSE;
Yap_heap_regs->update_mode = UPDATE_MODE_LOGICAL;
Yap_heap_regs->consultbase = Yap_heap_regs->consultsp =

21
C/stdpreds.c
View File

@ -11,8 +11,13 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2004-12-02 06:06:46 $,$Author: vsc $ *
* Last rev: $Date: 2004-12-05 05:01:25 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.75 2004/12/02 06:06:46 vsc
* fix threads so that they at least start
* allow error handling to work with threads
* replace heap_base by Yap_heap_base, according to Yap's convention for globals.
*
* Revision 1.74 2004/11/19 22:08:43 vsc
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
*
@ -939,7 +944,7 @@ p_name(void)
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0, NULL))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
@ -1017,7 +1022,7 @@ p_atom_chars(void)
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0,NULL))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
@ -1055,7 +1060,7 @@ p_atom_chars(void)
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0,NULL))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
@ -1279,7 +1284,7 @@ p_atom_codes(void)
char *nString;
*H++ = t;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0))->StrOfAE;
nString = ((AtomEntry *)Yap_ExpandPreAllocCodeSpace(0,NULL))->StrOfAE;
t = *--H;
s = nString+(s-String);
String = nString;
@ -1477,7 +1482,7 @@ p_number_chars(void)
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0);
nString = Yap_ExpandPreAllocCodeSpace(0,NULL);
t = *--H;
s = nString+(s-String);
String = nString;
@ -1515,7 +1520,7 @@ p_number_chars(void)
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0);
nString = Yap_ExpandPreAllocCodeSpace(0,NULL);
t = *--H;
s = nString+(s-String);
String = nString;
@ -1670,7 +1675,7 @@ p_number_codes(void)
char *nString;
*H++ = t;
nString = Yap_ExpandPreAllocCodeSpace(0);
nString = Yap_ExpandPreAllocCodeSpace(0,NULL);
t = *--H;
s = nString+(s-String);
String = nString;

8
C/sysbits.c
View File

@ -2166,6 +2166,11 @@ p_first_signal(void)
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_alarm")));
}
if (ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL);
UNLOCK(SignalLock);
return Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom("sig_delay_creep")));
}
if (ActiveSignals & YAP_CREEP_SIGNAL) {
ActiveSignals &= ~YAP_CREEP_SIGNAL;
UNLOCK(SignalLock);
@ -2225,6 +2230,9 @@ p_continue_signals(void)
if (ActiveSignals & YAP_CREEP_SIGNAL) {
Yap_signal(YAP_CREEP_SIGNAL);
}
if (ActiveSignals & YAP_DELAY_CREEP_SIGNAL) {
Yap_signal(YAP_DELAY_CREEP_SIGNAL|YAP_CREEP_SIGNAL);
}
if (ActiveSignals & YAP_TRACE_SIGNAL) {
Yap_signal(YAP_TRACE_SIGNAL);
}

10
C/utilpreds.c
View File

@ -318,7 +318,7 @@ CopyTerm(Term inp) {
t = Deref(ARG3);
goto restart_attached;
} else { /* handle overflow */
if (!Yap_ExpandPreAllocCodeSpace(0)) {
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -354,7 +354,7 @@ CopyTerm(Term inp) {
t = Deref(ARG3);
goto restart_list;
} else { /* handle overflow */
if (!Yap_ExpandPreAllocCodeSpace(0)) {
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -389,7 +389,7 @@ CopyTerm(Term inp) {
t = Deref(ARG3);
goto restart_appl;
} else { /* handle overflow */
if (!Yap_ExpandPreAllocCodeSpace(0)) {
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -629,7 +629,7 @@ CopyTermNoDelays(Term inp) {
t = Deref(ARG1);
goto restart_list;
} else { /* handle overflow */
if (!Yap_ExpandPreAllocCodeSpace(0)) {
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
@ -661,7 +661,7 @@ CopyTermNoDelays(Term inp) {
t = Deref(ARG1);
goto restart_appl;
} else { /* handle overflow */
if (!Yap_ExpandPreAllocCodeSpace(0)) {
if (!Yap_ExpandPreAllocCodeSpace(0,NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}

1
CHR/chr/trace.yap
View File

@ -590,3 +590,4 @@ get_arg(C1, Arg0, Arg, C) :-
ttyget0(C2),
get_arg(C2, Arg1, Arg, C).
get_arg(C1, Arg, Arg, C1).

96
CLPBN/clpbn.yap
View File

@ -51,84 +51,6 @@ extract_dist(p(Domain, Tab, []), Tab, Domain) :- !.
extract_dist(p(Domain, Tab, Inps), (Tab.Inps), Domain).
extract_dist(p(Domain, Tab), Tab, Domain).
key_entry(Key, I) :-
hash_table_size(Size),
term_hash(Key, -1, Size, Hash),
collision(Hash, Size, I),
( array_element(keys, I, El) ->
update_array(keys, I, Key)
;
El = Key),
!.
% go from beginning
collision(Size, Size, I) :- !,
collision(0, Size, I).
collision(Hash, _, Hash).
collision(Hash, Size, I) :-
Hash1 is Hash+1,
collision(Hash1, Size, I).
%
% just fetch skolems so that we can process them carefully.
%
fetch_skolems(A, A) --> { var(A) }, !. %meta-calls
fetch_skolems((A,B), (NA,NB)) --> !,
fetch_skolems(A, NA),
fetch_skolems(B, NB).
% do not allow disjunctive clauses, at least for now.
fetch_skolems((A;B), (A;B)) --> !.
fetch_skolems((A|B), (A|B)) --> !.
fetch_skolems((A->B), (NA->NB)) --> !,
fetch_skolems(A, NA),
fetch_skolems(B, NB).
fetch_skolems(M:A, M:NA) --> !,
fetch_skolems(A, NA).
fetch_skolems(X = { Constraints }, true) --> !,
[ [X|Constraints] ].
fetch_skolems(G, G) --> [].
%
% just fetch skolems so that we can process them carefully.
%
handle_body_goals((A,B), (NA,NB)) :- !,
handle_body_goals(A, NA),
handle_body_goals(B, NB).
% do not allow disjunctive clauses, at least for now.
handle_body_goals((A;B), (A;B)) :- !.
handle_body_goals((A|B), (A|B)) :- !.
handle_body_goals((A->B), (NA->NB)) :- !,
handle_body_goals(A, NA),
handle_body_goals(B, NB).
handle_body_goals(M:A, M:NA) :- !,
handle_body_goals(A, NA).
handle_body_goals(findall(V,G,L), (findall(V,G,L), aggs:fix_vars(L))) :- !.
handle_body_goals(setof(V,G,L), (setof(V,G,L),aggs:fix_vars(L))) :- !.
handle_body_goals(bagof(V,G,L), (bagof(V,G,L),aggs:fix_vars(L))) :- !.
handle_body_goals(G, G).
compile_skolems([[X|Constraints]], Vars, NVars, A, Code) :- !,
compile_skolem(X, Vars, NVars, A, Code, Constraints).
compile_skolems([[X|Constraints]|Cs], Vars, NVars, A, (Code, RCode)) :-
compile_skolem(X, Vars, NVars, A, Code, Constraints),
compile_skolems(Cs, Vars, NVars, A, RCode).
compile_skolem(EVar, Vars, NVars, Head, Code, Constraints) :-
compile_constraints(Constraints, Vars, NVars, Head, Code, EVar).
compile_constraints((A : B), Vars, NVars, Head, (CA , CB), EVar) :- !,
compile_first_constraint(A, Head, CA, EVar),
compile_second_constraint(B, Vars, NVars, CB, EVar).
compile_first_constraint(SkKey, Head, (KeyGoal, /* cycle(Key,EVar), */ array_element(clpbn, Id, EVar), clpbn:put_atts(EVar,[key(KeyDesc),indx(Id)])), EVar) :-
functor(SkKey, Name, _),!,
SkKey =.. [_|Key],
generate_key_goal(Head, Name, Key, KeyGoal, KeyDesc, Id).
compile_second_constraint(Constraint, Vars, NVars, clpbn:put_atts(EVar,[dist(NC)]), EVar) :-
check_constraint(Constraint, Vars, NVars, NC).
check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !.
check_constraint((A->D), _, _, (A->D)) :- var(A), !.
check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !,
@ -308,9 +230,17 @@ verify_attributes(Var, T, Goals) :-
verify_attributes(_, _, []).
bind_clpbn(T, _, Key, Dist) :- var(T),
bind_clpbn(T, Var, Key, Dist) :- var(T),
get_atts(T, [key(Key1),dist(Dist1)]), !,
bind_clpbns(Key, Dist, Key1, Dist1).
bind_clpbns(Key, Dist, Key1, Dist1),
(
get_atts(T, [evidence(Ev1)]) ->
bind_evidence_from_extra_var(Ev1,Var)
;
get_atts(Var, [evidence(Ev)]) ->
bind_evidence_from_extra_var(Ev,T)
;
true).
bind_clpbn(_, Var, _, _) :-
use(bnt),
check_if_bnt_done(Var), !.
@ -334,6 +264,12 @@ bind_clpbns(Key, Dist, Key, Dist1) :- !,
bind_clpbns(_, _, _, _, _) :-
format(user_error, "unification of two bayesian vars not supported~n").
bind_evidence_from_extra_var(Ev1,Var) :-
get_atts(Var, [evidence(Ev0)]),!,Ev0 = Ev1.
bind_evidence_from_extra_var(Ev1,Var) :-
put_atts(Var, [evidence(Ev1)]).
:- yap_flag(toplevel_hook,clpbn:init_clpbn).
hash_table_size(300000).

21
CLPBN/clpbn/vel.yap
View File

@ -64,13 +64,14 @@ add_old_variables([_|LV], AllVs0, AllVs, Vs, IVs) :-
add_old_variables(LV, AllVs0, AllVs, Vs, IVs).
find_all_clpbn_vars([], [], []) :- !.
find_all_clpbn_vars([V|Vs], [var(V,I,Sz,Vals,_,_)|LV], [table(I,Table,Deps,Sizes)|Tables]) :-
var_with_deps(V, Table, Deps, Sizes, Vals), !,
find_all_clpbn_vars([V|Vs], [var(V,I,Sz,Vals,Ev,_,_)|LV], [table(I,Table,Deps,Sizes)|Tables]) :-
var_with_deps(V, Table, Deps, Sizes, Ev, Vals), !,
get_dist_els(V,Sz),
find_all_clpbn_vars(Vs, LV, Tables).
var_with_deps(V, Table, Deps, Sizes, Vals) :-
var_with_deps(V, Table, Deps, Sizes, Ev, Vals) :-
clpbn:get_atts(V, [dist((D->Vals))]),
( clpbn:get_atts(V, [evidence(Ev)]) -> true ; true),
from_dist_get(D,Vals,OTable,VDeps),
reorder_table([V|VDeps],Sizes,OTable,Deps,Table).
@ -243,7 +244,7 @@ add_table_deps([V|Deps], I, Deps0, Table, Sizes, DepGraph0, [V-tab(Table,Deps0,S
add_table_deps(Deps, I, Deps0, Table, Sizes, DepGraph0, DepGraph).
add_table_deps_to_variables([], []).
add_table_deps_to_variables([var(V,_,_,_,Deps,K)|LV], DepGraph) :-
add_table_deps_to_variables([var(V,_,_,_,_,Deps,K)|LV], DepGraph) :-
steal_deps_for_variable(DepGraph, V, NDepGraph, Deps),
compute_size(Deps,[],K),
add_table_deps_to_variables(LV, NDepGraph).
@ -280,14 +281,14 @@ process(LV0, _, Out) :-
multiply_tables(WorkTables, Out).
find_best([], V, _, V, _, [], _).
find_best([var(V,I,Sz,Vals,Deps,K)|LV], _, Threshold, VF, NWorktables, LVF, Inputs) :-
K < Threshold,
find_best([var(V,I,Sz,Vals,Ev,Deps,K)|LV], _, Threshold, VF, NWorktables, LVF, Inputs) :-
( K < Threshold ; K = Threshold, nonvar(Ev)),
not_var_member(Inputs, V), !,
find_best(LV, V, K, VF, WorkTables,LV0, Inputs),
(V == VF ->
LVF = LV0, Deps = NWorktables
;
LVF = [var(V,I,Sz,Vals,Deps,K)|LV0], WorkTables = NWorktables
LVF = [var(V,I,Sz,Vals,Ev,Deps,K)|LV0], WorkTables = NWorktables
).
find_best([V|LV], V0, Threshold, VF, WorkTables, [V|LVF], Inputs) :-
find_best(LV, V0, Threshold, VF, WorkTables, LVF, Inputs).
@ -311,7 +312,7 @@ generate_szs_with_evidence([_|Out],Ev,[not_ok|Evs]) :-
fetch_tables([], []).
fetch_tables([var(_,_,_,_,Deps,_)|LV0], Tables) :-
fetch_tables([var(_,_,_,_,_,Deps,_)|LV0], Tables) :-
append(Deps,Tables0,Tables),
fetch_tables(LV0, Tables0).
@ -414,10 +415,10 @@ project_inner_loop(I,Sz,[_|Evs],NBase,F,Table,Ent0,Ent) :- !,
include([],_,_,[]).
include([var(V,P,VSz,D,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Tabs,Est)|NLV]) :-
include([var(V,P,VSz,D,Ev,Tabs,Est)|LV],tab(T,Vs,Sz),V1,[var(V,P,VSz,D,Ev,Tabs,Est)|NLV]) :-
not_var_member(Vs,V), !,
include(LV,tab(T,Vs,Sz),V1,NLV).
include([var(V,P,VSz,D,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,NTabs,NEst)|NLV]) :-
include([var(V,P,VSz,D,Ev,Tabs,_)|LV],Table,NV,[var(V,P,VSz,D,Ev,NTabs,NEst)|NLV]) :-
update_tables(Tabs,NTabs,Table,NV,[],NEst),
include(LV,Table,NV,NLV).

11
CLPQR/clpqr/expand.yap
View File

@ -169,11 +169,12 @@ ra_equate( _Theory, A, B) --> [ {A=B} ]. % later
purify_head( Term, NewTerm) :-
% vsc: doesn't really exist in YAP, ignore it for now.
( prolog:dcg_expansion( Term, []/*undef layout*/, Exp, _) ->
true
;
Term = Exp
),
% ( prolog:dcg_expansion( Term, []/*undef layout*/, Exp, _) ->
% true
% ;
% Term = Exp
% ),
Term = Exp,
( Exp = ?-(_) -> % don't touch these
fail
; Exp = :-(_) -> % expanded via goal_expansion

11
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.73 2004-12-02 06:06:47 vsc Exp $ *
* version: $Id: Heap.h,v 1.74 2004-12-05 05:01:43 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -50,7 +50,6 @@ typedef struct worker_local_struct {
struct pred_entry *wpp;
#endif
UInt active_signals;
UInt delayed_trace;
UInt i_pred_arity;
yamop *prof_end;
Int start_line;
@ -187,6 +186,8 @@ typedef struct various_codes {
struct pred_entry *spy_code;
int system_profiling;
int system_call_counting;
int system_pred_goal_expansion_all;
int system_pred_goal_expansion_func;
int system_pred_goal_expansion_on;
int compiler_optimizer_on;
int compiler_compile_mode;
@ -470,6 +471,8 @@ struct various_codes *Yap_heap_regs;
#endif
#define PROFILING Yap_heap_regs->system_profiling
#define CALL_COUNTING Yap_heap_regs->system_call_counting
#define PRED_GOAL_EXPANSION_ALL Yap_heap_regs->system_pred_goal_expansion_all
#define PRED_GOAL_EXPANSION_FUNC Yap_heap_regs->system_pred_goal_expansion_func
#define PRED_GOAL_EXPANSION_ON Yap_heap_regs->system_pred_goal_expansion_on
#define UPDATE_MODE Yap_heap_regs->update_mode
#define RETRY_C_RECORDED_CODE Yap_heap_regs->retry_recorded_code
@ -671,7 +674,6 @@ struct various_codes *Yap_heap_regs;
#define WPP Yap_heap_regs->wl[worker_id].wpp
#define UncaughtThrow Yap_heap_regs->wl[worker_id].uncaught_throw
#define ActiveSignals Yap_heap_regs->wl[worker_id].active_signals
#define DelayedTrace Yap_heap_regs->wl[worker_id].delayed_trace
#define IPredArity Yap_heap_regs->wl[worker_id].i_pred_arity
#define ProfEnd Yap_heap_regs->wl[worker_id].prof_end
#define StartLine Yap_heap_regs->wl[worker_id].start_line
@ -689,7 +691,6 @@ struct various_codes *Yap_heap_regs;
#define TrustLUCode Yap_heap_regs->wl[worker_id].trust_lu_code
#else
#define ActiveSignals Yap_heap_regs->wl.active_signals
#define DelayedTrace Yap_heap_regs->wl.delayed_trace
#define IPredArity Yap_heap_regs->wl.i_pred_arity
#define ProfEnd Yap_heap_regs->wl.prof_end
#define UncaughtThrow Yap_heap_regs->wl.uncaught_throw
@ -766,7 +767,7 @@ struct various_codes *Yap_heap_regs;
#define ReadlinePos Yap_heap_regs->readline_pos
#endif
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (UInt));
ADDR STD_PROTO(Yap_ExpandPreAllocCodeSpace, (UInt, void *));
#define Yap_ReleasePreAllocCodeSpace(x)
#if USE_SYSTEM_MALLOC||USE_DL_MALLOC
ADDR STD_PROTO(Yap_InitPreAllocCodeSpace, (void));

5
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.74 2004-11-18 22:32:40 vsc Exp $ *
* version: $Id: Yap.h.m4,v 1.75 2004-12-05 05:01:43 vsc Exp $ *
*************************************************************************/
#include "config.h"
@ -570,7 +570,8 @@ typedef enum {
YAP_DEBUG_SIGNAL = 0x1000, /* received start debug */
YAP_BREAK_SIGNAL = 0x2000, /* received break signal */
YAP_STACK_DUMP_SIGNAL= 0x4000, /* received stack dump signal */
YAP_STATISTICS_SIGNAL= 0x8000 /* received statistics */
YAP_STATISTICS_SIGNAL= 0x8000, /* received statistics */
YAP_DELAY_CREEP_SIGNAL= 0x10000 /* received a creep but should not do it */
} yap_signals;
#define NUMBER_OF_YAP_FLAGS INDEXING_MODE_FLAG+1

14
m4/Yatom.h.m4
View File

@ -163,7 +163,7 @@ Inline(IsValProperty, PropFlags, int, flags, (flags == ValProperty) )
*/
typedef enum {
MegaClausePredFlag=0x80000000L, /* predicate is implemented as a mega-clause */
ThreadLocalPredFlag=0x40000000L, /* local to a thread */
ThreadLocalPredFlag=0x40000000L, /* local to a thread */
MultiFileFlag = 0x20000000L, /* is multi-file */
UserCPredFlag = 0x10000000L, /* CPred defined by the user */
LogUpdatePredFlag= 0x08000000L, /* dynamic predicate with log. upd. sem.*/
@ -174,25 +174,21 @@ typedef enum {
SourcePredFlag = 0x00400000L, /* static predicate with source declaration */
MetaPredFlag = 0x00200000L, /* predicate subject to a meta declaration */
SyncPredFlag = 0x00100000L, /* has to synch before it can execute*/
NumberDBPredFlag = 0x00080000L, /* entry for a number key */
AtomDBPredFlag = 0x00040000L, /* entry for an atom key */
FastPredFlag = 0x00020000L, /* native code */
NumberDBPredFlag = 0x00080000L, /* entry for a number key */
AtomDBPredFlag = 0x00040000L, /* entry for an atom key */
GoalExPredFlag = 0x00020000L, /* predicate that is called by goal_expand */
TestPredFlag = 0x00010000L, /* is a test (optim. comit) */
AsmPredFlag = 0x00008000L, /* inline */
StandardPredFlag= 0x00004000L, /* system predicate */
DynamicPredFlag= 0x00002000L, /* dynamic predicate */
CPredFlag = 0x00001000L, /* written in C */
CPredFlag = 0x00001000L, /* written in C */
SafePredFlag = 0x00000800L, /* does not alter arguments */
CompiledPredFlag= 0x00000400L, /* is static */
IndexedPredFlag= 0x00000200L, /* has indexing code */
SpiedPredFlag = 0x00000100L, /* is a spy point */
BinaryTestPredFlag=0x00000080L, /* test predicate. */
#ifdef TABLING
TabledPredFlag = 0x00000040L, /* is tabled */
#endif /* TABLING */
#ifdef YAPOR
SequentialPredFlag=0x00000020L, /* may not create par. choice points!*/
#endif /* YAPOR */
ProfiledPredFlag = 0x00000010L /* pred is being profiled */
} pred_flag;

113
pl/boot.yap
View File

@ -644,13 +644,6 @@ not(G) :- \+ '$execute'(G).
'$meta_call'(G, CP, G0, M) :-
'$call'(G, CP, G0, M).
'$spied_meta_call'(G, M) :-
'$save_current_choice_point'(CP),
'$spied_call'(G, CP, G, M).
'$spied_meta_call'(G, CP, G0, M) :-
'$spied_call'(G, CP, G0, M).
'$call'(G, CP, G0, _, M) :- /* iso version */
'$iso_check_goal'(G,G0),
'$call'(G, CP, G0, M).
@ -705,90 +698,27 @@ not(G) :- \+ '$execute'(G).
'$$cut_by'(CP).
'$call'([A|B], _, _, M) :- !,
'$csult'([A|B], M).
'$call'(A, _, _,CurMod) :-
(
% goal_expansion is defined, or
'$pred_goal_expansion_on' ->
'$expand_call'(A,CurMod)
% this is a meta-predicate
; '$flags'(A,CurMod,F,_), F /\ 0x200000 =:= 0x200000 ->
'$expand_call'(A, CurMod)
'$call'(G, CP, G0, CurMod) :-
( '$is_expand_goal_or_meta_predicate'(G,CurMod) ->
(
user:goal_expansion(G, CurMod, NG) ->
'$call'(NG, CP, G0,CurMod)
;
% repeat other code.
'$is_metapredicate'(G,CurMod) ->
(
'$meta_expansion'(CurMod,CurMod,G,NG,[]) ->
'$execute0'(NG, CurMod)
;
'$execute0'(G, CurMod)
)
;
'$execute0'(G, CurMod)
)
;
'$execute0'(A, CurMod)
'$execute0'(G, CurMod)
).
'$expand_call'(A,CurMod) :-
'$expand_goal'(A, CurMod, CurMod, NG, NMod),
'$execute0'(NG, NMod).
'$spied_call'((A,B),CP,G0,M) :- !,
'$call'(A,CP,G0,M),
'$call'(B,CP,G0,M).
'$spied_call'((X->Y),CP,G0,M) :- !,
(
'$call'(X,CP,G0,M)
->
'$call'(Y,CP,G0,M)
).
'$spied_call'((X->Y; Z),CP,G0,M) :- !,
(
'$call'(X,CP,G0,M)
->
'$call'(Y,CP,G0,M)
;
'$call'(Z,CP,G0,M)
).
'$spied_call'((A;B),CP,G0,M) :- !,
(
'$call'(A,CP,G0,M)
;
'$call'(B,CP,G0,M)
).
'$spied_call'((A|B),CP,G0,M) :- !,
(
'$call'(A,CP,G0,M)
;
'$call'(B,CP,G0,M)
).
'$spied_call'(\+ X,_,_,M) :- !,
\+ '$execute'(M:X).
'$spied_call'(not X,_,_,M) :- !,
\+ '$execute'(M:X).
'$spied_call'(!,CP,_,_) :-
'$$cut_by'(CP).
'$spied_call'([A|B],_,_,M) :- !,
'$csult'([A|B], M).
'$spied_call'(A, CP, G0, CurMod) :-
(
% goal_expansion is defined, or
'$pred_goal_expansion_on'
->
'$finish_spied_call'(A,CurMod)
;
% this is a meta-predicate
'$flags'(A,CurMod,F,_), F /\ 0x200000 =:= 0x200000
->
'$finish_spied_call'(A,CurMod)
;
% finish_it_off (careful with co-routining)
'$std_spied_call'(A, CP, G0, CurMod)
).
'$finish_spied_call'(A,CurMod) :-
'$expand_goal'(A, CurMod, CurMod, NG, NMod),
'$execute0'(NG, NMod).
'$std_spied_call'(A, CP, G0, M) :-
( '$undefined'(A, M) ->
functor(A,F,N),
( recorded('$import','$import'(S,M,F,N),_) ->
'$spied_call'(S:A,CP,G0,M) ;
'$spy'(A)
)
;
'$spy'(A)
).
'$check_callable'(V,G) :- var(V), !,
'$current_module'(Mod),
'$do_error'(instantiation_error,Mod:G).
@ -806,8 +736,11 @@ not(G) :- \+ '$execute'(G).
recorded('$import','$import'(S,M,F,N),_),
S \= M, % can't try importing from the module itself.
!,
'$expand_goal'(G, S, M, NG, NMod),
'$execute0'(NG, NMod).
'$execute'(S:G).
'$undefp'([M|G]) :-
'$is_expand_goal_or_meta_predicate'(G,M),
user:goal_expansion(G, M, NG), !,
'$execute0'(NG,M).
'$undefp'([M|G]) :-
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
user:unknown_predicate_handler(G,M,NG), !,

27
pl/modules.yap
View File

@ -309,34 +309,7 @@ module(N) :-
tell(F),fail.
'$trace_module'(_,_).
%
% calling the meta-call expansion facility and expand_goal from
% a meta-call.
%
'$expand_goal'(G0, GoalMod, CurMod, G, NM) :-
'$expand_goal2'(G0,GoalMod,G1,NM),
( '$meta_expansion'(GoalMod, CurMod, G1, GF, []) ->
G = GF
;
G = G1
).
'$expand_goal2'(G, M, NG, NM) :-
'$undefined'(G,M),
functor(G,F,N),
recorded('$import','$import'(ExportingMod,M,F,N),_),
ExportingMod \= M,
!,
'$expand_goal2'(G, ExportingMod, NG, NM).
'$expand_goal2'(G, M, GF, M) :-
'$pred_goal_expansion_on',
% make sure we do not try to expand conjs, etc...
user:goal_expansion(G,M,GF0), !,
% allow recursive goal expansion
'$expand_goal2'(GF0,M,GF,M).
'$expand_goal2'(G, M, G, M).
% expand module names in a body
% args are:
% goals to expand

4
pl/preds.yap
View File

@ -691,7 +691,7 @@ dynamic(X) :-
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$flags'(T, Mod, F, NF);
F /\ 0x00002000 =:= 0x00002000 -> true; % dynamic
F /\ 0x08000000 =:= 0x08000000 -> true ; % LU
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00420000), '$flags'(T,Mod,F,NF);
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$dynamic2'(X,Mod) :-
@ -704,7 +704,7 @@ dynamic(X) :-
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$flags'(T,Mod,F,NF);
F /\ 0x08000000 =:= 0x08000000 -> true ; % LU
F /\ 0x00002000 =:= 0x00002000 -> true; % dynamic
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00420000), '$flags'(T,Mod,F,NF);
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$logical_updatable'(X,Mod) :-

3
pl/signals.yap
View File

@ -33,6 +33,9 @@
'$wake_up_goal'(G, LG).
'$do_signal'(sig_creep, G) :-
'$start_creep'(G).
'$do_signal'(sig_delay_creep, [M|G]) :-
'$execute'(M:G),
'$creep'.
'$do_signal'(sig_iti, G) :-
'$thread_gfetch'(Goal),
% if more signals alive, set creep flag