Menu
▾
▴
[Yap-commits] CVS: C arrays.c,1.2,1.3 dbase.c,1.4,1.5 init.c,1.6,1.7 save.c,1.9,1.10 sysbits.c,1.3,1.4
|
From: Vitor S. C. <vs...@us...> - 2001-06-08 19:10:48
|
Update of /cvsroot/yap/C
In directory usw-pr-cvs1:/tmp/cvs-serv13822/C
Modified Files:
arrays.c dbase.c init.c save.c sysbits.c
Log Message:
use arrays to implement catch and throw instead of record
cleanup queues at top-level and at catch-throw.
Index: arrays.c
===================================================================
RCS file: /cvsroot/yap/C/arrays.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- arrays.c 2001/06/08 14:52:53 1.2
+++ arrays.c 2001/06/08 19:10:43 1.3
@@ -771,6 +771,36 @@
}
}
+/* has a static array associated (+Name) */
+static Int
+p_has_static_array(void)
+{
+ Term t = Deref(ARG1);
+
+ if (IsVarTerm(t)) {
+ return (FALSE);
+ }
+ else if (IsAtomTerm(t)) {
+ /* Create a named array */
+ AtomEntry *ae = RepAtom(AtomOfTerm(t));
+ StaticArrayEntry *pp;
+
+ READ_LOCK(ae->ARWLock);
+ pp = RepStaticArrayProp(ae->PropOfAE);
+ while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
+ pp = RepStaticArrayProp(pp->NextOfPE);
+ if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
+ READ_UNLOCK(ae->ARWLock);
+ return (FALSE);
+ } else {
+ READ_UNLOCK(ae->ARWLock);
+ return(TRUE);
+ }
+ } else {
+ return (FALSE);
+ }
+}
+
/* resize a static array (+Name, + Size, +Props) */
/* does not work for mmap arrays yet */
static Int
@@ -1369,7 +1399,7 @@
Error(INSTANTIATION_ERROR,t3,"assign_static");
return (FALSE);
}
- if (indx < 0 || indx >= - ptr->ArrayEArity) {
+ if (indx < 0 || indx >= - ptr->ArrayEArity) {
WRITE_UNLOCK(ptr->ArRWLock);
Error(DOMAIN_ERROR_ARRAY_OVERFLOW,t2,"assign_static");
}
@@ -1543,6 +1573,60 @@
return(TRUE);
}
+/*
+ This is a hack, to steal the first element of a key.
+
+ It first fetches the first element in the chain, and then erases it
+ through its reference.
+
+ Be careful when using this routine. It is especially evil because if
+ the term is ground it should be copied to the stack, as space for
+ the entry may be deleted. For the moment, the terms I want are just
+ integers, so no problemo, amigo.
+
+ */
+static Term
+StealFirstFromDB(DBRef ref)
+{
+ Term TermDB, out;
+
+ if ((TermDB = FetchTermFromDB(ref,3)) == (CELL)0) {
+ /* oops, we are in trouble, not enough stack space */
+ return(TermNil);
+ }
+ if (IsVarTerm(TermDB) || !IsApplTerm(TermDB))
+ /* it's not a wonderful world afterall */
+ return(TermNil);
+ out = ArgOfTerm(1,TermDB);
+ /* now, return what once was there, only nevermore */
+ return(out);
+}
+
+Int
+SetDBForThrow(Term Message)
+{
+ Term cut_pt_term;
+ Atom a = FullLookupAtom("$catch_queue");
+ AtomEntry *ae = RepAtom(a);
+ StaticArrayEntry *ptr;
+ DBRef ref;
+ READ_LOCK(ae->ARWLock);
+ ptr = RepStaticArrayProp(ae->PropOfAE);
+ while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
+ ptr = RepStaticArrayProp(ptr->NextOfPE);
+ READ_UNLOCK(ae->ARWLock);
+ ref = ptr->ValueOfVE.terms[0];
+
+ cut_pt_term = StealFirstFromDB(ref);
+ if (IsVarTerm(cut_pt_term) || !IsIntegerTerm(cut_pt_term)) {
+ /* ooops, babe we are in trouble */
+ return(-1);
+ }
+ /* OK, we've got the place to cut to, next store the new throw */
+ ptr->ValueOfVE.terms[1] = StoreTermInDB(Message,3);
+ return(IntegerOfTerm(cut_pt_term));
+}
+
void
InitArrayPreds(void)
{
@@ -1558,5 +1642,6 @@
InitCPred("$sync_mmapped_arrays", 0, p_sync_mmapped_arrays, SafePredFlag);
InitCPred("$compile_array_refs", 0, p_compile_array_refs, SafePredFlag);
InitCPred("$array_refs_compiled", 0, p_array_refs_compiled, SafePredFlag);
+ InitCPred("$has_static_array", 1, p_has_static_array, TestPredFlag|SafePredFlag);
}
Index: dbase.c
===================================================================
RCS file: /cvsroot/yap/C/dbase.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- dbase.c 2001/06/08 14:52:53 1.4
+++ dbase.c 2001/06/08 19:10:43 1.5
@@ -114,7 +114,7 @@
} SFKeep;
#endif
-typedef struct
+typedef struct idb_queue
{
Functor id; /* identify this as being pointed to by a DBRef */
Term EntryTerm; /* cell bound to itself */
@@ -123,6 +123,8 @@
rwlock_t QRWLock; /* a simple lock to protect this entry */
#endif
DBRef FirstInQueue, LastInQueue;
+ Int age; /* the number of catches when we created the queue */
+ struct idb_queue *next, *prev;
} db_queue;
#define HashFieldMask ((CELL)0xffL)
@@ -263,7 +265,6 @@
STATIC_PROTO(Int p_first_age, (void));
STATIC_PROTO(Int p_db_nb_to_ref, (void));
STATIC_PROTO(Int p_last_age, (void));
-STATIC_PROTO(Term StealFirstFromDB, (Atom, Int));
#if OS_HANDLES_TR_OVERFLOW
#define check_trail(x)
@@ -3451,24 +3452,6 @@
return (TRUE);
}
-/* erase(+Ref) */
-static Int
-p_smash(void)
-{
- Term t1 = Deref(ARG1);
-
- if (IsVarTerm(t1)) {
- Error(INSTANTIATION_ERROR, t1, "erase");
- return (FALSE);
- }
- if (!IsDBRefTerm(t1)) {
- Error(TYPE_ERROR_DBREF, t1, "erase");
- return (FALSE);
- }
- EraseEntry(DBRefOfTerm(t1));
- return (TRUE);
-}
-
/* eraseall(+Key) */
static Int
p_eraseall(void)
@@ -3799,7 +3782,7 @@
db_queue *dbq;
Term t;
- while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NIL) {
+ while ((dbq = (db_queue *)AllocDBSpace(sizeof(db_queue))) == NULL) {
if (!growheap(FALSE)) {
Abort("[ SYSTEM ERROR: YAP failed to reserve space in growheap ]\n");
return(FALSE);
@@ -3808,12 +3791,17 @@
dbq->id = FunctorDBRef;
dbq->EntryTerm = MkAtomTerm(AbsAtom((AtomEntry *)dbq));
dbq->Flags = DBClMask;
- dbq->FirstInQueue = dbq->LastInQueue = NIL;
+ dbq->FirstInQueue = dbq->LastInQueue = NULL;
+ dbq->next = DBQueues;
+ dbq->prev = NULL;
+ DBQueues = dbq;
+ dbq->age = IntOfTerm(GetValue(AtomCatch));
INIT_RWLOCK(dbq->QRWLock);
t = MkDBRefTerm((DBRef)dbq);
return(unify(ARG1, t));
}
+
static Int
p_enqueue(void)
{
@@ -3887,6 +3875,12 @@
WRITE_LOCK(father_key->QRWLock);
if ((cur_instance = father_key->FirstInQueue) == NIL) {
/* an empty queue automatically goes away */
+ if (father_key == DBQueues)
+ DBQueues = father_key->next;
+ else
+ father_key->prev->next = father_key->next;
+ if (father_key->next != NULL)
+ father_key->next->prev = father_key->prev;
WRITE_UNLOCK(father_key->QRWLock);
FreeDBSpace((char *) father_key);
return(FALSE);
@@ -3906,78 +3900,35 @@
return(unify(ARG2, TDB));
}
}
-
-/*
- This is a hack, to steal the first element of a key.
- It first fetches the first element in the chain, and then erases it
- through its reference.
-
- Be careful when using this routine. It is especially evil because if
- the term is ground it should be copied to the stack, as space for
- the entry may be deleted. For the moment, the terms I want are just
- integers, so no problemo, amigo.
-
- */
-static Term
-StealFirstFromDB(Atom key, Int arity)
+static Int
+p_clean_queues(void)
{
- Prop AtProp;
- Register DBRef ref;
- Term TermDB;
- Term out;
-
- /* get the DB property */
- if ((AtProp = FindDBProp(RepAtom(key), 0, arity)) == NIL) {
- return(TermNil);
- }
- /* get the first entry */
-#ifdef KEEP_OLD_ENTRIES_HANGING_ABOUT
- ref = RepDBProp(AtProp)->FirstNEr;
-#else
- ref = RepDBProp(AtProp)->First;
-#endif
- /* is there anyone home ? */
- while (ref != NIL
- && (ref->Flags & (DBCode | ErasedMask)))
- ref = NextDBRef(ref);
- if (ref == NIL) {
- return(TermNil);
- }
- /* get our fine term */
- if ((TermDB = GetDBTerm(ref)) == (CELL)0) {
- /* oops, we are in trouble, not enough stack space */
- return(TermNil);
+ Int myage = IntOfTerm(ARG1);
+ db_queue *ptr;
+ YAPEnterCriticalSection();
+ ptr = DBQueues;
+ while (ptr) {
+ if (ptr->age >= myage) {
+ DBRef cur_instance;
+ db_queue *optr = ptr;
+
+ while ((cur_instance = ptr->FirstInQueue)) {
+ /* release space for cur_instance */
+ ptr->FirstInQueue = (DBRef)(cur_instance->Parent);
+ ErasePendingRefs(cur_instance);
+ FreeDBSpace((char *) cur_instance);
+ }
+ ptr = ptr->next;
+ FreeDBSpace((char *) optr);
+ } else
+ break;
}
- if (IsVarTerm(TermDB) || !IsApplTerm(TermDB))
- /* it's not a wonderful world afterall */
- return(TermNil);
-
- out = ArgOfTerm(1,TermDB);
- /* next, make it disappear from the DB */
- EraseEntry(ref);
- /* now, return what once was there, only nevermore */
- return(out);
-}
-
-Int
-SetDBForThrow(Term Message)
-{
- Term cut_pt_term;
-
- /* who's gonna catch us? */
- DBModule = 0;
- cut_pt_term = StealFirstFromDB(AtomCatch, 0);
- if (IsVarTerm(cut_pt_term) || !IsIntegerTerm(cut_pt_term)) {
- /* ooops, babe we are in trouble */
- return(-1);
- }
- /* OK, we've got the place to cut to, next store the new throw */
- if (record(MkFirst, MkAtomTerm(AtomThrow), Message, TermNil) == NIL)
- return (-1);
- else
- /* off we go, to see the wizard of Oz */
- return(IntegerOfTerm(cut_pt_term));
+ if (ptr)
+ ptr->prev = NULL;
+ DBQueues = ptr;
+ YAPLeaveCriticalSection();
+ return(TRUE);
}
/* given a key, find the clock number for the first entry */
@@ -4187,7 +4138,6 @@
InitCPred("$recordzp", 4, p_drcdzp, SafePredFlag|SyncPredFlag);
InitCPred("$recordaifnot", 3, p_rcdaifnot, SafePredFlag|SyncPredFlag);
InitCPred("$recordzifnot", 3, p_rcdzifnot, SafePredFlag|SyncPredFlag);
- InitCPred("$db_smash", 1, p_smash, SafePredFlag|SyncPredFlag);
InitCPred("erase", 1, p_erase, SafePredFlag|SyncPredFlag);
InitCPred("erased", 1, p_erased, TestPredFlag | SafePredFlag|SyncPredFlag);
InitCPred("instance", 2, p_instance, SyncPredFlag);
@@ -4199,6 +4149,7 @@
InitCPred("$db_key", 2, p_db_key, 0);
InitCPred("$db_enqueue", 2, p_enqueue, SyncPredFlag);
InitCPred("$db_dequeue", 2, p_dequeue, SyncPredFlag);
+ InitCPred("$db_clean_queues", 1, p_clean_queues, SyncPredFlag);
InitCPred("$db_first_age", 2, p_first_age, TestPredFlag|SafePredFlag|SyncPredFlag);
InitCPred("$db_nb_to_ref", 3, p_db_nb_to_ref, TestPredFlag|SafePredFlag);
InitCPred("$db_last_age", 2, p_last_age, TestPredFlag|SafePredFlag|SyncPredFlag);
Index: init.c
===================================================================
RCS file: /cvsroot/yap/C/init.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- init.c 2001/06/06 19:10:50 1.6
+++ init.c 2001/06/08 19:10:43 1.7
@@ -820,6 +820,7 @@
heap_regs->no_of_modules = 1;
heap_regs->primitives_module = 0;
heap_regs->user_module = 1;
+ heap_regs->db_queues = NULL;
heap_regs->atom_abol = LookupAtom("$abol");
AtomAltNot = LookupAtom("not");
heap_regs->atom_append = LookupAtom ("append");
Index: save.c
===================================================================
RCS file: /cvsroot/yap/C/save.c,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- save.c 2001/06/08 14:52:53 1.9
+++ save.c 2001/06/08 19:10:43 1.10
@@ -944,6 +944,10 @@
heap_regs->dead_clauses = (Clause *)
AddrAdjust((ADDR)(heap_regs->dead_clauses));
}
+ if (heap_regs->db_queues != NULL) {
+ heap_regs->db_queues = (struct idb_queue *)
+ AddrAdjust((ADDR)(heap_regs->db_queues));
+ }
heap_regs->retry_recorded_code =
PtoOpAdjust(heap_regs->retry_recorded_code);
heap_regs->retry_recorded_k_code =
Index: sysbits.c
===================================================================
RCS file: /cvsroot/yap/C/sysbits.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- sysbits.c 2001/05/21 20:00:05 1.3
+++ sysbits.c 2001/06/08 19:10:43 1.4
@@ -1099,7 +1099,7 @@
if (in_readline) {
/* readline must eat a newline, otherwise we will
have to wait before we do the Abort() */
- } else {
+ } else if (!(PrologMode & CritMode)) {
#endif
#if defined(__MINGW32__) || _MSC_VER
/* we can't do a direct abort, so ask the system to do it for us */
|
