start support for java interface
bug fixes git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1093 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
33bd3a9385
commit
08b9f55f9c
14
C/exec.c
14
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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -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;
|
||||
|
||||
3
C/save.c
3
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;
|
||||
}
|
||||
|
||||
/*
|
||||
|
||||
30
C/threads.c
30
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)
|
||||
{
|
||||
|
||||
5
H/Heap.h
5
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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
21
pl/boot.yap
21
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).
|
||||
@ -701,7 +695,7 @@ incore(G) :- '$execute'(G).
|
||||
'$execute0'(A, CurMod)
|
||||
).
|
||||
|
||||
'$expand_call'(A,CurMod) :-
|
||||
'$expand_call'(A,CurMod) :-
|
||||
'$expand_goal'(A, CurMod, CurMod, NG, NMod),
|
||||
'$execute0'(NG, NMod).
|
||||
|
||||
@ -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,_), !,
|
||||
|
||||
35
pl/debug.yap
35
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, _, _, _) :- !.
|
||||
@ -281,7 +283,7 @@ debugging :-
|
||||
'$do_spy'(B, M, CP, InControl)
|
||||
).
|
||||
'$do_spy'((T->A|B), M, CP, InControl) :- !,
|
||||
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes)
|
||||
( '$do_spy'(T, M, CP, yes) -> '$do_spy'(A, M, CP, yes)
|
||||
;
|
||||
'$do_spy'(B, M, CP, InControl)
|
||||
).
|
||||
@ -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).
|
||||
|
||||
@ -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), _), !.
|
||||
|
||||
Reference in New Issue
Block a user