start support for java interface

bug fixes


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1093 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/exec.c

@@ -127,6 +127,13 @@ do_execute(Term t, Term mod)
   /* first do predicate expansion, even before you process signals.
      This way you don't get to spy goal_expansion(). */
   if (PRED_GOAL_EXPANSION_ON) {
+    LOCK(SignalLock);
+    /* disable creeping when we do goal expansion */
+    if (ActiveSignals & YAP_CREEP_SIGNAL) {
+      ActiveSignals &= ~YAP_CREEP_SIGNAL;
+      DelayedTrace = TRUE;
+    }
+    UNLOCK(SignalLock);
     return CallMetaCall(mod);
   } else if (ActiveSignals) {
     return EnterCreepMode(t, mod);
@@ -244,7 +251,11 @@ p_execute0(void)
   unsigned int    arity;
   Prop            pe;
 
-  if (ActiveSignals) {
+  if (ActiveSignals || DelayedTrace) {
+    if (DelayedTrace) {
+      DelayedTrace = FALSE;
+      ActiveSignals |= YAP_CREEP_SIGNAL;
+    }
     return EnterCreepMode(t, mod);
   }
  restart_exec:
@@ -1517,6 +1528,7 @@ Yap_InitYaamRegs(void)
   WPP = NULL;
   PREG_ADDR = NULL;
 #endif
+  DelayedTrace = FALSE;
 }
 
 

C/iopreds.c

@@ -158,7 +158,6 @@ STATIC_PROTO (Int p_add_alias_to_stream, (void));
 STATIC_PROTO (Int p_change_alias_to_stream, (void));
 STATIC_PROTO (Int p_check_if_valid_new_alias, (void));
 STATIC_PROTO (Int p_fetch_stream_alias, (void));
-STATIC_PROTO (int format_print_str, (Int, Int, int, Term));
 STATIC_PROTO (Int p_format, (void));
 STATIC_PROTO (Int p_startline, (void));
 STATIC_PROTO (Int p_change_type_of_char, (void));
@@ -3593,7 +3592,7 @@ static void fill_pads(int nchars)
 }
 
 static int
-format_print_str (Int sno, Int size, Int has_size, Term args)
+format_print_str (Int sno, Int size, Int has_size, Term args, int (* f_putc)(int, int))
 {
   Term arghd;
   while (!has_size || size > 0) {
@@ -3616,7 +3615,7 @@ format_print_str (Int sno, Int size, Int has_size, Term args)
       Yap_Error(TYPE_ERROR_LIST, arghd, "format/2");
       return FALSE;
     }
-    format_putc(sno, (int) IntOfTerm (arghd));
+    f_putc(sno, (int) IntOfTerm (arghd));
     size--;
   }
   return TRUE;
@@ -4013,7 +4012,7 @@ format(Term tail, Term args, int sno)
 	    if (targ > tnum-1)
 	      goto do_consistency_error;
 	    t = targs[targ++];
-	    if (!format_print_str (sno, repeats, has_repeats, t)) {
+	    if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
 	      goto do_default_error;
 	    }
 	    break;

C/save.c

@@ -1301,7 +1301,9 @@ static void
 RestoreHeap(OPCODE old_ops[])
 {
   int heap_moved = (OldHeapBase != Yap_HeapBase), opcodes_moved;
+  Term mod = CurrentModule;
 
+  CurrentModule = PROLOG_MODULE;
   opcodes_moved = check_opcodes(old_ops);
   /* opcodes_moved has side-effects and should be tried first */
   if (heap_moved || opcodes_moved) {
@@ -1324,6 +1326,7 @@ RestoreHeap(OPCODE old_ops[])
 #ifdef DEBUG_RESTORE1
   fprintf(errout, "phase 1 done\n");
 #endif
+  CurrentModule = mod;
 }
 
 /*

C/threads.c

@@ -163,12 +163,42 @@ p_create_thread(void)
   return FALSE;
 }
 
+static Int
+Yap_new_thread(void)
+{
+  UInt ssize = IntegerOfTerm(Deref(ARG2));
+  UInt tsize = IntegerOfTerm(Deref(ARG3));
+  /*  UInt systemsize = IntegerOfTerm(Deref(ARG4)); */
+  Term tgoal = Deref(ARG1);
+  Term tdetach = Deref(ARG5);
+  int new_worker_id = IntegerOfTerm(Deref(ARG6));
+  
+  if (new_worker_id == -1) {
+    /* YAP ERROR */
+    return FALSE;
+  }
+  ThreadHandle[new_worker_id].id = new_worker_id;
+  store_specs(new_worker_id, ssize, tsize, tgoal, tdetach);
+  pthread_mutex_init(&ThreadHandle[new_worker_id].tlock, NULL);
+  if ((ThreadHandle[new_worker_id].ret = pthread_create(&ThreadHandle[new_worker_id].handle, NULL, thread_run, (void *)(&(ThreadHandle[new_worker_id].id)))) == 0) {
+    return TRUE;
+  }
+  /* YAP ERROR */
+  return FALSE;
+}
+
 static Int
 p_thread_self(void)
 {
   return Yap_unify(MkIntegerTerm(worker_id), ARG1);
 }
 
