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

C-metapredicates must always be protected by an environment.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@929 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-11-18 19:16:08 +00:00
parent e372271695
commit 7be28e4098
1 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
C/init.c
View File

@ -448,28 +448,42 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, int flags)
Atom atom = Yap_LookupAtom(Name); Atom atom = Yap_LookupAtom(Name);
PredEntry *pe; PredEntry *pe;
yamop *p_code = ((StaticClause *)NULL)->ClCode; yamop *p_code = ((StaticClause *)NULL)->ClCode;
StaticClause *cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e)); StaticClause *cl;
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode;
if (Arity) if (Arity)
pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule)); pe = RepPredProp(PredPropByFunc(Yap_MkFunctor(atom, Arity),CurrentModule));
else else
pe = RepPredProp(PredPropByAtom(atom,CurrentModule)); pe = RepPredProp(PredPropByAtom(atom,CurrentModule));
if (pe->PredFlags & SafePredFlag) {
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(((yamop *)p_code),sla),e));
} else {
cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),sla),e),e));
}
cl->ClFlags = 0;
cl->Owner = Yap_LookupAtom("user");
p_code = cl->ClCode;
pe->CodeOfPred = p_code; pe->CodeOfPred = p_code;
pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->PredFlags = flags | StandardPredFlag | CPredFlag;
pe->cs.f_code = code; pe->cs.f_code = code;
if (!(pe->PredFlags & SafePredFlag)) {
p_code->opc = Yap_opcode(_allocate);
p_code = NEXTOP(p_code,e);
}
if (flags & UserCPredFlag) if (flags & UserCPredFlag)
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_usercpred); p_code->opc = Yap_opcode(_call_usercpred);
else else
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred); p_code->opc = Yap_opcode(_call_cpred);
p_code->u.sla.bmap = NULL; p_code->u.sla.bmap = NULL;
p_code->u.sla.s = -Signed(RealEnvSize); p_code->u.sla.s = -Signed(RealEnvSize);
p_code->u.sla.sla_u.p = pe; p_code->u.sla.sla_u.p = pe;
p_code = NEXTOP(p_code,sla); p_code = NEXTOP(p_code,sla);
if (!(pe->PredFlags & SafePredFlag)) {
p_code->opc = Yap_opcode(_deallocate);
p_code = NEXTOP(p_code,e);
}
p_code->opc = Yap_opcode(_procceed); p_code->opc = Yap_opcode(_procceed);
pe->OpcodeOfPred = pe->CodeOfPred->opc;
{ {
Term mod = CurrentModule; Term mod = CurrentModule;
pe->ModuleOfPred = mod; pe->ModuleOfPred = mod;