diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

extend arrays with nb_terms so that we can implement nb_ builtins

Browse Source 
correctly.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1406 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-10-19 19:00:48 +00:00
parent ae5c86e381
commit 4479ee4626
4 changed files with 198 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

187
C/arrays.c
View File

@ -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; i<dim; i++)
pp->ValueOfVE.terms[i] = NULL;
break;
case array_of_nb_terms:
for (i = 0; i <mindim; i++) {
Term tlive = pp->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

8
H/Yatom.h
View File

@ -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 */

52
H/rheap.h
View File

@ -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));

2
library/swi.yap
View File

@ -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) :-