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

Bug fixes!

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@964 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-01-29 13:37:10 +00:00
parent c6827310f5
commit cacc407677
16 changed files with 77 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
C/absmi.c
View File

@ -2153,7 +2153,6 @@ Yap_absmi(int inp)
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
goto noheapleft;
}
#ifdef COROUTINING
if (ActiveSignals) {
if (Yap_op_from_opcode(PREG->opc) == _cut_e) {
/* followed by a cut */
@ -2164,7 +2163,6 @@ Yap_absmi(int inp)
}
goto creep;
}
#endif
saveregs();
if (!Yap_gc(0, ENV, CPREG)) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,Yap_ErrorMessage);
@ -5851,8 +5849,8 @@ Yap_absmi(int inp)
CACHE_Y_AS_ENV(YREG);
check_stack(NoStackEither, H);
ENDCACHE_Y_AS_ENV();
#endif
either_notest:
#endif
BEGD(d0);
/* Try to preserve the environment */
d0 = PREG->u.sla.s;

6
C/amasm.c
View File

@ -2699,8 +2699,12 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
code_p = a_empty_call(&clinfo, code_p, pass_no, cip);
break;
case push_or_op:
case pop_or_op:
/* be sure to allocate if we have an ;, even if it is
compiled inline.
*/
code_p = check_alloc(&clinfo, code_p, pass_no, cip);
case pushpop_or_op:
case pop_or_op:
case nop_op:
case name_op:
break;

4
C/compiler.c
View File

