diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

new version of throw using Bart's idea

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@327 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-01-24 23:55:34 +00:00
parent d04be23513
commit 5e938b92c4
8 changed files with 61 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/errors.c
View File

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

32
C/exec.c
View File

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

2
C/heapgc.c
View File

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

7
C/init.c
View File

@ -763,6 +763,8 @@ InitCodes(void)
AtomStream, AtomStream,
AtomStreamPos, AtomStreamPos,
AtomVar; AtomVar;
Functor
FunctorThrow;
#ifdef YAPOR #ifdef YAPOR
heap_regs->seq_def = TRUE; 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_stream_eOS = MkFunctor (LookupAtom("end_of_stream"), 1);
heap_regs->functor_change_module = MkFunctor (LookupAtom("$change_module"), 1); heap_regs->functor_change_module = MkFunctor (LookupAtom("$change_module"), 1);
heap_regs->functor_current_module = MkFunctor (LookupAtom("$current_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_minus = MkFunctor (heap_regs->atom_minus, 1);
heap_regs->functor_u_plus = MkFunctor (heap_regs->atom_plus, 1); heap_regs->functor_u_plus = MkFunctor (heap_regs->atom_plus, 1);
heap_regs->functor_v_bar = MkFunctor(LookupAtom("|"), 2); heap_regs->functor_v_bar = MkFunctor(LookupAtom("|"), 2);
@ -1009,6 +1011,9 @@ InitCodes(void)
CurrentModule = 0; CurrentModule = 0;
heap_regs->dead_clauses = NULL; heap_regs->dead_clauses = NULL;
heap_regs->pred_meta_call = RepPredProp(PredPropByFunc(MkFunctor(heap_regs->atom_meta_call,4),0)); 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)); ReleaseAtom(AtomOfTerm(heap_regs->term_refound_var));
{ {
/* make sure we know about the module predicate */ /* make sure we know about the module predicate */

7
C/save.c
View File

@ -1104,7 +1104,6 @@ restore_codes(void)
heap_regs->functor_stream_eOS = FuncAdjust(heap_regs->functor_stream_eOS); 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_change_module = FuncAdjust(heap_regs->functor_change_module);
heap_regs->functor_current_module = FuncAdjust(heap_regs->functor_current_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_minus = FuncAdjust(heap_regs->functor_u_minus);
heap_regs->functor_u_plus = FuncAdjust(heap_regs->functor_u_plus); heap_regs->functor_u_plus = FuncAdjust(heap_regs->functor_u_plus);
heap_regs->functor_v_bar = FuncAdjust(heap_regs->functor_v_bar); 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); (PredEntry *)AddrAdjust((ADDR)heap_regs->pred_goal_expansion);
heap_regs->pred_meta_call = heap_regs->pred_meta_call =
(PredEntry *)AddrAdjust((ADDR)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) if (heap_regs->undef_code != NULL)
heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->undef_code)); heap_regs->undef_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(heap_regs->undef_code));
if (heap_regs->creep_code != NULL) if (heap_regs->creep_code != NULL)

