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

fix ensure_loaded to reload if called from a different module.

Browse Source 
fix error handling in dbase.c


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@939 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-11-29 23:41:28 +00:00
parent 2867b43f06
commit d6207a55f9
10 changed files with 182 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
C/amasm.c
View File

@ -2675,13 +2675,29 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
H = (CELL *)freep;
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
H = h0;
if (!Yap_growheap(TRUE, size)) {
Yap_Error_TYPE = SYSTEM_ERROR;
switch (Yap_Error_TYPE) {
case OUT_OF_STACK_ERROR:
Yap_Error_Size = 256+((char *)freep - (char *)H);
save_machine_regs();
longjmp(Yap_CompilerBotch,3);
case OUT_OF_TRAIL_ERROR:
Yap_growtrail(64 * 1024L);
Yap_Error_TYPE = YAP_NO_ERROR;
break;
case OUT_OF_HEAP_ERROR:
/* don't just return NULL */
H = h0;
ARG1 = t;
if (!Yap_growheap(TRUE, size)) {
return NULL;
}
Yap_Error_TYPE = YAP_NO_ERROR;
t = ARG1;
h0 = H;
H = (CELL *)freep;
default:
return NULL;
}
h0 = H;
H = (CELL *)freep;
}
H = h0;
cl = (StaticClause *)((CODEADDR)x-(UInt)size);

2
C/compiler.c
View File

