diff --git a/C/adtdefs.c b/C/adtdefs.c index f6a4ae170..e3861002b 100755 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -27,6 +27,7 @@ static char SccsId[] = "%W% %G%"; #include "Yap.h" #include "Yatom.h" #include "clause.h" +#include "alloc.h" #include "yapio.h" #include #include @@ -45,9 +46,9 @@ uint64_t HashFunction(const unsigned char *CHP) { } return hash; /* - UInt OUT=0, i = 1; - while(*CHP != '\0') { OUT += (UInt)(*CHP++); } - return OUT; + UInt OUT=0, i = 1; + while(*CHP != '\0') { OUT += (UInt)(*CHP++); } + return OUT; */ } @@ -183,12 +184,17 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */ } #endif /* add new atom to start of chain */ - size_t asz = strlen((const char *)atom); - ae = (AtomEntry *)Yap_AllocAtomSpace((sizeof *ae) + asz+1); + sz = strlen((const char *)atom); + size_t asz = (sizeof *ae) + ( sz+1); + ae = malloc(asz); if (ae == NULL) { WRITE_UNLOCK(HashChain[hash].AERWLock); return NIL; } + // enable fast hashing by making sure that + // the last cell is fully initialized. + CELL *aec = (CELL*)ae; + aec[asz/(YAP_ALIGN+1)-1] = 0; NOfAtoms++; na = AbsAtom(ae); ae->PropsOfAE = NIL; @@ -206,1061 +212,1061 @@ LookupAtom(const unsigned char *atom) { /* lookup atom in atom table */ } Atom Yap_LookupAtomWithLength(const char *atom, - size_t len0) { /* lookup atom in atom table */ - Atom at; - unsigned char *ptr; + size_t len0) { /* lookup atom in atom table */ + Atom at; + unsigned char *ptr; - /* not really a wide atom */ - ptr = Yap_AllocCodeSpace(len0 + 1); - if (!ptr) - return NIL; - memcpy(ptr, atom, len0); - ptr[len0] = '\0'; - at = LookupAtom(ptr); - Yap_FreeCodeSpace(ptr); - return at; -} - -Atom Yap_LookupAtom(const char *atom) { /* lookup atom in atom table */ - return LookupAtom((const unsigned char *)atom); -} - -Atom Yap_ULookupAtom( - const unsigned char *atom) { /* lookup atom in atom table */ - return LookupAtom(atom); -} - - -Atom Yap_FullLookupAtom(const char *atom) { /* lookup atom in atom table */ - Atom t; - - if ((t = SearchInInvisible((const unsigned char *)atom)) != NIL) { - return (t); + /* not really a wide atom */ + ptr = Yap_AllocCodeSpace(len0 + 1); + if (!ptr) + return NIL; + memcpy(ptr, atom, len0); + ptr[len0] = '\0'; + at = LookupAtom(ptr); + Yap_FreeCodeSpace(ptr); + return at; } - return (LookupAtom((const unsigned char *)atom)); -} -void Yap_LookupAtomWithAddress(const char *atom, - AtomEntry *ae) { /* lookup atom in atom table */ - register CELL hash; - register const unsigned char *p; - Atom a; + Atom Yap_LookupAtom(const char *atom) { /* lookup atom in atom table */ + return LookupAtom((const unsigned char *)atom); + } - /* compute hash */ - p = (const unsigned char *)atom; - hash = HashFunction(p) % AtomHashTableSize; - /* ask for a WRITE lock because it is highly unlikely we shall find anything - */ - WRITE_LOCK(HashChain[hash].AERWLock); - a = HashChain[hash].Entry; - /* search atom in chain */ - if (SearchAtom(p, a) != NIL) { - Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, - "repeated initialization for atom %s", ae); + Atom Yap_ULookupAtom( + const unsigned char *atom) { /* lookup atom in atom table */ + return LookupAtom(atom); + } + + + Atom Yap_FullLookupAtom(const char *atom) { /* lookup atom in atom table */ + Atom t; + + if ((t = SearchInInvisible((const unsigned char *)atom)) != NIL) { + return (t); + } + return (LookupAtom((const unsigned char *)atom)); + } + + void Yap_LookupAtomWithAddress(const char *atom, + AtomEntry *ae) { /* lookup atom in atom table */ + register CELL hash; + register const unsigned char *p; + Atom a; + + /* compute hash */ + p = (const unsigned char *)atom; + hash = HashFunction(p) % AtomHashTableSize; + /* ask for a WRITE lock because it is highly unlikely we shall find anything + */ + WRITE_LOCK(HashChain[hash].AERWLock); + a = HashChain[hash].Entry; + /* search atom in chain */ + if (SearchAtom(p, a) != NIL) { + Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, + "repeated initialization for atom %s", ae); + WRITE_UNLOCK(HashChain[hash].AERWLock); + return; + } + /* add new atom to start of chain */ + NOfAtoms++; + ae->NextOfAE = a; + HashChain[hash].Entry = AbsAtom(ae); + ae->PropsOfAE = NIL; + strcpy((char *)ae->StrOfAE, (char *)atom); + INIT_RWLOCK(ae->ARWLock); WRITE_UNLOCK(HashChain[hash].AERWLock); - return; } - /* add new atom to start of chain */ - NOfAtoms++; - ae->NextOfAE = a; - HashChain[hash].Entry = AbsAtom(ae); - ae->PropsOfAE = NIL; - strcpy((char *)ae->StrOfAE, (char *)atom); - INIT_RWLOCK(ae->ARWLock); - WRITE_UNLOCK(HashChain[hash].AERWLock); -} -void Yap_ReleaseAtom(Atom atom) { /* Releases an atom from the hash chain */ - register Int hash; - register const unsigned char *p; - AtomEntry *inChain; - AtomEntry *ap = RepAtom(atom); - char unsigned *name = ap->UStrOfAE; + void Yap_ReleaseAtom(Atom atom) { /* Releases an atom from the hash chain */ + register Int hash; + register const unsigned char *p; + AtomEntry *inChain; + AtomEntry *ap = RepAtom(atom); + char unsigned *name = ap->UStrOfAE; - /* compute hash */ - p = name; - hash = HashFunction(p) % AtomHashTableSize; - WRITE_LOCK(HashChain[hash].AERWLock); - if (HashChain[hash].Entry == atom) { - NOfAtoms--; - HashChain[hash].Entry = ap->NextOfAE; + /* compute hash */ + p = name; + hash = HashFunction(p) % AtomHashTableSize; + WRITE_LOCK(HashChain[hash].AERWLock); + if (HashChain[hash].Entry == atom) { + NOfAtoms--; + HashChain[hash].Entry = ap->NextOfAE; + WRITE_UNLOCK(HashChain[hash].AERWLock); + return; + } + /* else */ + inChain = RepAtom(HashChain[hash].Entry); + while (inChain && inChain->NextOfAE != atom) + inChain = RepAtom(inChain->NextOfAE); + if (!inChain) + return; + WRITE_LOCK(inChain->ARWLock); + inChain->NextOfAE = ap->NextOfAE; + WRITE_UNLOCK(inChain->ARWLock); WRITE_UNLOCK(HashChain[hash].AERWLock); - return; + ap->NextOfAE = NULL; } - /* else */ - inChain = RepAtom(HashChain[hash].Entry); - while (inChain && inChain->NextOfAE != atom) - inChain = RepAtom(inChain->NextOfAE); - if (!inChain) - return; - WRITE_LOCK(inChain->ARWLock); - inChain->NextOfAE = ap->NextOfAE; - WRITE_UNLOCK(inChain->ARWLock); - WRITE_UNLOCK(HashChain[hash].AERWLock); - ap->NextOfAE = NULL; -} -static Prop -GetAPropHavingLock(AtomEntry *ae, - PropFlags kind) { /* look property list of atom a for kind */ - PropEntry *pp; + 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)); -} + pp = RepProp(ae->PropsOfAE); + while (!EndOfPAEntr(pp) && pp->KindOfPE != kind) + pp = RepProp(pp->NextOfPE); + return (AbsProp(pp)); + } -Prop Yap_GetAPropHavingLock( - AtomEntry *ae, PropFlags kind) { /* look property list of atom a for kind */ - return GetAPropHavingLock(ae, kind); -} + Prop Yap_GetAPropHavingLock( + AtomEntry *ae, PropFlags kind) { /* look property list of atom a for kind */ + return GetAPropHavingLock(ae, kind); + } -static Prop -GetAProp(Atom a, PropFlags kind) { /* look property list of atom a for kind */ - AtomEntry *ae = RepAtom(a); - Prop out; + static Prop + GetAProp(Atom a, PropFlags kind) { /* look property list of atom a for kind */ + AtomEntry *ae = RepAtom(a); + Prop out; - READ_LOCK(ae->ARWLock); - out = GetAPropHavingLock(ae, kind); - READ_UNLOCK(ae->ARWLock); - return (out); -} + READ_LOCK(ae->ARWLock); + out = GetAPropHavingLock(ae, kind); + READ_UNLOCK(ae->ARWLock); + return (out); + } -Prop Yap_GetAProp(Atom a, - PropFlags kind) { /* look property list of atom a for kind */ - return GetAProp(a, kind); -} + Prop Yap_GetAProp(Atom a, + PropFlags kind) { /* look property list of atom a for kind */ + return GetAProp(a, kind); + } -OpEntry *Yap_GetOpPropForAModuleHavingALock( - Atom a, Term mod) { /* look property list of atom a for kind */ - AtomEntry *ae = RepAtom(a); - PropEntry *pp; + 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)) { + 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; + } + + 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_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; + } + + OpEntry * + Yap_GetOpProp(Atom a, op_type type, + Term cmod 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 != cmod && 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; } - return (OpEntry *)pp; -} -int Yap_HasOp(Atom a) { /* look property list of atom a for kind */ - AtomEntry *ae = RepAtom(a); - PropEntry *pp; + inline static Prop GetPredPropByAtomHavingLock(AtomEntry *ae, Term cur_mod) + /* get predicate entry for ap/arity; create it if neccessary. */ + { + Prop p0; - 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 { + p0 = ae->PropsOfAE; + while (p0) { + PredEntry *pe = RepPredProp(p0); + if (pe->KindOfPE == PEProp && + (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) { + return (p0); +#if THREADS + /* Thread Local Predicates */ + if (pe->PredFlags & ThreadLocalPredFlag) { + return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS)); + } +#endif + } + p0 = pe->NextOfPE; + } + return (NIL); + } + + Prop Yap_GetPredPropByAtom(Atom at, Term cur_mod) + /* get predicate entry for ap/arity; create it if neccessary. */ + { + Prop p0; + AtomEntry *ae = RepAtom(at); + + READ_LOCK(ae->ARWLock); + p0 = GetPredPropByAtomHavingLock(ae, cur_mod); + READ_UNLOCK(ae->ARWLock); + return (p0); + } + + inline static Prop GetPredPropByAtomHavingLockInThisModule(AtomEntry *ae, Term cur_mod) + /* get predicate entry for ap/arity; create it if neccessary. */ + { + Prop p0; + + p0 = ae->PropsOfAE; + while (p0) { + PredEntry *pe = RepPredProp(p0); + if (pe->KindOfPE == PEProp && pe->ModuleOfPred == cur_mod) { +#if THREADS + /* Thread Local Predicates */ + if (pe->PredFlags & ThreadLocalPredFlag) { + return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS)); + } +#endif + return (p0); + } + p0 = pe->NextOfPE; + } + return (NIL); + } + + Prop Yap_GetPredPropByAtomInThisModule(Atom at, Term cur_mod) + /* get predicate entry for ap/arity; create it if neccessary. */ + { + Prop p0; + AtomEntry *ae = RepAtom(at); + + READ_LOCK(ae->ARWLock); + p0 = GetPredPropByAtomHavingLockInThisModule(ae, cur_mod); + READ_UNLOCK(ae->ARWLock); + return (p0); + } + + + Prop Yap_GetPredPropByFunc(Functor f, Term cur_mod) + /* get predicate entry for ap/arity; */ + { + Prop p0; + FUNC_READ_LOCK(f); + + p0 = GetPredPropByFuncHavingLock(f, cur_mod); + + FUNC_READ_UNLOCK(f); + return (p0); + } + + Prop Yap_GetPredPropByFuncInThisModule(Functor f, Term cur_mod) + /* get predicate entry for ap/arity; */ + { + Prop p0; + + FUNC_READ_LOCK(f); + p0 = GetPredPropByFuncHavingLock(f, cur_mod); + FUNC_READ_UNLOCK(f); + return (p0); + } + + Prop Yap_GetPredPropHavingLock(Atom ap, unsigned int arity, Term mod) + /* get predicate entry for ap/arity; */ + { + Prop p0; + AtomEntry *ae = RepAtom(ap); + Functor f; + + if (arity == 0) { + GetPredPropByAtomHavingLock(ae, mod); + } + f = InlinedUnlockedMkFunctor(ae, arity); + FUNC_READ_LOCK(f); + p0 = GetPredPropByFuncHavingLock(f, mod); + FUNC_READ_UNLOCK(f); + return (p0); + } + + /* get expression entry for at/arity; */ + Prop Yap_GetExpProp(Atom at, unsigned int arity) { + Prop p0; + AtomEntry *ae = RepAtom(at); + ExpEntry *p; + + READ_LOCK(ae->ARWLock); + p = RepExpProp(p0 = ae->PropsOfAE); + while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity)) + p = RepExpProp(p0 = p->NextOfPE); + READ_UNLOCK(ae->ARWLock); + return (p0); + } + + /* get expression entry for at/arity, at is already locked; */ + Prop Yap_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity) { + Prop p0; + ExpEntry *p; + + p = RepExpProp(p0 = ae->PropsOfAE); + while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity)) + p = RepExpProp(p0 = p->NextOfPE); + + return (p0); + } + + static int ExpandPredHash(void) { + UInt new_size = PredHashTableSize + PredHashIncrement; + PredEntry **oldp = PredHash; + PredEntry **np = + (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) * new_size); + UInt i; + + if (!np) { + return FALSE; + } + for (i = 0; i < new_size; i++) { + np[i] = NULL; + } + for (i = 0; i < PredHashTableSize; i++) { + PredEntry *p = PredHash[i]; + + while (p) { + PredEntry *nextp = p->NextPredOfHash; + UInt hsh = PRED_HASH(p->FunctorOfPred, p->ModuleOfPred, new_size); + p->NextPredOfHash = np[hsh]; + np[hsh] = p; + p = nextp; + } + } + PredHashTableSize = new_size; + PredHash = np; + Yap_FreeAtomSpace((ADDR)oldp); return TRUE; } -} -OpEntry * -Yap_OpPropForModule(Atom a, - Term mod) { /* look property list of atom a for kind */ - AtomEntry *ae = RepAtom(a); - PropEntry *pp; - OpEntry *info = NULL; + /* fe is supposed to be locked */ + Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) { + PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); - 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; -} - -OpEntry * -Yap_GetOpProp(Atom a, op_type type, - Term cmod 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 != cmod && 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; -} - -inline static Prop GetPredPropByAtomHavingLock(AtomEntry *ae, Term cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - - p0 = ae->PropsOfAE; - while (p0) { - PredEntry *pe = RepPredProp(p0); - if (pe->KindOfPE == PEProp && - (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) { - return (p0); -#if THREADS - /* Thread Local Predicates */ - if (pe->PredFlags & ThreadLocalPredFlag) { - return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS)); - } -#endif - } - p0 = pe->NextOfPE; - } - return (NIL); -} - -Prop Yap_GetPredPropByAtom(Atom at, Term cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - AtomEntry *ae = RepAtom(at); - - READ_LOCK(ae->ARWLock); - p0 = GetPredPropByAtomHavingLock(ae, cur_mod); - READ_UNLOCK(ae->ARWLock); - return (p0); -} - -inline static Prop GetPredPropByAtomHavingLockInThisModule(AtomEntry *ae, Term cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - - p0 = ae->PropsOfAE; - while (p0) { - PredEntry *pe = RepPredProp(p0); - if (pe->KindOfPE == PEProp && pe->ModuleOfPred == cur_mod) { -#if THREADS - /* Thread Local Predicates */ - if (pe->PredFlags & ThreadLocalPredFlag) { - return AbsPredProp(Yap_GetThreadPred(pe INIT_REGS)); - } -#endif - return (p0); - } - p0 = pe->NextOfPE; - } - return (NIL); -} - -Prop Yap_GetPredPropByAtomInThisModule(Atom at, Term cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - AtomEntry *ae = RepAtom(at); - - READ_LOCK(ae->ARWLock); - p0 = GetPredPropByAtomHavingLockInThisModule(ae, cur_mod); - READ_UNLOCK(ae->ARWLock); - return (p0); -} - - -Prop Yap_GetPredPropByFunc(Functor f, Term cur_mod) -/* get predicate entry for ap/arity; */ -{ - Prop p0; - FUNC_READ_LOCK(f); - - p0 = GetPredPropByFuncHavingLock(f, cur_mod); - - FUNC_READ_UNLOCK(f); - return (p0); -} - -Prop Yap_GetPredPropByFuncInThisModule(Functor f, Term cur_mod) -/* get predicate entry for ap/arity; */ -{ - Prop p0; - - FUNC_READ_LOCK(f); - p0 = GetPredPropByFuncHavingLock(f, cur_mod); - FUNC_READ_UNLOCK(f); - return (p0); -} - -Prop Yap_GetPredPropHavingLock(Atom ap, unsigned int arity, Term mod) -/* get predicate entry for ap/arity; */ -{ - Prop p0; - AtomEntry *ae = RepAtom(ap); - Functor f; - - if (arity == 0) { - GetPredPropByAtomHavingLock(ae, mod); - } - f = InlinedUnlockedMkFunctor(ae, arity); - FUNC_READ_LOCK(f); - p0 = GetPredPropByFuncHavingLock(f, mod); - FUNC_READ_UNLOCK(f); - return (p0); -} - -/* get expression entry for at/arity; */ -Prop Yap_GetExpProp(Atom at, unsigned int arity) { - Prop p0; - AtomEntry *ae = RepAtom(at); - ExpEntry *p; - - READ_LOCK(ae->ARWLock); - p = RepExpProp(p0 = ae->PropsOfAE); - while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity)) - p = RepExpProp(p0 = p->NextOfPE); - READ_UNLOCK(ae->ARWLock); - return (p0); -} - -/* get expression entry for at/arity, at is already locked; */ -Prop Yap_GetExpPropHavingLock(AtomEntry *ae, unsigned int arity) { - Prop p0; - ExpEntry *p; - - p = RepExpProp(p0 = ae->PropsOfAE); - while (p0 && (p->KindOfPE != ExpProperty || p->ArityOfEE != arity)) - p = RepExpProp(p0 = p->NextOfPE); - - return (p0); -} - -static int ExpandPredHash(void) { - UInt new_size = PredHashTableSize + PredHashIncrement; - PredEntry **oldp = PredHash; - PredEntry **np = - (PredEntry **)Yap_AllocAtomSpace(sizeof(PredEntry **) * new_size); - UInt i; - - if (!np) { - return FALSE; - } - for (i = 0; i < new_size; i++) { - np[i] = NULL; - } - for (i = 0; i < PredHashTableSize; i++) { - PredEntry *p = PredHash[i]; - - while (p) { - PredEntry *nextp = p->NextPredOfHash; - UInt hsh = PRED_HASH(p->FunctorOfPred, p->ModuleOfPred, new_size); - p->NextPredOfHash = np[hsh]; - np[hsh] = p; - p = nextp; - } - } - PredHashTableSize = new_size; - PredHash = np; - Yap_FreeAtomSpace((ADDR)oldp); - return TRUE; -} - -/* fe is supposed to be locked */ -Prop Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod) { - PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); - - if (p == NULL) { - WRITE_UNLOCK(fe->FRWLock); - return NULL; - } - if (cur_mod == TermProlog || cur_mod == 0L) { - p->ModuleOfPred = 0L; - } else - p->ModuleOfPred = cur_mod; - // TRUE_FUNC_WRITE_LOCK(fe); - INIT_LOCK(p->PELock); - p->KindOfPE = PEProp; - p->ArityOfPE = fe->ArityOfFE; - p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; - p->cs.p_code.NOfClauses = 0; - p->PredFlags = UndefPredFlag; - p->src.OwnerFile = Yap_source_file_name(); - p->OpcodeOfPred = UNDEF_OPCODE; - p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); - p->cs.p_code.ExpandCode = EXPAND_OP_CODE; - p->TimeStampOfPred = 0L; - p->LastCallOfPred = LUCALL_ASSERT; - p->MetaEntryOfPred = NULL; - if (cur_mod == TermProlog) - p->ModuleOfPred = 0L; - else - p->ModuleOfPred = cur_mod; - p->StatisticsForPred = NULL; - Yap_NewModulePred(cur_mod, p); - -#ifdef TABLING - p->TableOfPred = NULL; -#endif /* TABLING */ -#ifdef BEAM - p->beamTable = NULL; -#endif /* BEAM */ - /* careful that they don't cross MkFunctor */ - if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) { - p->PredFlags |= NoTracePredFlag; - } - p->FunctorOfPred = fe; - if (fe->PropsOfFE) { - UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); - - WRITE_LOCK(PredHashRWLock); - if (10 * (PredsInHashTable + 1) > 6 * PredHashTableSize) { - if (!ExpandPredHash()) { - Yap_FreeCodeSpace((ADDR)p); - WRITE_UNLOCK(PredHashRWLock); - FUNC_WRITE_UNLOCK(fe); - return NULL; - } - /* retry hashing */ - hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); - } - PredsInHashTable++; - if (p->ModuleOfPred == 0L) { - PredEntry *pe = RepPredProp(fe->PropsOfFE); - - hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize); - /* should be the first one */ - pe->NextPredOfHash = PredHash[hsh]; - PredHash[hsh] = pe; - fe->PropsOfFE = AbsPredProp(p); - p->NextOfPE = AbsPredProp(pe); - } else { - p->NextPredOfHash = PredHash[hsh]; - PredHash[hsh] = p; - p->NextOfPE = fe->PropsOfFE->NextOfPE; - fe->PropsOfFE->NextOfPE = AbsPredProp(p); - } - WRITE_UNLOCK(PredHashRWLock); - } else { - fe->PropsOfFE = AbsPredProp(p); - p->NextOfPE = NIL; - } - FUNC_WRITE_UNLOCK(fe); - { - Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, - GPROF_NEW_PRED_FUNC); - if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { - Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), - &(p->cs.p_code.ExpandCode) + 1, p, - GPROF_NEW_PRED_FUNC); - } - } - return AbsPredProp(p); -} - -#if THREADS -Prop Yap_NewThreadPred(PredEntry *ap USES_REGS) { - PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); - - if (p == NULL) { - return NIL; - } - INIT_LOCK(p->PELock); - p->StatisticsForPred = NULL : p->KindOfPE = PEProp; - p->ArityOfPE = ap->ArityOfPE; - p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; - p->cs.p_code.NOfClauses = 0; - p->PredFlags = ap->PredFlags & ~(IndexedPredFlag | SpiedPredFlag); -#if SIZEOF_INT_P == 4 - p->ExtraPredFlags = 0L; -#endif - p->MetaEntryOfPred = NULL; - p->src.OwnerFile = ap->src.OwnerFile; - p->OpcodeOfPred = FAIL_OPCODE; - p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); - p->cs.p_code.ExpandCode = EXPAND_OP_CODE; - p->ModuleOfPred = ap->ModuleOfPred; - p->NextPredOfModule = NULL; - p->TimeStampOfPred = 0L; - p->LastCallOfPred = LUCALL_ASSERT; -#ifdef TABLING - p->TableOfPred = NULL; -#endif /* TABLING */ -#ifdef BEAM - p->beamTable = NULL; -#endif - /* careful that they don't cross MkFunctor */ - p->NextOfPE = AbsPredProp(LOCAL_ThreadHandle.local_preds); - LOCAL_ThreadHandle.local_preds = p; - p->FunctorOfPred = ap->FunctorOfPred; - Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, - GPROF_NEW_PRED_THREAD); - if (falseGlobalPrologFlag(DEBUG_INFO_FLAG)) { - p->PredFlags |= (NoSpyPredFlag | NoTracePredFlag); - } - if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { - Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), - &(p->cs.p_code.ExpandCode) + 1, p, - GPROF_NEW_PRED_THREAD); - } - return AbsPredProp(p); -} -#endif - -Prop Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod) { - Prop p0; - PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); - CACHE_REGS - /* Printf("entering %s:%s/0\n", RepAtom(AtomOfTerm(cur_mod))->StrOfAE, - * ae->StrOfAE); */ - - if (p == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return NIL; - } - INIT_LOCK(p->PELock); - p->KindOfPE = PEProp; - p->ArityOfPE = 0; - p->StatisticsForPred = NULL; - p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; - p->cs.p_code.NOfClauses = 0; - p->PredFlags = UndefPredFlag; - p->src.OwnerFile = Yap_source_file_name(); - p->OpcodeOfPred = UNDEF_OPCODE; - p->cs.p_code.ExpandCode = EXPAND_OP_CODE; - p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); - p->MetaEntryOfPred = NULL; - if (cur_mod == TermProlog) - p->ModuleOfPred = 0; - else - p->ModuleOfPred = cur_mod; - Yap_NewModulePred(cur_mod, p); - p->TimeStampOfPred = 0L; - p->LastCallOfPred = LUCALL_ASSERT; -#ifdef TABLING - p->TableOfPred = NULL; -#endif /* TABLING */ -#ifdef BEAM - p->beamTable = NULL; -#endif - /* careful that they don't cross MkFunctor */ - AddPropToAtom(ae, (PropEntry *)p); - p0 = AbsPredProp(p); - p->FunctorOfPred = (Functor)AbsAtom(ae); - if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) { - p->PredFlags |= (NoTracePredFlag | NoSpyPredFlag); - } - if (Yap_isSystemModule(CurrentModule)) - p->PredFlags |= StandardPredFlag; - WRITE_UNLOCK(ae->ARWLock); - { - Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, - GPROF_NEW_PRED_ATOM); - if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { - Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), - &(p->cs.p_code.ExpandCode) + 1, p, - GPROF_NEW_PRED_ATOM); - } - } - return p0; -} - -Prop Yap_PredPropByFunctorNonThreadLocal(Functor f, Term cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - PredEntry *p; - - FUNC_WRITE_LOCK(f); - if (!(p = RepPredProp(f->PropsOfFE))) - return Yap_NewPredPropByFunctor(f, cur_mod); - - if ((p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) { - /* don't match multi-files */ - if (/*!(p->PredFlags & MultiFileFlag) ||*/ true || p->ModuleOfPred || !cur_mod || - cur_mod == TermProlog) { - FUNC_WRITE_UNLOCK(f); - return AbsPredProp(p); - } - } - if (p->NextOfPE) { - UInt hash = PRED_HASH(f, cur_mod, PredHashTableSize); - READ_LOCK(PredHashRWLock); - p = PredHash[hash]; - - while (p) { - if (p->FunctorOfPred == f && p->ModuleOfPred == cur_mod) { - READ_UNLOCK(PredHashRWLock); - FUNC_WRITE_UNLOCK(f); - return AbsPredProp(p); - } - p = p->NextPredOfHash; - } - READ_UNLOCK(PredHashRWLock); - } - return Yap_NewPredPropByFunctor(f, cur_mod); -} - -Prop Yap_PredPropByAtomNonThreadLocal(Atom at, Term cur_mod) -/* get predicate entry for ap/arity; create it if neccessary. */ -{ - Prop p0; - AtomEntry *ae = RepAtom(at); - - WRITE_LOCK(ae->ARWLock); - p0 = ae->PropsOfAE; - while (p0) { - PredEntry *pe = RepPredProp(p0); - if (pe->KindOfPE == PEProp && - (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) { - /* don't match multi-files */ - if (/*!(pe->PredFlags & MultiFileFlag) ||*/ true || pe->ModuleOfPred || !cur_mod || - cur_mod == TermProlog) { - WRITE_UNLOCK(ae->ARWLock); - return (p0); - } - } - p0 = pe->NextOfPE; - } - return Yap_NewPredPropByAtom(ae, cur_mod); -} - -Term Yap_GetValue(Atom a) { - Prop p0 = GetAProp(a, ValProperty); - Term out; - - if (p0 == NIL) - return (TermNil); - READ_LOCK(RepValProp(p0)->VRWLock); - out = RepValProp(p0)->ValueOfVE; - if (IsApplTerm(out)) { - Functor f = FunctorOfTerm(out); - if (f == FunctorDouble) { - CACHE_REGS - out = MkFloatTerm(FloatOfTerm(out)); - } else if (f == FunctorLongInt) { - CACHE_REGS - out = MkLongIntTerm(LongIntOfTerm(out)); - } else if (f == FunctorString) { - CACHE_REGS - out = MkStringTerm(StringOfTerm(out)); - } -#ifdef USE_GMP - else { - out = Yap_MkBigIntTerm(Yap_BigIntOfTerm(out)); - } -#endif - } - READ_UNLOCK(RepValProp(p0)->VRWLock); - return (out); -} - -void Yap_PutValue(Atom a, Term v) { - AtomEntry *ae = RepAtom(a); - Prop p0; - ValEntry *p; - Term t0; - - WRITE_LOCK(ae->ARWLock); - p0 = GetAPropHavingLock(ae, ValProperty); - if (p0 != NIL) { - p = RepValProp(p0); - WRITE_LOCK(p->VRWLock); - WRITE_UNLOCK(ae->ARWLock); - } else { - p = (ValEntry *)Yap_AllocAtomSpace(sizeof(ValEntry)); if (p == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return; + WRITE_UNLOCK(fe->FRWLock); + return NULL; + } + if (cur_mod == TermProlog || cur_mod == 0L) { + p->ModuleOfPred = 0L; + } else + p->ModuleOfPred = cur_mod; + // TRUE_FUNC_WRITE_LOCK(fe); + INIT_LOCK(p->PELock); + p->KindOfPE = PEProp; + p->ArityOfPE = fe->ArityOfFE; + p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; + p->cs.p_code.NOfClauses = 0; + p->PredFlags = UndefPredFlag; + p->src.OwnerFile = Yap_source_file_name(); + p->OpcodeOfPred = UNDEF_OPCODE; + p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); + p->cs.p_code.ExpandCode = EXPAND_OP_CODE; + p->TimeStampOfPred = 0L; + p->LastCallOfPred = LUCALL_ASSERT; + p->MetaEntryOfPred = NULL; + if (cur_mod == TermProlog) + p->ModuleOfPred = 0L; + else + p->ModuleOfPred = cur_mod; + p->StatisticsForPred = NULL; + Yap_NewModulePred(cur_mod, p); + +#ifdef TABLING + p->TableOfPred = NULL; +#endif /* TABLING */ +#ifdef BEAM + p->beamTable = NULL; +#endif /* BEAM */ + /* careful that they don't cross MkFunctor */ + if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) { + p->PredFlags |= NoTracePredFlag; + } + p->FunctorOfPred = fe; + if (fe->PropsOfFE) { + UInt hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); + + WRITE_LOCK(PredHashRWLock); + if (10 * (PredsInHashTable + 1) > 6 * PredHashTableSize) { + if (!ExpandPredHash()) { + Yap_FreeCodeSpace((ADDR)p); + WRITE_UNLOCK(PredHashRWLock); + FUNC_WRITE_UNLOCK(fe); + return NULL; + } + /* retry hashing */ + hsh = PRED_HASH(fe, cur_mod, PredHashTableSize); + } + PredsInHashTable++; + if (p->ModuleOfPred == 0L) { + PredEntry *pe = RepPredProp(fe->PropsOfFE); + + hsh = PRED_HASH(fe, pe->ModuleOfPred, PredHashTableSize); + /* should be the first one */ + pe->NextPredOfHash = PredHash[hsh]; + PredHash[hsh] = pe; + fe->PropsOfFE = AbsPredProp(p); + p->NextOfPE = AbsPredProp(pe); + } else { + p->NextPredOfHash = PredHash[hsh]; + PredHash[hsh] = p; + p->NextOfPE = fe->PropsOfFE->NextOfPE; + fe->PropsOfFE->NextOfPE = AbsPredProp(p); + } + WRITE_UNLOCK(PredHashRWLock); + } else { + fe->PropsOfFE = AbsPredProp(p); + p->NextOfPE = NIL; + } + FUNC_WRITE_UNLOCK(fe); + { + Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, + GPROF_NEW_PRED_FUNC); + if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { + Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), + &(p->cs.p_code.ExpandCode) + 1, p, + GPROF_NEW_PRED_FUNC); + } + } + return AbsPredProp(p); + } + +#if THREADS + Prop Yap_NewThreadPred(PredEntry *ap USES_REGS) { + PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); + + if (p == NULL) { + return NIL; + } + INIT_LOCK(p->PELock); + p->StatisticsForPred = NULL : p->KindOfPE = PEProp; + p->ArityOfPE = ap->ArityOfPE; + p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; + p->cs.p_code.NOfClauses = 0; + p->PredFlags = ap->PredFlags & ~(IndexedPredFlag | SpiedPredFlag); +#if SIZEOF_INT_P == 4 + p->ExtraPredFlags = 0L; +#endif + p->MetaEntryOfPred = NULL; + p->src.OwnerFile = ap->src.OwnerFile; + p->OpcodeOfPred = FAIL_OPCODE; + p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); + p->cs.p_code.ExpandCode = EXPAND_OP_CODE; + p->ModuleOfPred = ap->ModuleOfPred; + p->NextPredOfModule = NULL; + p->TimeStampOfPred = 0L; + p->LastCallOfPred = LUCALL_ASSERT; +#ifdef TABLING + p->TableOfPred = NULL; +#endif /* TABLING */ +#ifdef BEAM + p->beamTable = NULL; +#endif + /* careful that they don't cross MkFunctor */ + p->NextOfPE = AbsPredProp(LOCAL_ThreadHandle.local_preds); + LOCAL_ThreadHandle.local_preds = p; + p->FunctorOfPred = ap->FunctorOfPred; + Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, + GPROF_NEW_PRED_THREAD); + if (falseGlobalPrologFlag(DEBUG_INFO_FLAG)) { + p->PredFlags |= (NoSpyPredFlag | NoTracePredFlag); + } + if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { + Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), + &(p->cs.p_code.ExpandCode) + 1, p, + GPROF_NEW_PRED_THREAD); + } + return AbsPredProp(p); + } +#endif + + Prop Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod) { + Prop p0; + PredEntry *p = (PredEntry *)Yap_AllocAtomSpace(sizeof(*p)); + CACHE_REGS + /* Printf("entering %s:%s/0\n", RepAtom(AtomOfTerm(cur_mod))->StrOfAE, + * ae->StrOfAE); */ + + if (p == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return NIL; + } + INIT_LOCK(p->PELock); + p->KindOfPE = PEProp; + p->ArityOfPE = 0; + p->StatisticsForPred = NULL; + p->cs.p_code.FirstClause = p->cs.p_code.LastClause = NULL; + p->cs.p_code.NOfClauses = 0; + p->PredFlags = UndefPredFlag; + p->src.OwnerFile = Yap_source_file_name(); + p->OpcodeOfPred = UNDEF_OPCODE; + p->cs.p_code.ExpandCode = EXPAND_OP_CODE; + p->CodeOfPred = p->cs.p_code.TrueCodeOfPred = (yamop *)(&(p->OpcodeOfPred)); + p->MetaEntryOfPred = NULL; + if (cur_mod == TermProlog) + p->ModuleOfPred = 0; + else + p->ModuleOfPred = cur_mod; + Yap_NewModulePred(cur_mod, p); + p->TimeStampOfPred = 0L; + p->LastCallOfPred = LUCALL_ASSERT; +#ifdef TABLING + p->TableOfPred = NULL; +#endif /* TABLING */ +#ifdef BEAM + p->beamTable = NULL; +#endif + /* careful that they don't cross MkFunctor */ + AddPropToAtom(ae, (PropEntry *)p); + p0 = AbsPredProp(p); + p->FunctorOfPred = (Functor)AbsAtom(ae); + if (!trueGlobalPrologFlag(DEBUG_INFO_FLAG)) { + p->PredFlags |= (NoTracePredFlag | NoSpyPredFlag); + } + if (Yap_isSystemModule(CurrentModule)) + p->PredFlags |= StandardPredFlag; + WRITE_UNLOCK(ae->ARWLock); + { + Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred) + 1, p, + GPROF_NEW_PRED_ATOM); + if (!(p->PredFlags & (CPredFlag | AsmPredFlag))) { + Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), + &(p->cs.p_code.ExpandCode) + 1, p, + GPROF_NEW_PRED_ATOM); + } + } + return p0; + } + + Prop Yap_PredPropByFunctorNonThreadLocal(Functor f, Term cur_mod) + /* get predicate entry for ap/arity; create it if neccessary. */ + { + PredEntry *p; + + FUNC_WRITE_LOCK(f); + if (!(p = RepPredProp(f->PropsOfFE))) + return Yap_NewPredPropByFunctor(f, cur_mod); + + if ((p->ModuleOfPred == cur_mod || !(p->ModuleOfPred))) { + /* don't match multi-files */ + if (/*!(p->PredFlags & MultiFileFlag) ||*/ true || p->ModuleOfPred || !cur_mod || + cur_mod == TermProlog) { + FUNC_WRITE_UNLOCK(f); + return AbsPredProp(p); + } + } + if (p->NextOfPE) { + UInt hash = PRED_HASH(f, cur_mod, PredHashTableSize); + READ_LOCK(PredHashRWLock); + p = PredHash[hash]; + + while (p) { + if (p->FunctorOfPred == f && p->ModuleOfPred == cur_mod) { + READ_UNLOCK(PredHashRWLock); + FUNC_WRITE_UNLOCK(f); + return AbsPredProp(p); + } + p = p->NextPredOfHash; + } + READ_UNLOCK(PredHashRWLock); + } + return Yap_NewPredPropByFunctor(f, cur_mod); + } + + Prop Yap_PredPropByAtomNonThreadLocal(Atom at, Term cur_mod) + /* get predicate entry for ap/arity; create it if neccessary. */ + { + Prop p0; + AtomEntry *ae = RepAtom(at); + + WRITE_LOCK(ae->ARWLock); + p0 = ae->PropsOfAE; + while (p0) { + PredEntry *pe = RepPredProp(p0); + if (pe->KindOfPE == PEProp && + (pe->ModuleOfPred == cur_mod || !pe->ModuleOfPred)) { + /* don't match multi-files */ + if (/*!(pe->PredFlags & MultiFileFlag) ||*/ true || pe->ModuleOfPred || !cur_mod || + cur_mod == TermProlog) { + WRITE_UNLOCK(ae->ARWLock); + return (p0); + } + } + p0 = pe->NextOfPE; + } + return Yap_NewPredPropByAtom(ae, cur_mod); + } + + Term Yap_GetValue(Atom a) { + Prop p0 = GetAProp(a, ValProperty); + Term out; + + if (p0 == NIL) + return (TermNil); + READ_LOCK(RepValProp(p0)->VRWLock); + out = RepValProp(p0)->ValueOfVE; + if (IsApplTerm(out)) { + Functor f = FunctorOfTerm(out); + if (f == FunctorDouble) { + CACHE_REGS + out = MkFloatTerm(FloatOfTerm(out)); + } else if (f == FunctorLongInt) { + CACHE_REGS + out = MkLongIntTerm(LongIntOfTerm(out)); + } else if (f == FunctorString) { + CACHE_REGS + out = MkStringTerm(StringOfTerm(out)); + } +#ifdef USE_GMP + else { + out = Yap_MkBigIntTerm(Yap_BigIntOfTerm(out)); + } +#endif + } + READ_UNLOCK(RepValProp(p0)->VRWLock); + return (out); + } + + void Yap_PutValue(Atom a, Term v) { + AtomEntry *ae = RepAtom(a); + Prop p0; + ValEntry *p; + Term t0; + + WRITE_LOCK(ae->ARWLock); + p0 = GetAPropHavingLock(ae, ValProperty); + if (p0 != NIL) { + p = RepValProp(p0); + WRITE_LOCK(p->VRWLock); + WRITE_UNLOCK(ae->ARWLock); + } else { + p = (ValEntry *)Yap_AllocAtomSpace(sizeof(ValEntry)); + if (p == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return; + } + p->KindOfPE = ValProperty; + p->ValueOfVE = TermNil; + AddPropToAtom(RepAtom(a), (PropEntry *)p); + /* take care that the lock for the property will be inited even + if someone else searches for the property */ + INIT_RWLOCK(p->VRWLock); + WRITE_LOCK(p->VRWLock); + WRITE_UNLOCK(ae->ARWLock); + } + t0 = p->ValueOfVE; + if (IsFloatTerm(v)) { + /* store a float in code space, so that we can access the property */ + union { + Float f; + CELL ar[sizeof(Float) / sizeof(CELL)]; + } un; + CELL *pt, *iptr; + unsigned int i; + + un.f = FloatOfTerm(v); + if (IsFloatTerm(t0)) { + pt = RepAppl(t0); + } else { + if (IsApplTerm(t0)) { + Yap_FreeCodeSpace((char *)(RepAppl(t0))); + } + pt = (CELL *)Yap_AllocAtomSpace(sizeof(CELL) * + (1 + 2 * sizeof(Float) / sizeof(CELL))); + if (pt == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return; + } + p->ValueOfVE = AbsAppl(pt); + pt[0] = (CELL)FunctorDouble; + } + + iptr = pt + 1; + for (i = 0; i < sizeof(Float) / sizeof(CELL); i++) { + *iptr++ = (CELL)un.ar[i]; + } + } else if (IsLongIntTerm(v)) { + CELL *pt; + Int val = LongIntOfTerm(v); + + if (IsLongIntTerm(t0)) { + pt = RepAppl(t0); + } else { + if (IsApplTerm(t0)) { + Yap_FreeCodeSpace((char *)(RepAppl(t0))); + } + pt = (CELL *)Yap_AllocAtomSpace(2 * sizeof(CELL)); + if (pt == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return; + } + p->ValueOfVE = AbsAppl(pt); + pt[0] = (CELL)FunctorLongInt; + } + pt[1] = (CELL)val; +#ifdef USE_GMP + } else if (IsBigIntTerm(v)) { + CELL *ap = RepAppl(v); + Int sz = sizeof(MP_INT) + sizeof(CELL) + + (((MP_INT *)(ap + 1))->_mp_alloc * sizeof(mp_limb_t)); + CELL *pt = (CELL *)Yap_AllocAtomSpace(sz); + + if (pt == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return; + } + if (IsApplTerm(t0)) { + Yap_FreeCodeSpace((char *)RepAppl(t0)); + } + memcpy((void *)pt, (void *)ap, sz); + p->ValueOfVE = AbsAppl(pt); +#endif + } else if (IsStringTerm(v)) { + CELL *ap = RepAppl(v); + Int sz = sizeof(CELL) * (3 + ap[1]); + CELL *pt = (CELL *)Yap_AllocAtomSpace(sz); + + if (pt == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return; + } + if (IsApplTerm(t0)) { + Yap_FreeCodeSpace((char *)RepAppl(t0)); + } + memcpy((void *)pt, (void *)ap, sz); + p->ValueOfVE = AbsAppl(pt); + } else { + if (IsApplTerm(t0)) { + /* recover space */ + Yap_FreeCodeSpace((char *)(RepAppl(p->ValueOfVE))); + } + p->ValueOfVE = v; + } + WRITE_UNLOCK(p->VRWLock); + } + + bool Yap_PutAtomTranslation(Atom a, arity_t arity, Int i) { + AtomEntry *ae = RepAtom(a); + Prop p0; + TranslationEntry *p; + + WRITE_LOCK(ae->ARWLock); + p0 = GetAPropHavingLock(ae, TranslationProperty); + if (p0 == NIL) { + p = (TranslationEntry *)Yap_AllocAtomSpace(sizeof(TranslationEntry)); + if (p == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return false; + } + p->KindOfPE = TranslationProperty; + p->Translation = i; + p->arity = arity; + AddPropToAtom(RepAtom(a), (PropEntry *)p); } - p->KindOfPE = ValProperty; - p->ValueOfVE = TermNil; - AddPropToAtom(RepAtom(a), (PropEntry *)p); /* take care that the lock for the property will be inited even if someone else searches for the property */ - INIT_RWLOCK(p->VRWLock); - WRITE_LOCK(p->VRWLock); WRITE_UNLOCK(ae->ARWLock); + return true; } - t0 = p->ValueOfVE; - if (IsFloatTerm(v)) { - /* store a float in code space, so that we can access the property */ - union { - Float f; - CELL ar[sizeof(Float) / sizeof(CELL)]; - } un; - CELL *pt, *iptr; - unsigned int i; - un.f = FloatOfTerm(v); - if (IsFloatTerm(t0)) { - pt = RepAppl(t0); - } else { - if (IsApplTerm(t0)) { - Yap_FreeCodeSpace((char *)(RepAppl(t0))); + bool Yap_PutFunctorTranslation(Atom a, arity_t arity, Int i) { + AtomEntry *ae = RepAtom(a); + Prop p0; + TranslationEntry *p; + + WRITE_LOCK(ae->ARWLock); + p0 = GetAPropHavingLock(ae, TranslationProperty); + if (p0 == NIL) { + p = (TranslationEntry *)Yap_AllocAtomSpace(sizeof(TranslationEntry)); + if (p == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return false; } - pt = (CELL *)Yap_AllocAtomSpace(sizeof(CELL) * - (1 + 2 * sizeof(Float) / sizeof(CELL))); - if (pt == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return; + p->KindOfPE = TranslationProperty; + p->Translation = i; + p->arity = arity; + AddPropToAtom(RepAtom(a), (PropEntry *)p); + } + /* take care that the lock for the property will be inited even + if someone else searches for the property */ + WRITE_UNLOCK(ae->ARWLock); + return true; + } + + bool Yap_PutAtomMutex(Atom a, void *i) { + AtomEntry *ae = RepAtom(a); + Prop p0; + MutexEntry *p; + + WRITE_LOCK(ae->ARWLock); + p0 = GetAPropHavingLock(ae, MutexProperty); + if (p0 == NIL) { + p = (MutexEntry *)Yap_AllocAtomSpace(sizeof(MutexEntry)); + if (p == NULL) { + WRITE_UNLOCK(ae->ARWLock); + return false; } - p->ValueOfVE = AbsAppl(pt); - pt[0] = (CELL)FunctorDouble; + p->KindOfPE = MutexProperty; + p->Mutex = i; + AddPropToAtom(RepAtom(a), (PropEntry *)p); } - - iptr = pt + 1; - for (i = 0; i < sizeof(Float) / sizeof(CELL); i++) { - *iptr++ = (CELL)un.ar[i]; - } - } else if (IsLongIntTerm(v)) { - CELL *pt; - Int val = LongIntOfTerm(v); - - if (IsLongIntTerm(t0)) { - pt = RepAppl(t0); - } else { - if (IsApplTerm(t0)) { - Yap_FreeCodeSpace((char *)(RepAppl(t0))); - } - pt = (CELL *)Yap_AllocAtomSpace(2 * sizeof(CELL)); - if (pt == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return; - } - p->ValueOfVE = AbsAppl(pt); - pt[0] = (CELL)FunctorLongInt; - } - pt[1] = (CELL)val; -#ifdef USE_GMP - } else if (IsBigIntTerm(v)) { - CELL *ap = RepAppl(v); - Int sz = sizeof(MP_INT) + sizeof(CELL) + - (((MP_INT *)(ap + 1))->_mp_alloc * sizeof(mp_limb_t)); - CELL *pt = (CELL *)Yap_AllocAtomSpace(sz); - - if (pt == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return; - } - if (IsApplTerm(t0)) { - Yap_FreeCodeSpace((char *)RepAppl(t0)); - } - memcpy((void *)pt, (void *)ap, sz); - p->ValueOfVE = AbsAppl(pt); -#endif - } else if (IsStringTerm(v)) { - CELL *ap = RepAppl(v); - Int sz = sizeof(CELL) * (3 + ap[1]); - CELL *pt = (CELL *)Yap_AllocAtomSpace(sz); - - if (pt == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return; - } - if (IsApplTerm(t0)) { - Yap_FreeCodeSpace((char *)RepAppl(t0)); - } - memcpy((void *)pt, (void *)ap, sz); - p->ValueOfVE = AbsAppl(pt); - } else { - if (IsApplTerm(t0)) { - /* recover space */ - Yap_FreeCodeSpace((char *)(RepAppl(p->ValueOfVE))); - } - p->ValueOfVE = v; + /* take care that the lock for the property will be inited even + if someone else searches for the property */ + WRITE_UNLOCK(ae->ARWLock); + return true; } - WRITE_UNLOCK(p->VRWLock); -} -bool Yap_PutAtomTranslation(Atom a, arity_t arity, Int i) { - AtomEntry *ae = RepAtom(a); - Prop p0; - TranslationEntry *p; + Term Yap_ArrayToList(register Term *tp, size_t nof) { + CACHE_REGS + register Term *pt = tp + nof; + register Term t; - WRITE_LOCK(ae->ARWLock); - p0 = GetAPropHavingLock(ae, TranslationProperty); - if (p0 == NIL) { - p = (TranslationEntry *)Yap_AllocAtomSpace(sizeof(TranslationEntry)); - if (p == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return false; - } - p->KindOfPE = TranslationProperty; - p->Translation = i; - p->arity = arity; - AddPropToAtom(RepAtom(a), (PropEntry *)p); - } - /* take care that the lock for the property will be inited even - if someone else searches for the property */ - WRITE_UNLOCK(ae->ARWLock); - return true; -} - -bool Yap_PutFunctorTranslation(Atom a, arity_t arity, Int i) { - AtomEntry *ae = RepAtom(a); - Prop p0; - TranslationEntry *p; - - WRITE_LOCK(ae->ARWLock); - p0 = GetAPropHavingLock(ae, TranslationProperty); - if (p0 == NIL) { - p = (TranslationEntry *)Yap_AllocAtomSpace(sizeof(TranslationEntry)); - if (p == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return false; - } - p->KindOfPE = TranslationProperty; - p->Translation = i; - p->arity = arity; - AddPropToAtom(RepAtom(a), (PropEntry *)p); - } - /* take care that the lock for the property will be inited even - if someone else searches for the property */ - WRITE_UNLOCK(ae->ARWLock); - return true; -} - -bool Yap_PutAtomMutex(Atom a, void *i) { - AtomEntry *ae = RepAtom(a); - Prop p0; - MutexEntry *p; - - WRITE_LOCK(ae->ARWLock); - p0 = GetAPropHavingLock(ae, MutexProperty); - if (p0 == NIL) { - p = (MutexEntry *)Yap_AllocAtomSpace(sizeof(MutexEntry)); - if (p == NULL) { - WRITE_UNLOCK(ae->ARWLock); - return false; - } - p->KindOfPE = MutexProperty; - p->Mutex = i; - AddPropToAtom(RepAtom(a), (PropEntry *)p); - } - /* take care that the lock for the property will be inited even - if someone else searches for the property */ - WRITE_UNLOCK(ae->ARWLock); - return true; -} - -Term Yap_ArrayToList(register Term *tp, size_t nof) { - CACHE_REGS - register Term *pt = tp + nof; - register Term t; - - t = MkAtomTerm(AtomNil); - while (pt > tp) { - Term tm = *--pt; + t = MkAtomTerm(AtomNil); + while (pt > tp) { + Term tm = *--pt; #if YAPOR_SBA - if (tm == 0) - t = MkPairTerm((CELL)pt, t); - else + if (tm == 0) + t = MkPairTerm((CELL)pt, t); + else #endif - t = MkPairTerm(tm, t); - } - return (t); -} - -int Yap_GetName(char *s, UInt max, Term t) { - register Term Head; - register Int i; - - if (IsVarTerm(t) || !IsPairTerm(t)) - return FALSE; - while (IsPairTerm(t)) { - Head = HeadOfTerm(t); - if (!IsNumTerm(Head)) - return (FALSE); - i = IntOfTerm(Head); - if (i < 0 || i > MAX_ISO_LATIN1) - return FALSE; - *s++ = i; - t = TailOfTerm(t); - if (--max == 0) { - Yap_Error(SYSTEM_ERROR_FATAL, t, "not enough space for GetName"); + t = MkPairTerm(tm, t); } + return (t); + } + + int Yap_GetName(char *s, UInt max, Term t) { + register Term Head; + register Int i; + + if (IsVarTerm(t) || !IsPairTerm(t)) + return FALSE; + while (IsPairTerm(t)) { + Head = HeadOfTerm(t); + if (!IsNumTerm(Head)) + return (FALSE); + i = IntOfTerm(Head); + if (i < 0 || i > MAX_ISO_LATIN1) + return FALSE; + *s++ = i; + t = TailOfTerm(t); + if (--max == 0) { + Yap_Error(SYSTEM_ERROR_FATAL, t, "not enough space for GetName"); + } + } + *s = '\0'; + return TRUE; } - *s = '\0'; - return TRUE; -} #ifdef SFUNC -Term MkSFTerm(Functor f, int n, Term *a, empty_value) { - Term t, p = AbsAppl(H); - int i; + Term MkSFTerm(Functor f, int n, Term *a, empty_value) { + Term t, p = AbsAppl(H); + int i; - *H++ = f; - RESET_VARIABLE(H); - ++H; - for (i = 1; i <= n; ++i) { - t = Derefa(a++); - if (t != empty_value) { - *H++ = i; - *H++ = t; + *H++ = f; + RESET_VARIABLE(H); + ++H; + for (i = 1; i <= n; ++i) { + t = Derefa(a++); + if (t != empty_value) { + *H++ = i; + *H++ = t; + } } + *H++ = 0; + return (p); } - *H++ = 0; - return (p); -} -CELL *ArgsOfSFTerm(Term t) { - CELL *p = RepAppl(t) + 1; + CELL *ArgsOfSFTerm(Term t) { + CELL *p = RepAppl(t) + 1; - while (*p != (CELL)p) - p = CellPtr(*p) + 1; - return (p + 1); -} + while (*p != (CELL)p) + p = CellPtr(*p) + 1; + return (p + 1); + } #endif -static HoldEntry *InitAtomHold(void) { - HoldEntry *x = (HoldEntry *)Yap_AllocAtomSpace(sizeof(struct hold_entry)); - if (x == NULL) { - return NULL; + static HoldEntry *InitAtomHold(void) { + HoldEntry *x = (HoldEntry *)Yap_AllocAtomSpace(sizeof(struct hold_entry)); + if (x == NULL) { + return NULL; + } + x->KindOfPE = HoldProperty; + x->NextOfPE = NIL; + x->RefsOfPE = 1; + return x; } - x->KindOfPE = HoldProperty; - x->NextOfPE = NIL; - x->RefsOfPE = 1; - return x; -} -int Yap_AtomIncreaseHold(Atom at) { - AtomEntry *ae = RepAtom(at); - HoldEntry *pp; - Prop *opp = &(ae->PropsOfAE); + int Yap_AtomIncreaseHold(Atom at) { + AtomEntry *ae = RepAtom(at); + HoldEntry *pp; + Prop *opp = &(ae->PropsOfAE); - WRITE_LOCK(ae->ARWLock); - pp = RepHoldProp(ae->PropsOfAE); - while (!EndOfPAEntr(pp) && pp->KindOfPE != HoldProperty) { - opp = &(pp->NextOfPE); - pp = RepHoldProp(pp->NextOfPE); + WRITE_LOCK(ae->ARWLock); + pp = RepHoldProp(ae->PropsOfAE); + while (!EndOfPAEntr(pp) && pp->KindOfPE != HoldProperty) { + opp = &(pp->NextOfPE); + pp = RepHoldProp(pp->NextOfPE); + } + if (!pp) { + HoldEntry *new = InitAtomHold(); + if (!new) { + WRITE_UNLOCK(ae->ARWLock); + return FALSE; + } + *opp = AbsHoldProp(new); + } else { + pp->RefsOfPE++; + } + WRITE_UNLOCK(ae->ARWLock); + return TRUE; } - if (!pp) { - HoldEntry *new = InitAtomHold(); - if (!new) { + + int Yap_AtomDecreaseHold(Atom at) { + AtomEntry *ae = RepAtom(at); + HoldEntry *pp; + Prop *opp = &(ae->PropsOfAE); + + WRITE_LOCK(ae->ARWLock); + pp = RepHoldProp(ae->PropsOfAE); + while (!EndOfPAEntr(pp) && pp->KindOfPE != HoldProperty) { + opp = &(pp->NextOfPE); + pp = RepHoldProp(pp->NextOfPE); + } + if (!pp) { WRITE_UNLOCK(ae->ARWLock); return FALSE; } - *opp = AbsHoldProp(new); - } else { - pp->RefsOfPE++; - } - WRITE_UNLOCK(ae->ARWLock); - return TRUE; -} - -int Yap_AtomDecreaseHold(Atom at) { - AtomEntry *ae = RepAtom(at); - HoldEntry *pp; - Prop *opp = &(ae->PropsOfAE); - - WRITE_LOCK(ae->ARWLock); - pp = RepHoldProp(ae->PropsOfAE); - while (!EndOfPAEntr(pp) && pp->KindOfPE != HoldProperty) { - opp = &(pp->NextOfPE); - pp = RepHoldProp(pp->NextOfPE); - } - if (!pp) { + pp->RefsOfPE--; + if (!pp->RefsOfPE) { + *opp = pp->NextOfPE; + Yap_FreeCodeSpace((ADDR)pp); + } WRITE_UNLOCK(ae->ARWLock); - return FALSE; + return TRUE; } - pp->RefsOfPE--; - if (!pp->RefsOfPE) { - *opp = pp->NextOfPE; - Yap_FreeCodeSpace((ADDR)pp); - } - WRITE_UNLOCK(ae->ARWLock); - return TRUE; -} -const char *IndicatorOfPred(PredEntry *pe) { - const char *mods; - Atom at; - arity_t arity; - if (pe->ModuleOfPred == IDB_MODULE) { - mods = "idb"; - if (pe->PredFlags & NumberDBPredFlag) { - snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "idb:" UInt_FORMAT, - (Int)(pe->FunctorOfPred)); - return LOCAL_FileNameBuf; - } else if (pe->PredFlags & AtomDBPredFlag) { - at = (Atom)pe->FunctorOfPred; - arity = 0; + const char *IndicatorOfPred(PredEntry *pe) { + const char *mods; + Atom at; + arity_t arity; + if (pe->ModuleOfPred == IDB_MODULE) { + mods = "idb"; + if (pe->PredFlags & NumberDBPredFlag) { + snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "idb:" UInt_FORMAT, + (Int)(pe->FunctorOfPred)); + return LOCAL_FileNameBuf; + } else if (pe->PredFlags & AtomDBPredFlag) { + at = (Atom)pe->FunctorOfPred; + arity = 0; + } else { + at = NameOfFunctor(pe->FunctorOfPred); + arity = ArityOfFunctor(pe->FunctorOfPred); + } } else { - at = NameOfFunctor(pe->FunctorOfPred); - arity = ArityOfFunctor(pe->FunctorOfPred); - } - } else { - if (pe->ModuleOfPred == 0) - mods = "prolog"; - else - mods = RepAtom(AtomOfTerm(pe->ModuleOfPred))->StrOfAE; - arity = pe->ArityOfPE; - if (arity == 0) { - at = (Atom)pe->FunctorOfPred; - } else { - at = NameOfFunctor(pe->FunctorOfPred); + if (pe->ModuleOfPred == 0) + mods = "prolog"; + else + mods = RepAtom(AtomOfTerm(pe->ModuleOfPred))->StrOfAE; + arity = pe->ArityOfPE; + if (arity == 0) { + at = (Atom)pe->FunctorOfPred; + } else { + at = NameOfFunctor(pe->FunctorOfPred); + } } + snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s:%s/" UInt_FORMAT, mods, + RepAtom(at)->StrOfAE, arity); + return LOCAL_FileNameBuf; } - snprintf(LOCAL_FileNameBuf, YAP_FILENAME_MAX, "%s:%s/" UInt_FORMAT, mods, - RepAtom(at)->StrOfAE, arity); - return LOCAL_FileNameBuf; -} diff --git a/C/errors.c b/C/errors.c index 5585b42a9..615c6ea10 100755 --- a/C/errors.c +++ b/C/errors.c @@ -38,7 +38,7 @@ bool Yap_Warning(const char *s, ...) { PredEntry *pred; bool rc; Term ts[2]; - const char *format; + const char *fmt; char tmpbuf[MAXPATHLEN]; LOCAL_DoingUndefp = true; @@ -46,12 +46,12 @@ bool Yap_Warning(const char *s, ...) { pred = RepPredProp(PredPropByFunc(FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2 va_start(ap, s); - format = va_arg(ap, char *); - if (format != NULL) { + fmt = va_arg(ap, char *); + if (fmt != NULL) { #if HAVE_VSNPRINTF - vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap); + vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap); #else - (void)vsprintf(tmpbuf, format, ap); + (void)vsprintf(tmpbuf, fmt, ap); #endif } else return false; @@ -321,12 +321,12 @@ void Yap_ThrowError__(const char *file, const char *function, int lineno, char tmpbuf[MAXPATHLEN]; va_start(ap, where); - char *format = va_arg(ap, char *); - if (format != NULL) { + char *fmt = va_arg(ap, char *); + if (fmt != NULL) { #if HAVE_VSNPRINTF - (void)vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap); + (void)vsnprintf(tmpbuf, MAXPATHLEN - 1, fmt, ap); #else - (void)vsprintf(tnpbuf, format, ap); + (void)vsprintf(tnpbuf, fmt, ap); #endif // fprintf(stderr, "warning: "); Yap_Error__(file, function, lineno, type, where, tmpbuf); @@ -377,7 +377,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, Functor fun; Term error_t; Term comment; - char *format; + char *fmt; char s[MAXPATHLEN]; /* disallow recursive error handling */ @@ -389,7 +389,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, LOCAL_ActiveError->errorAsText = Yap_LookupAtom(Yap_errorName(type)); LOCAL_ActiveError->errorClass = Yap_errorClass(type); LOCAL_ActiveError->classAsText = - Yap_LookupAtom(Yap_errorClassName(LOCAL_ActiveError->errorClass)); + Yap_LookupAtom(Yap_errorClassName(LOCAL_ActiveError->errorClass)); LOCAL_ActiveError->errorLine = lineno; LOCAL_ActiveError->errorFunction = function; LOCAL_ActiveError->errorFile = file; @@ -399,17 +399,17 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, if (where == 0L) { where = TermNil; } -// first, obtain current location -// sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno, -// function); -// tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)); + // first, obtain current location + // sprintf(LOCAL_FileNameBuf, "%s:%d in C-function %s ", file, lineno, + // function); + // tf = MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)); #if DEBUG_STRICT if (Yap_heap_regs && !(LOCAL_PrologMode & BootMode)) fprintf(stderr, "***** Processing Error %d (%lx,%x) %s***\n", type, - (unsigned long int)LOCAL_Signals, LOCAL_PrologMode, format); + (unsigned long int)LOCAL_Signals, LOCAL_PrologMode, fmt); else fprintf(stderr, "***** Processing Error %d (%x) %s***\n", type, - LOCAL_PrologMode, format); + LOCAL_PrologMode, fmt); #endif if (type == INTERRUPT_EVENT) { fprintf(stderr, "%% YAP exiting: cannot handle signal %d\n", @@ -425,12 +425,12 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, Yap_exit(1); } va_start(ap, where); - format = va_arg(ap, char *); - if (format != NULL) { + fmt = va_arg(ap, char *); + if (fmt != NULL) { #if HAVE_VSNPRINTF - (void)vsnprintf(s, MAXPATHLEN - 1, format, ap); + (void)vsnprintf(s, MAXPATHLEN - 1, fmt, ap); #else - (void)vsprintf(s, format, ap); + (void)vsprintf(s, fmt, ap); #endif // fprintf(stderr, "warning: "); comment = MkAtomTerm(Yap_LookupAtom(s)); @@ -479,7 +479,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, error_exit_yap(1); } #ifdef DEBUG -// DumpActiveGoals( USES_REGS1 ); + // DumpActiveGoals( USES_REGS1 ); #endif /* DEBUG */ if (!IsVarTerm(where) && IsApplTerm(where) && FunctorOfTerm(where) == FunctorError) { @@ -569,7 +569,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, LOCAL_ErrorMessage = RepAtom(AtomOfTerm(nt[0]))->StrOfAE; } else { LOCAL_ErrorMessage = - (char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE; + (char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE; } nt[1] = TermNil; switch (type) { @@ -588,15 +588,15 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, ts[2] = MkAtomTerm(Yap_LookupAtom(function)); t3 = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("c"), 3), 3, ts); nt[1] = - MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")), t3), nt[1]); + MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")), t3), nt[1]); } if ((location = Yap_pc_location(P, B, ENV)) != TermNil) { nt[1] = MkPairTerm( - MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), location), nt[1]); + MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), location), nt[1]); } if ((location = Yap_env_location(CP, B, ENV, 0)) != TermNil) { nt[1] = MkPairTerm( - MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), location), nt[1]); + MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), location), nt[1]); } } } @@ -604,7 +604,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno, LOCAL_Signals = 0; CalculateStackGap(PASS_REGS1); #if DEBUG -// DumpActiveGoals( PASS_REGS1 ); + // DumpActiveGoals( PASS_REGS1 ); #endif /* wait if we we are in user code, it's up to her to decide */ diff --git a/C/text.c b/C/text.c index 894682e72..ced8236f5 100644 --- a/C/text.c +++ b/C/text.c @@ -268,7 +268,7 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { } } - st0 = st = malloc(length + 1); + st0 = st = Malloc(length + 1); t = t0; if (codes) { while (IsPairTerm(t)) { @@ -290,20 +290,20 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { st[0] = '\0'; return st0; - } +} - static unsigned char *latin2utf8(seq_tv_t *inp) { - unsigned char *b0 = inp->val.uc; - size_t sz = strlen(inp->val.c); - sz *= 2; - int ch; - unsigned char *buf = Malloc(sz + 1), *pt = buf; - if (!buf) - return NULL; - while ((ch = *b0++)) { - int off = put_utf8(pt, ch); - if (off < 0) { - continue; +static unsigned char *latin2utf8(seq_tv_t *inp) { + unsigned char *b0 = inp->val.uc; + size_t sz = strlen(inp->val.c); + sz *= 2; + int ch; + unsigned char *buf = Malloc(sz + 1), *pt = buf; + if (!buf) + return NULL; + while ((ch = *b0++)) { + int off = put_utf8(pt, ch); + if (off < 0) { + continue; } pt += off; } @@ -339,13 +339,13 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { seq_tv_t *inp USES_REGS) { bool codes; unsigned char *nbuf = codes2buf(t, buf, &codes PASS_REGS); - if (!codes) + if (codes) return NULL; return nbuf; } - static unsigned char *Yap_ListToBuffer(unsigned char *buf, Term t, - seq_tv_t *inp USES_REGS) { +static unsigned char *Yap_ListToBuffer(unsigned char *buf, Term t, + seq_tv_t *inp USES_REGS) { unsigned char *nbuf = codes2buf(t, buf, NULL PASS_REGS); return nbuf; } @@ -645,7 +645,7 @@ static void *codes2buf(Term t0, void *b0, bool *get_codes USES_REGS) { out->val.uc = BaseMalloc(leng + 1); strcpy(out->val.c, (char *)s0); } else if (out->val.uc != s0) { - out->val.c = Realloc(out->val.c, leng + 1); + out->val.c = BaseMalloc(leng + 1); strcpy(out->val.c, (char *)s0); } } else if (out->enc == ENC_ISO_LATIN1) { @@ -954,7 +954,7 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { bufv[j++] = nbuf; } if (j == 0) { - buf = malloc(8); + buf = Malloc(8); memset(buf, 0, 4); } else if (j == 1) { buf = bufv[0]; @@ -966,25 +966,25 @@ bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS) { return rc; } - // - bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, - seq_tv_t outv[] USES_REGS) { - const unsigned char *buf; - size_t b_l, u_l; +// +bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, + seq_tv_t outv[] USES_REGS) { + const unsigned char *buf; + size_t b_l, u_l; - inp->type |= YAP_STRING_IN_TMP; - buf = Yap_readText(inp PASS_REGS); - if (!buf) { - return false; - } - b_l = strlen((char *)buf); - if (b_l == 0) { - return false; - } - u_l = strlen_utf8(buf); - if (!cuts) { - if (n == 2) { - size_t b_l0, b_l1, u_l0, u_l1; + inp->type |= YAP_STRING_IN_TMP; + buf = Yap_readText(inp PASS_REGS); + if (!buf) { + return false; + } + b_l = strlen((char *)buf); + if (b_l == 0) { + return false; + } + u_l = strlen_utf8(buf); + if (!cuts) { + if (n == 2) { + size_t b_l0, b_l1, u_l0, u_l1; unsigned char *buf0, *buf1; if (outv[0].val.t) { diff --git a/C/utilpreds.c b/C/utilpreds.c index 121461c36..9d20666ef 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -800,12 +800,12 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len) ptr = (char *)AdjustSize((CELL*)ptr, buf); p0 = ptr; - *ptr++ = 0; - sz = strlen(RepAtom(at)->StrOfAE); - if (sz + 1 >= len) - return (Atom)NULL; - strcpy(ptr, RepAtom(at)->StrOfAE); - *hpp = ptr+(sz+1); + *ptr++ = 0; + sz = strlen(RepAtom(at)->StrOfAE); + if (sz + 1 >= len) + return (Atom)NULL; + strcpy(ptr, RepAtom(at)->StrOfAE); + *hpp = ptr+(sz+1); return (Atom)(p0-buf); } @@ -827,7 +827,7 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len) return (Functor)(((char *)hptr-buf)+1); } -#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ +#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ do { \ if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ (A) = (CELL *)(D); \ diff --git a/CMakeLists.txt b/CMakeLists.txt index 3f54796f6..299b99a8a 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -525,7 +525,7 @@ SET(CMAKE_SKIP_BUILD_RPATH FALSE) # when building, don't use the install RPATH already # (but later on when installing) -SET(CMAKE_BUILD_WITH_INSTALL_RPATH TRUE) +SET(CMAKE_BUILD_WITH_INSTALL_RPATH FALSE) SET(CMAKE_INSTALL_RPATH "${libdir}") diff --git a/H/YapTerm.h b/H/YapTerm.h index a7632a379..356064a21 100644 --- a/H/YapTerm.h +++ b/H/YapTerm.h @@ -114,3 +114,4 @@ typedef unsigned long int YAP_ULONG_LONG; #define Unsigned(V) ((CELL)(V)) #define Signed(V) ((Int)(V)) + diff --git a/H/YapText.h b/H/YapText.h index 5b0ea0a42..e566894a4 100644 --- a/H/YapText.h +++ b/H/YapText.h @@ -188,11 +188,7 @@ INLINE_ONLY inline EXTERN utf8proc_ssize_t get_utf8(const utf8proc_uint8_t *ptr, utf8proc_int32_t *valp) { utf8proc_ssize_t rc = utf8proc_iterate(ptr, n, valp); if (rc < 0) { - if (rc == UTF8PROC_ERROR_INVALIDUTF8) - Yap_Warning("get_utf8 found bad UTF-8 char %s, skipping...", ptr); - else - Yap_Warning("UTF-8 error %d, skipping...", *ptr); - rc = 1; + LOCAL_ActiveError->errorNo = REPRESENTATION_ERROR_IN_CHARACTER_CODE; } return rc; } @@ -203,13 +199,14 @@ INLINE_ONLY inline EXTERN utf8proc_ssize_t put_utf8(utf8proc_uint8_t *ptr, INLINE_ONLY inline EXTERN utf8proc_ssize_t put_utf8(utf8proc_uint8_t *ptr, utf8proc_int32_t val) { utf8proc_ssize_t rc = utf8proc_encode_char(val, ptr); - if (rc == 0) - Yap_Warning("UTF-8 error at %s", ptr); + if (rc < 0) { + LOCAL_ActiveError->errorNo = REPRESENTATION_ERROR_CHARACTER_CODE; + } return rc; } inline static const utf8proc_uint8_t *skip_utf8(const utf8proc_uint8_t *pt, - utf8proc_ssize_t n) { + utf8proc_ssize_t n) { utf8proc_ssize_t i; utf8proc_int32_t b; for (i = 0; i < n; i++) { @@ -217,14 +214,10 @@ inline static const utf8proc_uint8_t *skip_utf8(const utf8proc_uint8_t *pt, if (b == 0) return pt; if (l < 0) { - if (l == UTF8PROC_ERROR_INVALIDUTF8) - Yap_Warning("skip_utf8: found bad UTF-8 in char %s[%d], skipping...", - pt, i); - else - Yap_Warning("UTF-8 error %d at %s[%d], skipping...", l, pt, i); - l = 1; + LOCAL_ActiveError->errorNo = REPRESENTATION_ERROR_CHARACTER_CODE; + } else { + pt += l; } - pt += l; } return pt; } @@ -240,14 +233,11 @@ inline static utf8proc_ssize_t strlen_utf8(const utf8proc_uint8_t *pt) { utf8proc_ssize_t l = utf8proc_iterate(pt, -1, &b); if (b == 0) return rc; - else if (b > 0) { + else if (l > 0) { pt += l; rc++; } else { - if (l == UTF8PROC_ERROR_INVALIDUTF8) - Yap_Warning("found bad UTF-8 char %d, skipping %s...", *pt, pt); - else - Yap_Warning("UTF-8 error %d, skipping...", l); + LOCAL_ActiveError->errorNo = REPRESENTATION_ERROR_CHARACTER_CODE; pt++; } } @@ -259,6 +249,9 @@ inline static utf8proc_ssize_t strlen_latin_utf8(const unsigned char *pt) { utf8proc_uint8_t b; while (true) { utf8proc_ssize_t l = utf8proc_encode_char(*pt, &b); + if (l<0) { + pt++; + } if (b == 0) return rc; pt++; @@ -268,7 +261,7 @@ inline static utf8proc_ssize_t strlen_latin_utf8(const unsigned char *pt) { } inline static utf8proc_ssize_t strnlen_latin_utf8(const unsigned char *pt, - size_t max) { + size_t max) { utf8proc_ssize_t rc = 0; utf8proc_uint8_t b; while (true) { @@ -276,7 +269,8 @@ inline static utf8proc_ssize_t strnlen_latin_utf8(const unsigned char *pt, if (b == 0) return rc; pt++; - rc += l; + if (l > 0) + rc += l; if (--max == 0) return rc; } @@ -290,6 +284,8 @@ inline static utf8proc_ssize_t strlen_ucs2_utf8(const wchar_t *pt) { utf8proc_ssize_t l = utf8proc_encode_char(*pt, &b); if (b == 0) return rc; + if (l < 0) + continue; pt++; rc += l; } @@ -297,7 +293,7 @@ inline static utf8proc_ssize_t strlen_ucs2_utf8(const wchar_t *pt) { } inline static utf8proc_ssize_t strnlen_ucs2_utf8(const wchar_t *pt, - size_t max) { + size_t max) { utf8proc_ssize_t rc = 0; utf8proc_uint8_t b; while (true) { @@ -313,7 +309,7 @@ inline static utf8proc_ssize_t strnlen_ucs2_utf8(const wchar_t *pt, } inline static int cmpn_utf8(const utf8proc_uint8_t *pt1, - const utf8proc_uint8_t *pt2, utf8proc_ssize_t n) { + const utf8proc_uint8_t *pt2, utf8proc_ssize_t n) { utf8proc_ssize_t i; utf8proc_int32_t b; for (i = 0; i < n; i++) { @@ -322,13 +318,13 @@ inline static int cmpn_utf8(const utf8proc_uint8_t *pt1, utf8proc_ssize_t l = utf8proc_iterate(pt1, -1, &b); if (l == 2) { if (pt1[1] != pt2[1]) - return pt1[1] - pt2[1]; + return pt1[1] - pt2[1]; } else if (l == 3) { if (pt1[2] != pt2[2]) - return pt1[2] - pt2[2]; + return pt1[2] - pt2[2]; } else if (l == 4) { if (pt1[3] != pt2[3]) - return pt1[3] - pt2[3]; + return pt1[3] - pt2[3]; } pt1 += l; pt2 += l; @@ -339,7 +335,7 @@ inline static int cmpn_utf8(const utf8proc_uint8_t *pt1, // UTF16 #define LEAD_OFFSET ((uint32_t)0xD800 - (uint32_t)(0x10000 >> 10)) -#define SURROGATE_OFFSET \ +#define SURROGATE_OFFSET \ ((uint32_t)0x10000 - (uint32_t)(0xD800 << 10) - (uint32_t)0xDC00) extern const char *Yap_tokText(void *tokptr); @@ -359,9 +355,9 @@ typedef enum { YAP_STRING_FLOAT = 0x80, /// target is a floar term YAP_STRING_BIG = 0x100, /// target is an big num term YAP_STRING_DATUM = - 0x200, /// associated with previous 3, use actual object if type, not tern + 0x200, /// associated with previous 3, use actual object if type, not tern YAP_STRING_LENGTH = - 0x400, /// input: length is fixed; output: return integer with length + 0x400, /// input: length is fixed; output: return integer with length YAP_STRING_NTH = 0x800, /// input: ignored; output: nth char YAP_STRING_TERM = 0x1000, // Generic term, if nothing else given YAP_STRING_DIFF = 0x2000, // difference list @@ -490,7 +486,7 @@ extern bool write_Text(unsigned char *inp, seq_tv_t *out USES_REGS); extern bool Yap_CVT_Text(seq_tv_t *inp, seq_tv_t *out USES_REGS); extern bool Yap_Concat_Text(int n, seq_tv_t inp[], seq_tv_t *out USES_REGS); extern bool Yap_Splice_Text(int n, size_t cuts[], seq_tv_t *inp, - seq_tv_t outv[] USES_REGS); + seq_tv_t outv[] USES_REGS); // user friendly interface @@ -498,8 +494,8 @@ static inline Atom Yap_AtomicToLowAtom(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOM | YAP_STRING_DOWNCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -510,8 +506,8 @@ static inline Atom Yap_AtomicToUpAtom(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOM | YAP_STRING_UPCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -522,8 +518,8 @@ static inline Term Yap_AtomicToLowString(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_STRING | YAP_STRING_DOWNCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -534,8 +530,8 @@ static inline Term Yap_AtomicToUpString(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_STRING | YAP_STRING_UPCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -546,8 +542,8 @@ static inline Term Yap_AtomicToLowListOfCodes(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_CODES | YAP_STRING_DOWNCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -558,8 +554,8 @@ static inline Term Yap_AtomicToUpListOfCodes(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_CODES | YAP_STRING_UPCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -570,8 +566,8 @@ static inline Term Yap_AtomicToLowListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOMS | YAP_STRING_DOWNCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -582,8 +578,8 @@ static inline Term Yap_AtomicToUpListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOMS | YAP_STRING_UPCASE; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -594,8 +590,8 @@ static inline size_t Yap_AtomicToUnicodeLength(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_CODES | YAP_STRING_ATOMS | - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | + YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_CHARS | YAP_STRING_OUTPUT_TERM; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -606,7 +602,7 @@ static inline Term Yap_AtomicToListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOMS; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -617,7 +613,7 @@ static inline Term Yap_AtomicToListOfCodes(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.type = YAP_STRING_CODES; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -629,7 +625,7 @@ static inline Atom Yap_AtomicToAtom(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.type = YAP_STRING_ATOM; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -667,8 +663,8 @@ static inline Term Yap_AtomSWIToListOfAtoms(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | - YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | + YAP_STRING_TERM; out.val.uc = NULL; out.type = YAP_STRING_ATOMS; @@ -718,7 +714,7 @@ static inline Term Yap_AtomSWIToString(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES; out.val.uc = NULL; out.type = YAP_STRING_STRING; out.enc = ENC_ISO_UTF8; @@ -733,7 +729,7 @@ static inline Term Yap_AtomicToString(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.type = YAP_STRING_STRING; @@ -747,7 +743,7 @@ static inline Term Yap_AtomicToTDQ(Term t0, Term mod USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.type = mod_to_type(mod PASS_REGS); out.enc = ENC_ISO_UTF8; @@ -773,7 +769,7 @@ static inline Term Yap_AtomicToTBQ(Term t0, Term mod USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.type = mod_to_bqtype(mod PASS_REGS); @@ -797,7 +793,7 @@ static inline Atom Yap_CharsToAtom(const char *s, encoding_t enc USES_REGS) { } static inline Term Yap_CharsToListOfAtoms(const char *s, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -811,7 +807,7 @@ static inline Term Yap_CharsToListOfAtoms(const char *s, } static inline Term Yap_CharsToListOfCodes(const char *s, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -849,7 +845,7 @@ static inline Atom Yap_UTF8ToAtom(const unsigned char *s USES_REGS) { } static inline Term Yap_CharsToDiffListOfCodes(const char *s, Term tail, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -864,7 +860,7 @@ static inline Term Yap_CharsToDiffListOfCodes(const char *s, Term tail, } static inline Term Yap_UTF8ToDiffListOfCodes(const char *s, - Term tail USES_REGS) { + Term tail USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -879,7 +875,7 @@ static inline Term Yap_UTF8ToDiffListOfCodes(const char *s, } static inline Term Yap_WCharsToDiffListOfCodes(const wchar_t *s, - Term tail USES_REGS) { + Term tail USES_REGS) { seq_tv_t inp, out; inp.val.w0 = s; @@ -911,7 +907,7 @@ static inline char *Yap_AtomToUTF8Text(Atom at USES_REGS) { } static inline Term Yap_CharsToTDQ(const char *s, Term mod, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -926,7 +922,7 @@ static inline Term Yap_CharsToTDQ(const char *s, Term mod, } static inline Term Yap_CharsToTBQ(const char *s, Term mod, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -947,7 +943,6 @@ static inline Atom Yap_ListOfAtomsToAtom(Term t0 USES_REGS) { out.type = YAP_STRING_ATOM; out.val.uc = NULL; out.enc = ENC_ISO_UTF8; - out.enc = ENC_ISO_UTF8; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return (Atom)NULL; return out.val.a; @@ -958,7 +953,7 @@ static inline Term Yap_ListOfAtomsToNumber(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOMS; out.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.enc = ENC_ISO_UTF8; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1033,7 +1028,7 @@ static inline Term Yap_ListToAtomic(Term t0 USES_REGS) { out.val.uc = NULL; out.enc = ENC_ISO_UTF8; out.type = YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | - YAP_STRING_BIG | YAP_STRING_OUTPUT_TERM; + YAP_STRING_BIG | YAP_STRING_OUTPUT_TERM; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; return out.val.t; @@ -1072,8 +1067,8 @@ static inline Term Yap_ListSWIToString(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_ATOMS_CODES | - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | - YAP_STRING_OUTPUT_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | + YAP_STRING_OUTPUT_TERM; out.val.uc = NULL; out.type = YAP_STRING_STRING; out.enc = ENC_ISO_UTF8; @@ -1112,7 +1107,7 @@ static inline Term YapListToTBQ(Term t0, Term mod USES_REGS) { } static inline Atom Yap_NCharsToAtom(const char *s, size_t len, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -1128,7 +1123,7 @@ static inline Atom Yap_NCharsToAtom(const char *s, size_t len, } static inline Term Yap_CharsToDiffListOfAtoms(const char *s, encoding_t enc, - Term tail USES_REGS) { + Term tail USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -1142,7 +1137,7 @@ static inline Term Yap_CharsToDiffListOfAtoms(const char *s, encoding_t enc, } static inline Term Yap_NCharsToListOfCodes(const char *s, size_t len, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -1156,7 +1151,7 @@ static inline Term Yap_NCharsToListOfCodes(const char *s, size_t len, } static inline Term Yap_NCharsToString(const char *s, size_t len, - encoding_t enc USES_REGS) { + encoding_t enc USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -1170,7 +1165,7 @@ static inline Term Yap_NCharsToString(const char *s, size_t len, } static inline Term Yap_NCharsToTDQ(const char *s, size_t len, encoding_t enc, - Term mod USES_REGS) { + Term mod USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -1185,7 +1180,7 @@ static inline Term Yap_NCharsToTDQ(const char *s, size_t len, encoding_t enc, } static inline Term Yap_NCharsToTBQ(const char *s, size_t len, encoding_t enc, - Term mod USES_REGS) { + Term mod USES_REGS) { seq_tv_t inp, out; inp.val.c0 = s; @@ -1203,7 +1198,7 @@ static inline Atom Yap_NumberToAtom(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOM; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -1214,7 +1209,7 @@ static inline Term Yap_NumberToListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOMS; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -1225,7 +1220,7 @@ static inline Term Yap_NumberToListOfCodes(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_CODES; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -1236,7 +1231,7 @@ static inline Term Yap_NumberToString(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_STRING; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -1256,7 +1251,7 @@ static inline Atom Yap_NWCharsToAtom(const wchar_t *s, size_t len USES_REGS) { } static inline Term Yap_NWCharsToListOfAtoms(const wchar_t *s, - size_t len USES_REGS) { + size_t len USES_REGS) { seq_tv_t inp, out; inp.val.w0 = s; @@ -1269,7 +1264,7 @@ static inline Term Yap_NWCharsToListOfAtoms(const wchar_t *s, } static inline Term Yap_NWCharsToListOfCodes(const wchar_t *s, - size_t len USES_REGS) { + size_t len USES_REGS) { seq_tv_t inp, out; inp.val.w0 = s; @@ -1310,8 +1305,8 @@ static inline Atom Yap_StringSWIToAtom(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | - YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | + YAP_STRING_TERM; out.type = YAP_STRING_ATOM; out.val.uc = NULL; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1324,7 +1319,7 @@ static inline size_t Yap_StringToAtomic(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_STRING; out.type = - YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG; + YAP_STRING_ATOM | YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG; out.val.uc = NULL; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) return 0L; @@ -1353,8 +1348,8 @@ static inline size_t Yap_StringSWIToListOfAtoms(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | - YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | + YAP_STRING_TERM; out.type = YAP_STRING_ATOMS; out.val.uc = NULL; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1377,8 +1372,8 @@ static inline size_t Yap_StringSWIToListOfCodes(Term t0 USES_REGS) { seq_tv_t inp, out; inp.val.t = t0; inp.type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | - YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_ATOMS_CODES | + YAP_STRING_TERM; out.type = YAP_STRING_CODES; out.val.uc = NULL; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1391,7 +1386,7 @@ static inline Term Yap_StringToNumber(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_STRING; out.type = - YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_INT | YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.val.uc = NULL; out.enc = ENC_ISO_UTF8; if (!Yap_CVT_Text(&inp, &out PASS_REGS)) @@ -1404,7 +1399,7 @@ static inline Atom Yap_TextToAtom(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_CODES | - YAP_STRING_ATOMS_CODES; + YAP_STRING_ATOMS_CODES; out.val.uc = NULL; out.type = YAP_STRING_ATOM; @@ -1418,7 +1413,7 @@ static inline Term Yap_TextToString(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_CODES | - YAP_STRING_ATOMS_CODES; + YAP_STRING_ATOMS_CODES; out.val.uc = NULL; out.type = YAP_STRING_STRING; @@ -1443,7 +1438,7 @@ static inline const unsigned char *Yap_TextToUTF8Buffer(Term t0 USES_REGS) { inp.val.t = t0; inp.type = YAP_STRING_ATOM | YAP_STRING_STRING | YAP_STRING_CODES | - YAP_STRING_ATOMS_CODES | YAP_STRING_MALLOC; + YAP_STRING_ATOMS_CODES | YAP_STRING_MALLOC; out.val.uc = NULL; out.type = YAP_STRING_CHARS; out.enc = ENC_ISO_UTF8; @@ -1535,10 +1530,10 @@ static inline Atom Yap_ConcatAtomics(Term t1, Term t2 USES_REGS) { seq_tv_t inpv[2], out; inpv[0].val.t = t1; inpv[0].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; inpv[1].val.t = t2; inpv[1].type = YAP_STRING_STRING | YAP_STRING_ATOM | YAP_STRING_INT | - YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; + YAP_STRING_FLOAT | YAP_STRING_BIG | YAP_STRING_TERM; out.type = YAP_STRING_ATOM; out.val.uc = NULL; if (!Yap_Concat_Text(2, inpv, &out PASS_REGS)) @@ -1560,7 +1555,7 @@ static inline Term Yap_ConcatStrings(Term t1, Term t2 USES_REGS) { } static inline Atom Yap_SpliceAtom(Term t1, Atom ats[], size_t cut, - size_t max USES_REGS) { + size_t max USES_REGS) { seq_tv_t outv[2], inp; size_t cuts[2]; cuts[0] = cut; @@ -1603,7 +1598,7 @@ static inline Atom Yap_SubtractTailAtom(Term t1, Term th USES_REGS) { } static inline Term Yap_SpliceString(Term t1, Term ts[], size_t cut, - size_t max USES_REGS) { + size_t max USES_REGS) { seq_tv_t outv[2], inp; size_t cuts[2]; inp.type = YAP_STRING_STRING; diff --git a/cmake/cudd.cmake b/cmake/cudd.cmake index 952d3ee98..314ba353a 100644 --- a/cmake/cudd.cmake +++ b/cmake/cudd.cmake @@ -20,8 +20,6 @@ check_include_files( "stdio.h;cudd/cudd.h" HAVE_CUDD_CUDD_H ) check_include_files( "stdio.h;cudd/cuddInt.h" HAVE_CUDD_CUDDINT_H ) configure_file (cmake/cudd_config.h.cmake "${CMAKE_CURRENT_BINARY_DIR}/cudd_config.h" ) - configure_file (cmake/cudd_config.h.cmake - "${CMAKE_BINARY_DIR}/packages/cplint/config,config.h" ) endif (CUDD_FOUND) diff --git a/info/meta.yaml b/info/meta.yaml index 152a6f5d3..8e24404b1 100644 --- a/info/meta.yaml +++ b/info/meta.yaml @@ -5,7 +5,6 @@ package: requirements: build: - cmake - - clang - swig - readline - gmp @@ -24,4 +23,4 @@ about: summary: Prolog System source: - path: .. \ No newline at end of file + path: .. diff --git a/os/charsio.c b/os/charsio.c index 40d4a8faa..e7359ccc1 100644 --- a/os/charsio.c +++ b/os/charsio.c @@ -97,7 +97,7 @@ Int Yap_peek(int sno) { CACHE_REGS Int ocharcount, olinecount, olinepos; StreamDesc *s; - uint32_t ch; + int32_t ch; s = GLOBAL_Stream + sno; #if USE_READLINE @@ -1039,11 +1039,11 @@ code with _C_, while leaving the current stream position unaltered. */ static Int peek_byte(USES_REGS1) { /* at_end_of_stream */ /* the next character is a EOF */ - int sno = Yap_CheckStream(ARG1, Input_Stream_f, "peek_byte/2"); + int sno = Yap_CheckBinaryStream(ARG1, Input_Stream_f, "peek_byte/2"); Int ch; if (sno < 0) - return (FALSE); + return false; if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) { UNLOCK(GLOBAL_Stream[sno].streamlock); Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_byte/2"); @@ -1099,24 +1099,22 @@ atom with _C_, while leaving the stream position unaltered. static Int peek_char(USES_REGS1) { /* the next character is a EOF */ int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2"); - unsigned char sinp[10]; + unsigned char sinp[16]; Int ch; - if (sno < 0) - return false; - if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); - return (FALSE); - } - if ((ch = Yap_peek(sno)) < 0) { - UNLOCK(GLOBAL_Stream[sno].streamlock); - return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); - } - UNLOCK(GLOBAL_Stream[sno].streamlock); - int off = put_utf8(sinp, ch); - sinp[off] = '\0'; - return Yap_unify_constant(ARG2, MkAtomTerm(Yap_ULookupAtom(sinp))); +if (sno < 0) + return false; + if ((ch = Yap_peek(sno)) < 0) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof)); + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + int off = put_utf8(sinp, ch); + if (off < 0) { + return false; + } + sinp[off] = '\0'; + return Yap_unify_constant(ARG2, MkAtomTerm(Yap_ULookupAtom(sinp))); } /** @pred peek_char( - _C_) is iso