bug

2019-01-27 23:54:02 +00:00 · 2019-01-27 23:54:02 +00:00 · 7f71184785
parent 36fedfa321
commit 7f71184785
7 changed files with 99 additions and 106 deletions
--- a/C/globals.c
+++ b/C/globals.c
@ -335,61 +335,24 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
                            UInt arity, Term *newarena,
                            size_t min_grow USES_REGS) {
  size_t old_size = ArenaSz(arena);
-  CELL *oldH = HR;
+  CELL *Hi;
+  int res = 0;
+
+  t = Deref(t);      Yap_DebugPlWriteln(t);
+
+   CELL *oldH = HR;
  CELL *oldHB = HB;
  CELL *oldASP = ASP;
-  int res = 0;
-  Term tn;
-
- restart:
-  t = Deref(t);
-  if (IsVarTerm(t)) {
    ASP = ArenaLimit(arena);
    HR = HB = ArenaPt(arena);
-#if COROUTINING
-    if (GlobalIsAttachedTerm(t)) {
-      CELL *Hi;
-
-      *HR = t;
-      Hi = HR + 1;
-      HR += 2;
-      if ((res = Yap_copy_complex_term(Hi - 2, Hi - 1, share, NULL, copy_att_vars, Hi,
-                                   Hi PASS_REGS)) < 0)
-        goto error_handler;
+  Term o = MkVarTerm();
+    while (true) {
+      if ((res = Yap_copy_complex_term(&t-1, &t, share, NULL, copy_att_vars, 
+				       VarOfTerm(o),      HB PASS_REGS)) == 0) {
      CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
-      return Hi[0];
+      Yap_DebugPlWriteln(o);
+      return o;
    }
-#endif
-    if (share && VarOfTerm(t) > ArenaPt(arena)) {
-      CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
-      return t;
-    }
-    tn = MkVarTerm();
-    if (HR > ASP - MIN_ARENA_SIZE) {
-      res = -1;
-      goto error_handler;
-    }
-    CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
-    return tn;
-  } else if (IsAtomOrIntTerm(t)) {
-    return t;
-  } else  {
-    CELL *Hi;
-
-   Hi = HR;
-    HR++;
-    oldH = HR;
-    HR = HB = ArenaPt(arena);
-    ASP = ArenaLimit(arena);
-    if ((res = Yap_copy_complex_term(&t - 1, &t, share, NULL, copy_att_vars, Hi,
-                                 HR PASS_REGS)) < 0) {
-      goto error_handler;
-    }
-    CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
-    return Hi[0];
-  }
- error_handler:
-  HR = HB;
  CloseArena(oldH, oldHB, oldASP, newarena, old_size PASS_REGS);
  XREGS[arity + 1] = t;
  XREGS[arity + 2] = arena;
@ -422,7 +385,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
  arena = Deref(XREGS[arity + 2]);
  t = XREGS[arity + 1];
  old_size = ArenaSz(arena);
-  goto restart;
+}
 }

 static Term CreateTermInArena(Term arena, Atom Na, UInt Nar, UInt arity,
@ -513,7 +476,7 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS)
 {
  Prop p0;
  AtomEntry *ae = RepAtom(at);
-  GlobalEntry *new;
+  GlobalEntry *nx;

  WRITE_LOCK(ae->ARWLock);
  p0 = ae->PropsOfAE;
@ -529,19 +492,19 @@ inline static GlobalEntry *GetGlobalEntry(Atom at USES_REGS)
    }
    p0 = pe->NextOfPE;
  }
-  new = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*new));
-  INIT_RWLOCK(new->GRWLock);
-  new->KindOfPE = GlobalProperty;
+  nx = (GlobalEntry *)Yap_AllocAtomSpace(sizeof(*nx));
+  INIT_RWLOCK(nx->GRWLock);
+  nx->KindOfPE = GlobalProperty;
 #if THREADS
-  new->owner_id = worker_id;
+  nx->owner_id = worker_id;
 #endif
-  new->NextGE = LOCAL_GlobalVariables;
-  LOCAL_GlobalVariables = new;
-  new->AtomOfGE = ae;
-  AddPropToAtom(ae, (PropEntry *)new);
-  RESET_VARIABLE(&new->global);
+  nx->NextGE = LOCAL_GlobalVariables;
+  LOCAL_GlobalVariables = nx;
+  nx->AtomOfGE = ae;
+  AddPropToAtom(ae, (PropEntry *)nx);
+  RESET_VARIABLE(&nx->global);
  WRITE_UNLOCK(ae->ARWLock);
