win32 fixes

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1689 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/globals.c

@@ -626,6 +626,10 @@ CopyTermToArena(Term t, Term arena, UInt arity, Term *newarena, Term *att_arenap
     }
 #endif
     Term tn = MkVarTerm();
+    if (H > ASP - 128) {
+      res = -1;
+      goto error_handler;
+    }
     CloseArena(oldH, oldHB, oldASP, newarena, old_size);
     return tn;
   } else if (IsPrimitiveTerm(t)) {
@@ -1025,12 +1029,8 @@ p_nb_queue_close(void)
     out = 
       Yap_unify(ARG3, qp[QUEUE_TAIL]) &&
       Yap_unify(ARG2, qp[QUEUE_HEAD]);
-    qp[QUEUE_TAIL] = 
+    qp[-1] = (CELL)Yap_MkFunctor(Yap_LookupAtom("heap"),1);
-      qp[QUEUE_HEAD] = 
+    qp[0] = MkIntegerTerm(0);
-      qp[QUEUE_ARENA] = 
-      qp[QUEUE_DELAY_ARENA] = 
-      qp[QUEUE_SIZE] = 
-      MkIntTerm(0);
     return out;
   }
   Yap_Error(INSTANTIATION_ERROR,t,"queue/3");
@@ -1236,6 +1236,8 @@ p_nb_heap_close(void)
       RecoverArena(qp[HEAP_ARENA]);
     if (qp[HEAP_DELAY_ARENA] != MkIntTerm(0))
       RecoverDelayArena(qp[HEAP_DELAY_ARENA]);
+    qp[-1] = (CELL)Yap_MkFunctor(Yap_LookupAtom("heap"),1);
+    qp[0] = MkIntegerTerm(0);
     return TRUE;
   }
   Yap_Error(INSTANTIATION_ERROR,t,"heap_close/1");
@@ -1804,6 +1806,7 @@ p_nb_beam_del(void)
     Yap_unify(tv, ARG3);
 }
 
+#ifdef DEBUG
 static Int
 p_nb_beam_check(void)
 {
@@ -1844,6 +1847,7 @@ p_nb_beam_check(void)
   }
   return TRUE;
 }
+#endif
 
 static Int
 p_nb_beam_peek(void)
@@ -1918,7 +1922,9 @@ void Yap_InitGlobals(void)
   Yap_InitCPred("nb_beam_del", 3, p_nb_beam_del, SafePredFlag);
   Yap_InitCPred("nb_beam_peek", 3, p_nb_beam_peek, SafePredFlag);
   Yap_InitCPred("nb_beam_empty", 1, p_nb_beam_empty, SafePredFlag);
+#ifdef DEBUG
   Yap_InitCPred("nb_beam_check", 1, p_nb_beam_check, SafePredFlag);
+#endif
   Yap_InitCPred("nb_beam_size", 2, p_nb_beam_size, SafePredFlag);
   CurrentModule = cm;
 }

C/grow.c

@@ -199,7 +199,7 @@ MoveExpandedGlobal(void)
    * cpcellsd(To,From,NOfCells) - copy the cells downwards - in
    * absmi.asm 
    */
-  cpcellsd((CELL *)(Yap_GlobalBase+GDiff), (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);  
+  cpcellsd((CELL *)(Yap_GlobalBase+(GDiff-DelayDiff)), (CELL *)OldGlobalBase, OldH - (CELL *)OldGlobalBase);  
 }
 
 static void

C/heapgc.c

@@ -1455,7 +1455,7 @@ mark_environments(CELL_PTR gc_ENV, OPREG size, CELL *pvbmap)
       }
       bmap = (Int)(((CELL)bmap) << currv);
     }
