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

YAP would break when gc was called from portray: 

always save arguments before calling plwrite with possible portray
 only do it for portray because plwrite may be called from unsafe environments
 make Slot machinery mainstream.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@637 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-10-17 00:05:29 +00:00
parent 78923655b5
commit 153b2cb2a3
11 changed files with 219 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
C/absmi.c
View File

@ -1746,8 +1746,9 @@ absmi(int inp)
DEPTH -= MkIntConstant(2);
#endif /* DEPTH_LIMIT */
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
if (do_low_level_trace) {
low_level_trace(enter_pred,pred_entry(pt0),XREGS+1);
}
#endif /* LOW_LEVEL_TRACE */
/* this is the equivalent to setting up the stack */
ALWAYS_GONext();
@ -5810,6 +5811,7 @@ absmi(int inp)
} else {
ASP = (CELL *) (((char *) Y) + PREG->u.sla.s);
}
/* for slots to work */
#endif /* FROZEN_STACKS */
#ifdef LOW_LEVEL_TRACER
if (do_low_level_trace)
@ -6053,7 +6055,12 @@ absmi(int inp)
WRITE_UNLOCK(PredFromDefCode(PREG)->PRWLock);
JMPNext();
}
#endif
#endif
/* update ASP before calling IPred */
ASP = Y+E_CB;
if (ASP > (CELL *) B) {
ASP = (CELL *) B;
}
IPred((CODEADDR)PredFromDefCode(PREG));
/* IPred can generate errors, it thus must get rid of the lock itself */
setregs();

51
C/adtdefs.c
View File

@ -671,3 +671,54 @@ ArgsOfSFTerm(Term t)
}
#endif
long
_YAP_NewSlots(int n)
{
Int old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) {
RESET_VARIABLE(ASP);
ASP--;
n--;
}
ASP[0] = MkIntTerm(old_slots+oldn);
return((ASP+1)-LCL0);
}
long
_YAP_InitSlot(Term t)
{
Int old_slots = IntOfTerm(ASP[0]);
*ASP = t;
ASP--;
ASP[0] = MkIntTerm(old_slots+1);
return((ASP+1)-LCL0);
}
void
_YAP_RecoverSlots(int n)
{
Int old_slots = IntOfTerm(ASP[0]);
ASP += n;
ASP[0] = MkIntTerm(old_slots-n);
}
Term
_YAP_GetFromSlot(long slot)
{
return(Deref(LCL0[slot]));
}
Term *
_YAP_AddressFromSlot(long slot)
{
return(LCL0+slot);
}
void
_YAP_PutInSlot(long slot, Term t)
{
LCL0[slot] = t;
}

25
C/c_interface.c
View File

@ -431,50 +431,37 @@ YAP_Unify(Term t1, Term t2)
X_API long
YAP_NewSlots(int n)
{
Int old_slots = IntOfTerm(ASP[0]), oldn = n;
while (n > 0) {
RESET_VARIABLE(ASP);
ASP--;
n--;
}
ASP[0] = MkIntTerm(old_slots+oldn);
return((ASP+1)-LCL0);
return _YAP_NewSlots(n);
}
X_API long
YAP_InitSlot(Term t)
{
Int old_slots = IntOfTerm(ASP[0]);
*ASP = t;
ASP--;
ASP[0] = MkIntTerm(old_slots+1);
return((ASP+1)-LCL0);
return _YAP_InitSlot(t);
}
X_API void
YAP_RecoverSlots(int n)
{
Int old_slots = IntOfTerm(ASP[0]);
ASP += n;
ASP[0] = MkIntTerm(old_slots-n);
return _YAP_RecoverSlots(n);
}
X_API Term
YAP_GetFromSlot(long slot)
{
return(Deref(LCL0[slot]));
return _YAP_GetFromSlot(slot);
}
X_API Term *
YAP_AddressFromSlot(long slot)
{
return(LCL0+slot);
return _YAP_AddressFromSlot(slot);
}
X_API void
YAP_PutInSlot(long slot, Term t)
{
LCL0[slot] = t;
_YAP_PutInSlot(slot, t);
}

2
C/errors.c
View File

