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

Merge branch 'master' of ssh://git.dcc.fc.up.pt/yap-6.3

Browse Source
This commit is contained in:
Vítor Santos Costa 2013-01-11 19:26:11 +00:00
commit 8f2766cbf3
12 changed files with 97 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
C/cdmgr.c
View File

@ -544,6 +544,9 @@ PredForChoicePt(yamop *p_code) {
case _retry_me:
case _trust_me:
return p_code->u.Otapl.p;
case _retry_exo:
case _retry_all_exo:
return p_code->u.lp.p;
case _try_logical:
case _retry_logical:
case _trust_logical:
@ -891,7 +894,7 @@ Yap_BuildMegaClause(PredEntry *ap)
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->PredFlags |= MegaClausePredFlag|SourcePredFlag;
Yap_inform_profiler_of_clause(mcl, (char *)mcl+required, ap, GPROF_MEGA);
}
@ -3003,6 +3006,27 @@ p_is_source( USES_REGS1 )
return(out);
}
static Int
p_is_exo( USES_REGS1 )
{ /* '$is_dynamic'(+P) */
PredEntry *pe;
Int out;
MegaClause *mcl;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_exo");
if (EndOfPAEntr(pe))
return FALSE;
PELOCK(28,pe);
out = (pe->PredFlags & MegaClausePredFlag);
if (out) {
mcl =
ClauseCodeToMegaClause(pe->cs.p_code.FirstClause);
out = mcl->ClFlags & ExoMask;
}
UNLOCKPE(46,pe);
return(out);
}
static Int
p_owner_file( USES_REGS1 )
{ /* '$owner_file'(+P,M,F) */
@ -5769,6 +5793,12 @@ p_choicepoint_info( USES_REGS1 )
pe = ipc->u.Otapl.p;
t = BuildActivePred(pe, cptr->cp_args);
break;
case _retry_exo:
case _retry_all_exo:
ncl = NULL;
pe = ipc->u.lp.p;
t = BuildActivePred(pe, cptr->cp_args);
break;
case _Nstop:
{
Atom at = AtomLive;
@ -5978,7 +6008,7 @@ p_dbload_get_space( USES_REGS1 )
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->PredFlags |= (MegaClausePredFlag|SourcePredFlag);
ap->cs.p_code.NOfClauses = ncls;
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
@ -6037,6 +6067,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag);
Yap_InitCPred("$is_exo", 2, p_is_exo, TestPredFlag | SafePredFlag);
Yap_InitCPred("$owner_file", 3, p_owner_file, SafePredFlag);
Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);

7
C/dbase.c
View File

@ -4501,6 +4501,10 @@ p_erase_clause( USES_REGS1 )
Yap_EraseMegaClause(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1));
return TRUE;
}
if (FunctorOfTerm(t1) == FunctorExoClause) {
Yap_Error(TYPE_ERROR_DBREF, t1, "erase exo clause");
return FALSE;
}
}
Yap_Error(TYPE_ERROR_DBREF, t1, "erase");
return FALSE;
@ -4688,6 +4692,9 @@ p_instance( USES_REGS1 )
if (FunctorOfTerm(t1) == FunctorMegaClause) {
return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
}
if (FunctorOfTerm(t1) == FunctorExoClause) {
return Yap_unify(ARG2,ArgOfTerm(2,t1));
}
}
return FALSE;
} else {

6
C/exo.c
View File

@ -422,8 +422,8 @@ p_exodb_get_space( USES_REGS1 )
}
Yap_ClauseSpace += required;
/* cool, it's our turn to do the conversion */
mcl->ClFlags = MegaMask;
mcl->ClSize = required-sizeof(MegaClause);
mcl->ClFlags = MegaMask|ExoMask;
mcl->ClSize = required;
mcl->ClPred = ap;
mcl->ClItemSize = arity*sizeof(CELL);
mcl->ClNext = NULL;
@ -432,7 +432,7 @@ p_exodb_get_space( USES_REGS1 )
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->PredFlags |= MegaClausePredFlag|SourcePredFlag;
ap->cs.p_code.NOfClauses = ncls;
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);

8
C/heapgc.c
View File