-	  
+
     for (saved_var = gc_ENV - size; saved_var < gc_ENV - EnvSizeInCells; saved_var++) {
       if (currv == sizeof(CELL)*8) {
 	if (pvbmap) {
@@ -3052,7 +3052,9 @@ compact_heap(void)
 #else
 	XXX BROKEN CODE
 #endif
+#ifdef DEBUG
 	found_marked+=nofcells;
+#endif
 	/* first swap the tag so that it will be seen by the next step */
 	current[0] = ptr[0];
 	ptr[0] = EndSpecials;

C/save.c

@@ -20,6 +20,7 @@ static char     SccsId[] = "@(#)save.c	1.3 3/15/90";
 
 #if _MSC_VER || defined(__MINGW32__)
 #include <windows.h>
+#include <psapi.h>
 #endif
 #include "absmi.h"
 #include "alloc.h"
@@ -548,7 +549,7 @@ do_save(int mode) {
 
   if (Yap_HoleSize) {
     Yap_Error(SYSTEM_ERROR,MkAtomTerm(Yap_LookupAtom(Yap_FileNameBuf)),
-	  "restore/1: address space has holes, cannot save");
+	      "restore/1: address space has holes of size %ld, cannot save", (long int)Yap_HoleSize);
     return FALSE;
   }
   if (!Yap_GetName(Yap_FileNameBuf, YAP_FILENAME_MAX, t1)) {
@@ -1447,6 +1448,50 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
       }
     }
   }
+#if _MSC_VER || defined(__MINGW32__)
+  {
+    DWORD fatts;
+    int buflen;
+    char *pt;
+
+    /* try to get it from current executable */
+    if ((fatts = GetFileAttributes(Yap_FileNameBuf)) == 0xFFFFFFFFL ||
+	!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
+      /* couldn't find it where it was supposed to be,
+	 let's try using the executable */
+      if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, Yap_FileNameBuf, YAP_FILENAME_MAX)) {
+	/* do nothing */
+	goto end;
+      }
+      buflen = strlen(Yap_FileNameBuf);
+      pt = Yap_FileNameBuf+strlen(Yap_FileNameBuf);
+      while (*--pt != '\\') {
+	/* skip executable */
+	if (pt == Yap_FileNameBuf) {
+	  /* do nothing */
+	  goto end;
+	}
+      }
+      while (*--pt != '\\') {
+	/* skip parent directory "bin\\" */
+	if (pt == Yap_FileNameBuf) {
+	  goto end;
+	}
+      }
+      /* now, this is a possible location for the ROOT_DIR, let's look for a share directory here */
+      pt[1] = '\0';
+      strncat(Yap_FileNameBuf,"lib/Yap/startup",YAP_FILENAME_MAX);
+    }
+    if ((splfild = open_file(Yap_FileNameBuf, O_RDONLY)) > 0) {
+      if ((mode = commit_to_saved_state(Yap_FileNameBuf,Astate,ATrail,AStack,AHeap)) != FAIL_RESTORE) {
+	Yap_ErrorMessage = NULL;
+	return(mode);
+      }
+    }
+  }
+ end:
+#endif
+  /* try to open from current directory */
   /* could not open file */
   if (Yap_ErrorMessage == NULL) {
 #if __simplescalar__
@@ -1657,6 +1702,7 @@ Restore(char *s, char *lib_dir)
   Yap_InitPlIO();
   /* reset time */
   Yap_ReInitWallTime();
+  Yap_InitSysPath();
   CloseRestore();
   if (which_save == 2) {
     Yap_unify(ARG2, MkIntTerm(0));

C/sysbits.c

@@ -178,12 +178,57 @@ Yap_dir_separator (int ch)
   return dir_separator (ch);
 }
 
+#if _MSC_VER || defined(__MINGW32__)
+#include <psapi.h>
+
+char *libdir = NULL;
+#endif
+
 void
 Yap_InitSysPath(void) {
   strncpy(Yap_FileNameBuf, SHARE_DIR, YAP_FILENAME_MAX);
-#ifdef MAC
+#if _MSC_VER || defined(__MINGW32__)
-  strncat(Yap_FileNameBuf,":", YAP_FILENAME_MAX);
+  {
-#elif ATARI || _MSC_VER || defined(__MINGW32__)
+    DWORD fatts;
+    int buflen;
+    char *pt;
+
+    if ((fatts = GetFileAttributes(Yap_FileNameBuf)) == 0xFFFFFFFFL ||
+	!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
+      /* couldn't find it where it was supposed to be,
+	 let's try using the executable */
+      if (!GetModuleFileNameEx( GetCurrentProcess(), NULL, Yap_FileNameBuf, YAP_FILENAME_MAX)) {
+	Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name"); 
+	/* do nothing */
+	return;
+      }
+      buflen = strlen(Yap_FileNameBuf);
+      pt = Yap_FileNameBuf+strlen(Yap_FileNameBuf);
+      while (*--pt != '\\') {
+	/* skip executable */
+	if (pt == Yap_FileNameBuf) {
+	  Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name");
+	  /* do nothing */
+	  return;
+	}
+      }
+      while (*--pt != '\\') {
+	/* skip parent directory "bin\\" */
+	if (pt == Yap_FileNameBuf) {
+	  Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name");
+	  /* do nothing */
+	}
+      }
+      /* now, this is a possible location for the ROOT_DIR, let's look for a share directory here */
+      pt[1] = '\0';
+      /* grosse */
+      strncat(Yap_FileNameBuf,"lib\\Yap",YAP_FILENAME_MAX);
+      libdir = Yap_AllocCodeSpace(strlen(Yap_FileNameBuf)+1);
+      strncpy(libdir, Yap_FileNameBuf, strlen(Yap_FileNameBuf)+1);
+      pt[1] = '\0';
+      strncat(Yap_FileNameBuf,"share",YAP_FILENAME_MAX);
+    }
+  }
   strncat(Yap_FileNameBuf,"\\", YAP_FILENAME_MAX);
 #else
   strncat(Yap_FileNameBuf,"/", YAP_FILENAME_MAX);
@@ -1664,7 +1709,12 @@ TrueFileName (char *source, char *result, int in_lib)
 	      strncpy(ares1, yap_env, YAP_FILENAME_MAX);
 #endif
 	    } else {
-	      strncpy(ares1, LIB_DIR, YAP_FILENAME_MAX);
+#if _MSC_VER || defined(__MINGW32__)
+	      if (libdir)
+		strncpy(ares1, libdir, YAP_FILENAME_MAX);
+	      else
+#endif
+		strncpy(ares1, LIB_DIR, YAP_FILENAME_MAX);
 	    }
 #if HAVE_GETENV
 	  }

