diff --git a/C/absmi.c b/C/absmi.c index ca8d99bea..79bb2dbb3 100644 --- a/C/absmi.c +++ b/C/absmi.c @@ -11725,9 +11725,6 @@ Yap_absmi(int inp) CACHE_Y_AS_ENV(YREG); /* Try to preserve the environment */ E_YREG = (CELL *) (((char *) YREG) + PREG->u.sla.s); -#ifndef NO_CHECKING - check_stack(NoStackCall, H); -#endif #ifdef FROZEN_STACKS { choiceptr top_b = PROTECT_FROZEN_B(B); @@ -11844,6 +11841,9 @@ Yap_absmi(int inp) (yamop *) NEXTOP(PREG, sla); ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); PREG = pen->CodeOfPred; +#ifndef NO_CHECKING + check_stack(NoStackPExecute, H); +#endif #ifdef DEPTH_LIMIT if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */ if (pen->ModuleOfPred) { @@ -11878,6 +11878,30 @@ Yap_absmi(int inp) ENDP(pt1); ENDD(d0); + NoStackPExecute: + SREG = (CELL *) pen; + ASP = E_YREG; + /* setup GB */ + WRITEBACK_Y_AS_ENV(); + YREG[E_CB] = (CELL) B; +#ifdef COROUTINING + if (CFREG == Unsigned(LCL0)) { + if (Yap_ReadTimedVar(WokenGoals) != TermNil) + goto creep; + else { + CFREG = CalculateStackGap(); + JMPNext(); + } + } +#endif + if (CFREG != CalculateStackGap()) + goto creep; + saveregs(); + if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, YREG, NEXTOP(PREG, sla))) { + Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + } + setregs(); + JMPNext(); ENDCACHE_Y_AS_ENV(); } ENDBOp(); @@ -11889,9 +11913,6 @@ Yap_absmi(int inp) UInt arity; CACHE_Y_AS_ENV(YREG); -#ifndef NO_CHECKING - check_stack(NoStackCall, H); -#endif BEGP(pt0); BEGD(d0); d0 = E_YREG[-EnvSizeInCells-1]; @@ -12058,8 +12079,11 @@ Yap_absmi(int inp) } execute_after_comma: - ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); PREG = pen->CodeOfPred; +#ifndef NO_CHECKING + check_stack(NoStackPTExecute, H); +#endif + ALWAYS_LOOKAHEAD(pen->OpcodeOfPred); E_YREG[E_CB] = (CELL)B; #ifdef DEPTH_LIMIT if (DEPTH <= MkIntTerm(1)) {/* I assume Module==0 is primitives */ @@ -12079,6 +12103,31 @@ Yap_absmi(int inp) ENDD(d0); ENDP(pt0); + NoStackPTExecute: + WRITEBACK_Y_AS_ENV(); + SREG = (CELL *) pen; + ASP = E_YREG; +#ifdef COROUTINING + if (CFREG == Unsigned(LCL0)) { + if (Yap_ReadTimedVar(WokenGoals) != TermNil) + goto creep; + else { + CFREG = CalculateStackGap(); + JMPNext(); + } + } +#endif + if (CFREG != CalculateStackGap()) + goto creep; + ASP = (CELL *) (((char *) YREG) + PREG->u.sla.s); + if (ASP > (CELL *)B) + ASP = (CELL *)B; + saveregs(); + if (!Yap_gc(((PredEntry *)SREG)->ArityOfPE, YREG, NEXTOP(PREG, sla))) { + Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage); + } + setregs(); + JMPNext(); ENDCACHE_Y_AS_ENV(); } diff --git a/C/dbase.c b/C/dbase.c index 44595d689..72b94abbc 100644 --- a/C/dbase.c +++ b/C/dbase.c @@ -650,6 +650,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, { CELL *st = CodeMax; + CheckDBOverflow(); /* first thing, store a link to the list before we move on */ #ifdef IDB_USE_MBIT *StoPoint++ = AbsAppl((CELL *)(((CELL)st-(CELL)tbase)|MBIT)); @@ -669,7 +670,8 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, { CELL *st = CodeMax; - /* first thing, store a link to the list before we move on */ + CheckDBOverflow(); + /* first thing, store a link to the list before we move on */ #ifdef IDB_USE_MBIT *StoPoint++ = AbsAppl((CELL *)(((CELL)st-(CELL)tbase)|MBIT)); #else @@ -692,6 +694,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, { CELL *st = CodeMax; + CheckDBOverflow(); /* first thing, store a link to the list before we move on */ #ifdef IDB_USE_MBIT *StoPoint++ = AbsAppl((CELL *)(((CELL)st-(CELL)tbase)|MBIT)); @@ -911,6 +914,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, to_visit -= 3; pt0 = to_visit[0]; pt0_end = to_visit[1]; + CheckDBOverflow(); StoPoint = to_visit[2]; #endif goto loop; @@ -924,6 +928,7 @@ static CELL *MkDBTerm(register CELL *pt0, register CELL *pt0_end, pt0_end = RepAppl(ConstraintsTerm)+4; ConstraintsTerm = TermNil; StoPoint = CodeMax; + CheckDBOverflow(); CodeMax += 4; goto loop; } diff --git a/C/load_dl.c b/C/load_dl.c index b657e27b7..ca064209b 100644 --- a/C/load_dl.c +++ b/C/load_dl.c @@ -132,6 +132,11 @@ Yap_ShutdownLoadForeign(void) } f_code = f_code->next; } + /* + make sure that we don't try to close foreign code several times, eg, + from within an error handler + */ + ForeignCodeLoaded = NULL; } Int diff --git a/docs/yap.tex b/docs/yap.tex index 7458493e9..204d03a75 100644 --- a/docs/yap.tex +++ b/docs/yap.tex @@ -974,7 +974,7 @@ A slightly more sophisticated example is: @example @cartouche -#!/usr/bin/yap -L +#!/usr/bin/yap -L -- # # Hello World script file using Yap # . diff --git a/pl/boot.yap b/pl/boot.yap index 38c524b61..173c4bd9e 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -1048,33 +1048,6 @@ break :- '$get_value'('$break',BL), NBL is BL+1, atom_concat([Path,File],New), '$exists'(New,'$csult'). -path(Path) :- findall(X,'$in_path'(X),Path). - -'$in_path'(X) :- '$recorded'('$path',S,_), - ( S == "" -> X = '.' ; - name(X,S) ). - -add_to_path(New) :- add_to_path(New,last). - -add_to_path(New,Pos) :- - '$check_path'(New,Str), - atom_codes(Fixed,Str), - '$add_to_path'(Fixed,Pos). - -'$add_to_path'(New,_) :- '$recorded'('$path',New,R), erase(R), fail. -'$add_to_path'(New,last) :- !, '$recordz'('$path',New,_). -'$add_to_path'(New,first) :- '$recorda'('$path',New,_). - -remove_from_path(New) :- '$check_path'(New,Path), - '$recorded'('$path',Path,R), erase(R). - -'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt). -'$check_path'([],[]). -'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !. -'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A). -'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN). - - % term expansion % % return two arguments: Expanded0 is the term after "USER" expansion. diff --git a/pl/consult.yap b/pl/consult.yap index 3d66f09d7..7625a248e 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -247,3 +247,32 @@ prolog_load_context(term_position, Position) :- + +path(Path) :- findall(X,'$in_path'(X),Path). + +'$in_path'(X) :- '$recorded'('$path',Path,_), + atom_codes(Path,S), + ( S = "" -> X = '.' ; + atom_codes(X,S) ). + +add_to_path(New) :- add_to_path(New,last). + +add_to_path(New,Pos) :- + atom(New), !, + '$check_path'(New,Str), + atom_codes(Path,Str), + '$add_to_path'(Path,Pos). + +'$add_to_path'(New,_) :- '$recorded'('$path',New,R), erase(R), fail. +'$add_to_path'(New,last) :- !, '$recordz'('$path',New,_). +'$add_to_path'(New,first) :- '$recorda'('$path',New,_). + +remove_from_path(New) :- '$check_path'(New,Path), + '$recorded'('$path',Path,R), erase(R). + +'$check_path'(At,SAt) :- atom(At), !, atom_codes(At,S), '$check_path'(S,SAt). +'$check_path'([],[]). +'$check_path'([Ch],[Ch]) :- '$dir_separator'(Ch), !. +'$check_path'([Ch],[Ch,A]) :- !, integer(Ch), '$dir_separator'(A). +'$check_path'([N|S],[N|SN]) :- integer(N), '$check_path'(S,SN). + diff --git a/pl/depth_bound.yap b/pl/depth_bound.yap index d1bdf43f2..46bd3b935 100644 --- a/pl/depth_bound.yap +++ b/pl/depth_bound.yap @@ -17,6 +17,6 @@ %depth_bound_call(A,D) :- %write(depth_bound_call(A,D)), nl, fail. -depth_bound_call(A,D) :- - '$execute_under_depth_limit'(A,D). +%depth_bound_call(A,D) :- +% '$execute_under_depth_limit'(A,D). diff --git a/pl/modules.yap b/pl/modules.yap index f04ba4c41..8b1fb91b6 100644 --- a/pl/modules.yap +++ b/pl/modules.yap @@ -419,9 +419,16 @@ module(N) :- '$pred_goal_expansion_on', user:goal_expansion(G,M,GI), !, '$module_expansion'(GI,G1,G2,M,CM,TM,HVars). -'$complete_goal_expansion'(G, M, _, _, G, GF, _) :- +'$complete_goal_expansion'(G, M, CM, TM, G1, G2, HVars) :- '$system_predicate'(G,M), !, - '$c_built_in'(G,M,GF). + '$c_built_in'(G,M,Gi), + (Gi \== G -> + '$module_expansion'(Gi,G1,G2,M,CM,TM,HVars) ; + TM = M -> + G2 = G + ; + G2 = M:G % atts: + ). '$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !. '$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).