diff --git a/C/utilpreds.c b/C/utilpreds.c index 185b09881..d65cdca05 100644 --- a/C/utilpreds.c +++ b/C/utilpreds.c @@ -1,57 +1,54 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: utilpreds.c * -* Last rev: 4/03/88 * -* mods: * -* comments: new utility predicates for YAP * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * + ************************************************************************** + * * + * File: utilpreds.c * Last rev: 4/03/88 + ** mods: * comments: new utility predicates for YAP * + * * + *************************************************************************/ #ifdef SCCS -static char SccsId[] = "@(#)utilpreds.c 1.3"; +static char SccsId[] = "@(#)utilpreds.c 1.3"; #endif /** * @addtogroup Terms */ - #include "absmi.h" + #include "YapHeap.h" -#include "yapio.h" #include "attvar.h" +#include "yapio.h" #ifdef HAVE_STRING_H #include "string.h" #endif typedef struct { - Term old_var; - Term new_var; -} *vcell; + Term old_var; + Term new_var; +} * vcell; - -static int copy_complex_term(CELL *, CELL *, int, int, CELL *, CELL * CACHE_TYPE); -static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); -static Int p_non_singletons_in_term( USES_REGS1); -static CELL non_singletons_in_complex_term(CELL *, CELL * CACHE_TYPE); -static Int p_variables_in_term( USES_REGS1 ); -static Int ground_complex_term(CELL *, CELL * CACHE_TYPE); -static Int p_ground( USES_REGS1 ); -static Int p_copy_term( USES_REGS1 ); -static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); +static int copy_complex_term(CELL *, CELL *, int, int, CELL *, + CELL *CACHE_TYPE); +static CELL vars_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); +static Int p_non_singletons_in_term(USES_REGS1); +static CELL non_singletons_in_complex_term(CELL *, CELL *CACHE_TYPE); +static Int p_variables_in_term(USES_REGS1); +static Int ground_complex_term(CELL *, CELL *CACHE_TYPE); +static Int p_ground(USES_REGS1); +static Int p_copy_term(USES_REGS1); +static Int var_in_complex_term(CELL *, CELL *, Term CACHE_TYPE); #ifdef DEBUG -static Int p_force_trail_expansion( USES_REGS1 ); +static Int p_force_trail_expansion(USES_REGS1); #endif /* DEBUG */ -static inline void -clean_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_tr(tr_fr_ptr TR0 USES_REGS) { if (TR != TR0) { do { Term p = TrailTerm(--TR); @@ -60,8 +57,7 @@ clean_tr(tr_fr_ptr TR0 USES_REGS) { } } -static inline void -clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { +static inline void clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { if (TR != TR0) { tr_fr_ptr pt = TR0; @@ -73,217 +69,218 @@ clean_dirty_tr(tr_fr_ptr TR0 USES_REGS) { } } -static int -copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, CELL *HLow USES_REGS) -{ +static int copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, + CELL *ptf, CELL *HLow USES_REGS) { - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace() ; + struct cp_frame *to_visit0, + *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); CELL *HB0 = HB; tr_fr_ptr TR0 = TR; int ground = TRUE; HB = HR; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, copy_term_unk); - copy_term_nvar: - { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(HR); - ptf++; -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - ground = TRUE; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { -#if MULTIPLE_STACKS - if (f == FunctorDBRef) { - DBRef entryref = DBRefOfTerm(d0); - if (entryref->Flags & LogUpdMask) { - LogUpdClause *luclause = (LogUpdClause *)entryref; - PELOCK(100,luclause->ClPred); - UNLOCK(luclause->ClPred->PELock); - } else { - LOCK(entryref->lock); - TRAIL_REF(entryref); /* So that fail will erase it */ - INC_DBREF_COUNT(entryref); - UNLOCK(entryref->lock); - } - *ptf++ = d0; /* you can just copy other extensions. */ - } else -#endif - if (!share) { - UInt sz; - - *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ - /* make sure to copy floats */ - if (f== FunctorDouble) { - sz = sizeof(Float)/sizeof(CELL)+2; - } else if (f== FunctorLongInt) { - sz = 3; - } else if (f== FunctorString) { - sz = 3+ap2[1]; - } else { - CELL *pt = ap2+1; - sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); - } - if (HR+sz > ASP - 2048) { - goto overflow; - } - memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); - HR += sz; - } else { - *ptf++ = d0; /* you can just copy other extensions. */ - } - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { - goto overflow; - } - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + copy_term_nvar : { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (ap2 >= HB && ap2 < HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; } - continue; + *ptf = AbsPair(HR); + ptf++; +#ifdef RATIONAL_TREES + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = TRUE; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 >= HB && ap2 <= HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { +#if MULTIPLE_STACKS + if (f == FunctorDBRef) { + DBRef entryref = DBRefOfTerm(d0); + if (entryref->Flags & LogUpdMask) { + LogUpdClause *luclause = (LogUpdClause *)entryref; + PELOCK(100, luclause->ClPred); + UNLOCK(luclause->ClPred->PELock); + } else { + LOCK(entryref->lock); + TRAIL_REF(entryref); /* So that fail will erase it */ + INC_DBREF_COUNT(entryref); + UNLOCK(entryref->lock); + } + *ptf++ = d0; /* you can just copy other extensions. */ + } else +#endif + if (!share) { + UInt sz; + + *ptf++ = AbsAppl(HR); /* you can just copy other extensions. */ + /* make sure to copy floats */ + if (f == FunctorDouble) { + sz = sizeof(Float) / sizeof(CELL) + 2; + } else if (f == FunctorLongInt) { + sz = 3; + } else if (f == FunctorString) { + sz = 3 + ap2[1]; + } else { + CELL *pt = ap2 + 1; + sz = 2 + sizeof(MP_INT) + + (((MP_INT *)(pt + 1))->_mp_alloc * sizeof(mp_limb_t)); + } + if (HR + sz > ASP - 2048) { + goto overflow; + } + memmove((void *)HR, (void *)ap2, sz * sizeof(CELL)); + HR += sz; + } else { + *ptf++ = d0; /* you can just copy other extensions. */ + } + continue; + } + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ +#ifdef RATIONAL_TREES + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR + 1; + HR += 1 + d0; + if (HR > ASP - 2048) { + goto overflow; + } + } else { + /* just copy atoms or integers */ + *ptf++ = d0; } + continue; + } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); ground = FALSE; if (ptd0 >= HLow && ptd0 < HR) { /* we have already found this cell */ - *ptf++ = (CELL) ptd0; + *ptf++ = (CELL)ptd0; } else #if COROUTINING - if (newattvs && IsAttachedTerm((CELL)ptd0)) { - /* if unbound, call the standard copy term routine */ - struct cp_frame *bp; + if (newattvs && IsAttachedTerm((CELL)ptd0)) { + /* if unbound, call the standard copy term routine */ + struct cp_frame *bp; - CELL new; + CELL new; - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - Bind_NonAtt(ptd0, new); - ptf++; - } else { + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + Bind_NonAtt(ptd0, new); + ptf++; + } else { #endif - /* first time we met this term */ - RESET_VARIABLE(ptf); - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_NonAtt(ptd0, (CELL)ptf); - ptf++; + /* first time we met this term */ + RESET_VARIABLE(ptf); + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + Bind_NonAtt(ptd0, (CELL)ptf); + ptf++; #ifdef COROUTINING } #endif } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; + to_visit--; if (ground && share) { CELL old = to_visit->oldv; - CELL *newp = to_visit->to-1; + CELL *newp = to_visit->to - 1; CELL new = *newp; *newp = old; if (IsApplTerm(new)) - HR = RepAppl(new); + HR = RepAppl(new); else - HR = RepPair(new); + HR = RepPair(new); } pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; @@ -300,7 +297,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, HB = HB0; return ground; - overflow: +overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -308,7 +305,7 @@ copy_complex_term(CELL *pt0, CELL *pt0_end, int share, int newattvs, CELL *ptf, HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -327,7 +324,7 @@ trail_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -335,15 +332,15 @@ trail_overflow: } #endif { - tr_fr_ptr oTR = TR; + tr_fr_ptr oTR = TR; reset_trail(TR0); - if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + if (!Yap_growtrail((oTR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { return -4; } return -2; } - heap_overflow: +heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -351,7 +348,7 @@ trail_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -359,50 +356,45 @@ trail_overflow: } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; return -3; - } +} - -static Term -handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) -{ +static Term handle_cp_overflow(int res, tr_fr_ptr TR0, UInt arity, Term t) { CACHE_REGS - XREGS[arity+1] = t; - switch(res) { + XREGS[arity + 1] = t; + switch (res) { case -1: - if (!Yap_gcl((ASP-HR)*sizeof(CELL), arity+1, ENV, gc_P(P,CP))) { + if (!Yap_gcl((ASP - HR) * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return 0L; } - return Deref(XREGS[arity+1]); + return Deref(XREGS[arity + 1]); case -2: - return Deref(XREGS[arity+1]); - case -3: - { - UInt size = LOCAL_Error_Size; - LOCAL_Error_Size = 0L; - if (size > 4*1024*1024) - size = 4*1024*1024; - if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage); - return 0L; - } + return Deref(XREGS[arity + 1]); + case -3: { + UInt size = LOCAL_Error_Size; + LOCAL_Error_Size = 0L; + if (size > 4 * 1024 * 1024) + size = 4 * 1024 * 1024; + if (!Yap_ExpandPreAllocCodeSpace(size, NULL, TRUE)) { + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, TermNil, LOCAL_ErrorMessage); + return 0L; } - return Deref(XREGS[arity+1]); + } + return Deref(XREGS[arity + 1]); case -4: - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), FALSE)) { + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), FALSE)) { Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, LOCAL_ErrorMessage); return 0L; } - return Deref(XREGS[arity+1]); + return Deref(XREGS[arity + 1]); default: return 0L; } } -static Term -CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { +static Term CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -414,13 +406,14 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { restart_attached: *HR = t; - Hi = HR+1; + Hi = HR + 1; HR += 2; - if ((res = copy_complex_term(Hi-2, Hi-1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { - HR = Hi-1; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_attached; + if ((res = copy_complex_term(Hi - 2, Hi - 1, share, newattvs, Hi, + Hi PASS_REGS)) < 0) { + HR = Hi - 1; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_attached; } return Hi[0]; } @@ -440,14 +433,15 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { HR += 2; { int res; - if ((res = copy_complex_term(ap-1, ap+1, share, newattvs, Hi, Hi PASS_REGS)) < 0) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_list; + if ((res = copy_complex_term(ap - 1, ap + 1, share, newattvs, Hi, + Hi PASS_REGS)) < 0) { + HR = Hi; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_list; } else if (res && share) { - HR = Hi; - return t; + HR = Hi; + return t; } } return tf; @@ -463,74 +457,69 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) { ap = RepAppl(t); tf = AbsAppl(HR); HR[0] = (CELL)f; - HR += 1+ArityOfFunctor(f); - if (HR > ASP-128) { + HR += 1 + ArityOfFunctor(f); + if (HR > ASP - 128) { HR = HB0; - if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) - return FALSE; + if ((t = handle_cp_overflow(-1, TR0, arity, t)) == 0L) + return FALSE; goto restart_appl; } else { int res; - if ((res = copy_complex_term(ap, ap+ArityOfFunctor(f), share, newattvs, HB0+1, HB0 PASS_REGS)) < 0) { - HR = HB0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; + if ((res = copy_complex_term(ap, ap + ArityOfFunctor(f), share, newattvs, + HB0 + 1, HB0 PASS_REGS)) < 0) { + HR = HB0; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_appl; } else if (res && share && FunctorOfTerm(t) != FunctorMutable) { - HR = HB0; - return t; + HR = HB0; + return t; } } return tf; } } -Term -Yap_CopyTerm(Term inp) { +Term Yap_CopyTerm(Term inp) { CACHE_REGS return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS); } -Term -Yap_CopyTermNoShare(Term inp) { +Term Yap_CopyTermNoShare(Term inp) { CACHE_REGS return CopyTerm(inp, 0, FALSE, FALSE PASS_REGS); } -static Int -p_copy_term( USES_REGS1 ) /* copy term t to a new instance */ +static Int p_copy_term(USES_REGS1) /* copy term t to a new instance */ { Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ - return Yap_unify(ARG2,t); + return Yap_unify(ARG2, t); } -static Int -p_duplicate_term( USES_REGS1 ) /* copy term t to a new instance */ +static Int p_duplicate_term(USES_REGS1) /* copy term t to a new instance */ { Term t = CopyTerm(ARG1, 2, FALSE, TRUE PASS_REGS); if (t == 0L) return FALSE; /* be careful, there may be a stack shift here */ - return Yap_unify(ARG2,t); + return Yap_unify(ARG2, t); } static Int -p_copy_term_no_delays( USES_REGS1 ) /* copy term t to a new instance */ +p_copy_term_no_delays(USES_REGS1) /* copy term t to a new instance */ { Term t = CopyTerm(ARG1, 2, TRUE, FALSE PASS_REGS); if (t == 0L) { return FALSE; } /* be careful, there may be a stack shift here */ - return(Yap_unify(ARG2,t)); + return (Yap_unify(ARG2, t)); } - - typedef struct bp_frame { CELL *start_cp; CELL *end_cp; @@ -539,149 +528,144 @@ typedef struct bp_frame { CELL oldv; } bp_frame_t; - - typedef struct copy_frame { CELL *start_cp; CELL *end_cp; CELL *to; } copy_frame_t; -static Term -add_to_list( Term inp, Term v, Term t PASS_REGS) -{ +static Term add_to_list(Term inp, Term v, Term t PASS_REGS) { Term ta[2]; ta[0] = v; ta[1] = t; - return MkPairTerm(Yap_MkApplTerm( FunctorEq, 2, ta ), inp); + return MkPairTerm(Yap_MkApplTerm(FunctorEq, 2, ta), inp); } - -static int -break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Term vin,CELL *HLow USES_REGS) -{ +static int break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, + Term *vout, Term vin, + CELL *HLow USES_REGS) { - struct bp_frame *to_visit0, *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace() ; + struct bp_frame *to_visit0, + *to_visit = (struct bp_frame *)Yap_PreAllocCodeSpace(); CELL *HB0 = HB; tr_fr_ptr TR0 = TR; HB = HR; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, copy_term_unk); - copy_term_nvar: - { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - fprintf(stderr, "%ld \n", RepPair(ap2[0])- ptf); - if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]),HR)) { - Term v = MkVarTerm(); - *ptf = v; - vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf) ); - ptf++; - continue; - } - if (to_visit+1 >= (struct bp_frame *)AuxSp) { - goto heap_overflow; - } - *ptf++ = (CELL)(HR); - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; - /* fool the system into thinking we had a variable there */ - to_visit ++; - pt0 = ap2; - pt0_end = ap2 + 1; - ptf = HR; - *ap2 = AbsPair(HR); - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - if (IsVarTerm(d0) && d0 == (CELL)ap2) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } - d0 = Deref(d0); - if (!IsVarTerm(d0)) { - goto copy_term_nvar; - } else { - *ptf++ = d0; - } - continue; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0)+1; - f = (Functor)(ap2[-1]); - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just copy other extensions. */ - continue; - } - if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]),HR)) { - RESET_VARIABLE(ptf); - vin = add_to_list(vin, (CELL)ptf, ap2[0] ); - ptf++; - continue; - } - - arity_t arity = ArityOfFunctor(f); - if (to_visit+1 >= (struct bp_frame *)AuxSp) { - goto heap_overflow; - } - *ptf++ = AbsAppl(HR); - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldp = ap2; - d0 = to_visit->oldv = ap2[0]; - /* fool the system into thinking we had a variable there */ - to_visit ++; - pt0 = ap2; - pt0_end = ap2 + (arity-1); - ptf = HR; - if (HR > ASP - 2048) { - goto overflow; - } - *ptf++ =(CELL)f; - *ap2 = AbsAppl(HR); - HR += (arity+1); - if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { - RESET_VARIABLE(ptf); - ptf++; - continue; - } - d0 = Deref(d0); - if (!IsVarTerm(d0)) { - goto copy_term_nvar; - } else { - *ptf++ = d0; - } - continue; + copy_term_nvar : { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + fprintf(stderr, "%ld \n", RepPair(ap2[0]) - ptf); + if (IsVarTerm(ap2[0]) && IN_BETWEEN(HB, (ap2[0]), HR)) { + Term v = MkVarTerm(); + *ptf = v; + vin = add_to_list(vin, (CELL)(ptf), AbsPair(ptf)); + ptf++; + continue; + } + if (to_visit + 1 >= (struct bp_frame *)AuxSp) { + goto heap_overflow; + } + *ptf++ = (CELL)(HR); + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; + /* fool the system into thinking we had a variable there */ + to_visit++; + pt0 = ap2; + pt0_end = ap2 + 1; + ptf = HR; + *ap2 = AbsPair(HR); + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + if (IsVarTerm(d0) && d0 == (CELL)ap2) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } + d0 = Deref(d0); + if (!IsVarTerm(d0)) { + goto copy_term_nvar; } else { - /* just copy atoms or integers */ - *ptf++ = d0; + *ptf++ = d0; } continue; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0) + 1; + f = (Functor)(ap2[-1]); + if (IsExtensionFunctor(f)) { + *ptf++ = d0; /* you can just copy other extensions. */ + continue; + } + if (IsApplTerm(ap2[0]) && IN_BETWEEN(HB, RepAppl(ap2[0]), HR)) { + RESET_VARIABLE(ptf); + vin = add_to_list(vin, (CELL)ptf, ap2[0]); + ptf++; + continue; + } + + arity_t arity = ArityOfFunctor(f); + if (to_visit + 1 >= (struct bp_frame *)AuxSp) { + goto heap_overflow; + } + *ptf++ = AbsAppl(HR); + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldp = ap2; + d0 = to_visit->oldv = ap2[0]; + /* fool the system into thinking we had a variable there */ + to_visit++; + pt0 = ap2; + pt0_end = ap2 + (arity - 1); + ptf = HR; + if (HR > ASP - 2048) { + goto overflow; + } + *ptf++ = (CELL)f; + *ap2 = AbsAppl(HR); + HR += (arity + 1); + if (IsVarTerm(d0) && d0 == (CELL)(ap2)) { + RESET_VARIABLE(ptf); + ptf++; + continue; + } + d0 = Deref(d0); + if (!IsVarTerm(d0)) { + goto copy_term_nvar; + } else { + *ptf++ = d0; + } + continue; + } else { + /* just copy atoms or integers */ + *ptf++ = d0; } + continue; + } derefa_body(d0, ptd0, copy_term_unk, copy_term_nvar); - *ptf++ = (CELL) ptd0; + *ptf++ = (CELL)ptd0; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; + to_visit--; *to_visit->oldp = to_visit->oldv; ptf = to_visit->to; pt0 = to_visit->start_cp; @@ -694,7 +678,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te *vout = vin; return true; - overflow: +overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -702,7 +686,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -713,7 +697,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te /* follow chain of multi-assigned variables */ return -1; - heap_overflow: +heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -721,7 +705,7 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -729,13 +713,11 @@ break_rationals_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *vout, Te } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; return -3; } - - Term -Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { +Term Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); Term tii = ti; tr_fr_ptr TR0 = TR; @@ -744,7 +726,7 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { *to = ti; return t; } else if (IsPrimitiveTerm(t)) { - *to = ti; + *to = ti; return t; } else if (IsPairTerm(t)) { CELL *ap; @@ -756,16 +738,17 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { HR += 2; { Int res; - if ((res = break_rationals_complex_term(ap-1, ap+1, Hi, to, ti, Hi PASS_REGS)) < 0) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_list; + if ((res = break_rationals_complex_term(ap - 1, ap + 1, Hi, to, ti, + Hi PASS_REGS)) < 0) { + HR = Hi; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_list; } else if (*to == tii) { - HR = Hi; - return t; + HR = Hi; + return t; } else { - return AbsPair(Hi); + return AbsPair(Hi); } } } else { @@ -783,41 +766,42 @@ Yap_BreakRational(Term inp, UInt arity, Term *to, Term ti USES_REGS) { ap = RepAppl(t); HR[0] = (CELL)f; arity = ArityOfFunctor(f); - HR += 1+arity; - - { + HR += 1 + arity; + + { Int res; - if ((res = break_rationals_complex_term(ap, ap+(arity), HB0+1, to, ti, HB0 PASS_REGS)) < 0) { - HR = HB0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; + if ((res = break_rationals_complex_term(ap, ap + (arity), HB0 + 1, to, ti, + HB0 PASS_REGS)) < 0) { + HR = HB0; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_appl; } else if (*to == ti) { - HR = HB0; - return t; + HR = HB0; + return t; } else { - return AbsAppl(HB0); + return AbsAppl(HB0); } } } } - static int -break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *HLow USES_REGS) -{ +static int break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, + Term oi, CELL *HLow USES_REGS) { - struct copy_frame *to_visit0, *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace(); + struct copy_frame *to_visit0, + *to_visit = (struct copy_frame *)Yap_PreAllocCodeSpace(); CELL *HB0 = HB; tr_fr_ptr TR0 = TR; CELL new = 0L; HB = HLow; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; if (new) { @@ -827,91 +811,92 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL new = 0L; } deref_head(d0, break_rationals_unk); - break_rationals_nvar: - { - CELL first; - CELL *newp; - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); + break_rationals_nvar : { + CELL first; + CELL *newp; + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); - if (IsVarTerm(first = *ap2) && (newp = (CELL*)first) && newp >= HB && newp < HR) { - // found a marked term: - found_term: - if (!IsVarTerm(*newp)) { - Term v = (CELL)newp, t = *newp; - RESET_VARIABLE(newp); - oi = add_to_list( oi, v, t PASS_REGS); - } - *ptf++ = (CELL)newp; - continue; - } - new = (CELL)ptf; - *ptf++ = AbsPair(HR); - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct copy_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit ++; - } - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just share extensions, what about DB? */ - continue; - } - if (IsVarTerm(first = ap2[1]) && (newp = (CELL*)first) && newp >= HB && newp < HR) { - goto found_term; - } - // new - /* store the terms to visit */ - new = (CELL)ptf; - *ptf++ = AbsAppl(HR); - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct copy_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit ++; - } - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { - goto overflow; - } - } else { - /* just copy atoms or integers */ - *ptf++ = d0; + if (IsVarTerm(first = *ap2) && (newp = (CELL *)first) && newp >= HB && + newp < HR) { + // found a marked term: + found_term: + if (!IsVarTerm(*newp)) { + Term v = (CELL)newp, t = *newp; + RESET_VARIABLE(newp); + oi = add_to_list(oi, v, t PASS_REGS); + } + *ptf++ = (CELL)newp; + continue; } - continue; + new = (CELL)ptf; + *ptf++ = AbsPair(HR); + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct copy_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit++; + } + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + *ptf++ = d0; /* you can just share extensions, what about DB? */ + continue; + } + if (IsVarTerm(first = ap2[1]) && (newp = (CELL *)first) && newp >= HB && + newp < HR) { + goto found_term; + } + // new + /* store the terms to visit */ + new = (CELL)ptf; + *ptf++ = AbsAppl(HR); + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct copy_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit++; + } + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR + 1; + HR += 1 + d0; + if (HR > ASP - 2048) { + goto overflow; + } + } else { + /* just copy atoms or integers */ + *ptf++ = d0; } + continue; + } derefa_body(d0, ptd0, break_rationals_unk, break_rationals_nvar); *ptf++ = d0; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -924,14 +909,14 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL *of = oi; return TRUE; - overflow: +overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -940,25 +925,24 @@ break_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, Term *of, Term oi, CELL /* follow chain of multi-assigned variables */ return -1; - heap_overflow: +heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ /* restore our nice, friendly, term to its original state */ HB = HB0; while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; } reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; return -3; } - Term -Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { +Term Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -968,7 +952,7 @@ Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { } else if (IsPrimitiveTerm(t)) { *to = ti; return t; - } else { + } else { CELL *ap; CELL *Hi = HR; @@ -978,36 +962,30 @@ Yap_BreakTerm(Term inp, UInt arity, Term *to, Term ti USES_REGS) { { int res; - if ((res = break_complex_term(ap-1, ap, Hi, to, ti, Hi PASS_REGS)) < 0) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_term; + if ((res = break_complex_term(ap - 1, ap, Hi, to, ti, Hi PASS_REGS)) < + 0) { + HR = Hi; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_term; } } return Hi[0]; } } - -static Int -p_break_rational( USES_REGS1 ) -{ +static Int p_break_rational(USES_REGS1) { Term tf; return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, ARG4 PASS_REGS)) && - Yap_unify(tf, ARG3); + Yap_unify(tf, ARG3); } - -static Int -p_break_rational3( USES_REGS1 ) -{ +static Int p_break_rational3(USES_REGS1) { Term tf; return Yap_unify(ARG2, Yap_BreakTerm(ARG1, 4, &tf, TermNil PASS_REGS)) && - Yap_unify(tf, ARG3); + Yap_unify(tf, ARG3); } - /* FAST EXPORT ROUTINE. Export a Prolog term to something like: @@ -1025,266 +1003,262 @@ p_break_rational3( USES_REGS1 ) */ -static inline -CELL *CellDifH(CELL *hptr, CELL *hlow) -{ - return (CELL *)((char *)hptr-(char *)hlow); +static inline CELL *CellDifH(CELL *hptr, CELL *hlow) { + return (CELL *)((char *)hptr - (char *)hlow); } -#define AdjustSizeAtom(X) (((CELL)(X)+(8-1)) & ~(8-1)) +#define AdjustSizeAtom(X) (((CELL)(X) + (8 - 1)) & ~(8 - 1)) -static inline -CELL *AdjustSize(CELL *x, char *buf) -{ - UInt offset = (char *)x-buf; - return (CELL*)(buf+AdjustSizeAtom(offset)); +static inline CELL *AdjustSize(CELL *x, char *buf) { + UInt offset = (char *)x - buf; + return (CELL *)(buf + AdjustSizeAtom(offset)); } /* export an atom from the symbol table to a buffer */ -static inline -Atom export_atom(Atom at, char **hpp, char *buf, size_t len) -{ +static inline Atom export_atom(Atom at, char **hpp, char *buf, size_t len) { char *ptr, *p0; size_t sz; ptr = *hpp; - ptr = (char *)AdjustSize((CELL*)ptr, buf); + ptr = (char *)AdjustSize((CELL *)ptr, buf); p0 = ptr; *ptr++ = 0; sz = strlen(RepAtom(at)->StrOfAE); - if (sz + 1 >= len) + if (sz + 1 >= len) return (Atom)NULL; strcpy(ptr, RepAtom(at)->StrOfAE); - *hpp = ptr+(sz+1); - return (Atom)(p0-buf); + *hpp = ptr + (sz + 1); + return (Atom)(p0 - buf); } /* place a buffer: first arity then the atom */ -static inline -Functor export_functor(Functor f, char **hpp, char *buf, size_t len) -{ +static inline Functor export_functor(Functor f, char **hpp, char *buf, + size_t len) { CELL *hptr = AdjustSize((CELL *)*hpp, buf); UInt arity = ArityOfFunctor(f); - if (2*sizeof(CELL) >= len) + if (2 * sizeof(CELL) >= len) return NULL; hptr[0] = arity; - *hpp = (char *)(hptr+1); + *hpp = (char *)(hptr + 1); if (!export_atom(NameOfFunctor(f), hpp, buf, len)) return NULL; /* increment so that it cannot be mistaken with a functor on the stack, (increment is used as a tag ........01 */ - return (Functor)(((char *)hptr-buf)+1); + return (Functor)(((char *)hptr - buf) + 1); } -#define export_derefa_body(D,A,LabelUnk,LabelNonVar) \ - do { \ - if ((CELL *)(D) < CellDifH(HR,HLow)) { (A) = (CELL *)(D); break; } \ - (A) = (CELL *)(D); \ - (D) = *(CELL *)(D); \ - if(!IsVarTerm(D)) goto LabelNonVar; \ - LabelUnk: ; \ - } while (Unsigned(A) != (D)) +#define export_derefa_body(D, A, LabelUnk, LabelNonVar) \ + do { \ + if ((CELL *)(D) < CellDifH(HR, HLow)) { \ + (A) = (CELL *)(D); \ + break; \ + } \ + (A) = (CELL *)(D); \ + (D) = *(CELL *)(D); \ + if (!IsVarTerm(D)) \ + goto LabelNonVar; \ + LabelUnk:; \ + } while (Unsigned(A) != (D)) - -static int -export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0 , CELL *tf, size_t len) -{ +static int export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0, + CELL *tf, size_t len) { char *td = bptr; CELL *bf = (CELL *)buf; - if (buf + len < (char *)((CELL *)td + (tf-t0))) { + if (buf + len < (char *)((CELL *)td + (tf - t0))) { return FALSE; } - memmove((void *)td, (void *)t0, (tf-t0)* sizeof(CELL)); - bf[0] = (td-buf); - bf[1] = (tf-t0); + memmove((void *)td, (void *)t0, (tf - t0) * sizeof(CELL)); + bf[0] = (td - buf); + bf[1] = (tf - t0); bf[2] = inpt; - return bf[0]+sizeof(CELL)*bf[1]; + return bf[0] + sizeof(CELL) * bf[1]; } - -static size_t -export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, int newattvs, CELL *ptf, CELL *HLow USES_REGS) -{ - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); +static size_t export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char *buf, + size_t len0, int newattvs, CELL *ptf, + CELL *HLow USES_REGS) { + struct cp_frame *to_visit0, + *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); CELL *HB0 = HB; tr_fr_ptr TR0 = TR; int ground = TRUE; - char *bptr = buf+ 3*sizeof(CELL); + char *bptr = buf + 3 * sizeof(CELL); size_t len = len0; HB = HLow; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, export_term_unk); - export_term_nvar: - { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 < CellDifH(HR,HLow)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(CellDifH(HR,HLow)); - ptf++; -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(CellDifH(HR,HLow)); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 < CellDifH(HR,HLow)) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - *ptf++ = AbsAppl(CellDifH(HR,HLow)); - if (IsExtensionFunctor(f)) { - UInt sz; - - /* make sure to export floats */ - if (f== FunctorDouble) { - sz = sizeof(Float)/sizeof(CELL)+2; - } else if (f== FunctorLongInt) { - sz = 3; - } else if (f== FunctorString) { - sz = 3+ap2[1]; - } else { - CELL *pt = ap2+1; - sz = 2+sizeof(MP_INT)+(((MP_INT *)(pt+1))->_mp_alloc*sizeof(mp_limb_t)); - } - if (HR+sz > ASP - 2048) { - goto overflow; - } - memmove((void *)HR, (void *)ap2, sz*sizeof(CELL)); - HR += sz; - continue; - } - /* store the terms to visit */ -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - ground = (f != FunctorMutable); - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { - goto overflow; - } - ptf[-1] = (CELL)export_functor(f, &bptr, buf, len); - len = len0 - (bptr-buf); - if (HR > ASP - 2048) { - goto overflow; - } - } else { - if (IsAtomTerm(d0)) { - *ptf = MkAtomTerm(export_atom(AtomOfTerm(d0), &bptr, buf, len)); - ptf++; - len = len0 - (bptr-buf); - } else { - *ptf++ = d0; - } + export_term_nvar : { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (ap2 < CellDifH(HR, HLow)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + *ptf = AbsPair(CellDifH(HR, HLow)); + ptf++; +#ifdef RATIONAL_TREES + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(CellDifH(HR, HLow)); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 < CellDifH(HR, HLow)) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + + *ptf++ = AbsAppl(CellDifH(HR, HLow)); + if (IsExtensionFunctor(f)) { + UInt sz; + + /* make sure to export floats */ + if (f == FunctorDouble) { + sz = sizeof(Float) / sizeof(CELL) + 2; + } else if (f == FunctorLongInt) { + sz = 3; + } else if (f == FunctorString) { + sz = 3 + ap2[1]; + } else { + CELL *pt = ap2 + 1; + sz = 2 + sizeof(MP_INT) + + (((MP_INT *)(pt + 1))->_mp_alloc * sizeof(mp_limb_t)); + } + if (HR + sz > ASP - 2048) { + goto overflow; + } + memmove((void *)HR, (void *)ap2, sz * sizeof(CELL)); + HR += sz; + continue; + } + /* store the terms to visit */ +#ifdef RATIONAL_TREES + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = (f != FunctorMutable); + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + ptf = HR + 1; + HR += 1 + d0; + if (HR > ASP - 2048) { + goto overflow; + } + ptf[-1] = (CELL)export_functor(f, &bptr, buf, len); + len = len0 - (bptr - buf); + if (HR > ASP - 2048) { + goto overflow; + } + } else { + if (IsAtomTerm(d0)) { + *ptf = MkAtomTerm(export_atom(AtomOfTerm(d0), &bptr, buf, len)); + ptf++; + len = len0 - (bptr - buf); + } else { + *ptf++ = d0; } - continue; } + continue; + } export_derefa_body(d0, ptd0, export_term_unk, export_term_nvar); ground = FALSE; - if (ptd0 < CellDifH(HR,HLow)) { + if (ptd0 < CellDifH(HR, HLow)) { /* we have already found this cell */ - *ptf++ = (CELL) ptd0; + *ptf++ = (CELL)ptd0; } else { #if COROUTINING if (newattvs && IsAttachedTerm((CELL)ptd0) && FALSE) { - /* if unbound, call the standard export term routine */ - struct cp_frame *bp; + /* if unbound, call the standard export term routine */ + struct cp_frame *bp; - CELL new; + CELL new; - bp = to_visit; - if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, ptf PASS_REGS)) { - goto overflow; - } - to_visit = bp; - new = *ptf; - Bind_NonAtt(ptd0, new); - ptf++; + bp = to_visit; + if (!GLOBAL_attas[ExtFromCell(ptd0)].copy_term_op(ptd0, &bp, + ptf PASS_REGS)) { + goto overflow; + } + to_visit = bp; + new = *ptf; + Bind_NonAtt(ptd0, new); + ptf++; } else { #endif - /* first time we met this term */ - *ptf = (CELL)CellDifH(ptf,HLow); - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } - } - Bind_NonAtt(ptd0, (CELL)ptf); - ptf++; + /* first time we met this term */ + *ptf = (CELL)CellDifH(ptf, HLow); + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + Bind_NonAtt(ptd0, (CELL)ptf); + ptf++; #ifdef COROUTINING } #endif @@ -1292,7 +1266,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -1308,7 +1282,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, HB = HB0; return export_term_to_buffer(tf, buf, bptr, HLow, HR, len0); - overflow: +overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1316,7 +1290,7 @@ export_complex_term(Term tf, CELL *pt0, CELL *pt0_end, char * buf, size_t len0, HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -1335,7 +1309,7 @@ trail_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -1343,15 +1317,15 @@ trail_overflow: } #endif { - tr_fr_ptr oTR = TR; + tr_fr_ptr oTR = TR; reset_trail(TR0); - if (!Yap_growtrail((oTR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { + if (!Yap_growtrail((oTR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { return -4; } return -2; } - heap_overflow: +heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -1359,7 +1333,7 @@ trail_overflow: HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -1367,12 +1341,12 @@ trail_overflow: } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; return -3; } -static size_t -ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) { +static size_t ExportTerm(Term inp, char *buf, size_t len, UInt arity, + int newattvs USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; size_t res = 0; @@ -1380,73 +1354,62 @@ ExportTerm(Term inp, char * buf, size_t len, UInt arity, int newattvs USES_REGS) do { if (IsVarTerm(t) || IsIntTerm(t)) { - return export_term_to_buffer(t, buf, buf+ 3*sizeof(CELL), &inp, &inp, len); + return export_term_to_buffer(t, buf, buf + 3 * sizeof(CELL), &inp, &inp, + len); } if (IsAtomTerm(t)) { Atom at = AtomOfTerm(t); - char *b = buf+3*sizeof(CELL); - export_atom(at, &b, b, len-3*sizeof(CELL)); + char *b = buf + 3 * sizeof(CELL); + export_atom(at, &b, b, len - 3 * sizeof(CELL)); return export_term_to_buffer(t, buf, b, &inp, &inp, len); } if ((Int)res < 0) { HR = Hi; TR = TR0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return res; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return res; } Hi = HR; TR0 = TR; - res = export_complex_term(inp, &t-1, &t, buf, len, newattvs, Hi, Hi PASS_REGS); + res = export_complex_term(inp, &t - 1, &t, buf, len, newattvs, Hi, + Hi PASS_REGS); } while ((Int)res < 0); return res; } -size_t -Yap_ExportTerm(Term inp, char * buf, size_t len, UInt arity) { +size_t Yap_ExportTerm(Term inp, char *buf, size_t len, UInt arity) { CACHE_REGS return ExportTerm(inp, buf, len, arity, TRUE PASS_REGS); } +static CELL *ShiftPtr(CELL t, char *base) { return (CELL *)(base + t); } -static CELL * -ShiftPtr(CELL t, char *base) -{ - return (CELL *)(base+t); -} - -static Atom -addAtom(Atom t, char *buf) -{ - char *s = buf+(UInt)t; +static Atom addAtom(Atom t, char *buf) { + char *s = buf + (UInt)t; if (!*s) { - return Yap_LookupAtom(s+1); + return Yap_LookupAtom(s + 1); } - return NULL; + return NULL; } -static UInt -FetchFunctor(CELL *pt, char *buf) -{ - CELL *ptr = (CELL *)(buf+(*pt-1)); +static UInt FetchFunctor(CELL *pt, char *buf) { + CELL *ptr = (CELL *)(buf + (*pt - 1)); // do arity first UInt arity = *ptr++; Atom name, at; // and then an atom ptr = AdjustSize(ptr, buf); - name = (Atom)((char *)ptr-buf); + name = (Atom)((char *)ptr - buf); at = addAtom(name, buf); *pt = (CELL)Yap_MkFunctor(at, arity); return arity; } - static CELL *import_compound(CELL *hp, char *abase, char *buf, CELL *amax); static CELL *import_pair(CELL *hp, char *abase, char *buf, CELL *amax); -static CELL * -import_arg(CELL *hp, char *abase, char *buf, CELL *amax) -{ +static CELL *import_arg(CELL *hp, char *abase, char *buf, CELL *amax) { Term t = *hp; if (IsVarTerm(t)) { hp[0] = (CELL)ShiftPtr(t, abase); @@ -1468,31 +1431,26 @@ import_arg(CELL *hp, char *abase, char *buf, CELL *amax) return amax; } -static CELL * -import_compound(CELL *hp, char *abase, char *buf, CELL *amax) -{ +static CELL *import_compound(CELL *hp, char *abase, char *buf, CELL *amax) { Functor f = (Functor)*hp; UInt ar, i; if (!((CELL)f & 1) && IsExtensionFunctor(f)) return amax; ar = FetchFunctor(hp, buf); - for (i=1; i<=ar; i++) { - amax = import_arg(hp+i, abase, buf, amax); + for (i = 1; i <= ar; i++) { + amax = import_arg(hp + i, abase, buf, amax); } return amax; } -static CELL * -import_pair(CELL *hp, char *abase, char *buf, CELL *amax) -{ +static CELL *import_pair(CELL *hp, char *abase, char *buf, CELL *amax) { amax = import_arg(hp, abase, buf, amax); - amax = import_arg(hp+1, abase, buf, amax); + amax = import_arg(hp + 1, abase, buf, amax); return amax; } -Term -Yap_ImportTerm(char * buf) { +Term Yap_ImportTerm(char *buf) { CACHE_REGS CELL *bc = (CELL *)buf; size_t sz = bc[1]; @@ -1503,18 +1461,18 @@ Yap_ImportTerm(char * buf) { else if (IsIntTerm(tinp)) return tinp; else if (IsAtomTerm(tinp)) { - tret = MkAtomTerm(addAtom(NULL,(char *)(bc+3))); + tret = MkAtomTerm(addAtom(NULL, (char *)(bc + 3))); return tret; } // call the gc/stack shifter mechanism // if not enough stack available while (HR + sz > ASP - 4096) { - if (!Yap_gcl( (sz+4096)*sizeof(CELL), PP->ArityOfPE, ENV, gc_P(P,CP))) { + if (!Yap_gcl((sz + 4096) * sizeof(CELL), PP->ArityOfPE, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return 0L; } } - memmove(HR, buf+bc[0], sizeof(CELL)*sz); + memmove(HR, buf + bc[0], sizeof(CELL) * sz); if (IsApplTerm(tinp)) { tret = AbsAppl(HR); import_compound(HR, (char *)HR, buf, HR); @@ -1526,20 +1484,17 @@ Yap_ImportTerm(char * buf) { return tret; } -size_t -Yap_SizeOfExportedTerm(char * buf) { +size_t Yap_SizeOfExportedTerm(char *buf) { CELL *bc = (CELL *)buf; - return bc[0]+bc[1]*sizeof(CELL); + return bc[0] + bc[1] * sizeof(CELL); } -static Int -p_export_term( USES_REGS1 ) -{ +static Int p_export_term(USES_REGS1) { size_t sz = 4096, osz; char *export_buf; do { - export_buf = malloc(sz); + export_buf = malloc(sz); if (!export_buf) return FALSE; if (!(osz = Yap_ExportTerm(ARG1, export_buf, sz, 1))) { @@ -1547,23 +1502,19 @@ p_export_term( USES_REGS1 ) free(export_buf); } } while (!osz); - return Yap_unify(ARG3,MkIntegerTerm(osz)) && - Yap_unify(ARG2, MkIntegerTerm((Int)export_buf)); + return Yap_unify(ARG3, MkIntegerTerm(osz)) && + Yap_unify(ARG2, MkIntegerTerm((Int)export_buf)); } -static Int -p_import_term( USES_REGS1 ) -{ +static Int p_import_term(USES_REGS1) { char *export_buf = (char *)IntegerOfTerm(Deref(ARG1)); if (!export_buf) return FALSE; - Int out = Yap_unify(ARG2,Yap_ImportTerm(export_buf)); + Int out = Yap_unify(ARG2, Yap_ImportTerm(export_buf)); return out; } -static Int -p_kill_exported_term( USES_REGS1 ) -{ +static Int p_kill_exported_term(USES_REGS1) { char *export_buf = (char *)IntegerOfTerm(Deref(ARG1)); if (!export_buf) return FALSE; @@ -1571,9 +1522,8 @@ p_kill_exported_term( USES_REGS1 ) return TRUE; } - -static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; @@ -1581,84 +1531,82 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter CELL output = AbsPair(HR); to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + vars_in_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; } - + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ *ptd0 = TermNil; /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { + if (HR + 1024 > ASP) { goto global_overflow; } - HR[1] = AbsPair(HR+2); + HR[1] = AbsPair(HR + 2); HR += 2; HR[-2] = (CELL)ptd0; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; } } TrailTerm(TR++) = (CELL)ptd0; @@ -1684,17 +1632,17 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1),inp); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), inp); } else { - HR[-1] = t2; /* don't need to trail */ + HR[-1] = t2; /* don't need to trail */ } - return(output); + return (output); } else { - return(inp); + return (inp); } - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -1703,14 +1651,14 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; return 0L; - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +aux_overflow: + LOCAL_Error_Size = (to_visit - to_visit0) * sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -1724,7 +1672,7 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter HR = InitialH; return 0L; - global_overflow: +global_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -1736,14 +1684,11 @@ static Term vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Ter Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); return 0L; - } -static int -expand_vts( int args USES_REGS ) -{ +static int expand_vts(int args USES_REGS) { UInt expand = LOCAL_Error_Size; yap_error_number yap_errno = LOCAL_Error_TYPE; @@ -1756,13 +1701,13 @@ expand_vts( int args USES_REGS ) } } else if (yap_errno == RESOURCE_ERROR_AUXILIARY_STACK) { /* Aux space overflow */ - if (expand > 4*1024*1024) - expand = 4*1024*1024; + if (expand > 4 * 1024 * 1024) + expand = 4 * 1024 * 1024; if (!Yap_ExpandPreAllocCodeSpace(expand, NULL, TRUE)) { return FALSE; } } else { - if (!Yap_gcl(expand, 3, ENV, gc_P(P,CP))) { + if (!Yap_gcl(expand, 3, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_variables"); return FALSE; } @@ -1771,13 +1716,12 @@ expand_vts( int args USES_REGS ) } static Int -p_variables_in_term( USES_REGS1 ) /* variables in term t */ +p_variables_in_term(USES_REGS1) /* variables in term t */ { Term out, inp; int count; - - restart: +restart: count = 0; inp = Deref(ARG2); while (!IsVarTerm(inp) && IsPairTerm(inp)) { @@ -1788,11 +1732,11 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ TrailTerm(TR++) = t; count++; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - clean_tr(TR-count PASS_REGS); - if (!Yap_growtrail(count*sizeof(tr_fr_ptr *), FALSE)) { - return FALSE; - } - goto restart; + clean_tr(TR - count PASS_REGS); + if (!Yap_growtrail(count * sizeof(tr_fr_ptr *), FALSE)) { + return FALSE; + } + goto restart; } } inp = TailOfTerm(inp); @@ -1802,39 +1746,35 @@ p_variables_in_term( USES_REGS1 ) /* variables in term t */ if (IsVarTerm(t)) { out = AbsPair(HR); HR += 2; - RESET_VARIABLE(HR-2); - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-2),ARG1); - Yap_unify((CELL)(HR-1),ARG2); - } else if (IsPrimitiveTerm(t)) + RESET_VARIABLE(HR - 2); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 2), ARG1); + Yap_unify((CELL)(HR - 1), ARG2); + } else if (IsPrimitiveTerm(t)) out = ARG2; else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG2 PASS_REGS); - } - else { + out = + vars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, ARG2 PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), ARG2 PASS_REGS); + out = vars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + ARG2 PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - clean_tr(TR-count PASS_REGS); - return Yap_unify(ARG3,out); + clean_tr(TR - count PASS_REGS); + return Yap_unify(ARG3, out); } - -static Int -p_term_variables( USES_REGS1 ) /* variables in term t */ +static Int p_term_variables(USES_REGS1) /* variables in term t */ { Term out; if (!Yap_IsListOrPartialListTerm(ARG2)) { - Yap_Error(TYPE_ERROR_LIST,ARG2,"term_variables/2"); + Yap_Error(TYPE_ERROR_LIST, ARG2, "term_variables/2"); return FALSE; } @@ -1842,60 +1782,55 @@ p_term_variables( USES_REGS1 ) /* variables in term t */ Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(TermNil, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { + return Yap_unify(t, HeadOfTerm(out)) && + Yap_unify(TermNil, TailOfTerm(out)) && Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { + out = vars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, + TermNil PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); + out = vars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } /** * Exports a nil-terminated list with all the variables in a term. * @param[t] the term - * @param[arity] the arity of the calling predicate (required for exact garbage collection). + * @param[arity] the arity of the calling predicate (required for exact garbage + * collection). * @param[USES_REGS] threading */ -Term -Yap_TermVariables( Term t, UInt arity USES_REGS ) /* variables in term t */ +Term Yap_TermVariables( + Term t, UInt arity USES_REGS) /* variables in term t */ { Term out; - do { + do { t = Deref(t); if (IsVarTerm(t)) { return MkPairTerm(t, TermNil); - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return TermNil; } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { + out = vars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, + TermNil PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); + out = vars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( arity PASS_REGS )) - return FALSE; + if (!expand_vts(arity PASS_REGS)) + return FALSE; } } while (out == 0L); return out; @@ -1906,136 +1841,134 @@ typedef struct att_rec { CELL oval; } att_rec_t; -static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { int lvl = push_text_stack(); - att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit0, *to_visit = Malloc(1024 * sizeof(att_rec_t)); att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; CELL output = AbsPair(HR); to_visit0 = to_visit; - to_visit_max = to_visit0+1024; - restart: + to_visit_max = to_visit0 + 1024; +restart: do { - while (pt0 < pt0_end) { - register CELL d0; - register CELL *ptd0; - ++ pt0; - ptd0 = pt0; - d0 = *ptd0; - deref_head(d0, attvars_in_term_unk); - attvars_in_term_nvar: - { + while (pt0 < pt0_end) { + register CELL d0; + register CELL *ptd0; + ++pt0; + ptd0 = pt0; + d0 = *ptd0; + deref_head(d0, attvars_in_term_unk); + attvars_in_term_nvar : { if (IsPairTerm(d0)) { if (to_visit + 32 >= to_visit_max) { goto aux_overflow; } { CELL *npt0 = RepPair(d0); - if(IsAtomicTerm(Deref(npt0[0]))) { + if (IsAtomicTerm(Deref(npt0[0]))) { pt0 = npt0; pt0_end = pt0 + 1; continue; } } #ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit++; + *pt0 = TermNil; #else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } #endif - pt0 = RepPair(d0) - 1; - pt0_end = pt0+2; + pt0 = RepPair(d0) - 1; + pt0_end = pt0 + 2; } else if (IsApplTerm(d0)) { Functor f; - CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } + CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; + } #ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit++; + *pt0 = TermNil; #else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } #endif - arity_t a = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + a; + arity_t a = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + a; } continue; } - - derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); - if (IsAttVar(ptd0)) { - /* do or pt2 are unbound */ - *ptd0 = TermNil; - /* next make sure noone will see this as a variable again */ - if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + derefa_body(d0, ptd0, attvars_in_term_unk, attvars_in_term_nvar); + if (IsAttVar(ptd0)) { + /* do or pt2 are unbound */ + *ptd0 = TermNil; + /* next make sure noone will see this as a variable again */ + if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { + /* Trail overflow */ + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } + } + TrailTerm(TR++) = (CELL)ptd0; + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL)ptd0; + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; } - } - TrailTerm(TR++) = (CELL)ptd0; - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - /* store the terms to visit */ - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } #ifdef RATIONAL_TREES - - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; + + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit++; + *pt0 = TermNil; #else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } #endif - pt0 = &RepAttVar(ptd0)->Value; - pt0_end = &RepAttVar(ptd0)->Atts; + pt0 = &RepAttVar(ptd0)->Value; + pt0_end = &RepAttVar(ptd0)->Atts; + } + continue; } - continue; - } - /* Do we still have compound terms to visit */ - if (to_visit == to_visit0) - break; + /* Do we still have compound terms to visit */ + if (to_visit == to_visit0) + break; #ifdef RATIONAL_TREES - to_visit --; + to_visit--; pt0 = to_visit->beg; pt0_end = to_visit->end; *pt0 = to_visit->oval; @@ -2044,101 +1977,95 @@ static Term attvars_in_complex_term(register CELL *pt0, register CELL *pt0_end, pt0 = to_visit[0]; pt0_end = to_visit[1]; #endif - } while(true); + } while (true); clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + pop_text_stack(lvl); if (HR != InitialH) { /* close the list */ Term t2 = Deref(inp); if (IsVarTerm(t2)) { - RESET_VARIABLE(HR-1); - Yap_unify((CELL)(HR-1), t2); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), t2); } else { - HR[-1] = t2; /* don't need to trail */ + HR[-1] = t2; /* don't need to trail */ } - return(output); + return (output); } else { - return(inp); + return (inp); } - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->beg; *pt0 = to_visit->oval; } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); - pop_text_stack(lvl); + pop_text_stack(lvl); HR = InitialH; return 0L; - aux_overflow: - { - size_t d1 = to_visit-to_visit0; - size_t d2 = to_visit_max-to_visit0; - to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); - to_visit = to_visit0+d1; - to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +aux_overflow : { + size_t d1 = to_visit - to_visit0; + size_t d2 = to_visit_max - to_visit0; + to_visit0 = Realloc(to_visit0, d2 * sizeof(CELL *) + 64 * 1024); + to_visit = to_visit0 + d1; + to_visit_max = to_visit0 + (d2 + (64 * 1024)) / sizeof(CELL **); } -pt0--; -goto restart; + pt0--; + goto restart; - global_overflow: +global_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->beg; *pt0 = to_visit->oval; } #endif clean_tr(TR0 PASS_REGS); -pop_text_stack(lvl); + pop_text_stack(lvl); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); return 0L; - } -static Int -p_term_attvars( USES_REGS1 ) /* variables in term t */ +static Int p_term_attvars(USES_REGS1) /* variables in term t */ { Term out; do { Term t = Deref(ARG1); if (IsVarTerm(t)) { - out = attvars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t)+1, TermNil PASS_REGS); - } else if (IsPrimitiveTerm(t)) { + out = attvars_in_complex_term(VarOfTerm(t) - 1, VarOfTerm(t) + 1, + TermNil PASS_REGS); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(TermNil, ARG2); } else if (IsPairTerm(t)) { - out = attvars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TermNil PASS_REGS); - } - else { + out = attvars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, + TermNil PASS_REGS); + } else { Functor f = FunctorOfTerm(t); if (IsExtensionFunctor(f)) - return Yap_unify(TermNil, ARG2); - out = attvars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TermNil PASS_REGS); + return Yap_unify(TermNil, ARG2); + out = attvars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + TermNil PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } -static Int -p_term_variables3( USES_REGS1 ) /* variables in term t */ +static Int p_term_variables3(USES_REGS1) /* variables in term t */ { Term out; @@ -2146,34 +2073,29 @@ p_term_variables3( USES_REGS1 ) /* variables in term t */ Term t = Deref(ARG1); if (IsVarTerm(t)) { Term out = Yap_MkNewPairTerm(); - return - Yap_unify(t,HeadOfTerm(out)) && - Yap_unify(ARG3, TailOfTerm(out)) && - Yap_unify(out, ARG2); - } else if (IsPrimitiveTerm(t)) { + return Yap_unify(t, HeadOfTerm(out)) && + Yap_unify(ARG3, TailOfTerm(out)) && Yap_unify(out, ARG2); + } else if (IsPrimitiveTerm(t)) { return Yap_unify(ARG2, ARG3); } else if (IsPairTerm(t)) { - out = vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, ARG3 PASS_REGS); - } - else { + out = + vars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, ARG3 PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), ARG3 PASS_REGS); + out = vars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + ARG3 PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - return Yap_unify(ARG2,out); + return Yap_unify(ARG2, out); } - -static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; @@ -2188,83 +2110,82 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } } } inp = TailOfTerm(inp); } - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } else if (d0 == TermFoundVar) { - /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { - goto global_overflow; - } - HR[1] = AbsPair(HR+2); - HR += 2; - HR[-2] = (CELL)ptd0; - *ptd0 = TermNil; + vars_within_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } else if (d0 == TermFoundVar) { + /* leave an empty slot to fill in later */ + if (HR + 1024 > ASP) { + goto global_overflow; + } + HR[1] = AbsPair(HR + 2); + HR += 2; + HR[-2] = (CELL)ptd0; + *ptd0 = TermNil; } + continue; + } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); } @@ -2292,7 +2213,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2301,14 +2222,14 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; return 0L; - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +aux_overflow: + LOCAL_Error_Size = (to_visit - to_visit0) * sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2322,7 +2243,7 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, HR = InitialH; return 0L; - global_overflow: +global_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2334,44 +2255,41 @@ static Term vars_within_complex_term(register CELL *pt0, register CELL *pt0_end, Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); return 0L; - } static Int -p_variables_within_term( USES_REGS1 ) /* variables within term t */ +p_variables_within_term(USES_REGS1) /* variables within term t */ { Term out; do { Term t = Deref(ARG2); if (IsVarTerm(t)) { - out = vars_within_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), Deref(ARG1) PASS_REGS); + out = vars_within_complex_term(VarOfTerm(t) - 1, VarOfTerm(t), + Deref(ARG1) PASS_REGS); - } else if (IsPrimitiveTerm(t)) + } else if (IsPrimitiveTerm(t)) out = TermNil; else if (IsPairTerm(t)) { - out = vars_within_complex_term(RepPair(t)-1, - RepPair(t)+1, Deref(ARG1) PASS_REGS); - } - else { + out = vars_within_complex_term(RepPair(t) - 1, RepPair(t) + 1, + Deref(ARG1) PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = vars_within_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); + out = vars_within_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + Deref(ARG1) PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } -static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Term inp USES_REGS) -{ +static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term inp USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; @@ -2385,90 +2303,89 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, *ptr = TermFoundVar; TrailTerm(TR++) = t; if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; - } + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; + } } } inp = TailOfTerm(inp); } - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + vars_within_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; } + continue; + } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); /* do or pt2 are unbound */ *ptd0 = TermNil; /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { + if (HR + 1024 > ASP) { goto global_overflow; } - HR[1] = AbsPair(HR+2); + HR[1] = AbsPair(HR + 2); HR += 2; HR[-2] = (CELL)ptd0; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; } } TrailTerm(TR++) = (CELL)ptd0; @@ -2497,7 +2414,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, return TermNil; } - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2506,14 +2423,14 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; return 0L; - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +aux_overflow: + LOCAL_Error_Size = (to_visit - to_visit0) * sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2527,7 +2444,7 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, HR = InitialH; return 0L; - global_overflow: +global_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2539,125 +2456,122 @@ static Term new_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); return 0L; - } static Int -p_new_variables_in_term( USES_REGS1 ) /* variables within term t */ +p_new_variables_in_term(USES_REGS1) /* variables within term t */ { Term out; do { Term t = Deref(ARG2); if (IsVarTerm(t)) { - out = new_vars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), Deref(ARG1) PASS_REGS); + out = new_vars_in_complex_term(VarOfTerm(t) - 1, VarOfTerm(t), + Deref(ARG1) PASS_REGS); - } else if (IsPrimitiveTerm(t)) + } else if (IsPrimitiveTerm(t)) out = TermNil; else if (IsPairTerm(t)) { - out = new_vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, Deref(ARG1) PASS_REGS); - } - else { + out = new_vars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, + Deref(ARG1) PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = new_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), Deref(ARG1) PASS_REGS); + out = new_vars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + Deref(ARG1) PASS_REGS); } if (out == 0L) { - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } -static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ +static Term free_vars_in_complex_term(register CELL *pt0, + register CELL *pt0_end, + tr_fr_ptr TR0 USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; *HR++ = MkAtomTerm(AtomDollar); to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + vars_within_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; } + continue; + } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); /* do or pt2 are unbound */ *ptd0 = TermNil; /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { + if (HR + 1024 > ASP) { goto global_overflow; } - HR[0] = (CELL)ptd0; - HR ++; + HR[0] = (CELL)ptd0; + HR++; /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; } } TrailTerm(TR++) = (CELL)ptd0; @@ -2679,14 +2593,14 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); - if (HR != InitialH+1) { - InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR-InitialH)-1); + if (HR != InitialH + 1) { + InitialH[0] = (CELL)Yap_MkFunctor(AtomDollar, (HR - InitialH) - 1); return AbsAppl(InitialH); } else { return MkAtomTerm(AtomDollar); } - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2695,14 +2609,14 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; return 0L; - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +aux_overflow: + LOCAL_Error_Size = (to_visit - to_visit0) * sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2716,7 +2630,7 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end HR = InitialH; return 0L; - global_overflow: +global_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2728,78 +2642,77 @@ static Term free_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); return 0L; - } -static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end, tr_fr_ptr TR0 USES_REGS) -{ +static Term bind_vars_in_complex_term(register CELL *pt0, + register CELL *pt0_end, + tr_fr_ptr TR0 USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); CELL *InitialH = HR; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_within_term_unk); - vars_within_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - /* store the terms to visit */ - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + vars_within_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + /* store the terms to visit */ + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; } + continue; + } derefa_body(d0, ptd0, vars_within_term_unk, vars_within_term_nvar); /* do or pt2 are unbound */ @@ -2807,8 +2720,8 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; } } TrailTerm(TR++) = (CELL)ptd0; @@ -2831,7 +2744,7 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); return TermNil; - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2840,14 +2753,14 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; return 0L; - aux_overflow: - LOCAL_Error_Size = (to_visit-to_visit0)*sizeof(CELL **); +aux_overflow: + LOCAL_Error_Size = (to_visit - to_visit0) * sizeof(CELL **); #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -2860,11 +2773,10 @@ static Term bind_vars_in_complex_term(register CELL *pt0, register CELL *pt0_end Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0); HR = InitialH; return 0L; - } static Int -p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ +p_free_variables_in_term(USES_REGS1) /* variables within term t */ { Term out; Term t, t0; @@ -2877,60 +2789,56 @@ p_free_variables_in_term( USES_REGS1 ) /* variables within term t */ while (!IsVarTerm(t) && IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorHat) { - out = bind_vars_in_complex_term(RepAppl(t), - RepAppl(t)+1, TR0 PASS_REGS); - if (out == 0L) { - goto trail_overflow; - } + out = bind_vars_in_complex_term(RepAppl(t), RepAppl(t) + 1, + TR0 PASS_REGS); + if (out == 0L) { + goto trail_overflow; + } } else if (f == FunctorModule) { - found_module = ArgOfTerm(1, t); + found_module = ArgOfTerm(1, t); } else if (f == FunctorCall) { - t = ArgOfTerm(1, t); - continue; + t = ArgOfTerm(1, t); + continue; } else if (f == FunctorExecuteInMod) { - found_module = ArgOfTerm(2, t); - t = ArgOfTerm(1, t); - continue; + found_module = ArgOfTerm(2, t); + t = ArgOfTerm(1, t); + continue; } else { - break; + break; } - t = ArgOfTerm(2,t); + t = ArgOfTerm(2, t); } if (IsVarTerm(t)) { - out = free_vars_in_complex_term(VarOfTerm(t)-1, - VarOfTerm(t), TR0 PASS_REGS); + out = free_vars_in_complex_term(VarOfTerm(t) - 1, VarOfTerm(t), + TR0 PASS_REGS); - } else if (IsPrimitiveTerm(t)) + } else if (IsPrimitiveTerm(t)) out = TermNil; else if (IsPairTerm(t)) { - out = free_vars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, TR0 PASS_REGS); - } - else { + out = free_vars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, + TR0 PASS_REGS); + } else { Functor f = FunctorOfTerm(t); - out = free_vars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), TR0 PASS_REGS); + out = free_vars_in_complex_term( + RepAppl(t), RepAppl(t) + ArityOfFunctor(f), TR0 PASS_REGS); } if (out == 0L) { trail_overflow: - if (!expand_vts( 3 PASS_REGS )) - return FALSE; + if (!expand_vts(3 PASS_REGS)) + return FALSE; } } while (out == 0L); - if (found_module && t!=t0) { + if (found_module && t != t0) { Term ts[2]; ts[0] = found_module; ts[1] = t; t = Yap_MkApplTerm(FunctorModule, 2, ts); } - return - Yap_unify(ARG2, t) && - Yap_unify(ARG3,out); + return Yap_unify(ARG2, t) && Yap_unify(ARG3, out); } -static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ +static Term non_singletons_in_complex_term(register CELL *pt0, + register CELL *pt0_end USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; @@ -2938,78 +2846,76 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt CELL output = AbsPair(HR); to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } else if (d0 == TermFoundVar) { - CELL *pt2 = pt0; - while(IsVarTerm(*pt2)) - pt2 = (CELL *)(*pt2); - HR[0] = AbsPair(HR+2); - HR += 2; - HR[-1] = (CELL)pt2; - *pt2 = TermRefoundVar; + vars_in_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; - } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } else if (d0 == TermFoundVar) { + CELL *pt2 = pt0; + while (IsVarTerm(*pt2)) + pt2 = (CELL *)(*pt2); + HR[0] = (CELL)pt2; + HR[1] = AbsPair(HR + 2); + HR += 2; + *pt2 = TermRefoundVar; + } + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ @@ -3035,14 +2941,14 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt clean_tr(TR0 PASS_REGS); if (HR != InitialH) { /* close the list */ - RESET_VARIABLE(HR-2); - Yap_unify((CELL)(HR-2),ARG2); + RESET_VARIABLE(HR - 1); + Yap_unify((CELL)(HR - 1), ARG2); return output; } else { return ARG2; } - aux_overflow: +aux_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { to_visit -= 3; @@ -3053,13 +2959,13 @@ static Term non_singletons_in_complex_term(register CELL *pt0, register CELL *pt clean_tr(TR0 PASS_REGS); if (HR != InitialH) { /* close the list */ - RESET_VARIABLE(HR-1); + RESET_VARIABLE(HR - 1); } return 0L; } -static Int -p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ +static Int p_non_singletons_in_term( + USES_REGS1) /* non_singletons in term t */ { Term t; Term out; @@ -3068,34 +2974,34 @@ p_non_singletons_in_term( USES_REGS1 ) /* non_singletons in term t */ t = Deref(ARG1); if (IsVarTerm(t)) { out = ARG2; - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { out = ARG2; } else if (IsPairTerm(t)) { - out = non_singletons_in_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS); + out = non_singletons_in_complex_term(RepPair(t) - 1, + RepPair(t) + 1 PASS_REGS); } else { - out = non_singletons_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS); + out = non_singletons_in_complex_term( + RepAppl(t), RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)) PASS_REGS); } if (out != 0L) { - return Yap_unify(ARG3,out); + return Yap_unify(ARG3, out); } else { if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in singletons"); - return FALSE; + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, + "overflow in singletons"); + return FALSE; } } } } -static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_REGS) -{ +static Int ground_complex_term(register CELL *pt0, + register CELL *pt0_end USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -3104,61 +3010,59 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + vars_in_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; - } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); #ifdef RATIONAL_TREES @@ -3187,7 +3091,7 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R } return TRUE; - aux_overflow: +aux_overflow: /* unwind stack */ #ifdef RATIONAL_TREES while (to_visit > to_visit0) { @@ -3199,81 +3103,77 @@ static Int ground_complex_term(register CELL *pt0, register CELL *pt0_end USES_R return -1; } -bool Yap_IsGroundTerm(Term t) -{ +bool Yap_IsGroundTerm(Term t) { CACHE_REGS while (TRUE) { Int out; if (IsVarTerm(t)) { return FALSE; - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return TRUE; } else if (IsPairTerm(t)) { - if ((out =ground_complex_term(RepPair(t)-1, - RepPair(t)+1 PASS_REGS)) >= 0) { - return out != 0; + if ((out = ground_complex_term(RepPair(t) - 1, + RepPair(t) + 1 PASS_REGS)) >= 0) { + return out != 0; } } else { Functor fun = FunctorOfTerm(t); if (IsExtensionFunctor(fun)) - return TRUE; - else if ((out = ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun) PASS_REGS)) >= 0) { - return out != 0; + return TRUE; + else if ((out = ground_complex_term( + RepAppl(t), RepAppl(t) + ArityOfFunctor(fun) PASS_REGS)) >= + 0) { + return out != 0; } } if (out < 0) { *HR++ = t; if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); - return false; + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in ground"); + return false; } t = *--HR; } } } -static Int -p_ground( USES_REGS1 ) /* ground(+T) */ +static Int p_ground(USES_REGS1) /* ground(+T) */ { return Yap_IsGroundTerm(Deref(ARG1)); } -static int -SizeOfExtension(Term t) -{ +static int SizeOfExtension(Term t) { Functor f = FunctorOfTerm(t); - if (f== FunctorDouble) { - return 2 + sizeof(Float)/sizeof(CELL); + if (f == FunctorDouble) { + return 2 + sizeof(Float) / sizeof(CELL); } - if (f== FunctorString) { + if (f == FunctorString) { return 3 + RepAppl(t)[1]; } - if (f== FunctorLongInt) { - return 2 + sizeof(Float)/sizeof(CELL); + if (f == FunctorLongInt) { + return 2 + sizeof(Float) / sizeof(CELL); } - if (f== FunctorDBRef) { + if (f == FunctorDBRef) { return 0; } - if (f== FunctorBigInt) { - CELL *pt = RepAppl(t)+2; - return 3+sizeof(MP_INT)+(((MP_INT *)(pt))->_mp_alloc*sizeof(mp_limb_t)); + if (f == FunctorBigInt) { + CELL *pt = RepAppl(t) + 2; + return 3 + sizeof(MP_INT) + + (((MP_INT *)(pt))->_mp_alloc * sizeof(mp_limb_t)); } return 0; } - -static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, int ground USES_REGS) -{ +static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, + int ground USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); Int sz = 0; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; @@ -3282,64 +3182,62 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - sz += 2; - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - sz += SizeOfExtension(d0); - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - sz += (1+d0); - pt0 = ap2; - pt0_end = ap2 + d0; + vars_in_term_nvar : { + if (IsPairTerm(d0)) { + sz += 2; + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } - continue; - } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + sz += SizeOfExtension(d0); + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + sz += (1 + d0); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); if (!ground) @@ -3370,7 +3268,7 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in } return sz; - aux_overflow: +aux_overflow: /* unwind stack */ #ifdef RATIONAL_TREES while (to_visit > to_visit0) { @@ -3382,124 +3280,117 @@ static Int sz_ground_complex_term(register CELL *pt0, register CELL *pt0_end, in return -1; } -int -Yap_SizeGroundTerm(Term t, int ground) -{ +int Yap_SizeGroundTerm(Term t, int ground) { CACHE_REGS if (IsVarTerm(t)) { if (!ground) return 1; return 0; - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return 1; } else if (IsPairTerm(t)) { - int sz = sz_ground_complex_term(RepPair(t)-1, RepPair(t)+1, ground PASS_REGS); + int sz = sz_ground_complex_term(RepPair(t) - 1, RepPair(t) + 1, + ground PASS_REGS); if (sz <= 0) return sz; - return sz+2; -} else { - int sz = 0; - Functor fun = FunctorOfTerm(t); + return sz + 2; + } else { + int sz = 0; + Functor fun = FunctorOfTerm(t); - if (IsExtensionFunctor(fun)) - return 1+ SizeOfExtension(t); + if (IsExtensionFunctor(fun)) + return 1 + SizeOfExtension(t); - sz = sz_ground_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(fun), - ground PASS_REGS); - if (sz <= 0) - return sz; - return 1+ArityOfFunctor(fun)+sz; + sz = sz_ground_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(fun), + ground PASS_REGS); + if (sz <= 0) + return sz; + return 1 + ArityOfFunctor(fun) + sz; } } -static Int var_in_complex_term(register CELL *pt0, - register CELL *pt0_end, - Term v USES_REGS) -{ +static Int var_in_complex_term(register CELL *pt0, register CELL *pt0_end, + Term v USES_REGS) { register CELL **to_visit0, **to_visit = (CELL **)Yap_PreAllocCodeSpace(); register tr_fr_ptr TR0 = TR; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, var_in_term_unk); - var_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - continue; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - - continue; - } - if (to_visit + 1024 >= (CELL **)AuxSp) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = (CELL *)*pt0; - to_visit += 3; - *pt0 = TermNil; -#else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + var_in_term_nvar : { + if (IsPairTerm(d0)) { + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; continue; - } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + + continue; + } + if (to_visit + 1024 >= (CELL **)AuxSp) { + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = (CELL *)*pt0; + to_visit += 3; + *pt0 = TermNil; +#else + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } deref_body(d0, ptd0, var_in_term_unk, var_in_term_nvar); if ((CELL)ptd0 == v) { /* we found it */ #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit -= 3; - pt0 = to_visit[0]; - *pt0 = (CELL)to_visit[2]; + to_visit -= 3; + pt0 = to_visit[0]; + *pt0 = (CELL)to_visit[2]; } #endif clean_tr(TR0 PASS_REGS); - return(TRUE); + return (TRUE); } /* do or pt2 are unbound */ *ptd0 = TermNil; @@ -3530,8 +3421,7 @@ static Int var_in_complex_term(register CELL *pt0, clean_tr(TR0 PASS_REGS); return FALSE; - - aux_overflow: +aux_overflow: /* unwind stack */ #ifdef RATIONAL_TREES while (to_visit > to_visit0) { @@ -3543,34 +3433,30 @@ static Int var_in_complex_term(register CELL *pt0, return -1; } -static Int -var_in_term(Term v, Term t USES_REGS) /* variables in term t */ +static Int var_in_term(Term v, + Term t USES_REGS) /* variables in term t */ { if (IsVarTerm(t)) { - return(v == t); + return (v == t); } else if (IsPrimitiveTerm(t)) { - return(FALSE); + return (FALSE); } else if (IsPairTerm(t)) { - return(var_in_complex_term(RepPair(t)-1, - RepPair(t)+1,v PASS_REGS)); - } - else return(var_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(FunctorOfTerm(t)),v PASS_REGS)); + return (var_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, v PASS_REGS)); + } else + return (var_in_complex_term(RepAppl(t), + RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), + v PASS_REGS)); } -static Int -p_var_in_term( USES_REGS1 ) -{ - return(var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS)); +static Int p_var_in_term(USES_REGS1) { + return (var_in_term(Deref(ARG2), Deref(ARG1) PASS_REGS)); } /* The code for TermHash was originally contributed by Gertjen Van Noor */ /* This code with max_depth == -1 will loop for infinite trees */ - //----------------------------------------------------------------------------- // MurmurHash2, by Austin Appleby @@ -3585,200 +3471,188 @@ p_var_in_term( USES_REGS1 ) // 2. It will not produce the same results on little-endian and big-endian // machines. -static unsigned int -MurmurHashNeutral2 ( const void * key, int len, unsigned int seed ) -{ - const unsigned int m = 0x5bd1e995; - const int r = 24; +static unsigned int MurmurHashNeutral2(const void *key, int len, + unsigned int seed) { + const unsigned int m = 0x5bd1e995; + const int r = 24; - unsigned int h = seed ^ len; + unsigned int h = seed ^ len; - const unsigned char * data = (const unsigned char *)key; + const unsigned char *data = (const unsigned char *)key; - while(len >= 4) - { - unsigned int k; + while (len >= 4) { + unsigned int k; - k = data[0]; - k |= data[1] << 8; - k |= data[2] << 16; - k |= data[3] << 24; + k = data[0]; + k |= data[1] << 8; + k |= data[2] << 16; + k |= data[3] << 24; - k *= m; - k ^= k >> r; - k *= m; + k *= m; + k ^= k >> r; + k *= m; - h *= m; - h ^= k; + h *= m; + h ^= k; - data += 4; - len -= 4; - } + data += 4; + len -= 4; + } - switch(len) - { - case 3: h ^= data[2] << 16; - case 2: h ^= data[1] << 8; - case 1: h ^= data[0]; - h *= m; - }; + switch (len) { + case 3: + h ^= data[2] << 16; + case 2: + h ^= data[1] << 8; + case 1: + h ^= data[0]; + h *= m; + }; - h ^= h >> 13; - h *= m; - h ^= h >> 15; + h ^= h >> 13; + h *= m; + h ^= h >> 15; - return h; + return h; } -static CELL * -addAtomToHash(CELL *st, Atom at) -{ +static CELL *addAtomToHash(CELL *st, Atom at) { unsigned int len; - char *c = RepAtom(at)->StrOfAE; - int ulen = strlen(c); - /* fix hashing over empty atom */ - if (!ulen) { - return st; - } - if (ulen % CellSize == 0) { - len = ulen/CellSize; - } else { - len = ulen/CellSize; - len++; - } - st[len-1] = 0L; - strncpy((char *)st, c, ulen); - return st+len; + char *c = RepAtom(at)->StrOfAE; + int ulen = strlen(c); + /* fix hashing over empty atom */ + if (!ulen) { + return st; + } + if (ulen % CellSize == 0) { + len = ulen / CellSize; + } else { + len = ulen / CellSize; + len++; + } + st[len - 1] = 0L; + strncpy((char *)st, c, ulen); + return st + len; } typedef struct visited { CELL *start; - CELL *end; + CELL *end; CELL old; UInt vdepth; } visited_t; -static CELL * -hash_complex_term(register CELL *pt0, - register CELL *pt0_end, - Int depth, - CELL *st, - int variant USES_REGS) -{ - register visited_t *to_visit0, *to_visit = (visited_t *)Yap_PreAllocCodeSpace(); +static CELL *hash_complex_term(register CELL *pt0, register CELL *pt0_end, + Int depth, CELL *st, int variant USES_REGS) { + register visited_t *to_visit0, + *to_visit = (visited_t *)Yap_PreAllocCodeSpace(); to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, hash_complex_unk); - hash_complex_nvar: - { - if (st + 1024 >= ASP) { - goto global_overflow; - } - if (IsAtomOrIntTerm(d0)) { - if (d0 != TermFoundVar) { - if (IsAtomTerm(d0)) { - st = addAtomToHash(st, AtomOfTerm(d0)); - } else { - *st++ = IntOfTerm(d0); - } - } - continue; - } else if (IsPairTerm(d0)) { - st = addAtomToHash(st, AtomDot); - if (depth == 1) - continue; - if (to_visit + 256 >= (visited_t *)AuxSp) { - goto aux_overflow; - } - to_visit->start = pt0; - to_visit->end = pt0_end; - to_visit->old = *pt0; - to_visit->vdepth = depth; - to_visit++; - depth--; - *pt0 = TermFoundVar; - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - continue; - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - CELL fc = (CELL)f; - - switch(fc) { - - case (CELL)FunctorDBRef: - *st++ = fc; - break; - case (CELL)FunctorLongInt: - *st++ = LongIntOfTerm(d0); - break; - case (CELL)FunctorString: - memmove(st, RepAppl(d0), (3+RepAppl(d0)[1])*sizeof(CELL)); - st += 3+RepAppl(d0)[1]; - break; -#ifdef USE_GMP - case (CELL)FunctorBigInt: - { - CELL *pt = RepAppl(d0); - Int sz = - sizeof(MP_INT)+1+ - (((MP_INT *)(pt+2))->_mp_alloc*sizeof(mp_limb_t)); - - if (st + (1024 + sz/CellSize) >= ASP) { - goto global_overflow; - } - /* then the actual number */ - memmove((void *)(st+1), (void *)(pt+1), sz); - st = st+sz/CellSize; - } - break; -#endif - case (CELL)FunctorDouble: - { - CELL *pt = RepAppl(d0); - *st++ = pt[1]; -#if SIZEOF_DOUBLE == 2*SIZEOF_INT_P - *st++ = pt[2]; -#endif - break; - } - } - continue; - } - st = addAtomToHash(st, NameOfFunctor(f)); - if (depth == 1) - continue; - if (to_visit + 1024 >= (visited_t *)AuxSp) { - goto aux_overflow; - } - to_visit->start = pt0; - to_visit->end = pt0_end; - to_visit->old = *pt0; - to_visit->vdepth = depth; - to_visit++; - depth--; - *pt0 = TermFoundVar; - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; + hash_complex_nvar : { + if (st + 1024 >= ASP) { + goto global_overflow; + } + if (IsAtomOrIntTerm(d0)) { + if (d0 != TermFoundVar) { + if (IsAtomTerm(d0)) { + st = addAtomToHash(st, AtomOfTerm(d0)); + } else { + *st++ = IntOfTerm(d0); + } } continue; - } + } else if (IsPairTerm(d0)) { + st = addAtomToHash(st, AtomDot); + if (depth == 1) + continue; + if (to_visit + 256 >= (visited_t *)AuxSp) { + goto aux_overflow; + } + to_visit->start = pt0; + to_visit->end = pt0_end; + to_visit->old = *pt0; + to_visit->vdepth = depth; + to_visit++; + depth--; + *pt0 = TermFoundVar; + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + continue; + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + CELL fc = (CELL)f; + + switch (fc) { + + case (CELL)FunctorDBRef: + *st++ = fc; + break; + case (CELL)FunctorLongInt: + *st++ = LongIntOfTerm(d0); + break; + case (CELL)FunctorString: + memmove(st, RepAppl(d0), (3 + RepAppl(d0)[1]) * sizeof(CELL)); + st += 3 + RepAppl(d0)[1]; + break; +#ifdef USE_GMP + case (CELL)FunctorBigInt: { + CELL *pt = RepAppl(d0); + Int sz = sizeof(MP_INT) + 1 + + (((MP_INT *)(pt + 2))->_mp_alloc * sizeof(mp_limb_t)); + + if (st + (1024 + sz / CellSize) >= ASP) { + goto global_overflow; + } + /* then the actual number */ + memmove((void *)(st + 1), (void *)(pt + 1), sz); + st = st + sz / CellSize; + } break; +#endif + case (CELL)FunctorDouble: { + CELL *pt = RepAppl(d0); + *st++ = pt[1]; +#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P + *st++ = pt[2]; +#endif + break; + } + } + continue; + } + st = addAtomToHash(st, NameOfFunctor(f)); + if (depth == 1) + continue; + if (to_visit + 1024 >= (visited_t *)AuxSp) { + goto aux_overflow; + } + to_visit->start = pt0; + to_visit->end = pt0_end; + to_visit->old = *pt0; + to_visit->vdepth = depth; + to_visit++; + depth--; + *pt0 = TermFoundVar; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + } + continue; + } deref_body(d0, ptd0, hash_complex_unk, hash_complex_nvar); if (!variant) @@ -3797,50 +3671,50 @@ hash_complex_term(register CELL *pt0, } return st; - aux_overflow: +aux_overflow: /* unwind stack */ while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start; *pt0 = to_visit->old; } return (CELL *)-1; - global_overflow: +global_overflow: /* unwind stack */ while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start; *pt0 = to_visit->old; } - return (CELL *) -2; + return (CELL *)-2; } -Int -Yap_TermHash(Term t, Int size, Int depth, int variant) -{ +Int Yap_TermHash(Term t, Int size, Int depth, int variant) { CACHE_REGS unsigned int i1; Term t1 = Deref(t); while (TRUE) { - CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, FALSE PASS_REGS); + CELL *ar = hash_complex_term(&t1 - 1, &t1, depth, HR, FALSE PASS_REGS); if (ar == (CELL *)-1) { if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in term_hash"); - return FALSE; + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, + "overflow in term_hash"); + return FALSE; } t1 = Deref(ARG1); - } else if(ar == (CELL *)-2) { - if (!Yap_gcl((ASP-HR)*sizeof(CELL), 0, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash"); - return FALSE; + } else if (ar == (CELL *)-2) { + if (!Yap_gcl((ASP - HR) * sizeof(CELL), 0, ENV, gc_P(P, CP))) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash"); + return FALSE; } t1 = Deref(ARG1); } else if (ar == NULL) { return FALSE; } else { - i1 = MurmurHashNeutral2((const void *)HR, CellSize*(ar-HR),0x1a3be34a); + i1 = MurmurHashNeutral2((const void *)HR, CellSize * (ar - HR), + 0x1a3be34a); break; } } @@ -3848,9 +3722,7 @@ Yap_TermHash(Term t, Int size, Int depth, int variant) return i1 % size; } -static Int -p_term_hash( USES_REGS1 ) -{ +static Int p_term_hash(USES_REGS1) { unsigned int i1; Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); @@ -3859,56 +3731,57 @@ p_term_hash( USES_REGS1 ) Int size, depth; if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"term_hash/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "term_hash/4"); + return (FALSE); } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "term_hash/4"); + return (FALSE); } depth = IntegerOfTerm(t2); if (depth == 0) { - if (IsVarTerm(t1)) return(TRUE); - return(Yap_unify(ARG4,MkIntTerm(0))); + if (IsVarTerm(t1)) + return (TRUE); + return (Yap_unify(ARG4, MkIntTerm(0))); } if (IsVarTerm(t3)) { - Yap_Error(INSTANTIATION_ERROR,t3,"term_hash/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t3, "term_hash/4"); + return (FALSE); } if (!IsIntegerTerm(t3)) { - Yap_Error(TYPE_ERROR_INTEGER,t3,"term_hash/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t3, "term_hash/4"); + return (FALSE); } size = IntegerOfTerm(t3); while (TRUE) { - CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, FALSE PASS_REGS); + CELL *ar = hash_complex_term(&t1 - 1, &t1, depth, HR, FALSE PASS_REGS); if (ar == (CELL *)-1) { if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in term_hash"); - return FALSE; + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, + "overflow in term_hash"); + return FALSE; } t1 = Deref(ARG1); - } else if(ar == (CELL *)-2) { - if (!Yap_gcl((ASP-HR)*sizeof(CELL), 4, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash"); - return FALSE; + } else if (ar == (CELL *)-2) { + if (!Yap_gcl((ASP - HR) * sizeof(CELL), 4, ENV, gc_P(P, CP))) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash"); + return FALSE; } t1 = Deref(ARG1); } else if (ar == NULL) { return FALSE; } else { - i1 = MurmurHashNeutral2((const void *)HR, CellSize*(ar-HR),0x1a3be34a); + i1 = MurmurHashNeutral2((const void *)HR, CellSize * (ar - HR), + 0x1a3be34a); break; } } /* got the seed and hash from SWI-Prolog */ result = MkIntegerTerm(i1 % size); - return Yap_unify(ARG4,result); + return Yap_unify(ARG4, result); } -static Int -p_instantiated_term_hash( USES_REGS1 ) -{ +static Int p_instantiated_term_hash(USES_REGS1) { unsigned int i1; Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); @@ -3917,170 +3790,173 @@ p_instantiated_term_hash( USES_REGS1 ) Int size, depth; if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"term_hash/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t2, "term_hash/4"); + return (FALSE); } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "term_hash/4"); + return (FALSE); } depth = IntegerOfTerm(t2); if (depth == 0) { - if (IsVarTerm(t1)) return(TRUE); - return(Yap_unify(ARG4,MkIntTerm(0))); + if (IsVarTerm(t1)) + return (TRUE); + return (Yap_unify(ARG4, MkIntTerm(0))); } if (IsVarTerm(t3)) { - Yap_Error(INSTANTIATION_ERROR,t3,"term_hash/4"); - return(FALSE); + Yap_Error(INSTANTIATION_ERROR, t3, "term_hash/4"); + return (FALSE); } if (!IsIntegerTerm(t3)) { - Yap_Error(TYPE_ERROR_INTEGER,t3,"term_hash/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t3, "term_hash/4"); + return (FALSE); } size = IntegerOfTerm(t3); while (TRUE) { - CELL *ar = hash_complex_term(&t1-1, &t1, depth, HR, TRUE PASS_REGS); + CELL *ar = hash_complex_term(&t1 - 1, &t1, depth, HR, TRUE PASS_REGS); if (ar == (CELL *)-1) { if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) { - Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, "overflow in term_hash"); - return FALSE; + Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, + "overflow in term_hash"); + return FALSE; } t1 = Deref(ARG1); - } else if(ar == (CELL *)-2) { - if (!Yap_gcl((ASP-HR)*sizeof(CELL), 4, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash"); - return FALSE; + } else if (ar == (CELL *)-2) { + if (!Yap_gcl((ASP - HR) * sizeof(CELL), 4, ENV, gc_P(P, CP))) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_hash"); + return FALSE; } t1 = Deref(ARG1); } else if (ar == NULL) { return FALSE; } else { - i1 = MurmurHashNeutral2((const void *)HR, CellSize*(ar-HR),0x1a3be34a); + i1 = MurmurHashNeutral2((const void *)HR, CellSize * (ar - HR), + 0x1a3be34a); break; } } /* got the seed and hash from SWI-Prolog */ result = MkIntegerTerm(i1 % size); - return Yap_unify(ARG4,result); + return Yap_unify(ARG4, result); } -static int variant_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) -{ +static int variant_complex(register CELL *pt0, register CELL *pt0_end, + register CELL *pt1 USES_REGS) { tr_fr_ptr OLDTR = TR; register CELL **to_visit = (CELL **)ASP; /* make sure that unification always forces trailing */ HBREG = HR; - - loop: +loop: while (pt0 < pt0_end) { register CELL d0, d1; - ++ pt0; - ++ pt1; + ++pt0; + ++pt1; d0 = Derefa(pt0); d1 = Derefa(pt1); if (IsVarTerm(d0)) { if (IsVarTerm(d1)) { - CELL *pt0 = VarOfTerm(d0); - CELL *pt1 = VarOfTerm(d1); - if (pt0 >= HBREG || pt1 >= HBREG) { - /* one of the variables has been found before */ - if (VarOfTerm(d0)+1 == VarOfTerm(d1)) continue; - goto fail; - } else { - /* two new occurrences of the same variable */ - Term n0 = MkVarTerm(), n1 = MkVarTerm(); - Bind_Global(VarOfTerm(d0), n0); - Bind_Global(VarOfTerm(d1), n1); - } - continue; + CELL *pt0 = VarOfTerm(d0); + CELL *pt1 = VarOfTerm(d1); + if (pt0 >= HBREG || pt1 >= HBREG) { + /* one of the variables has been found before */ + if (VarOfTerm(d0) + 1 == VarOfTerm(d1)) + continue; + goto fail; + } else { + /* two new occurrences of the same variable */ + Term n0 = MkVarTerm(), n1 = MkVarTerm(); + Bind_Global(VarOfTerm(d0), n0); + Bind_Global(VarOfTerm(d1), n1); + } + continue; } else { - goto fail; + goto fail; } } else if (IsVarTerm(d1)) { goto fail; } else { - if (d0 == d1) continue; + if (d0 == d1) + continue; else if (IsAtomOrIntTerm(d0)) { - goto fail; + goto fail; } else if (IsPairTerm(d0)) { - if (!IsPairTerm(d1)) { - goto fail; - } + if (!IsPairTerm(d1)) { + goto fail; + } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 4; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 4; + if ((CELL *)to_visit < HR + 1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + *pt0 = d1; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit -= 3; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit -= 3; + if ((CELL *)to_visit < HR + 1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + } #endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - pt1 = RepPair(d1) - 1; - continue; + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + pt1 = RepPair(d1) - 1; + continue; } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2, *ap3; - if (!IsApplTerm(d1)) { - goto fail; - } else { - /* store the terms to visit */ - Functor f2; - ap2 = RepAppl(d0); - ap3 = RepAppl(d1); - f = (Functor)(*ap2); - f2 = (Functor)(*ap3); - if (f != f2) - goto fail; - if (IsExtensionFunctor(f)) { - if (!unify_extension(f, d0, ap2, d1)) - goto fail; - continue; - } + register Functor f; + register CELL *ap2, *ap3; + if (!IsApplTerm(d1)) { + goto fail; + } else { + /* store the terms to visit */ + Functor f2; + ap2 = RepAppl(d0); + ap3 = RepAppl(d1); + f = (Functor)(*ap2); + f2 = (Functor)(*ap3); + if (f != f2) + goto fail; + if (IsExtensionFunctor(f)) { + if (!unify_extension(f, d0, ap2, d1)) + goto fail; + continue; + } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 4; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 4; + if ((CELL *)to_visit < HR + 1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + *pt0 = d1; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit -= 3; - if ((CELL *)to_visit < HR+1024) - goto out_of_stack; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit -= 3; + if ((CELL *)to_visit < HR + 1024) + goto out_of_stack; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + } #endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - pt1 = ap3; - continue; - } + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + pt1 = ap3; + continue; + } } } } @@ -4104,13 +3980,13 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register HR = HBREG; /* untrail all bindings made by variant */ while (TR != (tr_fr_ptr)OLDTR) { - CELL *pt1 = (CELL *) TrailTerm(--TR); + CELL *pt1 = (CELL *)TrailTerm(--TR); RESET_VARIABLE(pt1); } HBREG = B->cp_h; return TRUE; - out_of_stack: +out_of_stack: HR = HBREG; /* untrail all bindings made by variant */ #ifdef RATIONAL_TREES @@ -4123,14 +3999,13 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register } #endif while (TR != (tr_fr_ptr)OLDTR) { - CELL *pt1 = (CELL *) TrailTerm(--TR); + CELL *pt1 = (CELL *)TrailTerm(--TR); RESET_VARIABLE(pt1); } HBREG = B->cp_h; return -1; - - fail: +fail: /* failure */ HR = HBREG; #ifdef RATIONAL_TREES @@ -4144,16 +4019,14 @@ static int variant_complex(register CELL *pt0, register CELL *pt0_end, register #endif /* untrail all bindings made by variant */ while (TR != (tr_fr_ptr)OLDTR) { - CELL *pt1 = (CELL *) TrailTerm(--TR); + CELL *pt1 = (CELL *)TrailTerm(--TR); RESET_VARIABLE(pt1); } HBREG = B->cp_h; return FALSE; } -static bool -is_variant(Term t1, Term t2, int parity USES_REGS) -{ +static bool is_variant(Term t1, Term t2, int parity USES_REGS) { int out; if (t1 == t2) @@ -4165,36 +4038,37 @@ is_variant(Term t1, Term t2, int parity USES_REGS) } else if (IsVarTerm(t2)) return false; if (IsAtomOrIntTerm(t1)) { - return(t1 == t2); + return (t1 == t2); } if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { - out = variant_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1 PASS_REGS); - if (out < 0) goto error; + out = variant_complex(RepPair(t1) - 1, RepPair(t1) + 1, + RepPair(t2) - 1 PASS_REGS); + if (out < 0) + goto error; return out != 0; - } - else return false; + } else + return false; } if (!IsApplTerm(t2)) { return false; } else { Functor f1 = FunctorOfTerm(t1); - if (f1 != FunctorOfTerm(t2)) return(FALSE); + if (f1 != FunctorOfTerm(t2)) + return (FALSE); if (IsExtensionFunctor(f1)) { - return(unify_extension(f1, t1, RepAppl(t1), t2)); + return (unify_extension(f1, t1, RepAppl(t1), t2)); } - out = variant_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2) PASS_REGS); - if (out < 0) goto error; + out = variant_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(f1), + RepAppl(t2) PASS_REGS); + if (out < 0) + goto error; return out != 0; } - error: +error: if (out == -1) { - if (!Yap_gcl((ASP-HR)*sizeof(CELL), parity, ENV, gc_P(P,CP))) { + if (!Yap_gcl((ASP - HR) * sizeof(CELL), parity, ENV, gc_P(P, CP))) { Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in variant"); return FALSE; } @@ -4203,36 +4077,30 @@ is_variant(Term t1, Term t2, int parity USES_REGS) return false; } -bool -Yap_Variant(Term t1, Term t2) -{ +bool Yap_Variant(Term t1, Term t2) { CACHE_REGS return is_variant(t1, t2, 0 PASS_REGS); } -static Int -p_variant( USES_REGS1 ) /* variant terms t1 and t2 */ +static Int p_variant(USES_REGS1) /* variant terms t1 and t2 */ { return is_variant(Deref(ARG1), Deref(ARG2), 2 PASS_REGS); } - -static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1 USES_REGS) -{ +static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, + register CELL *pt1 USES_REGS) { register CELL **to_visit = (CELL **)ASP; tr_fr_ptr OLDTR = TR, new_tr; UInt write_mode = TRUE; - HBREG = HR; - loop: +loop: while (pt0 < pt0_end) { register CELL d0, d1; Int our_write_mode = write_mode; - ++ pt0; - ++ pt1; + ++pt0; + ++pt1; /* this is a version of Derefa that checks whether we are trying to do something evil */ { @@ -4240,14 +4108,12 @@ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register restart_d0: if (npt0 >= HBREG) { - our_write_mode = FALSE; + our_write_mode = FALSE; } d0 = *npt0; - if (IsVarTerm(d0) && - d0 != (CELL)npt0 - ) { - npt0 = (CELL *)d0; - goto restart_d0; + if (IsVarTerm(d0) && d0 != (CELL)npt0) { + npt0 = (CELL *)d0; + goto restart_d0; } } { @@ -4255,116 +4121,117 @@ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register restart_d1: d1 = *npt1; - if (IsVarTerm(d1) - && d1 != (CELL)npt1 - ) { - /* never dereference through a variable from the left-side */ - if (npt1 >= HBREG) { - goto fail; - } else { - npt1 = (CELL *)d1; - goto restart_d1; - } + if (IsVarTerm(d1) && d1 != (CELL)npt1) { + /* never dereference through a variable from the left-side */ + if (npt1 >= HBREG) { + goto fail; + } else { + npt1 = (CELL *)d1; + goto restart_d1; + } } } if (IsVarTerm(d0)) { if (our_write_mode) { - /* generate a new binding */ - CELL *pt0 = VarOfTerm(d0); - Term new = MkVarTerm(); + /* generate a new binding */ + CELL *pt0 = VarOfTerm(d0); + Term new = MkVarTerm(); - Bind_Global(pt0, new); - if (d0 != d1) { /* avoid loops */ - Bind_Global(VarOfTerm(new), d1); - if (Yap_rational_tree_loop(VarOfTerm(new)-1,VarOfTerm(new),(CELL **)AuxSp,(CELL **)AuxBase)) - goto fail; - } + Bind_Global(pt0, new); + if (d0 != d1) { /* avoid loops */ + Bind_Global(VarOfTerm(new), d1); + if (Yap_rational_tree_loop(VarOfTerm(new) - 1, VarOfTerm(new), + (CELL **)AuxSp, (CELL **)AuxBase)) + goto fail; + } } else { - if (d0 == d1) continue; - goto fail; + if (d0 == d1) + continue; + goto fail; } continue; } else if (IsVarTerm(d1)) { goto fail; } else { - if (d0 == d1) continue; + if (d0 == d1) + continue; else if (IsAtomOrIntTerm(d0)) { - goto fail; + goto fail; } else if (IsPairTerm(d0)) { - if (!IsPairTerm(d1)) { - goto fail; - } + if (!IsPairTerm(d1)) { + goto fail; + } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 5; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - to_visit[4] = (CELL *)write_mode; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 5; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + to_visit[4] = (CELL *)write_mode; + *pt0 = d1; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit -= 4; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)write_mode; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit -= 4; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)write_mode; + } #endif - write_mode = our_write_mode; - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - pt1 = RepPair(d1) - 1; - continue; + write_mode = our_write_mode; + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + pt1 = RepPair(d1) - 1; + continue; } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2, *ap3; - if (!IsApplTerm(d1)) { - goto fail; - } else { - /* store the terms to visit */ - Functor f2; - ap2 = RepAppl(d0); - ap3 = RepAppl(d1); - f = (Functor)(*ap2); - f2 = (Functor)(*ap3); - if (f != f2) - goto fail; - if (IsExtensionFunctor(f)) { - if (!unify_extension(f, d0, ap2, d1)) - goto fail; - continue; - } + register Functor f; + register CELL *ap2, *ap3; + if (!IsApplTerm(d1)) { + goto fail; + } else { + /* store the terms to visit */ + Functor f2; + ap2 = RepAppl(d0); + ap3 = RepAppl(d1); + f = (Functor)(*ap2); + f2 = (Functor)(*ap3); + if (f != f2) + goto fail; + if (IsExtensionFunctor(f)) { + if (!unify_extension(f, d0, ap2, d1)) + goto fail; + continue; + } #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 5; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)*pt0; - to_visit[4] = (CELL *)write_mode; - *pt0 = d1; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 5; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)*pt0; + to_visit[4] = (CELL *)write_mode; + *pt0 = d1; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit -= 4; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = (CELL *)write_mode; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit -= 4; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = (CELL *)write_mode; + } #endif - write_mode = our_write_mode; - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - pt1 = ap3; - continue; - } + write_mode = our_write_mode; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + pt1 = ap3; + continue; + } } } } @@ -4375,7 +4242,7 @@ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register pt0_end = to_visit[1]; pt1 = to_visit[2]; *pt0 = (CELL)to_visit[3]; - write_mode = (Int)to_visit[ 4]; + write_mode = (Int)to_visit[4]; to_visit += 5; #else pt0 = to_visit[0]; @@ -4392,7 +4259,7 @@ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register new_tr = TR; while (TR != OLDTR) { /* cell we bound */ - CELL *pt1 = (CELL *) TrailTerm(--TR); + CELL *pt1 = (CELL *)TrailTerm(--TR); /* cell we created */ CELL *npt1 = (CELL *)*pt1; /* shorten the chain */ @@ -4406,7 +4273,7 @@ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register HBREG = B->cp_h; return TRUE; - fail: +fail: HR = HBREG; #ifdef RATIONAL_TREES while (to_visit < (CELL **)ASP) { @@ -4419,15 +4286,14 @@ static int subsumes_complex(register CELL *pt0, register CELL *pt0_end, register #endif /* untrail all bindings made by variant */ while (TR != (tr_fr_ptr)OLDTR) { - CELL *pt1 = (CELL *) TrailTerm(--TR); + CELL *pt1 = (CELL *)TrailTerm(--TR); RESET_VARIABLE(pt1); } HBREG = B->cp_h; return FALSE; } -static Int -p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ +static Int p_subsumes(USES_REGS1) /* subsumes terms t1 and t2 */ { Term t1 = Deref(ARG1); Term t2 = Deref(ARG2); @@ -4436,53 +4302,51 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */ return (TRUE); if (IsVarTerm(t1)) { YapBind(VarOfTerm(t1), t2); - if (Yap_rational_tree_loop(VarOfTerm(t1)-1,VarOfTerm(t1),(CELL **)AuxSp,(CELL **)AuxBase)) + if (Yap_rational_tree_loop(VarOfTerm(t1) - 1, VarOfTerm(t1), (CELL **)AuxSp, + (CELL **)AuxBase)) return FALSE; return TRUE; } else if (IsVarTerm(t2)) - return(FALSE); + return (FALSE); if (IsAtomOrIntTerm(t1)) { - return(t1 == t2); + return (t1 == t2); } if (IsPairTerm(t1)) { if (IsPairTerm(t2)) { - return(subsumes_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1 PASS_REGS)); - } - else return (FALSE); + return (subsumes_complex(RepPair(t1) - 1, RepPair(t1) + 1, + RepPair(t2) - 1 PASS_REGS)); + } else + return (FALSE); } else { Functor f1; - if (!IsApplTerm(t2)) return(FALSE); + if (!IsApplTerm(t2)) + return (FALSE); f1 = FunctorOfTerm(t1); if (f1 != FunctorOfTerm(t2)) - return(FALSE); + return (FALSE); if (IsExtensionFunctor(f1)) { - return(unify_extension(f1, t1, RepAppl(t1), t2)); + return (unify_extension(f1, t1, RepAppl(t1), t2)); } - return(subsumes_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2) PASS_REGS)); + return (subsumes_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(f1), + RepAppl(t2) PASS_REGS)); } } - -static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, register - CELL *pt1, CELL *npt USES_REGS) -{ +static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, + register CELL *pt1, CELL *npt USES_REGS) { register CELL **to_visit = (CELL **)ASP; tr_fr_ptr OLDTR = TR; int out; CELL *bindings = NULL, *tbindings = NULL; HB = HR; - loop: +loop: while (pt0 < pt0_end) { register CELL d0, d1; - ++ pt0; - ++ pt1; + ++pt0; + ++pt1; d0 = Derefa(pt0); d1 = Derefa(pt1); if (d0 == d1) { @@ -4493,38 +4357,38 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg match = VarOfTerm(d0); if (match >= HB) { - while (match >= HB) { - /* chained to a sequence */ - if (Yap_eq(d1, match[1]) ) { - *npt++ = match[2]; - break; - } - omatch = match; - match = (CELL *)match[3]; - } - /* found a match */ - if (match >= HB) - continue; - /* could not find a match, add to end of chain */ - RESET_VARIABLE(HR); /* key */ - HR[1] = d1; /* comparison value */ - HR[2] = (CELL)npt; /* new value */ - HR[3] = (CELL)match; /* end of chain points back to first cell */ - omatch[3] = (CELL)HR; - HR+=4; - RESET_VARIABLE(npt); - npt++; - continue; + while (match >= HB) { + /* chained to a sequence */ + if (Yap_eq(d1, match[1])) { + *npt++ = match[2]; + break; + } + omatch = match; + match = (CELL *)match[3]; + } + /* found a match */ + if (match >= HB) + continue; + /* could not find a match, add to end of chain */ + RESET_VARIABLE(HR); /* key */ + HR[1] = d1; /* comparison value */ + HR[2] = (CELL)npt; /* new value */ + HR[3] = (CELL)match; /* end of chain points back to first cell */ + omatch[3] = (CELL)HR; + HR += 4; + RESET_VARIABLE(npt); + npt++; + continue; } if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { - goto trail_overflow; + goto trail_overflow; } RESET_VARIABLE(HR); HR[1] = d1; HR[2] = (CELL)npt; HR[3] = d0; YapBind(VarOfTerm(d0), (CELL)HR); - HR+=4; + HR += 4; RESET_VARIABLE(npt); npt++; continue; @@ -4532,26 +4396,26 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg CELL *match = bindings; while (match) { - if (match[0] == d0 && match[1] == d1) { - *npt++ = match[2]; - break; - } - match = (CELL *)match[3]; + if (match[0] == d0 && match[1] == d1) { + *npt++ = match[2]; + break; + } + match = (CELL *)match[3]; } if (match) { - continue; + continue; } if (bindings) { - *tbindings = (CELL)HR; + *tbindings = (CELL)HR; } else { - bindings = HR; + bindings = HR; } HR[0] = d0; HR[1] = d1; - HR[2] = AbsPair(HR+4); + HR[2] = AbsPair(HR + 4); HR[3] = (CELL)NULL; - tbindings = HR+3; - HR+=4; + tbindings = HR + 3; + HR += 4; *npt++ = AbsPair(HR); #ifdef RATIONAL_TREES /* now link the two structures so that no one else will */ @@ -4565,11 +4429,11 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg #else /* store the terms to visit */ if (pt0 < pt0_end) { - to_visit -= 4; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = npt; + to_visit -= 4; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = npt; } #endif pt0 = RepPair(d0) - 1; @@ -4577,8 +4441,8 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg pt1 = RepPair(d1) - 1; npt = HR; HR += 2; - if (HR > (CELL *)to_visit -1024) - goto stack_overflow; + if (HR > (CELL *)to_visit - 1024) + goto stack_overflow; continue; } else if (IsApplTerm(d0) && IsApplTerm(d1)) { CELL *ap2 = RepAppl(d0); @@ -4586,65 +4450,65 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg Functor f = (Functor)(*ap2); Functor f2 = (Functor)(*ap3); if (f == f2) { - CELL *match = bindings; + CELL *match = bindings; - if (IsExtensionFunctor(f)) { - if (unify_extension(f, d0, ap2, d1)) { - *npt++ = d0; - continue; - } - } - while (match) { - if (match[0] == d0 && match[1] == d1) { - *npt++ = match[2]; - break; - } - match = (CELL *)match[3]; - } - if (match) { - continue; - } - if (bindings) { - *tbindings = (CELL)HR; - } else { - bindings = HR; - } - HR[0] = d0; - HR[1] = d1; - HR[2] = AbsAppl(HR+4); - HR[3] = (CELL)NULL; - tbindings = HR+3; - HR+=4; - *npt++ = AbsAppl(HR); + if (IsExtensionFunctor(f)) { + if (unify_extension(f, d0, ap2, d1)) { + *npt++ = d0; + continue; + } + } + while (match) { + if (match[0] == d0 && match[1] == d1) { + *npt++ = match[2]; + break; + } + match = (CELL *)match[3]; + } + if (match) { + continue; + } + if (bindings) { + *tbindings = (CELL)HR; + } else { + bindings = HR; + } + HR[0] = d0; + HR[1] = d1; + HR[2] = AbsAppl(HR + 4); + HR[3] = (CELL)NULL; + tbindings = HR + 3; + HR += 4; + *npt++ = AbsAppl(HR); #ifdef RATIONAL_TREES - /* now link the two structures so that no one else will */ - /* come here */ - to_visit -= 5; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = tbindings; - to_visit[4] = npt; + /* now link the two structures so that no one else will */ + /* come here */ + to_visit -= 5; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = tbindings; + to_visit[4] = npt; #else - /* store the terms to visit */ - if (pt0 < pt0_end) { - to_visit -= 4; - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit[2] = pt1; - to_visit[3] = npt; - } + /* store the terms to visit */ + if (pt0 < pt0_end) { + to_visit -= 4; + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit[2] = pt1; + to_visit[3] = npt; + } #endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - pt1 = ap3; - npt = HR; - *npt++ = (CELL)f; - HR += d0; - if (HR > (CELL *)to_visit -1024) - goto stack_overflow; - continue; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + pt1 = ap3; + npt = HR; + *npt++ = (CELL)f; + HR += d0; + if (HR > (CELL *)to_visit - 1024) + goto stack_overflow; + continue; } } RESET_VARIABLE(npt); @@ -4657,7 +4521,7 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg pt0_end = to_visit[1]; pt1 = to_visit[2]; tbindings = to_visit[3]; - npt = to_visit[ 4]; + npt = to_visit[4]; if (!tbindings) { bindings = NULL; } @@ -4673,27 +4537,25 @@ static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, reg } out = 1; - complete: +complete: /* get rid of intermediate variables */ while (TR != OLDTR) { - CELL *pt1 = (CELL *) TrailTerm(--TR); + CELL *pt1 = (CELL *)TrailTerm(--TR); RESET_VARIABLE(pt1); } HBREG = B->cp_h; return out; - stack_overflow: +stack_overflow: out = -1; goto complete; - trail_overflow: +trail_overflow: out = -2; goto complete; - } -static Int -p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ +static Int p_term_subsumer(USES_REGS1) /* term_subsumer terms t1 and t2 */ { int out = 0; @@ -4703,38 +4565,38 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ CELL *oldH = HR; if (t1 == t2) - return Yap_unify(ARG3,t1); + return Yap_unify(ARG3, t1); if (IsPairTerm(t1) && IsPairTerm(t2)) { Term tf = AbsAppl(HR); HR += 2; HB = HR; - if ((out = term_subsumer_complex(RepPair(t1)-1, - RepPair(t1)+1, - RepPair(t2)-1, HR-2 PASS_REGS)) > 0) { - HB = B->cp_h; - return Yap_unify(ARG3,tf); + if ((out = term_subsumer_complex(RepPair(t1) - 1, RepPair(t1) + 1, + RepPair(t2) - 1, HR - 2 PASS_REGS)) > + 0) { + HB = B->cp_h; + return Yap_unify(ARG3, tf); } - } else if (IsApplTerm(t1) && IsApplTerm(t2)) { + } else if (IsApplTerm(t1) && IsApplTerm(t2)) { Functor f1; if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) { - if (IsExtensionFunctor(f1)) { - if (unify_extension(f1, t1, RepAppl(t1), t2)) { - return Yap_unify(ARG3,t1); - } - } else { - Term tf = AbsAppl(HR); - UInt ar = ArityOfFunctor(f1); - HR[0] = (CELL)f1; - HR += 1+ar; - HB = HR; - if ((out = term_subsumer_complex(RepAppl(t1), - RepAppl(t1)+ArityOfFunctor(f1), - RepAppl(t2), HR-ar PASS_REGS)) > 0) { - HB = B->cp_h; - return Yap_unify(ARG3,tf); - } - } + if (IsExtensionFunctor(f1)) { + if (unify_extension(f1, t1, RepAppl(t1), t2)) { + return Yap_unify(ARG3, t1); + } + } else { + Term tf = AbsAppl(HR); + UInt ar = ArityOfFunctor(f1); + HR[0] = (CELL)f1; + HR += 1 + ar; + HB = HR; + if ((out = term_subsumer_complex( + RepAppl(t1), RepAppl(t1) + ArityOfFunctor(f1), RepAppl(t2), + HR - ar PASS_REGS)) > 0) { + HB = B->cp_h; + return Yap_unify(ARG3, tf); + } + } } } HB = B->cp_h; @@ -4743,16 +4605,16 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ } else { HR = oldH; if (out == -1) { - if (!Yap_gcl((ASP-HR)*sizeof(CELL), 0, ENV, gc_P(P,CP))) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_subsumer"); - return FALSE; - } + if (!Yap_gcl((ASP - HR) * sizeof(CELL), 0, ENV, gc_P(P, CP))) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, "in term_subsumer"); + return FALSE; + } } else { - /* Trail overflow */ - if (!Yap_growtrail(0, FALSE)) { - Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, "in term_subsumer"); - return FALSE; - } + /* Trail overflow */ + if (!Yap_growtrail(0, FALSE)) { + Yap_Error(RESOURCE_ERROR_TRAIL, TermNil, "in term_subsumer"); + return FALSE; + } } } } @@ -4760,10 +4622,8 @@ p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */ } #ifdef DEBUG -static Int -p_force_trail_expansion( USES_REGS1 ) -{ - Int i = IntOfTerm(Deref(ARG1))*1024, j = 0; +static Int p_force_trail_expansion(USES_REGS1) { + Int i = IntOfTerm(Deref(ARG1)) * 1024, j = 0; tr_fr_ptr OTR = TR; for (j = 0; j < i; j++) { @@ -4772,75 +4632,55 @@ p_force_trail_expansion( USES_REGS1 ) } TR = OTR; - return(TRUE); + return (TRUE); } -static Int -camacho_dum( USES_REGS1 ) -{ +static Int camacho_dum(USES_REGS1) { Term t1, t2; - int max = 3; + int max = 3; /* build output list */ t1 = TermNil; t2 = MkPairTerm(MkIntegerTerm(max), t1); - return(Yap_unify(t2, ARG1)); + return (Yap_unify(t2, ARG1)); } - - #endif /* DEBUG */ -bool -Yap_IsListTerm(Term t) -{ +bool Yap_IsListTerm(Term t) { Term *tailp; Yap_SkipList(&t, &tailp); return *tailp == TermNil; } -static Int -p_is_list( USES_REGS1 ) -{ - return Yap_IsListTerm(Deref(ARG1)); -} +static Int p_is_list(USES_REGS1) { return Yap_IsListTerm(Deref(ARG1)); } -bool -Yap_IsListOrPartialListTerm(Term t) -{ +bool Yap_IsListOrPartialListTerm(Term t) { Term *tailp, tail; Yap_SkipList(&t, &tailp); tail = *tailp; return tail == TermNil || IsVarTerm(tail); } -static Int -p_is_list_or_partial_list( USES_REGS1 ) -{ +static Int p_is_list_or_partial_list(USES_REGS1) { return Yap_IsListOrPartialListTerm(Deref(ARG1)); } -static Term -numbervar(Int id USES_REGS) -{ +static Term numbervar(Int id USES_REGS) { Term ts[1]; ts[0] = MkIntegerTerm(id); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static Term -numbervar_singleton(USES_REGS1) -{ +static Term numbervar_singleton(USES_REGS1) { Term ts[1]; ts[0] = MkIntegerTerm(-1); return Yap_MkApplTerm(FunctorDollarVar, 1, ts); } -static void -renumbervar(Term t, Int id USES_REGS) -{ +static void renumbervar(Term t, Int id USES_REGS) { Term *ts = RepAppl(t); ts[1] = MkIntegerTerm(id); } @@ -4849,94 +4689,93 @@ extern int vsc; int vsc; -static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end, Int numbv, int singles USES_REGS) -{ +static Int numbervars_in_complex_term(register CELL *pt0, + register CELL *pt0_end, Int numbv, + int singles USES_REGS) { int lvl = push_text_stack(); - att_rec_t *to_visit0, *to_visit = Malloc(1024*sizeof(att_rec_t)); + att_rec_t *to_visit0, *to_visit = Malloc(1024 * sizeof(att_rec_t)); att_rec_t *to_visit_max; register tr_fr_ptr TR0 = TR; CELL *InitialH = HR; to_visit0 = to_visit; - to_visit_max = to_visit0+1024; + to_visit_max = to_visit0 + 1024; loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, vars_in_term_unk); - vars_in_term_nvar: - { - if (IsPairTerm(d0)) { - if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; - } -#ifdef RATIONAL_TREES - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; -#else - if (pt0 < pt0_end) { - to_visit[0] = pt0; - to_visit[1] = pt0_end; - to_visit += 2; - } -#endif - pt0 = RepPair(d0) - 1; - pt0_end = RepPair(d0) + 1; - } else if (IsApplTerm(d0)) { - Functor f; - CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - f = (Functor)(*ap2); - if (IsExtensionFunctor(f)) { - continue; - } - if (singles && ap2 >= InitialH && ap2 < HR) { - renumbervar(d0, numbv++ PASS_REGS); - continue; - } - /* store the terms to visit */ + vars_in_term_nvar : { + if (IsPairTerm(d0)) { if (to_visit + 32 >= to_visit_max) { - goto aux_overflow; + goto aux_overflow; + } +#ifdef RATIONAL_TREES + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit++; + *pt0 = TermNil; +#else + if (pt0 < pt0_end) { + to_visit[0] = pt0; + to_visit[1] = pt0_end; + to_visit += 2; + } +#endif + pt0 = RepPair(d0) - 1; + pt0_end = RepPair(d0) + 1; + } else if (IsApplTerm(d0)) { + Functor f; + CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + f = (Functor)(*ap2); + if (IsExtensionFunctor(f)) { + continue; + } + if (singles && ap2 >= InitialH && ap2 < HR) { + renumbervar(d0, numbv++ PASS_REGS); + continue; + } + /* store the terms to visit */ + if (to_visit + 32 >= to_visit_max) { + goto aux_overflow; } #ifdef RATIONAL_TREES #else - to_visit->beg = pt0; - to_visit->end = pt0_end; - to_visit->oval = *pt0; - to_visit ++; - *pt0 = TermNil; + to_visit->beg = pt0; + to_visit->end = pt0_end; + to_visit->oval = *pt0; + to_visit++; + *pt0 = TermNil; #endif - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - } - continue; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; } - + continue; + } derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar); /* do or pt2 are unbound */ if (singles) - *ptd0 = numbervar_singleton( PASS_REGS1 ); + *ptd0 = numbervar_singleton(PASS_REGS1); else *ptd0 = numbervar(numbv++ PASS_REGS); /* leave an empty slot to fill in later */ - if (HR+1024 > ASP) { + if (HR + 1024 > ASP) { goto global_overflow; } /* next make sure noone will see this as a variable again */ if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) { /* Trail overflow */ - if (!Yap_growtrail((TR-TR0)*sizeof(tr_fr_ptr *), TRUE)) { - goto trail_overflow; + if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), TRUE)) { + goto trail_overflow; } } @@ -4948,7 +4787,7 @@ loop: /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { #ifdef RATIONAL_TREES - to_visit --; + to_visit--; pt0 = to_visit->beg; pt0_end = to_visit->end; *pt0 = to_visit->oval; @@ -4964,37 +4803,36 @@ loop: pop_text_stack(lvl); return numbv; - trail_overflow: +trail_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->beg; pt0_end = to_visit->end; *pt0 = to_visit->oval; } #endif LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; - LOCAL_Error_Size = (TR-TR0)*sizeof(tr_fr_ptr *); + LOCAL_Error_Size = (TR - TR0) * sizeof(tr_fr_ptr *); clean_tr(TR0 PASS_REGS); HR = InitialH; pop_text_stack(lvl); - return numbv-1; + return numbv - 1; - aux_overflow: - { - size_t d1 = to_visit-to_visit0; - size_t d2 = to_visit_max-to_visit0; - to_visit0 = Realloc(to_visit0,d2*sizeof(CELL*)+64*1024); - to_visit = to_visit0+d1; - to_visit_max = to_visit0+(d2+(64*1024))/sizeof(CELL **); +aux_overflow : { + size_t d1 = to_visit - to_visit0; + size_t d2 = to_visit_max - to_visit0; + to_visit0 = Realloc(to_visit0, d2 * sizeof(CELL *) + 64 * 1024); + to_visit = to_visit0 + d1; + to_visit_max = to_visit0 + (d2 + (64 * 1024)) / sizeof(CELL **); } -pt0--; -goto loop; + pt0--; + goto loop; - global_overflow: +global_overflow: #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->beg; pt0_end = to_visit->end; *pt0 = to_visit->oval; @@ -5003,76 +4841,72 @@ goto loop; clean_tr(TR0 PASS_REGS); HR = InitialH; LOCAL_Error_TYPE = RESOURCE_ERROR_STACK; - LOCAL_Error_Size = (ASP-HR)*sizeof(CELL); + LOCAL_Error_Size = (ASP - HR) * sizeof(CELL); pop_text_stack(lvl); - return numbv-1; - + return numbv - 1; } -Int -Yap_NumberVars( Term inp, Int numbv, bool handle_singles ) /* - * numbervariables in term t */ +Int Yap_NumberVars(Term inp, Int numbv, + bool handle_singles) /* + * numbervariables in term t */ { CACHE_REGS Int out; Term t; - restart: +restart: t = Deref(inp); if (IsVarTerm(t)) { CELL *ptd0 = VarOfTerm(t); TrailTerm(TR++) = (CELL)ptd0; if (handle_singles) { - *ptd0 = numbervar_singleton( PASS_REGS1 ); + *ptd0 = numbervar_singleton(PASS_REGS1); return numbv; } else { *ptd0 = numbervar(numbv PASS_REGS); - return numbv+1; + return numbv + 1; } - } else if (IsPrimitiveTerm(t)) { + } else if (IsPrimitiveTerm(t)) { return numbv; } else if (IsPairTerm(t)) { - out = numbervars_in_complex_term(RepPair(t)-1, - RepPair(t)+1, numbv, handle_singles PASS_REGS); + out = numbervars_in_complex_term(RepPair(t) - 1, RepPair(t) + 1, numbv, + handle_singles PASS_REGS); } else { Functor f = FunctorOfTerm(t); - out = numbervars_in_complex_term(RepAppl(t), - RepAppl(t)+ - ArityOfFunctor(f), numbv, handle_singles PASS_REGS); + out = numbervars_in_complex_term(RepAppl(t), RepAppl(t) + ArityOfFunctor(f), + numbv, handle_singles PASS_REGS); } if (out < numbv) { - if (!expand_vts( 3 PASS_REGS )) + if (!expand_vts(3 PASS_REGS)) return FALSE; goto restart; } return out; } -static Int -p_numbervars( USES_REGS1 ) -{ +static Int p_numbervars(USES_REGS1) { Term t2 = Deref(ARG2); Int out; if (IsVarTerm(t2)) { - Yap_Error(INSTANTIATION_ERROR,t2,"numbervars/3"); + Yap_Error(INSTANTIATION_ERROR, t2, "numbervars/3"); return FALSE; } if (!IsIntegerTerm(t2)) { - Yap_Error(TYPE_ERROR_INTEGER,t2,"term_hash/4"); - return(FALSE); + Yap_Error(TYPE_ERROR_INTEGER, t2, "term_hash/4"); + return (FALSE); } if ((out = Yap_NumberVars(ARG1, IntegerOfTerm(t2), FALSE)) < 0) return FALSE; return Yap_unify(ARG3, MkIntegerTerm(out)); } -static int -unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share USES_REGS) -{ +static int unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, + CELL *HLow, int share USES_REGS) { - struct cp_frame *to_visit0, *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); + struct cp_frame *to_visit0, + *to_visit = (struct cp_frame *)Yap_PreAllocCodeSpace(); CELL *HB0 = HB; tr_fr_ptr TR0 = TR; int ground = share; @@ -5080,171 +4914,171 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share HB = HLow; to_visit0 = to_visit; - loop: +loop: while (pt0 < pt0_end) { register CELL d0; register CELL *ptd0; - ++ pt0; + ++pt0; ptd0 = pt0; d0 = *ptd0; deref_head(d0, unnumber_term_unk); - unnumber_term_nvar: - { - if (IsPairTerm(d0)) { - CELL *ap2 = RepPair(d0); - if (ap2 >= HB && ap2 < HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - *ptf = AbsPair(HR); - ptf++; -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsPair(HR); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - ground = share; - pt0 = ap2 - 1; - pt0_end = ap2 + 1; - ptf = HR; - HR += 2; - if (HR > ASP - 2048) { - goto overflow; - } - } else if (IsApplTerm(d0)) { - register Functor f; - register CELL *ap2; - /* store the terms to visit */ - ap2 = RepAppl(d0); - if (ap2 >= HB && ap2 <= HR) { - /* If this is newer than the current term, just reuse */ - *ptf++ = d0; - continue; - } - f = (Functor)(*ap2); - - if (IsExtensionFunctor(f)) { - *ptf++ = d0; /* you can just unnumber other extensions. */ - continue; - } - if (f == FunctorDollarVar) { - Int id = IntegerOfTerm(ap2[1]); - ground = FALSE; - if (id < -1) { - Yap_Error(RESOURCE_ERROR_STACK, TermNil, "unnumber vars cannot cope with VAR(-%d)", id); - return 0L; - } - if (id <= max) { - if (ASP-(max+1) <= HR) { - goto overflow; - } - /* we found this before? */ - if (ASP[-id-1]) - *ptf++ = ASP[-id-1]; - else { - RESET_VARIABLE(ptf); - ASP[-id-1] = (CELL)ptf; - ptf++; - } - continue; - } - /* alloc more space */ - if (ASP-(id+1) <= HR) { - goto overflow; - } - while (id > max) { - ASP[-(id+1)] = 0L; - max++; - } - /* new variable */ - RESET_VARIABLE(ptf); - ASP[-(id+1)] = (CELL)ptf; - ptf++; - continue; - } - *ptf = AbsAppl(HR); - ptf++; - /* store the terms to visit */ -#ifdef RATIONAL_TREES - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->oldv = *pt0; - to_visit->ground = ground; - /* fool the system into thinking we had a variable there */ - *pt0 = AbsAppl(HR); - to_visit ++; -#else - if (pt0 < pt0_end) { - if (to_visit+1 >= (struct cp_frame *)AuxSp) { - goto heap_overflow; - } - to_visit->start_cp = pt0; - to_visit->end_cp = pt0_end; - to_visit->to = ptf; - to_visit->ground = ground; - to_visit ++; - } -#endif - ground = (f != FunctorMutable) && share; - d0 = ArityOfFunctor(f); - pt0 = ap2; - pt0_end = ap2 + d0; - /* store the functor for the new term */ - HR[0] = (CELL)f; - ptf = HR+1; - HR += 1+d0; - if (HR > ASP - 2048) { - goto overflow; - } - } else { - /* just unnumber atoms or integers */ - *ptf++ = d0; + unnumber_term_nvar : { + if (IsPairTerm(d0)) { + CELL *ap2 = RepPair(d0); + if (ap2 >= HB && ap2 < HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; } - continue; + *ptf = AbsPair(HR); + ptf++; +#ifdef RATIONAL_TREES + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsPair(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = share; + pt0 = ap2 - 1; + pt0_end = ap2 + 1; + ptf = HR; + HR += 2; + if (HR > ASP - 2048) { + goto overflow; + } + } else if (IsApplTerm(d0)) { + register Functor f; + register CELL *ap2; + /* store the terms to visit */ + ap2 = RepAppl(d0); + if (ap2 >= HB && ap2 <= HR) { + /* If this is newer than the current term, just reuse */ + *ptf++ = d0; + continue; + } + f = (Functor)(*ap2); + + if (IsExtensionFunctor(f)) { + *ptf++ = d0; /* you can just unnumber other extensions. */ + continue; + } + if (f == FunctorDollarVar) { + Int id = IntegerOfTerm(ap2[1]); + ground = FALSE; + if (id < -1) { + Yap_Error(RESOURCE_ERROR_STACK, TermNil, + "unnumber vars cannot cope with VAR(-%d)", id); + return 0L; + } + if (id <= max) { + if (ASP - (max + 1) <= HR) { + goto overflow; + } + /* we found this before? */ + if (ASP[-id - 1]) + *ptf++ = ASP[-id - 1]; + else { + RESET_VARIABLE(ptf); + ASP[-id - 1] = (CELL)ptf; + ptf++; + } + continue; + } + /* alloc more space */ + if (ASP - (id + 1) <= HR) { + goto overflow; + } + while (id > max) { + ASP[-(id + 1)] = 0L; + max++; + } + /* new variable */ + RESET_VARIABLE(ptf); + ASP[-(id + 1)] = (CELL)ptf; + ptf++; + continue; + } + *ptf = AbsAppl(HR); + ptf++; + /* store the terms to visit */ +#ifdef RATIONAL_TREES + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->oldv = *pt0; + to_visit->ground = ground; + /* fool the system into thinking we had a variable there */ + *pt0 = AbsAppl(HR); + to_visit++; +#else + if (pt0 < pt0_end) { + if (to_visit + 1 >= (struct cp_frame *)AuxSp) { + goto heap_overflow; + } + to_visit->start_cp = pt0; + to_visit->end_cp = pt0_end; + to_visit->to = ptf; + to_visit->ground = ground; + to_visit++; + } +#endif + ground = (f != FunctorMutable) && share; + d0 = ArityOfFunctor(f); + pt0 = ap2; + pt0_end = ap2 + d0; + /* store the functor for the new term */ + HR[0] = (CELL)f; + ptf = HR + 1; + HR += 1 + d0; + if (HR > ASP - 2048) { + goto overflow; + } + } else { + /* just unnumber atoms or integers */ + *ptf++ = d0; } + continue; + } derefa_body(d0, ptd0, unnumber_term_unk, unnumber_term_nvar); /* this should never happen ? */ ground = FALSE; - *ptf++ = (CELL) ptd0; + *ptf++ = (CELL)ptd0; } /* Do we still have compound terms to visit */ if (to_visit > to_visit0) { - to_visit --; + to_visit--; if (ground) { CELL old = to_visit->oldv; - CELL *newp = to_visit->to-1; + CELL *newp = to_visit->to - 1; CELL new = *newp; *newp = old; if (IsApplTerm(new)) - HR = RepAppl(new); + HR = RepAppl(new); else - HR = RepPair(new); + HR = RepPair(new); } pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; @@ -5261,7 +5095,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share HB = HB0; return ground; - overflow: +overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -5269,7 +5103,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -5280,7 +5114,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share /* follow chain of multi-assigned variables */ return -1; - heap_overflow: +heap_overflow: /* oops, we're in trouble */ HR = HLow; /* we've done it */ @@ -5288,7 +5122,7 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share HB = HB0; #ifdef RATIONAL_TREES while (to_visit > to_visit0) { - to_visit --; + to_visit--; pt0 = to_visit->start_cp; pt0_end = to_visit->end_cp; ptf = to_visit->to; @@ -5296,13 +5130,11 @@ unnumber_complex_term(CELL *pt0, CELL *pt0_end, CELL *ptf, CELL *HLow, int share } #endif reset_trail(TR0); - LOCAL_Error_Size = (ADDR)AuxSp-(ADDR)to_visit0; + LOCAL_Error_Size = (ADDR)AuxSp - (ADDR)to_visit0; return -3; } - -static Term -UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { +static Term UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { Term t = Deref(inp); tr_fr_ptr TR0 = TR; @@ -5322,14 +5154,15 @@ UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { HR += 2; { int res; - if ((res = unnumber_complex_term(ap-1, ap+1, Hi, Hi, share PASS_REGS)) < 0) { - HR = Hi; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_list; + if ((res = unnumber_complex_term(ap - 1, ap + 1, Hi, Hi, + share PASS_REGS)) < 0) { + HR = Hi; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_list; } else if (res) { - HR = Hi; - return t; + HR = Hi; + return t; } } return tf; @@ -5345,82 +5178,75 @@ UnnumberTerm(Term inp, UInt arity, int share USES_REGS) { ap = RepAppl(t); tf = AbsAppl(HR); HR[0] = (CELL)f; - HR += 1+ArityOfFunctor(f); - if (HR > ASP-128) { + HR += 1 + ArityOfFunctor(f); + if (HR > ASP - 128) { HR = HB0; - if ((t = handle_cp_overflow(-1, TR0, arity, t))== 0L) - return FALSE; + if ((t = handle_cp_overflow(-1, TR0, arity, t)) == 0L) + return FALSE; goto restart_appl; } else { int res; - if ((res = unnumber_complex_term(ap, ap+ArityOfFunctor(f), HB0+1, HB0, share PASS_REGS)) < 0) { - HR = HB0; - if ((t = handle_cp_overflow(res, TR0, arity, t))== 0L) - return FALSE; - goto restart_appl; + if ((res = unnumber_complex_term(ap, ap + ArityOfFunctor(f), HB0 + 1, HB0, + share PASS_REGS)) < 0) { + HR = HB0; + if ((t = handle_cp_overflow(res, TR0, arity, t)) == 0L) + return FALSE; + goto restart_appl; } else if (res && FunctorOfTerm(t) != FunctorMutable) { - HR = HB0; - return t; + HR = HB0; + return t; } } return tf; } } -Term -Yap_UnNumberTerm(Term inp, int share) { +Term Yap_UnNumberTerm(Term inp, int share) { CACHE_REGS return UnnumberTerm(inp, 0, share PASS_REGS); } -static Int -p_unnumbervars( USES_REGS1 ) { +static Int p_unnumbervars(USES_REGS1) { /* this should be a standard Prolog term, so we allow sharing? */ return Yap_unify(UnnumberTerm(ARG1, 2, FALSE PASS_REGS), ARG2); } -Int -Yap_SkipList(Term *l, Term **tailp) -{ +Int Yap_SkipList(Term *l, Term **tailp) { Int length = 0; Term *s; /* slow */ - Term v; /* temporary */ + Term v; /* temporary */ - do_derefa(v,l,derefa_unk,derefa_nonvar); + do_derefa(v, l, derefa_unk, derefa_nonvar); s = l; - if ( IsPairTerm(*l) ) - { intptr_t power = 1, lam = 0; - do - { if ( power == lam ) - { s = l; - power *= 2; - lam = 0; + if (IsPairTerm(*l)) { + intptr_t power = 1, lam = 0; + do { + if (power == lam) { + s = l; + power *= 2; + lam = 0; } lam++; length++; - l = RepPair(*l)+1; - do_derefa(v,l,derefa2_unk,derefa2_nonvar); - } while ( *l != *s && IsPairTerm(*l) ); + l = RepPair(*l) + 1; + do_derefa(v, l, derefa2_unk, derefa2_nonvar); + } while (*l != *s && IsPairTerm(*l)); } *tailp = l; return length; } - -static Int -p_skip_list( USES_REGS1 ) { +static Int p_skip_list(USES_REGS1) { Term *tail; - Int len = Yap_SkipList(XREGS+2, &tail); + Int len = Yap_SkipList(XREGS + 2, &tail); - return Yap_unify(MkIntegerTerm(len), ARG1) && - Yap_unify(*tail, ARG3); + return Yap_unify(MkIntegerTerm(len), ARG1) && Yap_unify(*tail, ARG3); } -static Int -p_skip_list4( USES_REGS1 ) { +static Int p_skip_list4(USES_REGS1) { Term *tail; Int len, len1 = -1; Term t2 = Deref(ARG2), t; @@ -5436,26 +5262,21 @@ p_skip_list4( USES_REGS1 ) { } } /* we need len here */ - len = Yap_SkipList(XREGS+1, &tail); + len = Yap_SkipList(XREGS + 1, &tail); t = *tail; /* don't set M0 if full list, just check M */ if (t == TermNil) { if (len1 >= 0) { /* ARG2 was bound */ - return - len1 == len && - Yap_unify(t, ARG4); + return len1 == len && Yap_unify(t, ARG4); } else { return Yap_unify_constant(ARG4, TermNil) && - Yap_unify_constant(ARG2, MkIntegerTerm(len)); + Yap_unify_constant(ARG2, MkIntegerTerm(len)); } } - return Yap_unify(MkIntegerTerm(len), ARG3) && - Yap_unify(t, ARG4); + return Yap_unify(MkIntegerTerm(len), ARG3) && Yap_unify(t, ARG4); } -static Int -p_free_arguments( USES_REGS1 ) -{ +static Int p_free_arguments(USES_REGS1) { Term t = Deref(ARG1); if (IsVarTerm(t)) return FALSE; @@ -5473,33 +5294,34 @@ p_free_arguments( USES_REGS1 ) if (IsExtensionFunctor(f)) return TRUE; ar = ArityOfFunctor(f); - for (i = 1 ; i <= ar; i++) { + for (i = 1; i <= ar; i++) { Term ta = ArgOfTerm(i, t); Int j; ret = IsVarTerm(ta); - if (!ret) break; + if (!ret) + break; /* stupid quadractic algorithm, but needs no testing for overflows */ - for (j = 1 ; j < i; j++) { - ret = ArgOfTerm(j, t) != ta; - if (!ret) break; + for (j = 1; j < i; j++) { + ret = ArgOfTerm(j, t) != ta; + if (!ret) + break; } - if (!ret) break; + if (!ret) + break; } return ret; } } -static Int -p_freshen_variables( USES_REGS1 ) -{ +static Int p_freshen_variables(USES_REGS1) { Term t = Deref(ARG1); Functor f = FunctorOfTerm(t); UInt arity = ArityOfFunctor(f), i; Term tn = Yap_MkNewApplTerm(f, arity); - CELL *src = RepAppl(t)+1; - CELL *targ = RepAppl(tn)+1; - for (i=0; i< arity; i++) { + CELL *src = RepAppl(t) + 1; + CELL *targ = RepAppl(tn) + 1; + for (i = 0; i < arity; i++) { RESET_VARIABLE(targ); *VarOfTerm(*src) = (CELL)targ; targ++; @@ -5508,142 +5330,141 @@ p_freshen_variables( USES_REGS1 ) return TRUE; } -static Int -p_reset_variables( USES_REGS1 ) -{ +static Int p_reset_variables(USES_REGS1) { Term t = Deref(ARG1); Functor f = FunctorOfTerm(t); UInt arity = ArityOfFunctor(f), i; - CELL *src = RepAppl(t)+1; + CELL *src = RepAppl(t) + 1; - for (i=0; i< arity; i++) { + for (i = 0; i < arity; i++) { RESET_VARIABLE(VarOfTerm(*src)); src++; } return TRUE; } -void Yap_InitUtilCPreds(void) -{ +void Yap_InitUtilCPreds(void) { CACHE_REGS Term cm = CurrentModule; Yap_InitCPred("copy_term", 2, p_copy_term, 0); -/** @pred copy_term(? _TI_,- _TF_) is iso + /** @pred copy_term(? _TI_,- _TF_) is iso -Term _TF_ is a variant of the original term _TI_, such that for -each variable _V_ in the term _TI_ there is a new variable _V'_ -in term _TF_. Notice that: + Term _TF_ is a variant of the original term _TI_, such that for + each variable _V_ in the term _TI_ there is a new variable _V'_ + in term _TF_. Notice that: -+ suspended goals and attributes for attributed variables in _TI_ are also duplicated; -+ ground terms are shared between the new and the old term. + + suspended goals and attributes for attributed variables in _TI_ are also + duplicated; + + ground terms are shared between the new and the old term. -If you do not want any sharing to occur please use -duplicate_term/2. + If you do not want any sharing to occur please use + duplicate_term/2. -*/ + */ Yap_InitCPred("duplicate_term", 2, p_duplicate_term, 0); -/** @pred duplicate_term(? _TI_,- _TF_) + /** @pred duplicate_term(? _TI_,- _TF_) -Term _TF_ is a variant of the original term _TI_, such that -for each variable _V_ in the term _TI_ there is a new variable - _V'_ in term _TF_, and the two terms do not share any -structure. All suspended goals and attributes for attributed variables -in _TI_ are also duplicated. + Term _TF_ is a variant of the original term _TI_, such that + for each variable _V_ in the term _TI_ there is a new variable + _V'_ in term _TF_, and the two terms do not share any + structure. All suspended goals and attributes for attributed variables + in _TI_ are also duplicated. -Also refer to copy_term/2. + Also refer to copy_term/2. -*/ + */ Yap_InitCPred("copy_term_nat", 2, p_copy_term_no_delays, 0); -/** @pred copy_term_nat(? _TI_,- _TF_) + /** @pred copy_term_nat(? _TI_,- _TF_) -As copy_term/2. Attributes however, are not copied but replaced -by fresh variables. + As copy_term/2. Attributes however, are not copied but replaced + by fresh variables. - */ + */ Yap_InitCPred("ground", 1, p_ground, SafePredFlag); -/** @pred ground( _T_) is iso + /** @pred ground( _T_) is iso -Succeeds if there are no free variables in the term _T_. + Succeeds if there are no free variables in the term _T_. -*/ + */ Yap_InitCPred("$variables_in_term", 3, p_variables_in_term, 0); Yap_InitCPred("$free_variables_in_term", 3, p_free_variables_in_term, 0); Yap_InitCPred("$non_singletons_in_term", 3, p_non_singletons_in_term, 0); Yap_InitCPred("term_variables", 2, p_term_variables, 0); -/** @pred term_variables(? _Term_, - _Variables_) is iso + /** @pred term_variables(? _Term_, - _Variables_) is iso -Unify _Variables_ with the list of all variables of term - _Term_. The variables occur in the order of their first -appearance when traversing the term depth-first, left-to-right. + Unify _Variables_ with the list of all variables of term + _Term_. The variables occur in the order of their first + appearance when traversing the term depth-first, left-to-right. -*/ + */ Yap_InitCPred("term_variables", 3, p_term_variables3, 0); Yap_InitCPred("term_attvars", 2, p_term_attvars, 0); -/** @pred term_attvars(+ _Term_,- _AttVars_) + /** @pred term_attvars(+ _Term_,- _AttVars_) - _AttVars_ is a list of all attributed variables in _Term_ and -its attributes. I.e., term_attvars/2 works recursively through -attributes. This predicate is Cycle-safe. + _AttVars_ is a list of all attributed variables in _Term_ and + its attributes. I.e., term_attvars/2 works recursively through + attributes. This predicate is Cycle-safe. -*/ - Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag|TestPredFlag); - Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, SafePredFlag|TestPredFlag); + */ + Yap_InitCPred("is_list", 1, p_is_list, SafePredFlag | TestPredFlag); + Yap_InitCPred("$is_list_or_partial_list", 1, p_is_list_or_partial_list, + SafePredFlag | TestPredFlag); Yap_InitCPred("rational_term_to_tree", 4, p_break_rational, 0); -/** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) + /** @pred rational_term_to_tree(? _TI_,- _TF_, ?SubTerms, ?MoreSubterms) -The term _TF_ is a forest representation (without cycles and repeated -terms) for the Prolog term _TI_. The term _TF_ is the main term. The -difference list _SubTerms_-_MoreSubterms_ stores terms of the form -_V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy -of a sub-term from _TI_. + The term _TF_ is a forest representation (without cycles and repeated + terms) for the Prolog term _TI_. The term _TF_ is the main term. The + difference list _SubTerms_-_MoreSubterms_ stores terms of the form + _V=T_, where _V_ is a new variable occuring in _TF_, and _T_ is a copy + of a sub-term from _TI_. -*/ + */ Yap_InitCPred("term_factorized", 3, p_break_rational3, 0); -/** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) + /** @pred term_factorized(? _TI_,- _TF_, ?SubTerms) -Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. + Similar to rational_term_to_tree/4, but _SubTerms_ is a proper list. -*/ + */ Yap_InitCPred("=@=", 2, p_variant, 0); Yap_InitCPred("numbervars", 3, p_numbervars, 0); -/** @pred numbervars( _T_,+ _N1_,- _Nn_) + /** @pred numbervars( _T_,+ _N1_,- _Nn_) -Instantiates each variable in term _T_ to a term of the form: -`$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. + Instantiates each variable in term _T_ to a term of the form: + `$VAR( _I_)`, with _I_ increasing from _N1_ to _Nn_. -*/ + */ Yap_InitCPred("unnumbervars", 2, p_unnumbervars, 0); -/** @pred unnumbervars( _T_,+ _NT_) + /** @pred unnumbervars( _T_,+ _NT_) -Replace every `$VAR( _I_)` by a free variable. + Replace every `$VAR( _I_)` by a free variable. -*/ + */ /* use this carefully */ - Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag|TestPredFlag); - Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag|TestPredFlag); + Yap_InitCPred("$skip_list", 3, p_skip_list, SafePredFlag | TestPredFlag); + Yap_InitCPred("$skip_list", 4, p_skip_list4, SafePredFlag | TestPredFlag); Yap_InitCPred("$free_arguments", 1, p_free_arguments, TestPredFlag); CurrentModule = TERMS_MODULE; Yap_InitCPred("variable_in_term", 2, p_var_in_term, 0); @@ -5661,7 +5482,8 @@ Replace every `$VAR( _I_)` by a free variable. Yap_InitCPred("reset_variables", 1, p_reset_variables, 0); CurrentModule = cm; #ifdef DEBUG - Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, SafePredFlag); + Yap_InitCPred("$force_trail_expansion", 1, p_force_trail_expansion, + SafePredFlag); Yap_InitCPred("dum", 1, camacho_dum, SafePredFlag); #endif } diff --git a/CXX/yapi.hh b/CXX/yapi.hh index 794e5af61..ab84a424b 100755 --- a/CXX/yapi.hh +++ b/CXX/yapi.hh @@ -12,8 +12,8 @@ #include #include -extern "C"{ -#include "config.h" +extern "C" { +#include "YapConfig.h" } #if HAVE_GMPXX_H @@ -41,17 +41,14 @@ extern "C"{ extern "C" { - - #include // Bad export from Python -#include +#include #include - #if YAP_PYTHON #include @@ -102,22 +99,19 @@ X_API extern void YAP_UserCPredicate(const char *, YAP_UserCPred, X_API extern void YAP_UserCPredicateWithArgs(const char *, YAP_UserCPred, YAP_Arity, YAP_Term); -X_API extern void YAP_UserBackCPredicate(const char *name, - YAP_UserCPred init, - YAP_UserCPred cont, - YAP_Arity arity, YAP_Arity extra); +X_API extern void YAP_UserBackCPredicate(const char *name, YAP_UserCPred init, + YAP_UserCPred cont, YAP_Arity arity, + YAP_Arity extra); X_API extern void YAP_UserBackCutCPredicate(const char *name, - YAP_UserCPred init, + YAP_UserCPred init, YAP_UserCPred cont, - YAP_UserCPred cut, - YAP_Arity arity, YAP_Arity extra); + YAP_UserCPred cut, YAP_Arity arity, + YAP_Arity extra); X_API extern YAP_Term YAP_ReadBuffer(const char *s, YAP_Term *tp); extern YAP_Term YAP_MkcharPTerm(char *s); - - } class YAPEngine; @@ -130,7 +124,6 @@ class YAPModule; class YAPError; class YAPPredicate; - #include "yapa.hh" #include "yapie.hh" diff --git a/H/udi_private.h b/H/udi_private.h index ebefb82ad..6718059ea 100644 --- a/H/udi_private.h +++ b/H/udi_private.h @@ -1,41 +1,40 @@ -#include "config.h" +#include "YapConfig.h" #include "udi.h" #include "utarray.h" #include "uthash.h" /* Argument Indexing */ struct udi_p_args { - int arg; //indexed arg - void *idxstr; //user indexing structure - UdiControlBlock control; //user indexing structure functions + int arg; // indexed arg + void *idxstr; // user indexing structure + UdiControlBlock control; // user indexing structure functions }; typedef struct udi_p_args *UdiPArg; -UT_icd arg_icd = {sizeof(struct udi_p_args), NULL, NULL, NULL }; +UT_icd arg_icd = {sizeof(struct udi_p_args), NULL, NULL, NULL}; /* clauselist */ -UT_icd cl_icd = {sizeof(yamop *), NULL, NULL, NULL }; +UT_icd cl_icd = {sizeof(yamop *), NULL, NULL, NULL}; /* * All the info we need to enter user indexed code * stored in a uthash */ -struct udi_info -{ - PredEntry *p; //predicate (need to identify asserts) - UT_array *clauselist; //clause list used on returns - UT_array *args; //indexed args - UT_hash_handle hh; //uthash handle +struct udi_info { + PredEntry *p; // predicate (need to identify asserts) + UT_array *clauselist; // clause list used on returns + UT_array *args; // indexed args + UT_hash_handle hh; // uthash handle }; typedef struct udi_info *UdiInfo; /* to ease code for a UdiInfo hash table*/ -#define HASH_FIND_UdiInfo(head,find,out) \ - HASH_FIND(hh,head,find,sizeof(PredEntry),out) -#define HASH_ADD_UdiInfo(head,p,add) \ - HASH_ADD_KEYPTR(hh,head,p,sizeof(PredEntry *),add) +#define HASH_FIND_UdiInfo(head, find, out) \ + HASH_FIND(hh, head, find, sizeof(PredEntry), out) +#define HASH_ADD_UdiInfo(head, p, add) \ + HASH_ADD_KEYPTR(hh, head, p, sizeof(PredEntry *), add) /* used during init */ -static YAP_Int p_new_udi( USES_REGS1 ); +static YAP_Int p_new_udi(USES_REGS1); static YAP_Int p_udi_args_init(Term spec, int arity, UdiInfo blk); /* @@ -44,18 +43,15 @@ static YAP_Int p_udi_args_init(Term spec, int arity, UdiInfo blk); /* single indexing helpers (no intersection needed just create clauselist) */ #include "clause_list.h" -struct si_callback_h -{ +struct si_callback_h { clause_list_t cl; UT_array *clauselist; - void * pred; + void *pred; }; -typedef struct si_callback_h * si_callback_h_t; +typedef struct si_callback_h *si_callback_h_t; -static inline int si_callback(void *key, void *data, void *arg) -{ - si_callback_h_t c = (si_callback_h_t) arg; - yamop **cl = (yamop **) utarray_eltptr(c->clauselist, ((YAP_Int) data) - 1); +static inline int si_callback(void *key, void *data, void *arg) { + si_callback_h_t c = (si_callback_h_t)arg; + yamop **cl = (yamop **)utarray_eltptr(c->clauselist, ((YAP_Int)data) - 1); return Yap_ClauseListExtend(c->cl, *cl, c->pred); } - diff --git a/console/yap.c b/console/yap.c index 0e2b58e0a..9f5b41def 100755 --- a/console/yap.c +++ b/console/yap.c @@ -1,23 +1,21 @@ /************************************************************************* -* * -* Yap Prolog * -* * -* Yap Prolog Was Developed At Nccup - Universidade Do Porto * -* * -* Copyright L.Damas, V.S.Costa And Universidade Do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: Yap.C * -* Last Rev: * -* Mods: * -* Comments: Yap's Main File * -* * -*************************************************************************/ + * * + * Yap Prolog * + * * + * Yap Prolog Was Developed At Nccup - Universidade Do Porto * + * * + * Copyright L.Damas, V.S.Costa And Universidade Do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: Yap.C * Last Rev: + ** Mods: * Comments: Yap's Main File * + * * + *************************************************************************/ /* static char SccsId[] = "X 4.3.3"; */ +#include "YapConfig.h" #include "YapInterface.h" -#include "config.h" #include "cut_c.h" @@ -112,14 +110,13 @@ static bool exec_top_level(int BootMode, YAP_init_args *iap) { livegoal = YAP_FullLookupAtom("live"); } return true; - //YAP_Exit(EXIT_SUCCESS); - - } + // YAP_Exit(EXIT_SUCCESS); +} // FILE *debugf; #ifdef LIGHT - + int _main(int argc, char **argv) #else int main(int argc, char **argv) @@ -129,7 +126,7 @@ int main(int argc, char **argv) int i; YAP_init_args init_args; BootMode = init_standard_system(argc, argv, &init_args); - + if (BootMode == YAP_BOOT_ERROR) { fprintf(stderr, "[ FATAL ERROR: could not find saved state ]\n"); exit(1); diff --git a/include/SWI-Prolog.h b/include/SWI-Prolog.h index fe8ddcb19..47bcb8c18 100755 --- a/include/SWI-Prolog.h +++ b/include/SWI-Prolog.h @@ -19,7 +19,7 @@ extern "C" { //=== includes =============================================================== #ifdef YAP_KERNEL -#include "config.h" +#include "YapConfig.h" #ifdef __cplusplus } @@ -40,8 +40,8 @@ extern "C" { #include "YapInterface.h" #else #if _YAP_NOT_INSTALLED_ +#include #include -#include #else #include #endif diff --git a/include/YapInterface.h b/include/YapInterface.h index 06b151205..479caa522 100755 --- a/include/YapInterface.h +++ b/include/YapInterface.h @@ -31,6 +31,8 @@ The following routines export the YAP internals and architecture. #define _yap_c_interface_h 1 +#include "YapConfig.h" + #define __YAP_PROLOG__ 1 #ifndef YAPVERSION diff --git a/library/matrix/matrix.c b/library/matrix/matrix.c index 0ee9f68af..cce7527c1 100644 --- a/library/matrix/matrix.c +++ b/library/matrix/matrix.c @@ -13,8 +13,8 @@ * * *************************************************************************/ +#include "YapConfig.h" #include "YapInterface.h" -#include "config.h" #include #if defined(__MINGW32__) || _MSC_VER #include @@ -1281,7 +1281,7 @@ static YAP_Bool matrix_sum(void) { y; // Alas, sum is big, y small, so low-order digits of y are lost. c = (t - sum) - y; // (t - sum) cancels the high-order part of y; // subtracting y recovers negative (low part of y) - sum = t; // Algebraically, c should always be zero. Beware + sum = t; // Algebraically, c should always be zero. Beware // overly-aggressive optimizing compilers! } tf = YAP_MkFloatTerm(sum); diff --git a/library/random/yap_random.c b/library/random/yap_random.c index 21bee0a60..ae8bef3fa 100644 --- a/library/random/yap_random.c +++ b/library/random/yap_random.c @@ -1,67 +1,56 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: random.c * -* Last rev: * -* mods: * -* comments: regular expression interpreter * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: random.c * Last rev: + ** mods: * comments: regular expression interpreter * + * * + *************************************************************************/ -#include "config.h" #include "YapInterface.h" #include #if defined(__MINGW32__) || _MSC_VER #include #endif -X_API void init_random( void ); +X_API void init_random(void); static short a1 = 27314, b1 = 9213, c1 = 17773; -static YAP_Bool -p_random(void) -{ +static YAP_Bool p_random(void) { double fli; long int t1, t2, t3; t1 = (a1 * 171) % 30269; t2 = (b1 * 172) % 30307; t3 = (c1 * 170) % 30323; - fli = (t1/30269.0) + (t2/30307.0) + (t3/30323.0); + fli = (t1 / 30269.0) + (t2 / 30307.0) + (t3 / 30323.0); a1 = t1; b1 = t2; c1 = t3; - return(YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli-(int)(fli)))); + return (YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(fli - (int)(fli)))); } -static YAP_Bool -p_setrand(void) -{ +static YAP_Bool p_setrand(void) { a1 = YAP_IntOfTerm(YAP_ARG1); b1 = YAP_IntOfTerm(YAP_ARG2); c1 = YAP_IntOfTerm(YAP_ARG3); - return(TRUE); + return (TRUE); } -static YAP_Bool -p_getrand(void) -{ - return(YAP_Unify(YAP_ARG1,YAP_MkIntTerm(a1)) && - YAP_Unify(YAP_ARG2,YAP_MkIntTerm(b1)) && - YAP_Unify(YAP_ARG3,YAP_MkIntTerm(c1))); +static YAP_Bool p_getrand(void) { + return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(a1)) && + YAP_Unify(YAP_ARG2, YAP_MkIntTerm(b1)) && + YAP_Unify(YAP_ARG3, YAP_MkIntTerm(c1))); } -X_API void -init_random(void) -{ +X_API void init_random(void) { YAP_UserCPredicate("random", p_random, 1); YAP_UserCPredicate("setrand", p_setrand, 3); YAP_UserCPredicate("getrand", p_getrand, 3); @@ -71,19 +60,17 @@ init_random(void) int WINAPI win_random(HANDLE, DWORD, LPVOID); -int WINAPI win_random(HANDLE hinst, DWORD reason, LPVOID reserved) -{ - switch (reason) - { - case DLL_PROCESS_ATTACH: - break; - case DLL_PROCESS_DETACH: - break; - case DLL_THREAD_ATTACH: - break; - case DLL_THREAD_DETACH: - break; - } +int WINAPI win_random(HANDLE hinst, DWORD reason, LPVOID reserved) { + switch (reason) { + case DLL_PROCESS_ATTACH: + break; + case DLL_PROCESS_DETACH: + break; + case DLL_THREAD_ATTACH: + break; + case DLL_THREAD_DETACH: + break; + } return 1; } #endif diff --git a/library/regex/regcomp.c b/library/regex/regcomp.c index 01488c0f3..32adcd376 100644 --- a/library/regex/regcomp.c +++ b/library/regex/regcomp.c @@ -50,7 +50,7 @@ static char sccsid[] = "@(#)regcomp.c 8.5 (Berkeley) 3/20/94"; #endif /* LIBC_SCCS and not lint */ #include "YapInterface.h" -#include "config.h" + #if HAVE_SYS_TYPES_H #include #endif diff --git a/library/regex/regexec.c b/library/regex/regexec.c index 6796be90a..1c3a5b9b1 100644 --- a/library/regex/regexec.c +++ b/library/regex/regexec.c @@ -48,11 +48,10 @@ static char sccsid[] = "@(#)regexec.c 8.3 (Berkeley) 3/20/94"; * macros that code uses. This lets the same code operate on two different * representations for state sets. */ -#include "config.h" +#include "YapInterface.h" #ifndef HAVE_REGEXEC -#include "YapInterface.h" #if HAVE_SYS_TYPES_H #include #endif @@ -68,8 +67,8 @@ static char sccsid[] = "@(#)regexec.c 8.3 (Berkeley) 3/20/94"; #include #endif -#include "utils.h" #include "regex2.h" +#include "utils.h" #include "yapregex.h" #if used diff --git a/library/regex/regexp.c b/library/regex/regexp.c index 99885b224..db5ba1503 100644 --- a/library/regex/regexp.c +++ b/library/regex/regexp.c @@ -22,7 +22,6 @@ * */ -#include "config.h" #if HAVE_SYS_TYPES_H #include #endif diff --git a/library/regex/yapregex.h b/library/regex/yapregex.h index d1043b12d..bb29a7f4e 100644 --- a/library/regex/yapregex.h +++ b/library/regex/yapregex.h @@ -38,66 +38,68 @@ */ #ifndef _REGEX_H_ -#define _REGEX_H_ +#define _REGEX_H_ + +#include "YapInterface.h" /* types */ typedef int regoff_t; typedef struct { - int re_magic; - int re_nsub; /* number of parenthesized subexpressions */ - const char *re_endp; /* end pointer for REG_PEND */ - struct re_guts *re_g; /* none of your business :-) */ + int re_magic; + int re_nsub; /* number of parenthesized subexpressions */ + const char *re_endp; /* end pointer for REG_PEND */ + struct re_guts *re_g; /* none of your business :-) */ } regex_t; typedef struct { - regoff_t rm_so; /* start of match */ - regoff_t rm_eo; /* end of match */ + regoff_t rm_so; /* start of match */ + regoff_t rm_eo; /* end of match */ } regmatch_t; /* regcomp() flags */ -#define REG_BASIC 0000 -#define REG_EXTENDED 0001 -#define REG_ICASE 0002 -#define REG_NOSUB 0004 -#define REG_NEWLINE 0010 -#define REG_NOSPEC 0020 -#define REG_PEND 0040 -#define REG_DUMP 0200 +#define REG_BASIC 0000 +#define REG_EXTENDED 0001 +#define REG_ICASE 0002 +#define REG_NOSUB 0004 +#define REG_NEWLINE 0010 +#define REG_NOSPEC 0020 +#define REG_PEND 0040 +#define REG_DUMP 0200 /* regerror() flags */ -#define REG_NOMATCH 1 -#define REG_BADPAT 2 -#define REG_ECOLLATE 3 -#define REG_ECTYPE 4 -#define REG_EESCAPE 5 -#define REG_ESUBREG 6 -#define REG_EBRACK 7 -#define REG_EPAREN 8 -#define REG_EBRACE 9 -#define REG_BADBR 10 -#define REG_ERANGE 11 -#define REG_ESPACE 12 -#define REG_BADRPT 13 -#define REG_EMPTY 14 -#define REG_ASSERT 15 -#define REG_INVARG 16 -#define REG_ATOI 255 /* convert name to number (!) */ -#define REG_ITOA 0400 /* convert number to name (!) */ +#define REG_NOMATCH 1 +#define REG_BADPAT 2 +#define REG_ECOLLATE 3 +#define REG_ECTYPE 4 +#define REG_EESCAPE 5 +#define REG_ESUBREG 6 +#define REG_EBRACK 7 +#define REG_EPAREN 8 +#define REG_EBRACE 9 +#define REG_BADBR 10 +#define REG_ERANGE 11 +#define REG_ESPACE 12 +#define REG_BADRPT 13 +#define REG_EMPTY 14 +#define REG_ASSERT 15 +#define REG_INVARG 16 +#define REG_ATOI 255 /* convert name to number (!) */ +#define REG_ITOA 0400 /* convert number to name (!) */ /* regexec() flags */ -#define REG_NOTBOL 00001 -#define REG_NOTEOL 00002 -#define REG_STARTEND 00004 -#define REG_TRACE 00400 /* tracing of execution */ -#define REG_LARGE 01000 /* force large representation */ -#define REG_BACKR 02000 /* force use of backref code */ +#define REG_NOTBOL 00001 +#define REG_NOTEOL 00002 +#define REG_STARTEND 00004 +#define REG_TRACE 00400 /* tracing of execution */ +#define REG_LARGE 01000 /* force large representation */ +#define REG_BACKR 02000 /* force use of backref code */ #include "YapInterface.h" -int yap_regcomp(regex_t *, const char *, int); -size_t yap_regerror(int, const regex_t *, char *, size_t); -int yap_regexec(const regex_t *, const char *, size_t, regmatch_t [], int); -void yap_regfree(regex_t *); +int yap_regcomp(regex_t *, const char *, int); +size_t yap_regerror(int, const regex_t *, char *, size_t); +int yap_regexec(const regex_t *, const char *, size_t, regmatch_t[], int); +void yap_regfree(regex_t *); #endif /* !_REGEX_H_ */ diff --git a/library/system/sys.c b/library/system/sys.c index 0a8c89580..446a69984 100644 --- a/library/system/sys.c +++ b/library/system/sys.c @@ -1,20 +1,19 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * - * -* comments: regular expression interpreter * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * + * comments: regular expression interpreter * + * * + *************************************************************************/ #include "YapInterface.h" -#include "config.h" #include @@ -312,22 +311,20 @@ static YAP_Bool rename_file(void) { return (TRUE); } - - static YAP_Bool read_link(void) { +static YAP_Bool read_link(void) { char *s1 = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)); #if HAVE_READLINK char buf[MAXPATHLEN + 1]; if (readlink(s1, buf, MAXPATHLEN) < 0) return false; - - - /* return an error number */ + + /* return an error number */ if (!YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom(buf)))) { - return false; + return false; } #endif -# if _WIN32 +#if _WIN32 return false; #endif return true; diff --git a/library/tries/core_tries.c b/library/tries/core_tries.c index c42602059..3f2c8b103 100644 --- a/library/tries/core_tries.c +++ b/library/tries/core_tries.c @@ -5,45 +5,41 @@ version: $ID$ *********************************************/ - - /* -------------------------- */ /* Includes */ /* -------------------------- */ -#include +#include "core_tries.h" #include #include #include -#include "core_tries.h" - - /* -------------------------- */ /* Local Procedures */ /* -------------------------- */ -static TrNode put_entry(TrNode node, YAP_Term entry); -static TrNode check_entry(TrNode node, YAP_Term entry); +static TrNode put_entry(TrNode node, YAP_Term entry); +static TrNode check_entry(TrNode node, YAP_Term entry); static YAP_Term get_entry(TrNode node, YAP_Term *stack_list, TrNode *cur_node); -static void remove_entry(TrNode node); -static void remove_child_nodes(TrNode node); -static TrNode copy_child_nodes(TrNode parent_dest, TrNode node_source); -static void traverse_and_add(TrNode parent_dest, TrNode parent_source); -static void traverse_and_join(TrNode parent_dest, TrNode parent_source); -static void traverse_and_intersect(TrNode parent_dest, TrNode parent_source); -static YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2); -static YAP_Int traverse_and_count_entries(TrNode node); -static void traverse_and_get_usage(TrNode node, YAP_Int depth); -static void traverse_and_save(TrNode node, FILE *file, int float_block); -static void traverse_and_load(TrNode parent, FILE *file); -static void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int mode); +static void remove_entry(TrNode node); +static void remove_child_nodes(TrNode node); +static TrNode copy_child_nodes(TrNode parent_dest, TrNode node_source); +static void traverse_and_add(TrNode parent_dest, TrNode parent_source); +static void traverse_and_join(TrNode parent_dest, TrNode parent_source); +static void traverse_and_intersect(TrNode parent_dest, TrNode parent_source); +static YAP_Int traverse_and_count_common_entries(TrNode parent1, + TrNode parent2); +static YAP_Int traverse_and_count_entries(TrNode node); +static void traverse_and_get_usage(TrNode node, YAP_Int depth); +static void traverse_and_save(TrNode node, FILE *file, int float_block); +static void traverse_and_load(TrNode parent, FILE *file); +static void traverse_and_print(TrNode node, int *arity, char *str, + int str_index, int mode); static YAP_Term trie_to_list(TrNode node); static YAP_Term trie_to_list_node(TrNode node); static YAP_Term trie_to_list_floats(TrNode node); - /* -------------------------- */ /* Local Variables */ /* -------------------------- */ @@ -51,7 +47,8 @@ static YAP_Term trie_to_list_floats(TrNode node); static TrEngine CURRENT_TRIE_ENGINE; static YAP_Int USAGE_ENTRIES, USAGE_NODES, USAGE_VIRTUAL_NODES; -static YAP_Int CURRENT_AUXILIARY_TERM_STACK_SIZE, CURRENT_TRIE_MODE, CURRENT_LOAD_VERSION, CURRENT_DEPTH, CURRENT_INDEX; +static YAP_Int CURRENT_AUXILIARY_TERM_STACK_SIZE, CURRENT_TRIE_MODE, + CURRENT_LOAD_VERSION, CURRENT_DEPTH, CURRENT_INDEX; static YAP_Term *AUXILIARY_TERM_STACK; YAP_Term *stack_args, *stack_args_base, *stack_vars, *stack_vars_base; static YAP_Functor FunctorComma; @@ -64,13 +61,11 @@ static void (*DATA_DESTRUCT_FUNCTION)(TrNode); static YAP_Int TRIE_DISABLE_HASH_TABLE = 0; - /* -------------------------- */ /* Inline Procedures */ /* -------------------------- */ -static -TrNode trie_node_check_insert(TrNode parent, YAP_Term t) { +static TrNode trie_node_check_insert(TrNode parent, YAP_Term t) { TrNode child; CURRENT_DEPTH++; @@ -82,35 +77,42 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) { TrHash hash; TrNode *bucket; int count; - hash = (TrHash) child; + hash = (TrHash)child; bucket = TrHash_bucket(hash, HASH_TERM(t, TrHash_seed(hash))); child = *bucket; count = 0; while (child) { - if ((TrNode_entry(child) == t) || (((TrNode_entry(child) == PairEndTermTag) || (TrNode_entry(child) == PairEndEmptyTag)) && ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL))) + if ((TrNode_entry(child) == t) || + (((TrNode_entry(child) == PairEndTermTag) || + (TrNode_entry(child) == PairEndEmptyTag)) && + ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL))) return child; count++; child = TrNode_next(child); - } while (child); + } + while (child) + ; TrHash_num_nodes(hash)++; new_trie_node(child, t, parent, NULL, *bucket, AS_TR_NODE_NEXT(bucket)); if (*bucket) TrNode_previous(*bucket) = child; *bucket = child; - if (count > MAX_NODES_PER_BUCKET && TrHash_num_nodes(hash) > TrHash_num_buckets(hash)) { + if (count > MAX_NODES_PER_BUCKET && + TrHash_num_nodes(hash) > TrHash_num_buckets(hash)) { /* expand trie hash */ TrNode chain, next, *first_bucket, *new_bucket; int seed; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); TrHash_num_buckets(hash) *= 2; - new_hash_buckets(hash, TrHash_num_buckets(hash)); + new_hash_buckets(hash, TrHash_num_buckets(hash)); seed = TrHash_num_buckets(hash) - 1; do { if (*--bucket) { chain = *bucket; do { - new_bucket = TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), seed)); + new_bucket = + TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), seed)); next = TrNode_next(chain); TrNode_next(chain) = *new_bucket; TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket); @@ -126,21 +128,26 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) { } else { int count = 0; do { - if ((TrNode_entry(child) == t) || (((TrNode_entry(child) == PairEndTermTag) || (TrNode_entry(child) == PairEndEmptyTag)) && ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL))) + if ((TrNode_entry(child) == t) || + (((TrNode_entry(child) == PairEndTermTag) || + (TrNode_entry(child) == PairEndEmptyTag)) && + ((CURRENT_TRIE_MODE & TRIE_MODE_MINIMAL) == TRIE_MODE_MINIMAL))) return child; count++; child = TrNode_next(child); } while (child); new_trie_node(child, t, parent, NULL, TrNode_child(parent), NULL); TrNode_previous(TrNode_child(parent)) = child; - if ((++count > MAX_NODES_PER_TRIE_LEVEL) && (TRIE_DISABLE_HASH_TABLE == 0)) { + if ((++count > MAX_NODES_PER_TRIE_LEVEL) && + (TRIE_DISABLE_HASH_TABLE == 0)) { /* alloc a new trie hash */ TrHash hash; TrNode chain, next, *bucket; new_trie_hash(hash, count, BASE_HASH_BUCKETS); chain = child; do { - bucket = TrHash_bucket(hash, HASH_TERM(TrNode_entry(chain), BASE_HASH_BUCKETS - 1)); + bucket = TrHash_bucket( + hash, HASH_TERM(TrNode_entry(chain), BASE_HASH_BUCKETS - 1)); next = TrNode_next(chain); TrNode_next(chain) = *bucket; TrNode_previous(chain) = AS_TR_NODE_NEXT(bucket); @@ -149,16 +156,14 @@ TrNode trie_node_check_insert(TrNode parent, YAP_Term t) { *bucket = chain; chain = next; } while (chain); - TrNode_child(parent) = (TrNode) hash; + TrNode_child(parent) = (TrNode)hash; } else TrNode_child(parent) = child; } return child; } - -static -TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) { +static TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) { TrNode child; CURRENT_DEPTH++; @@ -180,16 +185,14 @@ TrNode trie_node_insert(TrNode parent, YAP_Term t, TrHash hash) { return child; } - -static -TrNode trie_node_check(TrNode parent, YAP_Term t) { +static TrNode trie_node_check(TrNode parent, YAP_Term t) { TrNode child; child = TrNode_child(parent); if (IS_HASH_NODE(child)) { TrHash hash; TrNode *bucket; - hash = (TrHash) child; + hash = (TrHash)child; bucket = TrHash_bucket(hash, HASH_TERM(t, TrHash_seed(hash))); child = *bucket; if (!child) @@ -203,49 +206,42 @@ TrNode trie_node_check(TrNode parent, YAP_Term t) { return NULL; } - -static -YAP_Term trie_to_list_create_simple(const char *atom_name, TrNode node) { +static YAP_Term trie_to_list_create_simple(const char *atom_name, TrNode node) { YAP_Functor f = YAP_MkFunctor(YAP_LookupAtom(atom_name), 1); - YAP_Term child = trie_to_list(TrNode_child(node)); + YAP_Term child = trie_to_list(TrNode_child(node)); return YAP_MkApplTerm(f, 1, &child); } - -static -YAP_Term trie_to_list_create_simple_end(const char *atom_name, TrNode node) { +static YAP_Term trie_to_list_create_simple_end(const char *atom_name, + TrNode node) { YAP_Atom atom = YAP_LookupAtom(atom_name); - + if (IS_LEAF_TRIE_NODE(node)) { return YAP_MkAtomTerm(atom); } else { YAP_Functor f = YAP_MkFunctor(atom, 1); - YAP_Term child = trie_to_list(TrNode_child(node)); + YAP_Term child = trie_to_list(TrNode_child(node)); return YAP_MkApplTerm(f, 1, &child); } } - -static -YAP_Term trie_to_list_create_two(const char *atom_name, TrNode node, YAP_Term operand) { +static YAP_Term trie_to_list_create_two(const char *atom_name, TrNode node, + YAP_Term operand) { YAP_Atom atom = YAP_LookupAtom(atom_name); - - if(IS_LEAF_TRIE_NODE(node)) { + + if (IS_LEAF_TRIE_NODE(node)) { YAP_Functor f = YAP_MkFunctor(atom, 1); return YAP_MkApplTerm(f, 1, &operand); } else { YAP_Functor f = YAP_MkFunctor(atom, 2); - YAP_Term args[2] = { - operand, trie_to_list(TrNode_child(node)) - }; + YAP_Term args[2] = {operand, trie_to_list(TrNode_child(node))}; return YAP_MkApplTerm(f, 2, args); } } - /* -------------------------- */ -/* API */ +/* API */ /* -------------------------- */ TrEngine core_trie_init_module(void) { @@ -253,7 +249,8 @@ TrEngine core_trie_init_module(void) { TrEngine engine; if (init_once) { - new_struct(AUXILIARY_TERM_STACK, YAP_Term, BASE_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term)); + new_struct(AUXILIARY_TERM_STACK, YAP_Term, + BASE_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term)); CURRENT_AUXILIARY_TERM_STACK_SIZE = BASE_AUXILIARY_TERM_STACK_SIZE; CURRENT_TRIE_MODE = TRIE_MODE_STANDARD; FunctorComma = YAP_MkFunctor(YAP_LookupAtom(","), 2); @@ -263,13 +260,12 @@ TrEngine core_trie_init_module(void) { return engine; } - - TrNode core_trie_open(TrEngine engine) { TrNode node; CURRENT_TRIE_ENGINE = engine; - new_trie_node(node, 0, NULL, NULL, TrEngine_trie(engine), AS_TR_NODE_NEXT(&TrEngine_trie(engine))); + new_trie_node(node, 0, NULL, NULL, TrEngine_trie(engine), + AS_TR_NODE_NEXT(&TrEngine_trie(engine))); if (TrEngine_trie(engine)) TrNode_previous(TrEngine_trie(engine)) = node; TrEngine_trie(engine) = node; @@ -277,9 +273,8 @@ TrNode core_trie_open(TrEngine engine) { return node; } - - -void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) { +void core_trie_close(TrEngine engine, TrNode node, + void (*destruct_function)(TrNode)) { CURRENT_TRIE_ENGINE = engine; DATA_DESTRUCT_FUNCTION = destruct_function; if (TrNode_child(node)) @@ -289,39 +284,31 @@ void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrN TrNode_next(TrNode_previous(node)) = TrNode_next(node); } else TrNode_next(TrNode_previous(node)) = NULL; - free_trie_node(node); + free_trie_node(node); DECREMENT_TRIES(CURRENT_TRIE_ENGINE); return; } - - void core_trie_close_all(TrEngine engine, void (*destruct_function)(TrNode)) { while (TrEngine_trie(engine)) core_trie_close(engine, TrEngine_trie(engine), destruct_function); return; } - - void core_trie_set_mode(YAP_Int mode) { CURRENT_TRIE_MODE = mode; return; } +YAP_Int core_trie_get_mode(void) { return CURRENT_TRIE_MODE; } - -YAP_Int core_trie_get_mode(void) { - return CURRENT_TRIE_MODE; -} - - - -TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int *depth) { +TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, + YAP_Int *depth) { CURRENT_TRIE_ENGINE = engine; CURRENT_DEPTH = 0; stack_args_base = stack_args = AUXILIARY_TERM_STACK; - stack_vars_base = stack_vars = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; + stack_vars_base = stack_vars = + AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; node = put_entry(node, entry); if (!IS_LEAF_TRIE_NODE(node)) { MARK_AS_LEAF_TRIE_NODE(node); @@ -329,7 +316,7 @@ TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int } /* reset var terms */ while (STACK_NOT_EMPTY(stack_vars++, stack_vars_base)) { - (void) POP_DOWN(stack_vars); + (void)POP_DOWN(stack_vars); *((YAP_Term *)*stack_vars) = *stack_vars; } if (depth) @@ -337,34 +324,31 @@ TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int return node; } - - TrNode core_trie_check_entry(TrNode node, YAP_Term entry) { if (!TrNode_child(node)) return NULL; stack_args_base = stack_args = AUXILIARY_TERM_STACK; - stack_vars_base = stack_vars = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; + stack_vars_base = stack_vars = + AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; node = check_entry(node, entry); /* reset var terms */ while (STACK_NOT_EMPTY(stack_vars++, stack_vars_base)) { - (void) POP_DOWN(stack_vars); + (void)POP_DOWN(stack_vars); *((YAP_Term *)*stack_vars) = *stack_vars; } return node; } - - YAP_Term core_trie_get_entry(TrNode node) { CURRENT_INDEX = -1; stack_vars_base = stack_vars = AUXILIARY_TERM_STACK; - stack_args_base = stack_args = AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; + stack_args_base = stack_args = + AUXILIARY_TERM_STACK + CURRENT_AUXILIARY_TERM_STACK_SIZE - 1; return get_entry(node, stack_args, &node); } - - -void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) { +void core_trie_remove_entry(TrEngine engine, TrNode node, + void (*destruct_function)(TrNode)) { CURRENT_TRIE_ENGINE = engine; DATA_DESTRUCT_FUNCTION = destruct_function; if (DATA_DESTRUCT_FUNCTION) @@ -374,9 +358,8 @@ void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_functi return; } - - -void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)) { +void core_trie_remove_subtree(TrEngine engine, TrNode node, + void (*destruct_function)(TrNode)) { TrNode parent; CURRENT_TRIE_ENGINE = engine; @@ -387,18 +370,17 @@ void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_func return; } - - -void core_trie_add(TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode)) { +void core_trie_add(TrNode node_dest, TrNode node_source, + void (*add_function)(TrNode, TrNode)) { DATA_ADD_FUNCTION = add_function; if (TrNode_child(node_dest) && TrNode_child(node_source)) traverse_and_add(node_dest, node_source); return; } - - -void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*copy_function)(TrNode, TrNode)) { +void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, + void (*add_function)(TrNode, TrNode), + void (*copy_function)(TrNode, TrNode)) { CURRENT_TRIE_ENGINE = engine; DATA_ADD_FUNCTION = add_function; DATA_COPY_FUNCTION = copy_function; @@ -406,13 +388,14 @@ void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void if (TrNode_child(node_source)) traverse_and_join(node_dest, node_source); } else if (TrNode_child(node_source)) - TrNode_child(node_dest) = copy_child_nodes(node_dest, TrNode_child(node_source)); + TrNode_child(node_dest) = + copy_child_nodes(node_dest, TrNode_child(node_source)); return; } - - -void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*destruct_function)(TrNode)) { +void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, + void (*add_function)(TrNode, TrNode), + void (*destruct_function)(TrNode)) { CURRENT_TRIE_ENGINE = engine; DATA_ADD_FUNCTION = add_function; DATA_DESTRUCT_FUNCTION = destruct_function; @@ -427,8 +410,6 @@ void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, return; } - - YAP_Int core_trie_count_join(TrNode node1, TrNode node2) { YAP_Int count = 0; @@ -443,8 +424,6 @@ YAP_Int core_trie_count_join(TrNode node1, TrNode node2) { return count; } - - YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2) { YAP_Int count = 0; @@ -454,9 +433,8 @@ YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2) { return count; } - - -void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE *)) { +void core_trie_save(TrNode node, FILE *file, + void (*save_function)(TrNode, FILE *)) { CURRENT_INDEX = -1; DATA_SAVE_FUNCTION = save_function; if (TrNode_child(node)) { @@ -468,9 +446,8 @@ void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE return; } - - -TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, YAP_Int, FILE *)) { +TrNode core_trie_load(TrEngine engine, FILE *file, + void (*load_function)(TrNode, YAP_Int, FILE *)) { TrNode node; char version[15]; fpos_t curpos; @@ -486,7 +463,7 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, if (strcmp(version, "END_TRIE_v2")) { fprintf(stderr, "******************************************\n"); fprintf(stderr, " Tries core module: trie file corrupted\n"); - fprintf(stderr, "******************************************\n"); + fprintf(stderr, "******************************************\n"); fflush(stderr); return NULL; } @@ -499,7 +476,7 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, if (strcmp(version, "END_TRIE")) { fprintf(stderr, "******************************************\n"); fprintf(stderr, " Tries core module: trie file corrupted\n"); - fprintf(stderr, "******************************************\n"); + fprintf(stderr, "******************************************\n"); fflush(stderr); return NULL; } @@ -509,7 +486,7 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, } else { fprintf(stderr, "****************************************\n"); fprintf(stderr, " Tries core module: invalid trie file\n"); - fprintf(stderr, "****************************************\n"); + fprintf(stderr, "****************************************\n"); fflush(stderr); return NULL; } @@ -519,13 +496,13 @@ TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, DATA_LOAD_FUNCTION = load_function; node = core_trie_open(engine); traverse_and_load(node, file); - if (n) n = 0; // just added to remove the warning of not used! + if (n) + n = 0; // just added to remove the warning of not used! return node; } - - -void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes) { +void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, + YAP_Int *entries, YAP_Int *nodes) { *memory = TrEngine_memory(engine); *tries = TrEngine_tries(engine); *entries = TrEngine_entries(engine); @@ -533,9 +510,8 @@ void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int * return; } - - -void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes) { +void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, + YAP_Int *entries, YAP_Int *nodes) { *memory = TrEngine_memory_max(engine); *tries = TrEngine_tries_max(engine); *entries = TrEngine_entries_max(engine); @@ -543,9 +519,8 @@ void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_I return; } - - -void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *virtual_nodes) { +void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, + YAP_Int *virtual_nodes) { USAGE_ENTRIES = 0; USAGE_NODES = 0; USAGE_VIRTUAL_NODES = 0; @@ -557,8 +532,6 @@ void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *vir return; } - - void core_trie_print(TrNode node, void (*print_function)(TrNode)) { DATA_PRINT_FUNCTION = print_function; if (TrNode_child(node)) { @@ -572,42 +545,32 @@ void core_trie_print(TrNode node, void (*print_function)(TrNode)) { return; } +void core_disable_hash_table(void) { TRIE_DISABLE_HASH_TABLE = 1; } - -void core_disable_hash_table(void) { - TRIE_DISABLE_HASH_TABLE = 1; -} - - - -void core_enable_hash_table(void) { - TRIE_DISABLE_HASH_TABLE = 0; -} - - +void core_enable_hash_table(void) { TRIE_DISABLE_HASH_TABLE = 0; } YAP_Term core_trie_to_list(TrNode node) { TrNode root = TrNode_child(node); - + if (root) return trie_to_list(root); else return YAP_MkAtomTerm(YAP_LookupAtom("empty")); } - /* -------------------------- */ /* Local Procedures */ /* -------------------------- */ -static -TrNode put_entry(TrNode node, YAP_Term entry) { +static TrNode put_entry(TrNode node, YAP_Term entry) { YAP_Term t = YAP_Deref(entry); if (YAP_IsVarTerm(t)) { if (IsTrieVar(t, stack_vars, stack_vars_base)) { - node = trie_node_check_insert(node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2)); + node = trie_node_check_insert( + node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2)); } else { - node = trie_node_check_insert(node, MkTrieVar((stack_vars_base - stack_vars) / 2)); + node = trie_node_check_insert( + node, MkTrieVar((stack_vars_base - stack_vars) / 2)); PUSH_UP(stack_vars, t, stack_args); *((YAP_Term *)t) = (YAP_Term)stack_vars; PUSH_UP(stack_vars, stack_vars, stack_args); @@ -620,7 +583,7 @@ TrNode put_entry(TrNode node, YAP_Term entry) { volatile union { double f; YAP_Term p[SIZE_FLOAT_AS_TERM]; - } tf; /* to avoid gcc warning */ + } tf; /* to avoid gcc warning */ tf.f = YAP_FloatOfTerm(t); node = trie_node_check_insert(node, FloatInitTag); node = trie_node_check_insert(node, tf.p[0]); @@ -670,7 +633,7 @@ TrNode put_entry(TrNode node, YAP_Term entry) { node = trie_node_check_insert(node, CommaEndTag); } else { int i; - node = trie_node_check_insert(node, ApplTag | ((YAP_Term) f)); + node = trie_node_check_insert(node, ApplTag | ((YAP_Term)f)); for (i = 1; i <= YAP_ArityOfFunctor(f); i++) node = put_entry(node, YAP_ArgOfTerm(i, t)); } @@ -680,20 +643,20 @@ TrNode put_entry(TrNode node, YAP_Term entry) { fprintf(stderr, "***************************************\n"); fflush(stderr); } - + return node; } - -static -TrNode check_entry(TrNode node, YAP_Term entry) { +static TrNode check_entry(TrNode node, YAP_Term entry) { YAP_Term t = YAP_Deref(entry); if (YAP_IsVarTerm(t)) { if (IsTrieVar(t, stack_vars, stack_vars_base)) { - if (!(node = trie_node_check(node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2)))) + if (!(node = trie_node_check( + node, MkTrieVar((stack_vars_base - 1 - (YAP_Term *)t) / 2)))) return NULL; } else { - if (!(node = trie_node_check(node, MkTrieVar((stack_vars_base - stack_vars) / 2)))) + if (!(node = trie_node_check( + node, MkTrieVar((stack_vars_base - stack_vars) / 2)))) return NULL; PUSH_UP(stack_vars, t, stack_args); *((YAP_Term *)t) = (YAP_Term)stack_vars; @@ -709,7 +672,7 @@ TrNode check_entry(TrNode node, YAP_Term entry) { volatile union { double f; YAP_Term p[SIZE_FLOAT_AS_TERM]; - } tf; /* to avoid gcc warning */ + } tf; /* to avoid gcc warning */ tf.f = YAP_FloatOfTerm(t); if (!(node = trie_node_check(node, FloatInitTag))) return NULL; @@ -776,7 +739,7 @@ TrNode check_entry(TrNode node, YAP_Term entry) { return NULL; } else { int i; - if (!(node = trie_node_check(node, ApplTag | ((YAP_Term) f)))) + if (!(node = trie_node_check(node, ApplTag | ((YAP_Term)f)))) return NULL; for (i = 1; i <= YAP_ArityOfFunctor(f); i++) if (!(node = check_entry(node, YAP_ArgOfTerm(i, t)))) @@ -788,14 +751,12 @@ TrNode check_entry(TrNode node, YAP_Term entry) { fprintf(stderr, "***************************************\n"); fflush(stderr); } - + return node; } - -static -YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { - YAP_Term t = (YAP_Term) &t; +static YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { + YAP_Term t = (YAP_Term)&t; while (TrNode_parent(node)) { t = TrNode_entry(node); if (YAP_IsVarTerm(t)) { @@ -834,7 +795,8 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { t2 = *stack_aux--; t = YAP_MkPairTerm(t2, t); } - } else if (CURRENT_TRIE_MODE & TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */ + } else if (CURRENT_TRIE_MODE & + TRIE_MODE_REVERSE) { /* TRIE_MODE_REVERSE */ YAP_Term *stack_aux = stack_mark; t = *stack_aux; if (t == YAP_TermNil()) @@ -878,7 +840,7 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { volatile union { double f; YAP_Term p[SIZE_FLOAT_AS_TERM]; - } tf; /* to avoid gcc warning */ + } tf; /* to avoid gcc warning */ #ifdef TAG_LOW_BITS_32 node = TrNode_parent(node); tf.p[1] = TrNode_entry(node); @@ -908,14 +870,12 @@ YAP_Term get_entry(TrNode node, YAP_Term *stack_mark, TrNode *cur_node) { return t; } - -static -void remove_entry(TrNode node) { +static void remove_entry(TrNode node) { TrNode parent = TrNode_parent(node); while (parent) { if (TrNode_previous(node)) { if (IS_HASH_NODE(TrNode_child(parent))) { - TrHash hash = (TrHash) TrNode_child(parent); + TrHash hash = (TrHash)TrNode_child(parent); TrHash_num_nodes(hash)--; if (TrHash_num_nodes(hash)) { if (TrNode_next(node)) { @@ -953,12 +913,10 @@ void remove_entry(TrNode node) { return; } - -static -void remove_child_nodes(TrNode node) { +static void remove_child_nodes(TrNode node) { if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; - TrHash hash = (TrHash) node; + TrHash hash = (TrHash)node; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); do { @@ -982,18 +940,17 @@ void remove_child_nodes(TrNode node) { return; } - -static -TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) { +static TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) { TrNode child_dest, next_dest; if (IS_HASH_NODE(child_source)) { TrNode *bucket_dest, *first_bucket_source, *bucket_source; TrHash hash_dest, hash_source; - hash_source = (TrHash) child_source; + hash_source = (TrHash)child_source; first_bucket_source = TrHash_buckets(hash_source); bucket_source = first_bucket_source + TrHash_num_buckets(hash_source); - new_trie_hash(hash_dest, TrHash_num_nodes(hash_source), TrHash_num_buckets(hash_source)); + new_trie_hash(hash_dest, TrHash_num_nodes(hash_source), + TrHash_num_buckets(hash_source)); bucket_dest = TrHash_buckets(hash_dest) + TrHash_num_buckets(hash_dest); do { bucket_dest--; @@ -1003,14 +960,15 @@ TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) { } else *bucket_dest = NULL; } while (bucket_source != first_bucket_source); - return (TrNode) hash_dest; + return (TrNode)hash_dest; } if (TrNode_next(child_source)) next_dest = copy_child_nodes(parent_dest, TrNode_next(child_source)); else next_dest = NULL; - new_trie_node(child_dest, TrNode_entry(child_source), parent_dest, NULL, next_dest, NULL); + new_trie_node(child_dest, TrNode_entry(child_source), parent_dest, NULL, + next_dest, NULL); if (next_dest) TrNode_previous(next_dest) = child_dest; if (IS_LEAF_TRIE_NODE(child_source)) { @@ -1019,13 +977,12 @@ TrNode copy_child_nodes(TrNode parent_dest, TrNode child_source) { if (DATA_COPY_FUNCTION) (*DATA_COPY_FUNCTION)(child_dest, child_source); } else - TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source)); + TrNode_child(child_dest) = + copy_child_nodes(child_dest, TrNode_child(child_source)); return child_dest; } - -static -void traverse_and_add(TrNode parent_dest, TrNode parent_source) { +static void traverse_and_add(TrNode parent_dest, TrNode parent_source) { TrNode child_dest, child_source; /* parent_source is not a leaf node */ @@ -1033,7 +990,7 @@ void traverse_and_add(TrNode parent_dest, TrNode parent_source) { if (IS_HASH_NODE(child_source)) { TrNode *first_bucket_source, *bucket_source; TrHash hash_source; - hash_source = (TrHash) child_source; + hash_source = (TrHash)child_source; first_bucket_source = TrHash_buckets(hash_source); bucket_source = first_bucket_source + TrHash_num_buckets(hash_source); do { @@ -1072,9 +1029,7 @@ void traverse_and_add(TrNode parent_dest, TrNode parent_source) { return; } - -static -void traverse_and_join(TrNode parent_dest, TrNode parent_source) { +static void traverse_and_join(TrNode parent_dest, TrNode parent_source) { TrNode child_dest, child_source; /* parent_source is not a leaf node */ @@ -1082,7 +1037,7 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) { if (IS_HASH_NODE(child_source)) { TrNode *first_bucket_source, *bucket_source; TrHash hash_source; - hash_source = (TrHash) child_source; + hash_source = (TrHash)child_source; first_bucket_source = TrHash_buckets(hash_source); bucket_source = first_bucket_source + TrHash_num_buckets(hash_source); do { @@ -1099,14 +1054,16 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) { /* child_dest and child_source are not leaf nodes */ traverse_and_join(child_dest, child_source); } else { - child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source)); + child_dest = + trie_node_check_insert(parent_dest, TrNode_entry(child_source)); if (IS_LEAF_TRIE_NODE(child_source)) { MARK_AS_LEAF_TRIE_NODE(child_dest); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); if (DATA_COPY_FUNCTION) (*DATA_COPY_FUNCTION)(child_dest, child_source); } else - TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source)); + TrNode_child(child_dest) = + copy_child_nodes(child_dest, TrNode_child(child_source)); } child_source = TrNode_next(child_source); } @@ -1125,23 +1082,23 @@ void traverse_and_join(TrNode parent_dest, TrNode parent_source) { /* child_dest and child_source are not leaf nodes */ traverse_and_join(child_dest, child_source); } else { - child_dest = trie_node_check_insert(parent_dest, TrNode_entry(child_source)); + child_dest = + trie_node_check_insert(parent_dest, TrNode_entry(child_source)); if (IS_LEAF_TRIE_NODE(child_source)) { MARK_AS_LEAF_TRIE_NODE(child_dest); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); if (DATA_COPY_FUNCTION) (*DATA_COPY_FUNCTION)(child_dest, child_source); } else - TrNode_child(child_dest) = copy_child_nodes(child_dest, TrNode_child(child_source)); + TrNode_child(child_dest) = + copy_child_nodes(child_dest, TrNode_child(child_source)); } child_source = TrNode_next(child_source); } return; } - -static -void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) { +static void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) { TrNode child_dest, child_source, child_next; /* parent_dest is not a leaf node */ @@ -1149,7 +1106,7 @@ void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) { if (IS_HASH_NODE(child_dest)) { TrNode *first_bucket_dest, *bucket_dest; TrHash hash_dest; - hash_dest = (TrHash) child_dest; + hash_dest = (TrHash)child_dest; first_bucket_dest = TrHash_buckets(hash_dest); bucket_dest = first_bucket_dest + TrHash_num_buckets(hash_dest); do { @@ -1206,9 +1163,8 @@ void traverse_and_intersect(TrNode parent_dest, TrNode parent_source) { return; } - -static -YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) { +static YAP_Int traverse_and_count_common_entries(TrNode parent1, + TrNode parent2) { TrNode child1, child2; YAP_Int count = 0; @@ -1217,7 +1173,7 @@ YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) { if (IS_HASH_NODE(child1)) { TrNode *first_bucket, *bucket; TrHash hash; - hash = (TrHash) child1; + hash = (TrHash)child1; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); do { @@ -1254,15 +1210,13 @@ YAP_Int traverse_and_count_common_entries(TrNode parent1, TrNode parent2) { return count; } - -static -YAP_Int traverse_and_count_entries(TrNode node) { +static YAP_Int traverse_and_count_entries(TrNode node) { YAP_Int count = 0; if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; TrHash hash; - hash = (TrHash) node; + hash = (TrHash)node; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); do { @@ -1283,13 +1237,11 @@ YAP_Int traverse_and_count_entries(TrNode node) { return count; } - -static -void traverse_and_get_usage(TrNode node, YAP_Int depth) { +static void traverse_and_get_usage(TrNode node, YAP_Int depth) { if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; TrHash hash; - hash = (TrHash) node; + hash = (TrHash)node; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); do { @@ -1309,20 +1261,18 @@ void traverse_and_get_usage(TrNode node, YAP_Int depth) { traverse_and_get_usage(TrNode_child(node), depth); } else { USAGE_ENTRIES++; - USAGE_VIRTUAL_NODES+= depth; + USAGE_VIRTUAL_NODES += depth; } return; } - -static -void traverse_and_save(TrNode node, FILE *file, int float_block) { +static void traverse_and_save(TrNode node, FILE *file, int float_block) { YAP_Term t; if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; TrHash hash; - hash = (TrHash) node; + hash = (TrHash)node; fprintf(file, UInt_FORMAT " %d ", HASH_SAVE_MARK, TrHash_num_buckets(hash)); first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); @@ -1347,11 +1297,11 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) { #ifdef TAG_LOW_BITS_32 float_block++; #endif /* TAG_LOW_BITS_32 */ - float_block ++; + float_block++; } fprintf(file, UInt_FORMAT " ", t); } else if (YAP_IsVarTerm(t) || YAP_IsIntTerm(t)) - fprintf(file, UInt_FORMAT" ", t); + fprintf(file, UInt_FORMAT " ", t); else { int index; for (index = 0; index <= CURRENT_INDEX; index++) @@ -1363,37 +1313,35 @@ void traverse_and_save(TrNode node, FILE *file, int float_block) { expand_auxiliary_term_stack(); AUXILIARY_TERM_STACK[CURRENT_INDEX] = t; if (YAP_IsAtomTerm(t)) - fprintf(file, UInt_FORMAT " %d %s%c ", ATOM_SAVE_MARK, index, YAP_AtomName(YAP_AtomOfTerm(t)), '\0'); - else /* (ApplTag & t) */ - fprintf(file, UInt_FORMAT " %d %s " UInt_FORMAT " ", FUNCTOR_SAVE_MARK, index, + fprintf(file, UInt_FORMAT " %d %s%c ", ATOM_SAVE_MARK, index, + YAP_AtomName(YAP_AtomOfTerm(t)), '\0'); + else /* (ApplTag & t) */ + fprintf(file, UInt_FORMAT " %d %s " UInt_FORMAT " ", FUNCTOR_SAVE_MARK, + index, YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t))), YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t))); - } else - if (YAP_IsAtomTerm(t)) - fprintf(file, UInt_FORMAT " %d ", ATOM_SAVE_MARK, index); - else - fprintf(file, UInt_FORMAT " %d ", FUNCTOR_SAVE_MARK, index); + } else if (YAP_IsAtomTerm(t)) + fprintf(file, UInt_FORMAT " %d ", ATOM_SAVE_MARK, index); + else + fprintf(file, UInt_FORMAT " %d ", FUNCTOR_SAVE_MARK, index); } if (IS_LEAF_TRIE_NODE(node)) { fprintf(file, "- "); if (DATA_SAVE_FUNCTION) (*DATA_SAVE_FUNCTION)(node, file); - } - else { + } else { traverse_and_save(TrNode_child(node), file, float_block); fprintf(file, "- "); } return; } - -static -void traverse_and_load(TrNode parent, FILE *file) { +static void traverse_and_load(TrNode parent, FILE *file) { TrHash hash = NULL; YAP_Term t; int n; - if (!fscanf(file, UInt_FORMAT , &t)) { + if (!fscanf(file, UInt_FORMAT, &t)) { MARK_AS_LEAF_TRIE_NODE(parent); INCREMENT_ENTRIES(CURRENT_TRIE_ENGINE); if (DATA_LOAD_FUNCTION) @@ -1406,8 +1354,8 @@ void traverse_and_load(TrNode parent, FILE *file) { int num_buckets; n = fscanf(file, "%d", &num_buckets); new_trie_hash(hash, 0, num_buckets); - TrNode_child(parent) = (TrNode) hash; - n = fscanf(file, UInt_FORMAT , &t); + TrNode_child(parent) = (TrNode)hash; + n = fscanf(file, UInt_FORMAT, &t); } do { TrNode child; @@ -1419,7 +1367,7 @@ void traverse_and_load(TrNode parent, FILE *file) { if (CURRENT_LOAD_VERSION == 2) { char *ptr, ch; ptr = atom; - fgetc(file); /* skip the first empty space */ + fgetc(file); /* skip the first empty space */ while ((ch = fgetc(file))) *ptr++ = ch; *ptr = '\0'; @@ -1429,7 +1377,8 @@ void traverse_and_load(TrNode parent, FILE *file) { CURRENT_INDEX = index; if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE) expand_auxiliary_term_stack(); - AUXILIARY_TERM_STACK[CURRENT_INDEX] = YAP_MkAtomTerm(YAP_LookupAtom(atom)); + AUXILIARY_TERM_STACK[CURRENT_INDEX] = + YAP_MkAtomTerm(YAP_LookupAtom(atom)); } t = AUXILIARY_TERM_STACK[index]; } else if (t == FUNCTOR_SAVE_MARK) { @@ -1442,30 +1391,31 @@ void traverse_and_load(TrNode parent, FILE *file) { CURRENT_INDEX = index; if (CURRENT_INDEX == CURRENT_AUXILIARY_TERM_STACK_SIZE) expand_auxiliary_term_stack(); - AUXILIARY_TERM_STACK[CURRENT_INDEX] = ApplTag | ((YAP_Term) YAP_MkFunctor(YAP_LookupAtom(atom), arity)); + AUXILIARY_TERM_STACK[CURRENT_INDEX] = + ApplTag | ((YAP_Term)YAP_MkFunctor(YAP_LookupAtom(atom), arity)); } t = AUXILIARY_TERM_STACK[index]; } else if (t == FLOAT_SAVE_MARK) - n = fscanf(file, UInt_FORMAT , &t); + n = fscanf(file, UInt_FORMAT, &t); child = trie_node_insert(parent, t, hash); traverse_and_load(child, file); - } while (fscanf(file, UInt_FORMAT , &t)); + } while (fscanf(file, UInt_FORMAT, &t)); CURRENT_DEPTH--; - if (n) n = 0; // just added to remove the warning of not used! + if (n) + n = 0; // just added to remove the warning of not used! return; } - -static -void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int mode) { +static void traverse_and_print(TrNode node, int *arity, char *str, + int str_index, int mode) { YAP_Term t; int last_pair_mark = -arity[arity[0]]; if (IS_HASH_NODE(node)) { - int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + int *current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); TrNode *first_bucket, *bucket; TrHash hash; - hash = (TrHash) node; + hash = (TrHash)node; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); memmove(current_arity, arity, sizeof(int) * (arity[0] + 1)); @@ -1475,7 +1425,8 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m traverse_and_print(node, arity, str, str_index, mode); memmove(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) { - /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */ + /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag + * side-effect */ if (str_index > 0 && str[str_index - 1] != '[') str[str_index - 1] = ','; /* restore possible PairEndTermTag side-effect */ @@ -1489,12 +1440,13 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m } if (TrNode_next(node)) { - int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + int *current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1)); memmove(current_arity, arity, sizeof(int) * (arity[0] + 1)); traverse_and_print(TrNode_next(node), arity, str, str_index, mode); memmove(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); if (mode != TRIE_PRINT_FLOAT2 && arity[arity[0]] < 0) { - /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect */ + /* restore possible PairEndEmptyTag/PairEndTermTag/CommaEndTag side-effect + */ if (str_index > 0 && str[str_index - 1] != '[') str[str_index - 1] = ','; /* restore possible PairEndTermTag side-effect */ @@ -1511,75 +1463,76 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m t = TrNode_entry(node); if (mode == TRIE_PRINT_FLOAT) { #ifdef TAG_LOW_BITS_32 - arity[arity[0]] = (YAP_Int) t; + arity[arity[0]] = (YAP_Int)t; mode = TRIE_PRINT_FLOAT2; } else if (mode == TRIE_PRINT_FLOAT2) { volatile union { double f; YAP_Term p[SIZE_FLOAT_AS_TERM]; - } tf; /* to avoid gcc warning */ + } tf; /* to avoid gcc warning */ tf.p[1] = t; - tf.p[0] = (YAP_Term) arity[arity[0]]; + tf.p[0] = (YAP_Term)arity[arity[0]]; arity[arity[0]] = -1; -#else /* TAG_64BITS */ +#else /* TAG_64BITS */ volatile union { double f; YAP_Term p[SIZE_FLOAT_AS_TERM]; - } tf; /* to avoid gcc warning */ + } tf; /* to avoid gcc warning */ tf.p[0] = t; #endif /* TAG_SCHEME */ - str_index += sprintf(& str[str_index], "%.15g", tf.f); + str_index += sprintf(&str[str_index], "%.15g", tf.f); mode = TRIE_PRINT_FLOAT_END; } else if (mode == TRIE_PRINT_FLOAT_END) { arity[0]--; while (arity[0]) { if (arity[arity[0]] == 1) { - str_index += sprintf(& str[str_index], ")"); + str_index += sprintf(&str[str_index], ")"); arity[0]--; } else { if (arity[arity[0]] > 1) arity[arity[0]]--; - str_index += sprintf(& str[str_index], ","); + str_index += sprintf(&str[str_index], ","); break; } } mode = TRIE_PRINT_NORMAL; } else if (YAP_IsVarTerm(t)) { - str_index += sprintf(& str[str_index], "VAR" UInt_FORMAT, TrieVarIndex(t)); + str_index += sprintf(&str[str_index], "VAR" UInt_FORMAT, TrieVarIndex(t)); while (arity[0]) { if (arity[arity[0]] == 1) { - str_index += sprintf(& str[str_index], ")"); + str_index += sprintf(&str[str_index], ")"); arity[0]--; } else { if (arity[arity[0]] > 1) arity[arity[0]]--; - str_index += sprintf(& str[str_index], ","); + str_index += sprintf(&str[str_index], ","); break; } } } else if (YAP_IsAtomTerm(t)) { - str_index += sprintf(& str[str_index], "%s", YAP_AtomName(YAP_AtomOfTerm(t))); + str_index += + sprintf(&str[str_index], "%s", YAP_AtomName(YAP_AtomOfTerm(t))); while (arity[0]) { if (arity[arity[0]] == 1) { - str_index += sprintf(& str[str_index], ")"); + str_index += sprintf(&str[str_index], ")"); arity[0]--; } else { if (arity[arity[0]] > 1) arity[arity[0]]--; - str_index += sprintf(& str[str_index], ","); + str_index += sprintf(&str[str_index], ","); break; } } } else if (YAP_IsIntTerm(t)) { - str_index += sprintf(& str[str_index], UInt_FORMAT , YAP_IntOfTerm(t)); + str_index += sprintf(&str[str_index], UInt_FORMAT, YAP_IntOfTerm(t)); while (arity[0]) { if (arity[arity[0]] == 1) { - str_index += sprintf(& str[str_index], ")"); + str_index += sprintf(&str[str_index], ")"); arity[0]--; } else { if (arity[arity[0]] > 1) arity[arity[0]]--; - str_index += sprintf(& str[str_index], ","); + str_index += sprintf(&str[str_index], ","); break; } } @@ -1589,11 +1542,11 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m arity[0]++; arity[arity[0]] = -1; } else if (t == PairInitTag) { - str_index += sprintf(& str[str_index], "["); + str_index += sprintf(&str[str_index], "["); arity[0]++; arity[arity[0]] = -1; } else if (t == CommaInitTag) { - str_index += sprintf(& str[str_index], "("); + str_index += sprintf(&str[str_index], "("); arity[0]++; arity[arity[0]] = -1; } else { @@ -1607,18 +1560,20 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m arity[0]--; while (arity[0]) { if (arity[arity[0]] == 1) { - str_index += sprintf(& str[str_index], ")"); + str_index += sprintf(&str[str_index], ")"); arity[0]--; } else { if (arity[arity[0]] > 1) arity[arity[0]]--; - str_index += sprintf(& str[str_index], ","); + str_index += sprintf(&str[str_index], ","); break; } } } } else if (ApplTag & t) { - str_index += sprintf(& str[str_index], "%s(", YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t)))); + str_index += + sprintf(&str[str_index], "%s(", + YAP_AtomName(YAP_NameOfFunctor((YAP_Functor)(~ApplTag & t)))); arity[0]++; arity[arity[0]] = YAP_ArityOfFunctor((YAP_Functor)(~ApplTag & t)); } else { @@ -1639,24 +1594,22 @@ void traverse_and_print(TrNode node, int *arity, char *str, int str_index, int m return; } - -static -YAP_Term trie_to_list(TrNode node) { +static YAP_Term trie_to_list(TrNode node) { YAP_Term tail = YAP_MkAtomTerm(YAP_LookupAtom("[]")); -#define CONSUME_NODE_LIST \ - do { \ - /* add node result to list */ \ - tail = YAP_MkPairTerm(trie_to_list_node(node), tail); \ - } while((node = TrNode_next(node))); - +#define CONSUME_NODE_LIST \ + do { \ + /* add node result to list */ \ + tail = YAP_MkPairTerm(trie_to_list_node(node), tail); \ + } while ((node = TrNode_next(node))); + if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; - TrHash hash = (TrHash) node; - + TrHash hash = (TrHash)node; + first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); - + /* iterate through valid hash positions and consume each list */ do { if (*--bucket) { @@ -1666,31 +1619,29 @@ YAP_Term trie_to_list(TrNode node) { } while (bucket != first_bucket); } else { CONSUME_NODE_LIST; - } + } #undef CONSUME_NODE_LIST /* return list of trie options at this level */ return tail; } - -static -YAP_Term trie_to_list_node(TrNode node) { +static YAP_Term trie_to_list_node(TrNode node) { YAP_Term t = TrNode_entry(node); - - if(YAP_IsIntTerm(t) || YAP_IsAtomTerm(t)) { + + if (YAP_IsIntTerm(t) || YAP_IsAtomTerm(t)) { return trie_to_list_create_two(YAP_IsIntTerm(t) ? "int" : "atom", node, t); } else if (YAP_IsVarTerm(t)) { int index = TrieVarIndex(t); YAP_Term index_term = YAP_MkIntTerm((YAP_Int)index); return trie_to_list_create_two("var", node, index_term); } else if (YAP_IsPairTerm(t)) { - if(t == FloatInitTag) { - node = TrNode_child(node); /* consume FloatInitTag */ + if (t == FloatInitTag) { + node = TrNode_child(node); /* consume FloatInitTag */ YAP_Functor f = YAP_MkFunctor(YAP_LookupAtom("floats"), 1); YAP_Term child = trie_to_list_floats(node); return YAP_MkApplTerm(f, 1, &child); - } else if(t == PairInitTag) { + } else if (t == PairInitTag) { return trie_to_list_create_simple("list", node); } else if (t == PairEndEmptyTag) { return trie_to_list_create_simple_end("endlist", node); @@ -1703,70 +1654,66 @@ YAP_Term trie_to_list_node(TrNode node) { YAP_Functor f = (YAP_Functor)(~ApplTag & t); int arity = YAP_ArityOfFunctor(f); YAP_Functor new_f = YAP_MkFunctor(YAP_LookupAtom("functor"), 3); - YAP_Term args[3] = { - YAP_MkAtomTerm(YAP_NameOfFunctor(f)), - YAP_MkIntTerm((YAP_Int)arity), - trie_to_list(TrNode_child(node)) - }; + YAP_Term args[3] = {YAP_MkAtomTerm(YAP_NameOfFunctor(f)), + YAP_MkIntTerm((YAP_Int)arity), + trie_to_list(TrNode_child(node))}; return YAP_MkApplTerm(new_f, 3, args); } fprintf(stderr, "***************************************\n"); fprintf(stderr, " Tries core module: unknown type tag\n"); fprintf(stderr, "***************************************\n"); fflush(stderr); - + return YAP_MkAtomTerm(YAP_LookupAtom("fail")); } - -#define PUSH_NEW_FLOAT_TERM(val) \ - result = YAP_MkPairTerm( \ - trie_to_list_create_two("float", TrNode_child(node), YAP_MkFloatTerm(val)), \ - result); - +#define PUSH_NEW_FLOAT_TERM(val) \ + result = YAP_MkPairTerm(trie_to_list_create_two("float", TrNode_child(node), \ + YAP_MkFloatTerm(val)), \ + result); #ifdef TAG_LOW_BITS_32 -YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, volatile YAP_Term *p, volatile double *f) { - if(IS_HASH_NODE(node)) { +YAP_Term trie_to_list_floats_tag_low_32(YAP_Term result, TrNode node, + volatile YAP_Term *p, + volatile double *f) { + if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; - TrHash hash = (TrHash) node; - + TrHash hash = (TrHash)node; + first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); - + do { - if(*--bucket) { + if (*--bucket) { node = *bucket; do { p[1] = TrNode_entry(node); PUSH_NEW_FLOAT_TERM(*f); - } while((node = TrNode_next(node))); + } while ((node = TrNode_next(node))); } } while (bucket != first_bucket); } else { do { p[1] = TrNode_entry(node); PUSH_NEW_FLOAT_TERM(*f); - } while((node = TrNode_next(node))); + } while ((node = TrNode_next(node))); } - + return result; } #endif /* TAG_LOW_BITS_32 */ - -static -YAP_Term trie_to_list_floats(TrNode node) { +static YAP_Term trie_to_list_floats(TrNode node) { volatile union { double f; YAP_Term p[SIZE_FLOAT_AS_TERM]; - } tf; /* to avoid gcc warning */ + } tf; /* to avoid gcc warning */ YAP_Term result = YAP_MkAtomTerm(YAP_LookupAtom("[]")); if (IS_HASH_NODE(node)) { TrNode *first_bucket, *bucket; - TrHash hash = (TrHash) node; + TrHash hash = (TrHash)node; first_bucket = TrHash_buckets(hash); bucket = first_bucket + TrHash_num_buckets(hash); do { @@ -1775,27 +1722,28 @@ YAP_Term trie_to_list_floats(TrNode node) { do { tf.p[0] = TrNode_entry(node); #ifdef TAG_LOW_BITS_32 - result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, &tf.f); + result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), + &tf.p, &tf.f); #else PUSH_NEW_FLOAT_TERM(tf.f); #endif /* TAG_LOW_BITS_32 */ - } while((node = TrNode_next(node))); + } while ((node = TrNode_next(node))); } } while (bucket != first_bucket); } else { do { tf.p[0] = TrNode_entry(node); #ifdef TAG_LOW_BITS_32 - result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, &tf.f); + result = trie_to_list_floats_tag_low_32(result, TrNode_child(node), &tf.p, + &tf.f); #else PUSH_NEW_FLOAT_TERM(tf.f); #endif /* TAG_LOW_BITS_32 */ - } while((node = TrNode_next(node))); + } while ((node = TrNode_next(node))); } return result; } #undef PUSH_NEW_FLOAT_TERM - #include "core_dbtries.c" diff --git a/library/tries/core_tries.h b/library/tries/core_tries.h index 7cbef73be..576599564 100644 --- a/library/tries/core_tries.h +++ b/library/tries/core_tries.h @@ -5,61 +5,55 @@ version: $ID$ *********************************************/ - - /* -------------------------------------- */ /* Yap Tagging Scheme */ /* -------------------------------------- */ -#include "config.h" -#if SIZEOF_INT_P==4 -#define TAG_LOW_BITS_32 /* 'Tags_32LowTag.h' tagging scheme */ +#include "YapInterface.h" +#if SIZEOF_INT_P == 4 +#define TAG_LOW_BITS_32 /* 'Tags_32LowTag.h' tagging scheme */ #define SIZE_FLOAT_AS_TERM 2 -#elif SIZEOF_INT_P==8 -#define TAG_64BITS /* 'Tags_64bits.h' tagging scheme */ +#elif SIZEOF_INT_P == 8 +#define TAG_64BITS /* 'Tags_64bits.h' tagging scheme */ #define SIZE_FLOAT_AS_TERM 1 #else #error Unknown tagging scheme #endif /* YAP_SCHEME */ - - /* --------------------------- */ /* Defines */ /* --------------------------- */ #ifdef TAG_LOW_BITS_32 -#define ApplTag 1 /* 0x01 */ -#else /* TAG_64BITS */ -#define ApplTag 5 /* 0x05 */ -#endif /* TAG_SCHEME */ -#define PairInitTag 3 /* 0x03 */ -#define PairEndEmptyTag 19 /* 0x13 */ -#define PairEndTermTag 99 /* 0x63 */ -#define CommaInitTag 35 /* 0x23 */ -#define CommaEndTag 51 /* 0x33 */ -#define FloatInitTag 67 /* 0x43 */ -#define FloatEndTag 83 /* 0x53 */ +#define ApplTag 1 /* 0x01 */ +#else /* TAG_64BITS */ +#define ApplTag 5 /* 0x05 */ +#endif /* TAG_SCHEME */ +#define PairInitTag 3 /* 0x03 */ +#define PairEndEmptyTag 19 /* 0x13 */ +#define PairEndTermTag 99 /* 0x63 */ +#define CommaInitTag 35 /* 0x23 */ +#define CommaEndTag 51 /* 0x33 */ +#define FloatInitTag 67 /* 0x43 */ +#define FloatEndTag 83 /* 0x53 */ -#define TRIE_MODE_STANDARD 0 -#define TRIE_MODE_REVERSE 1 -#define TRIE_MODE_MINIMAL 2 -#define TRIE_MODE_REVMIN TRIE_MODE_REVERSE || TRIE_MODE_MINIMAL //3 +#define TRIE_MODE_STANDARD 0 +#define TRIE_MODE_REVERSE 1 +#define TRIE_MODE_MINIMAL 2 +#define TRIE_MODE_REVMIN TRIE_MODE_REVERSE || TRIE_MODE_MINIMAL // 3 -#define TRIE_PRINT_NORMAL 0 -#define TRIE_PRINT_FLOAT 1 -#define TRIE_PRINT_FLOAT2 2 +#define TRIE_PRINT_NORMAL 0 +#define TRIE_PRINT_FLOAT 1 +#define TRIE_PRINT_FLOAT2 2 #define TRIE_PRINT_FLOAT_END 3 #define BASE_AUXILIARY_TERM_STACK_SIZE 100000 - - /* --------------------------- */ /* Structs */ /* --------------------------- */ -typedef struct trie_engine { +typedef struct trie_engine { struct trie_node *first_trie; /* in use */ YAP_Int memory_in_use; @@ -71,17 +65,17 @@ typedef struct trie_engine { YAP_Int tries_max_used; YAP_Int entries_max_used; YAP_Int nodes_max_used; -} *TrEngine; +} * TrEngine; -#define TrEngine_trie(X) ((X)->first_trie) -#define TrEngine_memory(X) ((X)->memory_in_use) -#define TrEngine_tries(X) ((X)->tries_in_use) -#define TrEngine_entries(X) ((X)->entries_in_use) -#define TrEngine_nodes(X) ((X)->nodes_in_use) -#define TrEngine_memory_max(X) ((X)->memory_max_used) -#define TrEngine_tries_max(X) ((X)->tries_max_used) +#define TrEngine_trie(X) ((X)->first_trie) +#define TrEngine_memory(X) ((X)->memory_in_use) +#define TrEngine_tries(X) ((X)->tries_in_use) +#define TrEngine_entries(X) ((X)->entries_in_use) +#define TrEngine_nodes(X) ((X)->nodes_in_use) +#define TrEngine_memory_max(X) ((X)->memory_max_used) +#define TrEngine_tries_max(X) ((X)->tries_max_used) #define TrEngine_entries_max(X) ((X)->entries_max_used) -#define TrEngine_nodes_max(X) ((X)->nodes_max_used) +#define TrEngine_nodes_max(X) ((X)->nodes_max_used) typedef struct trie_node { struct trie_node *parent; @@ -89,230 +83,253 @@ typedef struct trie_node { struct trie_node *next; struct trie_node *previous; YAP_Term entry; -} *TrNode; +} * TrNode; -#define TrNode_parent(X) ((X)->parent) -#define TrNode_child(X) ((X)->child) -#define TrNode_next(X) ((X)->next) +#define TrNode_parent(X) ((X)->parent) +#define TrNode_child(X) ((X)->child) +#define TrNode_next(X) ((X)->next) #define TrNode_previous(X) ((X)->previous) -#define TrNode_entry(X) ((X)->entry) +#define TrNode_entry(X) ((X)->entry) typedef struct trie_hash { - struct trie_node *parent; /* for compatibility with the trie_node data structure */ + struct trie_node + *parent; /* for compatibility with the trie_node data structure */ struct trie_node **buckets; int number_of_buckets; int number_of_nodes; -} *TrHash; +} * TrHash; -#define TrHash_mark(X) ((X)->parent) -#define TrHash_buckets(X) ((X)->buckets) -#define TrHash_bucket(X,N) ((X)->buckets + N) +#define TrHash_mark(X) ((X)->parent) +#define TrHash_buckets(X) ((X)->buckets) +#define TrHash_bucket(X, N) ((X)->buckets + N) #define TrHash_num_buckets(X) ((X)->number_of_buckets) -#define TrHash_seed(X) ((X)->number_of_buckets - 1) -#define TrHash_num_nodes(X) ((X)->number_of_nodes) - -#define TYPE_TR_ENGINE struct trie_engine -#define TYPE_TR_NODE struct trie_node -#define TYPE_TR_HASH struct trie_hash -#define SIZEOF_TR_ENGINE sizeof(TYPE_TR_ENGINE) -#define SIZEOF_TR_NODE sizeof(TYPE_TR_NODE) -#define SIZEOF_TR_HASH sizeof(TYPE_TR_HASH) -#define SIZEOF_TR_BUCKET sizeof(TYPE_TR_NODE *) - -#define AS_TR_NODE_NEXT(ADDR) (TrNode)((YAP_UInt)(ADDR) - 2 * sizeof(struct trie_node *)) +#define TrHash_seed(X) ((X)->number_of_buckets - 1) +#define TrHash_num_nodes(X) ((X)->number_of_nodes) +#define TYPE_TR_ENGINE struct trie_engine +#define TYPE_TR_NODE struct trie_node +#define TYPE_TR_HASH struct trie_hash +#define SIZEOF_TR_ENGINE sizeof(TYPE_TR_ENGINE) +#define SIZEOF_TR_NODE sizeof(TYPE_TR_NODE) +#define SIZEOF_TR_HASH sizeof(TYPE_TR_HASH) +#define SIZEOF_TR_BUCKET sizeof(TYPE_TR_NODE *) +#define AS_TR_NODE_NEXT(ADDR) \ + (TrNode)((YAP_UInt)(ADDR)-2 * sizeof(struct trie_node *)) /* --------------------------- */ /* Macros */ /* --------------------------- */ -#define TAG_ADDR(ADDR) ((YAP_UInt)(ADDR) | 0x1) -#define UNTAG_ADDR(ADDR) ((YAP_UInt)(ADDR) & ~(0x1)) -#define PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, DATA) TrNode_child(TR_NODE) = (TrNode)TAG_ADDR(DATA) -#define GET_DATA_FROM_LEAF_TRIE_NODE(TR_NODE) UNTAG_ADDR(TrNode_child(TR_NODE)) -#define MARK_AS_LEAF_TRIE_NODE(TR_NODE) PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, TrNode_child(TR_NODE)) -#define IS_LEAF_TRIE_NODE(TR_NODE) ((YAP_UInt)(TrNode_child(TR_NODE)) & 0x1) +#define TAG_ADDR(ADDR) ((YAP_UInt)(ADDR) | 0x1) +#define UNTAG_ADDR(ADDR) ((YAP_UInt)(ADDR) & ~(0x1)) +#define PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, DATA) \ + TrNode_child(TR_NODE) = (TrNode)TAG_ADDR(DATA) +#define GET_DATA_FROM_LEAF_TRIE_NODE(TR_NODE) UNTAG_ADDR(TrNode_child(TR_NODE)) +#define MARK_AS_LEAF_TRIE_NODE(TR_NODE) \ + PUT_DATA_IN_LEAF_TRIE_NODE(TR_NODE, TrNode_child(TR_NODE)) +#define IS_LEAF_TRIE_NODE(TR_NODE) ((YAP_UInt)(TrNode_child(TR_NODE)) & 0x1) -#define IsTrieVar(TERM, STACK, STACK_BASE) ((YAP_Term *)(TERM) > STACK && (YAP_Term *)(TERM) <= STACK_BASE) -#define MkTrieVar(INDEX) ((INDEX) << 4) -#define TrieVarIndex(TERM) ((TERM) >> 4) +#define IsTrieVar(TERM, STACK, STACK_BASE) \ + ((YAP_Term *)(TERM) > STACK && (YAP_Term *)(TERM) <= STACK_BASE) +#define MkTrieVar(INDEX) ((INDEX) << 4) +#define TrieVarIndex(TERM) ((TERM) >> 4) -#define BASE_HASH_BUCKETS 256 +#define BASE_HASH_BUCKETS 256 #define MAX_NODES_PER_TRIE_LEVEL 32 -#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2) -#define HASH_TERM(TERM, SEED) (((TERM) >> 4) & (SEED)) -#define IS_HASH_NODE(NODE) (TrHash_mark(NODE) == NULL) +#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2) +#define HASH_TERM(TERM, SEED) (((TERM) >> 4) & (SEED)) +#define IS_HASH_NODE(NODE) (TrHash_mark(NODE) == NULL) -#define BASE_SAVE_MARK 10000 /* could lead to errors if the number of different variables in a term is greater than it */ -#define HASH_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK)) -#define ATOM_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK + 1)) -#define FUNCTOR_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK + 2)) -#define FLOAT_SAVE_MARK ((YAP_Term) MkTrieVar(BASE_SAVE_MARK + 3)) +#define BASE_SAVE_MARK \ + 10000 /* could lead to errors if the number of different variables in a term \ + is greater than it */ +#define HASH_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK)) +#define ATOM_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 1)) +#define FUNCTOR_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 2)) +#define FLOAT_SAVE_MARK ((YAP_Term)MkTrieVar(BASE_SAVE_MARK + 3)) #define STACK_NOT_EMPTY(STACK, STACK_BASE) STACK != STACK_BASE -#define POP_UP(STACK) *--STACK -#define POP_DOWN(STACK) *++STACK -#define PUSH_UP(STACK, ITEM, STACK_TOP) \ - { if (STACK < STACK_TOP) { \ - fprintf(stderr, "**************************************\n"); \ - fprintf(stderr, " Tries core module: term stack full\n"); \ - fprintf(stderr, "**************************************\n"); \ - } \ - *STACK = (YAP_Term)(ITEM); \ - STACK--; \ - } -#define PUSH_DOWN(STACK, ITEM, STACK_TOP) \ - { if (STACK > STACK_TOP) { \ - fprintf(stderr, "**************************************\n"); \ - fprintf(stderr, " Tries core module: term stack empty\n"); \ - fprintf(stderr, "**************************************\n"); \ - } \ - *STACK = (YAP_Term)(ITEM); \ - STACK++; \ - } +#define POP_UP(STACK) *--STACK +#define POP_DOWN(STACK) *++STACK +#define PUSH_UP(STACK, ITEM, STACK_TOP) \ + { \ + if (STACK < STACK_TOP) { \ + fprintf(stderr, "**************************************\n"); \ + fprintf(stderr, " Tries core module: term stack full\n"); \ + fprintf(stderr, "**************************************\n"); \ + } \ + *STACK = (YAP_Term)(ITEM); \ + STACK--; \ + } +#define PUSH_DOWN(STACK, ITEM, STACK_TOP) \ + { \ + if (STACK > STACK_TOP) { \ + fprintf(stderr, "**************************************\n"); \ + fprintf(stderr, " Tries core module: term stack empty\n"); \ + fprintf(stderr, "**************************************\n"); \ + } \ + *STACK = (YAP_Term)(ITEM); \ + STACK++; \ + } +#define new_struct(STR, STR_TYPE, STR_SIZE) \ + STR = (STR_TYPE *)YAP_AllocSpaceFromYap(STR_SIZE) +#define new_trie_engine(TR_ENGINE) \ + { \ + new_struct(TR_ENGINE, TYPE_TR_ENGINE, SIZEOF_TR_ENGINE); \ + TrEngine_trie(TR_ENGINE) = NULL; \ + TrEngine_memory(TR_ENGINE) = 0; \ + TrEngine_tries(TR_ENGINE) = 0; \ + TrEngine_entries(TR_ENGINE) = 0; \ + TrEngine_nodes(TR_ENGINE) = 0; \ + TrEngine_memory_max(TR_ENGINE) = 0; \ + TrEngine_tries_max(TR_ENGINE) = 0; \ + TrEngine_entries_max(TR_ENGINE) = 0; \ + TrEngine_nodes_max(TR_ENGINE) = 0; \ + } +#define new_trie_node(TR_NODE, ENTRY, PARENT, CHILD, NEXT, PREVIOUS) \ + { \ + new_struct(TR_NODE, TYPE_TR_NODE, SIZEOF_TR_NODE); \ + TrNode_entry(TR_NODE) = ENTRY; \ + TrNode_parent(TR_NODE) = PARENT; \ + TrNode_child(TR_NODE) = CHILD; \ + TrNode_next(TR_NODE) = NEXT; \ + TrNode_previous(TR_NODE) = PREVIOUS; \ + INCREMENT_NODES(CURRENT_TRIE_ENGINE); \ + INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \ + } +#define new_trie_hash(TR_HASH, NUM_NODES, NUM_BUCKETS) \ + { \ + new_struct(TR_HASH, TYPE_TR_HASH, SIZEOF_TR_HASH); \ + TrHash_mark(TR_HASH) = NULL; \ + TrHash_num_buckets(TR_HASH) = NUM_BUCKETS; \ + new_hash_buckets(TR_HASH, NUM_BUCKETS); \ + TrHash_num_nodes(TR_HASH) = NUM_NODES; \ + INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \ + } +#define new_hash_buckets(TR_HASH, NUM_BUCKETS) \ + { \ + int i; \ + void **ptr; \ + new_struct(ptr, void *, NUM_BUCKETS * sizeof(void *)); \ + TrHash_buckets(TR_HASH) = (TYPE_TR_NODE **)ptr; \ + for (i = NUM_BUCKETS; i != 0; i--) \ + *ptr++ = NULL; \ + INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS)*SIZEOF_TR_BUCKET); \ + } +#define expand_auxiliary_term_stack() \ + { \ + YAP_Term *aux_stack; \ + YAP_Int aux_size = CURRENT_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term); \ + new_struct(aux_stack, YAP_Term, aux_size * 2); \ + memmove(aux_stack, AUXILIARY_TERM_STACK, aux_size); \ + free_struct(AUXILIARY_TERM_STACK); \ + AUXILIARY_TERM_STACK = aux_stack; \ + CURRENT_AUXILIARY_TERM_STACK_SIZE *= 2; \ + } -#define new_struct(STR, STR_TYPE, STR_SIZE) \ - STR = (STR_TYPE *) YAP_AllocSpaceFromYap(STR_SIZE) -#define new_trie_engine(TR_ENGINE) \ - { new_struct(TR_ENGINE, TYPE_TR_ENGINE, SIZEOF_TR_ENGINE); \ - TrEngine_trie(TR_ENGINE) = NULL; \ - TrEngine_memory(TR_ENGINE) = 0; \ - TrEngine_tries(TR_ENGINE) = 0; \ - TrEngine_entries(TR_ENGINE) = 0; \ - TrEngine_nodes(TR_ENGINE) = 0; \ - TrEngine_memory_max(TR_ENGINE) = 0; \ - TrEngine_tries_max(TR_ENGINE) = 0; \ - TrEngine_entries_max(TR_ENGINE) = 0; \ - TrEngine_nodes_max(TR_ENGINE) = 0; \ - } -#define new_trie_node(TR_NODE, ENTRY, PARENT, CHILD, NEXT, PREVIOUS) \ - { new_struct(TR_NODE, TYPE_TR_NODE, SIZEOF_TR_NODE); \ - TrNode_entry(TR_NODE) = ENTRY; \ - TrNode_parent(TR_NODE) = PARENT; \ - TrNode_child(TR_NODE) = CHILD; \ - TrNode_next(TR_NODE) = NEXT; \ - TrNode_previous(TR_NODE) = PREVIOUS; \ - INCREMENT_NODES(CURRENT_TRIE_ENGINE); \ - INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \ - } -#define new_trie_hash(TR_HASH, NUM_NODES, NUM_BUCKETS) \ - { new_struct(TR_HASH, TYPE_TR_HASH, SIZEOF_TR_HASH); \ - TrHash_mark(TR_HASH) = NULL; \ - TrHash_num_buckets(TR_HASH) = NUM_BUCKETS; \ - new_hash_buckets(TR_HASH, NUM_BUCKETS); \ - TrHash_num_nodes(TR_HASH) = NUM_NODES; \ - INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \ - } -#define new_hash_buckets(TR_HASH, NUM_BUCKETS) \ - { int i; void **ptr; \ - new_struct(ptr, void *, NUM_BUCKETS * sizeof(void *)); \ - TrHash_buckets(TR_HASH) = (TYPE_TR_NODE **) ptr; \ - for (i = NUM_BUCKETS; i != 0; i--) \ - *ptr++ = NULL; \ - INCREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS) * SIZEOF_TR_BUCKET); \ - } +#define free_struct(STR) YAP_FreeSpaceFromYap((char *)(STR)) +#define free_trie_node(STR) \ + { \ + free_struct(STR); \ + DECREMENT_NODES(CURRENT_TRIE_ENGINE); \ + DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \ + } +#define free_trie_hash(STR) \ + { \ + free_struct(STR); \ + DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \ + } +#define free_hash_buckets(STR, NUM_BUCKETS) \ + { \ + free_struct(STR); \ + DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS)*SIZEOF_TR_BUCKET); \ + } +#define INCREMENT_MEMORY(TR_ENGINE, SIZE) \ + { \ + TrEngine_memory(TR_ENGINE) += SIZE; \ + if (TrEngine_memory(TR_ENGINE) > TrEngine_memory_max(TR_ENGINE)) \ + TrEngine_memory_max(TR_ENGINE) = TrEngine_memory(TR_ENGINE); \ + } +#define INCREMENT_TRIES(TR_ENGINE) \ + { \ + TrEngine_tries(TR_ENGINE)++; \ + if (TrEngine_tries(TR_ENGINE) > TrEngine_tries_max(TR_ENGINE)) \ + TrEngine_tries_max(TR_ENGINE) = TrEngine_tries(TR_ENGINE); \ + } +#define INCREMENT_ENTRIES(TR_ENGINE) \ + { \ + TrEngine_entries(TR_ENGINE)++; \ + if (TrEngine_entries(TR_ENGINE) > TrEngine_entries_max(TR_ENGINE)) \ + TrEngine_entries_max(TR_ENGINE) = TrEngine_entries(TR_ENGINE); \ + } +#define INCREMENT_NODES(TR_ENGINE) \ + { \ + TrEngine_nodes(TR_ENGINE)++; \ + if (TrEngine_nodes(TR_ENGINE) > TrEngine_nodes_max(TR_ENGINE)) \ + TrEngine_nodes_max(TR_ENGINE) = TrEngine_nodes(TR_ENGINE); \ + } +#define DECREMENT_MEMORY(TR_ENGINE, SIZE) TrEngine_memory(TR_ENGINE) -= SIZE +#define DECREMENT_TRIES(TR_ENGINE) TrEngine_tries(TR_ENGINE)-- +#define DECREMENT_ENTRIES(TR_ENGINE) TrEngine_entries(TR_ENGINE)-- +#define DECREMENT_NODES(TR_ENGINE) TrEngine_nodes(TR_ENGINE)-- - -#define expand_auxiliary_term_stack() \ - { YAP_Term *aux_stack; \ - YAP_Int aux_size = CURRENT_AUXILIARY_TERM_STACK_SIZE * sizeof(YAP_Term); \ - new_struct(aux_stack, YAP_Term, aux_size * 2); \ - memmove(aux_stack, AUXILIARY_TERM_STACK, aux_size); \ - free_struct(AUXILIARY_TERM_STACK); \ - AUXILIARY_TERM_STACK = aux_stack; \ - CURRENT_AUXILIARY_TERM_STACK_SIZE *= 2; \ - } - - - -#define free_struct(STR) \ - YAP_FreeSpaceFromYap((char *) (STR)) -#define free_trie_node(STR) \ - { free_struct(STR); \ - DECREMENT_NODES(CURRENT_TRIE_ENGINE); \ - DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_NODE); \ - } -#define free_trie_hash(STR) \ - { free_struct(STR); \ - DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, SIZEOF_TR_HASH); \ - } -#define free_hash_buckets(STR, NUM_BUCKETS) \ - { free_struct(STR); \ - DECREMENT_MEMORY(CURRENT_TRIE_ENGINE, (NUM_BUCKETS) * SIZEOF_TR_BUCKET); \ - } - - - -#define INCREMENT_MEMORY(TR_ENGINE, SIZE) \ - { TrEngine_memory(TR_ENGINE) += SIZE; \ - if (TrEngine_memory(TR_ENGINE) > TrEngine_memory_max(TR_ENGINE)) \ - TrEngine_memory_max(TR_ENGINE) = TrEngine_memory(TR_ENGINE); \ - } -#define INCREMENT_TRIES(TR_ENGINE) \ - { TrEngine_tries(TR_ENGINE)++; \ - if (TrEngine_tries(TR_ENGINE) > TrEngine_tries_max(TR_ENGINE)) \ - TrEngine_tries_max(TR_ENGINE) = TrEngine_tries(TR_ENGINE); \ - } -#define INCREMENT_ENTRIES(TR_ENGINE) \ - { TrEngine_entries(TR_ENGINE)++; \ - if (TrEngine_entries(TR_ENGINE) > TrEngine_entries_max(TR_ENGINE)) \ - TrEngine_entries_max(TR_ENGINE) = TrEngine_entries(TR_ENGINE); \ - } -#define INCREMENT_NODES(TR_ENGINE) \ - { TrEngine_nodes(TR_ENGINE)++; \ - if (TrEngine_nodes(TR_ENGINE) > TrEngine_nodes_max(TR_ENGINE)) \ - TrEngine_nodes_max(TR_ENGINE) = TrEngine_nodes(TR_ENGINE); \ - } -#define DECREMENT_MEMORY(TR_ENGINE, SIZE) \ - TrEngine_memory(TR_ENGINE) -= SIZE -#define DECREMENT_TRIES(TR_ENGINE) \ - TrEngine_tries(TR_ENGINE)-- -#define DECREMENT_ENTRIES(TR_ENGINE) \ - TrEngine_entries(TR_ENGINE)-- -#define DECREMENT_NODES(TR_ENGINE) \ - TrEngine_nodes(TR_ENGINE)-- - - -#define IS_FUNCTOR_NODE(N) (((ApplTag & TrNode_entry(N)) == ApplTag) && \ - (TrNode_entry(N) != PairInitTag) && \ - (TrNode_entry(N) != PairEndEmptyTag) && \ - (TrNode_entry(N) != PairEndTermTag)) - +#define IS_FUNCTOR_NODE(N) \ + (((ApplTag & TrNode_entry(N)) == ApplTag) && \ + (TrNode_entry(N) != PairInitTag) && (TrNode_entry(N) != PairEndEmptyTag) && \ + (TrNode_entry(N) != PairEndTermTag)) /* --------------------------- */ /* API */ /* --------------------------- */ extern TrEngine core_trie_init_module(void); -extern TrNode core_trie_open(TrEngine engine); -extern void core_trie_close(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)); -extern void core_trie_close_all(TrEngine engine, void (*destruct_function)(TrNode)); -extern void core_trie_set_mode(YAP_Int mode); -extern YAP_Int core_trie_get_mode(void); -extern TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, YAP_Int *depth); -extern TrNode core_trie_check_entry(TrNode node, YAP_Term entry); +extern TrNode core_trie_open(TrEngine engine); +extern void core_trie_close(TrEngine engine, TrNode node, + void (*destruct_function)(TrNode)); +extern void core_trie_close_all(TrEngine engine, + void (*destruct_function)(TrNode)); +extern void core_trie_set_mode(YAP_Int mode); +extern YAP_Int core_trie_get_mode(void); +extern TrNode core_trie_put_entry(TrEngine engine, TrNode node, YAP_Term entry, + YAP_Int *depth); +extern TrNode core_trie_check_entry(TrNode node, YAP_Term entry); extern YAP_Term core_trie_get_entry(TrNode node); -extern void core_trie_remove_entry(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)); -extern void core_trie_remove_subtree(TrEngine engine, TrNode node, void (*destruct_function)(TrNode)); -extern void core_trie_add(TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode)); -extern void core_trie_join(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*copy_function)(TrNode, TrNode)); -extern void core_trie_intersect(TrEngine engine, TrNode node_dest, TrNode node_source, void (*add_function)(TrNode, TrNode), void (*destruct_function)(TrNode)); -extern YAP_Int core_trie_count_join(TrNode node1, TrNode node2); -extern YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2); -extern void core_trie_save(TrNode node, FILE *file, void (*save_function)(TrNode, FILE *)); -extern TrNode core_trie_load(TrEngine engine, FILE *file, void (*load_function)(TrNode, YAP_Int, FILE *)); -extern void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes); -extern void core_trie_max_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, YAP_Int *entries, YAP_Int *nodes); -extern void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, YAP_Int *virtual_nodes); -extern void core_trie_print(TrNode node, void (*print_function)(TrNode)); +extern void core_trie_remove_entry(TrEngine engine, TrNode node, + void (*destruct_function)(TrNode)); +extern void core_trie_remove_subtree(TrEngine engine, TrNode node, + void (*destruct_function)(TrNode)); +extern void core_trie_add(TrNode node_dest, TrNode node_source, + void (*add_function)(TrNode, TrNode)); +extern void core_trie_join(TrEngine engine, TrNode node_dest, + TrNode node_source, + void (*add_function)(TrNode, TrNode), + void (*copy_function)(TrNode, TrNode)); +extern void core_trie_intersect(TrEngine engine, TrNode node_dest, + TrNode node_source, + void (*add_function)(TrNode, TrNode), + void (*destruct_function)(TrNode)); +extern YAP_Int core_trie_count_join(TrNode node1, TrNode node2); +extern YAP_Int core_trie_count_intersect(TrNode node1, TrNode node2); +extern void core_trie_save(TrNode node, FILE *file, + void (*save_function)(TrNode, FILE *)); +extern TrNode core_trie_load(TrEngine engine, FILE *file, + void (*load_function)(TrNode, YAP_Int, FILE *)); +extern void core_trie_stats(TrEngine engine, YAP_Int *memory, YAP_Int *tries, + YAP_Int *entries, YAP_Int *nodes); +extern void core_trie_max_stats(TrEngine engine, YAP_Int *memory, + YAP_Int *tries, YAP_Int *entries, + YAP_Int *nodes); +extern void core_trie_usage(TrNode node, YAP_Int *entries, YAP_Int *nodes, + YAP_Int *virtual_nodes); +extern void core_trie_print(TrNode node, void (*print_function)(TrNode)); -extern void core_disable_hash_table(void); -extern void core_enable_hash_table(void); +extern void core_disable_hash_table(void); +extern void core_enable_hash_table(void); -extern YAP_Term core_trie_to_list(TrNode node); +extern YAP_Term core_trie_to_list(TrNode node); #include "core_dbtries.h" diff --git a/os/open_memstream.c b/os/open_memstream.c index d8b3928c1..f230c3de0 100644 --- a/os/open_memstream.c +++ b/os/open_memstream.c @@ -16,8 +16,7 @@ /* Written by Eric Blake , 2010. */ - -#include "config.h" +#include "YapConfig.h" /* Specification. */ #include @@ -32,60 +31,55 @@ #if !HAVE_OPEN_MEMSTREAM && !_WIN32 #if !HAVE_FUNOPEN -# error Sorry, not ported to your platform yet +#error Sorry, not ported to your platform yet #else -FILE * open_memstream (char **buf, size_t *len); +FILE *open_memstream(char **buf, size_t *len); -# define INITIAL_ALLOC 64 +#define INITIAL_ALLOC 64 -struct data -{ - char **buf; /* User's argument. */ - size_t *len; /* User's argument. Smaller of pos or eof. */ - size_t pos; /* Current position. */ - size_t eof; /* End-of-file position. */ +struct data { + char **buf; /* User's argument. */ + size_t *len; /* User's argument. Smaller of pos or eof. */ + size_t pos; /* Current position. */ + size_t eof; /* End-of-file position. */ size_t allocated; /* Allocated size of *buf, always > eof. */ char c; /* Temporary storage for byte overwritten by NUL, if pos < eof. */ }; typedef struct data data; /* Stupid BSD interface uses int/int instead of ssize_t/size_t. */ -//verify (sizeof (int) <= sizeof (size_t)); -//verify (sizeof (int) <= sizeof (ssize_t)); +// verify (sizeof (int) <= sizeof (size_t)); +// verify (sizeof (int) <= sizeof (ssize_t)); -static int -mem_write (void *c, const char *buf, int n) -{ +static int mem_write(void *c, const char *buf, int n) { data *cookie = c; char *cbuf = *cookie->buf; /* Be sure we don't overflow. */ - if ((ssize_t) (cookie->pos + n) < 0) - { - errno = EFBIG; - return EOF; - } + if ((ssize_t)(cookie->pos + n) < 0) { + errno = EFBIG; + return EOF; + } /* Grow the buffer, if necessary. Use geometric growth to avoid quadratic realloc behavior. Overallocate, to accomodate the requirement to always place a trailing NUL not counted by length. Thus, we want max(prev_size*1.5, cookie->posn1). */ - if (cookie->allocated <= cookie->pos + n) - { - size_t newsize = cookie->allocated * 3 / 2; - if (newsize < cookie->pos + n + 1) - newsize = cookie->pos + n + 1; - cbuf = realloc (cbuf, newsize); - if (!cbuf) - return EOF; - *cookie->buf = cbuf; - cookie->allocated = newsize; - } + if (cookie->allocated <= cookie->pos + n) { + size_t newsize = cookie->allocated * 3 / 2; + if (newsize < cookie->pos + n + 1) + newsize = cookie->pos + n + 1; + cbuf = realloc(cbuf, newsize); + if (!cbuf) + return EOF; + *cookie->buf = cbuf; + cookie->allocated = newsize; + } /* If we have previously done a seek beyond eof, ensure all intermediate bytges are NUL. */ if (cookie->eof < cookie->pos) - memset (cbuf + cookie->eof, '\0', cookie->pos - cookie->eof); - memmove (cbuf + cookie->pos, buf, n); + memset(cbuf + cookie->eof, '\0', cookie->pos - cookie->eof); + memmove(cbuf + cookie->pos, buf, n); cookie->pos += n; /* If the user has previously written beyond the current position, remember what the trailing NUL is overwriting. Otherwise, @@ -99,9 +93,7 @@ mem_write (void *c, const char *buf, int n) return n; } -static fpos_t -mem_seek (void *c, fpos_t pos, int whence) -{ +static fpos_t mem_seek(void *c, fpos_t pos, int whence) { data *cookie = c; off_t offset = pos; @@ -109,88 +101,71 @@ mem_seek (void *c, fpos_t pos, int whence) offset = cookie->pos; else if (whence == SEEK_END) offset = cookie->eof; - if (offset < 0) - { - errno = EINVAL; - offset = -1; - } - else if ((size_t) offset != offset) - { - errno = ENOSPC; - offset = -1; - } - else - { - if (cookie->pos < cookie->eof) - { - (*cookie->buf)[cookie->pos] = cookie->c; - cookie->c = '\0'; - } - cookie->pos = offset; - if (cookie->pos < cookie->eof) - { - cookie->c = (*cookie->buf)[cookie->pos]; - (*cookie->buf)[cookie->pos] = '\0'; - *cookie->len = cookie->pos; - } - else - *cookie->len = cookie->eof; + if (offset < 0) { + errno = EINVAL; + offset = -1; + } else if ((size_t)offset != offset) { + errno = ENOSPC; + offset = -1; + } else { + if (cookie->pos < cookie->eof) { + (*cookie->buf)[cookie->pos] = cookie->c; + cookie->c = '\0'; } + cookie->pos = offset; + if (cookie->pos < cookie->eof) { + cookie->c = (*cookie->buf)[cookie->pos]; + (*cookie->buf)[cookie->pos] = '\0'; + *cookie->len = cookie->pos; + } else + *cookie->len = cookie->eof; + } return offset; } -static int -mem_close (void *c) -{ +static int mem_close(void *c) { data *cookie = c; char *buf; /* Be nice and try to reduce excess memory. */ - buf = realloc (*cookie->buf, *cookie->len + 1); + buf = realloc(*cookie->buf, *cookie->len + 1); if (buf) *cookie->buf = buf; - free (cookie); + free(cookie); return 0; } -FILE * -open_memstream (char **buf, size_t *len) -{ +FILE *open_memstream(char **buf, size_t *len) { FILE *f; data *cookie; - if (!buf || !len) - { - errno = EINVAL; - return NULL; - } - if (!(cookie = malloc (sizeof *cookie))) + if (!buf || !len) { + errno = EINVAL; return NULL; - if (!(*buf = malloc (INITIAL_ALLOC))) - { - free (cookie); - errno = ENOMEM; - return NULL; - } + } + if (!(cookie = malloc(sizeof *cookie))) + return NULL; + if (!(*buf = malloc(INITIAL_ALLOC))) { + free(cookie); + errno = ENOMEM; + return NULL; + } **buf = '\0'; *len = 0; - f = funopen (cookie, NULL, mem_write, mem_seek, mem_close); - if (!f) - { - int saved_errno = errno; - free (cookie); - errno = saved_errno; - } - else - { - cookie->buf = buf; - cookie->len = len; - cookie->pos = 0; - cookie->eof = 0; - cookie->c = '\0'; - cookie->allocated = INITIAL_ALLOC; - } + f = funopen(cookie, NULL, mem_write, mem_seek, mem_close); + if (!f) { + int saved_errno = errno; + free(cookie); + errno = saved_errno; + } else { + cookie->buf = buf; + cookie->len = len; + cookie->pos = 0; + cookie->eof = 0; + cookie->c = '\0'; + cookie->allocated = INITIAL_ALLOC; + } return f; } #endif /* HAVE_FUNOPEN */ diff --git a/os/sysbits.h b/os/sysbits.h index 208be1107..a21cdd356 100644 --- a/os/sysbits.h +++ b/os/sysbits.h @@ -13,7 +13,7 @@ * */ -#include "config.h" +#include "YapConfig.h" #if _WIN32 || defined(__MINGW32__) #if !defined(MINGW_HAS_SECURE_API) @@ -22,10 +22,10 @@ //#undef _POSIX_ #endif #include "Yap.h" +#include "YapEval.h" #include "YapHeap.h" #include "YapText.h" #include "Yatom.h" -#include "YapEval.h" #include "yapio.h" // Win32 InputOutput Support @@ -46,7 +46,6 @@ #endif #endif - #ifdef HAVE_UNISTD_H #include #endif @@ -121,7 +120,6 @@ /* windows.h does not like absmi.h, this should fix it for now */ #include -#include #if HAVE_TIME_H #include #endif diff --git a/packages/bdd/cudd.c b/packages/bdd/cudd.c index 077ce460e..fa5163010 100644 --- a/packages/bdd/cudd.c +++ b/packages/bdd/cudd.c @@ -41,7 +41,6 @@ CUDD will generate better/faster code. #include #include "YapInterface.h" -#include "config.h" #include "cudd_config.h" #if HAVE_STRING_H @@ -811,7 +810,7 @@ static YAP_Bool p_cudd_print_with_names(void) { DdManager *manager = (DdManager *)YAP_IntOfTerm(YAP_ARG1); DdNode *n0 = (DdNode *)YAP_IntOfTerm(YAP_ARG2); const char *s = YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)); - char ** namesp; + char **namesp; YAP_Term names = YAP_ARG4; FILE *f; YAP_Int len; @@ -850,7 +849,7 @@ static YAP_Bool p_cudd_print_with_names(void) { names = YAP_TailOfTerm(names); namesp[i++] = f; } - Cudd_DumpDot(manager, 1, &n0, (const char * const*)namesp, NULL, f); + Cudd_DumpDot(manager, 1, &n0, (const char *const *)namesp, NULL, f); if (f != stdout && f != stderr) fclose(f); while (i > 0) { @@ -863,8 +862,8 @@ static YAP_Bool p_cudd_print_with_names(void) { static YAP_Bool p_cudd_die(void) { DdManager *manager = (DdManager *)YAP_IntOfTerm(YAP_ARG1); - //Cudd_FreeTree(manager); - //cuddFreeTable(manager); + // Cudd_FreeTree(manager); + // cuddFreeTable(manager); Cudd_CheckZeroRef(manager); Cudd_Quit(manager); return TRUE; diff --git a/packages/bdd/simplecudd/simplecudd.h b/packages/bdd/simplecudd/simplecudd.h index 746d9423f..62e11bc36 100644 --- a/packages/bdd/simplecudd/simplecudd.h +++ b/packages/bdd/simplecudd/simplecudd.h @@ -186,14 +186,13 @@ * * \******************************************************************************/ - +#include "YapInterface.h" +#include "cudd_config.h" +#include #include #include #include -#include #include -#include "config.h" -#include "cudd_config.h" #if HAVE_CUDD_UTIL_H #include @@ -214,26 +213,26 @@ #include "general.h" -#define IsHigh(manager, node) HIGH(manager) == node -#define IsLow(manager, node) LOW(manager) == node -#define HIGH(manager) Cudd_ReadOne(manager) -#define LOW(manager) Cudd_Not(Cudd_ReadOne(manager)) -#define NOT(node) Cudd_Not(node) -#define GetIndex(node) Cudd_NodeReadIndex(node) +#define IsHigh(manager, node) HIGH(manager) == node +#define IsLow(manager, node) LOW(manager) == node +#define HIGH(manager) Cudd_ReadOne(manager) +#define LOW(manager) Cudd_Not(Cudd_ReadOne(manager)) +#define NOT(node) Cudd_Not(node) +#define GetIndex(node) Cudd_NodeReadIndex(node) #define GetOrder(manager, node) Cudd_ReadPerm(manager, GetIndex(node)) -#define GetVar(manager, index) Cudd_bddIthVar(manager, index) -#define NewVar(manager) Cudd_bddNewVar(manager) -#define KillBDD(manager) Cudd_Quit(manager) -#define GetVarCount(manager) Cudd_ReadSize(manager) -#define DEBUGON _debug = 1 -#define DEBUGOFF _debug = 0 -#define RAPIDLOADON _RapidLoad = 1 -#define RAPIDLOADOFF _RapidLoad = 0 -#define SETMAXBUFSIZE(size) _maxbufsize = size -#define BDDFILE_ERROR -1 -#define BDDFILE_OTHER 0 -#define BDDFILE_SCRIPT 1 -#define BDDFILE_NODEDUMP 2 +#define GetVar(manager, index) Cudd_bddIthVar(manager, index) +#define NewVar(manager) Cudd_bddNewVar(manager) +#define KillBDD(manager) Cudd_Quit(manager) +#define GetVarCount(manager) Cudd_ReadSize(manager) +#define DEBUGON _debug = 1 +#define DEBUGOFF _debug = 0 +#define RAPIDLOADON _RapidLoad = 1 +#define RAPIDLOADOFF _RapidLoad = 0 +#define SETMAXBUFSIZE(size) _maxbufsize = size +#define BDDFILE_ERROR -1 +#define BDDFILE_OTHER 0 +#define BDDFILE_SCRIPT 1 +#define BDDFILE_NODEDUMP 2 extern int _RapidLoad; extern int _debug; @@ -281,28 +280,33 @@ typedef struct _nodeline { /* Initialization */ -DdManager* simpleBDDinit(int varcnt); -DdManager* simpleBDDinitNoReOrder(int varcnt); +DdManager *simpleBDDinit(int varcnt); +DdManager *simpleBDDinitNoReOrder(int varcnt); /* BDD Generation */ -DdNode* D_BDDAnd(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDNand(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDOr(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDAnd(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDNand(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDOr(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* FileGenerateBDD(DdManager *manager, namedvars varmap, bddfileheader fileheader); -DdNode** FileGenerateBDDForest(DdManager *manager, namedvars varmap, bddfileheader fileheader); -DdNode* OnlineGenerateBDD(DdManager *manager, namedvars *varmap); -DdNode* LineParser(DdManager *manager, namedvars varmap, DdNode **inter, int maxinter, char *function, int iline); -DdNode* OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, int maxinter, char *function, int iline); -DdNode* BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, char Operator, int inegoper); +DdNode *FileGenerateBDD(DdManager *manager, namedvars varmap, + bddfileheader fileheader); +DdNode **FileGenerateBDDForest(DdManager *manager, namedvars varmap, + bddfileheader fileheader); +DdNode *OnlineGenerateBDD(DdManager *manager, namedvars *varmap); +DdNode *LineParser(DdManager *manager, namedvars varmap, DdNode **inter, + int maxinter, char *function, int iline); +DdNode *OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, + int maxinter, char *function, int iline); +DdNode *BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, + char Operator, int inegoper); int getInterBDD(char *function); -char* getFileName(const char *function); +char *getFileName(const char *function); int GetParam(char *inputline, int iParam); -char** GetVariableOrder(char *filename, int varcnt); +char **GetVariableOrder(char *filename, int varcnt); int LoadVariableData(namedvars varmap, char *filename); /* Named variables */ @@ -313,42 +317,51 @@ namedvars InitNamedVars(int varcnt, int varstart); void EnlargeNamedVars(namedvars *varmap, int newvarcnt); int AddNamedVarAt(namedvars varmap, const char *varname, int index); int AddNamedVar(namedvars varmap, const char *varname); -void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, void *dynvalue); -int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue); +void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, + void *dynvalue); +int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, + int ivalue, void *dynvalue); int GetNamedVarIndex(const namedvars varmap, const char *varname); int RepairVarcnt(namedvars *varmap); -char* GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); -char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node); +char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); +char *GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node); int all_loaded(namedvars varmap, int disp); /* Traversal */ -DdNode* HighNodeOf(DdManager *manager, DdNode *node); -DdNode* LowNodeOf(DdManager *manager, DdNode *node); +DdNode *HighNodeOf(DdManager *manager, DdNode *node); +DdNode *LowNodeOf(DdManager *manager, DdNode *node); /* Traversal - History */ -hisqueue* InitHistory(int varcnt); +hisqueue *InitHistory(int varcnt); void ReInitHistory(hisqueue *HisQueue, int varcnt); -void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue); -hisnode* GetNode(hisqueue *HisQueue, int varstart, DdNode *node); +void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, + int ivalue, void *dynvalue); +hisnode *GetNode(hisqueue *HisQueue, int varstart, DdNode *node); int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node); -void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd); +void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, + DdNode *bdd); /* Save-load */ bddfileheader ReadFileHeader(char *filename); int CheckFileVersion(const char *version); -DdNode * LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile); -DdNode * LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, FILE *inputfile, nodeline current); -DdNode * GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, char *varname, int nodenum); +DdNode *LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile); +DdNode *LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, + FILE *inputfile, nodeline current); +DdNode *GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, + char *varname, int nodenum); -int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); -void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile); +int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, + char *filename); +void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, + DdNode *Current, FILE *outputfile); void ExpandNodes(hisqueue *Nodes, int index, int nodenum); /* Export */ int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename); -int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); +int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, + char *filename); diff --git a/packages/bdd/simplecudd_lfi/simplecudd.h b/packages/bdd/simplecudd_lfi/simplecudd.h index 89bcd7fb8..9cd5778c2 100644 --- a/packages/bdd/simplecudd_lfi/simplecudd.h +++ b/packages/bdd/simplecudd_lfi/simplecudd.h @@ -184,16 +184,15 @@ * * \******************************************************************************/ - -#include +#include "YapInterface.h" +#include "cudd_config.h" +#include "pqueue.h" +#include #include #include #include -#include #include -#include "pqueue.h" -#include "config.h" -#include "cudd_config.h" +#include #if HAVE_CUDD_UTIL_H #include #elif HAVE_UTIL_H @@ -216,26 +215,26 @@ #include "general.h" -#define IsHigh(manager, node) HIGH(manager) == node -#define IsLow(manager, node) LOW(manager) == node -#define HIGH(manager) Cudd_ReadOne(manager) -#define LOW(manager) Cudd_Not(Cudd_ReadOne(manager)) -#define NOT(node) Cudd_Not(node) -#define GetIndex(node) Cudd_NodeReadIndex(node) +#define IsHigh(manager, node) HIGH(manager) == node +#define IsLow(manager, node) LOW(manager) == node +#define HIGH(manager) Cudd_ReadOne(manager) +#define LOW(manager) Cudd_Not(Cudd_ReadOne(manager)) +#define NOT(node) Cudd_Not(node) +#define GetIndex(node) Cudd_NodeReadIndex(node) #define GetOrder(manager, node) Cudd_ReadPerm(manager, GetIndex(node)) -#define GetVar(manager, index) Cudd_bddIthVar(manager, index) -#define NewVar(manager) Cudd_bddNewVar(manager) -#define KillBDD(manager) Cudd_Quit(manager) -#define GetVarCount(manager) Cudd_ReadSize(manager) -#define DEBUGON _debug = 1 -#define DEBUGOFF _debug = 0 -#define RAPIDLOADON _RapidLoad = 1 -#define RAPIDLOADOFF _RapidLoad = 0 -#define SETMAXBUFSIZE(size) _maxbufsize = size -#define BDDFILE_ERROR -1 -#define BDDFILE_OTHER 0 -#define BDDFILE_SCRIPT 1 -#define BDDFILE_NODEDUMP 2 +#define GetVar(manager, index) Cudd_bddIthVar(manager, index) +#define NewVar(manager) Cudd_bddNewVar(manager) +#define KillBDD(manager) Cudd_Quit(manager) +#define GetVarCount(manager) Cudd_ReadSize(manager) +#define DEBUGON _debug = 1 +#define DEBUGOFF _debug = 0 +#define RAPIDLOADON _RapidLoad = 1 +#define RAPIDLOADOFF _RapidLoad = 0 +#define SETMAXBUFSIZE(size) _maxbufsize = size +#define BDDFILE_ERROR -1 +#define BDDFILE_OTHER 0 +#define BDDFILE_SCRIPT 1 +#define BDDFILE_NODEDUMP 2 extern int _RapidLoad; extern int _debug; @@ -253,7 +252,7 @@ typedef struct _bddfileheader { typedef struct _namedvars { int varcnt; int varstart; - char ** vars; + char **vars; int *loaded; double *dvalue; int *ivalue; @@ -265,7 +264,7 @@ typedef struct _namedvars { typedef struct _hisnode { DdNode *key; double dvalue; - double dvalue2;// =0; //needed for expected counts + double dvalue2; // =0; //needed for expected counts int ivalue; void *dynvalue; } hisnode; @@ -286,27 +285,32 @@ typedef struct _nodeline { /* Initialization */ -DdManager* simpleBDDinit(int varcnt); +DdManager *simpleBDDinit(int varcnt); /* BDD Generation */ -DdNode* D_BDDAnd(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDNand(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDOr(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDAnd(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDNand(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDOr(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); +DdNode *D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2); -DdNode* FileGenerateBDD(DdManager *manager, namedvars varmap, bddfileheader fileheader); -DdNode** FileGenerateBDDForest(DdManager *manager, namedvars varmap, bddfileheader fileheader); -DdNode* OnlineGenerateBDD(DdManager *manager, namedvars *varmap); -DdNode* LineParser(DdManager *manager, namedvars varmap, DdNode **inter, int maxinter, char *function, int iline); -DdNode* OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, int maxinter, char *function, int iline); -DdNode* BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, char Operator, int inegoper); +DdNode *FileGenerateBDD(DdManager *manager, namedvars varmap, + bddfileheader fileheader); +DdNode **FileGenerateBDDForest(DdManager *manager, namedvars varmap, + bddfileheader fileheader); +DdNode *OnlineGenerateBDD(DdManager *manager, namedvars *varmap); +DdNode *LineParser(DdManager *manager, namedvars varmap, DdNode **inter, + int maxinter, char *function, int iline); +DdNode *OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, + int maxinter, char *function, int iline); +DdNode *BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, + char Operator, int inegoper); int getInterBDD(char *function); -char* getFileName(const char *function); +char *getFileName(const char *function); int GetParam(char *inputline, int iParam); -char** GetVariableOrder(char *filename, int varcnt); +char **GetVariableOrder(char *filename, int varcnt); int LoadVariableData(namedvars varmap, char *filename); /* Named variables */ @@ -317,43 +321,53 @@ namedvars InitNamedVars(int varcnt, int varstart); void EnlargeNamedVars(namedvars *varmap, int newvarcnt); int AddNamedVarAt(namedvars varmap, const char *varname, int index); int AddNamedVar(namedvars varmap, const char *varname); -void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, void *dynvalue); -int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue); +void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, + void *dynvalue); +int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, + int ivalue, void *dynvalue); int GetNamedVarIndex(const namedvars varmap, const char *varname); int RepairVarcnt(namedvars *varmap); -const char* GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); -const char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node); +const char *GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node); +const char *GetNodeVarNameDisp(DdManager *manager, namedvars varmap, + DdNode *node); int all_loaded(namedvars varmap, int disp); int all_loaded_for_deterministic_variables(namedvars varmap, int disp); /* Traversal */ -DdNode* HighNodeOf(DdManager *manager, DdNode *node); -DdNode* LowNodeOf(DdManager *manager, DdNode *node); +DdNode *HighNodeOf(DdManager *manager, DdNode *node); +DdNode *LowNodeOf(DdManager *manager, DdNode *node); /* Traversal - History */ -hisqueue* InitHistory(int varcnt); +hisqueue *InitHistory(int varcnt); void ReInitHistory(hisqueue *HisQueue, int varcnt); -void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue); -hisnode* GetNode(hisqueue *HisQueue, int varstart, DdNode *node); +void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, + int ivalue, void *dynvalue); +hisnode *GetNode(hisqueue *HisQueue, int varstart, DdNode *node); int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node); -void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd); +void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, + DdNode *bdd); /* Save-load */ bddfileheader ReadFileHeader(char *filename); int CheckFileVersion(const char *version); -DdNode * LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile); -DdNode * LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, FILE *inputfile, nodeline current); -DdNode * GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, char *varname, int nodenum); +DdNode *LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile); +DdNode *LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, + FILE *inputfile, nodeline current); +DdNode *GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, + char *varname, int nodenum); -int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename); -void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile); +int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, + char *filename); +void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, + DdNode *Current, FILE *outputfile); void ExpandNodes(hisqueue *Nodes, int index, int nodenum); /* Export */ int simpleBDDtoDot(DdManager *manager, DdNode *bdd, const char *filename); -int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, const char *filename); +int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, + const char *filename); diff --git a/packages/cplint/approx/simplecuddLPADs/simplecudd.h b/packages/cplint/approx/simplecuddLPADs/simplecudd.h index b270cadeb..bc53867d7 100644 --- a/packages/cplint/approx/simplecuddLPADs/simplecudd.h +++ b/packages/cplint/approx/simplecuddLPADs/simplecudd.h @@ -190,7 +190,7 @@ form variable=value */ -#include "config.h" +#include "YapInterface.h" #include "cudd_config.h" #include #include diff --git a/packages/cplint/cplint.h b/packages/cplint/cplint.h index 430d80c64..e1aa49ce6 100644 --- a/packages/cplint/cplint.h +++ b/packages/cplint/cplint.h @@ -7,7 +7,6 @@ This package uses the library cudd, see http://vlsi.colorado.edu/~fabio/CUDD/ for the relative license. */ -#include "config.h" #include "cudd_config.h" #include #if HAVE_CUDDINT_H @@ -18,7 +17,9 @@ for the relative license. #include "YapInterface.h" -typedef struct { int var, value; } factor; +typedef struct { + int var, value; +} factor; typedef struct { int nFact; diff --git a/packages/cplint/slipcase/bddem.c b/packages/cplint/slipcase/bddem.c index ab7fd4263..7aee6baca 100644 --- a/packages/cplint/slipcase/bddem.c +++ b/packages/cplint/slipcase/bddem.c @@ -9,7 +9,6 @@ for the relative license. */ -#include "config.h" #include "cudd_config.h" #include #include @@ -366,7 +365,7 @@ static YAP_Bool add_var(void) { probTerm = arg2; p0 = 1; for (i = 0; i < v->nVal - 1; i++) { - //node = Cudd_bddIthVar(mgr_ex[ex], boolVars_ex[ex] + i); + // node = Cudd_bddIthVar(mgr_ex[ex], boolVars_ex[ex] + i); p = YAP_FloatOfTerm(YAP_HeadOfTerm(probTerm)); bVar2mVar_ex[ex][boolVars_ex[ex] + i] = nVars_ex[ex] - 1; probs_ex[ex][boolVars_ex[ex] + i] = p / p0; diff --git a/packages/myddas/myddas.h b/packages/myddas/myddas.h index 07c83a45e..f9c25bd11 100644 --- a/packages/myddas/myddas.h +++ b/packages/myddas/myddas.h @@ -1,23 +1,22 @@ #ifndef __MYDDAS_H__ #define __MYDDAS_H__ -#include "config.h" +#include "YapConfig.h" #include #include "myddas_types.h" /* Passar para o myddas_statictics.h ???????? */ #ifdef MYDDAS_STATS -#include #include +#include #endif typedef struct myddas_global *MYDDAS_GLOBAL; #include "myddas_util.h" - -//extern void Yap_InitMYDDAS_SQLITE3Preds(void); -//extern void Yap_InitBackMYDDAS_SQLITE3Preds(void); +// extern void Yap_InitMYDDAS_SQLITE3Preds(void); +// extern void Yap_InitBackMYDDAS_SQLITE3Preds(void); #ifdef MYDDAS_STATS typedef struct myddas_stats_time_struct *MYDDAS_STATS_TIME; @@ -28,18 +27,17 @@ typedef void *MYDDAS_STATS_TIME; #endif #ifdef DEBUG -#define MYDDAS_MEMORY_MALLOC_NR(NUMBER) \ +#define MYDDAS_MEMORY_MALLOC_NR(NUMBER) \ NUMBER = Yap_REGS.MYDDAS_GLOBAL_POINTER->malloc_called; -#define MYDDAS_MEMORY_MALLOC_SIZE(NUMBER) \ +#define MYDDAS_MEMORY_MALLOC_SIZE(NUMBER) \ NUMBER = Yap_REGS.MYDDAS_GLOBAL_POINTER->memory_allocated; -#define MYDDAS_MEMORY_FREE_NR(NUMBER) \ +#define MYDDAS_MEMORY_FREE_NR(NUMBER) \ NUMBER = Yap_REGS.MYDDAS_GLOBAL_POINTER->free_called; -#define MYDDAS_MEMORY_FREE_SIZE(NUMBER) \ +#define MYDDAS_MEMORY_FREE_SIZE(NUMBER) \ NUMBER = Yap_REGS.MYDDAS_GLOBAL_POINTER->memory_freed; #endif -#include "myddas_structs.h" #include "MyddasProto.h" - +#include "myddas_structs.h" #endif /*__MYDDAS_H__*/ diff --git a/packages/yap-lbfgs/liblbfgs-1.10/lib/lbfgs.c b/packages/yap-lbfgs/liblbfgs-1.10/lib/lbfgs.c index 6fbd2242d..bb3fdb45d 100644 --- a/packages/yap-lbfgs/liblbfgs-1.10/lib/lbfgs.c +++ b/packages/yap-lbfgs/liblbfgs-1.10/lib/lbfgs.c @@ -61,26 +61,24 @@ distributing the effieicnt and explanatory implementation in an open source licence. */ -#ifdef HAVE_CONFIG_H -#include -#endif/*HAVE_CONFIG_H*/ +#include "YapConfig.h" +#include #include #include #include -#include #include -#ifdef _MSC_VER -#define inline __inline -#endif/*_MSC_VER*/ +#ifdef _MSC_VER +#define inline __inline +#endif /*_MSC_VER*/ -#if defined(USE_SSE) && defined(__SSE2__) && LBFGS_FLOAT == 64 +#if defined(USE_SSE) && defined(__SSE2__) && LBFGS_FLOAT == 64 /* Use SSE2 optimization for 64bit double precision. */ #include "arithmetic_sse_double.h" -#elif defined(USE_SSE) && defined(__SSE__) && LBFGS_FLOAT == 32 +#elif defined(USE_SSE) && defined(__SSE__) && LBFGS_FLOAT == 32 /* Use SSE optimization for 32bit float precision. */ #include "arithmetic_sse_float.h" @@ -90,923 +88,828 @@ licence. #endif -#define min2(a, b) ((a) <= (b) ? (a) : (b)) -#define max2(a, b) ((a) >= (b) ? (a) : (b)) -#define max3(a, b, c) max2(max2((a), (b)), (c)); +#define min2(a, b) ((a) <= (b) ? (a) : (b)) +#define max2(a, b) ((a) >= (b) ? (a) : (b)) +#define max3(a, b, c) max2(max2((a), (b)), (c)); struct tag_callback_data { - int n; - void *instance; - lbfgs_evaluate_t proc_evaluate; - lbfgs_progress_t proc_progress; + int n; + void *instance; + lbfgs_evaluate_t proc_evaluate; + lbfgs_progress_t proc_progress; }; typedef struct tag_callback_data callback_data_t; struct tag_iteration_data { - lbfgsfloatval_t alpha; - lbfgsfloatval_t *s; /* [n] */ - lbfgsfloatval_t *y; /* [n] */ - lbfgsfloatval_t ys; /* vecdot(y, s) */ + lbfgsfloatval_t alpha; + lbfgsfloatval_t *s; /* [n] */ + lbfgsfloatval_t *y; /* [n] */ + lbfgsfloatval_t ys; /* vecdot(y, s) */ }; typedef struct tag_iteration_data iteration_data_t; static const lbfgs_parameter_t _defparam = { - 6, 1e-5, 0, 1e-5, - 0, LBFGS_LINESEARCH_DEFAULT, 40, - 1e-20, 1e20, 1e-4, 0.9, 0.9, 1.0e-16, - 0.0, 0, -1, + 6, 1e-5, 0, 1e-5, 0, LBFGS_LINESEARCH_DEFAULT, + 40, 1e-20, 1e20, 1e-4, 0.9, 0.9, + 1.0e-16, 0.0, 0, -1, }; /* Forward function declarations. */ -typedef int (*line_search_proc)( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wa, - callback_data_t *cd, - const lbfgs_parameter_t *param - ); - -static int line_search_backtracking( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wa, - callback_data_t *cd, - const lbfgs_parameter_t *param - ); +typedef int (*line_search_proc)(int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, + lbfgsfloatval_t *g, lbfgsfloatval_t *s, + lbfgsfloatval_t *stp, const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, lbfgsfloatval_t *wa, + callback_data_t *cd, + const lbfgs_parameter_t *param); + +static int line_search_backtracking(int n, lbfgsfloatval_t *x, + lbfgsfloatval_t *f, lbfgsfloatval_t *g, + lbfgsfloatval_t *s, lbfgsfloatval_t *stp, + const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, + lbfgsfloatval_t *wa, callback_data_t *cd, + const lbfgs_parameter_t *param); static int line_search_backtracking_owlqn( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wp, - callback_data_t *cd, - const lbfgs_parameter_t *param - ); + int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, + lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, lbfgsfloatval_t *wp, callback_data_t *cd, + const lbfgs_parameter_t *param); -static int line_search_morethuente( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wa, - callback_data_t *cd, - const lbfgs_parameter_t *param - ); +static int line_search_morethuente(int n, lbfgsfloatval_t *x, + lbfgsfloatval_t *f, lbfgsfloatval_t *g, + lbfgsfloatval_t *s, lbfgsfloatval_t *stp, + const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, + lbfgsfloatval_t *wa, callback_data_t *cd, + const lbfgs_parameter_t *param); -static int update_trial_interval( - lbfgsfloatval_t *x, - lbfgsfloatval_t *fx, - lbfgsfloatval_t *dx, - lbfgsfloatval_t *y, - lbfgsfloatval_t *fy, - lbfgsfloatval_t *dy, - lbfgsfloatval_t *t, - lbfgsfloatval_t *ft, - lbfgsfloatval_t *dt, - const lbfgsfloatval_t tmin, - const lbfgsfloatval_t tmax, - int *brackt - ); +static int update_trial_interval(lbfgsfloatval_t *x, lbfgsfloatval_t *fx, + lbfgsfloatval_t *dx, lbfgsfloatval_t *y, + lbfgsfloatval_t *fy, lbfgsfloatval_t *dy, + lbfgsfloatval_t *t, lbfgsfloatval_t *ft, + lbfgsfloatval_t *dt, + const lbfgsfloatval_t tmin, + const lbfgsfloatval_t tmax, int *brackt); -static lbfgsfloatval_t owlqn_x1norm( - const lbfgsfloatval_t* x, - const int start, - const int n - ); +static lbfgsfloatval_t owlqn_x1norm(const lbfgsfloatval_t *x, const int start, + const int n); -static void owlqn_pseudo_gradient( - lbfgsfloatval_t* pg, - const lbfgsfloatval_t* x, - const lbfgsfloatval_t* g, - const int n, - const lbfgsfloatval_t c, - const int start, - const int end - ); +static void owlqn_pseudo_gradient(lbfgsfloatval_t *pg, const lbfgsfloatval_t *x, + const lbfgsfloatval_t *g, const int n, + const lbfgsfloatval_t c, const int start, + const int end); -static void owlqn_project( - lbfgsfloatval_t* d, - const lbfgsfloatval_t* sign, - const int start, - const int end - ); +static void owlqn_project(lbfgsfloatval_t *d, const lbfgsfloatval_t *sign, + const int start, const int end); - -#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) -static int round_out_variables(int n) -{ - n += 7; - n /= 8; - n *= 8; - return n; +#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) +static int round_out_variables(int n) { + n += 7; + n /= 8; + n *= 8; + return n; } -#endif/*defined(USE_SSE)*/ +#endif /*defined(USE_SSE)*/ -lbfgsfloatval_t* lbfgs_malloc(int n) -{ -#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) - n = round_out_variables(n); -#endif/*defined(USE_SSE)*/ - return (lbfgsfloatval_t*)vecalloc(sizeof(lbfgsfloatval_t) * n); +lbfgsfloatval_t *lbfgs_malloc(int n) { +#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) + n = round_out_variables(n); +#endif /*defined(USE_SSE)*/ + return (lbfgsfloatval_t *)vecalloc(sizeof(lbfgsfloatval_t) * n); } -void lbfgs_free(lbfgsfloatval_t *x) -{ - vecfree(x); +void lbfgs_free(lbfgsfloatval_t *x) { vecfree(x); } + +void lbfgs_parameter_init(lbfgs_parameter_t *param) { + memmove(param, &_defparam, sizeof(*param)); } -void lbfgs_parameter_init(lbfgs_parameter_t *param) -{ - memmove(param, &_defparam, sizeof(*param)); -} +int lbfgs(int n, lbfgsfloatval_t *x, lbfgsfloatval_t *ptr_fx, + lbfgs_evaluate_t proc_evaluate, lbfgs_progress_t proc_progress, + void *instance, lbfgs_parameter_t *_param) { + int ret; + int i, j, k, ls, end, bound; + lbfgsfloatval_t step; -int lbfgs( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *ptr_fx, - lbfgs_evaluate_t proc_evaluate, - lbfgs_progress_t proc_progress, - void *instance, - lbfgs_parameter_t *_param - ) -{ - int ret; - int i, j, k, ls, end, bound; - lbfgsfloatval_t step; + /* Constant parameters and their default values. */ + lbfgs_parameter_t param = (_param != NULL) ? (*_param) : _defparam; + const int m = param.m; - /* Constant parameters and their default values. */ - lbfgs_parameter_t param = (_param != NULL) ? (*_param) : _defparam; - const int m = param.m; + lbfgsfloatval_t *xp = NULL; + lbfgsfloatval_t *g = NULL, *gp = NULL, *pg = NULL; + lbfgsfloatval_t *d = NULL, *w = NULL, *pf = NULL; + iteration_data_t *lm = NULL, *it = NULL; + lbfgsfloatval_t ys, yy; + lbfgsfloatval_t xnorm, gnorm, beta; + lbfgsfloatval_t fx = 0.; + lbfgsfloatval_t rate = 0.; + line_search_proc linesearch = line_search_morethuente; - lbfgsfloatval_t *xp = NULL; - lbfgsfloatval_t *g = NULL, *gp = NULL, *pg = NULL; - lbfgsfloatval_t *d = NULL, *w = NULL, *pf = NULL; - iteration_data_t *lm = NULL, *it = NULL; - lbfgsfloatval_t ys, yy; - lbfgsfloatval_t xnorm, gnorm, beta; - lbfgsfloatval_t fx = 0.; - lbfgsfloatval_t rate = 0.; - line_search_proc linesearch = line_search_morethuente; + /* Construct a callback data. */ + callback_data_t cd; + cd.n = n; + cd.instance = instance; + cd.proc_evaluate = proc_evaluate; + cd.proc_progress = proc_progress; - /* Construct a callback data. */ - callback_data_t cd; - cd.n = n; - cd.instance = instance; - cd.proc_evaluate = proc_evaluate; - cd.proc_progress = proc_progress; +#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) + /* Round out the number of variables. */ + n = round_out_variables(n); +#endif /*defined(USE_SSE)*/ -#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) - /* Round out the number of variables. */ - n = round_out_variables(n); -#endif/*defined(USE_SSE)*/ + /* Check the input parameters for errors. */ + if (n <= 0) { + return LBFGSERR_INVALID_N; + } +#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) + if (n % 8 != 0) { + return LBFGSERR_INVALID_N_SSE; + } + if ((uintptr_t)(const void *)x % 16 != 0) { + return LBFGSERR_INVALID_X_SSE; + } +#endif /*defined(USE_SSE)*/ + if (param.epsilon < 0.) { + return LBFGSERR_INVALID_EPSILON; + } + if (param.past < 0) { + return LBFGSERR_INVALID_TESTPERIOD; + } + if (param.delta < 0.) { + return LBFGSERR_INVALID_DELTA; + } + if (param.min_step < 0.) { + return LBFGSERR_INVALID_MINSTEP; + } + if (param.max_step < param.min_step) { + return LBFGSERR_INVALID_MAXSTEP; + } + if (param.ftol < 0.) { + return LBFGSERR_INVALID_FTOL; + } + if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE || + param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE) { + if (param.wolfe <= param.ftol || 1. <= param.wolfe) { + return LBFGSERR_INVALID_WOLFE; + } + } + if (param.gtol < 0.) { + return LBFGSERR_INVALID_GTOL; + } + if (param.xtol < 0.) { + return LBFGSERR_INVALID_XTOL; + } + if (param.max_linesearch <= 0) { + return LBFGSERR_INVALID_MAXLINESEARCH; + } + if (param.orthantwise_c < 0.) { + return LBFGSERR_INVALID_ORTHANTWISE; + } + if (param.orthantwise_start < 0 || n < param.orthantwise_start) { + return LBFGSERR_INVALID_ORTHANTWISE_START; + } + if (param.orthantwise_end < 0) { + param.orthantwise_end = n; + } + if (n < param.orthantwise_end) { + return LBFGSERR_INVALID_ORTHANTWISE_END; + } + if (param.orthantwise_c != 0.) { + switch (param.linesearch) { + case LBFGS_LINESEARCH_BACKTRACKING: + linesearch = line_search_backtracking_owlqn; + break; + default: + /* Only the backtracking method is available. */ + return LBFGSERR_INVALID_LINESEARCH; + } + } else { + switch (param.linesearch) { + case LBFGS_LINESEARCH_MORETHUENTE: + linesearch = line_search_morethuente; + break; + case LBFGS_LINESEARCH_BACKTRACKING_ARMIJO: + case LBFGS_LINESEARCH_BACKTRACKING_WOLFE: + case LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE: + linesearch = line_search_backtracking; + break; + default: + return LBFGSERR_INVALID_LINESEARCH; + } + } - /* Check the input parameters for errors. */ - if (n <= 0) { - return LBFGSERR_INVALID_N; - } -#if defined(USE_SSE) && (defined(__SSE__) || defined(__SSE2__)) - if (n % 8 != 0) { - return LBFGSERR_INVALID_N_SSE; - } - if ((uintptr_t)(const void*)x % 16 != 0) { - return LBFGSERR_INVALID_X_SSE; - } -#endif/*defined(USE_SSE)*/ - if (param.epsilon < 0.) { - return LBFGSERR_INVALID_EPSILON; - } - if (param.past < 0) { - return LBFGSERR_INVALID_TESTPERIOD; - } - if (param.delta < 0.) { - return LBFGSERR_INVALID_DELTA; - } - if (param.min_step < 0.) { - return LBFGSERR_INVALID_MINSTEP; - } - if (param.max_step < param.min_step) { - return LBFGSERR_INVALID_MAXSTEP; - } - if (param.ftol < 0.) { - return LBFGSERR_INVALID_FTOL; - } - if (param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE || - param.linesearch == LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE) { - if (param.wolfe <= param.ftol || 1. <= param.wolfe) { - return LBFGSERR_INVALID_WOLFE; - } - } - if (param.gtol < 0.) { - return LBFGSERR_INVALID_GTOL; - } - if (param.xtol < 0.) { - return LBFGSERR_INVALID_XTOL; - } - if (param.max_linesearch <= 0) { - return LBFGSERR_INVALID_MAXLINESEARCH; - } - if (param.orthantwise_c < 0.) { - return LBFGSERR_INVALID_ORTHANTWISE; - } - if (param.orthantwise_start < 0 || n < param.orthantwise_start) { - return LBFGSERR_INVALID_ORTHANTWISE_START; - } - if (param.orthantwise_end < 0) { - param.orthantwise_end = n; - } - if (n < param.orthantwise_end) { - return LBFGSERR_INVALID_ORTHANTWISE_END; - } - if (param.orthantwise_c != 0.) { - switch (param.linesearch) { - case LBFGS_LINESEARCH_BACKTRACKING: - linesearch = line_search_backtracking_owlqn; - break; - default: - /* Only the backtracking method is available. */ - return LBFGSERR_INVALID_LINESEARCH; - } - } else { - switch (param.linesearch) { - case LBFGS_LINESEARCH_MORETHUENTE: - linesearch = line_search_morethuente; - break; - case LBFGS_LINESEARCH_BACKTRACKING_ARMIJO: - case LBFGS_LINESEARCH_BACKTRACKING_WOLFE: - case LBFGS_LINESEARCH_BACKTRACKING_STRONG_WOLFE: - linesearch = line_search_backtracking; - break; - default: - return LBFGSERR_INVALID_LINESEARCH; - } - } + /* Allocate working space. */ + xp = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + g = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + gp = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + d = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + w = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + if (xp == NULL || g == NULL || gp == NULL || d == NULL || w == NULL) { + ret = LBFGSERR_OUTOFMEMORY; + goto lbfgs_exit; + } - /* Allocate working space. */ - xp = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - g = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - gp = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - d = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - w = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - if (xp == NULL || g == NULL || gp == NULL || d == NULL || w == NULL) { - ret = LBFGSERR_OUTOFMEMORY; - goto lbfgs_exit; + if (param.orthantwise_c != 0.) { + /* Allocate working space for OW-LQN. */ + pg = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + if (pg == NULL) { + ret = LBFGSERR_OUTOFMEMORY; + goto lbfgs_exit; } + } - if (param.orthantwise_c != 0.) { - /* Allocate working space for OW-LQN. */ - pg = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - if (pg == NULL) { - ret = LBFGSERR_OUTOFMEMORY; - goto lbfgs_exit; - } + /* Allocate limited memory storage. */ + lm = (iteration_data_t *)vecalloc(m * sizeof(iteration_data_t)); + if (lm == NULL) { + ret = LBFGSERR_OUTOFMEMORY; + goto lbfgs_exit; + } + + /* Initialize the limited memory. */ + for (i = 0; i < m; ++i) { + it = &lm[i]; + it->alpha = 0; + it->ys = 0; + it->s = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + it->y = (lbfgsfloatval_t *)vecalloc(n * sizeof(lbfgsfloatval_t)); + if (it->s == NULL || it->y == NULL) { + ret = LBFGSERR_OUTOFMEMORY; + goto lbfgs_exit; } + } - /* Allocate limited memory storage. */ - lm = (iteration_data_t*)vecalloc(m * sizeof(iteration_data_t)); - if (lm == NULL) { - ret = LBFGSERR_OUTOFMEMORY; - goto lbfgs_exit; - } + /* Allocate an array for storing previous values of the objective function. */ + if (0 < param.past) { + pf = (lbfgsfloatval_t *)vecalloc(param.past * sizeof(lbfgsfloatval_t)); + } - /* Initialize the limited memory. */ - for (i = 0;i < m;++i) { - it = &lm[i]; - it->alpha = 0; - it->ys = 0; - it->s = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - it->y = (lbfgsfloatval_t*)vecalloc(n * sizeof(lbfgsfloatval_t)); - if (it->s == NULL || it->y == NULL) { - ret = LBFGSERR_OUTOFMEMORY; - goto lbfgs_exit; - } - } + /* Evaluate the function value and its gradient. */ + fx = cd.proc_evaluate(cd.instance, x, g, cd.n, 0); + if (0. != param.orthantwise_c) { + /* Compute the L1 norm of the variable and add it to the object value. */ + xnorm = owlqn_x1norm(x, param.orthantwise_start, param.orthantwise_end); + fx += xnorm * param.orthantwise_c; + owlqn_pseudo_gradient(pg, x, g, n, param.orthantwise_c, + param.orthantwise_start, param.orthantwise_end); + } - /* Allocate an array for storing previous values of the objective function. */ - if (0 < param.past) { - pf = (lbfgsfloatval_t*)vecalloc(param.past * sizeof(lbfgsfloatval_t)); - } + /* Store the initial value of the objective function. */ + if (pf != NULL) { + pf[0] = fx; + } - /* Evaluate the function value and its gradient. */ - fx = cd.proc_evaluate(cd.instance, x, g, cd.n, 0); - if (0. != param.orthantwise_c) { - /* Compute the L1 norm of the variable and add it to the object value. */ - xnorm = owlqn_x1norm(x, param.orthantwise_start, param.orthantwise_end); - fx += xnorm * param.orthantwise_c; - owlqn_pseudo_gradient( - pg, x, g, n, - param.orthantwise_c, param.orthantwise_start, param.orthantwise_end - ); - } + /* + Compute the direction; + we assume the initial hessian matrix H_0 as the identity matrix. + */ + if (param.orthantwise_c == 0.) { + vecncpy(d, g, n); + } else { + vecncpy(d, pg, n); + } - /* Store the initial value of the objective function. */ - if (pf != NULL) { - pf[0] = fx; - } + /* + Make sure that the initial variables are not a minimizer. + */ + vec2norm(&xnorm, x, n); + if (param.orthantwise_c == 0.) { + vec2norm(&gnorm, g, n); + } else { + vec2norm(&gnorm, pg, n); + } + if (xnorm < 1.0) + xnorm = 1.0; + if (gnorm / xnorm <= param.epsilon) { + ret = LBFGS_ALREADY_MINIMIZED; + goto lbfgs_exit; + } - /* - Compute the direction; - we assume the initial hessian matrix H_0 as the identity matrix. - */ + /* Compute the initial step: + step = 1.0 / sqrt(vecdot(d, d, n)) + */ + vec2norminv(&step, d, n); + + k = 1; + end = 0; + for (;;) { + /* Store the current position and gradient vectors. */ + veccpy(xp, x, n); + veccpy(gp, g, n); + + /* Search for an optimal step. */ if (param.orthantwise_c == 0.) { - vecncpy(d, g, n); + ls = linesearch(n, x, &fx, g, d, &step, xp, gp, w, &cd, ¶m); } else { - vecncpy(d, pg, n); + ls = linesearch(n, x, &fx, g, d, &step, xp, pg, w, &cd, ¶m); + owlqn_pseudo_gradient(pg, x, g, n, param.orthantwise_c, + param.orthantwise_start, param.orthantwise_end); + } + if (ls < 0) { + /* Revert to the previous point. */ + veccpy(x, xp, n); + veccpy(g, gp, n); + ret = ls; + goto lbfgs_exit; } - /* - Make sure that the initial variables are not a minimizer. - */ + /* Compute x and g norms. */ vec2norm(&xnorm, x, n); if (param.orthantwise_c == 0.) { - vec2norm(&gnorm, g, n); + vec2norm(&gnorm, g, n); } else { - vec2norm(&gnorm, pg, n); + vec2norm(&gnorm, pg, n); } - if (xnorm < 1.0) xnorm = 1.0; - if (gnorm / xnorm <= param.epsilon) { - ret = LBFGS_ALREADY_MINIMIZED; + + /* Report the progress. */ + if (cd.proc_progress) { + if ((ret = cd.proc_progress(cd.instance, x, g, fx, xnorm, gnorm, step, + cd.n, k, ls))) { goto lbfgs_exit; + } } - /* Compute the initial step: - step = 1.0 / sqrt(vecdot(d, d, n)) - */ - vec2norminv(&step, d, n); - - k = 1; - end = 0; - for (;;) { - /* Store the current position and gradient vectors. */ - veccpy(xp, x, n); - veccpy(gp, g, n); - - /* Search for an optimal step. */ - if (param.orthantwise_c == 0.) { - ls = linesearch(n, x, &fx, g, d, &step, xp, gp, w, &cd, ¶m); - } else { - ls = linesearch(n, x, &fx, g, d, &step, xp, pg, w, &cd, ¶m); - owlqn_pseudo_gradient( - pg, x, g, n, - param.orthantwise_c, param.orthantwise_start, param.orthantwise_end - ); - } - if (ls < 0) { - /* Revert to the previous point. */ - veccpy(x, xp, n); - veccpy(g, gp, n); - ret = ls; - goto lbfgs_exit; - } - - /* Compute x and g norms. */ - vec2norm(&xnorm, x, n); - if (param.orthantwise_c == 0.) { - vec2norm(&gnorm, g, n); - } else { - vec2norm(&gnorm, pg, n); - } - - /* Report the progress. */ - if (cd.proc_progress) { - if ((ret = cd.proc_progress(cd.instance, x, g, fx, xnorm, gnorm, step, cd.n, k, ls))) { - goto lbfgs_exit; - } - } - - /* - Convergence test. - The criterion is given by the following formula: - |g(x)| / \max(1, |x|) < \epsilon - */ - if (xnorm < 1.0) xnorm = 1.0; - if (gnorm / xnorm <= param.epsilon) { - /* Convergence. */ - ret = LBFGS_SUCCESS; - break; - } - - /* - Test for stopping criterion. - The criterion is given by the following formula: - (f(past_x) - f(x)) / f(x) < \delta - */ - if (pf != NULL) { - /* We don't test the stopping criterion while k < past. */ - if (param.past <= k) { - /* Compute the relative improvement from the past. */ - rate = (pf[k % param.past] - fx) / fx; - - /* The stopping criterion. */ - if (rate < param.delta) { - ret = LBFGS_STOP; - break; - } - } - - /* Store the current value of the objective function. */ - pf[k % param.past] = fx; - } - - if (param.max_iterations != 0 && param.max_iterations < k+1) { - /* Maximum number of iterations. */ - ret = LBFGSERR_MAXIMUMITERATION; - break; - } - - /* - Update vectors s and y: - s_{k+1} = x_{k+1} - x_{k} = \step * d_{k}. - y_{k+1} = g_{k+1} - g_{k}. - */ - it = &lm[end]; - vecdiff(it->s, x, xp, n); - vecdiff(it->y, g, gp, n); - - /* - Compute scalars ys and yy: - ys = y^t \cdot s = 1 / \rho. - yy = y^t \cdot y. - Notice that yy is used for scaling the hessian matrix H_0 (Cholesky factor). - */ - vecdot(&ys, it->y, it->s, n); - vecdot(&yy, it->y, it->y, n); - it->ys = ys; - - /* - Recursive formula to compute dir = -(H \cdot g). - This is described in page 779 of: - Jorge Nocedal. - Updating Quasi-Newton Matrices with Limited Storage. - Mathematics of Computation, Vol. 35, No. 151, - pp. 773--782, 1980. - */ - bound = (m <= k) ? m : k; - ++k; - end = (end + 1) % m; - - /* Compute the steepest direction. */ - if (param.orthantwise_c == 0.) { - /* Compute the negative of gradients. */ - vecncpy(d, g, n); - } else { - vecncpy(d, pg, n); - } - - j = end; - for (i = 0;i < bound;++i) { - j = (j + m - 1) % m; /* if (--j == -1) j = m-1; */ - it = &lm[j]; - /* \alpha_{j} = \rho_{j} s^{t}_{j} \cdot q_{k+1}. */ - vecdot(&it->alpha, it->s, d, n); - it->alpha /= it->ys; - /* q_{i} = q_{i+1} - \alpha_{i} y_{i}. */ - vecadd(d, it->y, -it->alpha, n); - } - - vecscale(d, ys / yy, n); - - for (i = 0;i < bound;++i) { - it = &lm[j]; - /* \beta_{j} = \rho_{j} y^t_{j} \cdot \gamma_{i}. */ - vecdot(&beta, it->y, d, n); - beta /= it->ys; - /* \gamma_{i+1} = \gamma_{i} + (\alpha_{j} - \beta_{j}) s_{j}. */ - vecadd(d, it->s, it->alpha - beta, n); - j = (j + 1) % m; /* if (++j == m) j = 0; */ - } - - /* - Constrain the search direction for orthant-wise updates. - */ - if (param.orthantwise_c != 0.) { - for (i = param.orthantwise_start;i < param.orthantwise_end;++i) { - if (d[i] * pg[i] >= 0) { - d[i] = 0; - } - } - } - - /* - Now the search direction d is ready. We try step = 1 first. - */ - step = 1.0; - } - -lbfgs_exit: - /* Return the final value of the objective function. */ - if (ptr_fx != NULL) { - *ptr_fx = fx; - } - - vecfree(pf); - - /* Free memory blocks used by this function. */ - if (lm != NULL) { - for (i = 0;i < m;++i) { - vecfree(lm[i].s); - vecfree(lm[i].y); - } - vecfree(lm); - } - vecfree(pg); - vecfree(w); - vecfree(d); - vecfree(gp); - vecfree(g); - vecfree(xp); - - return ret; -} - - - -static int line_search_backtracking( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wp, - callback_data_t *cd, - const lbfgs_parameter_t *param - ) -{ - int count = 0; - lbfgsfloatval_t width, dg; - lbfgsfloatval_t finit, dginit = 0., dgtest; - const lbfgsfloatval_t dec = 0.5, inc = 2.1; - - /* Check the input parameters for errors. */ - if (*stp <= 0.) { - return LBFGSERR_INVALIDPARAMETERS; - } - - /* Compute the initial gradient in the search direction. */ - vecdot(&dginit, g, s, n); - - /* Make sure that s points to a descent direction. */ - if (0 < dginit) { - return LBFGSERR_INCREASEGRADIENT; - } - - /* The initial value of the objective function. */ - finit = *f; - dgtest = param->ftol * dginit; - - for (;;) { - veccpy(x, xp, n); - vecadd(x, s, *stp, n); - - /* Evaluate the function and gradient values. */ - *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); - - ++count; - - if (*f > finit + *stp * dgtest) { - width = dec; - } else { - /* The sufficient decrease condition (Armijo condition). */ - if (param->linesearch == LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) { - /* Exit with the Armijo condition. */ - return count; - } - - /* Check the Wolfe condition. */ - vecdot(&dg, g, s, n); - if (dg < param->wolfe * dginit) { - width = inc; - } else { - if(param->linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE) { - /* Exit with the regular Wolfe condition. */ - return count; - } - - /* Check the strong Wolfe condition. */ - if(dg > -param->wolfe * dginit) { - width = dec; - } else { - /* Exit with the strong Wolfe condition. */ - return count; - } - } - } - - if (*stp < param->min_step) { - /* The step is the minimum value. */ - return LBFGSERR_MINIMUMSTEP; - } - if (*stp > param->max_step) { - /* The step is the maximum value. */ - return LBFGSERR_MAXIMUMSTEP; - } - if (param->max_linesearch <= count) { - /* Maximum number of iteration. */ - return LBFGSERR_MAXIMUMLINESEARCH; - } - - (*stp) *= width; - } -} - - - -static int line_search_backtracking_owlqn( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wp, - callback_data_t *cd, - const lbfgs_parameter_t *param - ) -{ - int i, count = 0; - lbfgsfloatval_t width = 0.5, norm = 0.; - lbfgsfloatval_t finit = *f, dgtest; - - /* Check the input parameters for errors. */ - if (*stp <= 0.) { - return LBFGSERR_INVALIDPARAMETERS; - } - - /* Choose the orthant for the new point. */ - for (i = 0;i < n;++i) { - wp[i] = (xp[i] == 0.) ? -gp[i] : xp[i]; - } - - for (;;) { - /* Update the current point. */ - veccpy(x, xp, n); - vecadd(x, s, *stp, n); - - /* The current point is projected onto the orthant. */ - owlqn_project(x, wp, param->orthantwise_start, param->orthantwise_end); - - /* Evaluate the function and gradient values. */ - *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); - - /* Compute the L1 norm of the variables and add it to the object value. */ - norm = owlqn_x1norm(x, param->orthantwise_start, param->orthantwise_end); - *f += norm * param->orthantwise_c; - - ++count; - - dgtest = 0.; - for (i = 0;i < n;++i) { - dgtest += (x[i] - xp[i]) * gp[i]; - } - - if (*f <= finit + param->ftol * dgtest) { - /* The sufficient decrease condition. */ - return count; - } - - if (*stp < param->min_step) { - /* The step is the minimum value. */ - return LBFGSERR_MINIMUMSTEP; - } - if (*stp > param->max_step) { - /* The step is the maximum value. */ - return LBFGSERR_MAXIMUMSTEP; - } - if (param->max_linesearch <= count) { - /* Maximum number of iteration. */ - return LBFGSERR_MAXIMUMLINESEARCH; - } - - (*stp) *= width; - } -} - - - -static int line_search_morethuente( - int n, - lbfgsfloatval_t *x, - lbfgsfloatval_t *f, - lbfgsfloatval_t *g, - lbfgsfloatval_t *s, - lbfgsfloatval_t *stp, - const lbfgsfloatval_t* xp, - const lbfgsfloatval_t* gp, - lbfgsfloatval_t *wa, - callback_data_t *cd, - const lbfgs_parameter_t *param - ) -{ - int count = 0; - int brackt, stage1, uinfo = 0; - lbfgsfloatval_t dg; - lbfgsfloatval_t stx, fx, dgx; - lbfgsfloatval_t sty, fy, dgy; - lbfgsfloatval_t fxm, dgxm, fym, dgym, fm, dgm; - lbfgsfloatval_t finit, ftest1, dginit, dgtest; - lbfgsfloatval_t width, prev_width; - lbfgsfloatval_t stmin, stmax; - - /* Check the input parameters for errors. */ - if (*stp <= 0.) { - return LBFGSERR_INVALIDPARAMETERS; - } - - /* Compute the initial gradient in the search direction. */ - vecdot(&dginit, g, s, n); - - /* Make sure that s points to a descent direction. */ - if (0 < dginit) { - return LBFGSERR_INCREASEGRADIENT; - } - - /* Initialize local variables. */ - brackt = 0; - stage1 = 1; - finit = *f; - dgtest = param->ftol * dginit; - width = param->max_step - param->min_step; - prev_width = 2.0 * width; - /* - The variables stx, fx, dgx contain the values of the step, - function, and directional derivative at the best step. - The variables sty, fy, dgy contain the value of the step, - function, and derivative at the other endpoint of - the interval of uncertainty. - The variables stp, f, dg contain the values of the step, - function, and derivative at the current step. - */ - stx = sty = 0.; - fx = fy = finit; - dgx = dgy = dginit; - - for (;;) { - /* - Set the minimum and maximum steps to correspond to the - present interval of uncertainty. - */ - if (brackt) { - stmin = min2(stx, sty); - stmax = max2(stx, sty); - } else { - stmin = stx; - stmax = *stp + 4.0 * (*stp - stx); - } - - /* Clip the step in the range of [stpmin, stpmax]. */ - if (*stp < param->min_step) *stp = param->min_step; - if (param->max_step < *stp) *stp = param->max_step; - - /* - If an unusual termination is to occur then let - stp be the lowest point obtained so far. - */ - if ((brackt && ((*stp <= stmin || stmax <= *stp) || param->max_linesearch <= count + 1 || uinfo != 0)) || (brackt && (stmax - stmin <= param->xtol * stmax))) { - *stp = stx; - } - - /* - Compute the current value of x: - x <- x + (*stp) * s. - */ - veccpy(x, xp, n); - vecadd(x, s, *stp, n); - - /* Evaluate the function and gradient values. */ - *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); - vecdot(&dg, g, s, n); - - ftest1 = finit + *stp * dgtest; - ++count; - - /* Test for errors and convergence. */ - if (brackt && ((*stp <= stmin || stmax <= *stp) || uinfo != 0)) { - /* Rounding errors prevent further progress. */ - return LBFGSERR_ROUNDING_ERROR; - } - if (*stp == param->max_step && *f <= ftest1 && dg <= dgtest) { - /* The step is the maximum value. */ - return LBFGSERR_MAXIMUMSTEP; - } - if (*stp == param->min_step && (ftest1 < *f || dgtest <= dg)) { - /* The step is the minimum value. */ - return LBFGSERR_MINIMUMSTEP; - } - if (brackt && (stmax - stmin) <= param->xtol * stmax) { - /* Relative width of the interval of uncertainty is at most xtol. */ - return LBFGSERR_WIDTHTOOSMALL; - } - if (param->max_linesearch <= count) { - /* Maximum number of iteration. */ - return LBFGSERR_MAXIMUMLINESEARCH; - } - if (*f <= ftest1 && fabs(dg) <= param->gtol * (-dginit)) { - /* The sufficient decrease condition and the directional derivative condition hold. */ - return count; - } - - /* - In the first stage we seek a step for which the modified - function has a nonpositive value and nonnegative derivative. - */ - if (stage1 && *f <= ftest1 && min2(param->ftol, param->gtol) * dginit <= dg) { - stage1 = 0; - } - - /* - A modified function is used to predict the step only if - we have not obtained a step for which the modified - function has a nonpositive function value and nonnegative - derivative, and if a lower function value has been - obtained but the decrease is not sufficient. - */ - if (stage1 && ftest1 < *f && *f <= fx) { - /* Define the modified function and derivative values. */ - fm = *f - *stp * dgtest; - fxm = fx - stx * dgtest; - fym = fy - sty * dgtest; - dgm = dg - dgtest; - dgxm = dgx - dgtest; - dgym = dgy - dgtest; - - /* - Call update_trial_interval() to update the interval of - uncertainty and to compute the new step. - */ - uinfo = update_trial_interval( - &stx, &fxm, &dgxm, - &sty, &fym, &dgym, - stp, &fm, &dgm, - stmin, stmax, &brackt - ); - - /* Reset the function and gradient values for f. */ - fx = fxm + stx * dgtest; - fy = fym + sty * dgtest; - dgx = dgxm + dgtest; - dgy = dgym + dgtest; - } else { - /* - Call update_trial_interval() to update the interval of - uncertainty and to compute the new step. - */ - uinfo = update_trial_interval( - &stx, &fx, &dgx, - &sty, &fy, &dgy, - stp, f, &dg, - stmin, stmax, &brackt - ); - } - - /* - Force a sufficient decrease in the interval of uncertainty. - */ - if (brackt) { - if (0.66 * prev_width <= fabs(sty - stx)) { - *stp = stx + 0.5 * (sty - stx); - } - prev_width = width; - width = fabs(sty - stx); - } + Convergence test. + The criterion is given by the following formula: + |g(x)| / \max(1, |x|) < \epsilon + */ + if (xnorm < 1.0) + xnorm = 1.0; + if (gnorm / xnorm <= param.epsilon) { + /* Convergence. */ + ret = LBFGS_SUCCESS; + break; } - return LBFGSERR_LOGICERROR; + /* + Test for stopping criterion. + The criterion is given by the following formula: + (f(past_x) - f(x)) / f(x) < \delta + */ + if (pf != NULL) { + /* We don't test the stopping criterion while k < past. */ + if (param.past <= k) { + /* Compute the relative improvement from the past. */ + rate = (pf[k % param.past] - fx) / fx; + + /* The stopping criterion. */ + if (rate < param.delta) { + ret = LBFGS_STOP; + break; + } + } + + /* Store the current value of the objective function. */ + pf[k % param.past] = fx; + } + + if (param.max_iterations != 0 && param.max_iterations < k + 1) { + /* Maximum number of iterations. */ + ret = LBFGSERR_MAXIMUMITERATION; + break; + } + + /* + Update vectors s and y: + s_{k+1} = x_{k+1} - x_{k} = \step * d_{k}. + y_{k+1} = g_{k+1} - g_{k}. + */ + it = &lm[end]; + vecdiff(it->s, x, xp, n); + vecdiff(it->y, g, gp, n); + + /* + Compute scalars ys and yy: + ys = y^t \cdot s = 1 / \rho. + yy = y^t \cdot y. + Notice that yy is used for scaling the hessian matrix H_0 (Cholesky + factor). + */ + vecdot(&ys, it->y, it->s, n); + vecdot(&yy, it->y, it->y, n); + it->ys = ys; + + /* + Recursive formula to compute dir = -(H \cdot g). + This is described in page 779 of: + Jorge Nocedal. + Updating Quasi-Newton Matrices with Limited Storage. + Mathematics of Computation, Vol. 35, No. 151, + pp. 773--782, 1980. + */ + bound = (m <= k) ? m : k; + ++k; + end = (end + 1) % m; + + /* Compute the steepest direction. */ + if (param.orthantwise_c == 0.) { + /* Compute the negative of gradients. */ + vecncpy(d, g, n); + } else { + vecncpy(d, pg, n); + } + + j = end; + for (i = 0; i < bound; ++i) { + j = (j + m - 1) % m; /* if (--j == -1) j = m-1; */ + it = &lm[j]; + /* \alpha_{j} = \rho_{j} s^{t}_{j} \cdot q_{k+1}. */ + vecdot(&it->alpha, it->s, d, n); + it->alpha /= it->ys; + /* q_{i} = q_{i+1} - \alpha_{i} y_{i}. */ + vecadd(d, it->y, -it->alpha, n); + } + + vecscale(d, ys / yy, n); + + for (i = 0; i < bound; ++i) { + it = &lm[j]; + /* \beta_{j} = \rho_{j} y^t_{j} \cdot \gamma_{i}. */ + vecdot(&beta, it->y, d, n); + beta /= it->ys; + /* \gamma_{i+1} = \gamma_{i} + (\alpha_{j} - \beta_{j}) s_{j}. */ + vecadd(d, it->s, it->alpha - beta, n); + j = (j + 1) % m; /* if (++j == m) j = 0; */ + } + + /* + Constrain the search direction for orthant-wise updates. + */ + if (param.orthantwise_c != 0.) { + for (i = param.orthantwise_start; i < param.orthantwise_end; ++i) { + if (d[i] * pg[i] >= 0) { + d[i] = 0; + } + } + } + + /* + Now the search direction d is ready. We try step = 1 first. + */ + step = 1.0; + } + +lbfgs_exit: + /* Return the final value of the objective function. */ + if (ptr_fx != NULL) { + *ptr_fx = fx; + } + + vecfree(pf); + + /* Free memory blocks used by this function. */ + if (lm != NULL) { + for (i = 0; i < m; ++i) { + vecfree(lm[i].s); + vecfree(lm[i].y); + } + vecfree(lm); + } + vecfree(pg); + vecfree(w); + vecfree(d); + vecfree(gp); + vecfree(g); + vecfree(xp); + + return ret; } +static int line_search_backtracking(int n, lbfgsfloatval_t *x, + lbfgsfloatval_t *f, lbfgsfloatval_t *g, + lbfgsfloatval_t *s, lbfgsfloatval_t *stp, + const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, + lbfgsfloatval_t *wp, callback_data_t *cd, + const lbfgs_parameter_t *param) { + int count = 0; + lbfgsfloatval_t width, dg; + lbfgsfloatval_t finit, dginit = 0., dgtest; + const lbfgsfloatval_t dec = 0.5, inc = 2.1; + /* Check the input parameters for errors. */ + if (*stp <= 0.) { + return LBFGSERR_INVALIDPARAMETERS; + } + + /* Compute the initial gradient in the search direction. */ + vecdot(&dginit, g, s, n); + + /* Make sure that s points to a descent direction. */ + if (0 < dginit) { + return LBFGSERR_INCREASEGRADIENT; + } + + /* The initial value of the objective function. */ + finit = *f; + dgtest = param->ftol * dginit; + + for (;;) { + veccpy(x, xp, n); + vecadd(x, s, *stp, n); + + /* Evaluate the function and gradient values. */ + *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); + + ++count; + + if (*f > finit + *stp * dgtest) { + width = dec; + } else { + /* The sufficient decrease condition (Armijo condition). */ + if (param->linesearch == LBFGS_LINESEARCH_BACKTRACKING_ARMIJO) { + /* Exit with the Armijo condition. */ + return count; + } + + /* Check the Wolfe condition. */ + vecdot(&dg, g, s, n); + if (dg < param->wolfe * dginit) { + width = inc; + } else { + if (param->linesearch == LBFGS_LINESEARCH_BACKTRACKING_WOLFE) { + /* Exit with the regular Wolfe condition. */ + return count; + } + + /* Check the strong Wolfe condition. */ + if (dg > -param->wolfe * dginit) { + width = dec; + } else { + /* Exit with the strong Wolfe condition. */ + return count; + } + } + } + + if (*stp < param->min_step) { + /* The step is the minimum value. */ + return LBFGSERR_MINIMUMSTEP; + } + if (*stp > param->max_step) { + /* The step is the maximum value. */ + return LBFGSERR_MAXIMUMSTEP; + } + if (param->max_linesearch <= count) { + /* Maximum number of iteration. */ + return LBFGSERR_MAXIMUMLINESEARCH; + } + + (*stp) *= width; + } +} + +static int line_search_backtracking_owlqn( + int n, lbfgsfloatval_t *x, lbfgsfloatval_t *f, lbfgsfloatval_t *g, + lbfgsfloatval_t *s, lbfgsfloatval_t *stp, const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, lbfgsfloatval_t *wp, callback_data_t *cd, + const lbfgs_parameter_t *param) { + int i, count = 0; + lbfgsfloatval_t width = 0.5, norm = 0.; + lbfgsfloatval_t finit = *f, dgtest; + + /* Check the input parameters for errors. */ + if (*stp <= 0.) { + return LBFGSERR_INVALIDPARAMETERS; + } + + /* Choose the orthant for the new point. */ + for (i = 0; i < n; ++i) { + wp[i] = (xp[i] == 0.) ? -gp[i] : xp[i]; + } + + for (;;) { + /* Update the current point. */ + veccpy(x, xp, n); + vecadd(x, s, *stp, n); + + /* The current point is projected onto the orthant. */ + owlqn_project(x, wp, param->orthantwise_start, param->orthantwise_end); + + /* Evaluate the function and gradient values. */ + *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); + + /* Compute the L1 norm of the variables and add it to the object value. */ + norm = owlqn_x1norm(x, param->orthantwise_start, param->orthantwise_end); + *f += norm * param->orthantwise_c; + + ++count; + + dgtest = 0.; + for (i = 0; i < n; ++i) { + dgtest += (x[i] - xp[i]) * gp[i]; + } + + if (*f <= finit + param->ftol * dgtest) { + /* The sufficient decrease condition. */ + return count; + } + + if (*stp < param->min_step) { + /* The step is the minimum value. */ + return LBFGSERR_MINIMUMSTEP; + } + if (*stp > param->max_step) { + /* The step is the maximum value. */ + return LBFGSERR_MAXIMUMSTEP; + } + if (param->max_linesearch <= count) { + /* Maximum number of iteration. */ + return LBFGSERR_MAXIMUMLINESEARCH; + } + + (*stp) *= width; + } +} + +static int line_search_morethuente(int n, lbfgsfloatval_t *x, + lbfgsfloatval_t *f, lbfgsfloatval_t *g, + lbfgsfloatval_t *s, lbfgsfloatval_t *stp, + const lbfgsfloatval_t *xp, + const lbfgsfloatval_t *gp, + lbfgsfloatval_t *wa, callback_data_t *cd, + const lbfgs_parameter_t *param) { + int count = 0; + int brackt, stage1, uinfo = 0; + lbfgsfloatval_t dg; + lbfgsfloatval_t stx, fx, dgx; + lbfgsfloatval_t sty, fy, dgy; + lbfgsfloatval_t fxm, dgxm, fym, dgym, fm, dgm; + lbfgsfloatval_t finit, ftest1, dginit, dgtest; + lbfgsfloatval_t width, prev_width; + lbfgsfloatval_t stmin, stmax; + + /* Check the input parameters for errors. */ + if (*stp <= 0.) { + return LBFGSERR_INVALIDPARAMETERS; + } + + /* Compute the initial gradient in the search direction. */ + vecdot(&dginit, g, s, n); + + /* Make sure that s points to a descent direction. */ + if (0 < dginit) { + return LBFGSERR_INCREASEGRADIENT; + } + + /* Initialize local variables. */ + brackt = 0; + stage1 = 1; + finit = *f; + dgtest = param->ftol * dginit; + width = param->max_step - param->min_step; + prev_width = 2.0 * width; + + /* + The variables stx, fx, dgx contain the values of the step, + function, and directional derivative at the best step. + The variables sty, fy, dgy contain the value of the step, + function, and derivative at the other endpoint of + the interval of uncertainty. + The variables stp, f, dg contain the values of the step, + function, and derivative at the current step. + */ + stx = sty = 0.; + fx = fy = finit; + dgx = dgy = dginit; + + for (;;) { + /* + Set the minimum and maximum steps to correspond to the + present interval of uncertainty. + */ + if (brackt) { + stmin = min2(stx, sty); + stmax = max2(stx, sty); + } else { + stmin = stx; + stmax = *stp + 4.0 * (*stp - stx); + } + + /* Clip the step in the range of [stpmin, stpmax]. */ + if (*stp < param->min_step) + *stp = param->min_step; + if (param->max_step < *stp) + *stp = param->max_step; + + /* + If an unusual termination is to occur then let + stp be the lowest point obtained so far. + */ + if ((brackt && ((*stp <= stmin || stmax <= *stp) || + param->max_linesearch <= count + 1 || uinfo != 0)) || + (brackt && (stmax - stmin <= param->xtol * stmax))) { + *stp = stx; + } + + /* + Compute the current value of x: + x <- x + (*stp) * s. + */ + veccpy(x, xp, n); + vecadd(x, s, *stp, n); + + /* Evaluate the function and gradient values. */ + *f = cd->proc_evaluate(cd->instance, x, g, cd->n, *stp); + vecdot(&dg, g, s, n); + + ftest1 = finit + *stp * dgtest; + ++count; + + /* Test for errors and convergence. */ + if (brackt && ((*stp <= stmin || stmax <= *stp) || uinfo != 0)) { + /* Rounding errors prevent further progress. */ + return LBFGSERR_ROUNDING_ERROR; + } + if (*stp == param->max_step && *f <= ftest1 && dg <= dgtest) { + /* The step is the maximum value. */ + return LBFGSERR_MAXIMUMSTEP; + } + if (*stp == param->min_step && (ftest1 < *f || dgtest <= dg)) { + /* The step is the minimum value. */ + return LBFGSERR_MINIMUMSTEP; + } + if (brackt && (stmax - stmin) <= param->xtol * stmax) { + /* Relative width of the interval of uncertainty is at most xtol. */ + return LBFGSERR_WIDTHTOOSMALL; + } + if (param->max_linesearch <= count) { + /* Maximum number of iteration. */ + return LBFGSERR_MAXIMUMLINESEARCH; + } + if (*f <= ftest1 && fabs(dg) <= param->gtol * (-dginit)) { + /* The sufficient decrease condition and the directional derivative + * condition hold. */ + return count; + } + + /* + In the first stage we seek a step for which the modified + function has a nonpositive value and nonnegative derivative. + */ + if (stage1 && *f <= ftest1 && + min2(param->ftol, param->gtol) * dginit <= dg) { + stage1 = 0; + } + + /* + A modified function is used to predict the step only if + we have not obtained a step for which the modified + function has a nonpositive function value and nonnegative + derivative, and if a lower function value has been + obtained but the decrease is not sufficient. + */ + if (stage1 && ftest1 < *f && *f <= fx) { + /* Define the modified function and derivative values. */ + fm = *f - *stp * dgtest; + fxm = fx - stx * dgtest; + fym = fy - sty * dgtest; + dgm = dg - dgtest; + dgxm = dgx - dgtest; + dgym = dgy - dgtest; + + /* + Call update_trial_interval() to update the interval of + uncertainty and to compute the new step. + */ + uinfo = update_trial_interval(&stx, &fxm, &dgxm, &sty, &fym, &dgym, stp, + &fm, &dgm, stmin, stmax, &brackt); + + /* Reset the function and gradient values for f. */ + fx = fxm + stx * dgtest; + fy = fym + sty * dgtest; + dgx = dgxm + dgtest; + dgy = dgym + dgtest; + } else { + /* + Call update_trial_interval() to update the interval of + uncertainty and to compute the new step. + */ + uinfo = update_trial_interval(&stx, &fx, &dgx, &sty, &fy, &dgy, stp, f, + &dg, stmin, stmax, &brackt); + } + + /* + Force a sufficient decrease in the interval of uncertainty. + */ + if (brackt) { + if (0.66 * prev_width <= fabs(sty - stx)) { + *stp = stx + 0.5 * (sty - stx); + } + prev_width = width; + width = fabs(sty - stx); + } + } + + return LBFGSERR_LOGICERROR; +} /** * Define the local variables for computing minimizers. */ -#define USES_MINIMIZER \ - lbfgsfloatval_t a, d, gamma, theta, p, q, r, s; +#define USES_MINIMIZER lbfgsfloatval_t a, d, gamma, theta, p, q, r, s; /** * Find a minimizer of an interpolated cubic function. @@ -1018,21 +921,22 @@ static int line_search_morethuente( * @param fv The value of f(v). * @param du The value of f'(v). */ -#define CUBIC_MINIMIZER(cm, u, fu, du, v, fv, dv) \ - d = (v) - (u); \ - theta = ((fu) - (fv)) * 3 / d + (du) + (dv); \ - p = fabs(theta); \ - q = fabs(du); \ - r = fabs(dv); \ - s = max3(p, q, r); \ - /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ - a = theta / s; \ - gamma = s * sqrt(a * a - ((du) / s) * ((dv) / s)); \ - if ((v) < (u)) gamma = -gamma; \ - p = gamma - (du) + theta; \ - q = gamma - (du) + gamma + (dv); \ - r = p / q; \ - (cm) = (u) + r * d; +#define CUBIC_MINIMIZER(cm, u, fu, du, v, fv, dv) \ + d = (v) - (u); \ + theta = ((fu) - (fv)) * 3 / d + (du) + (dv); \ + p = fabs(theta); \ + q = fabs(du); \ + r = fabs(dv); \ + s = max3(p, q, r); \ + /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ + a = theta / s; \ + gamma = s * sqrt(a * a - ((du) / s) * ((dv) / s)); \ + if ((v) < (u)) \ + gamma = -gamma; \ + p = gamma - (du) + theta; \ + q = gamma - (du) + gamma + (dv); \ + r = p / q; \ + (cm) = (u) + r * d; /** * Find a minimizer of an interpolated cubic function. @@ -1046,27 +950,28 @@ static int line_search_morethuente( * @param xmin The maximum value. * @param xmin The minimum value. */ -#define CUBIC_MINIMIZER2(cm, u, fu, du, v, fv, dv, xmin, xmax) \ - d = (v) - (u); \ - theta = ((fu) - (fv)) * 3 / d + (du) + (dv); \ - p = fabs(theta); \ - q = fabs(du); \ - r = fabs(dv); \ - s = max3(p, q, r); \ - /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ - a = theta / s; \ - gamma = s * sqrt(max2(0, a * a - ((du) / s) * ((dv) / s))); \ - if ((u) < (v)) gamma = -gamma; \ - p = gamma - (dv) + theta; \ - q = gamma - (dv) + gamma + (du); \ - r = p / q; \ - if (r < 0. && gamma != 0.) { \ - (cm) = (v) - r * d; \ - } else if (a < 0) { \ - (cm) = (xmax); \ - } else { \ - (cm) = (xmin); \ - } +#define CUBIC_MINIMIZER2(cm, u, fu, du, v, fv, dv, xmin, xmax) \ + d = (v) - (u); \ + theta = ((fu) - (fv)) * 3 / d + (du) + (dv); \ + p = fabs(theta); \ + q = fabs(du); \ + r = fabs(dv); \ + s = max3(p, q, r); \ + /* gamma = s*sqrt((theta/s)**2 - (du/s) * (dv/s)) */ \ + a = theta / s; \ + gamma = s * sqrt(max2(0, a * a - ((du) / s) * ((dv) / s))); \ + if ((u) < (v)) \ + gamma = -gamma; \ + p = gamma - (dv) + theta; \ + q = gamma - (dv) + gamma + (du); \ + r = p / q; \ + if (r < 0. && gamma != 0.) { \ + (cm) = (v)-r * d; \ + } else if (a < 0) { \ + (cm) = (xmax); \ + } else { \ + (cm) = (xmin); \ + } /** * Find a minimizer of an interpolated quadratic function. @@ -1077,9 +982,9 @@ static int line_search_morethuente( * @param v The value of another point, v. * @param fv The value of f(v). */ -#define QUARD_MINIMIZER(qm, u, fu, du, v, fv) \ - a = (v) - (u); \ - (qm) = (u) + (du) / (((fu) - (fv)) / a + (du)) / 2 * a; +#define QUARD_MINIMIZER(qm, u, fu, du, v, fv) \ + a = (v) - (u); \ + (qm) = (u) + (du) / (((fu) - (fv)) / a + (du)) / 2 * a; /** * Find a minimizer of an interpolated quadratic function. @@ -1089,9 +994,9 @@ static int line_search_morethuente( * @param v The value of another point, v. * @param dv The value of f'(v). */ -#define QUARD_MINIMIZER2(qm, u, du, v, dv) \ - a = (u) - (v); \ - (qm) = (v) + (dv) / ((dv) - (du)) * a; +#define QUARD_MINIMIZER2(qm, u, du, v, dv) \ + a = (u) - (v); \ + (qm) = (v) + (dv) / ((dv) - (du)) * a; /** * Update a safeguarded trial value and interval for line search. @@ -1116,256 +1021,233 @@ static int line_search_morethuente( * @param brackt The pointer to the predicate if the trial value is * bracketed. * @retval int Status value. Zero indicates a normal termination. - * + * * @see * Jorge J. More and David J. Thuente. Line search algorithm with * guaranteed sufficient decrease. ACM Transactions on Mathematical * Software (TOMS), Vol 20, No 3, pp. 286-307, 1994. */ -static int update_trial_interval( - lbfgsfloatval_t *x, - lbfgsfloatval_t *fx, - lbfgsfloatval_t *dx, - lbfgsfloatval_t *y, - lbfgsfloatval_t *fy, - lbfgsfloatval_t *dy, - lbfgsfloatval_t *t, - lbfgsfloatval_t *ft, - lbfgsfloatval_t *dt, - const lbfgsfloatval_t tmin, - const lbfgsfloatval_t tmax, - int *brackt - ) -{ - int bound; - int dsign = fsigndiff(dt, dx); - lbfgsfloatval_t mc; /* minimizer of an interpolated cubic. */ - lbfgsfloatval_t mq; /* minimizer of an interpolated quadratic. */ - lbfgsfloatval_t newt; /* new trial value. */ - USES_MINIMIZER; /* for CUBIC_MINIMIZER and QUARD_MINIMIZER. */ +static int update_trial_interval(lbfgsfloatval_t *x, lbfgsfloatval_t *fx, + lbfgsfloatval_t *dx, lbfgsfloatval_t *y, + lbfgsfloatval_t *fy, lbfgsfloatval_t *dy, + lbfgsfloatval_t *t, lbfgsfloatval_t *ft, + lbfgsfloatval_t *dt, + const lbfgsfloatval_t tmin, + const lbfgsfloatval_t tmax, int *brackt) { + int bound; + int dsign = fsigndiff(dt, dx); + lbfgsfloatval_t mc; /* minimizer of an interpolated cubic. */ + lbfgsfloatval_t mq; /* minimizer of an interpolated quadratic. */ + lbfgsfloatval_t newt; /* new trial value. */ + USES_MINIMIZER; /* for CUBIC_MINIMIZER and QUARD_MINIMIZER. */ - /* Check the input parameters for errors. */ + /* Check the input parameters for errors. */ + if (*brackt) { + if (*t <= min2(*x, *y) || max2(*x, *y) <= *t) { + /* The trival value t is out of the interval. */ + return LBFGSERR_OUTOFINTERVAL; + } + if (0. <= *dx * (*t - *x)) { + /* The function must decrease from x. */ + return LBFGSERR_INCREASEGRADIENT; + } + if (tmax < tmin) { + /* Incorrect tmin and tmax specified. */ + return LBFGSERR_INCORRECT_TMINMAX; + } + } + + /* + Trial value selection. + */ + if (*fx < *ft) { + /* + Case 1: a higher function value. + The minimum is brackt. If the cubic minimizer is closer + to x than the quadratic one, the cubic one is taken, else + the average of the minimizers is taken. + */ + *brackt = 1; + bound = 1; + CUBIC_MINIMIZER(mc, *x, *fx, *dx, *t, *ft, *dt); + QUARD_MINIMIZER(mq, *x, *fx, *dx, *t, *ft); + if (fabs(mc - *x) < fabs(mq - *x)) { + newt = mc; + } else { + newt = mc + 0.5 * (mq - mc); + } + } else if (dsign) { + /* + Case 2: a lower function value and derivatives of + opposite sign. The minimum is brackt. If the cubic + minimizer is closer to x than the quadratic (secant) one, + the cubic one is taken, else the quadratic one is taken. + */ + *brackt = 1; + bound = 0; + CUBIC_MINIMIZER(mc, *x, *fx, *dx, *t, *ft, *dt); + QUARD_MINIMIZER2(mq, *x, *dx, *t, *dt); + if (fabs(mc - *t) > fabs(mq - *t)) { + newt = mc; + } else { + newt = mq; + } + } else if (fabs(*dt) < fabs(*dx)) { + /* + Case 3: a lower function value, derivatives of the + same sign, and the magnitude of the derivative decreases. + The cubic minimizer is only used if the cubic tends to + infinity in the direction of the minimizer or if the minimum + of the cubic is beyond t. Otherwise the cubic minimizer is + defined to be either tmin or tmax. The quadratic (secant) + minimizer is also computed and if the minimum is brackt + then the the minimizer closest to x is taken, else the one + farthest away is taken. + */ + bound = 1; + CUBIC_MINIMIZER2(mc, *x, *fx, *dx, *t, *ft, *dt, tmin, tmax); + QUARD_MINIMIZER2(mq, *x, *dx, *t, *dt); if (*brackt) { - if (*t <= min2(*x, *y) || max2(*x, *y) <= *t) { - /* The trival value t is out of the interval. */ - return LBFGSERR_OUTOFINTERVAL; - } - if (0. <= *dx * (*t - *x)) { - /* The function must decrease from x. */ - return LBFGSERR_INCREASEGRADIENT; - } - if (tmax < tmin) { - /* Incorrect tmin and tmax specified. */ - return LBFGSERR_INCORRECT_TMINMAX; - } - } - - /* - Trial value selection. - */ - if (*fx < *ft) { - /* - Case 1: a higher function value. - The minimum is brackt. If the cubic minimizer is closer - to x than the quadratic one, the cubic one is taken, else - the average of the minimizers is taken. - */ - *brackt = 1; - bound = 1; - CUBIC_MINIMIZER(mc, *x, *fx, *dx, *t, *ft, *dt); - QUARD_MINIMIZER(mq, *x, *fx, *dx, *t, *ft); - if (fabs(mc - *x) < fabs(mq - *x)) { - newt = mc; - } else { - newt = mc + 0.5 * (mq - mc); - } - } else if (dsign) { - /* - Case 2: a lower function value and derivatives of - opposite sign. The minimum is brackt. If the cubic - minimizer is closer to x than the quadratic (secant) one, - the cubic one is taken, else the quadratic one is taken. - */ - *brackt = 1; - bound = 0; - CUBIC_MINIMIZER(mc, *x, *fx, *dx, *t, *ft, *dt); - QUARD_MINIMIZER2(mq, *x, *dx, *t, *dt); - if (fabs(mc - *t) > fabs(mq - *t)) { - newt = mc; - } else { - newt = mq; - } - } else if (fabs(*dt) < fabs(*dx)) { - /* - Case 3: a lower function value, derivatives of the - same sign, and the magnitude of the derivative decreases. - The cubic minimizer is only used if the cubic tends to - infinity in the direction of the minimizer or if the minimum - of the cubic is beyond t. Otherwise the cubic minimizer is - defined to be either tmin or tmax. The quadratic (secant) - minimizer is also computed and if the minimum is brackt - then the the minimizer closest to x is taken, else the one - farthest away is taken. - */ - bound = 1; - CUBIC_MINIMIZER2(mc, *x, *fx, *dx, *t, *ft, *dt, tmin, tmax); - QUARD_MINIMIZER2(mq, *x, *dx, *t, *dt); - if (*brackt) { - if (fabs(*t - mc) < fabs(*t - mq)) { - newt = mc; - } else { - newt = mq; - } - } else { - if (fabs(*t - mc) > fabs(*t - mq)) { - newt = mc; - } else { - newt = mq; - } - } + if (fabs(*t - mc) < fabs(*t - mq)) { + newt = mc; + } else { + newt = mq; + } } else { - /* - Case 4: a lower function value, derivatives of the - same sign, and the magnitude of the derivative does - not decrease. If the minimum is not brackt, the step - is either tmin or tmax, else the cubic minimizer is taken. - */ - bound = 0; - if (*brackt) { - CUBIC_MINIMIZER(newt, *t, *ft, *dt, *y, *fy, *dy); - } else if (*x < *t) { - newt = tmax; - } else { - newt = tmin; - } + if (fabs(*t - mc) > fabs(*t - mq)) { + newt = mc; + } else { + newt = mq; + } } - + } else { /* - Update the interval of uncertainty. This update does not - depend on the new step or the case analysis above. - - - Case a: if f(x) < f(t), - x <- x, y <- t. - - Case b: if f(t) <= f(x) && f'(t)*f'(x) > 0, - x <- t, y <- y. - - Case c: if f(t) <= f(x) && f'(t)*f'(x) < 0, - x <- t, y <- x. + Case 4: a lower function value, derivatives of the + same sign, and the magnitude of the derivative does + not decrease. If the minimum is not brackt, the step + is either tmin or tmax, else the cubic minimizer is taken. */ - if (*fx < *ft) { - /* Case a */ - *y = *t; - *fy = *ft; - *dy = *dt; + bound = 0; + if (*brackt) { + CUBIC_MINIMIZER(newt, *t, *ft, *dt, *y, *fy, *dy); + } else if (*x < *t) { + newt = tmax; } else { - /* Case c */ - if (dsign) { - *y = *x; - *fy = *fx; - *dy = *dx; - } - /* Cases b and c */ - *x = *t; - *fx = *ft; - *dx = *dt; + newt = tmin; } + } - /* Clip the new trial value in [tmin, tmax]. */ - if (tmax < newt) newt = tmax; - if (newt < tmin) newt = tmin; + /* + Update the interval of uncertainty. This update does not + depend on the new step or the case analysis above. - /* - Redefine the new trial value if it is close to the upper bound - of the interval. - */ - if (*brackt && bound) { - mq = *x + 0.66 * (*y - *x); - if (*x < *y) { - if (mq < newt) newt = mq; - } else { - if (newt < mq) newt = mq; - } + - Case a: if f(x) < f(t), + x <- x, y <- t. + - Case b: if f(t) <= f(x) && f'(t)*f'(x) > 0, + x <- t, y <- y. + - Case c: if f(t) <= f(x) && f'(t)*f'(x) < 0, + x <- t, y <- x. + */ + if (*fx < *ft) { + /* Case a */ + *y = *t; + *fy = *ft; + *dy = *dt; + } else { + /* Case c */ + if (dsign) { + *y = *x; + *fy = *fx; + *dy = *dx; } + /* Cases b and c */ + *x = *t; + *fx = *ft; + *dx = *dt; + } - /* Return the new trial value. */ - *t = newt; - return 0; + /* Clip the new trial value in [tmin, tmax]. */ + if (tmax < newt) + newt = tmax; + if (newt < tmin) + newt = tmin; + + /* + Redefine the new trial value if it is close to the upper bound + of the interval. + */ + if (*brackt && bound) { + mq = *x + 0.66 * (*y - *x); + if (*x < *y) { + if (mq < newt) + newt = mq; + } else { + if (newt < mq) + newt = mq; + } + } + + /* Return the new trial value. */ + *t = newt; + return 0; } +static lbfgsfloatval_t owlqn_x1norm(const lbfgsfloatval_t *x, const int start, + const int n) { + int i; + lbfgsfloatval_t norm = 0.; + for (i = start; i < n; ++i) { + norm += fabs(x[i]); + } - - -static lbfgsfloatval_t owlqn_x1norm( - const lbfgsfloatval_t* x, - const int start, - const int n - ) -{ - int i; - lbfgsfloatval_t norm = 0.; - - for (i = start;i < n;++i) { - norm += fabs(x[i]); - } - - return norm; + return norm; } -static void owlqn_pseudo_gradient( - lbfgsfloatval_t* pg, - const lbfgsfloatval_t* x, - const lbfgsfloatval_t* g, - const int n, - const lbfgsfloatval_t c, - const int start, - const int end - ) -{ - int i; +static void owlqn_pseudo_gradient(lbfgsfloatval_t *pg, const lbfgsfloatval_t *x, + const lbfgsfloatval_t *g, const int n, + const lbfgsfloatval_t c, const int start, + const int end) { + int i; - /* Compute the negative of gradients. */ - for (i = 0;i < start;++i) { - pg[i] = g[i]; - } + /* Compute the negative of gradients. */ + for (i = 0; i < start; ++i) { + pg[i] = g[i]; + } - /* Compute the psuedo-gradients. */ - for (i = start;i < end;++i) { - if (x[i] < 0.) { - /* Differentiable. */ - pg[i] = g[i] - c; - } else if (0. < x[i]) { - /* Differentiable. */ - pg[i] = g[i] + c; - } else { - if (g[i] < -c) { - /* Take the right partial derivative. */ - pg[i] = g[i] + c; - } else if (c < g[i]) { - /* Take the left partial derivative. */ - pg[i] = g[i] - c; - } else { - pg[i] = 0.; - } - } + /* Compute the psuedo-gradients. */ + for (i = start; i < end; ++i) { + if (x[i] < 0.) { + /* Differentiable. */ + pg[i] = g[i] - c; + } else if (0. < x[i]) { + /* Differentiable. */ + pg[i] = g[i] + c; + } else { + if (g[i] < -c) { + /* Take the right partial derivative. */ + pg[i] = g[i] + c; + } else if (c < g[i]) { + /* Take the left partial derivative. */ + pg[i] = g[i] - c; + } else { + pg[i] = 0.; + } } + } - for (i = end;i < n;++i) { - pg[i] = g[i]; - } + for (i = end; i < n; ++i) { + pg[i] = g[i]; + } } -static void owlqn_project( - lbfgsfloatval_t* d, - const lbfgsfloatval_t* sign, - const int start, - const int end - ) -{ - int i; +static void owlqn_project(lbfgsfloatval_t *d, const lbfgsfloatval_t *sign, + const int start, const int end) { + int i; - for (i = start;i < end;++i) { - if (d[i] * sign[i] <= 0) { - d[i] = 0; - } + for (i = start; i < end; ++i) { + if (d[i] * sign[i] <= 0) { + d[i] = 0; } + } } diff --git a/packages/yap-lbfgs/yap_lbfgs.c b/packages/yap-lbfgs/yap_lbfgs.c index 038506d8a..a5db1344d 100644 --- a/packages/yap-lbfgs/yap_lbfgs.c +++ b/packages/yap-lbfgs/yap_lbfgs.c @@ -68,9 +68,9 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x, } YAP_Term o; if (YAP_IsIntTerm((o = YAP_GetFromSlot(sl)))) - rc = YAP_IntOfTerm(o); + rc = YAP_IntOfTerm(o); else - rc = YAP_FloatOfTerm(o); + rc = YAP_FloatOfTerm(o); YAP_RecoverSlots(1, sl); return rc; } @@ -350,7 +350,7 @@ static YAP_Bool lbfgs_release(void) { /* return FALSE; */ } -static lbfgs_parameter_t * get_params(YAP_Term t) { +static lbfgs_parameter_t *get_params(YAP_Term t) { YAP_Int ar = YAP_ArityOfFunctor(YAP_FunctorOfTerm(t)); YAP_Term arg = YAP_ArgOfTerm(ar, t); return (lbfgs_parameter_t *)YAP_IntOfTerm(arg); @@ -516,7 +516,6 @@ static YAP_Bool lbfgs_set_parameter(void) { return TRUE; } - /** @pred lbfgs_get_parameter(+Name,-Value) Get the current Value for Name */ diff --git a/pl/listing.yap b/pl/listing.yap index 753a38f27..38543747f 100644 --- a/pl/listing.yap +++ b/pl/listing.yap @@ -33,10 +33,10 @@ /** * @defgroup listingGroup List predicates in a module - * + * * @ingroup builtins * - * @{ + * @{ */ @@ -144,7 +144,7 @@ listing(Stream, [MV|MVs]) :- !, '$listing'(_,_,_,_). '$funcspec'(Name/Arity,Name,Arity) :- !, atom(Name). -'$funcspec'(Name,Name,_) :- atom(Name), !. +'$funcspec'(Name,Name,0) :- atom(Name), !. '$funcspec'(Name,_,_) :- '$do_error'(domain_error(predicate_spec,Name),listing(Name)). @@ -216,7 +216,7 @@ listing(Stream, [MV|MVs]) :- !, '$clause'(Pred, M, Body, _), '$current_module'(Mod), ( M \= Mod -> H = M:Pred ; H = Pred ), - '$portray_clause'(Stream,(H:-Body)), + portray_clause(Stream,(H:-Body)), fail. /** @pred portray_clause(+ _S_,+ _C_) @@ -225,7 +225,7 @@ Write clause _C_ on stream _S_ as if written by listing/0. */ portray_clause(Stream, Clause) :- copy_term_nat(Clause, CopiedClause), - '$beautify_vs'(CopiedClause), + '$beautify_vs'(CopiedClause), '$portray_clause'(Stream, CopiedClause), fail. portray_clause(_, _).