library_directory may not be deterministic (usually it isn't).
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1240 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
52a46e5c5d
commit
49c8efc0df
16
C/absmi.c
16
C/absmi.c
|
|
@ -10,8 +10,14 @@
|
|||
* *
|
||||
* File: absmi.c *
|
||||
* comments: Portable abstract machine interpreter *
|
||||
* Last rev: $Date: 2005-01-13 05:47:25 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-02-08 18:04:17 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.156 2005/01/13 05:47:25 vsc
|
||||
* lgamma broke arithmetic optimisation
|
||||
* integer_y has type y
|
||||
* pass original source to checker (and maybe even use option in parser)
|
||||
* use warning mechanism for checker messages.
|
||||
*
|
||||
* Revision 1.155 2004/12/28 22:20:34 vsc
|
||||
* some extra bug fixes for trail overflows: some cannot be recovered that easily,
|
||||
* some can.
|
||||
|
|
@ -6907,12 +6913,13 @@ Yap_absmi(int inp)
|
|||
}
|
||||
/* for slots to work */
|
||||
Yap_StartSlots();
|
||||
Yap_PrologMode = UserCCallMode;
|
||||
#endif /* FROZEN_STACKS */
|
||||
{
|
||||
PredEntry *p = PREG->u.sla.sla_u.p;
|
||||
#ifdef LOW_LEVEL_TRACER
|
||||
if (Yap_do_low_level_trace)
|
||||
low_level_trace(enter_pred,p,XREGS+1);
|
||||
if (Yap_do_low_level_trace)
|
||||
low_level_trace(enter_pred,p,XREGS+1);
|
||||
#endif /* LOW_LEVEL_TRACE */
|
||||
PREG = NEXTOP(PREG, sla);
|
||||
saveregs();
|
||||
|
|
@ -6924,6 +6931,7 @@ Yap_absmi(int inp)
|
|||
|
||||
restore_machine_regs();
|
||||
setregs();
|
||||
Yap_PrologMode = UserMode;
|
||||
if (!SREG) {
|
||||
FAIL();
|
||||
}
|
||||
|
|
@ -7042,6 +7050,7 @@ Yap_absmi(int inp)
|
|||
ENDCACHE_Y();
|
||||
|
||||
TRYUSERCC:
|
||||
Yap_PrologMode = UserCCallMode;
|
||||
ASP = YENV;
|
||||
saveregs();
|
||||
save_machine_regs();
|
||||
|
|
@ -7049,6 +7058,7 @@ Yap_absmi(int inp)
|
|||
EX = 0L;
|
||||
restore_machine_regs();
|
||||
setregs();
|
||||
Yap_PrologMode = UserMode;
|
||||
if (!SREG) {
|
||||
FAIL();
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,8 +10,11 @@
|
|||
* File: c_interface.c *
|
||||
* comments: c_interface primitives definition *
|
||||
* *
|
||||
* Last rev: $Date: 2004-12-08 00:56:35 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-02-08 18:04:47 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.59 2004/12/08 00:56:35 vsc
|
||||
* missing ;
|
||||
*
|
||||
* Revision 1.58 2004/11/19 22:08:41 vsc
|
||||
* replace SYSTEM_ERROR by out OUT_OF_WHATEVER_ERROR whenever appropriate.
|
||||
*
|
||||
|
|
@ -838,7 +841,9 @@ YAP_RunGoal(Term t)
|
|||
yamop *old_CP = CP;
|
||||
BACKUP_MACHINE_REGS();
|
||||
|
||||
Yap_PrologMode = UserMode;
|
||||
out = Yap_RunTopGoal(t);
|
||||
Yap_PrologMode = UserCCallMode;
|
||||
if (out) {
|
||||
P = (yamop *)ENV[E_CP];
|
||||
ENV = (CELL *)ENV[E_E];
|
||||
|
|
@ -860,7 +865,9 @@ YAP_RestartGoal(void)
|
|||
|
||||
P = (yamop *)FAILCODE;
|
||||
do_putcf = myputc;
|
||||
Yap_PrologMode = UserMode;
|
||||
out = Yap_exec_absmi(TRUE);
|
||||
Yap_PrologMode = UserCCallMode;
|
||||
if (out == FALSE) {
|
||||
/* cleanup */
|
||||
Yap_trust_last();
|
||||
|
|
@ -876,7 +883,9 @@ YAP_ContinueGoal(void)
|
|||
int out;
|
||||
BACKUP_MACHINE_REGS();
|
||||
|
||||
Yap_PrologMode = UserMode;
|
||||
out = Yap_exec_absmi(TRUE);
|
||||
Yap_PrologMode = UserCCallMode;
|
||||
|
||||
RECOVER_MACHINE_REGS();
|
||||
return(out);
|
||||
|
|
|
|||
131
C/cdmgr.c
131
C/cdmgr.c
|
|
@ -11,8 +11,12 @@
|
|||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2005-02-08 04:05:23 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2005-02-08 18:04:57 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.151 2005/02/08 04:05:23 vsc
|
||||
* fix mess with add clause
|
||||
* improves on sigsegv handling
|
||||
*
|
||||
* Revision 1.150 2005/01/28 23:14:34 vsc
|
||||
* move to Yap-4.5.7
|
||||
* Fix clause size
|
||||
|
|
@ -3217,9 +3221,66 @@ code_in_pred_s_index(StaticIndex *icl, yamop *codeptr) {
|
|||
}
|
||||
|
||||
static Int
|
||||
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
|
||||
find_code_in_clause(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
|
||||
Int i = 1;
|
||||
yamop *clcode;
|
||||
int i = 1;
|
||||
|
||||
clcode = pp->cs.p_code.FirstClause;
|
||||
if (clcode != NULL) {
|
||||
if (pp->PredFlags & LogUpdatePredFlag) {
|
||||
LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode);
|
||||
do {
|
||||
if (IN_BLOCK(codeptr,(CODEADDR)cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
return i;
|
||||
}
|
||||
i++;
|
||||
cl = cl->ClNext;
|
||||
} while (cl != NULL);
|
||||
} else if (pp->PredFlags & DynamicPredFlag) {
|
||||
do {
|
||||
DynamicClause *cl;
|
||||
|
||||
cl = ClauseCodeToDynamicClause(clcode);
|
||||
if (IN_BLOCK(codeptr,cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
return i;
|
||||
}
|
||||
if (clcode == pp->cs.p_code.LastClause)
|
||||
break;
|
||||
i++;
|
||||
clcode = NextDynamicClause(clcode);
|
||||
} while (TRUE);
|
||||
} else if (pp->PredFlags & MegaClausePredFlag) {
|
||||
MegaClause *cl;
|
||||
|
||||
cl = ClauseCodeToMegaClause(clcode);
|
||||
if (IN_BLOCK(codeptr,cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
return 1+((char *)codeptr-(char *)cl->ClCode)/cl->ClItemSize;
|
||||
}
|
||||
} else {
|
||||
StaticClause *cl;
|
||||
|
||||
cl = ClauseCodeToStaticClause(clcode);
|
||||
do {
|
||||
if (IN_BLOCK(codeptr,cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
return i;
|
||||
}
|
||||
if (cl->ClCode == pp->cs.p_code.LastClause)
|
||||
break;
|
||||
i++;
|
||||
cl = cl->ClNext;
|
||||
} while (TRUE);
|
||||
}
|
||||
}
|
||||
return(0);
|
||||
}
|
||||
|
||||
static Int
|
||||
code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
|
||||
Int out;
|
||||
|
||||
READ_LOCK(pp->PRWLock);
|
||||
/* check if the codeptr comes from the indexing code */
|
||||
|
|
@ -3238,62 +3299,9 @@ code_in_pred(PredEntry *pp, Atom *pat, UInt *parity, yamop *codeptr) {
|
|||
}
|
||||
}
|
||||
}
|
||||
clcode = pp->cs.p_code.FirstClause;
|
||||
if (clcode != NULL) {
|
||||
if (pp->PredFlags & LogUpdatePredFlag) {
|
||||
LogUpdClause *cl = ClauseCodeToLogUpdClause(clcode);
|
||||
do {
|
||||
if (IN_BLOCK(codeptr,(CODEADDR)cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
READ_UNLOCK(pp->PRWLock);
|
||||
return i;
|
||||
}
|
||||
i++;
|
||||
cl = cl->ClNext;
|
||||
} while (cl != NULL);
|
||||
} else if (pp->PredFlags & DynamicPredFlag) {
|
||||
do {
|
||||
DynamicClause *cl;
|
||||
|
||||
cl = ClauseCodeToDynamicClause(clcode);
|
||||
if (IN_BLOCK(codeptr,cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
READ_UNLOCK(pp->PRWLock);
|
||||
return i;
|
||||
}
|
||||
if (clcode == pp->cs.p_code.LastClause)
|
||||
break;
|
||||
i++;
|
||||
clcode = NextDynamicClause(clcode);
|
||||
} while (TRUE);
|
||||
} else if (pp->PredFlags & MegaClausePredFlag) {
|
||||
MegaClause *cl;
|
||||
|
||||
cl = ClauseCodeToMegaClause(clcode);
|
||||
if (IN_BLOCK(codeptr,cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
READ_UNLOCK(pp->PRWLock);
|
||||
return 1+((char *)codeptr-(char *)cl->ClCode)/cl->ClItemSize;
|
||||
}
|
||||
} else {
|
||||
StaticClause *cl;
|
||||
|
||||
cl = ClauseCodeToStaticClause(clcode);
|
||||
do {
|
||||
if (IN_BLOCK(codeptr,cl,cl->ClSize)) {
|
||||
clause_was_found(pp, pat, parity);
|
||||
READ_UNLOCK(pp->PRWLock);
|
||||
return i;
|
||||
}
|
||||
if (cl->ClCode == pp->cs.p_code.LastClause)
|
||||
break;
|
||||
i++;
|
||||
cl = cl->ClNext;
|
||||
} while (TRUE);
|
||||
}
|
||||
}
|
||||
out = find_code_in_clause(pp, pat, parity, codeptr);
|
||||
READ_UNLOCK(pp->PRWLock);
|
||||
return(0);
|
||||
return out;
|
||||
}
|
||||
|
||||
static Int
|
||||
|
|
@ -3328,6 +3336,13 @@ Yap_PredForCode(yamop *codeptr, find_pred_type where_from, Atom *pat, UInt *pari
|
|||
p = PredForChoicePt(codeptr);
|
||||
} else if (where_from == FIND_PRED_FROM_ENV) {
|
||||
p = EnvPreg(codeptr);
|
||||
if (p) {
|
||||
if (p->ModuleOfPred == PROLOG_MODULE)
|
||||
*pmodule = ModuleName[0];
|
||||
else
|
||||
*pmodule = p->ModuleOfPred;
|
||||
return find_code_in_clause(p, pat, parity, codeptr);
|
||||
}
|
||||
} else {
|
||||
return PredForCode(codeptr, pat, parity, pmodule);
|
||||
}
|
||||
|
|
|
|||
86
C/errors.c
86
C/errors.c
|
|
@ -85,6 +85,7 @@ DumpActiveGoals (void)
|
|||
CELL cp;
|
||||
PredEntry *pe;
|
||||
int first = 1;
|
||||
|
||||
if (legal_env (YENV) && YENV < ENV)
|
||||
ep = YENV;
|
||||
else if (legal_env (ENV))
|
||||
|
|
@ -181,6 +182,7 @@ detect_bug_location(yamop *yap_pc, find_pred_type where_from, char *tp, int psiz
|
|||
Term pred_module;
|
||||
Int cl;
|
||||
|
||||
tp[0] = '\0';
|
||||
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity, &pred_module))
|
||||
== 0) {
|
||||
/* system predicate */
|
||||
|
|
@ -257,40 +259,64 @@ detect_bug_location(yamop *yap_pc, find_pred_type where_from, char *tp, int psiz
|
|||
}
|
||||
}
|
||||
|
||||
static void
|
||||
cl_position(yamop *ptr, find_pred_type where_from)
|
||||
{
|
||||
char tp[256];
|
||||
detect_bug_location(ptr, where_from, tp, 256);
|
||||
fprintf(stderr," %s\n", tp);
|
||||
}
|
||||
|
||||
static void
|
||||
dump_stack(void)
|
||||
{
|
||||
choiceptr b_ptr = B;
|
||||
CELL *env_ptr = ENV;
|
||||
char tp[256];
|
||||
yamop *ipc = CP;
|
||||
|
||||
if (H > ASP || H > LCL0) {
|
||||
fprintf(stderr,"%% YAP ERROR: Global Collided against Local\n");
|
||||
fprintf(stderr,"%% YAP ERROR: Global Collided against Local (%p--%p)\n",H,ASP);
|
||||
} else if (HeapTop > (ADDR)Yap_GlobalBase) {
|
||||
fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global\n");
|
||||
fprintf(stderr,"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n", HeapTop, Yap_GlobalBase);
|
||||
} else {
|
||||
if (b_ptr != NULL) {
|
||||
fprintf(stderr," %% Goals with open alternatives:\n");
|
||||
while (b_ptr != NULL) {
|
||||
cl_position(b_ptr->cp_ap, FIND_PRED_FROM_CP);
|
||||
#if !USE_SYSTEM_MALLOC
|
||||
fprintf (stderr,"%dKB of Code Space (%p--%p)\n",((CELL)HeapTop-(CELL)Yap_HeapBase)/1024,Yap_HeapBase,HeapTop);
|
||||
#if USE_DL_MALLOC
|
||||
if (Yap_hole_start) {
|
||||
fprintf (stderr," Last hole: %p--%p\n", Yap_hole_start, Yap_hole_end);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
fprintf (stderr,"%dKB of Global Stack (%p--%p)\n",(sizeof(CELL)*(H-H0))/1024,H0,H);
|
||||
fprintf (stderr,"%dKB of Local Stack (%p--%p)\n",(sizeof(CELL)*(LCL0-ASP))/1024,ASP,LCL0);
|
||||
fprintf (stderr,"%dKB of Trail (%p--%p)\n",((ADDR)TR-Yap_TrailBase)/1024,Yap_TrailBase,TR);
|
||||
fprintf (stderr,"Performed %d garbage collections\n", GcCalls);
|
||||
#if LOW_LEVEL_TRACER
|
||||
{
|
||||
extern long long vsc_count;
|
||||
|
||||
if (vsc_count) {
|
||||
fprintf(stderr,"Trace Counter at %lld\n",vsc_count);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
fprintf (stderr,"Goal Stack Dump (* is backtrack point)\n");
|
||||
while (b_ptr != NULL) {
|
||||
while (env_ptr && env_ptr <= (CELL *)b_ptr) {
|
||||
detect_bug_location(ipc, FIND_PRED_FROM_ENV, tp, 256);
|
||||
if (env_ptr == (CELL *)b_ptr &&
|
||||
(choiceptr)env_ptr[E_CB] > b_ptr) {
|
||||
b_ptr = b_ptr->cp_b;
|
||||
fprintf(stderr," %s (*)\n", tp);
|
||||
} else {
|
||||
fprintf(stderr," %s\n", tp);
|
||||
}
|
||||
ipc = (yamop *)(env_ptr[E_CP]);
|
||||
env_ptr = (CELL *)(env_ptr[E_E]);
|
||||
}
|
||||
if (b_ptr) {
|
||||
if (b_ptr->cp_ap->opc != Yap_opcode(_or_else) &&
|
||||
b_ptr->cp_ap->opc != Yap_opcode(_or_last) &&
|
||||
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
|
||||
/* we can safely ignore ; because there is always an upper env */
|
||||
detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, tp, 256);
|
||||
fprintf(stderr," %s (*)\n", tp);
|
||||
}
|
||||
b_ptr = b_ptr->cp_b;
|
||||
}
|
||||
fprintf(stderr,"\n");
|
||||
}
|
||||
if (env_ptr != NULL) {
|
||||
fprintf(stderr," %% Goals left to continue:\n");
|
||||
while (env_ptr != NULL) {
|
||||
cl_position((yamop *)(env_ptr[E_CP]), FIND_PRED_FROM_ENV);
|
||||
env_ptr = (CELL *)(env_ptr[E_E]);
|
||||
}
|
||||
fprintf(stderr,"\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -299,12 +325,12 @@ dump_stack(void)
|
|||
static void
|
||||
error_exit_yap (int value)
|
||||
{
|
||||
if (!Yap_PrologMode & BootMode) {
|
||||
#if DEBUG
|
||||
fprintf(stderr,"%d garbage collections\n", GcCalls);
|
||||
#endif
|
||||
if (!(Yap_PrologMode & BootMode)) {
|
||||
dump_stack();
|
||||
#if DEBUG
|
||||
#endif
|
||||
}
|
||||
fprintf(stderr, "\n Exiting ....\n");
|
||||
Yap_exit(value);
|
||||
}
|
||||
|
||||
|
|
@ -380,7 +406,11 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
|
|||
} else {
|
||||
tmpbuf[0] = '\0';
|
||||
}
|
||||
fprintf(stderr,"%% Fatal YAP Error: %s exiting....\n",tmpbuf);
|
||||
if (Yap_PrologMode == UserCCallMode) {
|
||||
fprintf(stderr,"%% OOOPS in USER C-CODE: %s.\n",tmpbuf);
|
||||
} else {
|
||||
fprintf(stderr,"%% OOOPS: %s.\n",tmpbuf);
|
||||
}
|
||||
error_exit_yap (1);
|
||||
}
|
||||
if (P == (yamop *)(FAILCODE))
|
||||
|
|
|
|||
|
|
@ -1021,7 +1021,6 @@ SearchForTrailFault(siginfo_t *siginfo)
|
|||
{
|
||||
void *ptr = siginfo->si_addr;
|
||||
|
||||
fprintf(stderr,"error at %p\n",ptr);
|
||||
/* If the TRAIL is very close to the top of mmaped allocked space,
|
||||
then we can try increasing the TR space and restarting the
|
||||
instruction. In the worst case, the system will
|
||||
|
|
@ -1039,7 +1038,7 @@ SearchForTrailFault(siginfo_t *siginfo)
|
|||
#endif /* OS_HANDLES_TR_OVERFLOW */
|
||||
{
|
||||
Yap_Error(FATAL_ERROR, TermNil,
|
||||
"likely bug in YAP, segmentation violation at %p", ptr);
|
||||
"tried to access illegal address %p!!!!", ptr);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
#/bin/bash
|
||||
# Guess what: this code works for me!
|
||||
|
||||
version="Yap-4.5.6"
|
||||
version="Yap-4.5.7"
|
||||
PATH="$PATH":~/bin/noarch
|
||||
splat
|
||||
cd C
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@
|
|||
* File: Yap.h.m4 *
|
||||
* mods: *
|
||||
* comments: main header file for YAP *
|
||||
* version: $Id: Yap.h.m4,v 1.77 2005-01-28 23:14:40 vsc Exp $ *
|
||||
* version: $Id: Yap.h.m4,v 1.78 2005-02-08 18:05:07 vsc Exp $ *
|
||||
*************************************************************************/
|
||||
|
||||
#include "config.h"
|
||||
|
|
@ -914,7 +914,8 @@ typedef enum {
|
|||
GCMode = 1024, /* doing Garbage Collecting */
|
||||
ErrorHandlingMode = 2048, /* doing error handling */
|
||||
CCallMode = 4096, /* In c Call */
|
||||
UnifyMode = 8192 /* In Unify Code */
|
||||
UnifyMode = 8192, /* In Unify Code */
|
||||
UserCCallMode = 16284 /* In User C-call Code */
|
||||
} prolog_exec_mode;
|
||||
|
||||
extern prolog_exec_mode Yap_PrologMode;
|
||||
|
|
|
|||
|
|
@ -931,18 +931,19 @@ break :-
|
|||
|
||||
% Path predicates
|
||||
|
||||
'$exists'(F,Mode) :- get_value(fileerrors,V), set_value(fileerrors,0),
|
||||
( '$open'(F,Mode,S,0), !, '$close'(S), set_value(fileerrors,V);
|
||||
set_value(fileerrors,V), fail).
|
||||
'$exists'(F,Mode) :-
|
||||
get_value(fileerrors,V),
|
||||
set_value(fileerrors,0),
|
||||
( '$open'(F,Mode,S,0) -> '$close'(S), set_value(fileerrors,V) ; set_value(fileerrors,V), fail).
|
||||
|
||||
|
||||
'$find_in_path'(user,user_input, _) :- !.
|
||||
'$find_in_path'(user_input,user_input, _) :- !.
|
||||
'$find_in_path'(S,NewFile, _) :-
|
||||
S =.. [Name,File], !,
|
||||
( user:file_search_path(Name, Dir) -> '$do_not_creep' ; '$do_not_creep'),
|
||||
'$dir_separator'(D),
|
||||
atom_codes(A,[D]),
|
||||
( user:file_search_path(Name, Dir), '$do_not_creep' ; '$do_not_creep'),
|
||||
atom_concat([Dir,A,File],NFile),
|
||||
'$search_in_path'(NFile, NewFile).
|
||||
'$find_in_path'(File,NewFile,_) :- atom(File), !,
|
||||
|
|
|
|||
Reference in New Issue