C/write.c

@@ -22,11 +22,9 @@ static char     SccsId[] = "%W% %G%";
 #include "Yatom.h"
 #include "Heap.h"
 #include "yapio.h"
-#if DEBUG
 #if COROUTINING
 #include "attvar.h"
 #endif
-#endif
 
 #if HAVE_STRING_H
 #include <string.h>

H/iopreds.h

@@ -23,9 +23,16 @@ static char SccsId[] = "%W% %G%";
  *
  */
 
+#if _MSC_VER || defined(__MINGW32__)
+
+#include <windows.h>
+
+#endif
+
 #if HAVE_LIBREADLINE
 
 #if _MSC_VER || defined(__MINGW32__)
+
 FILE *rl_instream, *rl_outstream;
 #endif
 

changes-5.1.html

@@ -16,6 +16,8 @@
 
 <h2>Yap-5.1.2:</h2>
 <ul>
+<li> FIXED:  make library_directory/1 better protected.</li> 
+<li> FIXED:  make YAP smarter at finding libraries in WIN32.</li> 
 <li> NEW:  data structures using global variables: queues, heaps and
 beam search support.</li> 
 <li> NEW:  global variables a la hProlog, includes major changes in

configure

@@ -3431,12 +3431,80 @@ _ACEOF
 
   LIBS="-lwsock32 $LIBS"
 
+fi
+
+
+echo "$as_me:$LINENO: checking for main in -lpsapi" >&5
+echo $ECHO_N "checking for main in -lpsapi... $ECHO_C" >&6
+if test "${ac_cv_lib_psapi_main+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpsapi  $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+
+int
+main ()
+{
+main ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"
+			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_psapi_main=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_psapi_main=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_psapi_main" >&5
+echo "${ECHO_T}$ac_cv_lib_psapi_main" >&6
+if test $ac_cv_lib_psapi_main = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBPSAPI 1
+_ACEOF
+
+  LIBS="-lpsapi $LIBS"
+
 fi
 
     yap_cv_readline=no
     if test "$prefix" = "NONE"
     then
-      prefix="\$SYSTEMDRIVE/Yap"
+      prefix="\${SYSTEMDRIVE}/Yap"
     fi
   else
     use_malloc="yes"
@@ -3514,10 +3582,78 @@ _ACEOF
 
 fi
 
-  if test "$prefix" = "NONE"
+
-  then
+echo "$as_me:$LINENO: checking for main in -lpsapi" >&5
-    prefix="c:/Yap"
+echo $ECHO_N "checking for main in -lpsapi... $ECHO_C" >&6
-  fi
+if test "${ac_cv_lib_psapi_main+set}" = set; then
+  echo $ECHO_N "(cached) $ECHO_C" >&6
+else
+  ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpsapi  $LIBS"
+cat >conftest.$ac_ext <<_ACEOF
+/* confdefs.h.  */
+_ACEOF
+cat confdefs.h >>conftest.$ac_ext
+cat >>conftest.$ac_ext <<_ACEOF
+/* end confdefs.h.  */
+
+
+int
+main ()
+{
+main ();
+  ;
+  return 0;
+}
+_ACEOF
+rm -f conftest.$ac_objext conftest$ac_exeext
+if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
+  (eval $ac_link) 2>conftest.er1
+  ac_status=$?
+  grep -v '^ *+' conftest.er1 >conftest.err
+  rm -f conftest.er1
+  cat conftest.err >&5
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); } &&
+	 { ac_try='test -z "$ac_c_werror_flag"
+			 || test ! -s conftest.err'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; } &&
+	 { ac_try='test -s conftest$ac_exeext'
+  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+  (eval $ac_try) 2>&5
+  ac_status=$?
+  echo "$as_me:$LINENO: \$? = $ac_status" >&5
+  (exit $ac_status); }; }; then
+  ac_cv_lib_psapi_main=yes
+else
+  echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ac_cv_lib_psapi_main=no
+fi
+rm -f conftest.err conftest.$ac_objext \
+      conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+echo "$as_me:$LINENO: result: $ac_cv_lib_psapi_main" >&5
+echo "${ECHO_T}$ac_cv_lib_psapi_main" >&6
+if test $ac_cv_lib_psapi_main = yes; then
+  cat >>confdefs.h <<_ACEOF
+#define HAVE_LIBPSAPI 1
+_ACEOF
+
+  LIBS="-lpsapi $LIBS"
+
+fi
+
+    if test "$prefix" = "NONE"
+    then
+      prefix="\${SYSTEMDRIVE}/Yap"
+    fi
 else
   INSTALL_COMMAND="install_unix"
 