@ -181,7 +181,7 @@ DumpActiveGoals (void)
DebugPutc (c_output_stream,'(');
for (i= 0; i < arity; i++) {
if (i > 0) DebugPutc (c_output_stream,',');
plwrite(args[i], DebugPutc, 4);
plwrite(args[i], DebugPutc, Handle_vars_f);
}
DebugPutc (c_output_stream,')');
}

7
C/exec.c
View File

@ -1447,8 +1447,11 @@ execute_goal(Term t, int nargs, SMALLUNSGN mod)
#ifdef DEPTH_LIMIT
DEPTH= B->cp_depth;
#endif
YENV= ASP = B->cp_env;
ENV = (CELL *)((B->cp_env)[E_E]);
/* ASP should be set to the top of the local stack when we
did the call */
ASP = B->cp_env;
/* YENV should be set to the current environment */
YENV = ENV = (CELL *)((B->cp_env)[E_E]);
B = B->cp_b;
SET_BB(B);
HB = PROTECT_FROZEN_H(B);

3
C/heapgc.c
View File

@ -3020,6 +3020,9 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop)
return(0);
}
gc_calls++;
if (gc_calls == 19) {
fprintf(stderr,"here I go\n");
}
if (gc_trace) {
YP_fprintf(YP_stderr, "[gc]\n");
} else if (gc_verbose) {

27
C/iopreds.c
View File

@ -2584,7 +2584,11 @@ p_current_output (void)
static Int
p_write (void)
{ /* '$write'(+Flags,?Term) */
plwrite (ARG2, Stream[c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG1)));
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);
plwrite (ARG2, Stream[c_output_stream].stream_putc, flags);
if (EX != 0L) {
Term ball = EX;
EX = 0L;
@ -2603,6 +2607,9 @@ p_write2 (void)
c_output_stream = old_output_stream;
return(FALSE);
}
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
*--ASP = MkIntTerm(0);
plwrite (ARG3, Stream[c_output_stream].stream_putc, (int) IntOfTerm (Deref (ARG2)));
c_output_stream = old_output_stream;
if (EX != 0L) {
@ -3789,7 +3796,7 @@ format(Term tail, Term args, int sno)
Error(TYPE_ERROR_ATOM,arghd,"~a in format/2");
return(FALSE);
}
plwrite (arghd, format_putc, 4);
plwrite (arghd, format_putc, Handle_vars_f);
break;
case 'c':
if (IsVarTerm (args)) {
@ -3888,7 +3895,7 @@ format(Term tail, Term args, int sno)
return(FALSE);
}
if (!arg_size) {
plwrite (arghd, format_putc, 4);
plwrite (arghd, format_putc, Handle_vars_f);
} else {
Int siz;
/*
@ -4166,7 +4173,7 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
plwrite (arghd, format_putc, (int) 3);
plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f );
break;
case 'p':
if (size_args) {
@ -4186,7 +4193,13 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
plwrite (arghd, format_putc, (int) 12);
*--ASP = MkIntTerm(0);
{
long sl = _YAP_InitSlot(args);
plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f);
args = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
if (EX != 0L) {
Term ball = EX;
EX = 0L;
@ -4213,7 +4226,7 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
plwrite (arghd, format_putc, (int) 5);
plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f);
break;
case 'w':
if (size_args) {
@ -4233,7 +4246,7 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
plwrite (arghd, format_putc, (int) 4);
plwrite (arghd, format_putc, Handle_vars_f);
break;
case '~':
if (size_args) {

7
C/tracer.c
View File

@ -60,7 +60,7 @@ send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
Portray_delays = TRUE;
#endif
#endif
plwrite(args[i], TracePutchar, 4);
plwrite(args[i], TracePutchar, Handle_vars_f);
#if DEBUG
#if COROUTINING
Portray_delays = FALSE;
@ -112,12 +112,13 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
/* if (vsc_count < 24200) return; */
/* return;*/
/* if (vsc_count < 38372100LL) return;*/
/* if (vsc_count == 80) {
printf("Here I go\n");
} */
/* if (vsc_count > 500000) exit(0); */
/* if (gc_calls < 1) return;*/
/* if (gc_calls < 1) return; */
#if defined(__GNUC__)
YP_fprintf(YP_stderr,"%llu ", vsc_count);
#endif

113
C/write.c
View File

@ -57,13 +57,9 @@ STATIC_PROTO(void writeTerm, (Term, int, int, int));
static int (*writech) (int, int);
static int Quote_illegal, Ignore_ops, Handle_vars, Use_portray;
static int keep_terms;
#define Quote_illegal_f 1
#define Ignore_ops_f 2
#define Handle_vars_f 4
#define Use_portray_f 8
#if DEBUG
#if COROUTINING
int Portray_delays = FALSE;
@ -324,15 +320,34 @@ write_var(CELL *t)
} else if (ext == attvars_ext) {
attvar_record *attv = (attvar_record *)t;
int i;
long sl = 0;
wrputs("$AT(");
write_var(t);
wrputc(',');
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot((CELL)attv);
}
writeTerm((Term)&(attv->Value), 999, 1, FALSE);
if (keep_terms) {
attv = (attvar_record *)_YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
for (i = 0; i < NUM_OF_ATTS; i ++) {
if (!IsVarTerm(attv->Atts[2*i+1])) {
long sl = 0;
wrputc(',');
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot((CELL)attv);
}
writeTerm((Term)&(attv->Atts[2*i+1]), 999, 1, FALSE);
if (keep_terms) {
attv = (attvar_record *)_YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
}
}
wrputc(')');
@ -389,12 +404,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
if (Use_portray) {
Term targs[1];
Term old_EX = 0L;
long sl = 0;
targs[0] = t;
PutValue(AtomPortray, MkAtomTerm(AtomNil));
if (EX != 0L) old_EX = EX;
*--ASP = MkIntTerm(0);
/* *--ASP = MkIntTerm(0); */
sl = _YAP_InitSlot(t);
execute_goal(MkApplTerm(FunctorPortray, 1, targs), 0, 1);
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
if (old_EX != 0L) EX = old_EX;
Use_portray = TRUE;
Use_portray = TRUE;
@ -408,6 +427,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
lastw = separator;
while (1) {
int new_depth = depth + 1;
long sl= 0;
if (*max_list && eldepth > *max_list) {
putAtom(LookupAtom("..."));
@ -416,7 +436,15 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
return;
} else
eldepth++;
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot(t);
}
writeTerm(HeadOfTermCell(t), 999, new_depth, FALSE);
if (keep_terms) {
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
ti = TailOfTerm(t);
if (IsVarTerm(ti))
break;
@ -452,6 +480,8 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
wrputc('(');
lastw = separator;
while (*p) {
long sl = 0;
while (argno < *p) {
wrputc('_'), wrputc(',');
++argno;
@ -459,7 +489,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
*p++;
lastw = separator;
/* cannot use the term directly with the SBA */
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot((CELL)p);
}
writeTerm(Deref(p++), 999, depth + 1, FALSE);
if (keep_terms) {
/* garbage collection may be called */
p = (CELL *)_YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
if (*p)
wrputc(',');
argno++;
@ -472,11 +511,15 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
if (Use_portray) {
Term targs[1];
Term old_EX = 0L;
long sl = 0;
targs[0] = t;
PutValue(AtomPortray, MkAtomTerm(AtomNil));
if (EX != 0L) old_EX = EX;
*--ASP = MkIntTerm(0);
sl = _YAP_InitSlot(t);
execute_goal(MkApplTerm(FunctorPortray, 1, targs),0, 1);
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
if (old_EX != 0L) EX = old_EX;
Use_portray = TRUE;
if (GetValue(AtomPortray) == MkAtomTerm(AtomTrue) || EX != 0L)
@ -522,6 +565,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
} else if (!Ignore_ops &&
Arity == 1 && opinfo && IsPosfixOp(opinfo, &op, &lp)) {
Term tleft = ArgOfTerm(1, t);
long sl = 0;
int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
LeftOpToProtect(AtomOfTerm(tleft), lp);
@ -536,7 +580,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
wrputc('(');
lastw = separator;
}
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot(t);
}
writeTerm(ArgOfTermCell(1,t), lp, depth + 1, rinfixarg);
if (keep_terms) {
/* garbage collection may be called */
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
if (bracket_left) {
wrputc(')');
lastw = separator;
@ -551,6 +604,7 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
&rp) ) {
Term tleft = ArgOfTerm(1, t);
Term tright = ArgOfTerm(2, t);
long sl = 0;
int bracket_left =
!IsVarTerm(tleft) && IsAtomTerm(tleft) &&
LeftOpToProtect(AtomOfTerm(tleft), lp);
@ -569,7 +623,16 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
wrputc('(');
lastw = separator;
}
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot(t);
}
writeTerm(ArgOfTermCell(1, t), lp, depth + 1, rinfixarg);
if (keep_terms) {
/* garbage collection may be called */
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
if (bracket_left) {
wrputc(')');
lastw = separator;
@ -619,9 +682,20 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
putUnquotedString(ti);
}
} else {
long sl = 0;
wrputs("'$VAR'(");
lastw = separator;
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot(t);
}
writeTerm(ArgOfTermCell(1,t), 999, depth + 1, FALSE);
if (keep_terms) {
/* garbage collection may be called */
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
wrputc(')');
lastw = separator;
}
@ -632,10 +706,21 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
wrputc('}');
lastw = separator;
} else if (atom == AtomArray) {
long sl = 0;
wrputc('{');
lastw = separator;
for (op = 1; op <= Arity; ++op) {
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot(t);
}
writeTerm(ArgOfTermCell(op, t), 999, depth + 1, FALSE);
if (keep_terms) {
/* garbage collection may be called */
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
if (op != Arity) {
wrputc(',');
lastw = separator;
@ -648,7 +733,18 @@ writeTerm(Term t, int p, int depth, int rinfixarg)
lastw = separator;
wrputc('(');
for (op = 1; op <= Arity; ++op) {
long sl = 0;
if (keep_terms) {
/* garbage collection may be called */
sl = _YAP_InitSlot(t);
}
writeTerm(ArgOfTermCell(op, t), 999, depth + 1, FALSE);
if (keep_terms) {
/* garbage collection may be called */
t = _YAP_GetFromSlot(sl);
_YAP_RecoverSlots(1);
}
if (op != Arity) {
wrputc(',');
lastw = separator;
@ -671,6 +767,9 @@ plwrite(Term t, int (*mywrite) (int, int), int flags)
Quote_illegal = flags & Quote_illegal_f;
Handle_vars = flags & Handle_vars_f;
Use_portray = flags & Use_portray_f;
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
keep_terms = Use_portray;
Ignore_ops = flags & Ignore_ops_f;
writeTerm(t, 1200, 1, FALSE);
}

10
H/Yapproto.h
View File

@ -10,7 +10,7 @@
* File: Yap.proto *
* mods: *
* comments: Function declarations for YAP *
* version: $Id: Yapproto.h,v 1.23 2002-10-03 17:29:46 stasinos Exp $ *
* version: $Id: Yapproto.h,v 1.24 2002-10-17 00:05:29 vsc Exp $ *
*************************************************************************/
/* prototype file for Yap */
@ -49,6 +49,14 @@ void STD_PROTO(ReleaseAtom,(Atom));
Term STD_PROTO(StringToList,(char *));
Term STD_PROTO(StringToListOfAtoms,(char *));
long STD_PROTO(_YAP_InitSlot,(Term));
Term STD_PROTO(_YAP_GetFromSlot,(long));
void STD_PROTO(_YAP_RecoverSlots,(int));
Term STD_PROTO(_YAP_GetFromSlot,(long));
Term *STD_PROTO(_YAP_AddressFromSlot,(long));
void STD_PROTO(_YAP_PutInSlot,(long, Term));
#if SFUNC
Term STD_PROTO(MkSFTerm,(Functor,int,Term *,Term));
CELL STD_PROTO(*ArgsOfSFTerm,(Term));

5
H/yapio.h
View File

@ -291,6 +291,11 @@ extern int c_input_stream, c_output_stream, c_error_stream;
Term STD_PROTO(OpenStream,(FILE *,char *,Term,int));
#define Quote_illegal_f 1
#define Ignore_ops_f 2
#define Handle_vars_f 4
#define Use_portray_f 8
/* routines in sysbits.c */
char *STD_PROTO(pfgets,(char *,int,YP_File));