From 5e938b92c41f260c6243d898ef7572f85f63c143 Mon Sep 17 00:00:00 2001 From: vsc Date: Thu, 24 Jan 2002 23:55:34 +0000 Subject: [PATCH] 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 | 2 +- C/exec.c | 32 ++++++++++++----------- C/heapgc.c | 2 +- C/init.c | 7 ++++- C/save.c | 7 ++++- H/Heap.h | 11 +++++--- pl/boot.yap | 72 +++++++++++++++------------------------------------- pl/utils.yap | 3 ++- 8 files changed, 61 insertions(+), 75 deletions(-) diff --git a/C/errors.c b/C/errors.c index ec33b442a..8051fd2fb 100644 --- a/C/errors.c +++ b/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--; diff --git a/C/exec.c b/C/exec.c index 2ad29b7d7..51fedc2c2 100644 --- a/C/exec.c +++ b/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); } diff --git a/C/heapgc.c b/C/heapgc.c index 229c07874..0c89d7eb4 100644 --- a/C/heapgc.c +++ b/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))); diff --git a/C/init.c b/C/init.c index 0278aad45..26da086e2 100644 --- a/C/init.c +++ b/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 */ diff --git a/C/save.c b/C/save.c index 575bc153b..35e4d7d2e 100644 --- a/C/save.c +++ b/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) diff --git a/H/Heap.h b/H/Heap.h index b267eda55..3d5da27f2 100644 --- a/H/Heap.h +++ b/H/Heap.h @@ -10,7 +10,7 @@ * File: Heap.h * * mods: * * comments: Heap Init Structure * -* version: $Id: Heap.h,v 1.20 2002-01-14 22:25:17 vsc Exp $ * +* version: $Id: Heap.h,v 1.21 2002-01-24 23:55:34 vsc Exp $ * *************************************************************************/ /* information that can be stored in Code Space */ @@ -256,7 +256,6 @@ typedef struct various_codes { functor_stream_eOS, functor_change_module, functor_current_module, - functor_throw, functor_u_minus, functor_u_plus, functor_v_bar, @@ -270,6 +269,9 @@ typedef struct various_codes { void *last_wtime; PredEntry *pred_goal_expansion; PredEntry *pred_meta_call; + PredEntry *pred_catch; + PredEntry *pred_throw; + PredEntry *pred_handle_throw; UInt n_of_file_aliases; UInt sz_of_file_aliases; struct AliasDescS * file_aliases; @@ -298,6 +300,7 @@ typedef struct various_codes { #define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode )) #endif /* TABLING */ #define FAILCODE ((CODEADDR)&(heap_regs->failcode )) +#define FAILCODE ((CODEADDR)&(heap_regs->failcode )) #define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode )) #define YESCODE ((CODEADDR)&(heap_regs->yescode )) #define NOCODE ((CODEADDR)&(heap_regs->nocode )) @@ -447,7 +450,6 @@ typedef struct various_codes { #define FunctorChangeModule heap_regs->functor_change_module #define FunctorCurrentModule heap_regs->functor_current_module #define FunctorModSwitch heap_regs->functor_mod_switch -#define FunctorThrow heap_regs->functor_throw #define FunctorUMinus heap_regs->functor_u_minus #define FunctorUPlus heap_regs->functor_u_plus #define FunctorVBar heap_regs->functor_v_bar @@ -457,6 +459,9 @@ typedef struct various_codes { #define TermReFoundVar heap_regs->term_refound_var #define PredGoalExpansion heap_regs->pred_goal_expansion #define PredMetaCall heap_regs->pred_meta_call +#define PredCatch heap_regs->pred_catch +#define PredThrow heap_regs->pred_throw +#define PredHandleThrow heap_regs->pred_handle_throw #define NOfFileAliases heap_regs->n_of_file_aliases #define SzOfFileAliases heap_regs->sz_of_file_aliases #define FileAliases heap_regs->file_aliases diff --git a/pl/boot.yap b/pl/boot.yap index 14012683c..28189200b 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -44,7 +44,6 @@ read_sig. '$init_system' :- % do catch as early as possible - '$init_catch', ( '$access_yap_flags'(15, 0) -> '$version' @@ -1161,21 +1160,10 @@ expand_term(Term,Expanded) :- % what is ball; % where was the previous catch catch(G, C, A) :- - '$mark_tr'(Ball), - array_element('$catch', 0, OldEnv), - Env is '$env', - update_array('$catch', 0, Env), - '$execute'(G), - '$force_to_1st'(Ball), - ( var(Ball) -> - % no throw, just get rid of this. - update_array('$catch', 0, OldEnv) - ; - % jmp_env will reset both fields for me! - !, '$handle_throw'(C, A, Ball) - ). + '$mark_tr'(C,A,_), + '$execute'(G). -% + % % system_catch is like catch, but it avoids the overhead of a full % meta-call by calling '$execute0' instead of $execute. % This way it @@ -1183,30 +1171,26 @@ catch(G, C, A) :- % '$system_catch'(G, M, C, A) :- % check current trail - '$mark_tr'(Ball), - % update current catch handler - array_element('$catch', 0, OldEnv), - Env is '$env', - update_array('$catch', 0, Env), - '$execute0'(G, M), - % this says where Ball is, for the benefit of jump_env - '$force_to_1st'(Ball), - ( - var(Ball) -> - % no throw, just get rid of this. - update_array('$catch', 0, OldEnv) - ; - % process the throw, if we can. - !, '$handle_throw'(C, A, Ball) - ). + '$mark_tr'(C,A,_), + '$execute0'(G, M). +% +% throw has to be *exactly* after system catch! +% +throw(Ball) :- + % get this off the unwound computation. + copy_term(Ball,NewBall), + % get current jump point + '$jump_env_and_store_ball'(NewBall). + + + % just create a choice-point -'$mark_tr'(_). -'$mark_tr'(_) :- fail. +'$mark_tr'(_,_,_). +'$mark_tr'(_,_,_) :- fail. -'$force_to_1st'(_). - -'$handle_throw'(C, A, '$ball'(Ball)) :- +'$handle_throw'(_, _, _). +'$handle_throw'(C, A, Ball) :- % reset info (C = Ball -> '$execute'(A) @@ -1214,22 +1198,6 @@ catch(G, C, A) :- throw(Ball) ). -throw(Ball) :- - % get this off the unwound computation. - copy_term(Ball,NewBall), - % get current jump point - array_element('$catch', 0, Env), - '$do_throw'(NewBall, Env). - -'$do_throw'(NewBall,Env) :- - % jump - '$jump_env_and_store_ball'(Env, '$ball'(NewBall)). -% restore bindings. -'$do_throw'(_,_). - -'$init_catch' :- - '$create_array'('$catch', 1). - '$exec_initialisation_goals' :- '$recorded'('$blocking_code',_,R), erase(R), diff --git a/pl/utils.yap b/pl/utils.yap index bdc238218..47b918f1b 100644 --- a/pl/utils.yap +++ b/pl/utils.yap @@ -406,8 +406,9 @@ statistics :- OvfTime is TotHOTime+TotSOTime+TotTOTime, '$format'(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n", [OvfTime,NOfHO,NOfSO,NOfTO]), + TotGCTimeF is float(TotGCTime)/1000, '$format'(user_error,"~t~3f~12+ sec. for ~w garbage collections which collected ~d bytes~n", - [TotGCTime,NOfGC,TotGCSize]), + [TotGCTimeF,NOfGC,TotGCSize]), RTime is float(Runtime)/1000, '$format'(user_error,"~t~3f~12+ sec. runtime~n", [RTime]), CPUTime is float(CPUtime)/1000,