diff --git a/C/absmi.c b/C/absmi.c index ddd861479..ebf60b0de 100644 --- a/C/absmi.c +++ b/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(); } diff --git a/C/c_interface.c b/C/c_interface.c index f4dd3070b..9e8c47904 100644 --- a/C/c_interface.c +++ b/C/c_interface.c @@ -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); diff --git a/C/cdmgr.c b/C/cdmgr.c index 5c2001d05..cffd8fb93 100644 --- a/C/cdmgr.c +++ b/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); } diff --git a/C/errors.c b/C/errors.c index 43fc08495..cd81d0628 100644 --- a/C/errors.c +++ b/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)) diff --git a/C/sysbits.c b/C/sysbits.c index bcb722888..18f1792ca 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -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); } } diff --git a/distribute b/distribute index 1a1b8a5c2..e7de3f92a 100755 --- a/distribute +++ b/distribute @@ -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 diff --git a/m4/Yap.h.m4 b/m4/Yap.h.m4 index 92cd4f126..19798fcb9 100644 --- a/m4/Yap.h.m4 +++ b/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.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; diff --git a/pl/boot.yap b/pl/boot.yap index 758f32ac8..d5420bffb 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -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), !,