@ -2307,6 +2307,10 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose
mark_ref_in_use((DBRef)rtp->u.OtILl.block PASS_REGS);
nargs = rtp->u.OtILl.d->ClPred->ArityOfPE+1;
break;
case _retry_exo:
case _retry_all_exo:
nargs = rtp->u.lp.p->ArityOfPE;
break;
#ifdef DEBUG
case _retry_me:
case _trust_me:
@ -3223,6 +3227,10 @@ sweep_choicepoints(choiceptr gc_B USES_REGS)
case _retry4:
sweep_b(gc_B, 4 PASS_REGS);
break;
case _retry_exo:
case _retry_all_exo:
sweep_b(gc_B, rtp->u.lp.p->ArityOfPE PASS_REGS);
break;
case _retry_c:
case _retry_userc:
{

9
C/qlyr.c
View File

@ -849,6 +849,7 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
} else if (pp->PredFlags & MegaClausePredFlag) {
CACHE_REGS
char *base = (void *)read_uint(stream);
UInt mask = read_uint(stream);
UInt size = read_uint(stream);
MegaClause *cl = (MegaClause *)Yap_AlwaysAllocCodeSpace(size);
@ -857,12 +858,20 @@ read_clauses(IOSTREAM *stream, PredEntry *pp, UInt nclauses, UInt flags) {
}
LOCAL_HDiff = (char *)cl-base;
read_bytes(stream, cl, size);
cl->ClFlags = mask;
pp->cs.p_code.FirstClause =
pp->cs.p_code.LastClause =
cl->ClCode;
pp->PredFlags |= MegaClausePredFlag;
/* enter index mode */
if (mask & ExoMask) {
struct index_t **icl = (struct index_t **)(cl->ClCode);
pp->OpcodeOfPred = Yap_opcode(_enter_exo);
icl[0] = NULL;
icl[1] = NULL;
} else {
pp->OpcodeOfPred = INDEX_OPCODE;
}
pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = (yamop *)(&(pp->OpcodeOfPred));
/* This must be set for restoremegaclause */
pp->cs.p_code.NOfClauses = nclauses;

1
C/qlyw.c
View File

@ -649,6 +649,7 @@ save_clauses(IOSTREAM *stream, PredEntry *pp) {
UInt size = cl->ClSize;
CHECK(save_uint(stream, (UInt)cl));
CHECK(save_uint(stream, (UInt)(cl->ClFlags)));
CHECK(save_uint(stream, size));
CHECK(save_bytes(stream, cl, size));
} else if (pp->PredFlags & DynamicPredFlag) {

2
H/iatoms.h
View File

@ -99,6 +99,7 @@
AtomExecuteWoMod = Yap_FullLookupAtom("$execute_wo_mod");
AtomExist = Yap_LookupAtom("exist");
AtomExistenceError = Yap_LookupAtom("existence_error");
AtomExoClause = Yap_FullLookupAtom("$exo_clause");
AtomExpectedNumber = Yap_LookupAtom("expected_number_syntax");
AtomExtendFileSearchPath = Yap_FullLookupAtom("$extend_file_search_path");
AtomFB = Yap_LookupAtom("fb");
@ -374,6 +375,7 @@
FunctorExecuteInMod = Yap_MkFunctor(AtomExecuteInMod,2);
FunctorExecuteWithin = Yap_MkFunctor(AtomExecuteWithin,1);
FunctorExistenceError = Yap_MkFunctor(AtomExistenceError,2);
FunctorExoClause = Yap_MkFunctor(AtomExoClause,2);
FunctorFunctor = Yap_MkFunctor(AtomFunctor,3);
FunctorGAtom = Yap_MkFunctor(AtomAtom,1);
FunctorGAtomic = Yap_MkFunctor(AtomAtomic,1);

2
H/ratoms.h
View File

@ -99,6 +99,7 @@
AtomExecuteWoMod = AtomAdjust(AtomExecuteWoMod);
AtomExist = AtomAdjust(AtomExist);
AtomExistenceError = AtomAdjust(AtomExistenceError);
AtomExoClause = AtomAdjust(AtomExoClause);
AtomExpectedNumber = AtomAdjust(AtomExpectedNumber);
AtomExtendFileSearchPath = AtomAdjust(AtomExtendFileSearchPath);
AtomFB = AtomAdjust(AtomFB);
@ -374,6 +375,7 @@
FunctorExecuteInMod = FuncAdjust(FunctorExecuteInMod);
FunctorExecuteWithin = FuncAdjust(FunctorExecuteWithin);
FunctorExistenceError = FuncAdjust(FunctorExistenceError);
FunctorExoClause = FuncAdjust(FunctorExoClause);
FunctorFunctor = FuncAdjust(FunctorFunctor);
FunctorGAtom = FuncAdjust(FunctorGAtom);
FunctorGAtomic = FuncAdjust(FunctorGAtomic);

11
H/rheap.h
View File

@ -588,11 +588,22 @@ RestoreMegaClause(MegaClause *cl USES_REGS)
}
max = (yamop *)((CODEADDR)cl+cl->ClSize);
if (cl->ClFlags & ExoMask) {
CELL *base = (CELL *)((ADDR)cl->ClCode+2*sizeof(struct index_t *));
CELL *end = (CELL*)max, *ptr;
for (ptr = base; ptr < end; ptr++) {
Term t = *ptr;
if (IsAtomTerm(t)) *ptr = AtomTermAdjust(t);
/* don't handle other complex terms just yet, ints are ok */
}
} else {
for (ptr = cl->ClCode; ptr < max; ) {
nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
restore_opcodes(ptr, nextptr PASS_REGS);
ptr = nextptr;
}
}
}
/* Restores a prolog clause, in its compiled form */

