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

more meta-call fixes

Browse Source 
fix module expansion for builtins
fix path predicates.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@758 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-02-07 12:05:39 +00:00
parent 75392e54c7
commit 6bb873d03e
8 changed files with 108 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
C/absmi.c
View File

@ -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();
}

7
C/dbase.c
View File

@ -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;
}

5
C/load_dl.c
View File

@ -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

2
docs/yap.tex
View File

@ -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
# .

27
pl/boot.yap
View File

@ -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.

29
pl/consult.yap
View File

@ -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).

4
pl/depth_bound.yap
View File

@ -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).

11
pl/modules.yap
View File

@ -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, _).