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:
parent
dc6a6f6bd2
commit
15b122b2c9
43
C/absmi.c
43
C/absmi.c
@ -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;
|
||||
|
61
C/cdmgr.c
61
C/cdmgr.c
@ -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);
|
||||
|
4
C/exec.c
4
C/exec.c
@ -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);
|
||||
|
14
C/iopreds.c
14
C/iopreds.c
@ -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';
|
||||
|
@ -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));
|
||||
|
Reference in New Issue
Block a user