4
H/tatoms.h
View File

@ -196,6 +196,8 @@
#define AtomExist Yap_heap_regs->AtomExist_
Atom AtomExistenceError_;
#define AtomExistenceError Yap_heap_regs->AtomExistenceError_
Atom AtomExoClause_;
#define AtomExoClause Yap_heap_regs->AtomExoClause_
Atom AtomExpectedNumber_;
#define AtomExpectedNumber Yap_heap_regs->AtomExpectedNumber_
Atom AtomExtendFileSearchPath_;
@ -746,6 +748,8 @@
#define FunctorExecuteWithin Yap_heap_regs->FunctorExecuteWithin_
Functor FunctorExistenceError_;
#define FunctorExistenceError Yap_heap_regs->FunctorExistenceError_
Functor FunctorExoClause_;
#define FunctorExoClause Yap_heap_regs->FunctorExoClause_
Functor FunctorFunctor_;
#define FunctorFunctor Yap_heap_regs->FunctorFunctor_
Functor FunctorGAtom_;

2
misc/ATOMS
View File

@ -104,6 +104,7 @@ A ExecuteWithin F "$execute_within"
A ExecuteWoMod F "$execute_wo_mod"
A Exist N "exist"
A ExistenceError N "existence_error"
A ExoClause F "$exo_clause"
A ExpectedNumber N "expected_number_syntax"
A ExtendFileSearchPath F "$extend_file_search_path"
A FB N "fb"
@ -379,6 +380,7 @@ F Execute2InMod ExecuteWoMod 2
F ExecuteInMod ExecuteInMod 2
F ExecuteWithin ExecuteWithin 1
F ExistenceError ExistenceError 2
F ExoClause ExoClause 2
F Functor Functor 3
F GAtom Atom 1
F GAtomic Atomic 1

13
pl/preds.yap
View File

@ -281,12 +281,19 @@ clause(V,Q,R) :-
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
'$clause'(V,M,Q,R) :- var(V), !,
'$do_error'(instantiation_error,clause(M:V,Q,R)).
'$clause'(C,M,Q,R) :- number(C), !,
'$clause'(C,M,Q,R) :-
number(C), !,
'$do_error'(type_error(callable,C),clause(M:C,Q,R)).
'$clause'(R,M,Q,R) :- db_reference(R), !,
'$do_error'(type_error(callable,R),clause(M:R,Q,R)).
'$clause'(C,M,Q,R) :-
db_reference(C), !,
'$do_error'(type_error(callable,C),clause(M:R,Q,R)).
'$clause'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R).
'$clause'(P,M,Q,R) :-
'$is_exo'(P, M), !,
Q = true,
R = '$exo_clause'(M,P),
'$execute0'(P, M).
'$clause'(P,M,Q,R) :-
'$is_source'(P, M), !,
'$static_clause'(P,M,Q,R).