-  return new;
+  return nx;
 }

 static UInt garena_overflow_size(CELL *arena USES_REGS) {
--- a/C/qlyr.c
+++ b/C/qlyr.c
@ -863,6 +863,9 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
      } while (cl != NULL);
    }
    if (!nclauses) {
+    pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
+    pp->OpcodeOfPred = FAIL_OPCODE;
+
      return;
    }
    while ((read_tag(stream) == QLY_START_LU_CLAUSE)) {
@ -947,6 +950,10 @@ static void read_clauses(FILE *stream, PredEntry *pp, UInt nclauses,
        Yap_EraseStaticClause(cl, pp, CurrentModule);
        cl = ncl;
      } while (cl != NULL);
+    } else if (flags & MultiFileFlag) {
+    pp->CodeOfPred = pp->cs.p_code.TrueCodeOfPred = FAILCODE;
+    pp->OpcodeOfPred = FAIL_OPCODE;
+
    }
    for (i = 0; i < nclauses; i++) {
      char *base = (void *)read_UInt(stream);
--- a/C/utilpreds.c
+++ b/C/utilpreds.c
@ -258,6 +258,7 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
 	    *headp = *ptf++ = RepAppl(v)[0];
 	    o = MkPairTerm( v, o );
 	  } else {
+	    *headp = RepAppl(ptf);
 	    *ptf++ = head;
 	  }
 	  continue;
@ -326,6 +327,8 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
 	  continue;
 	}
 	/* store the terms to visit */
+	*ptf = AbsAppl(HR);
+	ptf++;
 	to_visit->start_cp = pt0;
 	to_visit->end_cp = pt0_end;
 	to_visit->to = ptf;
@ -335,8 +338,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
 	if (++to_visit >= to_visit_max-32) {
 	  expand_stack(to_visit0, to_visit, to_visit_max, struct cp_frame);
 	}
-	*ptf = AbsAppl(HR);
-	ptf++;
      
 	if (IsExtensionFunctor(f)) {
 	  switch ((CELL)f) {
@ -393,11 +394,10 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
 	      goto overflow;
 	    }
 	    *ptf++ = AbsAppl(HR);
-	    HR[0] = (CELL)f;
-	    for (i = 1; i < sz; i++) {
-	      HR[i] = headp[i];
-
-	    }
+	    memmove(HR, headp, sz*sizeof(CELL));
+ MP_INT *new = (MP_INT *)(HR + 2);	    
+  new->_mp_d = (mp_limb_t *)(new + 1);
+ 
 	    HR += sz;
 	  }
 	  }
