diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' of github.com:vscosta/yap-6.3

Browse Source 
Conflicts:
	C/sysbits.c
	C/threads.c
This commit is contained in:
Vítor Santos Costa 2014-11-27 15:15:22 +00:00
commit d526545bc9
18 changed files with 764 additions and 445 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/save.c
View File

@ -254,8 +254,8 @@ open_file(char *my_file, int flag)
if (flag == O_RDONLY) {
my_file += strlen("/assets/");
AAsset* asset = AAssetManager_open(GLOBAL_assetManager, my_file, AASSET_MODE_UNKNOWN);
if (!asset)
return NULL;
if (!asset)
return NULL;
AAsset_close( asset );
return NULL; // usually the file will be compressed, so there is no point in actually trying to open it.
}
@ -284,7 +284,7 @@ open_file(char *my_file, int flag)
#ifdef undf0
fprintf(errout, "Opened file %s\n", my_file);
#endif
return splfild;
return splfild;
}
static int
@ -1535,7 +1535,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
}
}
}
#if _MSC_VER || defined(__MINGW32__)
#if __WINDOWS__
if ((inpf = Yap_RegistryGetString("startup"))) {
if (!((splfild = Sopen_file(inpf, "r")) < 0)) {
if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) {
@ -1553,7 +1553,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
!(fatts & FILE_ATTRIBUTE_DIRECTORY)) {
/* couldn't find it where it was supposed to be,
let's try using the executable */
if (!GetModuleFileName( GetCurrentProcess(), LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {
if (!GetModuleFileName( NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {
/* do nothing */
goto end;
}

2
C/signals.c
View File

@ -253,8 +253,10 @@ Yap_signal(yap_signals sig)
do_signal(worker_id, sig PASS_REGS);
}
#ifdef DEBUG
static Int
p_debug( USES_REGS1 );
#endif
void
Yap_external_signal(int wid, yap_signals sig)

367
C/sysbits.c
View File

@ -113,6 +113,24 @@ static int chdir(char *);
/* #define signal skel_signal */
#endif /* MACYAP */
#if DEBUG
void
LOG(const char *fmt, ...);
void
LOG(const char *fmt, ...)
{
FILE * fd;
va_list ap;
fd = fopen("c:\\cygwin\\Log.txt", "a");
va_start(ap, fmt);
vfprintf(fd, fmt, ap);
va_end(ap);
fclose( fd );
}
#endif
void exit(int);
@ -128,7 +146,7 @@ Yap_WinError(char *yap_error)
NULL);
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "%s at %s", msg, yap_error);
}
#endif /* _WIN32 */
#endif /* __WINDOWS__ */
#define is_valid_env_char(C) ( ((C) >= 'a' && (C) <= 'z') || ((C) >= 'A' && \
@ -136,15 +154,23 @@ Yap_WinError(char *yap_error)
static int
is_directory(char *FileName)
is_directory(const char *FileName)
{
#ifdef _WIN32
#ifdef __WINDOWS__
char s[YAP_FILENAME_MAX+1];
char *s0 = FileName;
const char *s0 = FileName;
char *s1 = s;
int ch;
// win32 syntax
if (s0[0] == '/' && s0[1] == '/' && isalpha(s0[2]) && s0[3] == '/')
{
s1[0] = s0[2];
s1[1] = ':';
s1[2] = '\\';
s0+=4;
s1+=3;
}
while ((ch = *s1++ = *s0++)) {
if (ch == '$') {
s1[-1] = '%';
@ -163,167 +189,193 @@ is_directory(char *FileName)
*s1++ = ch;
if (ch == '\0') { s1--; s0--; }
}
} else if (ch == '/')
s1[-1] = '\\';
}
if (ExpandEnvironmentStrings(s, FileName, YAP_FILENAME_MAX) == 0)
return FALSE;
DWORD dwAtts = GetFileAttributes( FileName );
if (dwAtts == INVALID_FILE_ATTRIBUTES)
return FALSE;
return (dwAtts & FILE_ATTRIBUTE_DIRECTORY);
#elif HAVE_LSTAT
struct stat buf;
} else if (ch == '/')
s1[-1] = '\\';
}
if (ExpandEnvironmentStrings(s, FileName, YAP_FILENAME_MAX) == 0)
return FALSE;
if (lstat(FileName, &buf) == -1) {
/* return an error number */
return FALSE;
}
return S_ISDIR(buf.st_mode);
#else
return FALSE;
#endif
}
DWORD dwAtts = GetFileAttributes( FileName );
if (dwAtts == INVALID_FILE_ATTRIBUTES)
return FALSE;
return (dwAtts & FILE_ATTRIBUTE_DIRECTORY);
#elif HAVE_LSTAT
struct stat buf;
static int
dir_separator (int ch)
if (lstat(FileName, &buf) == -1) {
/* return an error number */
return FALSE;
}
return S_ISDIR(buf.st_mode);
#else
return FALSE;
#endif
}
static int
dir_separator (int ch)
{
#ifdef MAC
return (ch == ':');
#elif ATARI || _MSC_VER
return (ch == '\\');
#elif defined(__MINGW32__) || defined(__CYGWIN__)
return (ch == '\\' || ch == '/');
#else
return (ch == '/');
#endif
}
int
Yap_dir_separator (int ch)
{
return dir_separator (ch);
}
static char *
get_exec( char *s)
{
#ifdef MAC
return (ch == ':');
#elif ATARI || _MSC_VER
return (ch == '\\');
#elif defined(__MINGW32__) || defined(__CYGWIN__)
return (ch == '\\' || ch == '/');
#else
return (ch == '/');
#endif
}
int
Yap_dir_separator (int ch)
{
return dir_separator (ch);
}
char *ptr;
#if __WINDOWS__
#include <psapi.h>
char *libdir = NULL;
ptr = max( strrchr(LOCAL_FileNameBuf, '\\') , strrchr(LOCAL_FileNameBuf, '/') );
#else
ptr = strrchr(LOCAL_FileNameBuf, '/');
#endif
if (!ptr || ptr < LOCAL_FileNameBuf)
return NULL;
return ptr;
}
static const char *
initLibPath(const char *regp, const char *path, const char *offset, const char *envp USES_REGS)
{
// environment variables trump all
#if HAVE_GETENV
{
const char *dir = getenv( envp );
if (dir != NULL &&
is_directory(dir)) {
if (strlen(dir) >= YAP_FILENAME_MAX)
return NULL;
strcpy(LOCAL_FileNameBuf, dir );
return LOCAL_FileNameBuf;
}
}
#endif
#if __WINDOWS__
{
const char *dir;
if ((dir = (const char *)Yap_RegistryGetString((char *)regp)) &&
is_directory(dir)) {
if (strlen(dir) >= YAP_FILENAME_MAX)
return NULL;
strcpy(LOCAL_FileNameBuf, dir );
return LOCAL_FileNameBuf;
}
}
#endif
if ( DESTDIR ) {
if (strlen( DESTDIR "/" ) >= YAP_FILENAME_MAX)
return NULL;
strcpy(LOCAL_FileNameBuf, DESTDIR "/" );
strncat(LOCAL_FileNameBuf, path, YAP_FILENAME_MAX);
} else {
strcpy(LOCAL_FileNameBuf, path );
}
if (is_directory(LOCAL_FileNameBuf)) {
return LOCAL_FileNameBuf;
}
{
size_t buflen;
char *pt;
/* couldn't find it where it was supposed to be,
let's try using the executable */
pt = Yap_FindExecutable( );
if (!pt)
return NULL;
if ((buflen = strlen(pt)) >= YAP_FILENAME_MAX)
return NULL;
if (!strcpy( LOCAL_FileNameBuf, pt )) {
/* do nothing */
return NULL;
}
/* should have space for absolute path */
if ((pt = get_exec( LOCAL_FileNameBuf ))
/* should have space for absolute path, including drive */
&& pt -4 > LOCAL_FileNameBuf
&& !strncmp(pt-3, "bin", 3)
&& (pt = pt-4)
#if __WINDOWS__
&& (pt[0] == '/' || pt[0] == '\\')
#else
&& (pt[0] == '/')
#endif
) {
pt[1] = '\0';
strncat(LOCAL_FileNameBuf, offset , YAP_FILENAME_MAX);
printf("done %s\n", LOCAL_FileNameBuf);
if ( is_directory(LOCAL_FileNameBuf) ) {
return LOCAL_FileNameBuf;
}
}
}
return NULL;
}
static Int
initSysPath(Term tlib, Term tcommons) {
CACHE_REGS
int len;
int dir_done = FALSE;
int commons_done = FALSE;
#if __WINDOWS__
{
char *dir;
if ((dir = Yap_RegistryGetString("library")) &&
is_directory(dir)) {
if (! Yap_unify( tlib,
MkAtomTerm(Yap_LookupAtom(dir))) )
return FALSE;
}
if ((dir = Yap_RegistryGetString("prolog_commons")) &&
is_directory(dir)) {
if (! Yap_unify( tcommons,
MkAtomTerm(Yap_LookupAtom(dir))) )
return FALSE;
}
}
if (dir_done && commons_done)
return TRUE;
#endif
strncpy(LOCAL_FileNameBuf, YAP_SHAREDIR, YAP_FILENAME_MAX);
strncat(LOCAL_FileNameBuf,"/", YAP_FILENAME_MAX);
len = strlen(LOCAL_FileNameBuf);
if (!dir_done) {
strncat(LOCAL_FileNameBuf, "Yap", YAP_FILENAME_MAX);
if (is_directory(LOCAL_FileNameBuf))
{
if (! Yap_unify( tlib,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
}
if (!commons_done) {
LOCAL_FileNameBuf[len] = '\0';
strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX);
if (is_directory(LOCAL_FileNameBuf)) {
if (! Yap_unify( tcommons,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
}
if (dir_done && commons_done)
return TRUE;
#if __WINDOWS__
{
size_t buflen;
char *pt;
/* couldn't find it where it was supposed to be,
let's try using the executable */
if (!GetModuleFileName( NULL, LOCAL_FileNameBuf, YAP_FILENAME_MAX)) {
Yap_WinError( "could not find executable name" );
/* do nothing */
p_system_library( USES_REGS1 )
{
if (Yap_LibDir == NULL) {
const char *path = initLibPath( "library", YAP_SHAREDIR"/Yap", "share/Yap", "YAPSHAREDIR" );
if (!path)
return FALSE;
}
buflen = strlen(LOCAL_FileNameBuf);
pt = LOCAL_FileNameBuf+buflen;
while (*--pt != '\\') {
/* skip executable */
if (pt == LOCAL_FileNameBuf) {
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name");
/* do nothing */
return FALSE;
}
}
while (*--pt != '\\') {
/* skip parent directory "bin\\" */
if (pt == LOCAL_FileNameBuf) {
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "could not find executable name");
/* do nothing */
return FALSE;
}
}
/* now, this is a possible location for the ROOT_DIR, let's look for a share directory here */
pt[1] = '\0';
/* grosse */
strncat(LOCAL_FileNameBuf,"lib\\Yap",YAP_FILENAME_MAX);
libdir = Yap_AllocCodeSpace(strlen(LOCAL_FileNameBuf)+1);
strncpy(libdir, LOCAL_FileNameBuf, strlen(LOCAL_FileNameBuf)+1);
pt[1] = '\0';
strncat(LOCAL_FileNameBuf,"share",YAP_FILENAME_MAX);
Yap_LibDir = (const char *)malloc( strlen(path)+1 );
strcpy( Yap_LibDir, path );
}
strncat(LOCAL_FileNameBuf,"\\", YAP_FILENAME_MAX);
len = strlen(LOCAL_FileNameBuf);
strncat(LOCAL_FileNameBuf, "Yap", YAP_FILENAME_MAX);
if (!dir_done && is_directory(LOCAL_FileNameBuf)) {
if (! Yap_unify( tlib,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
LOCAL_FileNameBuf[len] = '\0';
strncat(LOCAL_FileNameBuf, "PrologCommons", YAP_FILENAME_MAX);
if (!commons_done && is_directory(LOCAL_FileNameBuf)) {
if (! Yap_unify( tcommons,
MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf))) )
return FALSE;
}
#endif
return dir_done && commons_done;
return Yap_unify( ARG1, MkAtomTerm(Yap_LookupAtom(Yap_LibDir)) );
}
static Int
p_system_foreign( USES_REGS1 )
{
if (Yap_ForeignDir == NULL) {
const char *path = initLibPath( "dlls", YAP_LIBDIR"/Yap", "lib/Yap", "YAPLIBDIR" );
if (!path)
return FALSE;
Yap_ForeignDir = (const char *)malloc( strlen(path)+1 );
strcpy( Yap_ForeignDir, path );
}
return Yap_unify( ARG1, MkAtomTerm(Yap_LookupAtom(Yap_ForeignDir)) );
}
static Int
p_libraries_path( USES_REGS1 )
p_system_commons( USES_REGS1 )
{
return initSysPath( ARG1, ARG2 );
if (Yap_CommonsDir == NULL) {
const char *path = initLibPath( "commons", YAP_SHAREDIR"/PrologCommons", "share/PrologCommons", "YAPCOMMONSDIR" );
if (!path)
return FALSE;
Yap_CommonsDir = (const char *)malloc( strlen(path)+1 );
strcpy( Yap_CommonsDir, path );
}
return Yap_unify( ARG1, MkAtomTerm(Yap_LookupAtom(Yap_CommonsDir)) );
}
static Int
p_system_bin( USES_REGS1 )
{
if (Yap_BinDir == NULL) {
const char *path = initLibPath( "bin", YAP_BINDIR"/PrologBin", "bin", "YAPBINDIR" );
if (!path)
return FALSE;
Yap_BinDir = (const char *)malloc( strlen(path)+1 );
strcpy( Yap_BinDir, path );
}
return Yap_unify( ARG1, MkAtomTerm(Yap_LookupAtom(Yap_BinDir)) );
}
static Int
@ -1850,9 +1902,9 @@ TrueFileName (char *source, char *root, char *result, int in_lib, int expand_roo
strncpy(ares1, yap_env, YAP_FILENAME_MAX);
#endif
} else {
#if _MSC_VER || defined(__MINGW32__)
if (libdir)
strncpy(ares1, libdir, YAP_FILENAME_MAX);
#if __WINDOWS__
if (Yap_LibDir)
strncpy(ares1, Yap_LibDir, YAP_FILENAME_MAX);
else
#endif
strncpy(ares1, YAP_LIBDIR, YAP_FILENAME_MAX);
@ -3030,7 +3082,10 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("release_random_state", 1, p_release_random_state, SafePredFlag);
#endif
Yap_InitCPred ("log_event", 1, p_log_event, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("library_directories", 2, p_libraries_path, SafePredFlag);
Yap_InitCPred ("system_library", 1, p_system_library, SafePredFlag);
Yap_InitCPred ("system_commons", 1, p_system_commons, SafePredFlag);
Yap_InitCPred ("system_foreign", 1, p_system_foreign, SafePredFlag);
Yap_InitCPred ("system_bin", 1, p_system_bin, SafePredFlag);
Yap_InitCPred ("sh", 0, p_sh, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$shell", 1, p_shell, SafePredFlag|SyncPredFlag|UserCPredFlag);
Yap_InitCPred ("system", 1, p_system, SafePredFlag|SyncPredFlag|UserCPredFlag);
@ -3041,7 +3096,7 @@ Yap_InitSysPreds(void)
Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$set_fpu_exceptions", 1, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$set_fpu_exceptions",1, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);

47
C/threads.c
View File

@ -1784,31 +1784,30 @@ p_new_mutex(void)
return Yap_unify(ARG1, MkIntegerTerm(mutexes++) );
}
static Int
p_with_mutex( USES_REGS1 )
{
Int mut;
Term t1 = Deref(ARG1), excep;
Int rc = FALSE;
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
Term tm = CurrentModule;
Term tg = Deref(ARG2);
static Int
p_with_mutex( USES_REGS1 )
{
Int mut;
Term t1 = Deref(ARG1), excep;
Int rc = FALSE;
Int creeping = Yap_get_signal(YAP_CREEP_SIGNAL);
PredEntry *pe;
Term tm = CurrentModule;
Term tg = Deref(ARG2);
if (IsVarTerm(t1)) {
p_new_mutex( PASS_REGS1 );
t1 = Deref(ARG1);
mut = IntOfTerm(t1);
}
tg = Yap_StripModule(tg, &tm);
if (IsVarTerm(tg)) {
Yap_Error(INSTANTIATION_ERROR, ARG2, "with_mutex/2");
goto end;
} else if (IsApplTerm(tg)) {
register Functor f = FunctorOfTerm(tg);
register CELL *pt;
size_t i, arity;
if (IsVarTerm(t1)) {
p_new_mutex( PASS_REGS1 );
}
t1 = Deref(ARG1);
mut = IntOfTerm(t1);
tg = Yap_StripModule(tg, &tm);
if (IsVarTerm(tg)) {
Yap_Error(INSTANTIATION_ERROR, ARG2, "with_mutex/2");
goto end;
} else if (IsApplTerm(tg)) {
register Functor f = FunctorOfTerm(tg);
register CELL *pt;
size_t i, arity;
f = FunctorOfTerm(tg);
if (IsExtensionFunctor(f)) {

2
configure.in
View File

@ -591,7 +591,7 @@ AC_PROG_RANLIB
AC_CHECK_TOOL(AR,[ar],:)
AC_PATH_PROG(INSTALL_INFO,install-info,true,$PATH:/sbin:/usr/sbin:/usr/etc:/usr/local/sbin)
dnl do this before windows.h
AC_CHECK_HEADERS(winsock.h winsock2.h windows.h)
AC_CHECK_HEADERS(winsock.h winsock2.h windows.h Shlobj.h )
AC_PATH_PROG(SHELL,sh)
AC_CHECK_TOOL([INDENT], [indent], [:])

22
console/LGPL/pl-ntmain.c
View File

@ -270,18 +270,18 @@ registerConsole(rlc_console c)
}
static void
closeConsoles(void)
{ int i;
rlc_console *p;
/* static void */
/* closeConsoles(void) */
/* { int i; */
/* rlc_console *p; */
LOCK();
for(i=0, p=consoles; i<consoles_length; i++, p++)
{ if ( *p )
rlc_close(*p);
}
UNLOCK();
}
/* LOCK(); */
/* for(i=0, p=consoles; i<consoles_length; i++, p++) */
/* { if ( *p ) */
/* rlc_close(*p); */
/* } */
/* UNLOCK(); */
/* } */
/*******************************

2
include/SWI-Prolog.h
View File

@ -525,6 +525,8 @@ extern X_API int PL_unify_atom_nchars(term_t, size_t len, const char *);
extern X_API int PL_unify_float(term_t, double);
extern X_API int PL_unify_functor(term_t, functor_t);
extern X_API int PL_unify_int64(term_t, int64_t);
extern X_API int PL_unify_intptr(term_t, intptr_t);
extern X_API int PL_unify_uintptr(term_t, uintptr_t);
extern X_API int PL_unify_integer(term_t, long);
extern X_API int PL_unify_list(term_t, term_t, term_t);
extern X_API int PL_unify_list_chars(term_t, const char *);

14
library/dialect/swi/fli/swi.c
View File

@ -1210,6 +1210,20 @@ X_API int PL_unify_integer(term_t t, long n)
return Yap_unify(Yap_GetFromSlot(t PASS_REGS),iterm);
}
X_API int PL_unify_intptr(term_t t, intptr_t n)
{
CACHE_REGS
Term iterm = MkIntegerTerm(n);
return Yap_unify(Yap_GetFromSlot(t PASS_REGS),iterm);
}
X_API int PL_unify_uintptr(term_t t, uintptr_t n)
{
CACHE_REGS
Term iterm = MkIntegerTerm(n);
return Yap_unify(Yap_GetFromSlot(t PASS_REGS),iterm);
}
/* SWI: int PL_unify_integer(term_t ?t, long n)
YAP long int unify(YAP_Term* a, Term* b) */
X_API int PL_unify_functor(term_t t, functor_t f)

4
library/regex/regcomp.c
View File

@ -77,10 +77,12 @@ unsigned char collate_substitute_table[UCHAR_MAX + 1][STR_LEN];
struct collate_st_char_pri collate_char_pri_table[UCHAR_MAX + 1];
struct collate_st_chain_pri collate_chain_pri_table[TABLE_SIZE];
#if _MSC_VER || defined(__MINGW32__) || defined(__CYGWIN__)
#if __WINDOWS__
#define isblank(X) isspace(X)
#ifndef isascii
#define isascii(X) ((unsigned int)(X) < 0177)
#endif
#endif
/*
* Compare two characters converting collate information

4
library/regex/regexp.c
View File

@ -175,11 +175,11 @@ init_regexp(void)
YAP_UserCPredicate("check_regexp", regexp, 7);
}
#if defined(_WIN32) || defined(__MINGW32__)
#if __WINDOWS__
#include <windows.h>
int WINAPI winegexp(HANDLE, DWORD, LPVOID);
int WINAPI win_regexp(HANDLE, DWORD, LPVOID);
int WINAPI win_regexp(HANDLE hinst, DWORD reason, LPVOID reserved)
{

5
misc/HEAPFIELDS
View File

@ -309,7 +309,10 @@ char *char_conversion_table2 CharConversionTable2 =NULL CodeCharPAdjust
int parser_error_style ParserErrorStyle =EXCEPTION_ON_PARSER_ERROR void
/* library location. */
char *yap_lib_dir Yap_LibDir =NULL CodeCharPAdjust
const char *yap_lib_dir Yap_LibDir =NULL CodeCharPAdjust
const char *yap_foreign_dir Yap_ForeignDir =NULL CodeCharPAdjust
const char *yap_commons_dir Yap_CommonsDir =NULL CodeCharPAdjust
const char *yap_bin_dir Yap_BinDir =NULL CodeCharPAdjust
/* time */
void *last_wtime LastWtimePtr =NULL CodeVoidPAdjust

271
misc/mkwin
View File

@ -1,4 +1,4 @@
# !/bin/sh
#!/bin/sh
#
# script for compiling and installing YAP under msys. Uses a mingw64
# compiler, msys shell and nsis to do the installing
@ -19,12 +19,14 @@
# http://nsis.sourceforge.net/Main_Page
#
#
# newline
for YHOME in /y/vsc /z /home/vsc /home/vitor /Users/vsc /u/vitor;
do
if test -d $YHOME/Yap
then
break
fi
if test -d $YHOME/Yap
then
break
fi
done
#!/bin/sh
@ -60,34 +62,39 @@ VERSION="$VER"."$PATCHID"
I=$#
while test $I -gt 0
do
if test $1 = threads
then
THREADS=yes
elif test $1 = no_threads
then
THREADS=no
elif test $1 = reuse
then
CLEAN=no
elif test $1 = clean
then
CLEAN=yes
elif test $1 = 32
then
ABI=32
elif test $1 = 64
then
ABI=64
else
echo "received \"$1\", should be one of threads, no_threads, 32, 64, reuse, clean"
fi
I=$(( $I - 1 ))
case $1 in
threads)
THREADS=yes
;;
no_threads)
THREADS=no
;;
reuse)
CLEAN=no
;;
exe)
CLEAN=exe
;;
clean)
CLEAN=yes
;;
32)
ABI=32
;;
64)
ABI=64
;;
**)
echo "received \"$1\", should be one of threads, no_threads, 32, 64, reuse, clean"
;;
esac
I=$(( $I - 1 ))
done
# srcdir comes from here, please avoid relative paths
CONFIGURE="$SRC"/configure
#DEBUG=" --enable-debug-yap --enable-low-level-tracer"
DEBUG=
DEBUG=" --enable-debug-yap --enable-low-level-tracer"
#DEBUG=
# debugging setup
do_compile=yes
@ -99,176 +106,186 @@ do_install=yes
DOCS_DIR="$YHOME"/Yap/doxout
if test $ABI = 64; then
TARGET=YAP64
case $( uname ) in
*Darwin*)
GCC_DIR="$MXE"
HOST="x86_64-w64-mingw32"
BUILD=/c/cygwin/Yap/mingw"$ABI"
;;
*MINGW64*)
TARGET=YAP64
case $( uname ) in
*Darwin*)
GCC_DIR="$MXE"
HOST="x86_64-w64-mingw32"
BUILD=/c/cygwin/Yap/mingw"$ABI"
;;
*MINGW64*)
# GCC_DIR=/l/Work/noth/mingw-w64/x86_64-4.9.0-posix-seh-rt_v3-rev1/mingw64
# GCC_DIR=/c/TDM-GCC-64
GCC_DIR=/c/msys64/MinGW64
HOST="x86_64-w64-mingw32"
;;
MSYS*)
GCC_DIR=/c/msys64/MinGW64
HOST="x86_64-w64-mingw32"
;;
MSYS*)
# GCC_DIR=/c/TDM-GCC-64
GCC_DIR=/c/msys64
HOST="x86_64-pc-msys"
BLD="--build=$HOST"
;;
esac
GCC_DIR=/c/msys64
HOST="x86_64-pc-msys"
BLD="--build=$HOST"
;;
esac
# ok.
# BDD compiler package. Get version that compiles on Windows from Vitor!
# GMP=/l/Work/noth/msys/1.0/local
GMP=yes #/c/msys64/usr/win64
CUDD=/c/cygwin/Yap/cudd-2.5.0-mingw64
GECODE=no # "/c/Program Files/Gecode"
JAVA="$( echo /c/Program\ Files/Java/jdk* )"
GMP=yes #/c/msys64/usr/win64
CUDD=/c/cygwin/Yap/cudd-2.5.0-mingw64
GECODE=no # "/c/Program Files/Gecode"
JAVA="$( echo /c/Program\ Files/Java/jdk* )"
# "/c/Python33-64"
PYTHON=yes
R="$( echo /c/Program\ Files/R/R-*/bin/x64* )"
PYTHON=yes
R=yes
# HOME WIN32 configuration
elif test $ABI = 32; then
TARGET=YAP
case $( uname ) in
*Darwin*)
TARGET=YAP
case $( uname ) in
*Darwin*)
#use mxe as a cross compiler
GCC_DIR="$MXE"
HOST="i686-pc-mingw32"
GMP=/c/msys64/usr/win32
;;
*MINGW32*)
GCC_DIR=/c/msys64/mingw32
HOST="i686-w64-mingw32"
GMP=yes
;;
esac
GCC_DIR="$MXE"
HOST="i686-pc-mingw32"
GMP=/c/msys64/usr/win32
;;
*MINGW32*)
GCC_DIR=/c/msys64/mingw32
HOST="i686-w64-mingw32"
GMP=yes
;;
esac
# ok.
# BDD compiler package. Get version that compiles on Windows from Vitor!
# GMP=/l/Work/noth/msys/1.0/local
CUDD=/c/cygwin/Yap/cudd-2.5.0-mingw32
GECODE=no # "/c/Program Files/Gecode"
JAVA="$( echo /c/Program\ Files\ *x86*/Java/jdk* )"
CUDD=/c/cygwin/Yap/cudd-2.5.0-mingw32
GECODE=no # "/c/Program Files/Gecode"
JAVA="$( echo /c/Program\ Files\ *x86*/Java/jdk* )"
#"/c/Python27/DLLs"
PYTHON=yes
R="$( echo /c/Program\ Files/R/R-*/bin/i* )"
PYTHON=yes
R=yes
# HOST=" --enable-abi=32"
fi
if test x"$THREADS" = xyes; then
EXTRA_THREADS="-threads"
EXTRA_THREADS="-threads"
fi
for BUILD in /c/cygwin/Yap "$HOME"/Yap/bins .
do
if test -d $BUILD; then break; fi
if test -d $BUILD; then break; fi
done
BUILD+="/mingw""$ABI""$EXTRA_THREADS"
export PATH="$GCC_DIR"/bin:"$PATH"
# echo "gcc= " $GCC_DIR
echo "host= " $HOST
echo "host= " $HOST
if test x"$JAVA" != xno
then
export PATH="$PATH":"$JAVA"/bin
export PATH="$PATH":"$JAVA"/bin
fi
if test x"$PYTHON" != xno
if test x"$PYTHON" != xno -a x"$PYTHON" != yes
then
export PATH="$PATH":"$PYTHON"
export PATH="$PATH":"$PYTHON"
fi
if test x"$R" != xno
if test x"$R" != yes
then
if test "$ABI" = 32
then
RPATH="$( echo /c/Program\ Files/R/R-*/bin/i386 )"
else
RPATH="$( echo /c/Program\ Files/R/R-*/bin/x64 )"
fi
export PATH="$PATH":"$RPATH"
elif test x"$R" != xno
then
export PATH="$PATH":"$R"
fi
if test $CUDD != no
then
BDDLIB="yes"
CPLINT="yes"
BDDLIB="yes"
CPLINT="yes"
else
BDDLIB="no"
CPLINT="no"
BDDLIB="no"
CPLINT="no"
fi
if test x"$GECODE" != xno
then
export PATH="$PATH":"$GECODE"/bin
export PATH="$PATH":"$GECODE"/bin
fi
if test x"$JAVA" != xno
then
export PATH="$PATH":"$JAVA"/bin
export PATH="$PATH":"$JAVA"/bin
fi
if test "$PYTHON" = yes
then
export PATH="$PATH":"$PYTHON"
export PATH="$PATH":"$PYTHON"
fi
if test x"$R" != xno
then
if test $ABI = 32; then
R_ABI=i386
else
R_ABI=x64
fi
export PATH="$PATH":"$R"
if test $ABI = 32; then
R_ABI=i386
else
R_ABI=x64
fi
export PATH="$PATH":"$R"
fi
if test $CLEAN = yes
then
make distclean
rm -rf /c/$TARGET
fi
export INSTALL_SH=$SRC/yap-"$VERSION"/install.sh
# avoid using relative paths
if test "$do_compile" = yes; then
mkdir -p "$BUILD"
cd "$BUILD"
# make distclean
if test "$do_compile" = yes -a "$CLEAN" = yes; then
rm -rf "$BUILD"/*
mkdir -p "$BUILD"
cd "$BUILD"
# /bin/rm -rf "$BUILD"/*
"$CONFIGURE" --host="$HOST" "$BLD" \
--prefix=/c/"$TARGET" $DEBUG\
--with-R="$R" \
--with-java="$JAVA" \
--with-gmp="$GMP" \
--with-python="$PYTHON"/python.exe \
--with-cudd="$CUDD" --enable-bddlib="$BDDLIB" --with-cplint="$CPLINT" \
--with-gecode="$GECODE" \
--enable-threads="$THREADS" --enable-pthread-locking
"$CONFIGURE" --host="$HOST" "$BLD" \
--prefix=/c/"$TARGET" $DEBUG\
--with-R="$R" \
--with-java="$JAVA" \
--with-gmp="$GMP" \
--with-python="$PYTHON"/python.exe \
--with-cudd="$CUDD" --enable-bddlib="$BDDLIB" --with-cplint="$CPLINT" \
--with-gecode="$GECODE" \
--enable-threads="$THREADS" --enable-pthread-locking
make -j 4
fi
make -j 4
if test "$do_install" = yes; then
make install
cp -a "$DOCS_DIR"0/html /c/$TARGET/share/doc/Yap
cp $DOCS_DIR/latex/*pdf /c/$TARGET/share/doc/Yap
make install
cp -a "$DOCS_DIR"0/html /c/$TARGET/share/doc/Yap
cp $DOCS_DIR/latex/*pdf /c/$TARGET/share/doc/Yap
DLL_PATH="$GCC_DIR"/bin
DLL_PATH="$GCC_DIR"/bin
cp "$DLL_PATH"/libwinpthread-1.dll /c/"$TARGET"/bin
cp "$DLL_PATH"/libgmp*.dll /c/"$TARGET"/bin
cp /c/"$TARGET"/bin/libwinpthread-1.dll /c/"$TARGET"/bin/pthreadGC2.dll
cp "$DLL_PATH"/libwinpthread-1.dll /c/"$TARGET"/bin
cp "$DLL_PATH"/libgmp*.dll /c/"$TARGET"/bin
cp /c/"$TARGET"/bin/libwinpthread-1.dll /c/"$TARGET"/bin/pthreadGC2.dll
if test $ABI = 64; then
"$NSIS" -DREGKEY=SOFTWARE\\YAP\\Prolog64 \
-DROOTDIR=/c/$TARGET -DTARGET="$TARGET" \
-DABI="$ABI" \
-DVERSION="$VERSION""$EXTRA_THREADS" \
if test $ABI = 64; then
"$NSIS" -DREGKEY=SOFTWARE\\YAP\\Prolog64 \
-DROOTDIR=/c/$TARGET -DTARGET="$TARGET" \
-DABI="$ABI" \
-DVERSION="$VERSION""$EXTRA_THREADS" \
-DOPTIONS="$SRC_WIN\\misc\\options.ini" \
-DOUT_DIR=".." -D"WIN64=1" \
-NOCD $SRC/misc/Yap.nsi
else
"$NSIS" -DREGKEY=SOFTWARE\\YAP\\Prolog \
-DROOTDIR=/c/$TARGET -DTARGET="$TARGET" \
-DABI="$ABI" \
-DVERSION="$VERSION""$EXTRA_THREADS" \
-DOUT_DIR=".." -D"WIN64=1" \
-NOCD $SRC/misc/Yap.nsi
else
"$NSIS" -DREGKEY=SOFTWARE\\YAP\\Prolog \
-DROOTDIR=/c/$TARGET -DTARGET="$TARGET" \
-DABI="$ABI" \
-DVERSION="$VERSION""$EXTRA_THREADS" \
-DOPTIONS="$SRC_WIN\\misc\\options.ini" \
-DOUT_DIR=".." \
-NOCD $SRC/misc/Yap.nsi
fi
-DOUT_DIR=".." \
-NOCD $SRC/misc/Yap.nsi
fi
fi

346
os/pl-nt.c
View File

@ -26,6 +26,12 @@
#define __WINDOWS__ 1
#endif
/** @defgroup InputOutputNTIO WIN32 Specific Input/Output
* @ingroup InputOutput
*
* @{
*/
#ifdef __WINDOWS__
#define WINVER 0x0501
#if (_MSC_VER >= 1300) || __MINGW32__
@ -583,13 +589,25 @@ win_shell(term_t op, term_t file, term_t how)
succeed;
}
/** @pred win_shell(+Operation, +Document)
*
* This SWI Windows Built-in is a simplified version of win_sh/3 that
* opens a document using the WIN32 API ShellExecute() operation.
*/
static
PRED_IMPL("win_shell", 2, win_shell2, 0)
{ return win_shell(A1, A2, 0);
}
/** 2pred win_shell(+Operation, +Document)
*
* This SWI Windows Built-in uses the WIN32 API ShellExecute() command
* to either:
*
* + `open` _Document_ using the default Windows helper.
* + `print` _Document_
* + `explore`, `edit` or any operation accepted by [ShellExecute](http://msdn.microsoft.com/en-us/library/windows/desktop/bb762153(v=vs.85).aspx).
*/
static
PRED_IMPL("win_shell", 3, win_shell3, 0)
{ return win_shell(A1, A2, A3);
@ -695,7 +713,7 @@ PRED_IMPL("win_add_dll_directory", 2, win_add_dll_directory, 0)
return PL_representation_error("file_name");
if ( load_library_search_flags() )
{ if ( (cookie = (*f_AddDllDirectoryW)(dirw)) )
return PL_unify_int64(A2, (int64_t)cookie);
return PL_unify_intptr(A2, (intptr_t)cookie);
return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "AddDllDirectory()");
} else
return FALSE;
@ -706,9 +724,9 @@ PRED_IMPL("win_add_dll_directory", 2, win_add_dll_directory, 0)
static
PRED_IMPL("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
{ int64_t icookie;
{ intptr_t icookie;
if ( PL_get_int64_ex(A1, &icookie) )
if ( PL_get_intptr_ex(A1, &icookie) )
{ if ( f_RemoveDllDirectory )
{ if ( (*f_RemoveDllDirectory)((DLL_DIRECTORY_COOKIE)icookie) )
return TRUE;
@ -845,43 +863,218 @@ ms_snprintf(char *buffer, size_t count, const char *fmt, ...)
#include <shlobj.h>
#endif
#if ONLY_SUPPORT_RECENT_WINDOWS
typedef struct folderid
{ KNOWNFOLDERID *csidl;
char *name;
} folderid;
static folderid *folderids;
// do nothing the first step
static void
in(REFKNOWNFOLDERID idp, char *name, int i)
{
if (folderids) {
folderids[i].csidl = (KNOWNFOLDERID *)idp;
folderids[i].name = name;
}
}
// initialize twice: first, just count, second
// incrementing i to point to the next free entry
static int
j(int i)
{
in( &FOLDERID_AccountPictures, "AccountPictures" , i++);
in( &FOLDERID_AddNewPrograms, "AddNewPrograms" , i++);
in( &FOLDERID_AdminTools, "AdminTools" , i++);
in( &FOLDERID_AppsFolder, "AppsFolder" , i++);
in( &FOLDERID_ApplicationShortcuts, "ApplicationShortcuts" , i++);
in( &FOLDERID_AppUpdates, "AppUpdates" , i++);
in( &FOLDERID_CDBurning, "CDBurning" , i++);
in( &FOLDERID_ChangeRemovePrograms, "ChangeRemovePrograms" , i++);
in( &FOLDERID_CommonAdminTools, "CommonAdminTools" , i++);
in( &FOLDERID_CommonOEMLinks, "CommonOEMLinks" , i++);
in( &FOLDERID_CommonPrograms, "CommonPrograms" , i++);
in( &FOLDERID_CommonStartMenu, "CommonStartMenu" , i++);
in( &FOLDERID_CommonStartup, "CommonStartup" , i++);
in( &FOLDERID_CommonTemplates, "CommonTemplates" , i++);
in( &FOLDERID_ComputerFolder, "ComputerFolder" , i++);
in( &FOLDERID_ConflictFolder, "ConflictFolder" , i++);
in( &FOLDERID_ConnectionsFolder, "ConnectionsFolder" , i++);
in( &FOLDERID_Contacts, "Contacts" , i++);
in( &FOLDERID_ControlPanelFolder, "ControlPanelFolder" , i++);
in( &FOLDERID_Cookies, "Cookies" , i++);
in( &FOLDERID_Desktop, "Desktop" , i++);
in( &FOLDERID_DeviceMetadataStore, "DeviceMetadataStore" , i++);
in( &FOLDERID_Documents, "Documents" , i++);
in( &FOLDERID_DocumentsLibrary, "DocumentsLibrary" , i++);
in( &FOLDERID_Downloads, "Downloads" , i++);
in( &FOLDERID_Favorites, "Favorites" , i++);
in( &FOLDERID_Fonts, "Fonts" , i++);
in( &FOLDERID_Games, "Games" , i++);
in( &FOLDERID_GameTasks, "GameTasks" , i++);
in( &FOLDERID_History, "History" , i++);
in( &FOLDERID_HomeGroup, "HomeGroup" , i++);
in( &FOLDERID_HomeGroupCurrentUser, "HomeGroupCurrentUser" , i++);
in( &FOLDERID_ImplicitAppShortcuts, "ImplicitAppShortcuts" , i++);
in( &FOLDERID_InternetCache, "InternetCache" , i++);
in( &FOLDERID_InternetFolder, "InternetFolder" , i++);
in( &FOLDERID_Libraries, "Libraries" , i++);
in( &FOLDERID_Links, "Links" , i++);
in( &FOLDERID_LocalAppData, "LocalAppData" , i++);
in( &FOLDERID_LocalAppDataLow, "LocalAppDataLow" , i++);
in( &FOLDERID_LocalizedResourcesDir, "LocalizedResourcesDir" , i++);
in( &FOLDERID_Music, "Music" , i++);
in( &FOLDERID_MusicLibrary, "MusicLibrary" , i++);
in( &FOLDERID_NetHood, "NetHood" , i++);
in( &FOLDERID_NetworkFolder, "NetworkFolder" , i++);
in( &FOLDERID_OriginalImages, "OriginalImages" , i++);
in( &FOLDERID_PhotoAlbums, "PhotoAlbums" , i++);
in( &FOLDERID_Pictures, "Pictures" , i++);
in( &FOLDERID_PicturesLibrary, "PicturesLibrary" , i++);
in( &FOLDERID_Playlists, "Playlists" , i++);
in( &FOLDERID_PrintHood, "PrintHood" , i++);
in( &FOLDERID_PrintersFolder, "PrintersFolder" , i++);
in( &FOLDERID_Profile, "Profile" , i++);
in( &FOLDERID_ProgramData, "ProgramData" , i++);
in( &FOLDERID_ProgramFiles, "ProgramFiles" , i++);
in( &FOLDERID_ProgramFilesX64, "ProgramFilesX64" , i++);
in( &FOLDERID_ProgramFilesX86, "ProgramFilesX86" , i++);
in( &FOLDERID_ProgramFilesCommon, "ProgramFilesCommon" , i++);
in( &FOLDERID_ProgramFilesCommonX64, "ProgramFilesCommonX64" , i++);
in( &FOLDERID_ProgramFilesCommonX86, "ProgramFilesCommonX86" , i++);
in( &FOLDERID_Programs, "Programs" , i++);
in( &FOLDERID_Public, "Public" , i++);
in( &FOLDERID_PublicDesktop, "PublicDesktop" , i++);
in( &FOLDERID_PublicDocuments, "PublicDocuments" , i++);
in( &FOLDERID_PublicDownloads, "PublicDownloads" , i++);
in( &FOLDERID_PublicGameTasks, "PublicGameTasks" , i++);
in( &FOLDERID_PublicLibraries, "PublicLibraries" , i++);
in( &FOLDERID_PublicMusic, "PublicMusic" , i++);
in( &FOLDERID_PublicPictures, "PublicPictures" , i++);
in( &FOLDERID_PublicRingtones, "PublicRingtones" , i++);
in( &FOLDERID_PublicUserTiles, "PublicUserTiles" , i++);
in( &FOLDERID_PublicVideos, "PublicVideos" , i++);
in( &FOLDERID_QuickLaunch, "QuickLaunch" , i++);
in( &FOLDERID_Recent, "Recent" , i++);
in( &FOLDERID_RecordedTVLibrary, "RecordedTVLibrary" , i++);
in( &FOLDERID_RecycleBinFolder, "RecycleBinFolder" , i++);
in( &FOLDERID_ResourceDir, "ResourceDir" , i++);
in( &FOLDERID_Ringtones, "Ringtones" , i++);
in( &FOLDERID_RoamingAppData, "RoamingAppData" , i++);
in( &FOLDERID_RoamingTiles, "RoamingTiles" , i++);
in( &FOLDERID_RoamedTileImages, "RoamedTileImages" , i++);
in( &FOLDERID_SampleMusic, "SampleMusic" , i++);
in( &FOLDERID_SamplePictures, "SamplePictures" , i++);
in( &FOLDERID_SamplePlaylists, "SamplePlaylists" , i++);
in( &FOLDERID_SampleVideos, "SampleVideos" , i++);
in( &FOLDERID_SavedGames, "SavedGames" , i++);
in( &FOLDERID_SavedSearches, "SavedSearches" , i++);
in( &FOLDERID_Screenshots, "Screenshots" , i++);
in( &FOLDERID_SEARCH_CSC, "SEARCH_CSC" , i++);
in( &FOLDERID_SearchHome, "SearchHome" , i++);
// in( &FOLDERID_SearchHistory, "SearchHistory" , i++);
in( &FOLDERID_SendTo, "SendTo" , i++);
in( &FOLDERID_SidebarDefaultParts, "SidebarDefaultParts" , i++);
in( &FOLDERID_SidebarParts, "SidebarParts" , i++);
in( &FOLDERID_StartMenu, "StartMenu" , i++);
in( &FOLDERID_Startup, "Startup" , i++);
in( &FOLDERID_SyncManagerFolder, "SyncManagerFolder" , i++);
in( &FOLDERID_SyncResultsFolder, "SyncResultsFolder" , i++);
in( &FOLDERID_SyncSetupFolder, "SyncSetupFolder" , i++);
in( &FOLDERID_System, "System" , i++);
in( &FOLDERID_SystemX86, "SystemX86" , i++);
in( &FOLDERID_Templates, "Templates" , i++);
in( &FOLDERID_UserPinned, "UserPinned" , i++);
in( &FOLDERID_UserProfiles, "UserProfiles" , i++);
in( &FOLDERID_UserProgramFiles, "UserProgramFiles" , i++);
in( &FOLDERID_UserProgramFilesCommon, "UserProgramFilesCommon" , i++);
in( &FOLDERID_UsersFiles, "UsersFiles" , i++);
in( &FOLDERID_UsersLibraries, "UsersLibraries" , i++);
in( &FOLDERID_Videos, "Videos" , i++);
in( &FOLDERID_VideosLibrary, "VideosLibrary" , i++);
in( &FOLDERID_Windows, "Windows" , i++);
in( NULL, NULL, i++);
return i;
};
static void
init_folderids(void)
{
int n = j(0);
folderids = ( folderid * )malloc( n*sizeof(folderid) );
j( 0 );
}
static int
unify_csidl_path(term_t t, REFKNOWNFOLDERID csidl)
{ wchar_t buf[MAX_PATH];
if ( SHGetKnownFolderPathW(csidl, 0, NULL, csidl, buf) )
{ wchar_t *p;
for(p=buf; *p; p++)
{ if ( *p == '\\' )
*p = '/';
}
return PL_unify_wchars(t, PL_ATOM, -1, buf);
} else
return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "SHGetKnownFolderPath");
}
#else
typedef struct folderid
{ int csidl;
const char *name;
} folderid;
static const folderid folderids[] =
{ { CSIDL_COMMON_ALTSTARTUP, "common_altstartup" },
{ CSIDL_ALTSTARTUP, "altstartup" },
{ { CSIDL_ADMINTOOLS, "admintools" },
// { CSIDL_ALTSTARTUP, "altstartup" },
{ CSIDL_APPDATA, "appdata" },
{ CSIDL_CONTROLS, "controls" },
{ CSIDL_COOKIES, "cookies" },
{ CSIDL_DESKTOP, "desktop" },
{ CSIDL_COMMON_DESKTOPDIRECTORY, "common_desktopdirectory" },
{ CSIDL_DESKTOPDIRECTORY, "desktopdirectory" },
{ CSIDL_COMMON_FAVORITES, "common_favorites" },
{ CSIDL_FAVORITES, "favorites" },
{ CSIDL_FONTS, "fonts" },
{ CSIDL_HISTORY, "history" },
{ CSIDL_INTERNET_CACHE, "internet_cache" },
{ CSIDL_INTERNET, "internet" },
{ CSIDL_DRIVES, "drives" },
{ CSIDL_PERSONAL, "personal" },
{ CSIDL_NETWORK, "network" },
{ CSIDL_NETHOOD, "nethood" },
{ CSIDL_PERSONAL, "personal" },
{ CSIDL_PRINTERS, "printers" },
{ CSIDL_PRINTHOOD, "printhood" },
{ CSIDL_COMMON_ADMINTOOLS, "common_admintools" },
{ CSIDL_COMMON_APPDATA, "common_appdata" },
// { CSIDL_COMMON_DESKTOPDIRECTORY, "common_desktopdirectory" },
{ CSIDL_COMMON_DOCUMENTS, "common_documents" },
// { CSIDL_COMMON_FAVORITES, "common_favorites" },
{ CSIDL_COMMON_PROGRAMS, "common_programs" },
{ CSIDL_PROGRAMS, "programs" },
{ CSIDL_RECENT, "recent" },
{ CSIDL_BITBUCKET, "bitbucket" },
{ CSIDL_SENDTO, "sendto" },
{ CSIDL_COMMON_STARTMENU, "common_startmenu" },
{ CSIDL_STARTMENU, "startmenu" },
{ CSIDL_COMMON_STARTUP, "common_startup" },
{ CSIDL_STARTUP, "startup" },
{ CSIDL_TEMPLATES, "templates" },
// { CSIDL_COMMON_STARTMENU, "common_startmenu" },
// { CSIDL_COMMON_STARTUP, "common_startup" },
{ CSIDL_COOKIES, "cookies" },
// { CSIDL_BITBUCKET, "bitbucket" },
// { CSIDL_CONTROLS, "controls" },
// { CSIDL_DESKTOP, "desktop" },
// { CSIDL_DESKTOPDIRECTORY, "desktopdirectory" },
// { CSIDL_DRIVES, "drives" },
// { CSIDL_FAVORITES, "favorites" },
{ CSIDL_FLAG_CREATE, "flag_create" },
{ CSIDL_FLAG_DONT_VERIFY, "flag_dont_verify" },
// { CSIDL_FONTS, "fonts" },
{ CSIDL_HISTORY, "history" },
// { CSIDL_INTERNET, "internet" },
{ CSIDL_INTERNET_CACHE, "internet_cache" },
{ CSIDL_LOCAL_APPDATA, "local_appdata" },
{ CSIDL_MYPICTURES, "mypictures" },
// { CSIDL_NETHOOD, "nethood" },
// { CSIDL_NETWORK, "network" },
{ CSIDL_PERSONAL, "personal" },
// { CSIDL_PRINTERS, "printers" },
// { CSIDL_PRINTHOOD, "printhood" },
// { CSIDL_PROGRAMS, "programs" },
{ CSIDL_PROGRAM_FILES, "program_files" },
{ CSIDL_PROGRAM_FILES_COMMON, "program_files_common" },
//{ CSIDL_RECENT, "recent" },
// { CSIDL_SENDTO, "sendto" },
// { CSIDL_STARTMENU, "startmenu" },
{ CSIDL_SYSTEM, "system" },
// { CSIDL_TEMPLATES, "templates" },
{ CSIDL_WINDOWS, "windows" },
{ 0, NULL }
};
@ -890,7 +1083,11 @@ static int
unify_csidl_path(term_t t, int csidl)
{ wchar_t buf[MAX_PATH];
if ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) )
if ( SUCCEEDED(SHGetFolderPathW(NULL,
CSIDL_PERSONAL|CSIDL_FLAG_CREATE,
NULL,
0,
buf)) )
{ wchar_t *p;
for(p=buf; *p; p++)
@ -904,6 +1101,19 @@ unify_csidl_path(term_t t, int csidl)
}
#endif
/** @pred win_folder(?_KnowFolder_, -_Path_)
*
* This SWI Windows Built-in relates a Windows `known folder` with its
* corresponding file system _Path_. It can also be used to enumerate folderids/
*
* It is an interface to [SHGetKnownFolderPath](http://msdn.microsoft.com/en-us/library/windows/desktop/bb762204(v=vs.85).aspx).
* Note that in order to follow Microsoft
* documentation, YAP supports `Known Folderids` instead of special folderids,
* as used in SWI-Prolog. Also, names in YAP are obtained by removing
* the prefix `FOLDERID_`: no further processing is made to convert to lower caps.
*/
static
PRED_IMPL("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
{ GET_LD
@ -911,6 +1121,10 @@ PRED_IMPL("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
switch( CTX_CNTRL )
{ case FRG_FIRST_CALL:
#if ONLY_SUPPORT_RECENT_WINDOWS
if (!folderids)
init_folderids();
#endif
if ( PL_is_variable(A1) )
{ n = 0;
goto generate;
@ -1020,6 +1234,14 @@ reg_open_key(const wchar_t *which, int create)
#define MAXREGSTRLEN 1024
/** @pred win_registry_get_value(+_Key_, +_Name_, -_Value_)
*
* This SWI Windows Built-in consults the Windows registry for a
* subkey _Name_ of attribute _Key_ and obtains its value _Value_.
*
* It is an interface to [RegQueryValueEx](http://msdn.microsoft.com/en-us/library/windows/desktop/ms724911(v=vs.85).aspx), and it allows using the predefined
* keys such as `HKEY_LOCAL_MACHINE`.
*/
static
PRED_IMPL("win_registry_get_value", 3, win_registry_get_value, 0)
{ GET_LD
@ -1063,6 +1285,58 @@ PRED_IMPL("win_registry_get_value", 3, win_registry_get_value, 0)
return FALSE;
}
/** @pred win_registry_get_subkey(+_Key_, -_Name_)
*
* This non-deterministic Windows Built-in consults the Windows registry for all
* subkeys _Name_ of attribute _Key_. It can be used to enumerate and rebuild
* the registry.
*
* This built-in is an interface to [RegEnumKeyEx](http://msdn.microsoft.com/en-us/library/windows/desktop/ms724862(v=vs.85).aspx)
*/
static
PRED_IMPL( "win_registry_get_subkey", 2, win_registry_get_subkey, PL_FA_NONDETERMINISTIC)
{ GET_LD
int n;
DWORD SubKeys;
wchar_t data[MAXREGSTRLEN/sizeof(wchar_t)];
size_t klen;
DWORD namlen = sizeof(data)*sizeof(wchar_t);
wchar_t *k;
HKEY key;
term_t Key = A1;
term_t Name = A2;
switch( CTX_CNTRL )
{ case FRG_FIRST_CALL:
n = 0;
break;
case FRG_REDO:
n = (int)CTX_INT+1;
break;
default:
succeed;
}
if ( !PL_get_wchars(Key, &klen, &k, CVT_ATOM|CVT_EXCEPTION) )
return FALSE;
if ( !(key=reg_open_key(k, FALSE)) )
return PL_error(NULL, 0, NULL, ERR_EXISTENCE, PL_new_atom("key"), Key);
DEBUG(9, Sdprintf("key = %p, name = %s\n", key, name));
if ( RegQueryInfoKey(key, NULL, NULL, NULL, &SubKeys, NULL, NULL, NULL,NULL,NULL,NULL,NULL ) != ERROR_SUCCESS ) {
return PL_error(NULL, 0, NULL, ERR_EXISTENCE, PL_new_atom("key"), Key);
}
if ( RegEnumKeyExW( key, n, data, &namlen, NULL, NULL, NULL, NULL ) != ERROR_SUCCESS) {
return PL_error(NULL, 0, NULL, ERR_EXISTENCE, PL_new_atom("key"), Key);
}
RegCloseKey(key);
int rc = PL_unify_wchars(Name, PL_ATOM,
namlen, (wchar_t*)data);
if (rc && rc == SubKeys-1) succeed;
ForeignRedoInt(n);
}
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Get the local, global, trail and argument-stack defaults from the
@ -1124,6 +1398,7 @@ BeginPredDefs(win)
PRED_DEF("win_shell", 2, win_shell2, 0)
PRED_DEF("win_shell", 3, win_shell3, 0)
PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0)
PRED_DEF("win_registry_get_subkey", 2, win_registry_get_subkey,PL_FA_NONDETERMINISTIC)
PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
#ifdef EMULATE_DLOPEN
PRED_DEF("win_add_dll_directory", 2, win_add_dll_directory, 0)
@ -1133,3 +1408,4 @@ EndPredDefs
#endif /*__WINDOWS__*/
/** @} */

85
pl/absf.yap
View File

@ -209,6 +209,7 @@ absolute_file_name(File0,File) :-
'$check_fn_type'(prolog,_) :- !.
'$check_fn_type'(source,_) :- !.
'$check_fn_type'(executable,_) :- !.
'$check_fn_type'(exe,_) :- !.
'$check_fn_type'(qly,_) :- !.
'$check_fn_type'(directory,_) :- !.
'$check_fn_type'(T,G) :- atom(T), !,
@ -351,59 +352,14 @@ absolute_file_name(File0,File) :-
atom_concat([Path,File],PFile).
'$system_library_directories'(library, Dir) :-
getenv('YAPSHAREDIR', Dirs),
'$split_by_sep'(0, 0, Dirs, Dir).
library_directory( Dir ).
% '$split_by_sep'(0, 0, Dirs, Dir).
'$system_library_directories'(foreign, Dir) :-
getenv('YAPLIBDIR', Dirs),
'$split_by_sep'(0, 0, Dirs, Dir).
foreign_directory( Dir ).
% compatibility with old versions
% search the current directory first.
'$system_library_directories'(commons, Dir) :-
getenv('YAPCOMMONSDIR', Dirs),
'$split_by_sep'(0, 0, Dirs, Dir).
% windows has stuff installed in the registry
'$system_library_directories'(Library, Dir) :-
'$swi_current_prolog_flag'(windows, true),
( (
'$swi_current_prolog_flag'(address_bits, 64) ->
( HKEY='HKEY_LOCAL_MACHINE/Software/YAP/Prolog64';
HKEY='HKEY_CURRENT_USER/Software/YAP/Prolog64' )
;
( HKEY='HKEY_LOCAL_MACHINE/Software/YAP/Prolog';
HKEY='HKEY_CURRENT_USER/Software/YAP/Prolog' )
), % do not use once/1
% sanity check: are we running the binary mentioned in the registry?
'$system_catch'(win_registry_get_value(HKEY,'bin', Bin), prolog,_,fail) ) -> true,
'$swi_current_prolog_flag'(executable, Bin1),
same_file(Bin, Bin1),
'$system_catch'(win_registry_get_value(HKEY, Library, Dir), prolog,_,fail).
% not installed on registry
'$system_library_directories'(Library, Dir) :-
'$yap_paths'(_DLLs, ODir1, _OBinDir ),
% '$absolute_file_name'( OBinDir, BinDir ),
% '$swi_current_prolog_flag'(executable, Bin1),
% prolog_to_os_filename( Bin2, Bin1 ),
% file_directory_name( Bin2, BinDir1 ),
% same_file( BinDir, BinDir1 ),
( Library == library ->
atom_concat( ODir1, '/Yap' , ODir )
;
atom_concat( ODir1, '/PrologCommons' , ODir )
),
'$absolute_file_name'( ODir, Dir ),
exists_directory( Dir ), !.
% desperation: let's check the executable directory
'$system_library_directories'(Library, Dir) :-
'$swi_current_prolog_flag'(executable, Bin1),
prolog_to_os_filename( Bin2, Bin1 ),
file_directory_name( Bin2, Dir1 ),
( Library == library ->
atom_concat( Dir1, '../share/Yap' , Dir )
;
atom_concat( Dir1, '../share/PrologCommons' , Dir )
),
exists_directory( Dir ), !.
commons_directory( Dir ).
'$split_by_sep'(Start, Next, Dirs, Dir) :-
@ -538,7 +494,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
`library( _File_ )` are searched by the predicates consult/1,
reconsult/1, use_module/1, ensure_loaded/1, and load_files/2.
This directory is initialized through the system predicate
This directory is initialized s a rule that calls the system predicate
library_directories/2.
*/
@ -547,14 +503,14 @@ remove_from_path(New) :- '$check_path'(New,Path),
:- dynamic user:library_directory/1.
user:library_directory( Path ):-
library_directories( Path, _ ).
system_library( Path ).
/**
@pred user:commons_directory(? _Directory_:atom) is nondet, dynamic
State the location of the Commons Prolog Initiative.
This directory is initialized through the system predicate
This directory is initialized as a rule that calls the system predicate
library_directories/2.
*/
@ -563,7 +519,23 @@ user:library_directory( Path ):-
:- dynamic user:commons_directory/1.
user:commons_directory( Path ):-
library_directories( _, Path ).
system_commons( Path ).
/**
@pred user:foreign_directory(? _Directory_:atom) is nondet, dynamic
State the location of the Foreign Prolog Initiative.
This directory is initialized as a rule that calls the system predicate
library_directories/2.
*/
:- multifile user:foreign_directory/1.
:- dynamic user:foreign_directory/1.
user:foreign_directory( Path ):-
system_foreign( Path ).
/**
@pred user:prolog_file_type(?Suffix:atom, ?Handler:atom) is nondet, dynamic
@ -600,7 +572,7 @@ user:prolog_file_type(prolog, prolog).
user:prolog_file_type(A, prolog) :-
current_prolog_flag(associate, A),
A \== prolog,
A \==pl,
A \== pl,
A \== yap.
user:prolog_file_type(qly, qly).
user:prolog_file_type(A, executable) :-
@ -622,9 +594,10 @@ file_search_path(swi, Home) :-
current_prolog_flag(home, Home).
file_search_path(yap, Home) :-
current_prolog_flag(home, Home).
file_search_path(system, Dir) :-
file_search_path,(system, Dir) :-
prolog_flag(host_type, Dir).
file_search_path(foreign, yap('lib/Yap')).
file_search_path(foreign, Dir) :-
foreign_directory(Dir).
file_search_path(path, C) :-
( getenv('PATH', A),
( current_prolog_flag(windows, true)

10
pl/boot.yap
View File

@ -389,16 +389,6 @@ true :- true.
\+ '$undefined'('$init_preds',prolog),
'$init_preds',
fail.
'$init_consult' :-
retractall(user:library_directory(_)),
'$system_library_directories'(library, D),
assert(user:library_directory(D)),
fail.
'$init_consult' :-
retractall(user:commons_directory(_)),
'$system_library_directories'(commons, D),
assert(user:commons_directory(D)),
fail.
'$init_consult'.
'$init_win_graphics' :-

14
pl/qly.yap
View File

@ -321,20 +321,6 @@ save_program(File, _Goal) :-
P \= [],
set_value('$extend_file_search_path',[]),
'$extend_file_search_path'(P).
'$init_path_extensions' :-
retractall(user:library_directory(_)),
% make sure library_directory is open.
\+ clause(user:library_directory(_),_),
'$system_library_directories'(library,D),
assert(user:library_directory(D)),
fail.
'$init_path_extensions' :-
retractall(user:library_directory(_)),
% make sure library_directory is open.
\+ clause(user:library_directory(_),_),
'$system_library_directories'(commons,D),
assert(user:commons_directory(D)),
fail.
'$init_path_extensions'.
% then we can execute the programs.

2
swi/console/console.c
View File

@ -738,7 +738,7 @@ static HKEY
rlc_option_key(rlc_console_attr *attr, int create)
{ TCHAR Prog[256];
TCHAR *address[] = { _T("Software"),
RLC_VENDOR,
_T(RLC_VENDOR),
Prog,
_T("Console"),
(TCHAR *)attr->key, /* possible secondary key */

2
swi/console/console.h
View File

@ -27,7 +27,7 @@
#ifndef RLC_VENDOR
#ifdef __YAP_PROLOG__
#define RLC_VENDOR _T("YAP")
#define RLC_VENDOR TEXT("YAP")
#else
#define RLC_VENDOR TEXT("SWI")
#endif