Lots of fixes (check logfile for details

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1585 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2006-04-05 00:16:55 +00:00
parent 0f8650bfa3
commit 30318bb60d
10 changed files with 131 additions and 34 deletions

View File

@ -11,8 +11,12 @@
* File: compiler.c *
* comments: Clause compiler *
* *
* Last rev: $Date: 2006-03-24 17:13:41 $,$Author: rslopes $ *
* Last rev: $Date: 2006-04-05 00:16:54 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.71 2006/03/24 17:13:41 rslopes
* New update to BEAM engine.
* BEAM now uses YAP Indexing (JITI)
*
* Revision 1.70 2005/12/17 03:25:39 vsc
* major changes to support online event-based profiling
* improve error discovery and restart on scanner.
@ -706,6 +710,10 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
static void
c_eq(Term t1, Term t2, compiler_struct *cglobs)
{
if (t1 == t2) {
Yap_emit(nop_op, Zero, Zero, &cglobs->cint);
return;
}
if (IsNonVarTerm(t1)) {
if (IsVarTerm(t2)) {
Term t = t1;
@ -733,6 +741,7 @@ c_eq(Term t1, Term t2, compiler_struct *cglobs)
/* they might */
c_eq(HeadOfTerm(t1), HeadOfTerm(t2), cglobs);
c_eq(TailOfTerm(t1), TailOfTerm(t2), cglobs);
return;
} else if (IsRefTerm(t1)) {
/* just check if they unify */
if (t1 != t2) {
@ -742,6 +751,7 @@ c_eq(Term t1, Term t2, compiler_struct *cglobs)
}
/* they do */
Yap_emit(nop_op, Zero, Zero, &cglobs->cint);
return;
} else {
/* compound terms */
Functor f = FunctorOfTerm(t1);
@ -3195,13 +3205,15 @@ Yap_cclause(volatile Term inp_clause, int NOfArgs, int mod, volatile Term src)
#endif
#ifdef BEAM
void codigo_eam(compiler_struct *);
if (EAM) codigo_eam(&cglobs);
{
void codigo_eam(compiler_struct *);
if (EAM) codigo_eam(&cglobs);
}
#endif
/* phase 3: assemble code */
acode = Yap_assemble(ASSEMBLING_CLAUSE, src, cglobs.cint.CurrentPred, (cglobs.is_a_fact && !cglobs.hasdbrefs), &cglobs.cint);
/* check first if there was space for us */
if (acode == NULL) {
return NULL;

View File

@ -11,8 +11,12 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2006-03-24 17:13:41 $,$Author: rslopes $ *
* Last rev: $Date: 2006-04-05 00:16:54 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.160 2006/03/24 17:13:41 rslopes
* New update to BEAM engine.
* BEAM now uses YAP Indexing (JITI)
*
* Revision 1.159 2006/03/22 20:07:28 vsc
* take better care of zombies
*
@ -4908,10 +4912,18 @@ index_jmp(ClausePointer cur, ClausePointer parent, yamop *ipc, int is_lu, yamop
cur.lui = ncur;
return cur;
} else {
StaticIndex *scur = cur.si;
StaticIndex *scur = parent.si, *ncur;
/* check myself */
if (ipc >= scur->ClCode && ipc <= (yamop *)((CODEADDR)scur+scur->ClSize))
if (!scur)
return cur;
if (ipc >= scur->ClCode &&
ipc <= (yamop *)((CODEADDR)scur+scur->ClSize))
return cur;
ncur = ClauseCodeToStaticIndex(ipc);
if (ncur->ClPred == scur->ClPred) {
cur.si = ncur;
return cur;
}
/*
if (parent.si != cur.si) {
if (parent.si) {
@ -4920,14 +4932,6 @@ index_jmp(ClausePointer cur, ClausePointer parent, yamop *ipc, int is_lu, yamop
return parent;
}
}
ncur = ClauseCodeToStaticIndex(ipc);
if (ncur->ClPred != scur->ClPred) {
#ifdef DEBUG
fprintf(stderr,"OOPS, bad parent in lu index\n");
#endif
cur.si = NULL;
return cur;
}
cur.si = ncur;
return cur;
*/

View File

@ -3392,8 +3392,12 @@ p_show_stream_position (void)
sargs[0] = MkIntTerm (Stream[sno].charcount);
else if (Stream[sno].status & Null_Stream_f)
sargs[0] = MkIntTerm (Stream[sno].charcount);
else
sargs[0] = MkIntTerm (YP_ftell (Stream[sno].u.file.file));
else {
if (Stream[sno].stream_getc == PlUnGetc)
sargs[0] = MkIntTerm (YP_ftell (Stream[sno].u.file.file) - 1);
else
sargs[0] = MkIntTerm (YP_ftell (Stream[sno].u.file.file));
}
sargs[1] = MkIntTerm (Stream[sno].linecount);
sargs[2] = MkIntTerm (Stream[sno].linepos);
tout = Yap_MkApplTerm (FunctorStreamPos, 3, sargs);
@ -3439,7 +3443,7 @@ p_set_stream_position (void)
}
Stream[sno].charcount = char_pos;
Stream[sno].linecount = IntOfTerm (tp);
if (IsVarTerm (tp = ArgOfTerm (2, tin))) {
if (IsVarTerm (tp = ArgOfTerm (3, tin))) {
Yap_Error(INSTANTIATION_ERROR, tp, "set_stream_position/2");
return (FALSE);
} else if (!IsIntTerm (tp)) {
@ -3452,6 +3456,7 @@ p_set_stream_position (void)
"fseek failed for set_stream_position/2");
return(FALSE);
}
Stream[sno].stream_getc = PlGetc;
} else if (FunctorOfTerm (tin) == FunctorStreamEOS) {
if (IsVarTerm (tp = ArgOfTerm (1, tin))) {
Yap_Error(INSTANTIATION_ERROR, tp, "set_stream_position/2");
@ -3469,6 +3474,7 @@ p_set_stream_position (void)
"fseek failed for set_stream_position/2");
return(FALSE);
}
Stream[sno].stream_getc = PlGetc;
/* reset the counters */
Stream[sno].linepos = 0;
Stream[sno].linecount = 0;

View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.tries.C
version: $Id: tab.tries.c,v 1.17 2005-11-04 01:17:17 vsc Exp $
version: $Id: tab.tries.c,v 1.18 2006-04-05 00:16:54 vsc Exp $
**********************************************************************/
@ -694,8 +694,6 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
LOCK(TabEnt_lock(tab_ent));
#endif /* TABLE_LOCK_LEVEL */
for (i = 1; i <= arity; i++) {
extern long long vsc_count;
STACK_PUSH_UP(XREGS[i], stack_terms);
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base);
do {

View File

@ -15,7 +15,14 @@
<h1>Changes in YAP-5.1</h1>
<h2>Yap-5.1.0:</h2>
<ul>
<ul> FIXED: compiling inline lists would compile the lists and more
(obs Nicos Angelopoulos). </li>
<ul> FIXED: message queue ops should not fail silently (obs Paulo
Moura). </li>
<ul> FIXED: stream bugs in iopreds.c (Takeyuki SHIRAMOTO). </li>
<li> FIXED: extra backtrack in informational_messages (obs Nicos
Angelopoulos).</li>
<li> NEW: abolish_module/1 at the request of Nicos Angelopoulos.</li>
<li> FIXED: variable shunting needs HB initialised before any marking
takes place!!!</li>
<li> FIXED: handle possible overflow in term_variables</li>

View File

@ -5746,7 +5746,7 @@ or stored parameters. Current parameters are:
Number of times a procedure was called.
@item retries
Number of times a call to the procedure was backtracked to and retried.
Number of times a call to the procedure was backtracked to and retried.
@end table
@item profile_reset
@ -10012,6 +10012,51 @@ You can use the directive @code{table} to force calls for the argument
predicate to be tabled. Tabling information is stored in a trie, as for
XSB-Prolog.
The following predicates may be useful to control tabled execution:
@table @code
@item is_tabled(+@var{PredIndicator})
@findex is_tabled/1
@snindex is_tabled/1
@cnindex is_tabled/1
Succeeds if the predicate @var{PredIndicator}, of the form
@var{Name/Arity}, is a tabled predicate.
@item tabling_mode(+@var{PredIndicator},+@var{Options})
@findex is_tabled/1
@snindex is_tabled/1
@cnindex is_tabled/1
Sets tabling mode options for the list or predicate given by
@var{PredIndicator}. The list of @var{Options} includes:
@table @code
@item @code{batched}: use batched scheduling for this predicate (default).
@item @code{local}: use local scheduling for this predicate.
@item @code{exec_answers}: use complete tries as code (default).
@item @code{load_answers}: use complete tries as a consumer, somewhat less
efficient but creates less choice-points.
@end table
@item abolish_table(+@var{PredIndicator})
@findex abolish_table/1
@snindex abolish_table/1
@cnindex abolish_table/1
Remove tables for @var{PredIndicator}
@item show_table(+@var{PredIndicator})
@findex show_table/1
@snindex show_table/1
@cnindex show_table/1
Print out the contents of the table generated for @var{PredIndicator}.
@item table_statistics(+@var{PredIndicator})
@findex table_statistics/1
@snindex table_statistics/1
@cnindex table_statistics/1
Print out some information on the current tables for
@var{PredIndicator}.
@end table
@node Low Level Tracing, Low Level Profiling, Tabling, Extensions
@chapter Tracing at Low Level

View File

@ -219,6 +219,7 @@ use_module(M,F,Is) :-
;
true
),
'$change_alias_to_stream'('$loop_stream',OldStream),
set_value('$consulting',Old),
set_value('$consulting_file',OldF),
cd(OldD),
@ -229,7 +230,6 @@ use_module(M,F,Is) :-
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
'$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)),
'$exec_initialisation_goals',
'$change_alias_to_stream'('$loop_stream',OldStream),
!.
'$bind_module'(_, load_files).

View File

@ -11,8 +11,11 @@
* File: errors.yap *
* comments: error messages for YAP *
* *
* Last rev: $Date: 2006-02-24 14:26:37 $,$Author: vsc $ *
* Last rev: $Date: 2006-04-05 00:16:55 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.75 2006/02/24 14:26:37 vsc
* fix informational_messages
*
* Revision 1.74 2006/01/26 19:20:00 vsc
* syntax error was giving the offset
*
@ -194,7 +197,7 @@ print_message(Level, Mss) :-
'$print_message'(error,Throw) :-
format(user_error,'% YAP: no handler for error ~w~n', [Throw]).
'$print_message'(informational,_) :-
get_value('$verbose',off).
get_value('$verbose',off), !.
'$print_message'(informational,M) :-
'$do_informational_message'(M).
'$print_message'(warning,M) :-
@ -616,7 +619,7 @@ print_message(Level, Mss) :-
'$output_error_message'(existence_error(library,F), W) :-
format(user_error,'% EXISTENCE ERROR- ~w could not open library ~w~n',
[W,F]).
'$output_error_message'(existence_error(queue,F), W) :-
'$output_error_message'(existence_error(message_queue,F), W) :-
format(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
[W,F]).
'$output_error_message'(existence_error(procedure,P), context(Call,Parent)) :-
@ -682,8 +685,8 @@ print_message(Level, Mss) :-
'$output_error_message'(permission_error(create,mutex,P), Where) :-
format(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
[Where,P]).
'$output_error_message'(permission_error(create,queue,P), Where) :-
format(user_error,'% PERMISSION ERROR- ~w: cannot create queue ~a~n',
'$output_error_message'(permission_error(create,message_queue,P), Where) :-
format(user_error,'% PERMISSION ERROR- ~w: cannot create message queue ~a~n',
[Where,P]).
'$output_error_message'(permission_error(create,operator,P), Where) :-
format(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',

View File

@ -547,3 +547,17 @@ source_module(Mod) :-
'$preprocess_body_before_mod_change'(G,M,_,M:G).
%
% get rid of a module and of all predicates included in the module.
%
abolish_module(Mod) :-
'$current_predicate'(Mod,Na,Ar),
abolish(Mod:Na/Ar),
fail.
abolish_module(Mod) :-
recorded('$module','$module'(_,Mod,_),R), erase(R),
fail.
abolish_module(Mod) :-
recorded('$import','$import'(Mod,_,_,_),R), erase(R),
fail.
abolish_module(_).

View File

@ -283,7 +283,7 @@ message_queue_create(Cond) :-
message_queue_create(Name) :-
atom(Name),
recorded('$thread_alias',[_,Name],_), !,
'$do_error'(permission_error(create,queue,Name),message_queue_create(Name)).
'$do_error'(permission_error(create,message_queue,Name),message_queue_create(Name)).
message_queue_create(Name) :-
atom(Name), !,
'$create_mq'(Name).
@ -315,7 +315,7 @@ message_queue_destroy(Queue) :-
'$clean_mqueue'(CName).
message_queue_destroy(Queue) :-
atom(Queue), !,
'$do_error'(existence_error(queue,Queue),message_queue_destroy(Queue)).
'$do_error'(existence_error(message_queue,Queue),message_queue_destroy(Queue)).
message_queue_destroy(Name) :-
'$do_error'(type_error(atom,Name),message_queue_destroy(Name)).
@ -329,11 +329,13 @@ thread_send_message(Queue, Term) :-
recorded('$thread_alias',[Id|Queue],_), !,
thread_send_message(Id, Term).
thread_send_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond,Key),_),
recorded('$queue',q(Queue,Mutex,Cond,Key),_), !,
mutex_lock(Mutex),
recordz(Key,Term,_),
'$cond_broadcast'(Cond),
mutex_unlock(Mutex).
thread_send_message(Queue, Term) :-
'$do_error'(existence_error(message_queue,Queue),thread_send_message(Queue,Term)).
thread_get_message(Term) :-
'$thread_self'(Id),
@ -343,9 +345,12 @@ thread_get_message(Queue, Term) :-
recorded('$thread_alias',[Id|Queue],_), !,
thread_get_message(Id, Term).
thread_get_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,Cond,Key),_),
recorded('$queue',q(Queue,Mutex,Cond,Key),_), !,
mutex_lock(Mutex),
'$thread_get_message_loop'(Key, Term, Mutex, Cond).
thread_get_message(Queue, Term) :-
'$do_error'(existence_error(message_queue,Queue),thread_get_message(Queue,Term)).
'$thread_get_message_loop'(Key, Term, Mutex, _) :-
recorded(Key,Term,R), !,
@ -360,9 +365,12 @@ thread_peek_message(Term) :-
thread_peek_message(Id, Term).
thread_peek_message(Queue, Term) :-
recorded('$queue',q(Queue,Mutex,_,Key),_),
recorded('$queue',q(Queue,Mutex,_,Key),_), !,
mutex_lock(Mutex),
'$thread_peek_message2'(Key, Term, Mutex).
thread_peek_message(Queue, Term) :-
'$do_error'(existence_error(message_queue,Queue),thread_peek_message(Queue,Term)).
'$thread_peek_message2'(Key, Term, Mutex) :-
recorded(Key,Term,_), !,