OpEntry *Yap_GetOpPropForAModuleHavingALock( Atom a, Term mod) { /* look property list of atom a for kind */ AtomEntry *ae = RepAtom(a); PropEntry *pp; pp = RepProp(ae->PropsOfAE); while (!EndOfPAEntr(pp) && (pp->KindOfPE != OpProperty || ((OpEntry *)pp)->OpModule != mod)) pp = RepProp(pp->NextOfPE); if (EndOfPAEntr(pp)) { return NULL; } return (OpEntry *)pp; }
inline static Atom SearchInInvisible(const unsigned char *atom) { AtomEntry *chain; READ_LOCK(INVISIBLECHAIN.AERWLock); chain = RepAtom(INVISIBLECHAIN.Entry); while (!EndOfPAEntr(chain) && strcmp((char *)chain->StrOfAE, (char *)atom)) { chain = RepAtom(chain->NextOfAE); } READ_UNLOCK(INVISIBLECHAIN.AERWLock); if (EndOfPAEntr(chain)) return (NIL); else return (AbsAtom(chain)); }
static int hidden (Atom at) { AtomEntry *chain; READ_LOCK(INVISIBLECHAIN.AERWLock); chain = RepAtom(INVISIBLECHAIN.Entry); while (!EndOfPAEntr (chain) && AbsAtom (chain) != at) chain = RepAtom(chain->NextOfAE); READ_UNLOCK(INVISIBLECHAIN.AERWLock); if (EndOfPAEntr (chain)) return (FALSE); return (TRUE); }
static void RestoreAtomList(Atom atm) { AtomEntry *at; at = RepAtom(atm); if (EndOfPAEntr(at)) return; do { RestoreAtom(atm); atm = CleanAtomMarkedBit(at->NextOfAE); at = RepAtom(atm); } while (!EndOfPAEntr(at)); }
int Yap_HasOp(Atom a) { /* look property list of atom a for kind */ AtomEntry *ae = RepAtom(a); PropEntry *pp; READ_LOCK(ae->ARWLock); pp = RepProp(ae->PropsOfAE); while (!EndOfPAEntr(pp) && (pp->KindOfPE != OpProperty)) pp = RepProp(pp->NextOfPE); READ_UNLOCK(ae->ARWLock); if (EndOfPAEntr(pp)) { return FALSE; } else { return TRUE; } }
OpEntry * Yap_GetOpProp(Atom a, op_type type USES_REGS) { /* look property list of atom a for kind */ AtomEntry *ae = RepAtom(a); PropEntry *pp; OpEntry *oinfo = NULL; READ_LOCK(ae->ARWLock); pp = RepProp(ae->PropsOfAE); while (!EndOfPAEntr(pp)) { OpEntry *info = NULL; if (pp->KindOfPE != OpProperty) { pp = RepProp(pp->NextOfPE); continue; } info = (OpEntry *)pp; if (info->OpModule != CurrentModule && info->OpModule != PROLOG_MODULE) { pp = RepProp(pp->NextOfPE); continue; } if (type == INFIX_OP) { if (!info->Infix) { pp = RepProp(pp->NextOfPE); continue; } } else if (type == POSFIX_OP) { if (!info->Posfix) { pp = RepProp(pp->NextOfPE); continue; } } else { if (!info->Prefix) { pp = RepProp(pp->NextOfPE); continue; } } /* if it is not the latest module */ if (info->OpModule == PROLOG_MODULE) { /* cannot commit now */ oinfo = info; pp = RepProp(pp->NextOfPE); } else { READ_LOCK(info->OpRWLock); READ_UNLOCK(ae->ARWLock); return info; } } if (oinfo) { READ_LOCK(oinfo->OpRWLock); READ_UNLOCK(ae->ARWLock); return oinfo; } READ_UNLOCK(ae->ARWLock); return NULL; }
static Prop GetAPropHavingLock(AtomEntry *ae, PropFlags kind) { /* look property list of atom a for kind */ PropEntry *pp; pp = RepProp(ae->PropsOfAE); while (!EndOfPAEntr(pp) && pp->KindOfPE != kind) pp = RepProp(pp->NextOfPE); return (AbsProp(pp)); }
static int OpDec(int p, const char *type, Atom a, Term m) { int i; AtomEntry *ae = RepAtom(a); OpEntry *info; if (m == TermProlog) m = PROLOG_MODULE; else if (m == USER_MODULE) m = PROLOG_MODULE; for (i = 1; i <= 7; ++i) if (strcmp(type, optypes[i]) == 0) break; if (i > 7) { Yap_Error(DOMAIN_ERROR_OPERATOR_SPECIFIER,MkAtomTerm(Yap_LookupAtom(type)),"op/3"); return(FALSE); } if (p) { if (i == 1 || i == 2 || i == 4) p |= DcrlpFlag; if (i == 1 || i == 3 || i == 6) p |= DcrrpFlag; } WRITE_LOCK(ae->ARWLock); info = Yap_GetOpPropForAModuleHavingALock(ae, m); if (EndOfPAEntr(info)) { info = (OpEntry *) Yap_AllocAtomSpace(sizeof(OpEntry)); info->KindOfPE = Ord(OpProperty); info->OpModule = m; info->OpName = a; //LOCK(OpListLock); info->OpNext = OpList; OpList = info; //UNLOCK(OpListLock); AddPropToAtom(ae, (PropEntry *)info); INIT_RWLOCK(info->OpRWLock); WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); info->Prefix = info->Infix = info->Posfix = 0; } else { WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); } if (i <= 3) { GET_LD if (truePrologFlag(PLFLAG_ISO) && info->Posfix != 0) /* there is a posfix operator */ { /* ISO dictates */ WRITE_UNLOCK(info->OpRWLock); Yap_Error(PERMISSION_ERROR_CREATE_OPERATOR,MkAtomTerm(a),"op/3"); return FALSE; } info->Infix = p; } else if (i <= 5) {
/* this routine must be run at least having a read lock on ae */ static Prop GetFunctorProp(AtomEntry *ae, unsigned int arity) { /* look property list of atom a for kind */ FunctorEntry *pp; pp = RepFunctorProp(ae->PropsOfAE); while (!EndOfPAEntr(pp) && (!IsFunctorProperty(pp->KindOfPE) || pp->ArityOfFE != arity)) pp = RepFunctorProp(pp->NextOfPE); return (AbsFunctorProp(pp)); }
static Int p_binary_is(void) { /* X is Y */ Term t = Deref(ARG2); Term t1, t2; if (IsVarTerm(t)) { Yap_ArithError(INSTANTIATION_ERROR,t, "X is Y"); return(FALSE); } t1 = Yap_Eval(Deref(ARG3)); if (!Yap_FoundArithError(t1, ARG3)) { return FALSE; } t2 = Yap_Eval(Deref(ARG4)); if (!Yap_FoundArithError(t2, ARG4)) { return FALSE; } if (IsIntTerm(t)) { Term tout = Yap_FoundArithError(eval2(IntOfTerm(t), t1, t2), 0L); if (!tout) return FALSE; return Yap_unify_constant(ARG1,tout); } if (IsAtomTerm(t)) { Atom name = AtomOfTerm(t); ExpEntry *p; Term out; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) { Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntTerm(1); t = Yap_MkApplTerm(FunctorSlash, 2, ti); Yap_Error(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,2); P = FAILCODE; return(FALSE); } if (!(out=Yap_FoundArithError(eval2(p->FOfEE, t1, t2), 0L))) return FALSE; return Yap_unify_constant(ARG1,out); } return FALSE; }
static Int p_binary_op_as_integer(void) { /* X is Y */ Term t = Deref(ARG1); if (IsVarTerm(t)) { Yap_Error(INSTANTIATION_ERROR,t, "X is Y"); return(FALSE); } if (IsIntTerm(t)) { return Yap_unify_constant(ARG2,t); } if (IsAtomTerm(t)) { Atom name = AtomOfTerm(t); ExpEntry *p; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 2)))) { return Yap_unify(ARG1,ARG2); } return Yap_unify_constant(ARG2,MkIntTerm(p->FOfEE)); } return(FALSE); }
OpEntry * Yap_OpPropForModule(Atom a, Term mod) { /* look property list of atom a for kind */ AtomEntry *ae = RepAtom(a); PropEntry *pp; OpEntry *info = NULL; if (mod == TermProlog) mod = PROLOG_MODULE; WRITE_LOCK(ae->ARWLock); pp = RepProp(ae->PropsOfAE); while (!EndOfPAEntr(pp)) { if (pp->KindOfPE == OpProperty) { info = (OpEntry *)pp; if (info->OpModule == mod) { WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); return info; } } pp = pp->NextOfPE; } info = (OpEntry *)Yap_AllocAtomSpace(sizeof(OpEntry)); info->KindOfPE = Ord(OpProperty); info->OpModule = mod; info->OpName = a; LOCK(OpListLock); info->OpNext = OpList; OpList = info; UNLOCK(OpListLock); AddPropToAtom(ae, (PropEntry *)info); INIT_RWLOCK(info->OpRWLock); WRITE_LOCK(info->OpRWLock); WRITE_UNLOCK(ae->ARWLock); info->Prefix = info->Infix = info->Posfix = 0; return info; }
static Term Eval(Term t USES_REGS) { if (IsVarTerm(t)) { return Yap_ArithError(INSTANTIATION_ERROR,t,"in arithmetic"); } else if (IsNumTerm(t)) { return t; } else if (IsAtomTerm(t)) { ExpEntry *p; Atom name = AtomOfTerm(t); if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, 0)))) { /* error */ Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntTerm(0); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "atom %s in arithmetic expression", RepAtom(name)->StrOfAE); } return Yap_eval_atom(p->FOfEE); } else if (IsApplTerm(t)) { Functor fun = FunctorOfTerm(t); if (fun == FunctorString) { const char *s = StringOfTerm(t); if (s[1] == '\0') return MkIntegerTerm(s[0]); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string in arithmetic expression"); } else if ((Atom)fun == AtomFoundVar) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, TermNil, "cyclic term in arithmetic expression"); } else { Int n = ArityOfFunctor(fun); Atom name = NameOfFunctor(fun); ExpEntry *p; Term t1, t2; if (EndOfPAEntr(p = RepExpProp(Yap_GetExpProp(name, n)))) { Term ti[2]; /* error */ ti[0] = t; ti[1] = MkIntegerTerm(n); t = Yap_MkApplTerm(FunctorSlash, 2, ti); return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "functor %s/%d for arithmetic expression", RepAtom(name)->StrOfAE,n); } if (p->FOfEE == op_power && p->ArityOfEE == 2) { t2 = ArgOfTerm(2, t); if (IsPairTerm(t2)) { return get_matrix_element(ArgOfTerm(1, t), t2 PASS_REGS); } } *RepAppl(t) = (CELL)AtomFoundVar; t1 = Eval(ArgOfTerm(1,t) PASS_REGS); if (t1 == 0L) { *RepAppl(t) = (CELL)fun; return FALSE; } if (n == 1) { *RepAppl(t) = (CELL)fun; return Yap_eval_unary(p->FOfEE, t1); } t2 = Eval(ArgOfTerm(2,t) PASS_REGS); *RepAppl(t) = (CELL)fun; if (t2 == 0L) return FALSE; return Yap_eval_binary(p->FOfEE,t1,t2); } } /* else if (IsPairTerm(t)) */ { if (TailOfTerm(t) != TermNil) { return Yap_ArithError(TYPE_ERROR_EVALUABLE, t, "string must contain a single character to be evaluated as an arithmetic expression"); } return Eval(HeadOfTerm(t) PASS_REGS); } }