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
This commit is contained in:
parent
ae5c86e381
commit
4479ee4626
187
C/arrays.c
187
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_access_array, (void));
|
||||||
STATIC_PROTO(Int p_assign_static, (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
|
static Term
|
||||||
AccessNamedArray(Atom a, Int indx)
|
AccessNamedArray(Atom a, Int indx)
|
||||||
{
|
{
|
||||||
@ -263,36 +319,23 @@ AccessNamedArray(Atom a, Int indx)
|
|||||||
P = (yamop *)FAILCODE;
|
P = (yamop *)FAILCODE;
|
||||||
TRef = TermNil;
|
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:
|
case array_of_terms:
|
||||||
{
|
{
|
||||||
/* The object is now in use */
|
/* The object is now in use */
|
||||||
DBTerm *ref = ptr->ValueOfVE.terms[indx];
|
DBTerm *ref = ptr->ValueOfVE.terms[indx];
|
||||||
Term TRef;
|
|
||||||
|
|
||||||
READ_UNLOCK(ptr->ArRWLock);
|
READ_UNLOCK(ptr->ArRWLock);
|
||||||
if (ref != NULL) {
|
return GetTermFromArray(ref);
|
||||||
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);
|
|
||||||
}
|
}
|
||||||
default:
|
default:
|
||||||
READ_UNLOCK(ptr->ArRWLock);
|
READ_UNLOCK(ptr->ArRWLock);
|
||||||
@ -461,11 +504,12 @@ AllocateStaticArraySpace(StaticArrayEntry *p, static_array_types atype, Int arra
|
|||||||
case array_of_ptrs:
|
case array_of_ptrs:
|
||||||
asize = array_size*sizeof(AtomEntry *);
|
asize = array_size*sizeof(AtomEntry *);
|
||||||
break;
|
break;
|
||||||
case array_of_dbrefs:
|
|
||||||
case array_of_atoms:
|
case array_of_atoms:
|
||||||
asize = array_size*sizeof(Term);
|
|
||||||
break;
|
|
||||||
case array_of_terms:
|
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);
|
asize = array_size*sizeof(DBRef);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -535,6 +579,12 @@ CreateStaticArray(AtomEntry *ae, Int dim, static_array_types type, CODEADDR star
|
|||||||
for (i = 0; i < dim; i++)
|
for (i = 0; i < dim; i++)
|
||||||
p->ValueOfVE.terms[i] = NULL;
|
p->ValueOfVE.terms[i] = NULL;
|
||||||
break;
|
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 {
|
} else {
|
||||||
/* external array */
|
/* external array */
|
||||||
@ -614,6 +664,17 @@ ResizeStaticArray(StaticArrayEntry *pp, Int dim)
|
|||||||
for (i = mindim; i<dim; i++)
|
for (i = mindim; i<dim; i++)
|
||||||
pp->ValueOfVE.terms[i] = NULL;
|
pp->ValueOfVE.terms[i] = NULL;
|
||||||
break;
|
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);
|
WRITE_UNLOCK(pp->ArRWLock);
|
||||||
}
|
}
|
||||||
@ -767,6 +828,8 @@ p_create_static_array(void)
|
|||||||
props = array_of_uchars;
|
props = array_of_uchars;
|
||||||
else if (!strcmp(atname, "term"))
|
else if (!strcmp(atname, "term"))
|
||||||
props = array_of_terms;
|
props = array_of_terms;
|
||||||
|
else if (!strcmp(atname, "nb_term"))
|
||||||
|
props = array_of_nb_terms;
|
||||||
else {
|
else {
|
||||||
Yap_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array");
|
Yap_Error(DOMAIN_ERROR_ARRAY_TYPE,tprops,"create static array");
|
||||||
return(FALSE);
|
return(FALSE);
|
||||||
@ -862,6 +925,8 @@ p_static_array_properties(void)
|
|||||||
return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("unsigned char"))));
|
return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("unsigned char"))));
|
||||||
case array_of_terms:
|
case array_of_terms:
|
||||||
return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("term"))));
|
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:
|
case array_of_atoms:
|
||||||
return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("atom"))));
|
return(Yap_unify(ARG3,MkAtomTerm(Yap_LookupAtom("atom"))));
|
||||||
}
|
}
|
||||||
@ -1622,6 +1687,31 @@ p_assign_static(void)
|
|||||||
}
|
}
|
||||||
break;
|
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:
|
case array_of_terms:
|
||||||
{
|
{
|
||||||
|
|
||||||
@ -1633,7 +1723,7 @@ p_assign_static(void)
|
|||||||
ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(Deref(ARG3),3);
|
ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(Deref(ARG3),3);
|
||||||
if (ptr->ValueOfVE.terms[indx] == NULL){
|
if (ptr->ValueOfVE.terms[indx] == NULL){
|
||||||
WRITE_UNLOCK(ptr->ArRWLock);
|
WRITE_UNLOCK(ptr->ArRWLock);
|
||||||
return(FALSE);
|
return FALSE;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
@ -1986,32 +2076,33 @@ p_static_array_to_term(void)
|
|||||||
for (indx=0; indx < dim; indx++) {
|
for (indx=0; indx < dim; indx++) {
|
||||||
/* The object is now in use */
|
/* The object is now in use */
|
||||||
DBTerm *ref = pp->ValueOfVE.terms[indx];
|
DBTerm *ref = pp->ValueOfVE.terms[indx];
|
||||||
Term TRef;
|
|
||||||
|
|
||||||
if (ref != NULL) {
|
Term TRef = GetTermFromArray(ref);
|
||||||
while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
|
|
||||||
if (Yap_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
|
if (P == FAILCODE) {
|
||||||
Yap_Error_TYPE = YAP_NO_ERROR;
|
return FALSE;
|
||||||
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;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
*sptr++ = TRef;
|
*sptr++ = TRef;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
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:
|
case array_of_atoms:
|
||||||
for (indx=0; indx < dim; indx++) {
|
for (indx=0; indx < dim; indx++) {
|
||||||
Term out;
|
Term out;
|
||||||
@ -2026,7 +2117,7 @@ p_static_array_to_term(void)
|
|||||||
return Yap_unify(AbsAppl(base),ARG2);
|
return Yap_unify(AbsAppl(base),ARG2);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return(FALSE);
|
return FALSE;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
|
@ -960,9 +960,16 @@ typedef enum
|
|||||||
array_of_ptrs,
|
array_of_ptrs,
|
||||||
array_of_atoms,
|
array_of_atoms,
|
||||||
array_of_dbrefs,
|
array_of_dbrefs,
|
||||||
|
array_of_nb_terms,
|
||||||
array_of_terms
|
array_of_terms
|
||||||
} static_array_types;
|
} static_array_types;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
Term tlive;
|
||||||
|
Term tstore;
|
||||||
|
} live_term;
|
||||||
|
|
||||||
|
|
||||||
typedef union
|
typedef union
|
||||||
{
|
{
|
||||||
Int *ints;
|
Int *ints;
|
||||||
@ -973,6 +980,7 @@ typedef union
|
|||||||
Term *atoms;
|
Term *atoms;
|
||||||
Term *dbrefs;
|
Term *dbrefs;
|
||||||
DBTerm **terms;
|
DBTerm **terms;
|
||||||
|
live_term *lterms;
|
||||||
} statarray_elements;
|
} statarray_elements;
|
||||||
|
|
||||||
/* next, the actual data structure */
|
/* next, the actual data structure */
|
||||||
|
50
H/rheap.h
50
H/rheap.h
@ -11,8 +11,11 @@
|
|||||||
* File: rheap.h *
|
* File: rheap.h *
|
||||||
* comments: walk through heap code *
|
* 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 $
|
* $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
|
* Revision 1.53 2005/08/01 15:40:38 ricroc
|
||||||
* TABLING NEW: better support for incomplete tabling
|
* TABLING NEW: better support for incomplete tabling
|
||||||
*
|
*
|
||||||
@ -545,7 +548,9 @@ RestoreDBEntry(DBRef dbr)
|
|||||||
fprintf(stderr, " a var\n");
|
fprintf(stderr, " a var\n");
|
||||||
#endif
|
#endif
|
||||||
RestoreDBTerm(&(dbr->DBT));
|
RestoreDBTerm(&(dbr->DBT));
|
||||||
|
if (dbr->Parent) {
|
||||||
dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
|
dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
|
||||||
|
}
|
||||||
if (dbr->Code != NULL)
|
if (dbr->Code != NULL)
|
||||||
dbr->Code = PtoOpAdjust(dbr->Code);
|
dbr->Code = PtoOpAdjust(dbr->Code);
|
||||||
if (dbr->Prev != NULL)
|
if (dbr->Prev != NULL)
|
||||||
@ -836,6 +841,49 @@ restore_static_array(StaticArrayEntry *ae)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
return;
|
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:
|
case array_of_terms:
|
||||||
{
|
{
|
||||||
DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms));
|
DBTerm **base = (DBTerm **)AddrAdjust((ADDR)(ae->ValueOfVE.terms));
|
||||||
|
@ -114,7 +114,7 @@ prolog:nb_getval(GlobalVariable,Value) :-
|
|||||||
array_element(GlobalVariable,0,Value).
|
array_element(GlobalVariable,0,Value).
|
||||||
|
|
||||||
prolog:nb_setval(GlobalVariable,Value) :-
|
prolog:nb_setval(GlobalVariable,Value) :-
|
||||||
static_array(GlobalVariable,1,term),
|
static_array(GlobalVariable,1,nb_term),
|
||||||
update_array(GlobalVariable,0,Value).
|
update_array(GlobalVariable,0,Value).
|
||||||
|
|
||||||
prolog:nb_delete(GlobalVariable) :-
|
prolog:nb_delete(GlobalVariable) :-
|
||||||
|
Reference in New Issue
Block a user