@ -2724,6 +2724,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
{
Int osize = 2*sizeof(CELL)*(ASP-H);
ARG1 = my_clause;
*H++ = src;
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Term = my_clause;
@ -2734,6 +2735,7 @@ Yap_cclause(Term inp_clause, int NOfArgs, int mod, Term src)
Yap_Error_Term = my_clause;
}
}
src = *--H;
my_clause = ARG1;
}
} else if (botch_why == 4) {

221
C/dbase.c
View File

@ -85,12 +85,6 @@ static char SccsId[] = "%W% %G%";
#define AllocDBSpace(V) ((DBRef)Yap_AllocCodeSpace(V))
#define FreeDBSpace(V) Yap_FreeCodeSpace(V)
#define NO_ERROR_IN_DB 0
#define OVF_ERROR_IN_DB 1
#define SOVF_ERROR_IN_DB 2
#define TOVF_ERROR_IN_DB 3
#define OTHER_ERROR_IN_DB 4
#if SIZEOF_INT_P==4
#define ToSmall(V) ((link_entry)(Unsigned(V)>>2))
#else
@ -156,13 +150,9 @@ typedef BITS16 link_entry;
#ifdef IDB_LINK_TABLE
static link_entry *lr = NULL, *LinkAr;
#endif
static int DBErrorFlag = FALSE; /* error while recording */
/* we cannot call Error directly from within recorded(). These flags are used
to delay for a while
*/
static yap_error_number DBErrorNumber; /* error number */
static Term DBErrorTerm; /* error term */
static char *DBErrorMsg; /* Error Message */
static DBRef *tofref; /* place the refs also up */
CELL *next_float = NULL;
@ -970,8 +960,8 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
return(CodeMax);
error:
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_Error_Size = 1024+((char *)AuxSp-(char *)HeapTop);
DBErrorFlag = OVF_ERROR_IN_DB;
*vars_foundp = vars_found;
#ifdef RATIONAL_TREES
while (to_visit > to_visit_base) {
@ -989,7 +979,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
return(NULL);
error2:
DBErrorFlag = SOVF_ERROR_IN_DB;
Yap_Error_TYPE = OUT_OF_STACK_ERROR;
*vars_foundp = vars_found;
#ifdef RATIONAL_TREES
while (to_visit > to_visit_base) {
@ -1008,7 +998,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
#if !OS_HANDLES_TR_OVERFLOW
error_tr_overflow:
DBErrorFlag = TOVF_ERROR_IN_DB; \
Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
*vars_foundp = vars_found;
#ifdef RATIONAL_TREES
while (to_visit > to_visit_base) {
@ -1071,10 +1061,9 @@ sf_include(sfp)
*StoPoint++ = tvalue;
j += 2;
} else {
DBErrorFlag = OTHER_ERROR_IN_DB;
DBErrorNumber = TYPE_ERROR_DBTERM;
DBErrorTerm = d0;
DBErrorMsg = "wrong term in SF";
Yap_Error_TYPE = TYPE_ERROR_DBTERM;
Yap_Error_Term = d0;
Yap_ErrorMessage = "wrong term in SF";
return(NULL);
}
}
@ -1210,10 +1199,9 @@ static DBRef
generate_dberror_msg(int errnumb, UInt sz, char *msg)
{
Yap_Error_Size = sz;
DBErrorFlag = errnumb;
DBErrorNumber = SYSTEM_ERROR;
DBErrorTerm = TermNil;
DBErrorMsg = msg;
Yap_Error_TYPE = errnumb;
Yap_Error_Term = TermNil;
Yap_ErrorMessage = msg;
return NULL;
}
@ -1226,13 +1214,13 @@ CreateDBWithDBRef(Term Tm, DBProp p)
if (p == NULL) {
ppt = (DBTerm *)AllocDBSpace(sizeof(DBTerm)+2*sizeof(CELL));
if (ppt == NULL) {
return generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
return generate_dberror_msg(OUT_OF_HEAP_ERROR, TermNil, "could not allocate space");
}
pp = (DBRef)ppt;
} else {
pp = AllocDBSpace(DBLength(2*sizeof(DBRef)));
if (pp == NULL) {
return generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
return generate_dberror_msg(OUT_OF_HEAP_ERROR, 0, "could not allocate space");
}
pp->id = FunctorDBRef;
pp->Flags = DBNoVars|DBComplex|DBWithRefs;
@ -1259,7 +1247,7 @@ CreateDBTermForAtom(Term Tm, UInt extra_size) {
ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm));
if (ptr == NULL) {
return (DBTerm *)generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
return (DBTerm *)generate_dberror_msg(OUT_OF_HEAP_ERROR, 0, "could not allocate space");
}
ppt = (DBTerm *)(ptr+extra_size);
ppt->NOfCells = 0;
@ -1280,7 +1268,7 @@ CreateDBTermForVar(UInt extra_size)
ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm));
if (ptr == NULL) {
return (DBTerm *)generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
return (DBTerm *)generate_dberror_msg(OUT_OF_HEAP_ERROR, 0, "could not allocate space");
}
ppt = (DBTerm *)(ptr+extra_size);
ppt->NOfCells = 0;
@ -1303,7 +1291,7 @@ CreateDBRefForAtom(Term Tm, DBProp p, int InFlag) {
return (found_one);
pp = AllocDBSpace(DBLength(NIL));
if (pp == NIL) {
return generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
return generate_dberror_msg(OUT_OF_HEAP_ERROR, 0, "could not allocate space");
}
pp->id = FunctorDBRef;
INIT_LOCK(pp->lock);
@ -1327,7 +1315,7 @@ CreateDBRefForVar(Term Tm, DBProp p, int InFlag) {
return (found_one);
pp = AllocDBSpace(DBLength(NULL));
if (pp == NULL) {
return generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "could not allocate space");
return generate_dberror_msg(OUT_OF_HEAP_ERROR, 0, "could not allocate space");
}
pp->id = FunctorDBRef;
pp->Flags = DBVar;
@ -1356,7 +1344,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
CELL *CodeAbs; /* how much code did we find */
int vars_found;
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
if (p == NULL) {
if (IsVarTerm(Tm)) {
@ -1477,7 +1465,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
}
}
CodeAbs = (CELL *)((CELL)ntp-(CELL)ntp0);
if (DBErrorFlag) {
if (Yap_Error_TYPE) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return (NULL); /* Error Situation */
}
@ -1497,7 +1485,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
CodeAbs += CellPtr(lr) - CellPtr(LinkAr);
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
Yap_Error_Size = (UInt)DBLength(CodeAbs);
DBErrorFlag = OVF_ERROR_IN_DB;
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return(NULL);
}
@ -1524,7 +1512,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
CodeAbs += (TmpRefBase - tofref) + 1;
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
Yap_Error_Size = (UInt)DBLength(CodeAbs);
DBErrorFlag = OVF_ERROR_IN_DB;
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return(NULL);
}
@ -1534,7 +1522,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
#if SIZEOF_LINK_ENTRY==2
if (Unsigned(CodeAbs) >= 0x40000) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return generate_dberror_msg(OTHER_ERROR_IN_DB, 0, "trying to store term larger than 256KB");
return generate_dberror_msg(SYSTEM_ERROR, 0, "trying to store term larger than 256KB");
}
#endif
#endif
@ -1543,14 +1531,14 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
ppt = (DBTerm *)(ptr+extra_size);
if (ppt == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return generate_dberror_msg(OVF_ERROR_IN_DB, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
return generate_dberror_msg(OUT_OF_HEAP_ERROR, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
}
pp = (DBRef)ppt;
} else {
pp = AllocDBSpace(DBLength(CodeAbs));
if (pp == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return generate_dberror_msg(OVF_ERROR_IN_DB, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
return generate_dberror_msg(OUT_OF_HEAP_ERROR, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
}
pp->id = FunctorDBRef;
pp->Flags = flag;
@ -1851,30 +1839,30 @@ p_rcda(void)
} else {
TRef = MkDBRefTerm(record(MkFirst, t1, t2, Unsigned(0)));
}
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -1891,19 +1879,19 @@ p_rcdap(void)
restart_record:
Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, Unsigned(0)));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return Yap_unify(ARG3, TRef);
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE;
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE;
@ -1911,11 +1899,11 @@ p_rcdap(void)
goto recover_record;
}
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return FALSE;
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -1941,30 +1929,30 @@ p_rcda_at(void)
restart_record:
Yap_Error_Size = 0;
TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -1994,30 +1982,30 @@ p_rcdz(void)
} else {
TRef = MkDBRefTerm(record(MkLast, t1, t2, Unsigned(0)));
}
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -2034,30 +2022,30 @@ p_rcdzp(void)
restart_record:
Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, Unsigned(0)));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -2083,30 +2071,30 @@ p_rcdz_at(void)
restart_record:
Yap_Error_Size = 0;
TRef = MkDBRefTerm(record_at(MkLast, DBRefOfTerm(t1), t2, Unsigned(0)));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recordz_at/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -2131,30 +2119,30 @@ p_rcdstatp(void)
TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, MkIntTerm(0)));
else
TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, MkIntTerm(0)));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG4,TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in record_stat_source/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
goto restart_record;
@ -2174,30 +2162,30 @@ p_drcdap(void)
Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkFirst | MkCode | WithRef,
t1, t2, t4));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
if (!Yap_gc(4, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t4 = Deref(ARG4);
@ -2218,30 +2206,30 @@ p_drcdzp(void)
Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkLast | MkCode | WithRef,
t1, t2, t4));
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
return Yap_unify(ARG3, TRef);
case OUT_OF_STACK_ERROR:
if (!Yap_gc(4, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
goto recover_record;
case TOVF_ERROR_IN_DB:
case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else
goto recover_record;
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
recover_record:
DBErrorFlag = NO_ERROR_IN_DB;
Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1);
t2 = Deref(ARG2);
t4 = Deref(ARG4);
@ -2494,10 +2482,9 @@ resize_int_keys(UInt new_size) {
new = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*new_size);
if (new == NULL) {
YAPLeaveCriticalSection();
DBErrorFlag = OTHER_ERROR_IN_DB;
DBErrorNumber = SYSTEM_ERROR;
DBErrorTerm = TermNil;
DBErrorMsg = "could not allocate space";
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "could not allocate space";
return(FALSE);
}
for (i = 0; i < new_size; i++) {
@ -2577,10 +2564,9 @@ new_lu_int_key(Int key)
if (INT_LU_KEYS == NULL) {
init_int_lu_keys();
if (INT_LU_KEYS == NULL) {
DBErrorFlag = OTHER_ERROR_IN_DB;
DBErrorNumber = SYSTEM_ERROR;
DBErrorTerm = TermNil;
DBErrorMsg = "could not allocate space";
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "could not allocate space";
return NULL;
}
}
@ -2693,10 +2679,9 @@ FetchIntDBPropFromKey(Int key, int flag, int new, char *error_mssg)
if (INT_KEYS == NULL) {
init_int_keys();
if (INT_KEYS == NULL) {
DBErrorFlag = OTHER_ERROR_IN_DB;
DBErrorNumber = SYSTEM_ERROR;
DBErrorTerm = TermNil;
DBErrorMsg = "could not allocate space";
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_Error_Term = TermNil;
Yap_ErrorMessage = "could not allocate space";
return(NULL);
}
}
@ -4579,13 +4564,13 @@ StoreTermInDB(Term t, int nargs)
Yap_Error_Size = 0;
while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL,
InQueue, &needs_vars, 0)) == NULL) {
switch(DBErrorFlag) {
case NO_ERROR_IN_DB:
switch(Yap_Error_TYPE) {
case YAP_NO_ERROR:
#ifdef DEBUG
Yap_Error(SYSTEM_ERROR, TermNil, "no error but null return in enqueue/2");
#endif
break;
case SOVF_ERROR_IN_DB:
case OUT_OF_STACK_ERROR:
XREGS[nargs+1] = t;
if (!Yap_gc(nargs+1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
@ -4594,20 +4579,20 @@ StoreTermInDB(Term t, int nargs)
t = Deref(XREGS[nargs+1]);
break;
}
case TOVF_ERROR_IN_DB:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
case OUT_OF_TRAIL_ERROR:
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE);
case OVF_ERROR_IN_DB:
case OUT_OF_HEAP_ERROR:
XREGS[nargs+1] = t;
if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
} else {
t = Deref(XREGS[nargs+1]);
break;
}
default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg);
Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE);
}
}

