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.

Browse Source 
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