more fixes for !

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1116 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-08-16 21:02:04 +00:00
parent dc6a6f6bd2
commit 15b122b2c9
5 changed files with 86 additions and 39 deletions

View File

@ -10,8 +10,16 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-08-11 16:14:51 $,$Author: vsc $ *
* Last rev: $Date: 2004-08-16 21:02:04 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.142 2004/08/11 16:14:51 vsc
* whole lot of fixes:
* - memory leak in indexing
* - memory management in WIN32 now supports holes
* - extend Yap interface, more support for SWI-Interface
* - new predicate mktime in system
* - buffer console I/O in WIN32
*
* Revision 1.141 2004/07/23 21:08:44 vsc
* windows fixes
*
@ -438,7 +446,7 @@ Yap_absmi(int inp)
else {
ASP = YREG;
}
*--ASP = MkIntTerm(0);
Yap_StartSlots();
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
@ -456,7 +464,7 @@ Yap_absmi(int inp)
else {
ASP = YREG;
}
*--ASP = MkIntTerm(0);
Yap_StartSlots();
saveregs();
#if PUSH_REGS
restore_absmi_regs(old_regs);
@ -1933,13 +1941,15 @@ Yap_absmi(int inp)
}
trim_trail:
HBREG = PROTECT_FROZEN_H(B->cp_b);
#if 1
{
tr_fr_ptr pt1, pt0;
pt1 = pt0 = B->cp_tr;
while (pt1 != TR) {
BEGD(d1);
if (IsVarTerm(d1 = TrailTerm(pt1))) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B)) {
d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
TrailTerm(pt0) = d1;
pt0++;
}
@ -1982,6 +1992,7 @@ Yap_absmi(int inp)
}
TR = pt0;
}
#endif /* X */
B = B->cp_b;
#endif /* YAPOR */
#ifdef TABLING
@ -2009,6 +2020,26 @@ Yap_absmi(int inp)
B = B->cp_b;
}
#endif /* YAPOR */
#ifdef FROZEN_STACKS
{
choiceptr top_b = PROTECT_FROZEN_B(B->cp_b);
#ifdef SBA
if (ENV > (CELL *) top_b || ENV < H) YREG = (CELL *) top_b;
#else
if (ENV > (CELL *) top_b) YREG = (CELL *) top_b;
#endif /* SBA */
else YREG = (CELL *)((CELL)ENV + ENV_Size(CPREG));
}
#else
if (ENV > (CELL *)B->cp_b) {
YREG = (CELL *)B->cp_b;
}
else {
YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG));
}
YREG[E_CB] = d0;
#endif /* FROZEN_STACKS */
goto trim_trail;
}
ENDD(d0);
@ -6299,7 +6330,7 @@ Yap_absmi(int inp)
ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s);
}
/* for slots to work */
*--ASP = MkIntTerm(0);
Yap_StartSlots();
#endif /* FROZEN_STACKS */
{
PredEntry *p = PREG->u.sla.sla_u.p;

View File

@ -11,8 +11,14 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2004-07-22 21:32:20 $,$Author: vsc $ *
* Last rev: $Date: 2004-08-16 21:02:04 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.126 2004/07/22 21:32:20 vsc
* debugger fixes
* initial support for JPL
* bad calls to garbage collector and gc
* debugger fixes
*
* Revision 1.125 2004/06/29 19:04:41 vsc
* fix multithreaded version
* include new version of Ricardo's profiler
@ -3202,14 +3208,22 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
LogUpdClause *cl;
Term rtn;
Term Terms[3];
long slh, slb, slr;
Yap_StartSlots();
slh = Yap_InitSlot(th);
slb = Yap_InitSlot(tb);
slr = Yap_InitSlot(tr);
Terms[0] = th;
Terms[1] = tb;
Terms[2] = tr;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
tr = Terms[2];
th = Yap_GetFromSlot(slh);
tb = Yap_GetFromSlot(slb);
tr = Yap_GetFromSlot(slr);
/* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(3);
*/
if (cl == NULL) {
return FALSE;
}
@ -3300,14 +3314,6 @@ p_log_update_clause(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
if(pe->OpcodeOfPred == INDEX_OPCODE) {
WRITE_LOCK(pe->PRWLock);
#if defined(YAPOR) || defined(THREADS)
if (pe->OpcodeOfPred == INDEX_OPCODE)
#endif
IPred(pe);
WRITE_UNLOCK(pe->PRWLock);
}
#if defined(YAPOR) || defined(THREADS)
READ_LOCK(pe->PRWLock);
PP = pe;
@ -3334,13 +3340,20 @@ fetch_next_lu_clause0(PredEntry *pe, yamop *i_code, Term th, Term tb, yamop *cp_
{
LogUpdClause *cl;
Term Terms[3];
long slh, slb;
Yap_StartSlots();
slh = Yap_InitSlot(th);
slb = Yap_InitSlot(tb);
Terms[0] = th;
Terms[1] = tb;
Terms[2] = TermNil;
cl = Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredLogUpdClause0->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
th = Yap_GetFromSlot(slh);
tb = Yap_GetFromSlot(slb);
/* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(2);
*/
#if defined(YAPOR) || defined(THREADS)
if (PP == pe) {
READ_UNLOCK(pe->PRWLock);
@ -3402,12 +3415,6 @@ p_log_update_clause0(void)
pe = get_pred(t1, Deref(ARG2), "clause/3");
if (pe == NULL || EndOfPAEntr(pe))
return FALSE;
if(pe->OpcodeOfPred == INDEX_OPCODE) {
#if defined(YAPOR) || defined(THREADS)
if (pe->OpcodeOfPred == INDEX_OPCODE)
#endif
IPred(pe);
}
#if defined(YAPOR) || defined(THREADS)
READ_LOCK(pe->PRWLock);
PP = pe;
@ -3435,14 +3442,22 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
StaticClause *cl;
Term rtn;
Term Terms[3];
long slh, slb, slr;
Yap_StartSlots();
slh = Yap_InitSlot(th);
slb = Yap_InitSlot(tb);
slr = Yap_InitSlot(tr);
Terms[0] = th;
Terms[1] = tb;
Terms[2] = tr;
cl = (StaticClause *)Yap_FollowIndexingCode(pe, i_code, Terms, NEXTOP(PredStaticClause->CodeOfPred,ld), cp_ptr);
th = Terms[0];
tb = Terms[1];
tr = Terms[2];
th = Yap_GetFromSlot(slh);
tb = Yap_GetFromSlot(slb);
tr = Yap_GetFromSlot(slr);
/* don't do this!! I might have stored a choice-point and changed ASP
Yap_RecoverSlots(3);
*/
if (cl == NULL)
return FALSE;
rtn = MkDBRefTerm((DBRef)cl);

View File

@ -1183,7 +1183,7 @@ Yap_execute_goal(Term t, int nargs, Term mod)
CP = saved_cp;
P = saved_p;
ASP = ENV;
*--ASP = MkIntTerm(0);
Yap_StartSlots();
#ifdef DEPTH_LIMIT
DEPTH= ENV[E_DEPTH];
#endif
@ -1517,7 +1517,7 @@ Yap_InitYaamRegs(void)
UNLOCK(SignalLock);
EX = 0L;
/* for slots to work */
*--ASP = MkIntTerm(0);
Yap_StartSlots();
#if COROUTINING
RESET_VARIABLE((CELL *)Yap_GlobalBase);
DelayedVars = Yap_NewTimedVar((CELL)Yap_GlobalBase);

View File

@ -2739,7 +2739,7 @@ p_write (void)
int flags = (int) IntOfTerm (Deref (ARG1));
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
*--ASP = MkIntTerm(0);
Yap_StartSlots();
Yap_plwrite (ARG2, Stream[Yap_c_output_stream].stream_putc, flags);
if (EX != 0L) {
Term ball = EX;
@ -2761,7 +2761,7 @@ p_write2 (void)
}
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
*--ASP = MkIntTerm(0);
Yap_StartSlots();
Yap_plwrite (ARG3, Stream[Yap_c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG2)));
Yap_c_output_stream = old_output_stream;
if (EX != 0L) {
@ -4061,7 +4061,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
*--ASP = MkIntTerm(0);
Yap_StartSlots();
Yap_plwrite (t, f_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f );
ASP++;
break;
@ -4069,7 +4069,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
*--ASP = MkIntTerm(0);
Yap_StartSlots();
{
long sl = Yap_InitSlot(args);
Yap_plwrite(t, f_putc, Handle_vars_f|Use_portray_f|To_heap_f);
@ -4096,7 +4096,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
*--ASP = MkIntTerm(0);
Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|Quote_illegal_f|To_heap_f);
ASP++;
break;
@ -4104,7 +4104,7 @@ format(volatile Term otail, volatile Term oargs, int sno)
if (targ > tnum-1 || has_repeats)
goto do_consistency_error;
t = targs[targ++];
*--ASP = MkIntTerm(0);
Yap_StartSlots();
Yap_plwrite (t, f_putc, Handle_vars_f|To_heap_f);
ASP++;
break;
@ -4777,7 +4777,7 @@ Yap_TermToString(Term t, char *s, unsigned int sz, int flags)
if (sno < 0)
return FALSE;
*--ASP = MkIntTerm(0);
Yap_StartSlots();
Yap_c_output_stream = sno;
Yap_plwrite (t, Stream[sno].stream_putc, flags);
s[Stream[sno].u.mem_string.pos] = '\0';

View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.54 2004-08-11 16:14:52 vsc Exp $ *
* version: $Id: Yapproto.h,v 1.55 2004-08-16 21:02:04 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -41,6 +41,7 @@ void STD_PROTO(Yap_ReleaseAtom,(Atom));
Term STD_PROTO(Yap_StringToList,(char *));
Term STD_PROTO(Yap_StringToListOfAtoms,(char *));
#define Yap_StartSlots() (*--ASP = MkIntTerm(0))
long STD_PROTO(Yap_InitSlot,(Term));
long STD_PROTO(Yap_NewSlots,(int));
Term STD_PROTO(Yap_GetFromSlot,(long));