@ -451,9 +451,9 @@ c_arg(Int argno, Term t, unsigned int arity, unsigned int level, compiler_struct
/* use a special list to store the blobs */
cglobs->cint.cpc = cglobs->cint.icpc;
if (IsFloatTerm(t)) {
/* if (IsFloatTerm(t)) {
Yap_emit(align_float_op, Zero, Zero, &cglobs->cint);
}
}*/
Yap_emit(label_op, l1, Zero, &cglobs->cint);
if (IsFloatTerm(t)) {
/* let us do floats first */

2
C/dbase.c
View File

@ -1550,7 +1550,7 @@ CreateDBStruct(Term Tm, DBProp p, int InFlag, int *pstat, UInt extra_size)
if (p == NULL) {
ADDR ptr = Yap_AllocCodeSpace((CELL)CodeAbs+extra_size+sizeof(DBTerm));
ppt = (DBTerm *)(ptr+extra_size);
if (ppt == NULL) {
if (ptr == NULL) {
Yap_ReleasePreAllocCodeSpace((ADDR)pp0);
return generate_dberror_msg(OUT_OF_HEAP_ERROR, (UInt)DBLength(CodeAbs), "heap crashed against stacks");
}

32
C/exec.c
View File

@ -22,6 +22,7 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#include "yapio.h"
STATIC_PROTO(Int CallPredicate, (PredEntry *, choiceptr));
STATIC_PROTO(Int EnterCreepMode, (Term, SMALLUNSGN));
STATIC_PROTO(Int CallClause, (PredEntry *, Int));
STATIC_PROTO(Int p_save_cp, (void));
STATIC_PROTO(Int p_execute, (void));
@ -211,20 +212,11 @@ p_save_cp(void)
return(TRUE);
}
static Int
EnterCreepMode(SMALLUNSGN mod) {
PredEntry *PredSpy = RepPredProp(PredPropByFunc(FunctorSpy,1));
ARG1 = MkPairTerm(ModuleName[mod],ARG1);
CreepFlag = CalculateStackGap();
P_before_spy = P;
return (CallPredicate(PredSpy, B));
}
inline static Int
do_execute(Term t, SMALLUNSGN mod)
{
if (ActiveSignals) {
return(EnterCreepMode(mod));
return(EnterCreepMode(t, mod));
} else if (PRED_GOAL_EXPANSION_ON) {
return(CallMetaCall(mod));
}
@ -294,6 +286,26 @@ do_execute(Term t, SMALLUNSGN mod)
}
}
static Int
EnterCreepMode(Term t, SMALLUNSGN mod) {
PredEntry *PredCreep;
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
ARG1 = t;
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at meta-call");
}
if (!ActiveSignals) {
return do_execute(ARG1, mod);
}
}
PredCreep = RepPredProp(PredPropByFunc(FunctorCreep,1));
ARG1 = MkPairTerm(ModuleName[mod],ARG1);
CreepFlag = CalculateStackGap();
P_before_spy = P;
return (CallPredicate(PredCreep, B));
}
static Int
p_execute(void)
{ /* '$execute'(Goal) */

18
C/heapgc.c
View File

@ -1471,11 +1471,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _count_retry:
{
Atom at;
unsigned long int arity;
UInt arity;
SMALLUNSGN mod;
if (Yap_PredForCode(gc_B->cp_ap, &at, (UInt *)(&arity), &mod)) {
if (Yap_PredForCode(gc_B->cp_ap, &at, &arity, &mod)) {
if (arity)
fprintf(Yap_stderr,"[GC] %s/%ld marked %ld (%s)\n", RepAtom(at)->StrOfAE, arity, total_marked, op_names[opnum]);
fprintf(Yap_stderr,"[GC] %s/%ld marked %ld (%s)\n", RepAtom(at)->StrOfAE, (long int)arity, total_marked, op_names[opnum]);
else
fprintf(Yap_stderr,"[GC] %s marked %ld (%s)\n", RepAtom(at)->StrOfAE, total_marked, op_names[opnum]);
} else
@ -1534,7 +1534,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
gc_B->cp_tr = (tr_fr_ptr)(orig-diff);
#endif /* FROZEN_STACKS */
}
restart_cp:
if (opnum == _or_else || opnum == _or_last) {
/* ; choice point */
mark_environments((CELL_PTR) (gc_B->cp_a1),
@ -1563,6 +1562,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
/* extended choice point */
restart_cp:
switch (opnum) {
case _Nstop:
mark_slots(gc_B->cp_env);
@ -1593,6 +1593,11 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
}
nargs = rtp->u.lds.s+rtp->u.lds.extra;
break;
case _jump:
rtp = rtp->u.l.l;
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
case _trust_logical_pred:
case _retry_profiled:
case _count_retry:
@ -1732,11 +1737,6 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _trust_killed:
nargs = rtp->u.ld.s;
break;
case _jump:
rtp = rtp->u.l.l;
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
goto restart_cp;
default:
fprintf(Yap_stderr, "OOps in GC: Unexpected opcode: %d\n", opnum);
nargs = 0;

7
C/index.c
View File

@ -4106,9 +4106,6 @@ ExpandIndex(PredEntry *ap) {
int cb;
struct intermediates cint;
cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
cint.CurrentPred = ap;
Yap_Error_Size = 0;
if ((cb = setjmp(cint.CompilerBotch)) == 3) {
restore_machine_regs();
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
@ -4126,10 +4123,12 @@ ExpandIndex(PredEntry *ap) {
}
return NULL;
}
Yap_Error_Size = 0;
}
restart_index:
cint.CodeStart = cint.cpc = cint.BlobsStart = cint.icpc = NIL;
cint.CurrentPred = ap;
Yap_ErrorMessage = NULL;
Yap_Error_Size = 0;
#ifdef DEBUG
if (Yap_Option['i' - 'a' + 1]) {
Term tmod = ModuleName[ap->ModuleOfPred];

6
C/init.c
View File

@ -709,7 +709,7 @@ InitCodes(void)
AtomNot,
AtomQuery,
AtomSemic,
AtomSpy,
AtomCreep,
AtomStream,
AtomStreamPos,
AtomVar;
@ -909,7 +909,7 @@ InitCodes(void)
AtomStream = Yap_LookupAtom ("$stream");
AtomStreamPos = Yap_LookupAtom ("$stream_position");
heap_regs->atom_true = Yap_LookupAtom("true");
AtomSpy = Yap_LookupAtom("$spy");
AtomCreep = Yap_LookupAtom("$creep");
heap_regs->atom_user = Yap_LookupAtom ("user");
heap_regs->atom_usr_err = Yap_LookupAtom ("user_error");
heap_regs->atom_usr_in = Yap_LookupAtom ("user_input");
@ -959,7 +959,7 @@ InitCodes(void)
heap_regs->functor_or = Yap_MkFunctor(AtomSemic, 2);
heap_regs->functor_portray = Yap_MkFunctor(AtomPortray, 1);
heap_regs->functor_query = Yap_MkFunctor(AtomQuery, 1);
heap_regs->functor_spy = Yap_MkFunctor(AtomSpy, 1);
heap_regs->functor_creep = Yap_MkFunctor(AtomCreep, 1);
heap_regs->functor_stream = Yap_MkFunctor (AtomStream, 1);
heap_regs->functor_stream_pos = Yap_MkFunctor (AtomStreamPos, 3);
heap_regs->functor_stream_eOS = Yap_MkFunctor (Yap_LookupAtom("end_of_stream"), 1);

19
C/iopreds.c
View File

@ -3654,7 +3654,12 @@ format_putc(int sno, int ch) {
format_base = newbuf;
format_max = newbuf+new_max_size;
format_buf_size = new_max_size;
}
if (ActiveSignals & YAP_CDOVF_SIGNAL) {
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(FATAL_ERROR, TermNil, "YAP failed to grow heap at format");
}
}
}
}
return ((int) ch);
}
@ -3883,7 +3888,7 @@ format(Term tail, Term args, int sno)
Yap_Error(TYPE_ERROR_ATOM,arghd,"~a in format/2");
return(FALSE);
}
Yap_plwrite (arghd, format_putc, Handle_vars_f);
Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f);
break;
case 'c':
if (IsVarTerm (args)) {
@ -3982,7 +3987,7 @@ format(Term tail, Term args, int sno)
return(FALSE);
}
if (!arg_size) {
Yap_plwrite (arghd, format_putc, Handle_vars_f);
Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f);
} else {
Int siz;
/*
@ -4260,7 +4265,7 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
Yap_plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f );
Yap_plwrite (arghd, format_putc, Quote_illegal_f|Ignore_ops_f|To_heap_f );
break;
case 'p':
if (size_args) {
@ -4283,7 +4288,7 @@ format(Term tail, Term args, int sno)
*--ASP = MkIntTerm(0);
{
long sl = Yap_InitSlot(args);
Yap_plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f);
Yap_plwrite(arghd, format_putc, Handle_vars_f|Use_portray_f|To_heap_f);
args = Yap_GetFromSlot(sl);
Yap_RecoverSlots(1);
}
@ -4313,7 +4318,7 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
Yap_plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f);
Yap_plwrite (arghd, format_putc, Handle_vars_f|Quote_illegal_f|To_heap_f);
break;
case 'w':
if (size_args) {
@ -4333,7 +4338,7 @@ format(Term tail, Term args, int sno)
}
arghd = HeadOfTerm (args);
args = TailOfTerm (args);
Yap_plwrite (arghd, format_putc, Handle_vars_f);
Yap_plwrite (arghd, format_putc, Handle_vars_f|To_heap_f);
break;
case '~':
if (size_args) {

3
C/tracer.c
View File

@ -155,9 +155,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
#endif
#if defined(THREADS) || defined(YAPOR)
fprintf(Yap_stderr,"(%d)", worker_id);
#endif
#if defined(__GNUC__)
fprintf(Yap_stderr,"%llu ", vsc_count);
#endif
/* check_trail_consistency(); */
if (pred == NULL) {

2
C/write.c
View File

@ -779,7 +779,7 @@ Yap_plwrite(Term t, int (*mywrite) (int, int), int flags)
wglb.MaxList = max_list;
/* notice: we must have ASP well set when using portray, otherwise
we cannot make recursive Prolog calls */
wglb.keep_terms = wglb.Use_portray;
wglb.keep_terms = (flags & (Use_portray_f|To_heap_f));
wglb.Ignore_ops = flags & Ignore_ops_f;
writeTerm(t, 1200, 1, FALSE, &wglb);
}

6
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.50 2004-01-23 02:22:06 vsc Exp $ *
* version: $Id: Heap.h,v 1.51 2004-01-29 13:37:09 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -280,6 +280,7 @@ typedef struct various_codes {
functor_call,
functor_clist,
functor_comma,
functor_creep,
functor_csult,
functor_cut_by,
functor_eq,
@ -303,7 +304,6 @@ typedef struct various_codes {
functor_or,
functor_portray,
functor_query,
functor_spy,
functor_stream,
functor_stream_pos,
functor_stream_eOS,
@ -529,6 +529,7 @@ struct various_codes *heap_regs;
#define FunctorCall heap_regs->functor_call
#define FunctorClist heap_regs->functor_clist
#define FunctorComma heap_regs->functor_comma
#define FunctorCreep heap_regs->functor_creep
#define FunctorCsult heap_regs->functor_csult
#define FunctorCutBy heap_regs->functor_cut_by
#define FunctorEq heap_regs->functor_eq
@ -552,7 +553,6 @@ struct various_codes *heap_regs;
#define FunctorOr heap_regs->functor_or
#define FunctorPortray heap_regs->functor_portray
#define FunctorQuery heap_regs->functor_query
#define FunctorSpy heap_regs->functor_spy
#define FunctorStream heap_regs->functor_stream
#define FunctorStreamPos heap_regs->functor_stream_pos
#define FunctorStreamEOS heap_regs->functor_stream_eOS

2
H/rheap.h
View File

@ -248,6 +248,7 @@ restore_codes(void)
heap_regs->functor_call = FuncAdjust(heap_regs->functor_call);
heap_regs->functor_cut_by = FuncAdjust(heap_regs->functor_cut_by);
heap_regs->functor_comma = FuncAdjust(heap_regs->functor_comma);
heap_regs->functor_creep = FuncAdjust(heap_regs->functor_creep);
heap_regs->functor_csult = FuncAdjust(heap_regs->functor_csult);
heap_regs->functor_eq = FuncAdjust(heap_regs->functor_eq);
heap_regs->functor_execute_in_mod = FuncAdjust(heap_regs->functor_execute_in_mod);
@ -270,7 +271,6 @@ restore_codes(void)
heap_regs->functor_or = FuncAdjust(heap_regs->functor_or);
heap_regs->functor_portray = FuncAdjust(heap_regs->functor_portray);
heap_regs->functor_query = FuncAdjust(heap_regs->functor_query);
heap_regs->functor_spy = FuncAdjust(heap_regs->functor_spy);
heap_regs->functor_stream = FuncAdjust(heap_regs->functor_stream);
heap_regs->functor_stream_pos = FuncAdjust(heap_regs->functor_stream_pos);
heap_regs->functor_stream_eOS = FuncAdjust(heap_regs->functor_stream_eOS);

1
H/yapio.h
View File

@ -289,6 +289,7 @@ extern int
#define Ignore_ops_f 2
#define Handle_vars_f 4
#define Use_portray_f 8
#define To_heap_f 16
/* write.c */
void STD_PROTO(Yap_plwrite,(Term,int (*)(int, int),int));

19
pl/debug.yap
View File

@ -256,7 +256,7 @@ debugging :-
% 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'(!, _, _, _) :- !, '$cut_by'(CP).
'$do_spy'(!, _, CP, _) :- !, '$cut_by'(CP).
'$do_spy'('$cut_by'(M), _, _, _) :- !, '$cut_by'(M).
'$do_spy'(true, _, _, _) :- !.
'$do_spy'(M:G, _, CP, InControl) :- !,
@ -302,7 +302,7 @@ debugging :-
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, InControl),
Module, Event,
'$loop_spy_event'(Event, GoalNumber, G, Module, InControl)).
% handle weird things happening in the debugger.
'$loop_spy_event'('$retry_spy'(G0), GoalNumber, G, Module, InControl) :-
G0 >= GoalNumber, !,
@ -317,7 +317,7 @@ debugging :-
'$loop_spy_event'(abort, _, _, _, _) :- !,
throw(abort).
'$loop_spy_event'(Event, GoalNumber, G, Module, _) :- !,
'$trace'(exception,G,Module,GoalNumber),
'$trace'(exception(Event),G,Module,GoalNumber),
fail.
@ -387,11 +387,12 @@ debugging :-
'$flags'(G,M,F,F),
F /\ 0x8402000 =\= 0, !, % dynamic procedure, logical semantics, or source
% use the interpreter
'$clause'(G, M, Cl),
CP is '$last_choice_pt',
'$clause'(G, M, Cl),
'$do_spy'(Cl, M, CP, InControl).
'$spycall'(G, M, InControl) :-
'$continue_debugging'(InControl),
'$spycall'(G, M, _) :-
% I lost control here.
'$continue_debugging'(no),
'$execute0'(G, M).
@ -406,9 +407,9 @@ debugging :-
set_value(debug,0),
( Module\=prolog,
Module\=user ->
'$format'(user_error,"~a~a (~d) ~a: ~a:",[CSPY,SLL,L,P,Module])
'$format'(user_error,"~a~a (~d) ~q: ~a:",[CSPY,SLL,L,P,Module])
;
'$format'(user_error,"~a~a (~d) ~a:",[CSPY,SLL,L,P])
'$format'(user_error,"~a~a (~d) ~q:",[CSPY,SLL,L,P])
),
'$debugger_write'(user_error,G),
set_value(debug,OldDebug),
@ -426,7 +427,7 @@ debugging :-
'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0.
'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0.
% the same as fail.
'$unleashed'(exception) :- get_value('$leash',L), L /\ 2'0001 =:= 0.
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0.
'$debugger_write'(Stream, G) :-
recorded('$print_options','$debugger'(OUT),_), !,

4
pl/modules.yap
View File

@ -79,7 +79,9 @@ use_module(M,I) :-
use_module(Mod,F,I) :-
'$use_module'(Mod,F,I).
'$use_module'(Module,M:File,Imports) :- !,
'$use_module'(Module,V,Imports) :- var(V), !,
'$use_module'(Module,Module,Imports).
'$use_module'(Module,M:File,Imports) :-
atom(M), !,
'$current_module'(M0),
'$change_module'(M),