From 153b2cb2a396c1e9277047833dc118cb1571adee Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 17 Oct 2002 00:05:29 +0000 Subject: [PATCH] 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 --- C/absmi.c | 11 ++++- C/adtdefs.c | 51 ++++++++++++++++++++++ C/c_interface.c | 25 +++-------- C/errors.c | 2 +- C/exec.c | 7 ++- C/heapgc.c | 3 ++ C/iopreds.c | 27 +++++++++--- C/tracer.c | 7 +-- C/write.c | 113 +++++++++++++++++++++++++++++++++++++++++++++--- H/Yapproto.h | 10 ++++- H/yapio.h | 5 +++ 11 files changed, 219 insertions(+), 42 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index afd6bd509..871a5fdd5 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -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(); diff --git a/C/adtdefs.c b/C/adtdefs.c index fc2d82921..cdfd74a49 100644 --- a/C/adtdefs.c +++ b/C/adtdefs.c @@ -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; +} + + diff --git a/C/c_interface.c b/C/c_interface.c index 6a151d683..6dd4e0e7f 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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); } diff --git a/C/errors.c b/C/errors.c index 90bfeda32..a991c2546 100644 --- a/C/errors.c +++ b/C/errors.c @@ -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,')'); } diff --git a/C/exec.c b/C/exec.c index 9b1b7f8d0..633d8090b 100644 --- a/C/exec.c +++ b/C/exec.c @@ -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); diff --git a/C/heapgc.c b/C/heapgc.c index da3380298..6051be316 100644 --- a/C/heapgc.c +++ b/C/heapgc.c @@ -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) { diff --git a/C/iopreds.c b/C/iopreds.c index a6b995dde..3d2cc7334 100644 --- a/C/iopreds.c +++ b/C/iopreds.c @@ -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) { diff --git a/C/tracer.c b/C/tracer.c index 27895c0df..ddfa44cdd 100644 --- a/C/tracer.c +++ b/C/tracer.c @@ -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 diff --git a/C/write.c b/C/write.c index f21babd08..3e1cdaa32 100644 --- a/C/write.c +++ b/C/write.c @@ -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); } diff --git a/H/Yapproto.h b/H/Yapproto.h index b53bf3f00..6bbf27e03 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -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)); diff --git a/H/yapio.h b/H/yapio.h index efdc32cf1..1691dc9fa 100644 --- a/H/yapio.h +++ b/H/yapio.h @@ -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));