@@ -6355,6 +6491,7 @@ fi
 	    LIBS="$LIBS -ldl"
 	  fi
 	fi
+	LIBS="$LIBS -framework JavaVM"
 	SHLIB_CFLAGS="-fno-common"
 	SHLIB_SUFFIX=".dylib"
         DO_SECOND_LD=""
@@ -15539,9 +15676,10 @@ for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
   # 1. Remove the extension, and $U if already installed.
   ac_i=`echo "$ac_i" |
 	 sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
-  # 2. Add them.
+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR
-  ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
+  #    will be set to the directory where LIBOBJS objects are built.
-  ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+  ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+  ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo'
 done
 LIBOBJS=$ac_libobjs
 

configure.in

@@ -371,10 +371,11 @@ then
   then
     CC="gcc  -mno-cygwin"
     AC_CHECK_LIB(wsock32,main)
+    AC_CHECK_LIB(psapi,main)
     yap_cv_readline=no
     if test "$prefix" = "NONE"
     then
-      prefix="\$SYSTEMDRIVE/Yap"
+      prefix="\${SYSTEMDRIVE}/Yap"
     fi
   else
     use_malloc="yes"
@@ -385,10 +386,11 @@ then
   yap_cv_readline=no
   INSTALL_COMMAND=install_win32
   AC_CHECK_LIB(wsock32,main)
-  if test "$prefix" = "NONE"
+  AC_CHECK_LIB(psapi,main)
-  then
+    if test "$prefix" = "NONE"
-    prefix="c:/Yap"
+    then
-  fi
+      prefix="\${SYSTEMDRIVE}/Yap"
+    fi
 else
   INSTALL_COMMAND="install_unix"
   AC_CHECK_LIB(m,sin)

pl/boot.yap

@@ -936,13 +936,19 @@ bootstrap(F) :-
 
 '$find_in_path'(user,user_input, _) :- !.
 '$find_in_path'(user_input,user_input, _) :- !.
+'$find_in_path'(library(File),NewFile, _) :-
+	'$dir_separator'(D),
+	atom_codes(A,[D]),
+	'$system_library_directories'(Dir),
+	'$extend_path'(Dir,A,File,NFile),
+	'$search_in_path'(NFile, NewFile), !.
 '$find_in_path'(S,NewFile, _) :-
 	S =.. [Name,File], !,
 	'$dir_separator'(D),
 	atom_codes(A,[D]),
 	( user:file_search_path(Name, Dir), '$do_not_creep' ; '$do_not_creep', fail),
 	'$extend_path'(Dir,A,File,NFile),
-	'$search_in_path'(NFile, NewFile).
+	'$search_in_path'(NFile, NewFile), !.
 '$find_in_path'(File,NewFile,_) :- atom(File), !,
 	'$search_in_path'(File,NewFile),!.
 '$find_in_path'(File,_,Call) :-

pl/consult.yap

@@ -469,3 +469,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
 	fail.
 '$record_loaded'(_, _).
 
+'$system_library_directories'(Dir) :-
+	getenv('YAPSHAREDIR', Dir).
+'$system_library_directories'(Dir) :-
+	get_value(system_library_directory,Dir).

pl/init.yap

@@ -116,15 +116,15 @@ system_mode(verbose,off) :- set_value('$verbose',off).
 
 :- multifile goal_expansion/3.
 
-:- dynamic_predicate(goal_expansion/3, logical).
+:- dynamic goal_expansion/3.
 
 :- multifile term_expansion/2.
 
-:- dynamic_predicate(term_expansion/2, logical).
+:- dynamic term_expansion/2.
 
 :- multifile file_search_path/2.
 
-:- dynamic_predicate(file_search_path/2, logical).
+:- dynamic file_search_path/2.
 
 file_search_path(library, Dir) :-
      library_directory(Dir).
@@ -133,11 +133,7 @@ file_search_path(system, Dir) :-
 
 :- multifile library_directory/1.
 
-:- dynamic_predicate(library_directory/1, logical).
+:- dynamic library_directory/1.
-
+
-library_directory(D) :-
-	getenv('YAPSHAREDIR', D).
-
-:- get_value(system_library_directory,D), assert(library_directory(D)).