more meta-call fixes

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

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

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

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

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

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.

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

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) :-
+%depth_bound_call(A,D) :-
-	'$execute_under_depth_limit'(A,D).
+%	'$execute_under_depth_limit'(A,D).
 

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