3
C/index.c
View File

@ -3438,7 +3438,7 @@ install_clauses(ClauseDef *cls, PredEntry *ap, istack_entry *stack, yamop *beg,
cls->Code = cls->CurrentCode = cl->ClCode;
cls->Tag = 0;
cls++;
if (cl->ClCode == end || cl->ClCode == NULL) {
if (cl->ClCode == end) {
return cls-1;
}
cl = cl->ClNext;
@ -3698,6 +3698,7 @@ expand_index(PredEntry *ap) {
case _trust_me4:
/* we will commit to this group for sure */
ipc = NEXTOP(ipc,ld);
alt = NULL;
/* start of a group, reset stack */
sp = stack;
stack[0].pos = 0;

2
C/tracer.c
View File

@ -115,6 +115,8 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
if (vsc_count < 340000LL)
return;
#ifdef COMMENTED
if (port != enter_pred ||
!pred ||

38
pl/boot.yap
View File

@ -244,10 +244,13 @@ repeat :- '$repeat'.
'$execute_commands'(V,_,_) :- var(V), !,
'$do_error'(instantiation_error,meta_call(V)).
'$execute_commands'([],_,_) :- !, fail.
'$execute_commands'([C|_],VL,Con) :-
'$execute_command'(C,VL,Con).
'$execute_commands'([_|Cs],VL,Con) :- !,
'$execute_commands'(Cs,VL,Con).
'$execute_commands'([C|_],VL,Con) :- !,
(
'$execute_command'(C,VL,Con)
;
'$execute_commands'(Cs,VL,Con)
),
fail.
'$execute_commands'(C,VL,Con) :-
'$execute_command'(C,VL,Con).
@ -856,26 +859,26 @@ break :- get_value('$break',BL), NBL is BL+1,
'$consult'(X) :-
'$find_in_path'(X,Y,consult(X)),
'$open'(Y,'$csult',Stream,0), !,
'$consult'(X,Stream),
'$current_module'(OldModule),
'$consult'(X,OldModule,Stream),
'$close'(Stream).
'$consult'(X) :-
'$do_error'(permission_error(input,stream,X),consult(X)).
'$consult'(_,Stream) :-
'$record_loaded'(Stream),
'$consult'(_,Module,Stream) :-
'$record_loaded'(Stream,Module),
fail.
'$consult'(F,Stream) :-
'$consult'(F,Module,Stream) :-
'$access_yap_flags'(8, 2), % SICStus Prolog compatibility
!,
'$reconsult'(F,Stream).
'$consult'(F,Stream) :-
'$reconsult'(F,Module,Stream).
'$consult'(F,Mod,Stream) :-
'$getcwd'(OldD),
get_value('$consulting_file',OldF),
'$set_consulting_file'(Stream),
H0 is heapused, '$cputime'(T0,_),
'$current_stream'(File,_,Stream),
'$current_module'(OldModule),
'$start_consult'(consult,File,LC),
get_value('$consulting',Old),
set_value('$consulting',true),
@ -895,7 +898,6 @@ break :- get_value('$break',BL), NBL is BL+1,
'$cd'(OldD),
( LC == 0 -> prompt(_,' |: ') ; true),
'$exec_initialisation_goals',
'$current_module'(Mod,OldModule),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
( '$undefined'('$print_message'(_,_),prolog) ->
( get_value('$verbose',on) ->
@ -909,14 +911,14 @@ break :- get_value('$break',BL), NBL is BL+1,
!.
'$record_loaded'(user).
'$record_loaded'(user_input).
'$record_loaded'(Stream) :-
'$loaded'(Stream,_), !.
'$record_loaded'(Stream) :-
'$record_loaded'(user, _).
'$record_loaded'(user_input, _).
'$record_loaded'(Stream, M) :-
'$loaded'(Stream, M, _), !.
'$record_loaded'(Stream, M) :-
'$file_name'(Stream,F),
'$file_age'(F,Age),
recorda('$loaded','$loaded'(F,Age),_).
recorda('$loaded','$loaded'(F,M,Age),_).
'$set_consulting_file'(user) :- !,
set_value('$consulting_file',user_input).

40
pl/consult.yap
View File

@ -16,6 +16,7 @@
*************************************************************************/
ensure_loaded(V) :-
'$current_module'(M),
'$ensure_loaded'(V).
'$ensure_loaded'(V) :- var(V), !,
@ -32,14 +33,15 @@ ensure_loaded(V) :-
'$ensure_loaded'(X) :-
'$find_in_path'(X,Y,ensure_loaded(X)),
'$open'(Y, '$csult', Stream, 0), !,
( '$loaded'(Stream,TFN) ->
( recorded('$module','$module'(TFN,M,P),_) ->
'$current_module'(T), '$import'(P,M,T)
'$current_module'(M),
( '$loaded'(Stream, M, TFN) ->
( recorded('$module','$module'(TFN,NM,P),_) ->
'$import'(P,NM,M)
;
true
)
;
'$reconsult'(X,Stream)
'$reconsult'(X,M,Stream)
),
'$close'(Stream).
'$ensure_loaded'(X) :-
@ -89,15 +91,16 @@ reconsult(Fs) :-
'$reconsult'(X) :-
'$find_in_path'(X,Y,reconsult(X)),
'$open'(Y,'$csult',Stream,0), !,
'$reconsult'(X,Stream),
'$current_module'(M),
'$reconsult'(X,M,Stream),
'$close'(Stream).
'$reconsult'(X) :-
'$do_error'(permission_error(input,stream,X),reconsult(X)).
'$reconsult'(F,Stream) :-
'$record_loaded'(Stream),
'$reconsult'(F,M,Stream) :-
'$record_loaded'(Stream, M),
fail.
'$reconsult'(F,Stream) :-
'$reconsult'(F, OldModule, Stream) :-
'$getcwd'(OldD),
get_value('$consulting_file',OldF),
'$set_consulting_file'(Stream),
@ -105,7 +108,6 @@ reconsult(Fs) :-
current_stream(File,_,Stream),
get_value('$consulting',Old),
set_value('$consulting',false),
'$current_module'(OldModule),
'$start_reconsulting'(F),
'$start_consult'(reconsult,File,LC),
'$remove_multifile_clauses'(File),
@ -210,16 +212,28 @@ prolog_load_context(term_position, Position) :-
stream_position(Stream, Position).
'$loaded'(Stream,F1) :-
'$file_name'(Stream,F), %
recorded('$loaded','$loaded'(F1,Age),R),
'$loaded'(Stream,M,F1) :-
'$file_name'(Stream,F),
'$loaded_file'(F,M,F1).
% if the file exports a module, then we can
% be imported from any module.
'$loaded_file'(F,M,F1) :-
recorded('$module','$module'(F1,_,P),_),
recorded('$loaded','$loaded'(F1,_,Age),R),
'$same_file'(F1,F), !,
'$loaded_file_age'(F, R).
'$loaded_file'(F,M,F1) :-
recorded('$loaded','$loaded'(F1,M,Age),R),
'$same_file'(F1,F), !,
'$loaded_file_age'(F, R).
'$loaded_file_age'(F, R) :-
'$file_age'(F,CurrentAge),
((CurrentAge = Age ; Age = -1) -> true; erase(R), fail).
path(Path) :- findall(X,'$in_path'(X),Path).
'$in_path'(X) :- recorded('$path',Path,_),

1
pl/errors.yap
View File

@ -93,7 +93,6 @@ print_message(Level, Mss) :-
'$do_print_message'(M),
'$format'(user_error," ]~n", []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'(debug(debug)) :- !,
'$format'(user_error,"Debug mode on.",[]).

2
pl/init.yap
View File

@ -114,7 +114,7 @@ system_mode(verbose,off) :- set_value('$verbose',off).
%
% cleanup ensure loaded and recover some data-base space.
%
:- ( recorded('$loaded','$loaded'(_,_),R), erase(R), fail ; true ).
:- ( recorded('$loaded','$loaded'(_,_,_),R), erase(R), fail ; true ).
:- set_value('$user_module',user), '$protect'.

8
pl/modules.yap
View File

@ -58,12 +58,12 @@ use_module(M,I) :-
'$current_module'(M),
'$find_in_path'(File,X,use_module(File,Imports)), !,
'$open'(X,'$csult',Stream,0), !,
( '$loaded'(Stream,TrueFileName) -> true
( '$loaded'(Stream,M,TrueFileName) -> true
;
% the following avoids import of all public predicates
'$consulting_file_name'(Stream,TrueFileName),
recorda('$importing','$importing'(TrueFileName),R),
'$reconsult'(File,Stream)
'$reconsult'(File,M,Stream)
),
'$close'(Stream),
( var(R) -> true; erased(R) -> true; erase(R)),
@ -91,14 +91,14 @@ use_module(Mod,F,I) :-
'$current_module'(M),
'$file_name'(Stream,FName),
(
'$loaded'(Stream, TrueFileName)
'$loaded'(Stream, M, TrueFileName)
->
true
;
'$consulting_file_name'(Stream,TrueFileName),
% the following avoids import of all public predicates
recorda('$importing','$importing'(TrueFileName),R),
'$reconsult'(File,Stream)
'$reconsult'(File,M,Stream)
),
'$close'(Stream),
( var(R) -> true; erased(R) -> true; erase(R)),