@ -462,7 +462,6 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
    } else {
 	/* first time we met this term */
 	RESET_VARIABLE(ptf);
-	DO_TRAIL(ptd0, (CELL)ptf);
 	*ptd0 = (CELL)ptf;
 	ptf++;
 	if ((ADDR)TR > LOCAL_TrailTop - 16)
--- a/C/write.c
+++ b/C/write.c
@ -103,9 +103,9 @@ static bool callPortray(Term t, int sno USES_REGS) {
 }

 #define PROTECT(t, F)  \
-  {  \
+  { /*yhandle_t sl = Yap_InitHandle(t);*/	\
    F;            \
-    t = Yap_GetFromSlot(wglb->sl); \
+    /*t = Yap_GetFromSlot(sl);*/		\
  }
 static void wrputn(Int, struct write_globs *);
 static void wrputf(Float, struct write_globs *);
@ -117,7 +117,7 @@ static wtype AtomIsSymbols(unsigned char *);
 static void putAtom(Atom, int, struct write_globs *);
 static void writeTerm(Term, int, int, int, struct write_globs *,
                      struct rewind_term *);
-static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
+static void writeTerm__(Term t, Term *h, int p, int depth, int rinfixarg,
                      struct write_globs *wglb, struct rewind_term *rwt);

 static void write_list(Term t, int direction, int depth,
@ -273,7 +273,7 @@ static void writebig(Term t, int p, int depth, int rinfixarg,
    return;
  } else if (big_tag == BIG_RATIONAL) {
    Term trat = Yap_RatTermToApplTerm(t);
-    writeTerm__(trat,wglb->sl, p, depth, rinfixarg, wglb, rwt);
+    writeTerm(trat, p, depth, rinfixarg, wglb, rwt);
    return;
 #endif
  } else if (big_tag >= USER_BLOB_START && big_tag < USER_BLOB_END) {
@ -684,6 +684,7 @@ static void putUnquotedString(Term string, struct write_globs *wglb)
 static void write_var(CELL *t, struct write_globs *wglb,
                      struct rewind_term *rwt) {
  CACHE_REGS
+    //    yhandle_t sl = wglb->sl;
  if (lastw == alphanum) {
    wrputc(' ', wglb->stream);
  }
@ -706,9 +707,7 @@ static void write_var(CELL *t, struct write_globs *wglb,
        wrputs("$AT(", wglb->stream);
        write_var(t, wglb, rwt);
        wrputc(',', wglb->stream);
-	CELL tt = (CELL)t;
-        PROTECT(tt, writeTerm(*l, 999, 1, FALSE, wglb, &nrwt));
-	t = (CELL *)tt;
+        writeTerm(*l, 999, 1, FALSE, wglb, &nrwt);
        attv = RepAttVar(t);
        wrputc(',', wglb->stream);
        l++;
@ -727,23 +726,24 @@ static void write_var(CELL *t, struct write_globs *wglb,

 static bool check_for_loops(Term t, struct write_globs *wglb)
 {
-  yhandle_t i, sl = wglb->sl;
  if ((wglb->Write_Loops)) {
    return false;
  }
-  for (i=sl-1; i>wglb->sl0;i--) {	 
-    if (Yap_GetFromHandle(i) == t)  {
+  if ((IsPairTerm(t) &&
+       HeadOfTerm(t) == TermFoundVar) ||
+      (IsApplTerm(t) &&
+       FunctorOfTerm(t) == (Functor)TermFoundVar)) {
+  
      char buf[64];
-      snprintf(buf,63," @{ ^^%ld } " ,sl-i);
+      snprintf(buf,63," @{ ^^%ld } " ,0L);
      wrputs(buf, wglb->stream);
      return true;
    } 
-  }
  return false;
 }


-static void write_list__(Term t, yhandle_t sl, int direction, int depth,
+static void write_list__(Term t, Term *hp, int direction, int depth,
                       struct write_globs *wglb, struct rewind_term *rwt) {
  Term ti;
  struct rewind_term nrwt;
@ -755,7 +755,7 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth,
    int ndirection;
    int do_jump;

-    PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
+    PROTECT(t, writeTerm(*hp, 999, depth + 1, FALSE, wglb, &nrwt));
    ti = TailOfTerm(t);
    if (IsVarTerm(ti))
      break;
@ -808,16 +808,18 @@ static void write_list__(Term t, yhandle_t sl, int direction, int depth,

 static void write_list(Term t, int direction, int depth,
                       struct write_globs *wglb, struct rewind_term *rwt) {
-  if (check_for_loops(t,wglb)) return;
-  yhandle_t sl = wglb->sl = Yap_InitHandle(t);
-    write_list__(t, sl,  direction, depth,
+  write_list__(t, RepPair(t),  direction, depth,
 	       wglb, rwt);
-     Yap_PopHandle(sl);	
-    wglb->sl = sl-1;
+/*    if (check_for_loops(t,wglb)) return; */
+/*     Term h = RepPair(t)[0]; */
+/* RepPair(t)[0] = TermFoundVar; */
+/*     write_list__(t, &h,  direction, depth, */
+/* 	       wglb, rwt); */
+/*     RepPair(t)[0] = h;	 */
 }


-static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
+static void writeTerm__(Term t, CELL *hp, int p, int depth, int rinfixarg,
                      struct write_globs *wglb, struct rewind_term *rwt) 
 /* term to write			 */
 /* context priority			 */
@ -841,7 +843,7 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
      wrputs("'.'(", wglb->stream);
      lastw = separator;

-      PROTECT(t, writeTerm(HeadOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt));
+      PROTECT(t, writeTerm(*hp, 999, depth + 1, FALSE, wglb, &nrwt));
      wrputs(",", wglb->stream);
      writeTerm(TailOfTerm(t), 999, depth + 1, FALSE, wglb, &nrwt);
      wrclose_bracket(wglb, TRUE);
@ -855,14 +857,13 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
      putString(t, wglb);
    } else {
      wrputc('[', wglb->stream);
-      lastw = separator;
-      /* we assume t was already saved in the stack */
-      write_list__(t, wglb->sl, 0, depth, wglb, rwt);
+      lastw = separator; 
+   write_list__(t, hp, 0, depth, wglb, rwt);
      wrputc(']', wglb->stream);
      lastw = separator;
    }
  } else { /* compound term */
-    Functor functor = FunctorOfTerm(t);
+    Functor functor = (Functor)*hp;
    int Arity;
    Atom atom;
    int op, lp, rp;
@ -1129,12 +1130,30 @@ static void writeTerm__(Term t, yhandle_t sl, int p, int depth, int rinfixarg,
 static void writeTerm(Term t, int p, int depth, int rinfixarg,
                      struct write_globs *wglb, struct rewind_term *rwt)
 {
-  if (check_for_loops(t,wglb)) return;
-   yhandle_t sl = wglb->sl = Yap_InitHandle(t);
-    writeTerm__(t, sl,  p, depth, rinfixarg,
+  if (IsPairTerm(t)) {
+    writeTerm__(t,RepPair(t),  p, depth,rinfixarg,
 	       wglb, rwt);
-    Yap_PopHandle(sl);				
-    wglb->sl = sl-1;
+  } else if (IsApplTerm(t)) {
+    writeTerm__(t, RepAppl(t),  p, depth,rinfixarg,
+	       wglb, rwt);
+  } else
+    writeTerm__(t, &t,  p, depth,rinfixarg,
+	       wglb, rwt);
+/*   if (check_for_loops(t,wglb)) return; */
+/*   if (IsPairTerm(t)) { */
+/*     Term h = HeadOfTerm(t); */
+/*   RepPair(t)[0] = TermFoundVar; */
+/*  writeTerm__(t, &h,  p, depth, rinfixarg, */
+/* 	       wglb, rwt); */
+/*  RepPair(t)[0] = h; */
+/*   } else if (IsApplTerm(t)) { */
+/*     Term h = RepAppl(t)[0]; */
+/* RepAppl(t)[0] = TermFoundVar; */
+/*     writeTerm__(t, &h,  p, depth, rinfixarg, */
+/* 	       wglb, rwt); */
+/*     RepAppl(t)[0] = h; */
+/*     }  */
+
 }

 void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
@ -1183,8 +1202,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
    }
  }
  /* protect slots for portray */
-  wglb.sl0  = (wglb.sl = Yap_InitHandle(t))-1;
-  writeTerm__(t,wglb.sl, priority, 1, FALSE, &wglb, &rwt);
+  writeTerm(t, priority, 1, FALSE, &wglb, &rwt);
  if (flags & New_Line_f) {
    if (flags & Fullstop_f) {
      wrputc('.', wglb.stream);
--- a/pl/consult.yap
+++ b/pl/consult.yap
@ -862,6 +862,7 @@ nb_setval('$if_level',0).
 	'__NB_getval__'('$lf_status', TOpts, fail),
 	'$lf_opt'( initialization, TOpts, Ref),
 	nb:nb_queue_close(Ref, Answers, []),
+	writeln(init:Answers),
 	'$process_init_goal'(Answers).
 '$exec_initialization_goals'.

@ -1449,7 +1450,9 @@ environment. Use initialization/2 for more flexible behavior.
 '$initialization_queue'(G) :-
 	b_getval('$lf_status', TOpts),
 	'$lf_opt'( initialization, TOpts, Ref),
+	writeln(G),
 	nb:nb_queue_enqueue(Ref, G),
+	writeln(Ref),
 	fail.
 '$initialization_queue'(_).

--- a/pl/messages.yap
+++ b/pl/messages.yap
@ -108,7 +108,8 @@ In YAP, the info field describes:
 :- use_system_module( user, [message_hook/3]).

 %:- start_low_level_trace.
-:- multifile prolog:message/3.
+:- dynamic  prolog:message//1.
+:- multifile prolog:message//1.
 %:- stop_low_level_trace.
 :- multifile user:message_hook/3.

@ -374,7 +375,8 @@ display_consulting( F, Level, Info, LC) -->
       '$error_descriptor'(Info, Desc),
       query_exception(prologParserFile, Desc, F0),
       query_exception(prologParserLine, Desc, L),
-       F \= F0
+       integer(L)
+,       F \= F0
    }, !,
    [ '~a:~d:0: ~a raised at:'-[F0,L,Level], nl ].
 display_consulting( F, Level, _, LC) -->
--- a/pl/undefined.yap
+++ b/pl/undefined.yap
@ -97,7 +97,7 @@ undefined_query(G0, M0, Cut) :-
 '$undefp'([M0|G0],MG) :-
    % make sure we do not loop on undefined predicates
    '$undef_setup'(M0:G0, Action,Debug,Current, MGI),
-    ('$get_undefined_predicates'(Current, MGI, MG )                                                  , MG) 
+    ('$get_undefined_predicates'( MGI, MG )                                                  , MG) 
    ->
        true
    ;
@ -119,10 +119,11 @@ undefined_query(G0, M0, Cut) :-
 '$handle_error'(fail,_Goal,_Mod) :-
    fail.

-'$undef_setup'(Action,Debug,Current) :-
+'$undef_setup'(G0,Action,Debug,Current,GI) :-
    yap_flag( unknown, Action, fail),
    yap_flag( debug, Debug, false),
-    '$stop_creeping'(Current).
+    '$stop_creeping'(Current),
+    '$g2i'(G0,GI).

 '$g2i'(user:G, Na/Ar ) :-
        !,