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

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)
+	if (Yap_do_low_level_trace)
-	low_level_trace(enter_pred,p,XREGS+1);
+	  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();
       }

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);

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;
+  out = find_code_in_clause(pp, pat, parity, codeptr);
-  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);
-    }
-  }
   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);
   }

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) {
+#if !USE_SYSTEM_MALLOC
-      fprintf(stderr," %% Goals with open alternatives:\n");
+    fprintf (stderr,"%dKB of Code Space (%p--%p)\n",((CELL)HeapTop-(CELL)Yap_HeapBase)/1024,Yap_HeapBase,HeapTop); 
-      while (b_ptr != NULL) {
+#if USE_DL_MALLOC 
-	cl_position(b_ptr->cp_ap, FIND_PRED_FROM_CP);
+    if (Yap_hole_start) {
-	b_ptr = b_ptr->cp_b;
+      fprintf (stderr,"  Last hole: %p--%p\n", Yap_hole_start, Yap_hole_end);
-      }
-      fprintf(stderr,"\n");
     }
-    if (env_ptr != NULL) {
+#endif
-      fprintf(stderr," %% Goals left to continue:\n");
+#endif
-      while (env_ptr != NULL) {
+    fprintf (stderr,"%dKB of Global Stack (%p--%p)\n",(sizeof(CELL)*(H-H0))/1024,H0,H); 
-	cl_position((yamop *)(env_ptr[E_CP]), FIND_PRED_FROM_ENV);
+    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]);
       }
-      fprintf(stderr,"\n");
+      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;
+      }
     }
   }
 }
@@ -299,12 +325,12 @@ dump_stack(void)
 static void
 error_exit_yap (int value)
 {
-  if (!Yap_PrologMode & BootMode) {
+  if (!(Yap_PrologMode & BootMode)) {
-#if DEBUG
-    fprintf(stderr,"%d garbage collections\n", GcCalls);
-#endif
     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))

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);
   }
 }
 

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

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;

pl/boot.yap

@@ -931,18 +931,19 @@ break :-
 
 % Path predicates
 
-'$exists'(F,Mode) :- get_value(fileerrors,V), set_value(fileerrors,0),
+'$exists'(F,Mode) :-
-	( '$open'(F,Mode,S,0), !, '$close'(S), set_value(fileerrors,V);
+	get_value(fileerrors,V),
-	  set_value(fileerrors,V), fail).
+	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), !,