new version of throw using Bart's idea

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

C/errors.c

@@ -1750,7 +1750,7 @@ Error (yap_error_number type, Term where, char *format,...)
   nt[1] = MkAtomTerm(LookupAtom(p));
   if (serious) {
     choiceptr newb;
-    PredEntry *p = RepPredProp(PredPropByFunc(FunctorThrow,0));
+    PredEntry *p = PredThrow;
       
     CreepFlag = CalculateStackGap();
     ASP--;

C/exec.c

@@ -1253,30 +1253,32 @@ p_clean_ifcp(void) {
 /* This does very nasty stuff!!!!! */
 static Int
 p_jump_env(void) {
-  CELL *env = LCL0-IntegerOfTerm(Deref(ARG1)), *prev = NULL, *cur = ENV;
+  yamop *min = (yamop *)(PredCatch->CodeOfPred);
+  yamop *max = (yamop *)(PredThrow->CodeOfPred);
+  CELL *cur = ENV, *env;
+  yamop *cpe = (yamop *)(cur[E_CP]);
 
-  while (cur != env) {
-    prev = cur;
+  while (cpe < min || cpe > max) {
     cur = (CELL *)cur[E_E];
+    cpe = (yamop *)(cur[E_CP]);
   }
-  if (prev == NULL) {
-    return(FALSE);
-  }
-  CP = (yamop *)(prev[E_CP]);
-  YENV = ENV = env;
-  /* force trail reset */
+  CP = cpe;
+  env = (CELL *)cur[E_E];
+  YENV = ENV = (CELL *)(env[E_E]);
   while (B->cp_b < (choiceptr)env) {
     B = B->cp_b;
   }
-  B->cp_cp = CP;
-  B->cp_ap = CP;
-  B->cp_env = env;
+  B->cp_cp = (yamop *)(env[E_CP]);
+  B->cp_ap = (yamop *)(PredHandleThrow->LastClause);
+  B->cp_env = ENV;
   B->cp_h = H;
-  /* I could do this, but it is easier to leave the unwinding to the emulator */
-  env[CP->u.yx.y] = ARG2;
+  /* I could backtrack here, but it is easier to leave the unwinding
+     to the emulator */
+  B->cp_a3 = Deref(ARG1);
   return(FALSE);
 }
 
+
 void 
 InitExecFs(void)
 {
@@ -1306,6 +1308,6 @@ InitExecFs(void)
   InitCPred("$restore_regs", 1, p_restore_regs, SafePredFlag);
   InitCPred("$restore_regs", 2, p_restore_regs2, SafePredFlag);
   InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag);
-  InitCPred("$jump_env_and_store_ball", 2, p_jump_env, SafePredFlag);
+  InitCPred("$jump_env_and_store_ball", 1, p_jump_env, SafePredFlag);
 }
 

C/heapgc.c

@@ -2758,7 +2758,7 @@ Int total_gc_time(void)
 static Int
 p_inform_gc(void)
 {
-  Term tn = MkIntegerTerm(tot_gc_time/1000);
+  Term tn = MkIntegerTerm(tot_gc_time);
   Term tt = MkIntegerTerm(gc_calls);
   Term ts = MkIntegerTerm((tot_gc_recovered*sizeof(CELL)));
  

C/init.c

@@ -763,6 +763,8 @@ InitCodes(void)
     AtomStream,
     AtomStreamPos,
     AtomVar;
+  Functor
+    FunctorThrow;
 
 #ifdef YAPOR
   heap_regs->seq_def = TRUE;
@@ -989,7 +991,7 @@ InitCodes(void)
   heap_regs->functor_stream_eOS = MkFunctor (LookupAtom("end_of_stream"), 1);
   heap_regs->functor_change_module = MkFunctor (LookupAtom("$change_module"), 1);
   heap_regs->functor_current_module = MkFunctor (LookupAtom("$current_module"), 1);
-  heap_regs->functor_throw = MkFunctor( LookupAtom("throw"), 1);
+  FunctorThrow = MkFunctor( LookupAtom("throw"), 1);
   heap_regs->functor_u_minus = MkFunctor (heap_regs->atom_minus, 1);
   heap_regs->functor_u_plus = MkFunctor (heap_regs->atom_plus, 1);
   heap_regs->functor_v_bar = MkFunctor(LookupAtom("|"), 2);
@@ -1009,6 +1011,9 @@ InitCodes(void)
   CurrentModule = 0;
   heap_regs->dead_clauses = NULL;
   heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(heap_regs->atom_meta_call,4),0));
+  heap_regs->pred_catch = RepPredProp(PredPropByFunc(MkFunctor(LookupAtom("catch"),3),0));
+  heap_regs->pred_throw = RepPredProp(PredPropByFunc(FunctorThrow,0));
+  heap_regs->pred_handle_throw = RepPredProp(PredPropByFunc(MkFunctor(LookupAtom("$handle_throw"),3),0));
   ReleaseAtom(AtomOfTerm(heap_regs->term_refound_var));
   {
     /* make sure we know about the module predicate */

C/save.c

@@ -1104,7 +1104,6 @@ restore_codes(void)
   heap_regs->functor_stream_eOS = FuncAdjust(heap_regs->functor_stream_eOS);
   heap_regs->functor_change_module = FuncAdjust(heap_regs->functor_change_module);
   heap_regs->functor_current_module = FuncAdjust(heap_regs->functor_current_module);
-  heap_regs->functor_throw = FuncAdjust(heap_regs->functor_throw);
   heap_regs->functor_u_minus = FuncAdjust(heap_regs->functor_u_minus);
   heap_regs->functor_u_plus = FuncAdjust(heap_regs->functor_u_plus);
   heap_regs->functor_v_bar = FuncAdjust(heap_regs->functor_v_bar);
@@ -1122,6 +1121,12 @@ restore_codes(void)
     (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_goal_expansion);
   heap_regs->pred_meta_call =
     (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_meta_call);
+  heap_regs->pred_catch =
+    (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_catch);
+  heap_regs->pred_throw =
+    (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_throw);
+  heap_regs->pred_handle_throw =
+    (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_handle_throw);
   if (heap_regs->undef_code != NULL)
     heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->undef_code));
   if (heap_regs->creep_code != NULL)