Bug fixes!

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@964 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/absmi.c

@@ -2153,7 +2153,6 @@ Yap_absmi(int inp)
       if (ActiveSignals & YAP_CDOVF_SIGNAL) {
 	goto noheapleft;
       }
-#ifdef COROUTINING
       if (ActiveSignals) {
 	if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
 	  /* followed by a cut */
@@ -2164,7 +2163,6 @@ Yap_absmi(int inp)
 	}
 	goto creep;
       }
-#endif
       saveregs();
       if (!Yap_gc(0, ENV, CPREG)) {
 	Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@@ -5851,8 +5849,8 @@ Yap_absmi(int inp)
       CACHE_Y_AS_ENV(YREG);
       check_stack(NoStackEither, H);
       ENDCACHE_Y_AS_ENV();
-#endif
       either_notest:
+#endif
       BEGD(d0);
       /* Try to preserve the environment */
       d0 = PREG->u.sla.s;

C/amasm.c

@@ -2699,8 +2699,12 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
       code_p = a_empty_call(&clinfo, code_p, pass_no, cip);
       break;
     case push_or_op:
-    case pop_or_op:
+      /* be sure to allocate if we have an ;, even if it is 
+	 compiled inline.
+       */
+      code_p = check_alloc(&clinfo, code_p, pass_no, cip);
     case pushpop_or_op:
+    case pop_or_op:
     case nop_op:
     case name_op:
       break;

C/compiler.c

@@ -451,9 +451,9 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
 
       /* use a special list to store the blobs */
       cglobs->cint.cpc = cglobs->cint.icpc;
-      if (IsFloatTerm(t)) {
+      /*      if (IsFloatTerm(t)) {
 	Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
-      }
+	}*/
       Yap_emit(label_op, l1, Zero, &cglobs->cint);
       if (IsFloatTerm(t)) {
 	/* let us do floats first */

C/dbase.c

@@ -1550,7 +1550,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
     if (p == NULL) {
       ADDR ptr = Yap_AllocCodeSpace((CELL)CodeAbs+extra_size+sizeof(DBTerm));
       ppt = (DBTerm *)(ptr+extra_size);
-      if (ppt == NULL) {
+      if (ptr == NULL) {
 	Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
 	return generate_dberror_msg(OUT_OF_HEAP_ERROR, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
       }

C/exec.c

@@ -22,6 +22,7 @@ static char     SccsId[] = "@(#)cdmgr.c	1.1 05/02/98";
 #include "yapio.h"
 
 STATIC_PROTO(Int  CallPredicate, (PredEntry *, choiceptr));
+STATIC_PROTO(Int  EnterCreepMode, (Term, SMALLUNSGN));
 STATIC_PROTO(Int  CallClause, (PredEntry *, Int));
 STATIC_PROTO(Int  p_save_cp, (void));
 STATIC_PROTO(Int  p_execute, (void));
@@ -211,20 +212,11 @@ p_save_cp(void)
   return(TRUE);
 }
 
-static Int
-EnterCreepMode(SMALLUNSGN mod) {
-  PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,1));
-  ARG1 = MkPairTerm(ModuleName[mod],ARG1);
-  CreepFlag = CalculateStackGap();
-  P_before_spy = P;
-  return (CallPredicate(PredSpy, B));
-}
-
 inline static Int
 do_execute(Term t, SMALLUNSGN mod)
 {
   if (ActiveSignals) {
-    return(EnterCreepMode(mod));
+    return(EnterCreepMode(t, mod));
   } else if (PRED_GOAL_EXPANSION_ON) {
     return(CallMetaCall(mod));
   }
@@ -294,6 +286,26 @@ do_execute(Term t, SMALLUNSGN mod)
   }
 }
 
+static Int
+EnterCreepMode(Term t, SMALLUNSGN mod) {
+  PredEntry *PredCreep;
+
+  if (ActiveSignals & YAP_CDOVF_SIGNAL) {
+    ARG1 = t;
+    if (!Yap_growheap(FALSE, 0, NULL)) {
+      Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at meta-call");
+    }
+    if (!ActiveSignals) {
+      return do_execute(ARG1, mod);
+    }
+  }
+  PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1));
+  ARG1 = MkPairTerm(ModuleName[mod],ARG1);
+  CreepFlag = CalculateStackGap();
+  P_before_spy = P;
+  return (CallPredicate(PredCreep, B));
+}
+
 static Int
 p_execute(void)
 {				/* '$execute'(Goal)	 */

C/heapgc.c

@@ -1471,11 +1471,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
       case _count_retry:
 	{
 	  Atom at;
-	  unsigned long int arity;
+	  UInt arity;
 	  SMALLUNSGN mod;
-	  if (Yap_PredForCode(gc_B->cp_ap, &at, (UInt *)(&arity), &mod)) {
+	  if (Yap_PredForCode(gc_B->cp_ap, &at, &arity, &mod)) {
 	    if (arity) 
-	      fprintf(Yap_stderr,"[GC]       %s/%ld marked %ld (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]);
+	      fprintf(Yap_stderr,"[GC]       %s/%ld marked %ld (%s)\n", RepAtom(at)->StrOfAE, (long int)arity, total_marked, op_names[opnum]);
 	    else
 	      fprintf(Yap_stderr,"[GC]       %s marked %ld (%s)\n", RepAtom(at)->StrOfAE, total_marked, op_names[opnum]);
 	  } else
@@ -1534,7 +1534,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
       gc_B->cp_tr = (tr_fr_ptr)(orig-diff);
 #endif /* FROZEN_STACKS */
     }
-  restart_cp:
     if (opnum == _or_else || opnum == _or_last) {
       /* ; choice point */
       mark_environments((CELL_PTR) (gc_B->cp_a1),
@@ -1563,6 +1562,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
 			  EnvSize((CELL_PTR) (gc_B->cp_cp)),
 			  EnvBMap((CELL_PTR) (gc_B->cp_cp)));
       /* extended choice point */
+    restart_cp:
       switch (opnum) {
       case _Nstop:
 	mark_slots(gc_B->cp_env);
@@ -1593,6 +1593,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
 	}
 	nargs = rtp->u.lds.s+rtp->u.lds.extra;
 	break;
+      case _jump:
+	rtp = rtp->u.l.l;
+	op = rtp->opc;
+	opnum = Yap_op_from_opcode(op);
+	goto restart_cp;
       case _trust_logical_pred:
       case _retry_profiled:
       case _count_retry:
@@ -1732,11 +1737,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
       case _trust_killed:
 	nargs = rtp->u.ld.s;
 	break;
-      case _jump:
-	rtp = rtp->u.l.l;
-	op = rtp->opc;
-	opnum = Yap_op_from_opcode(op);
-	goto restart_cp;
       default:
 	fprintf(Yap_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum);
 	nargs = 0;

C/index.c

@@ -4106,9 +4106,6 @@ ExpandIndex(PredEntry *ap) {
   int cb;
   struct intermediates cint;
 
-  cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
-  cint.CurrentPred = ap;
-  Yap_Error_Size = 0;
   if ((cb = setjmp(cint.CompilerBotch)) == 3) {
     restore_machine_regs();
     Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
@@ -4126,10 +4123,12 @@ ExpandIndex(PredEntry *ap) {
       }
       return NULL;
     }
-    Yap_Error_Size = 0;
   }
  restart_index:
+  cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
+  cint.CurrentPred = ap;
   Yap_ErrorMessage = NULL;
+  Yap_Error_Size = 0;
 #ifdef DEBUG
   if (Yap_Option['i' - 'a' + 1]) {
     Term tmod = ModuleName[ap->ModuleOfPred];

C/init.c

@@ -709,7 +709,7 @@ InitCodes(void)
     AtomNot,
     AtomQuery,
     AtomSemic,
-    AtomSpy,
+    AtomCreep,
     AtomStream,
     AtomStreamPos,
     AtomVar;
@@ -909,7 +909,7 @@ InitCodes(void)
   AtomStream = Yap_LookupAtom ("$stream");
   AtomStreamPos = Yap_LookupAtom ("$stream_position");
   heap_regs->atom_true = Yap_LookupAtom("true");
-  AtomSpy = Yap_LookupAtom("$spy");
+  AtomCreep = Yap_LookupAtom("$creep");
   heap_regs->atom_user = Yap_LookupAtom ("user");
   heap_regs->atom_usr_err = Yap_LookupAtom ("user_error");
   heap_regs->atom_usr_in = Yap_LookupAtom ("user_input");
@@ -959,7 +959,7 @@ InitCodes(void)
   heap_regs->functor_or = Yap_MkFunctor(AtomSemic, 2);
   heap_regs->functor_portray = Yap_MkFunctor(AtomPortray, 1);
   heap_regs->functor_query = Yap_MkFunctor(AtomQuery, 1);
-  heap_regs->functor_spy = Yap_MkFunctor(AtomSpy, 1);
+  heap_regs->functor_creep = Yap_MkFunctor(AtomCreep, 1);
   heap_regs->functor_stream = Yap_MkFunctor (AtomStream, 1);
   heap_regs->functor_stream_pos = Yap_MkFunctor (AtomStreamPos, 3);
   heap_regs->functor_stream_eOS = Yap_MkFunctor (Yap_LookupAtom("end_of_stream"), 1);

C/iopreds.c

@@ -3654,7 +3654,12 @@ format_putc(int sno, int ch) {
       format_base = newbuf;
       format_max = newbuf+new_max_size;
       format_buf_size = new_max_size;
-  }
+      if (ActiveSignals & YAP_CDOVF_SIGNAL) {
+	if (!Yap_growheap(FALSE, 0, NULL)) {
+	  Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at format");
+	}
+      }
+    }
   }
   return ((int) ch);
 }
@@ -3883,7 +3888,7 @@ format(Term tail, Term args, int sno)
 		Yap_Error(TYPE_ERROR_ATOM,arghd,"~a in format/2");
 		return(FALSE);
 	      }
-	      Yap_plwrite (arghd, format_putc, Handle_vars_f);
+	      Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f);
 	      break;
 	    case 'c':
 	      if (IsVarTerm (args)) {
@@ -3982,7 +3987,7 @@ format(Term tail, Term args, int sno)
 		return(FALSE);
 	      }
 	      if (!arg_size) {
-		Yap_plwrite (arghd, format_putc, Handle_vars_f);
+		Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f);
 	      } else {
 		Int siz;
 		/*
@@ -4260,7 +4265,7 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      Yap_plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f );
+	      Yap_plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f );
 	      break;
 	    case 'p':
 	      if (size_args) {
@@ -4283,7 +4288,7 @@ format(Term tail, Term args, int sno)
 	      *--ASP = MkIntTerm(0);
 	      { 
 		long sl = Yap_InitSlot(args);
-		Yap_plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f);
+		Yap_plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f|To_heap_f);
 		args = Yap_GetFromSlot(sl);
 		Yap_RecoverSlots(1);
 	      }
@@ -4313,7 +4318,7 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      Yap_plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f);
+	      Yap_plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f|To_heap_f);
 	      break;
 	    case 'w':
 	      if (size_args) {
@@ -4333,7 +4338,7 @@ format(Term tail, Term args, int sno)
 	      }
 	      arghd = HeadOfTerm (args);
 	      args = TailOfTerm (args);
-	      Yap_plwrite (arghd, format_putc, Handle_vars_f);
+	      Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f);
 	      break;
 	    case '~':
 	      if (size_args) {

C/tracer.c

@@ -155,9 +155,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
 #endif
 #if defined(THREADS) || defined(YAPOR)
   fprintf(Yap_stderr,"(%d)", worker_id);
-#endif
-#if defined(__GNUC__)
-  fprintf(Yap_stderr,"%llu ", vsc_count);
 #endif
   /* check_trail_consistency(); */
   if (pred == NULL) {

C/write.c

@@ -779,7 +779,7 @@ Yap_plwrite(Term t, int (*mywrite) (int, int), int flags)
   wglb.MaxList = max_list;
   /* notice: we must have ASP well set when using portray, otherwise
      we cannot make recursive Prolog calls */
-  wglb.keep_terms = wglb.Use_portray;
+  wglb.keep_terms = (flags & (Use_portray_f|To_heap_f)); 
   wglb.Ignore_ops = flags & Ignore_ops_f;
   writeTerm(t, 1200, 1, FALSE, &wglb);
 }

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.50 2004-01-23 02:22:06 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.51 2004-01-29 13:37:09 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -280,6 +280,7 @@ typedef struct various_codes {
     functor_call,
     functor_clist,
     functor_comma,
+    functor_creep,
     functor_csult,
     functor_cut_by,
     functor_eq,
@@ -303,7 +304,6 @@ typedef struct various_codes {
     functor_or,
     functor_portray,
     functor_query,
-    functor_spy,
     functor_stream,
     functor_stream_pos,
     functor_stream_eOS,
@@ -529,6 +529,7 @@ struct various_codes *heap_regs;
 #define  FunctorCall              heap_regs->functor_call
 #define  FunctorClist             heap_regs->functor_clist
 #define  FunctorComma             heap_regs->functor_comma
+#define  FunctorCreep             heap_regs->functor_creep
 #define  FunctorCsult             heap_regs->functor_csult
 #define  FunctorCutBy             heap_regs->functor_cut_by
 #define  FunctorEq                heap_regs->functor_eq
@@ -552,7 +553,6 @@ struct various_codes *heap_regs;
 #define  FunctorOr                heap_regs->functor_or
 #define  FunctorPortray           heap_regs->functor_portray
 #define  FunctorQuery             heap_regs->functor_query
-#define  FunctorSpy               heap_regs->functor_spy
 #define  FunctorStream            heap_regs->functor_stream
 #define  FunctorStreamPos         heap_regs->functor_stream_pos
 #define  FunctorStreamEOS         heap_regs->functor_stream_eOS

H/rheap.h

@@ -248,6 +248,7 @@ restore_codes(void)
   heap_regs->functor_call = FuncAdjust(heap_regs->functor_call);
   heap_regs->functor_cut_by = FuncAdjust(heap_regs->functor_cut_by);
   heap_regs->functor_comma = FuncAdjust(heap_regs->functor_comma);
+  heap_regs->functor_creep = FuncAdjust(heap_regs->functor_creep);
   heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
   heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq);
   heap_regs->functor_execute_in_mod = FuncAdjust(heap_regs->functor_execute_in_mod);
@@ -270,7 +271,6 @@ restore_codes(void)
   heap_regs->functor_or = FuncAdjust(heap_regs->functor_or);
   heap_regs->functor_portray = FuncAdjust(heap_regs->functor_portray);
   heap_regs->functor_query = FuncAdjust(heap_regs->functor_query);
-  heap_regs->functor_spy = FuncAdjust(heap_regs->functor_spy);
   heap_regs->functor_stream = FuncAdjust(heap_regs->functor_stream);
   heap_regs->functor_stream_pos = FuncAdjust(heap_regs->functor_stream_pos);
   heap_regs->functor_stream_eOS = FuncAdjust(heap_regs->functor_stream_eOS);

H/yapio.h

@@ -289,6 +289,7 @@ extern int
 #define	Ignore_ops_f		2
 #define	Handle_vars_f		4
 #define	Use_portray_f		8
+#define	To_heap_f	       16
 
 /* write.c */
 void	STD_PROTO(Yap_plwrite,(Term,int (*)(int, int),int));

pl/debug.yap

@@ -256,7 +256,7 @@ debugging :-
 
 % last argument to do_spy says that we are at the end of a context. It
 % is required to know whether we are controlled by the debugger.
-'$do_spy'(!, _, _, _) :- !, '$cut_by'(CP).
+'$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP).
 '$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M).
 '$do_spy'(true, _, _, _) :- !.
 '$do_spy'(M:G, _, CP, InControl) :- !,
@@ -302,7 +302,7 @@ debugging :-
     '$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl),
 		    Module, Event,
 		    '$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
-		    
+
 % handle weird things happening in the debugger.		    
 '$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :-
      G0 >= GoalNumber, !,
@@ -317,7 +317,7 @@ debugging :-
 '$loop_spy_event'(abort, _, _, _, _) :- !,
      throw(abort).
 '$loop_spy_event'(Event, GoalNumber, G, Module, _) :- !,
-     '$trace'(exception,G,Module,GoalNumber),
+     '$trace'(exception(Event),G,Module,GoalNumber),
      fail.
 
 
@@ -387,11 +387,12 @@ debugging :-
 	'$flags'(G,M,F,F),
 	F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
 	% use the interpreter
-	'$clause'(G, M, Cl),
 	CP is '$last_choice_pt',
+	'$clause'(G, M, Cl),
 	'$do_spy'(Cl, M, CP, InControl).
-'$spycall'(G, M, InControl) :-
+'$spycall'(G, M, _) :-
-	'$continue_debugging'(InControl),
+	% I lost control here.
+	'$continue_debugging'(no),
 	'$execute0'(G, M).
 
 
@@ -406,9 +407,9 @@ debugging :-
 	        set_value(debug,0),
 		( Module\=prolog,
 		  Module\=user ->
-		    '$format'(user_error,"~a~a (~d) ~a: ~a:",[CSPY,SLL,L,P,Module])
+		    '$format'(user_error,"~a~a (~d) ~q: ~a:",[CSPY,SLL,L,P,Module])
 		    ;
-		    '$format'(user_error,"~a~a (~d) ~a:",[CSPY,SLL,L,P])
+		    '$format'(user_error,"~a~a (~d) ~q:",[CSPY,SLL,L,P])
 		),
 		'$debugger_write'(user_error,G),
 	        set_value(debug,OldDebug),
@@ -426,7 +427,7 @@ debugging :-
 '$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0.
 '$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0.
 % the same as fail.
-'$unleashed'(exception) :- get_value('$leash',L), L /\ 2'0001 =:= 0.
+'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0.
 
 '$debugger_write'(Stream, G) :-
 	recorded('$print_options','$debugger'(OUT),_), !,

pl/modules.yap

@@ -79,7 +79,9 @@ use_module(M,I) :-
 use_module(Mod,F,I) :-
 	'$use_module'(Mod,F,I).
 
-'$use_module'(Module,M:File,Imports) :- !,
+'$use_module'(Module,V,Imports) :- var(V), !,
+	'$use_module'(Module,Module,Imports).
+'$use_module'(Module,M:File,Imports) :-
 	atom(M), !,
         '$current_module'(M0),
         '$change_module'(M),