void Yap_InitAsmPred(const char *Name, arity_t Arity, int code, CPredicate def, pred_flags_t flags) { CACHE_REGS Atom atom = NIL; PredEntry *pe = NULL; Functor f = NULL; while (atom == NIL) { atom = Yap_FullLookupAtom(Name); if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } if (Arity) { while (!f) { f = Yap_MkFunctor(atom, Arity); if (!f && !Yap_growheap(FALSE, 0L, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } } while (pe == NULL) { if (Arity) pe = RepPredProp(PredPropByFunc(f, CurrentModule)); else pe = RepPredProp(PredPropByAtom(atom, CurrentModule)); if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } flags |= AsmPredFlag | StandardPredFlag | (code); if (pe->PredFlags & AsmPredFlag) { flags = update_flags_from_prolog(flags, pe); /* already exists */ } pe->PredFlags = flags; pe->cs.f_code = def; pe->ModuleOfPred = CurrentModule; if (def != NULL) { yamop *p_code = ((StaticClause *)NULL)->ClCode; StaticClause *cl; if (pe->CodeOfPred == (yamop *)(&(pe->OpcodeOfPred))) { if (flags & SafePredFlag) { cl = (StaticClause *)Yap_AllocCodeSpace( (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l)); } else { cl = (StaticClause *)Yap_AllocCodeSpace((CELL)NEXTOP( NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), p), l)); } if (!cl) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "No Heap Space in InitAsmPred"); return; } Yap_ClauseSpace += (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), p), l); } else { cl = ClauseCodeToStaticClause(pe->CodeOfPred); } cl->ClFlags = StaticMask; cl->ClNext = NULL; if (flags & SafePredFlag) { cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), Osbpp), e), e); } else { cl->ClSize = (CELL)NEXTOP( NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code), e), Osbpp), p), e), e); } cl->usc.ClLine = Yap_source_line_no(); p_code = cl->ClCode; pe->CodeOfPred = p_code; if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_allocate); p_code = NEXTOP(p_code, e); } p_code->opc = Yap_opcode(_call_cpred); p_code->y_u.Osbpp.bmap = NULL; p_code->y_u.Osbpp.s = -Signed(RealEnvSize); p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe; p_code = NEXTOP(p_code, Osbpp); if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_deallocate); p_code->y_u.p.p = pe; p_code = NEXTOP(p_code, p); } p_code->opc = Yap_opcode(_procceed); p_code->y_u.p.p = pe; p_code = NEXTOP(p_code, p); p_code->opc = Yap_opcode(_Ystop); p_code->y_u.l.l = cl->ClCode; pe->OpcodeOfPred = pe->CodeOfPred->opc; } else { pe->OpcodeOfPred = Yap_opcode(_undef_p); pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred)); } }
static size_t save_clauses(FILE *stream, PredEntry *pp) { yamop *FirstC, *LastC; FirstC = pp->cs.p_code.FirstClause; LastC = pp->cs.p_code.LastClause; if (FirstC == NULL && LastC == NULL) { return 1; } if (pp->PredFlags & LogUpdatePredFlag) { LogUpdClause *cl = ClauseCodeToLogUpdClause(FirstC); while (cl != NULL) { if (IN_BETWEEN(cl->ClTimeStart, pp->TimeStampOfPred, cl->ClTimeEnd)) { UInt size = cl->ClSize; CHECK(save_tag(stream, QLY_START_LU_CLAUSE)); CHECK(save_UInt(stream, (UInt)cl)); CHECK(save_UInt(stream, size)); CHECK(save_bytes(stream, cl, size)); } cl = cl->ClNext; } CHECK(save_tag(stream, QLY_END_LU_CLAUSES)); } else if (pp->PredFlags & MegaClausePredFlag) { MegaClause *cl = ClauseCodeToMegaClause(FirstC); 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) { yamop *cl = FirstC; do { DynamicClause *dcl = ClauseCodeToDynamicClause(cl); UInt size = dcl->ClSize; CHECK(save_UInt(stream, (UInt)cl)); CHECK(save_UInt(stream, size)); CHECK(save_bytes(stream, dcl, size)); if (cl == LastC) return 1; cl = NextDynamicClause(cl); } while (TRUE); } else { StaticClause *cl = ClauseCodeToStaticClause(FirstC); if (pp->PredFlags & SYSTEM_PRED_FLAGS) { return 1; } do { UInt size = cl->ClSize; CHECK(save_UInt(stream, (UInt)cl)); CHECK(save_UInt(stream, size)); CHECK(save_bytes(stream, cl, size)); if (cl->ClCode == LastC) return 1; cl = cl->ClNext; } while (TRUE); } return 1; }
void Yap_InitCPred(const char *Name, arity_t Arity, CPredicate code, pred_flags_t flags) { CACHE_REGS Atom atom = NIL; PredEntry *pe = NULL; yamop *p_code; StaticClause *cl = NULL; Functor f = NULL; while (atom == NIL) { if (flags & UserCPredFlag) atom = Yap_LookupAtom(Name); else atom = Yap_FullLookupAtom(Name); if (atom == NIL && !Yap_growheap(FALSE, 0L, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } if (Arity) { while (!f) { f = Yap_MkFunctor(atom, Arity); if (!f && !Yap_growheap(FALSE, 0L, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } } while (pe == NULL) { if (Arity) pe = RepPredProp(PredPropByFunc(f, CurrentModule)); else pe = RepPredProp(PredPropByAtom(atom, CurrentModule)); if (!pe && !Yap_growheap(FALSE, sizeof(PredEntry), NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } if (pe->PredFlags & CPredFlag) { /* already exists */ flags = update_flags_from_prolog(flags, pe); cl = ClauseCodeToStaticClause(pe->CodeOfPred); if ((flags | StandardPredFlag | CPredFlag) != pe->PredFlags) { Yap_ClauseSpace -= cl->ClSize; Yap_FreeCodeSpace((ADDR)cl); cl = NULL; } } p_code = cl->ClCode; while (!cl) { UInt sz; if (flags & SafePredFlag) { sz = (CELL)NEXTOP(NEXTOP(NEXTOP(p_code, Osbpp), p), l); } else { sz = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(p_code, e), p), Osbpp), p), l); } cl = (StaticClause *)Yap_AllocCodeSpace(sz); if (!cl) { if (!Yap_growheap(FALSE, sz, NULL)) { Yap_Error(RESOURCE_ERROR_HEAP, TermNil, "while initializing %s", Name); return; } } else { Yap_ClauseSpace += sz; cl->ClFlags = StaticMask; cl->ClNext = NULL; cl->ClSize = sz; cl->usc.ClLine = Yap_source_line_no(); p_code = cl->ClCode; } } pe->CodeOfPred = p_code; pe->PredFlags = flags | StandardPredFlag | CPredFlag; pe->src.OwnerFile = Yap_ConsultingFile(PASS_REGS1); pe->cs.f_code = code; if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_allocate); p_code = NEXTOP(p_code, e); } if (flags & UserCPredFlag) p_code->opc = Yap_opcode(_call_usercpred); else p_code->opc = Yap_opcode(_call_cpred); p_code->y_u.Osbpp.bmap = NULL; p_code->y_u.Osbpp.s = -Signed(RealEnvSize); p_code->y_u.Osbpp.p = p_code->y_u.Osbpp.p0 = pe; p_code = NEXTOP(p_code, Osbpp); if (!(flags & SafePredFlag)) { p_code->opc = Yap_opcode(_deallocate); p_code->y_u.p.p = pe; p_code = NEXTOP(p_code, p); } p_code->opc = Yap_opcode(_procceed); p_code->y_u.p.p = pe; p_code = NEXTOP(p_code, p); p_code->opc = Yap_opcode(_Ystop); p_code->y_u.l.l = cl->ClCode; pe->OpcodeOfPred = pe->CodeOfPred->opc; }