From 4479ee462608ecf6afb0816972f3b7dc8bcd3e32 Mon Sep 17 00:00:00 2001 From: vsc Date: Wed, 19 Oct 2005 19:00:48 +0000 Subject: [PATCH] extend arrays with nb_terms so that we can implement nb_ builtins correctly. git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1406 b08c6af1-5177-4d33-ba66-4b1c6b8b522a --- C/arrays.c | 187 +++++++++++++++++++++++++++++++++++------------- H/Yatom.h | 8 +++ H/rheap.h | 52 +++++++++++++- library/swi.yap | 2 +- 4 files changed, 198 insertions(+), 51 deletions(-) diff --git a/C/arrays.c b/C/arrays.c index ea537968b..e0b95e225 100644 --- a/C/arrays.c +++ b/C/arrays.c @@ -141,6 +141,62 @@ STATIC_PROTO(Int p_close_static_array, (void)); STATIC_PROTO(Int p_access_array, (void)); STATIC_PROTO(Int p_assign_static, (void)); +static Term +GetTermFromArray(DBTerm *ref) +{ + if (ref != NULL) { + Term TRef; + + while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) { + if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_growglobal(NULL)) { + Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); + return TermNil; + } + } else { + Yap_Error_TYPE = YAP_NO_ERROR; + if (!Yap_gc(3, ENV, CP)) { + Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); + return TermNil; + } + } + } + return TRef; + } else { + P = (yamop *)FAILCODE; + return TermNil; + } +} + +static Term +GetNBTerm(live_term *ar, Int indx) +{ + /* The object is now in use */ + Term livet = ar[indx].tlive; + Term termt = ar[indx].tstore; + + if (!IsVarTerm(livet) + || !IsUnboundVar(&(ar[indx].tlive))) { + return livet; + } + if (IsVarTerm(termt)) { + Term livet = MkVarTerm(); + Bind(&(ar[indx].tlive), livet); + return livet; + } else if (IsAtomicTerm(termt)) { + Bind(&(ar[indx].tlive), termt); + return termt; + } else { + DBTerm *ref = (DBTerm *)RepAppl(termt); + if ((livet = GetTermFromArray(ref)) == TermNil) { + return TermNil; + } + Bind(&(ar[indx].tlive), livet); + return livet; + } +} + static Term AccessNamedArray(Atom a, Int indx) { @@ -263,36 +319,23 @@ AccessNamedArray(Atom a, Int indx) P = (yamop *)FAILCODE; TRef = TermNil; } - return (TRef); + return TRef; + } + case array_of_nb_terms: + { + /* The object is now in use */ + Term out = GetNBTerm(ptr->ValueOfVE.lterms, indx); + + READ_UNLOCK(ptr->ArRWLock); + return out; } case array_of_terms: { /* The object is now in use */ DBTerm *ref = ptr->ValueOfVE.terms[indx]; - Term TRef; READ_UNLOCK(ptr->ArRWLock); - if (ref != NULL) { - while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); - return TermNil; - } - } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gc(3, ENV, CP)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return(TermNil); - } - } - } - } else { - P = (yamop *)FAILCODE; - TRef = TermNil; - } - return (TRef); + return GetTermFromArray(ref); } default: READ_UNLOCK(ptr->ArRWLock); @@ -461,11 +504,12 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra case array_of_ptrs: asize = array_size*sizeof(AtomEntry *); break; - case array_of_dbrefs: case array_of_atoms: - asize = array_size*sizeof(Term); - break; case array_of_terms: + case array_of_nb_terms: + asize = array_size*sizeof(live_term); + break; + case array_of_dbrefs: asize = array_size*sizeof(DBRef); break; } @@ -535,6 +579,12 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star for (i = 0; i < dim; i++) p->ValueOfVE.terms[i] = NULL; break; + case array_of_nb_terms: + for (i = 0; i < dim; i++) { + RESET_VARIABLE(&(p->ValueOfVE.lterms[i].tlive)); + p->ValueOfVE.lterms[i].tstore = TermNil; + } + break; } } else { /* external array */ @@ -614,6 +664,17 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim) for (i = mindim; iValueOfVE.terms[i] = NULL; break; + case array_of_nb_terms: + for (i = 0; i ValueOfVE.lterms[i].tlive; + if (IsVarTerm(tlive) && IsUnboundVar(&(pp->ValueOfVE.lterms[i].tlive))) { + RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive)); + } else { + pp->ValueOfVE.lterms[i].tlive = tlive; + } + pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore; + } + break; } WRITE_UNLOCK(pp->ArRWLock); } @@ -767,6 +828,8 @@ p_create_static_array(void) props = array_of_uchars; else if (!strcmp(atname, "term")) props = array_of_terms; + else if (!strcmp(atname, "nb_term")) + props = array_of_nb_terms; else { Yap_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array"); return(FALSE); @@ -862,6 +925,8 @@ p_static_array_properties(void) return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("unsigned char")))); case array_of_terms: return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("term")))); + case array_of_nb_terms: + return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("nb_term")))); case array_of_atoms: return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("atom")))); } @@ -1622,6 +1687,31 @@ p_assign_static(void) } break; + case array_of_nb_terms: + + RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tlive)); + { + Term told = ptr->ValueOfVE.lterms[indx].tstore; + Term tnew = Deref(ARG3); + /* recover space */ + if (IsApplTerm(told)) { + Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told)); + } + if (IsVarTerm(tnew)) { + RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore)); + } else if (IsAtomicTerm(tnew)) { + ptr->ValueOfVE.lterms[indx].tstore = tnew; + } else { + DBTerm *new = Yap_StoreTermInDB(tnew,3); + if (!new) { + WRITE_UNLOCK(ptr->ArRWLock); + return FALSE; + } + ptr->ValueOfVE.lterms[indx].tstore = AbsAppl((CELL *)new); + } + } + break; + case array_of_terms: { @@ -1633,7 +1723,7 @@ p_assign_static(void) ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(Deref(ARG3),3); if (ptr->ValueOfVE.terms[indx] == NULL){ WRITE_UNLOCK(ptr->ArRWLock); - return(FALSE); + return FALSE; } } break; @@ -1986,32 +2076,33 @@ p_static_array_to_term(void) for (indx=0; indx < dim; indx++) { /* The object is now in use */ DBTerm *ref = pp->ValueOfVE.terms[indx]; - Term TRef; - if (ref != NULL) { - while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) { - if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_growglobal(NULL)) { - Yap_Error(OUT_OF_ATTVARS_ERROR, TermNil, Yap_ErrorMessage); - return TermNil; - } - } else { - Yap_Error_TYPE = YAP_NO_ERROR; - if (!Yap_gc(3, YENV, P)) { - Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); - return TermNil; - } - } - } - } else { - P = (yamop *)FAILCODE; - TRef = TermNil; + Term TRef = GetTermFromArray(ref); + + if (P == FAILCODE) { + return FALSE; } + *sptr++ = TRef; } } break; + case array_of_nb_terms: + { + CELL *sptr = H; + H += dim; + for (indx=0; indx < dim; indx++) { + /* The object is now in use */ + Term To = GetNBTerm(pp->ValueOfVE.lterms, indx); + + if (P == FAILCODE) { + return FALSE; + } + + *sptr++ = To; + } + } + break; case array_of_atoms: for (indx=0; indx < dim; indx++) { Term out; @@ -2026,7 +2117,7 @@ p_static_array_to_term(void) return Yap_unify(AbsAppl(base),ARG2); } } - return(FALSE); + return FALSE; } static Int diff --git a/H/Yatom.h b/H/Yatom.h index 8f97cc0c6..9a374d691 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -960,9 +960,16 @@ typedef enum array_of_ptrs, array_of_atoms, array_of_dbrefs, + array_of_nb_terms, array_of_terms } static_array_types; +typedef struct { + Term tlive; + Term tstore; +} live_term; + + typedef union { Int *ints; @@ -973,6 +980,7 @@ typedef union Term *atoms; Term *dbrefs; DBTerm **terms; + live_term *lterms; } statarray_elements; /* next, the actual data structure */ diff --git a/H/rheap.h b/H/rheap.h index 9ff758ced..d2322bed2 100644 --- a/H/rheap.h +++ b/H/rheap.h @@ -11,8 +11,11 @@ * File: rheap.h * * comments: walk through heap code * * * -* Last rev: $Date: 2005-09-09 17:24:39 $,$Author: vsc $ * +* Last rev: $Date: 2005-10-19 19:00:48 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.54 2005/09/09 17:24:39 vsc +* a new and hopefully much better implementation of atts. +* * Revision 1.53 2005/08/01 15:40:38 ricroc * TABLING NEW: better support for incomplete tabling * @@ -545,7 +548,9 @@ RestoreDBEntry(DBRef dbr) fprintf(stderr, " a var\n"); #endif RestoreDBTerm(&(dbr->DBT)); - dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent)); + if (dbr->Parent) { + dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent)); + } if (dbr->Code != NULL) dbr->Code = PtoOpAdjust(dbr->Code); if (dbr->Prev != NULL) @@ -836,6 +841,49 @@ restore_static_array(StaticArrayEntry *ae) } } return; + case array_of_nb_terms: + { + live_term *base = (live_term *)AddrAdjust((ADDR)(ae->ValueOfVE.lterms)); + Int i; + + ae->ValueOfVE.lterms = base; + if (ae != 0L) { + for (i=0; i < sz; i++,base++) { + Term reg = base->tlive; + if (IsVarTerm(reg)) { + CELL *var = (CELL *)reg; + + if (IsOldGlobalPtr(var)) { + base->tlive = (CELL)PtoGloAdjust(var); + } else { + base->tlive = (CELL)PtoHeapCellAdjust(var); + } + } else if (IsAtomTerm(reg)) { + base->tlive = AtomTermAdjust(reg); + } else if (IsApplTerm(reg)) { + CELL *db = RepAppl(reg); + db = PtoGloAdjust(db); + base->tlive = AbsAppl(db); + } else if (IsApplTerm(reg)) { + CELL *db = RepPair(reg); + db = PtoGloAdjust(db); + base->tlive = AbsPair(db); + } + + reg = base->tstore; + if (IsVarTerm(reg)) { + base->tstore = (Term)GlobalAddrAdjust((ADDR)reg); + } else if (IsAtomTerm(reg)) { + base->tstore = AtomTermAdjust(reg); + } else { + DBTerm *db = (DBTerm *)RepAppl(reg); + db = DBTermAdjust(db); + RestoreDBTerm(db); + base->tstore = AbsAppl((CELL *)db); + } + } + } + } case array_of_terms: { DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms)); diff --git a/library/swi.yap b/library/swi.yap index 63c3742a9..b7f51d857 100644 --- a/library/swi.yap +++ b/library/swi.yap @@ -114,7 +114,7 @@ prolog:nb_getval(GlobalVariable,Value) :- array_element(GlobalVariable,0,Value). prolog:nb_setval(GlobalVariable,Value) :- - static_array(GlobalVariable,1,term), + static_array(GlobalVariable,1,nb_term), update_array(GlobalVariable,0,Value). prolog:nb_delete(GlobalVariable) :-