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; H = (CELL *)freep;
while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) { while ((x = Yap_StoreTermInDBPlusExtraSpace(t, size)) == NULL) {
H = h0; switch (Yap_Error_TYPE) {
if (!Yap_growheap(TRUE, size)) { case OUT_OF_STACK_ERROR:
Yap_Error_TYPE = SYSTEM_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; return NULL;
} }
h0 = H;
H = (CELL *)freep;
} }
H = h0; H = h0;
cl = (StaticClause *)((CODEADDR)x-(UInt)size); 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); Int osize = 2*sizeof(CELL)*(ASP-H);
ARG1 = my_clause; ARG1 = my_clause;
*H++ = src;
if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) { if (!Yap_gcl(Yap_Error_Size, 2, ENV, P)) {
Yap_Error_TYPE = OUT_OF_STACK_ERROR; Yap_Error_TYPE = OUT_OF_STACK_ERROR;
Yap_Error_Term = my_clause; 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; Yap_Error_Term = my_clause;
} }
} }
src = *--H;
my_clause = ARG1; my_clause = ARG1;
} }
} else if (botch_why == 4) { } 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 AllocDBSpace(V) ((DBRef)Yap_AllocCodeSpace(V))
#define FreeDBSpace(V) Yap_FreeCodeSpace(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 #if SIZEOF_INT_P==4
#define ToSmall(V) ((link_entry)(Unsigned(V)>>2)) #define ToSmall(V) ((link_entry)(Unsigned(V)>>2))
#else #else
@ -156,13 +150,9 @@ typedef BITS16 link_entry;
#ifdef IDB_LINK_TABLE #ifdef IDB_LINK_TABLE
static link_entry *lr = NULL, *LinkAr; static link_entry *lr = NULL, *LinkAr;
#endif #endif
static int DBErrorFlag = FALSE; /* error while recording */
/* we cannot call Error directly from within recorded(). These flags are used /* we cannot call Error directly from within recorded(). These flags are used
to delay for a while 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 */ static DBRef *tofref; /* place the refs also up */
CELL *next_float = NULL; CELL *next_float = NULL;
@ -970,8 +960,8 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
return(CodeMax); return(CodeMax);
error: error:
Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_Error_Size = 1024+((char *)AuxSp-(char *)HeapTop); Yap_Error_Size = 1024+((char *)AuxSp-(char *)HeapTop);
DBErrorFlag = OVF_ERROR_IN_DB;
*vars_foundp = vars_found; *vars_foundp = vars_found;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > to_visit_base) { while (to_visit > to_visit_base) {
@ -989,7 +979,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end,
return(NULL); return(NULL);
error2: error2:
DBErrorFlag = SOVF_ERROR_IN_DB; Yap_Error_TYPE = OUT_OF_STACK_ERROR;
*vars_foundp = vars_found; *vars_foundp = vars_found;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > to_visit_base) { 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 #if !OS_HANDLES_TR_OVERFLOW
error_tr_overflow: error_tr_overflow:
DBErrorFlag = TOVF_ERROR_IN_DB; \ Yap_Error_TYPE = OUT_OF_TRAIL_ERROR;
*vars_foundp = vars_found; *vars_foundp = vars_found;
#ifdef RATIONAL_TREES #ifdef RATIONAL_TREES
while (to_visit > to_visit_base) { while (to_visit > to_visit_base) {
@ -1071,10 +1061,9 @@ sf_include(sfp)
*StoPoint++ = tvalue; *StoPoint++ = tvalue;
j += 2; j += 2;
} else { } else {
DBErrorFlag = OTHER_ERROR_IN_DB; Yap_Error_TYPE = TYPE_ERROR_DBTERM;
DBErrorNumber = TYPE_ERROR_DBTERM; Yap_Error_Term = d0;
DBErrorTerm = d0; Yap_ErrorMessage = "wrong term in SF";
DBErrorMsg = "wrong term in SF";
return(NULL); return(NULL);
} }
} }
@ -1210,10 +1199,9 @@ static DBRef
generate_dberror_msg(int errnumb, UInt sz, char *msg) generate_dberror_msg(int errnumb, UInt sz, char *msg)
{ {
Yap_Error_Size = sz; Yap_Error_Size = sz;
DBErrorFlag = errnumb; Yap_Error_TYPE = errnumb;
DBErrorNumber = SYSTEM_ERROR; Yap_Error_Term = TermNil;
DBErrorTerm = TermNil; Yap_ErrorMessage = msg;
DBErrorMsg = msg;
return NULL; return NULL;
} }
@ -1226,13 +1214,13 @@ CreateDBWithDBRef(Term Tm, DBProp p)
if (p == NULL) { if (p == NULL) {
ppt = (DBTerm *)AllocDBSpace(sizeof(DBTerm)+2*sizeof(CELL)); ppt = (DBTerm *)AllocDBSpace(sizeof(DBTerm)+2*sizeof(CELL));
if (ppt == NULL) { 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; pp = (DBRef)ppt;
} else { } else {
pp = AllocDBSpace(DBLength(2*sizeof(DBRef))); pp = AllocDBSpace(DBLength(2*sizeof(DBRef)));
if (pp == 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->id = FunctorDBRef;
pp->Flags = DBNoVars|DBComplex|DBWithRefs; pp->Flags = DBNoVars|DBComplex|DBWithRefs;
@ -1259,7 +1247,7 @@ CreateDBTermForAtom(Term Tm, UInt extra_size) {
ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm)); ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm));
if (ptr == NULL) { 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 = (DBTerm *)(ptr+extra_size);
ppt->NOfCells = 0; ppt->NOfCells = 0;
@ -1280,7 +1268,7 @@ CreateDBTermForVar(UInt extra_size)
ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm)); ptr = (ADDR)AllocDBSpace(extra_size+sizeof(DBTerm));
if (ptr == NULL) { 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 = (DBTerm *)(ptr+extra_size);
ppt->NOfCells = 0; ppt->NOfCells = 0;
@ -1303,7 +1291,7 @@ CreateDBRefForAtom(Term Tm, DBProp p, int InFlag) {
return (found_one); return (found_one);
pp = AllocDBSpace(DBLength(NIL)); pp = AllocDBSpace(DBLength(NIL));
if (pp == 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; pp->id = FunctorDBRef;
INIT_LOCK(pp->lock); INIT_LOCK(pp->lock);
@ -1327,7 +1315,7 @@ CreateDBRefForVar(Term Tm, DBProp p, int InFlag) {
return (found_one); return (found_one);
pp = AllocDBSpace(DBLength(NULL)); pp = AllocDBSpace(DBLength(NULL));
if (pp == 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->id = FunctorDBRef;
pp->Flags = DBVar; 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 */ CELL *CodeAbs; /* how much code did we find */
int vars_found; int vars_found;
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
if (p == NULL) { if (p == NULL) {
if (IsVarTerm(Tm)) { 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); CodeAbs = (CELL *)((CELL)ntp-(CELL)ntp0);
if (DBErrorFlag) { if (Yap_Error_TYPE) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return (NULL); /* Error Situation */ 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); CodeAbs += CellPtr(lr) - CellPtr(LinkAr);
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) { if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
Yap_Error_Size = (UInt)DBLength(CodeAbs); Yap_Error_Size = (UInt)DBLength(CodeAbs);
DBErrorFlag = OVF_ERROR_IN_DB; Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return(NULL); return(NULL);
} }
@ -1524,7 +1512,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
CodeAbs += (TmpRefBase - tofref) + 1; CodeAbs += (TmpRefBase - tofref) + 1;
if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) { if ((CELL *)((char *)ntp0+(CELL)CodeAbs) > AuxSp) {
Yap_Error_Size = (UInt)DBLength(CodeAbs); Yap_Error_Size = (UInt)DBLength(CodeAbs);
DBErrorFlag = OVF_ERROR_IN_DB; Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return(NULL); return(NULL);
} }
@ -1534,7 +1522,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
#if SIZEOF_LINK_ENTRY==2 #if SIZEOF_LINK_ENTRY==2
if (Unsigned(CodeAbs) >= 0x40000) { if (Unsigned(CodeAbs) >= 0x40000) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); 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
#endif #endif
@ -1543,14 +1531,14 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
ppt = (DBTerm *)(ptr+extra_size); ppt = (DBTerm *)(ptr+extra_size);
if (ppt == NULL) { if (ppt == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); 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; pp = (DBRef)ppt;
} else { } else {
pp = AllocDBSpace(DBLength(CodeAbs)); pp = AllocDBSpace(DBLength(CodeAbs));
if (pp == NULL) { if (pp == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0); 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->id = FunctorDBRef;
pp->Flags = flag; pp->Flags = flag;
@ -1851,30 +1839,30 @@ p_rcda(void)
} else { } else {
TRef = MkDBRefTerm(record(MkFirst, t1, t2, Unsigned(0))); TRef = MkDBRefTerm(record(MkFirst, t1, t2, Unsigned(0)));
} }
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -1891,19 +1879,19 @@ p_rcdap(void)
restart_record: restart_record:
Yap_Error_Size = 0; Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, Unsigned(0))); TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, Unsigned(0)));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return Yap_unify(ARG3, TRef); return Yap_unify(ARG3, TRef);
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return FALSE; return FALSE;
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return FALSE; return FALSE;
@ -1911,11 +1899,11 @@ p_rcdap(void)
goto recover_record; goto recover_record;
} }
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return FALSE; return FALSE;
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -1941,30 +1929,30 @@ p_rcda_at(void)
restart_record: restart_record:
Yap_Error_Size = 0; Yap_Error_Size = 0;
TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0))); TRef = MkDBRefTerm(record_at(MkFirst, DBRefOfTerm(t1), t2, Unsigned(0)));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -1994,30 +1982,30 @@ p_rcdz(void)
} else { } else {
TRef = MkDBRefTerm(record(MkLast, t1, t2, Unsigned(0))); TRef = MkDBRefTerm(record(MkLast, t1, t2, Unsigned(0)));
} }
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -2034,30 +2022,30 @@ p_rcdzp(void)
restart_record: restart_record:
Yap_Error_Size = 0; Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, Unsigned(0))); TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, Unsigned(0)));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -2083,30 +2071,30 @@ p_rcdz_at(void)
restart_record: restart_record:
Yap_Error_Size = 0; Yap_Error_Size = 0;
TRef = MkDBRefTerm(record_at(MkLast, DBRefOfTerm(t1), t2, Unsigned(0))); TRef = MkDBRefTerm(record_at(MkLast, DBRefOfTerm(t1), t2, Unsigned(0)));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recordz_at/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -2131,30 +2119,30 @@ p_rcdstatp(void)
TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, MkIntTerm(0))); TRef = MkDBRefTerm(record(MkFirst | MkCode, t1, t2, MkIntTerm(0)));
else else
TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, MkIntTerm(0))); TRef = MkDBRefTerm(record(MkLast | MkCode, t1, t2, MkIntTerm(0)));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG4,TRef)); return (Yap_unify(ARG4,TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_gc(3, ENV, P)) { if (!Yap_gc(3, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in record_stat_source/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
goto restart_record; goto restart_record;
@ -2174,30 +2162,30 @@ p_drcdap(void)
Yap_Error_Size = 0; Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkFirst | MkCode | WithRef, TRef = MkDBRefTerm(record(MkFirst | MkCode | WithRef,
t1, t2, t4)); t1, t2, t4));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return (Yap_unify(ARG3, TRef));
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(4, ENV, P)) { if (!Yap_gc(4, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
t4 = Deref(ARG4); t4 = Deref(ARG4);
@ -2218,30 +2206,30 @@ p_drcdzp(void)
Yap_Error_Size = 0; Yap_Error_Size = 0;
TRef = MkDBRefTerm(record(MkLast | MkCode | WithRef, TRef = MkDBRefTerm(record(MkLast | MkCode | WithRef,
t1, t2, t4)); t1, t2, t4));
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
return (Yap_unify(ARG3, TRef)); return Yap_unify(ARG3, TRef);
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
if (!Yap_gc(4, ENV, P)) { if (!Yap_gc(4, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
goto recover_record; 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"); Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
if (!Yap_growheap(FALSE, Yap_Error_Size)) { if (!Yap_growheap(FALSE, Yap_Error_Size)) {
Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(SYSTEM_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} else } else
goto recover_record; goto recover_record;
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); return(FALSE);
} }
recover_record: recover_record:
DBErrorFlag = NO_ERROR_IN_DB; Yap_Error_TYPE = YAP_NO_ERROR;
t1 = Deref(ARG1); t1 = Deref(ARG1);
t2 = Deref(ARG2); t2 = Deref(ARG2);
t4 = Deref(ARG4); t4 = Deref(ARG4);
@ -2494,10 +2482,9 @@ resize_int_keys(UInt new_size) {
new = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*new_size); new = (Prop *)Yap_AllocCodeSpace(sizeof(Prop)*new_size);
if (new == NULL) { if (new == NULL) {
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
DBErrorFlag = OTHER_ERROR_IN_DB; Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
DBErrorNumber = SYSTEM_ERROR; Yap_Error_Term = TermNil;
DBErrorTerm = TermNil; Yap_ErrorMessage = "could not allocate space";
DBErrorMsg = "could not allocate space";
return(FALSE); return(FALSE);
} }
for (i = 0; i < new_size; i++) { for (i = 0; i < new_size; i++) {
@ -2577,10 +2564,9 @@ new_lu_int_key(Int key)
if (INT_LU_KEYS == NULL) { if (INT_LU_KEYS == NULL) {
init_int_lu_keys(); init_int_lu_keys();
if (INT_LU_KEYS == NULL) { if (INT_LU_KEYS == NULL) {
DBErrorFlag = OTHER_ERROR_IN_DB; Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
DBErrorNumber = SYSTEM_ERROR; Yap_Error_Term = TermNil;
DBErrorTerm = TermNil; Yap_ErrorMessage = "could not allocate space";
DBErrorMsg = "could not allocate space";
return NULL; return NULL;
} }
} }
@ -2693,10 +2679,9 @@ FetchIntDBPropFromKey(Int key, int flag, int new, char *error_mssg)
if (INT_KEYS == NULL) { if (INT_KEYS == NULL) {
init_int_keys(); init_int_keys();
if (INT_KEYS == NULL) { if (INT_KEYS == NULL) {
DBErrorFlag = OTHER_ERROR_IN_DB; Yap_Error_TYPE = OUT_OF_HEAP_ERROR;
DBErrorNumber = SYSTEM_ERROR; Yap_Error_Term = TermNil;
DBErrorTerm = TermNil; Yap_ErrorMessage = "could not allocate space";
DBErrorMsg = "could not allocate space";
return(NULL); return(NULL);
} }
} }
@ -4579,13 +4564,13 @@ StoreTermInDB(Term t, int nargs)
Yap_Error_Size = 0; Yap_Error_Size = 0;
while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL, while ((x = (DBTerm *)CreateDBStruct(t, (DBProp)NULL,
InQueue, &needs_vars, 0)) == NULL) { InQueue, &needs_vars, 0)) == NULL) {
switch(DBErrorFlag) { switch(Yap_Error_TYPE) {
case NO_ERROR_IN_DB: case YAP_NO_ERROR:
#ifdef DEBUG #ifdef DEBUG
Yap_Error(SYSTEM_ERROR, TermNil, "no error but null return in enqueue/2"); Yap_Error(SYSTEM_ERROR, TermNil, "no error but null return in enqueue/2");
#endif #endif
break; break;
case SOVF_ERROR_IN_DB: case OUT_OF_STACK_ERROR:
XREGS[nargs+1] = t; XREGS[nargs+1] = t;
if (!Yap_gc(nargs+1, ENV, P)) { if (!Yap_gc(nargs+1, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage); Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
@ -4594,20 +4579,20 @@ StoreTermInDB(Term t, int nargs)
t = Deref(XREGS[nargs+1]); t = Deref(XREGS[nargs+1]);
break; break;
} }
case TOVF_ERROR_IN_DB: case OUT_OF_TRAIL_ERROR:
Yap_Error(SYSTEM_ERROR, TermNil, "YAP could not grow trail in recorda/3"); Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "YAP could not grow trail in recorda/3");
return(FALSE); return(FALSE);
case OVF_ERROR_IN_DB: case OUT_OF_HEAP_ERROR:
XREGS[nargs+1] = t; XREGS[nargs+1] = t;
if (!Yap_growheap(FALSE, Yap_Error_Size)) { 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); return(FALSE);
} else { } else {
t = Deref(XREGS[nargs+1]); t = Deref(XREGS[nargs+1]);
break; break;
} }
default: default:
Yap_Error(DBErrorNumber, DBErrorTerm, DBErrorMsg); Yap_Error(Yap_Error_TYPE, Yap_Error_Term, Yap_ErrorMessage);
return(FALSE); 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->Code = cls->CurrentCode = cl->ClCode;
cls->Tag = 0; cls->Tag = 0;
cls++; cls++;
if (cl->ClCode == end || cl->ClCode == NULL) { if (cl->ClCode == end) {
return cls-1; return cls-1;
} }
cl = cl->ClNext; cl = cl->ClNext;
@ -3698,6 +3698,7 @@ expand_index(PredEntry *ap) {
case _trust_me4: case _trust_me4:
/* we will commit to this group for sure */ /* we will commit to this group for sure */
ipc = NEXTOP(ipc,ld); ipc = NEXTOP(ipc,ld);
alt = NULL;
/* start of a group, reset stack */ /* start of a group, reset stack */
sp = stack; sp = stack;
stack[0].pos = 0; 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; */ /* extern int gc_calls; */
vsc_count++; vsc_count++;
if (vsc_count < 340000LL)
return;
#ifdef COMMENTED #ifdef COMMENTED
if (port != enter_pred || if (port != enter_pred ||
!pred || !pred ||

38
pl/boot.yap
View File

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

40
pl/consult.yap
View File

@ -16,6 +16,7 @@
*************************************************************************/ *************************************************************************/
ensure_loaded(V) :- ensure_loaded(V) :-
'$current_module'(M),
'$ensure_loaded'(V). '$ensure_loaded'(V).
'$ensure_loaded'(V) :- var(V), !, '$ensure_loaded'(V) :- var(V), !,
@ -32,14 +33,15 @@ ensure_loaded(V) :-
'$ensure_loaded'(X) :- '$ensure_loaded'(X) :-
'$find_in_path'(X,Y,ensure_loaded(X)), '$find_in_path'(X,Y,ensure_loaded(X)),
'$open'(Y, '$csult', Stream, 0), !, '$open'(Y, '$csult', Stream, 0), !,
( '$loaded'(Stream,TFN) -> '$current_module'(M),
( recorded('$module','$module'(TFN,M,P),_) -> ( '$loaded'(Stream, M, TFN) ->
'$current_module'(T), '$import'(P,M,T) ( recorded('$module','$module'(TFN,NM,P),_) ->
'$import'(P,NM,M)
; ;
true true
) )
; ;
'$reconsult'(X,Stream) '$reconsult'(X,M,Stream)
), ),
'$close'(Stream). '$close'(Stream).
'$ensure_loaded'(X) :- '$ensure_loaded'(X) :-
@ -89,15 +91,16 @@ reconsult(Fs) :-
'$reconsult'(X) :- '$reconsult'(X) :-
'$find_in_path'(X,Y,reconsult(X)), '$find_in_path'(X,Y,reconsult(X)),
'$open'(Y,'$csult',Stream,0), !, '$open'(Y,'$csult',Stream,0), !,
'$reconsult'(X,Stream), '$current_module'(M),
'$reconsult'(X,M,Stream),
'$close'(Stream). '$close'(Stream).
'$reconsult'(X) :- '$reconsult'(X) :-
'$do_error'(permission_error(input,stream,X),reconsult(X)). '$do_error'(permission_error(input,stream,X),reconsult(X)).
'$reconsult'(F,Stream) :- '$reconsult'(F,M,Stream) :-
'$record_loaded'(Stream), '$record_loaded'(Stream, M),
fail. fail.
'$reconsult'(F,Stream) :- '$reconsult'(F, OldModule, Stream) :-
'$getcwd'(OldD), '$getcwd'(OldD),
get_value('$consulting_file',OldF), get_value('$consulting_file',OldF),
'$set_consulting_file'(Stream), '$set_consulting_file'(Stream),
@ -105,7 +108,6 @@ reconsult(Fs) :-
current_stream(File,_,Stream), current_stream(File,_,Stream),
get_value('$consulting',Old), get_value('$consulting',Old),
set_value('$consulting',false), set_value('$consulting',false),
'$current_module'(OldModule),
'$start_reconsulting'(F), '$start_reconsulting'(F),
'$start_consult'(reconsult,File,LC), '$start_consult'(reconsult,File,LC),
'$remove_multifile_clauses'(File), '$remove_multifile_clauses'(File),
@ -210,16 +212,28 @@ prolog_load_context(term_position, Position) :-
stream_position(Stream, Position). stream_position(Stream, Position).
'$loaded'(Stream,F1) :- '$loaded'(Stream,M,F1) :-
'$file_name'(Stream,F), % '$file_name'(Stream,F),
recorded('$loaded','$loaded'(F1,Age),R), '$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), !, '$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), '$file_age'(F,CurrentAge),
((CurrentAge = Age ; Age = -1) -> true; erase(R), fail). ((CurrentAge = Age ; Age = -1) -> true; erase(R), fail).
path(Path) :- findall(X,'$in_path'(X),Path). path(Path) :- findall(X,'$in_path'(X),Path).
'$in_path'(X) :- recorded('$path',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), '$do_print_message'(M),
'$format'(user_error," ]~n", []). '$format'(user_error," ]~n", []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$do_print_message'(debug(debug)) :- !, '$do_print_message'(debug(debug)) :- !,
'$format'(user_error,"Debug mode on.",[]). '$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. % 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'. :- set_value('$user_module',user), '$protect'.

8
pl/modules.yap
View File

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