11
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * 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 */ /* information that can be stored in Code Space */
@ -256,7 +256,6 @@ typedef struct various_codes {
functor_stream_eOS, functor_stream_eOS,
functor_change_module, functor_change_module,
functor_current_module, functor_current_module,
functor_throw,
functor_u_minus, functor_u_minus,
functor_u_plus, functor_u_plus,
functor_v_bar, functor_v_bar,
@ -270,6 +269,9 @@ typedef struct various_codes {
void *last_wtime; void *last_wtime;
PredEntry *pred_goal_expansion; PredEntry *pred_goal_expansion;
PredEntry *pred_meta_call; PredEntry *pred_meta_call;
PredEntry *pred_catch;
PredEntry *pred_throw;
PredEntry *pred_handle_throw;
UInt n_of_file_aliases; UInt n_of_file_aliases;
UInt sz_of_file_aliases; UInt sz_of_file_aliases;
struct AliasDescS * file_aliases; struct AliasDescS * file_aliases;
@ -298,6 +300,7 @@ typedef struct various_codes {
#define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode )) #define ANSWER_RESOLUTION ((yamop *)&(heap_regs->tableanswerresolutioncode ))
#endif /* TABLING */ #endif /* TABLING */
#define FAILCODE ((CODEADDR)&(heap_regs->failcode )) #define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define FAILCODE ((CODEADDR)&(heap_regs->failcode ))
#define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode )) #define TRUSTFAILCODE ((CODEADDR)&(heap_regs->trustfailcode ))
#define YESCODE ((CODEADDR)&(heap_regs->yescode )) #define YESCODE ((CODEADDR)&(heap_regs->yescode ))
#define NOCODE ((CODEADDR)&(heap_regs->nocode )) #define NOCODE ((CODEADDR)&(heap_regs->nocode ))
@ -447,7 +450,6 @@ typedef struct various_codes {
#define FunctorChangeModule heap_regs->functor_change_module #define FunctorChangeModule heap_regs->functor_change_module
#define FunctorCurrentModule heap_regs->functor_current_module #define FunctorCurrentModule heap_regs->functor_current_module
#define FunctorModSwitch heap_regs->functor_mod_switch #define FunctorModSwitch heap_regs->functor_mod_switch
#define FunctorThrow heap_regs->functor_throw
#define FunctorUMinus heap_regs->functor_u_minus #define FunctorUMinus heap_regs->functor_u_minus
#define FunctorUPlus heap_regs->functor_u_plus #define FunctorUPlus heap_regs->functor_u_plus
#define FunctorVBar heap_regs->functor_v_bar #define FunctorVBar heap_regs->functor_v_bar
@ -457,6 +459,9 @@ typedef struct various_codes {
#define TermReFoundVar heap_regs->term_refound_var #define TermReFoundVar heap_regs->term_refound_var
#define PredGoalExpansion heap_regs->pred_goal_expansion #define PredGoalExpansion heap_regs->pred_goal_expansion
#define PredMetaCall heap_regs->pred_meta_call #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 NOfFileAliases heap_regs->n_of_file_aliases
#define SzOfFileAliases heap_regs->sz_of_file_aliases #define SzOfFileAliases heap_regs->sz_of_file_aliases
#define FileAliases heap_regs->file_aliases #define FileAliases heap_regs->file_aliases

72
pl/boot.yap
View File

@ -44,7 +44,6 @@ read_sig.
'$init_system' :- '$init_system' :-
% do catch as early as possible % do catch as early as possible
'$init_catch',
( (
'$access_yap_flags'(15, 0) -> '$access_yap_flags'(15, 0) ->
'$version' '$version'
@ -1161,21 +1160,10 @@ expand_term(Term,Expanded) :-
% what is ball; % what is ball;
% where was the previous catch % where was the previous catch
catch(G, C, A) :- catch(G, C, A) :-
'$mark_tr'(Ball), '$mark_tr'(C,A,_),
array_element('$catch', 0, OldEnv), '$execute'(G).
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)
).
% %
% system_catch is like catch, but it avoids the overhead of a full % system_catch is like catch, but it avoids the overhead of a full
% meta-call by calling '$execute0' instead of $execute. % meta-call by calling '$execute0' instead of $execute.
% This way it % This way it
@ -1183,30 +1171,26 @@ catch(G, C, A) :-
% %
'$system_catch'(G, M, C, A) :- '$system_catch'(G, M, C, A) :-
% check current trail % check current trail
'$mark_tr'(Ball), '$mark_tr'(C,A,_),
% update current catch handler '$execute0'(G, M).
array_element('$catch', 0, OldEnv),
Env is '$env', %
update_array('$catch', 0, Env), % throw has to be *exactly* after system catch!
'$execute0'(G, M), %
% this says where Ball is, for the benefit of jump_env throw(Ball) :-
'$force_to_1st'(Ball), % get this off the unwound computation.
( copy_term(Ball,NewBall),
var(Ball) -> % get current jump point
% no throw, just get rid of this. '$jump_env_and_store_ball'(NewBall).
update_array('$catch', 0, OldEnv)
;
% process the throw, if we can.
!, '$handle_throw'(C, A, Ball)
).
% just create a choice-point % just create a choice-point
'$mark_tr'(_). '$mark_tr'(_,_,_).
'$mark_tr'(_) :- fail. '$mark_tr'(_,_,_) :- fail.
'$force_to_1st'(_). '$handle_throw'(_, _, _).
'$handle_throw'(C, A, Ball) :-
'$handle_throw'(C, A, '$ball'(Ball)) :-
% reset info % reset info
(C = Ball -> (C = Ball ->
'$execute'(A) '$execute'(A)
@ -1214,22 +1198,6 @@ catch(G, C, A) :-
throw(Ball) 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' :- '$exec_initialisation_goals' :-
'$recorded'('$blocking_code',_,R), '$recorded'('$blocking_code',_,R),
erase(R), erase(R),

3
pl/utils.yap
View File

@ -406,8 +406,9 @@ statistics :-
OvfTime is TotHOTime+TotSOTime+TotTOTime, OvfTime is TotHOTime+TotSOTime+TotTOTime,
'$format'(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n", '$format'(user_error,"~n~t~3f~12+ sec. for ~w code, ~w stack, and ~w trail space overflows~n",
[OvfTime,NOfHO,NOfSO,NOfTO]), [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", '$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, RTime is float(Runtime)/1000,
'$format'(user_error,"~t~3f~12+ sec. runtime~n", [RTime]), '$format'(user_error,"~t~3f~12+ sec. runtime~n", [RTime]),
CPUTime is float(CPUtime)/1000, CPUTime is float(CPUtime)/1000,