+int
+Yap_self(void)
+{
+  return worker_id;
+}
+
 static Int
 p_thread_join(void)
 {

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.62 2004-04-22 20:07:05 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.63 2004-07-15 15:47:08 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -50,6 +50,7 @@ typedef struct worker_local_struct {
   struct pred_entry *wpp;
 #endif
   UInt   active_signals;
+  UInt   delayed_trace;
   UInt   i_pred_arity;
   yamop *prof_end;
   Int    start_line;
@@ -636,6 +637,7 @@ struct various_codes *heap_regs;
 #define  SignalLock               heap_regs->wl[worker_id].signal_lock
 #define  WPP                      heap_regs->wl[worker_id].wpp
 #define  ActiveSignals            heap_regs->wl[worker_id].active_signals
+#define  DelayedTrace	          heap_regs->wl[worker_id].delayed_trace
 #define  IPredArity               heap_regs->wl[worker_id].i_pred_arity
 #define  ProfEnd                  heap_regs->wl[worker_id].prof_end
 #define  StartLine                heap_regs->wl[worker_id].start_line
@@ -647,6 +649,7 @@ struct various_codes *heap_regs;
 #endif
 #else
 #define  ActiveSignals            heap_regs->wl.active_signals
+#define  DelayedTrace	          heap_regs->wl.delayed_trace
 #define  IPredArity               heap_regs->wl.i_pred_arity
 #define  ProfEnd                  heap_regs->wl.prof_end
 #define  StartLine                heap_regs->wl.start_line

library/yap2swi/yap2swi.h

@@ -86,6 +86,9 @@ typedef struct _PL_extension
 
 /* end from pl-itf.h */
 
+/* copied from old SICStus/SWI interface */
+typedef int foreign_t;
+typedef void install_t;
 
 extern X_API PL_agc_hook_t PL_agc_hook(PL_agc_hook_t);
 extern X_API char* PL_atom_chars(atom_t);

m4/Yap.h.m4

@@ -10,7 +10,7 @@
 * File:		Yap.h.m4						 *
 * mods:									 *
 * comments:	main header file for YAP				 *
-* version:      $Id: Yap.h.m4,v 1.58 2004-06-29 19:04:45 vsc Exp $	 *
+* version:      $Id: Yap.h.m4,v 1.59 2004-07-15 15:47:08 vsc Exp $	 *
 *************************************************************************/
 
 #include "config.h"
@@ -257,7 +257,7 @@ extern char     Yap_Option[20];
 #elif __APPLE__
 #define MMAP_ADDR 0x20000000
 #else
-#define MMAP_ADDR 0x09000000
+#define MMAP_ADDR 0x08800000
 #endif
 #elif __svr4__ || defined(__SVR4)
 #define MMAP_ADDR 0x02000000

pl/boot.yap

@@ -124,7 +124,7 @@ read_sig.
 	'$system_catch'('$do_yes_no'((G->true),user),user,Error,user:'$Error'(Error)),
 	fail.
 '$enter_top_level' :-
-	( recorded('$trace', on, _) ->
+	( recorded('$trace',on,_) ->
 	    '$format'(user_error, '% trace~n', [])
 	;
 	  recorded('$debug', on, _) ->
@@ -388,7 +388,7 @@ repeat :- '$repeat'.
 	'$yes_no'(G,(?-)).
 '$query'(G,V) :-
 	(
-		'$start_creep',
+	  ( recorded('$trace',on,_) -> '$creep' ; true),
 		'$execute'(G),
 		'$do_stop_creep',
 		'$extract_goal_vars_for_dump'(V,LIV),
@@ -431,16 +431,10 @@ repeat :- '$repeat'.
 	'$stop_creep'.
 
 
-'$start_creep' :-
-	( recorded('$trace', on, _) ->
-	    '$creep'
-	;
-	    true
-	).
-
 '$do_yes_no'([X|L], M) :- !, '$csult'([X|L], M).
-'$do_yes_no'(G, M) :- '$start_creep', '$execute'(M:G).
+'$do_yes_no'(G, M) :-
-
+	  ( recorded('$trace',on,_) -> '$creep' ; true),
+	  '$execute'(M:G).
 '$extract_goal_vars_for_dump'([],[]).
 '$extract_goal_vars_for_dump'([[_|V]|VL],[V|LIV]) :-
 	'$extract_goal_vars_for_dump'(VL,LIV).
@@ -1071,7 +1065,7 @@ catch(G, C, A) :-
 	'$catch'(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
@@ -1125,7 +1119,6 @@ throw(Ball) :-
 	fail.
 '$exec_initialisation_goals'.
 
-
 '$run_toplevel_hooks' :-
 	get_value('$break',0),
 	recorded('$toplevel_hooks',H,_), !,

pl/debug.yap

@@ -142,11 +142,11 @@ trace :-
 trace :- 
 	recorded('$spy_skip',_,R), erase(R), fail.
 trace :-
-	'$print_message'(informational,debug(trace)),
 	( recordaifnot('$trace',on,_) -> true ; true),
 	( recordaifnot('$debug',on,_) -> true ; true),
 	( recordaifnot('$spy_stop',on,_) -> true ; true),
 	'$set_yap_flags'(10,1),
+	'$print_message'(informational,debug(trace)),
 	'$creep'.
 
 notrace :- 
@@ -257,10 +257,12 @@ debugging :-
 % $spy may be called from user code, so be careful.
 '$spy'([Mod|G]) :-
 	CP is '$last_choice_pt',	
-	'$do_spy'(G, Mod, CP, no).
+	'$do_spy'(G, Mod, CP, yes).
 
 % last argument to do_spy says that we are at the end of a context. It
 % is required to know whether we are controlled by the debugger.
+'$do_spy'(_, _, _, _) :-
+	'$stop_debugging', fail.
 '$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP).
 '$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M).
 '$do_spy'(true, _, _, _) :- !.
@@ -309,6 +311,8 @@ debugging :-
 		    '$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
 
 % handle weird things happening in the debugger.		    
+'$loop_spy_event'(_, _, _, _, _) :-
+	'$stop_debugging', fail.
 '$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :-
      G0 >= GoalNumber, !,
      '$loop_spy'(GoalNumber, G, Module, InControl).
@@ -395,10 +399,11 @@ debugging :-
 	% use the interpreter
 	CP is '$last_choice_pt',
 	'$clause'(G, M, Cl),
+	'$stop_debugging',
 	'$do_spy'(Cl, M, CP, InControl).
-'$spycall'(G, M, _) :-
+'$spycall'(G, M, InControl) :-
 	% I lost control here.
-	'$continue_debugging'(no),
+	'$continue_debugging'(InControl),
 	'$execute_nonstop'(G, M).
 
 
@@ -474,7 +479,7 @@ debugging :-
 '$action'(0'e,_,_,_,_) :- !,			% e		exit
 	'$skipeol'(0'e),
 	halt.
-'$action'(0'f,P,CallId,_,_) :- !,		% f		fail
+'$action'(0'f,_,CallId,_,_) :- !,		% f		fail
 	'$scan_number'(0'f, CallId, GoalId),
 	throw('$fail_spy'(GoalId)).
 '$action'(0'h,_,_,_,_) :- !,			% h		help
@@ -503,9 +508,9 @@ debugging :-
 	fail.
 '$action'(0'l,_,CallNumber,_,_) :- !,		% l		leap
 	'$skipeol'(0'l),
-	'$set_yap_flags'(10,1),
 	( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ),
-	( recordaifnot('$spy_stop',on,_) -> true ; true ).
+	( recordaifnot('$spy_stop',on,_) -> true ; true ),
+	'$set_yap_flags'(10,1).
 '$action'(0'n,_,_,_,_) :- !,			% n		nodebug
 	'$skipeol'(0'n),
 	'$set_yap_flags'(10,0),
@@ -513,9 +518,9 @@ debugging :-
 	nodebug.
 '$action'(0'k,_,CallNumber,_,_) :- !,		% k		quasi leap
 	'$skipeol'(0'k),
-	'$set_yap_flags'(10,0),
 	( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ),
-	( recordaifnot('$spy_stop',on,_) -> true ; true ).
+	( recordaifnot('$spy_stop',on,_) -> true ; true ),
+	'$set_yap_flags'(10,0).
 	% skip first call (for current goal),
 	% stop next time.
 '$action'(0'r,P,CallId,_,_) :- !,		% r		retry
@@ -534,8 +539,8 @@ debugging :-
 	'$skipeol'(0't),
 	( (P=call; P=redo) ->
 		( recorded('$spy_skip',_,R), erase(R), fail ; recorda('$spy_skip',CallNumber,_) ),
-	        '$set_yap_flags'(10,0),
+		( recorded('$spy_stop',_,R), erase(R), fail ; true),
-		( recorded('$spy_stop',_,R), erase(R), fail ; true)
+	        '$set_yap_flags'(10,0)
 	    ;
 	        '$ilgl'(0't)
 	).
@@ -553,6 +558,9 @@ debugging :-
 	fail.
 
 % if we are in the interpreter, don't need to care about forcing a trace, do we?
+'$continue_debugging'(_) :-
+	recorded('$trace',on, _),
+	fail.
 '$continue_debugging'(no) :- !.
 '$continue_debugging'(_) :-
 	'$access_yap_flags'(10,1), !,
@@ -579,7 +587,8 @@ debugging :-
 	
 '$ilgl'(C) :-
 	'$print_message'(warning, trace_command(C)),
-	'$print_message'(help, trace_help).
+	'$print_message'(help, trace_help),
+	fail.
 
 '$skipeol'(10) :- !.
 '$skipeol'(_) :- get0(user,C), '$skipeol'(C).

pl/signals.yap

@@ -69,7 +69,7 @@
 '$start_creep'([Mod|G]) :-
 	'$stop_debugging',
 	CP is '$last_choice_pt',	
-	'$do_spy'(G, Mod, CP, no).
+	'$do_spy'(G, Mod, CP, yes).
 
 '$signal_do'(Sig, Goal) :-
 	recorded('$signal_handler', action(Sig,Goal), _), !.