diff --git a/C/globals.c b/C/globals.c index db2e6cfaf..a0ed1ed5b 100644 --- a/C/globals.c +++ b/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[QUEUE_HEAD] = - qp[QUEUE_ARENA] = - qp[QUEUE_DELAY_ARENA] = - qp[QUEUE_SIZE] = - MkIntTerm(0); + qp[-1] = (CELL)Yap_MkFunctor(Yap_LookupAtom("heap"),1); + qp[0] = MkIntegerTerm(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; } diff --git a/C/grow.c b/C/grow.c index cff8f4452..a0708b7a1 100644 --- a/C/grow.c +++ b/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 diff --git a/C/heapgc.c b/C/heapgc.c index dc58b7eda..6a2f89e97 100644 --- a/C/heapgc.c +++ b/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; diff --git a/C/save.c b/C/save.c index 8025a42bb..fdccd3f0e 100644 --- a/C/save.c +++ b/C/save.c @@ -20,6 +20,7 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90"; #if _MSC_VER || defined(__MINGW32__) #include +#include #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)); diff --git a/C/sysbits.c b/C/sysbits.c index c7ec5adcf..b815d1c26 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -178,12 +178,57 @@ Yap_dir_separator (int ch) return dir_separator (ch); } +#if _MSC_VER || defined(__MINGW32__) +#include + +char *libdir = NULL; +#endif + void Yap_InitSysPath(void) { strncpy(Yap_FileNameBuf, SHARE_DIR, YAP_FILENAME_MAX); -#ifdef MAC - strncat(Yap_FileNameBuf,":", YAP_FILENAME_MAX); -#elif ATARI || _MSC_VER || defined(__MINGW32__) +#if _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 } diff --git a/C/write.c b/C/write.c index a590835f2..1cfad2e6a 100644 --- a/C/write.c +++ b/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 diff --git a/H/iopreds.h b/H/iopreds.h index 25afd4d5a..d2f8cc2b8 100644 --- a/H/iopreds.h +++ b/H/iopreds.h @@ -23,9 +23,16 @@ static char SccsId[] = "%W% %G%"; * */ +#if _MSC_VER || defined(__MINGW32__) + +#include + +#endif + #if HAVE_LIBREADLINE #if _MSC_VER || defined(__MINGW32__) + FILE *rl_instream, *rl_outstream; #endif diff --git a/changes-5.1.html b/changes-5.1.html index f7048236e..401224fda 100644 --- a/changes-5.1.html +++ b/changes-5.1.html @@ -16,6 +16,8 @@

Yap-5.1.2:

    +
  • FIXED: make library_directory/1 better protected.
  • +
  • FIXED: make YAP smarter at finding libraries in WIN32.
  • NEW: data structures using global variables: queues, heaps and beam search support.
  • NEW: global variables a la hProlog, includes major changes in diff --git a/configure b/configure index f8ac6e9b9..3cbfc48e0 100755 --- a/configure +++ b/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 - prefix="c:/Yap" - 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 + + 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. - ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" - ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + ac_libobjs="$ac_libobjs \${LIBOBJDIR}$ac_i\$U.$ac_objext" + ac_ltlibobjs="$ac_ltlibobjs \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs diff --git a/configure.in b/configure.in index 728270c3d..f32b1c4c4 100644 --- a/configure.in +++ b/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" - then - prefix="c:/Yap" - fi + AC_CHECK_LIB(psapi,main) + if test "$prefix" = "NONE" + then + prefix="\${SYSTEMDRIVE}/Yap" + fi else INSTALL_COMMAND="install_unix" AC_CHECK_LIB(m,sin) diff --git a/pl/boot.yap b/pl/boot.yap index a87738de8..321b6a3a2 100644 --- a/pl/boot.yap +++ b/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) :- diff --git a/pl/consult.yap b/pl/consult.yap index dc2b30e63..ed0d47ea7 100644 --- a/pl/consult.yap +++ b/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). \ No newline at end of file diff --git a/pl/init.yap b/pl/init.yap index 567801f33..4e7f8ebab 100644 --- a/pl/init.yap +++ b/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). - -library_directory(D) :- - getenv('YAPSHAREDIR', D). - -:- get_value(system_library_directory,D), assert(library_directory(D)). +:- dynamic library_directory/1. +