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
This commit is contained in:
vsc
parent
d04be23513
commit
5e938b92c4
@ -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--;
|
||||
|
||||
32
C/exec.c
32
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);
|
||||
}
|
||||
|
||||
|
||||
@ -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)));
|
||||
|
||||
|
||||
7
C/init.c
7
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 */
|
||||
|
||||
7
C/save.c
7
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)
|
||||
|
||||
11
H/Heap.h
11
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
|
||||
|
||||
72
pl/boot.yap
72
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),
|
||||
|
||||
@ -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,
|
||||
|
||||
Reference in New Issue
Block a user