Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3
This commit is contained in:
Vítor Santos Costa
commit
0ad02c3ee1
@ -521,6 +521,7 @@ X_API int STD_PROTO(YAP_Erase,(void *));
|
||||
X_API int STD_PROTO(YAP_Variant,(Term, Term));
|
||||
X_API int STD_PROTO(YAP_ExactlyEqual,(Term, Term));
|
||||
X_API Int STD_PROTO(YAP_TermHash,(Term, Int, Int, int));
|
||||
X_API void STD_PROTO(YAP_signal,(int));
|
||||
X_API int STD_PROTO(YAP_SetYAPFlag,(yap_flag_t, int));
|
||||
|
||||
static int (*do_getf)(void);
|
||||
@ -3246,6 +3247,11 @@ YAP_SlotsToArgs(int n, Int slot)
|
||||
}
|
||||
}
|
||||
|
||||
X_API void
|
||||
YAP_signal(int sig)
|
||||
{
|
||||
Yap_signal(sig);
|
||||
}
|
||||
|
||||
X_API int
|
||||
YAP_SetYAPFlag(yap_flag_t flag, int val)
|
||||
|
||||
30
Makefile.in
30
Makefile.in
@ -236,6 +236,12 @@ C_SOURCES= \
|
||||
$(srcdir)/MYDDAS/myddas_top_level.c \
|
||||
$(srcdir)/MYDDAS/myddas_wkb2prolog.c
|
||||
|
||||
PLCONS_SOURCES = \
|
||||
$(srcdir)/console/LGPL/pl-nt.c \
|
||||
$(srcdir)/console/LGPL/pl-ntcon.c \
|
||||
$(srcdir)/console/LGPL/pl-ntconsole.c \
|
||||
$(srcdir)/console/LGPL/pl-ntmain.c
|
||||
|
||||
PL_SOURCES= \
|
||||
$(srcdir)/pl/arith.yap \
|
||||
$(srcdir)/pl/arrays.yap \
|
||||
@ -318,7 +324,11 @@ LIB_OBJECTS = $(ENGINE_OBJECTS) $(C_INTERFACE_OBJECTS) $(OR_OBJECTS) $(BEAM_OBJE
|
||||
|
||||
OBJECTS = yap.o $(LIB_OBJECTS)
|
||||
|
||||
|
||||
PLCONS_OBJECTS = \
|
||||
pl-nt.o \
|
||||
pl-ntcon.o \
|
||||
pl-ntconsole.o \
|
||||
pl-ntmain.o
|
||||
|
||||
all: parms.h startup.yss
|
||||
|
||||
@ -483,6 +493,18 @@ regfree.o: $(srcdir)/library/regex/regfree.c $(srcdir)/library/regex/regex2.h co
|
||||
regexec.o: $(srcdir)/library/regex/regexec.c config.h
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/library/regex $(srcdir)/library/regex/regexec.c -o regexec.o
|
||||
|
||||
pl-nt.o: $(srcdir)/console/LGPL/pl-nt.c config.h
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/packages/PLStream $(srcdir)/console/LGPL/pl-nt.c -o $@
|
||||
|
||||
pl-ntcon.o: $(srcdir)/console/LGPL/pl-ntcon.c config.h
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include $(srcdir)/console/LGPL/pl-ntcon.c -o $@
|
||||
|
||||
pl-ntconsole.o: $(srcdir)/console/LGPL/pl-ntconsole.c config.h
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir) -I$(srcdir)/include -I$(srcdir)/packages/PLStream $(srcdir)/console/LGPL/pl-ntconsole.c -o $@
|
||||
|
||||
pl-ntmain.o: $(srcdir)/console/LGPL/pl-ntmain.c config.h
|
||||
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir) -I$(srcdir)/packages/PLStream $(srcdir)/console/LGPL/pl-ntmain.c -o $@
|
||||
|
||||
# default rule
|
||||
%.o : $(srcdir)/C/%.c config.h
|
||||
$(CC) -c $(CFLAGS) $< -o $@
|
||||
@ -511,6 +533,7 @@ all: startup.yss
|
||||
@INSTALL_DLLS@ (cd library/random; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd library/regex; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd library/rltree; $(MAKE))
|
||||
@ENABLE_WINCONSOLE@ (cd LGPL/swi_console; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd library/system; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd library/tries; $(MAKE))
|
||||
@INSTALL_DLLS@ (cd packages/clib; $(MAKE))
|
||||
@ -534,6 +557,10 @@ startup.yss: yap@EXEC_SUFFIX@ $(PL_SOURCES)
|
||||
yap@EXEC_SUFFIX@: $(HEADERS) yap.o @YAPLIB@
|
||||
$(MPI_CC) $(EXECUTABLE_CFLAGS) $(LDFLAGS) -o yap yap.o @YAPLIB@ $(LIBS) @MPI_LIBS@
|
||||
|
||||
pl-yap@EXEC_SUFFIX@: $(PLCONS_OBJECTS) LGPL/swi_console/plterm.dll packages/PLSTream/libplstream.dll
|
||||
(cd LGPL/swi_console; $(MAKE))
|
||||
$(MPI_CC) $(EXECUTABLE_CFLAGS) $(LDFLAGS) -o pl-yap $(PLCONS_OBJECTS) LGPL/swi_console/plterm.dll packages/PLSTream/libplstream.dll @YAPLIB@ $(LIBS) @MPI_LIBS@
|
||||
|
||||
libYap.a: $(LIB_OBJECTS)
|
||||
-rm -f libYap.a
|
||||
$(AR) rc libYap.a $(LIB_OBJECTS)
|
||||
@ -673,6 +700,7 @@ clean: clean_docs
|
||||
@INSTALL_DLLS@ (cd library/random; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd library/regex; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd library/rltree; $(MAKE) clean)
|
||||
@ENABLE_WINCONSOLE@ (cd LGPL/swi_console; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd library/system; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd library/tries; $(MAKE) clean)
|
||||
@INSTALL_DLLS@ (cd packages/clib; $(MAKE) clean)
|
||||
|
||||
959
console/LGPL/pl-nt.c
Executable file
959
console/LGPL/pl-nt.c
Executable file
@ -0,0 +1,959 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: jan@swi.psy.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2002, University of Amsterdam
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Lesser General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2.1 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Lesser General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
#ifdef _YAP_NOT_INSTALLED_
|
||||
#define __WINDOWS__ 1
|
||||
#endif
|
||||
|
||||
#ifdef __WINDOWS__
|
||||
#define _WIN32_WINNT 0x0400
|
||||
#if (_MSC_VER >= 1300)
|
||||
#include <winsock2.h> /* Needed on VC8 */
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <windows.h> /* Needed for MSVC 5&6 */
|
||||
#include <winsock2.h>
|
||||
#endif
|
||||
|
||||
#include "pl-incl.h"
|
||||
#include "pl-utf8.h"
|
||||
#include <crtdbg.h>
|
||||
#include <process.h>
|
||||
#include "pl-ctype.h"
|
||||
#include <stdio.h>
|
||||
#include <stdarg.h>
|
||||
#include "SWI-Stream.h"
|
||||
#include <process.h>
|
||||
#include <winbase.h>
|
||||
|
||||
|
||||
/*******************************
|
||||
* CONSOLE *
|
||||
*******************************/
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
There is no way to tell which subsystem an app belongs too, except for
|
||||
peeking in its executable-header. This is a bit too much ...
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
int
|
||||
hasConsole(void)
|
||||
{ HANDLE h;
|
||||
|
||||
if ( GD->os.gui_app == FALSE ) /* has been set explicitly */
|
||||
succeed;
|
||||
|
||||
/* I found a console */
|
||||
if ( (h = GetStdHandle(STD_OUTPUT_HANDLE)) != INVALID_HANDLE_VALUE )
|
||||
{ DWORD mode;
|
||||
|
||||
if ( GetConsoleMode(h, &mode) )
|
||||
succeed;
|
||||
}
|
||||
|
||||
/* assume we are GUI */
|
||||
fail;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
PL_wait_for_console_input(void *handle)
|
||||
{ BOOL rc;
|
||||
HANDLE hConsole = handle;
|
||||
|
||||
for(;;)
|
||||
{ rc = MsgWaitForMultipleObjects(1,
|
||||
&hConsole,
|
||||
FALSE, /* wait for either event */
|
||||
INFINITE,
|
||||
QS_ALLINPUT);
|
||||
|
||||
if ( rc == WAIT_OBJECT_0+1 )
|
||||
{ MSG msg;
|
||||
|
||||
while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
|
||||
{ TranslateMessage(&msg);
|
||||
DispatchMessage(&msg);
|
||||
}
|
||||
} else if ( rc == WAIT_OBJECT_0 )
|
||||
{ return TRUE;
|
||||
} else
|
||||
{ Sdprintf("MsgWaitForMultipleObjects(): 0x%x\n", rc);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*******************************
|
||||
* MESSAGE BOX *
|
||||
*******************************/
|
||||
|
||||
void
|
||||
PlMessage(const char *fm, ...)
|
||||
{ va_list(args);
|
||||
|
||||
va_start(args, fm);
|
||||
|
||||
if ( hasConsole() )
|
||||
{ Sfprintf(Serror, "SWI-Prolog: ");
|
||||
Svfprintf(Serror, fm, args);
|
||||
Sfprintf(Serror, "\n");
|
||||
} else
|
||||
{ char buf[1024];
|
||||
|
||||
vsprintf(buf, fm, args);
|
||||
MessageBox(NULL, buf, "SWI-Prolog", MB_OK|MB_TASKMODAL);
|
||||
}
|
||||
|
||||
va_end(args);
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*******************************
|
||||
* WinAPI ERROR CODES *
|
||||
*******************************/
|
||||
|
||||
char *
|
||||
WinError()
|
||||
{ int id = GetLastError();
|
||||
char *msg;
|
||||
static WORD lang;
|
||||
static int lang_initialised = 0;
|
||||
|
||||
if ( !lang_initialised )
|
||||
lang = MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_UK);
|
||||
|
||||
again:
|
||||
if ( FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
|
||||
FORMAT_MESSAGE_IGNORE_INSERTS|
|
||||
FORMAT_MESSAGE_FROM_SYSTEM,
|
||||
NULL, /* source */
|
||||
id, /* identifier */
|
||||
lang,
|
||||
(LPTSTR) &msg,
|
||||
0, /* size */
|
||||
NULL) ) /* arguments */
|
||||
{ atom_t a = PL_new_atom(msg);
|
||||
|
||||
LocalFree(msg);
|
||||
lang_initialised = 1;
|
||||
|
||||
return stringAtom(a);
|
||||
} else
|
||||
{ if ( lang_initialised == 0 )
|
||||
{ lang = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
|
||||
lang_initialised = 1;
|
||||
goto again;
|
||||
}
|
||||
|
||||
return "Unknown Windows error";
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*******************************
|
||||
* SLEEP/1 SUPPORT *
|
||||
*******************************/
|
||||
|
||||
int
|
||||
Pause(double t)
|
||||
{ HANDLE h;
|
||||
|
||||
if ( (h = CreateWaitableTimer(NULL, TRUE, NULL)) )
|
||||
{ LARGE_INTEGER ft;
|
||||
|
||||
ft.QuadPart = -(LONGLONG)(t * 10000000.0); /* 100 nanosecs per tick */
|
||||
|
||||
SetWaitableTimer(h, &ft, 0, NULL, NULL, FALSE);
|
||||
for(;;)
|
||||
{ int rc = MsgWaitForMultipleObjects(1,
|
||||
&h,
|
||||
FALSE,
|
||||
INFINITE,
|
||||
QS_ALLINPUT);
|
||||
if ( rc == WAIT_OBJECT_0+1 )
|
||||
{ MSG msg;
|
||||
|
||||
while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
|
||||
{ TranslateMessage(&msg);
|
||||
DispatchMessage(&msg);
|
||||
}
|
||||
|
||||
if ( PL_handle_signals() < 0 )
|
||||
{ CloseHandle(h);
|
||||
return FALSE;
|
||||
}
|
||||
} else
|
||||
break;
|
||||
}
|
||||
CloseHandle(h);
|
||||
|
||||
return TRUE;
|
||||
} else /* Pre NT implementation */
|
||||
{ DWORD msecs = (DWORD)(t * 1000.0);
|
||||
|
||||
while( msecs >= 100 )
|
||||
{ Sleep(100);
|
||||
if ( PL_handle_signals() < 0 )
|
||||
return FALSE;
|
||||
msecs -= 100;
|
||||
}
|
||||
if ( msecs > 0 )
|
||||
Sleep(msecs);
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*******************************
|
||||
* SET FILE SIZE *
|
||||
*******************************/
|
||||
|
||||
int
|
||||
ftruncate(int fileno, int64_t length)
|
||||
{ errno_t e;
|
||||
|
||||
if ( (e=_chsize_s(fileno, length)) == 0 )
|
||||
return 0;
|
||||
|
||||
errno = e;
|
||||
return -1;
|
||||
}
|
||||
|
||||
|
||||
#ifndef _YAP_NOT_INSTALLED_
|
||||
/*******************************
|
||||
* QUERY CPU TIME *
|
||||
*******************************/
|
||||
|
||||
#define nano * 0.0000001
|
||||
#define ntick 1.0 /* manual says 100.0 ??? */
|
||||
|
||||
double
|
||||
CpuTime(cputime_kind which)
|
||||
{ double t;
|
||||
HANDLE proc = GetCurrentProcess();
|
||||
FILETIME created, exited, kerneltime, usertime;
|
||||
|
||||
if ( GetProcessTimes(proc, &created, &exited, &kerneltime, &usertime) )
|
||||
{ FILETIME *p;
|
||||
|
||||
switch ( which )
|
||||
{ case CPU_USER:
|
||||
p = &usertime;
|
||||
break;
|
||||
case CPU_SYSTEM:
|
||||
p = &kerneltime;
|
||||
break;
|
||||
}
|
||||
t = (double)p->dwHighDateTime * (4294967296.0 * ntick nano);
|
||||
t += (double)p->dwLowDateTime * (ntick nano);
|
||||
} else /* '95, Windows 3.1/win32s */
|
||||
{ extern intptr_t clock_wait_ticks;
|
||||
|
||||
t = (double) (clock() - clock_wait_ticks) / (double) CLOCKS_PER_SEC;
|
||||
}
|
||||
|
||||
return t;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
static int
|
||||
CpuCount()
|
||||
{ SYSTEM_INFO si;
|
||||
|
||||
GetSystemInfo(&si);
|
||||
|
||||
return si.dwNumberOfProcessors;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
setOSPrologFlags()
|
||||
{ PL_set_prolog_flag("cpu_count", PL_INTEGER, CpuCount());
|
||||
}
|
||||
|
||||
|
||||
char *
|
||||
findExecutable(const char *module, char *exe)
|
||||
{ int n;
|
||||
wchar_t wbuf[MAXPATHLEN];
|
||||
HMODULE hmod;
|
||||
|
||||
if ( module )
|
||||
{ if ( !(hmod = GetModuleHandle(module)) )
|
||||
{ hmod = GetModuleHandle("libpl.dll");
|
||||
DEBUG(0,
|
||||
Sdprintf("Warning: could not find module from \"%s\"\n"
|
||||
"Warning: Trying %s to find home\n",
|
||||
module,
|
||||
hmod ? "\"LIBPL.DLL\"" : "executable"));
|
||||
}
|
||||
} else
|
||||
hmod = NULL;
|
||||
|
||||
if ( (n = GetModuleFileNameW(hmod, wbuf, MAXPATHLEN)) > 0 )
|
||||
{ wbuf[n] = EOS;
|
||||
return _xos_long_file_name_toA(wbuf, exe, MAXPATHLEN);
|
||||
} else if ( module )
|
||||
{ char buf[MAXPATHLEN];
|
||||
PrologPath(module, buf, sizeof(buf));
|
||||
|
||||
strcpy(exe, buf);
|
||||
} else
|
||||
*exe = EOS;
|
||||
|
||||
return exe;
|
||||
}
|
||||
|
||||
/*******************************
|
||||
* SUPPORT FOR SHELL/2 *
|
||||
*******************************/
|
||||
|
||||
typedef struct
|
||||
{ const char *name;
|
||||
int id;
|
||||
} showtype;
|
||||
|
||||
static int
|
||||
get_showCmd(term_t show, int *cmd)
|
||||
{ char *s;
|
||||
showtype *st;
|
||||
static showtype types[] =
|
||||
{ { "hide", SW_HIDE },
|
||||
{ "maximize", SW_MAXIMIZE },
|
||||
{ "minimize", SW_MINIMIZE },
|
||||
{ "restore", SW_RESTORE },
|
||||
{ "show", SW_SHOW },
|
||||
{ "showdefault", SW_SHOWDEFAULT },
|
||||
{ "showmaximized", SW_SHOWMAXIMIZED },
|
||||
{ "showminimized", SW_SHOWMINIMIZED },
|
||||
{ "showminnoactive", SW_SHOWMINNOACTIVE },
|
||||
{ "showna", SW_SHOWNA },
|
||||
{ "shownoactive", SW_SHOWNOACTIVATE },
|
||||
{ "shownormal", SW_SHOWNORMAL },
|
||||
/* compatibility */
|
||||
{ "normal", SW_SHOWNORMAL },
|
||||
{ "iconic", SW_MINIMIZE },
|
||||
{ NULL, 0 },
|
||||
};
|
||||
|
||||
if ( show == 0 )
|
||||
{ *cmd = SW_SHOWNORMAL;
|
||||
succeed;
|
||||
}
|
||||
|
||||
if ( !PL_get_chars_ex(show, &s, CVT_ATOM) )
|
||||
fail;
|
||||
for(st=types; st->name; st++)
|
||||
{ if ( streq(st->name, s) )
|
||||
{ *cmd = st->id;
|
||||
succeed;
|
||||
}
|
||||
}
|
||||
|
||||
return PL_error(NULL, 0, NULL, ERR_DOMAIN,
|
||||
PL_new_atom("win_show"), show);
|
||||
}
|
||||
|
||||
|
||||
|
||||
static int
|
||||
win_exec(size_t len, const wchar_t *cmd, UINT show)
|
||||
{ GET_LD
|
||||
STARTUPINFOW startup;
|
||||
PROCESS_INFORMATION info;
|
||||
int rval;
|
||||
wchar_t *wcmd;
|
||||
|
||||
memset(&startup, 0, sizeof(startup));
|
||||
startup.cb = sizeof(startup);
|
||||
startup.wShowWindow = show;
|
||||
|
||||
/* ensure 0-terminated */
|
||||
wcmd = PL_malloc((len+1)*sizeof(wchar_t));
|
||||
memcpy(wcmd, cmd, len*sizeof(wchar_t));
|
||||
wcmd[len] = 0;
|
||||
|
||||
rval = CreateProcessW(NULL, /* app */
|
||||
wcmd,
|
||||
NULL, NULL, /* security */
|
||||
FALSE, /* inherit handles */
|
||||
0, /* flags */
|
||||
NULL, /* environment */
|
||||
NULL, /* Directory */
|
||||
&startup,
|
||||
&info); /* process info */
|
||||
PL_free(wcmd);
|
||||
|
||||
if ( rval )
|
||||
{ CloseHandle(info.hProcess);
|
||||
CloseHandle(info.hThread);
|
||||
|
||||
succeed;
|
||||
} else
|
||||
{ term_t tmp = PL_new_term_ref();
|
||||
|
||||
PL_unify_wchars(tmp, PL_ATOM, len, cmd);
|
||||
return PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
utf8towcs(wchar_t *o, const char *src)
|
||||
{ for( ; *src; )
|
||||
{ int wc;
|
||||
|
||||
src = utf8_get_char(src, &wc);
|
||||
*o++ = wc;
|
||||
}
|
||||
*o = 0;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
System(char *command) /* command is a UTF-8 string */
|
||||
{ STARTUPINFOW sinfo;
|
||||
PROCESS_INFORMATION pinfo;
|
||||
int shell_rval;
|
||||
size_t len;
|
||||
wchar_t *wcmd;
|
||||
|
||||
memset(&sinfo, 0, sizeof(sinfo));
|
||||
sinfo.cb = sizeof(sinfo);
|
||||
|
||||
len = utf8_strlen(command, strlen(command));
|
||||
wcmd = PL_malloc((len+1)*sizeof(wchar_t));
|
||||
utf8towcs(wcmd, command);
|
||||
|
||||
if ( CreateProcessW(NULL, /* module */
|
||||
wcmd, /* command line */
|
||||
NULL, /* Security stuff */
|
||||
NULL, /* Thread security stuff */
|
||||
FALSE, /* Inherit handles */
|
||||
CREATE_NO_WINDOW, /* flags */
|
||||
NULL, /* environment */
|
||||
NULL, /* CWD */
|
||||
&sinfo, /* startup info */
|
||||
&pinfo) ) /* process into */
|
||||
{ BOOL rval;
|
||||
DWORD code;
|
||||
|
||||
CloseHandle(pinfo.hThread); /* don't need this */
|
||||
PL_free(wcmd);
|
||||
|
||||
do
|
||||
{ MSG msg;
|
||||
|
||||
if ( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
|
||||
{ TranslateMessage(&msg);
|
||||
DispatchMessage(&msg);
|
||||
} else
|
||||
Sleep(50);
|
||||
|
||||
rval = GetExitCodeProcess(pinfo.hProcess, &code);
|
||||
} while(rval == TRUE && code == STILL_ACTIVE);
|
||||
|
||||
shell_rval = (rval == TRUE ? code : -1);
|
||||
CloseHandle(pinfo.hProcess);
|
||||
} else
|
||||
{ PL_free(wcmd);
|
||||
return shell_rval = -1;
|
||||
}
|
||||
|
||||
return shell_rval;
|
||||
}
|
||||
|
||||
|
||||
word
|
||||
pl_win_exec(term_t cmd, term_t how)
|
||||
{ wchar_t *s;
|
||||
size_t len;
|
||||
UINT h;
|
||||
|
||||
if ( PL_get_wchars(cmd, &len, &s, CVT_ALL|CVT_EXCEPTION) &&
|
||||
get_showCmd(how, &h) )
|
||||
{ return win_exec(len, s, h);
|
||||
} else
|
||||
fail;
|
||||
}
|
||||
|
||||
typedef struct
|
||||
{ int eno;
|
||||
const char *message;
|
||||
} shell_error;
|
||||
|
||||
static const shell_error se_errors[] =
|
||||
{ { 0 , "Out of memory or resources" },
|
||||
{ ERROR_FILE_NOT_FOUND, "File not found" },
|
||||
{ ERROR_PATH_NOT_FOUND, "path not found" },
|
||||
{ ERROR_BAD_FORMAT, "Invalid .EXE" },
|
||||
{ SE_ERR_ACCESSDENIED, "Access denied" },
|
||||
{ SE_ERR_ASSOCINCOMPLETE, "Incomplete association" },
|
||||
{ SE_ERR_DDEBUSY, "DDE server busy" },
|
||||
{ SE_ERR_DDEFAIL, "DDE transaction failed" },
|
||||
{ SE_ERR_DDETIMEOUT, "DDE request timed out" },
|
||||
{ SE_ERR_DLLNOTFOUND, "DLL not found" },
|
||||
{ SE_ERR_FNF, "File not found (FNF)" },
|
||||
{ SE_ERR_NOASSOC, "No association" },
|
||||
{ SE_ERR_OOM, "Not enough memory" },
|
||||
{ SE_ERR_PNF, "Path not found (PNF)" },
|
||||
{ SE_ERR_SHARE, "Sharing violation" },
|
||||
{ 0, NULL }
|
||||
};
|
||||
|
||||
|
||||
static int
|
||||
win_shell(term_t op, term_t file, term_t how)
|
||||
{ size_t lo, lf;
|
||||
wchar_t *o, *f;
|
||||
UINT h;
|
||||
HINSTANCE instance;
|
||||
|
||||
if ( !PL_get_wchars(op, &lo, &o, CVT_ALL|CVT_EXCEPTION|BUF_RING) ||
|
||||
!PL_get_wchars(file, &lf, &f, CVT_ALL|CVT_EXCEPTION|BUF_RING) ||
|
||||
!get_showCmd(how, &h) )
|
||||
fail;
|
||||
|
||||
instance = ShellExecuteW(NULL, o, f, NULL, NULL, h);
|
||||
|
||||
if ( (intptr_t)instance <= 32 )
|
||||
{ const shell_error *se;
|
||||
|
||||
for(se = se_errors; se->message; se++)
|
||||
{ if ( se->eno == (int)instance )
|
||||
return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file);
|
||||
}
|
||||
PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file);
|
||||
}
|
||||
|
||||
succeed;
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
PRED_IMPL("win_shell", 2, win_shell2, 0)
|
||||
{ return win_shell(A1, A2, 0);
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
PRED_IMPL("win_shell", 3, win_shell3, 0)
|
||||
{ return win_shell(A1, A2, A3);
|
||||
}
|
||||
|
||||
|
||||
foreign_t
|
||||
pl_win_module_file(term_t module, term_t file)
|
||||
{ char buf[MAXPATHLEN];
|
||||
char *m;
|
||||
char *f;
|
||||
|
||||
if ( !PL_get_chars_ex(module, &m, CVT_ALL) )
|
||||
fail;
|
||||
if ( (f = findExecutable(m, buf)) )
|
||||
return PL_unify_atom_chars(file, f);
|
||||
|
||||
fail;
|
||||
}
|
||||
|
||||
/*******************************
|
||||
* WINDOWS MESSAGES *
|
||||
*******************************/
|
||||
|
||||
LRESULT
|
||||
PL_win_message_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)
|
||||
{
|
||||
#ifdef O_PLMT
|
||||
if ( hwnd == NULL &&
|
||||
message == WM_SIGNALLED &&
|
||||
wParam == 0 && /* or another constant? */
|
||||
lParam == 0 )
|
||||
{ if ( PL_handle_signals() < 0 )
|
||||
return PL_MSG_EXCEPTION_RAISED;
|
||||
|
||||
return PL_MSG_HANDLED;
|
||||
}
|
||||
#endif
|
||||
|
||||
return PL_MSG_IGNORED;
|
||||
}
|
||||
|
||||
|
||||
/*******************************
|
||||
* DLOPEN AND FRIENDS *
|
||||
*******************************/
|
||||
|
||||
#ifdef EMULATE_DLOPEN
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
These functions emulate the bits from the ELF shared object interface we
|
||||
need. They are used by pl-load.c, which defines the actual Prolog
|
||||
interface.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
static char *dlmsg;
|
||||
|
||||
void *
|
||||
dlopen(const char *file, int flags) /* file is in UTF-8 */
|
||||
{ HINSTANCE h;
|
||||
size_t len = utf8_strlen(file, strlen(file));
|
||||
wchar_t *wfile = alloca((len+1)*sizeof(wchar_t));
|
||||
|
||||
if ( !wfile )
|
||||
{ dlmsg = "No memory";
|
||||
return NULL;
|
||||
}
|
||||
|
||||
utf8towcs(wfile, file);
|
||||
|
||||
if ( (h = LoadLibraryW(wfile)) )
|
||||
{ dlmsg = "No Error";
|
||||
return (void *)h;
|
||||
}
|
||||
|
||||
dlmsg = WinError();
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
const char *
|
||||
dlerror()
|
||||
{ return dlmsg;
|
||||
}
|
||||
|
||||
|
||||
void *
|
||||
dlsym(void *handle, char *symbol)
|
||||
{ void *addr = GetProcAddress(handle, symbol);
|
||||
|
||||
if ( addr )
|
||||
{ dlmsg = "No Error";
|
||||
return addr;
|
||||
}
|
||||
|
||||
dlmsg = WinError();
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
dlclose(void *handle)
|
||||
{ FreeLibrary(handle);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
#endif /*EMULATE_DLOPEN*/
|
||||
|
||||
|
||||
/*******************************
|
||||
* FOLDERS *
|
||||
*******************************/
|
||||
|
||||
#include <Shlobj.h>
|
||||
|
||||
typedef struct folderid
|
||||
{ int csidl;
|
||||
const char *name;
|
||||
} folderid;
|
||||
|
||||
static const folderid folderids[] =
|
||||
{ { CSIDL_COMMON_ALTSTARTUP, "common_altstartup" },
|
||||
{ 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_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" },
|
||||
{ 0, NULL }
|
||||
};
|
||||
|
||||
|
||||
static int
|
||||
unify_csidl_path(term_t t, int csidl)
|
||||
{ wchar_t buf[MAX_PATH];
|
||||
|
||||
if ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) )
|
||||
{ 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, "SHGetSpecialFolderPath");
|
||||
}
|
||||
|
||||
|
||||
static
|
||||
PRED_IMPL("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
|
||||
{ GET_LD
|
||||
int n;
|
||||
|
||||
switch( CTX_CNTRL )
|
||||
{ case FRG_FIRST_CALL:
|
||||
if ( PL_is_variable(A1) )
|
||||
{ n = 0;
|
||||
goto generate;
|
||||
} else
|
||||
{ char *s;
|
||||
|
||||
if ( PL_get_chars(A1, &s, CVT_ATOM|CVT_EXCEPTION) )
|
||||
{ const folderid *fid;
|
||||
|
||||
for(fid = folderids; fid->name; fid++)
|
||||
{ if ( streq(s, fid->name) )
|
||||
return unify_csidl_path(A2, fid->csidl);
|
||||
}
|
||||
|
||||
{ atom_t dom = PL_new_atom("win_folder");
|
||||
|
||||
PL_error(NULL, 0, NULL, ERR_DOMAIN, dom, A1);
|
||||
PL_unregister_atom(dom);
|
||||
return FALSE;
|
||||
}
|
||||
} else
|
||||
return FALSE;
|
||||
}
|
||||
case FRG_REDO:
|
||||
{ fid_t fid;
|
||||
|
||||
n = (int)CTX_INT+1;
|
||||
|
||||
generate:
|
||||
fid = PL_open_foreign_frame();
|
||||
for(; folderids[n].name; n++)
|
||||
{ if ( unify_csidl_path(A2, folderids[n].csidl) &&
|
||||
PL_unify_atom_chars(A1, folderids[n].name) )
|
||||
{ PL_close_foreign_frame(fid);
|
||||
ForeignRedoInt(n);
|
||||
}
|
||||
PL_rewind_foreign_frame(fid);
|
||||
}
|
||||
PL_close_foreign_frame(fid);
|
||||
return FALSE;
|
||||
}
|
||||
default:
|
||||
succeed;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
/*******************************
|
||||
* REGISTRY *
|
||||
*******************************/
|
||||
|
||||
#define wstreq(s,q) (wcscmp((s), (q)) == 0)
|
||||
|
||||
static HKEY
|
||||
reg_open_key(const wchar_t *which, int create)
|
||||
{ HKEY key = HKEY_CURRENT_USER;
|
||||
DWORD disp;
|
||||
LONG rval;
|
||||
|
||||
while(*which)
|
||||
{ wchar_t buf[256];
|
||||
wchar_t *s;
|
||||
HKEY tmp;
|
||||
|
||||
for(s=buf; *which && !(*which == '/' || *which == '\\'); )
|
||||
*s++ = *which++;
|
||||
*s = '\0';
|
||||
if ( *which )
|
||||
which++;
|
||||
|
||||
if ( wstreq(buf, L"HKEY_CLASSES_ROOT") )
|
||||
{ key = HKEY_CLASSES_ROOT;
|
||||
continue;
|
||||
} else if ( wstreq(buf, L"HKEY_CURRENT_USER") )
|
||||
{ key = HKEY_CURRENT_USER;
|
||||
continue;
|
||||
} else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") )
|
||||
{ key = HKEY_LOCAL_MACHINE;
|
||||
continue;
|
||||
} else if ( wstreq(buf, L"HKEY_USERS") )
|
||||
{ key = HKEY_USERS;
|
||||
continue;
|
||||
}
|
||||
|
||||
DEBUG(2, Sdprintf("Trying %s\n", buf));
|
||||
if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS )
|
||||
{ RegCloseKey(key);
|
||||
key = tmp;
|
||||
continue;
|
||||
}
|
||||
|
||||
if ( !create )
|
||||
return NULL;
|
||||
|
||||
rval = RegCreateKeyExW(key, buf, 0, L"", 0,
|
||||
KEY_ALL_ACCESS, NULL, &tmp, &disp);
|
||||
RegCloseKey(key);
|
||||
if ( rval == ERROR_SUCCESS )
|
||||
key = tmp;
|
||||
else
|
||||
return NULL;
|
||||
}
|
||||
|
||||
return key;
|
||||
}
|
||||
|
||||
#define MAXREGSTRLEN 1024
|
||||
|
||||
static
|
||||
PRED_IMPL("win_registry_get_value", 3, win_registry_get_value, 0)
|
||||
{ GET_LD
|
||||
DWORD type;
|
||||
BYTE data[MAXREGSTRLEN];
|
||||
DWORD len = sizeof(data);
|
||||
size_t klen, namlen;
|
||||
wchar_t *k, *name;
|
||||
HKEY key;
|
||||
|
||||
term_t Key = A1;
|
||||
term_t Name = A2;
|
||||
term_t Value = A3;
|
||||
|
||||
if ( !PL_get_wchars(Key, &klen, &k, CVT_ATOM|CVT_EXCEPTION) ||
|
||||
!PL_get_wchars(Name, &namlen, &name, CVT_ATOM|CVT_ATOM) )
|
||||
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 ( RegQueryValueExW(key, name, NULL, &type, data, &len) == ERROR_SUCCESS )
|
||||
{ RegCloseKey(key);
|
||||
|
||||
switch(type)
|
||||
{ case REG_SZ:
|
||||
return PL_unify_wchars(Value, PL_ATOM,
|
||||
len/sizeof(wchar_t)-1, (wchar_t*)data);
|
||||
case REG_DWORD:
|
||||
return PL_unify_integer(Value, *((DWORD *)data));
|
||||
default:
|
||||
warning("get_registry_value/2: Unknown registery-type: %d", type);
|
||||
fail;
|
||||
}
|
||||
}
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Get the local, global, trail and argument-stack defaults from the
|
||||
registry. They can be on the HKEY_CURRENT_USER as well as the
|
||||
HKEY_LOCAL_MACHINE registries to allow for both user-only and
|
||||
system-wide settings.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
static struct regdef
|
||||
{ const char *name;
|
||||
int *address;
|
||||
} const regdefs[] =
|
||||
{ { "localSize", &GD->defaults.local },
|
||||
{ "globalSize", &GD->defaults.global },
|
||||
{ "trailSize", &GD->defaults.trail },
|
||||
{ NULL, NULL }
|
||||
};
|
||||
|
||||
|
||||
static void
|
||||
setStacksFromKey(HKEY key)
|
||||
{ DWORD type;
|
||||
BYTE data[128];
|
||||
DWORD len = sizeof(data);
|
||||
const struct regdef *rd;
|
||||
|
||||
for(rd = regdefs; rd->name; rd++)
|
||||
{ if ( RegQueryValueEx(key, rd->name, NULL, &type, data, &len) ==
|
||||
ERROR_SUCCESS &&
|
||||
type == REG_DWORD )
|
||||
{ DWORD v = *((DWORD *)data);
|
||||
|
||||
*rd->address = (int)v;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
getDefaultsFromRegistry()
|
||||
{ HKEY key;
|
||||
|
||||
if ( (key = reg_open_key(L"HKEY_LOCAL_MACHINE/Software/SWI/Prolog", FALSE)) )
|
||||
{ setStacksFromKey(key);
|
||||
RegCloseKey(key);
|
||||
}
|
||||
if ( (key = reg_open_key(L"HKEY_CURRENT_USER/Software/SWI/Prolog", FALSE)) )
|
||||
{ setStacksFromKey(key);
|
||||
RegCloseKey(key);
|
||||
}
|
||||
}
|
||||
|
||||
/*******************************
|
||||
* PUBLISH PREDICATES *
|
||||
*******************************/
|
||||
|
||||
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_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
|
||||
EndPredDefs
|
||||
|
||||
#endif /*__WINDOWS__*/
|
||||
|
||||
91
console/LGPL/pl-ntcon.c
Executable file
91
console/LGPL/pl-ntcon.c
Executable file
@ -0,0 +1,91 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: J.Wielemaker@cs.vu.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2010, University of Amsterdam, VU University Amsterdam
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Lesser General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2.1 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Lesser General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
#include <winsock2.h>
|
||||
#include <windows.h>
|
||||
#include "SWI-Stream.h"
|
||||
#include "SWI-Prolog.h"
|
||||
#include <signal.h>
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
This is the simple main program of swipl.exe; the SWI-Prolog console
|
||||
application. It can be used as a basis for console-based applications
|
||||
that have SWI-Prolog embedded.
|
||||
|
||||
The default version does Control-C processing and decodes ANSI color
|
||||
sequences to support colors in the console window.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
#ifndef O_CTRLC
|
||||
#define O_CTRLC 1
|
||||
#endif
|
||||
#ifndef O_ANSI_COLORS
|
||||
#define O_ANSI_COLORS 1
|
||||
#endif
|
||||
|
||||
/*******************************
|
||||
* INTERRUPT *
|
||||
*******************************/
|
||||
|
||||
#if O_CTRLC
|
||||
static DWORD main_thread_id;
|
||||
|
||||
static BOOL
|
||||
consoleHandlerRoutine(DWORD id)
|
||||
{ switch(id)
|
||||
{ case CTRL_C_EVENT:
|
||||
PL_w32thread_raise(main_thread_id, SIGINT);
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
return FALSE;
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/*******************************
|
||||
* MAIN *
|
||||
*******************************/
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
#if O_CTRLC
|
||||
main_thread_id = GetCurrentThreadId();
|
||||
SetConsoleCtrlHandler((PHANDLER_ROUTINE)consoleHandlerRoutine, TRUE);
|
||||
#endif
|
||||
|
||||
#if O_ANSI_COLORS
|
||||
PL_w32_wrap_ansi_console(); /* decode ANSI color sequences (ESC[...m) */
|
||||
#endif
|
||||
|
||||
if ( !PL_initialise(argc, argv) )
|
||||
PL_halt(1);
|
||||
|
||||
PL_halt(PL_toplevel() ? 0 : 1);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
459
console/LGPL/pl-ntconsole.c
Executable file
459
console/LGPL/pl-ntconsole.c
Executable file
@ -0,0 +1,459 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker and Matt Lilley
|
||||
E-mail: J.Wielemaker@cs.vu.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 2010, VU University, Amsterdam
|
||||
Copyright (C): 2009, SCIENTIFIC SOFTWARE AND SYSTEMS LIMITED
|
||||
|
||||
This library is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU Lesser General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2.1 of the License, or (at your option) any later version.
|
||||
|
||||
This library is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||||
Lesser General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*/
|
||||
|
||||
#define WINDOWS_LEAN_AND_MEAN 1
|
||||
#if (_MSC_VER >= 1300)
|
||||
#include <winsock2.h> /* Needed on VC8 */
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <windows.h> /* Needed for MSVC 5&6 */
|
||||
#include <winsock2.h>
|
||||
#endif
|
||||
#include "pl-incl.h"
|
||||
|
||||
#define ANSI_MAGIC (0x734ab9de)
|
||||
#define ANSI_BUFFER_SIZE (256)
|
||||
#define ANSI_MAX_ARGC (10)
|
||||
|
||||
typedef enum
|
||||
{ CMD_INITIAL = 0,
|
||||
CMD_ESC,
|
||||
CMD_ANSI
|
||||
} astate;
|
||||
|
||||
|
||||
typedef struct
|
||||
{ int magic;
|
||||
HANDLE hConsole;
|
||||
IOSTREAM *pStream;
|
||||
void *saved_handle;
|
||||
|
||||
wchar_t buffer[ANSI_BUFFER_SIZE];
|
||||
size_t buffered;
|
||||
int argv[ANSI_MAX_ARGC];
|
||||
int argc;
|
||||
int argstat;
|
||||
astate cmdstat; /* State for sequence processing */
|
||||
WORD def_attr; /* Default attributes */
|
||||
} ansi_stream;
|
||||
|
||||
|
||||
static IOFUNCTIONS con_functions;
|
||||
static IOFUNCTIONS *saved_functions;
|
||||
|
||||
static void
|
||||
Message(const char *fm, ...)
|
||||
{ char buf[1024];
|
||||
va_list(args);
|
||||
|
||||
return;
|
||||
|
||||
va_start(args, fm);
|
||||
vsprintf(buf, fm, args);
|
||||
MessageBox(NULL, buf, "SWI-Prolog", MB_OK|MB_TASKMODAL);
|
||||
va_end(args);
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
flush_ansi(ansi_stream *as)
|
||||
{ size_t written = 0;
|
||||
|
||||
while ( written < as->buffered )
|
||||
{ BOOL rc;
|
||||
DWORD done;
|
||||
|
||||
rc = WriteConsoleW(as->hConsole,
|
||||
&as->buffer[written],
|
||||
(DWORD)(as->buffered-written),
|
||||
&done,
|
||||
NULL);
|
||||
|
||||
if ( rc )
|
||||
{ written += done;
|
||||
} else
|
||||
{ as->buffered = 0;
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
as->buffered = 0;
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
send_ansi(ansi_stream *as, int chr)
|
||||
{ as->buffer[as->buffered++] = chr;
|
||||
|
||||
if ( as->buffered == ANSI_BUFFER_SIZE ||
|
||||
(as->pStream->flags & SIO_NBUF) ||
|
||||
(chr == '\n' && (as->pStream->flags & SIO_LBUF)) )
|
||||
return flush_ansi(as);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
#define FG_MASK (FOREGROUND_RED|FOREGROUND_BLUE|FOREGROUND_GREEN)
|
||||
#define BG_MASK (BACKGROUND_RED|BACKGROUND_BLUE|BACKGROUND_GREEN)
|
||||
|
||||
static void
|
||||
set_ansi_attributes(ansi_stream *as)
|
||||
{ CONSOLE_SCREEN_BUFFER_INFO info;
|
||||
|
||||
if ( GetConsoleScreenBufferInfo(as->hConsole, &info) )
|
||||
{ int i;
|
||||
WORD attr = info.wAttributes;
|
||||
|
||||
for(i=0; i < as->argc; i++)
|
||||
{ switch( as->argv[i] )
|
||||
{ case 0:
|
||||
attr = as->def_attr;
|
||||
break;
|
||||
case 1:
|
||||
attr |= FOREGROUND_INTENSITY;
|
||||
break;
|
||||
case 22:
|
||||
attr &= ~FOREGROUND_INTENSITY;
|
||||
break;
|
||||
default:
|
||||
if ( as->argv[i] >= 30 && as->argv[i] <= 39 )
|
||||
{ int fg = as->argv[i] - 30;
|
||||
|
||||
attr &= ~FG_MASK;
|
||||
|
||||
if ( fg == 9 ) /* default */
|
||||
{ attr |= (as->def_attr & FG_MASK);
|
||||
} else
|
||||
{ if ( fg % 2 == 1 )
|
||||
attr |= FOREGROUND_RED;
|
||||
if ( fg >= 4 )
|
||||
attr |= FOREGROUND_BLUE;
|
||||
if ( (fg == 2) || (fg == 3) || (fg == 6) || (fg == 7) )
|
||||
attr |= FOREGROUND_GREEN;
|
||||
}
|
||||
} else if ( as->argv[i] >= 40 && as->argv[i] <= 49 )
|
||||
{ int bg = as->argv[i] - 40;
|
||||
|
||||
attr &= ~BG_MASK;
|
||||
if ( bg == 9 ) /* default */
|
||||
{ attr |= (as->def_attr & BG_MASK);
|
||||
} else
|
||||
{ if ( bg % 2 == 1 )
|
||||
attr |= BACKGROUND_RED;
|
||||
if ( bg >= 4 )
|
||||
attr |= BACKGROUND_BLUE;
|
||||
if ( (bg == 2) || (bg == 3) || (bg == 6) || (bg == 7) )
|
||||
attr |= BACKGROUND_GREEN;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ( attr != info.wAttributes )
|
||||
{ flush_ansi(as);
|
||||
SetConsoleTextAttribute(as->hConsole, attr);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
rlc_need_arg(ansi_stream *as, int arg, int def)
|
||||
{ if ( as->argc < arg )
|
||||
{ as->argv[arg-1] = def;
|
||||
as->argc = arg;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
put_ansi(ansi_stream *as, int chr)
|
||||
{ switch(as->cmdstat)
|
||||
{ case CMD_INITIAL:
|
||||
switch(chr)
|
||||
{
|
||||
#if 0
|
||||
case '\b':
|
||||
CMD(rlc_caret_backward(b, 1));
|
||||
break;
|
||||
case Control('G'):
|
||||
MessageBeep(MB_ICONEXCLAMATION);
|
||||
break;
|
||||
case '\r':
|
||||
CMD(rlc_cariage_return(b));
|
||||
break;
|
||||
case '\n':
|
||||
CMD(rlc_caret_down(b, 1));
|
||||
break;
|
||||
case '\t':
|
||||
CMD(rlc_tab(b));
|
||||
break;
|
||||
#endif
|
||||
case 27: /* ESC */
|
||||
as->cmdstat = CMD_ESC;
|
||||
break;
|
||||
default:
|
||||
return send_ansi(as, chr);
|
||||
}
|
||||
break;
|
||||
case CMD_ESC:
|
||||
switch(chr)
|
||||
{ case '[':
|
||||
as->cmdstat = CMD_ANSI;
|
||||
as->argc = 0;
|
||||
as->argstat = 0; /* no arg */
|
||||
break;
|
||||
default:
|
||||
as->cmdstat = CMD_INITIAL;
|
||||
break;
|
||||
}
|
||||
break;
|
||||
case CMD_ANSI: /* ESC [ */
|
||||
if ( chr >= '0' && chr <= '9' )
|
||||
{ if ( !as->argstat )
|
||||
{ as->argv[as->argc] = (chr - '0');
|
||||
as->argstat = 1; /* positive */
|
||||
} else
|
||||
{ as->argv[as->argc] = as->argv[as->argc] * 10 + (chr - '0');
|
||||
}
|
||||
|
||||
break;
|
||||
}
|
||||
if ( !as->argstat && chr == '-' )
|
||||
{ as->argstat = -1; /* negative */
|
||||
break;
|
||||
}
|
||||
if ( as->argstat )
|
||||
{ as->argv[as->argc] *= as->argstat;
|
||||
if ( as->argc < (ANSI_MAX_ARGC-1) )
|
||||
as->argc++; /* silently discard more of them */
|
||||
as->argstat = 0;
|
||||
}
|
||||
switch(chr)
|
||||
{ case ';':
|
||||
return 0; /* wait for more args */
|
||||
#if 0
|
||||
case 'H':
|
||||
case 'f':
|
||||
rlc_need_arg(as, 1, 0);
|
||||
rlc_need_arg(as, 2, 0);
|
||||
CMD(rlc_set_caret(as, as->argv[0], as->argv[1]));
|
||||
break;
|
||||
case 'A':
|
||||
rlc_need_arg(as, 1, 1);
|
||||
CMD(rlc_caret_up(as, as->argv[0]));
|
||||
break;
|
||||
case 'B':
|
||||
rlc_need_arg(as, 1, 1);
|
||||
CMD(rlc_caret_down(as, as->argv[0]));
|
||||
break;
|
||||
case 'C':
|
||||
rlc_need_arg(as, 1, 1);
|
||||
CMD(rlc_caret_forward(as, as->argv[0]));
|
||||
break;
|
||||
case 'D':
|
||||
rlc_need_arg(as, 1, 1);
|
||||
CMD(rlc_caret_backward(as, as->argv[0]));
|
||||
break;
|
||||
case 's':
|
||||
CMD(rlc_save_caret_position(as));
|
||||
break;
|
||||
case 'u':
|
||||
CMD(rlc_restore_caret_position(as));
|
||||
break;
|
||||
case 'J':
|
||||
if ( as->argv[0] == 2 )
|
||||
CMD(rlc_erase_display(as));
|
||||
break;
|
||||
case 'K':
|
||||
CMD(rlc_erase_line(as));
|
||||
break;
|
||||
#endif
|
||||
case 'm':
|
||||
rlc_need_arg(as, 1, 0);
|
||||
set_ansi_attributes(as);
|
||||
}
|
||||
as->cmdstat = CMD_INITIAL;
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static ssize_t
|
||||
write_ansi(void *handle, char *buffer, size_t size)
|
||||
{ ansi_stream *as = handle;
|
||||
size_t n = size/sizeof(wchar_t);
|
||||
const wchar_t *s = (const wchar_t*)buffer;
|
||||
const wchar_t *e = &s[n];
|
||||
|
||||
Message("Writing %d characters", n);
|
||||
|
||||
for( ; s<e; s++)
|
||||
{ if ( put_ansi(as, *s) != 0 )
|
||||
return -1; /* error */
|
||||
}
|
||||
|
||||
Message("Wrote %d characters", n);
|
||||
return n * sizeof(wchar_t);
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
close_ansi(void *handle)
|
||||
{ ansi_stream *as = handle;
|
||||
|
||||
if ( as->magic == ANSI_MAGIC )
|
||||
{ as->pStream->functions = saved_functions;
|
||||
as->pStream->handle = as->saved_handle;
|
||||
|
||||
PL_free(as);
|
||||
return 0;
|
||||
}
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
control_ansi(void *handle, int op, void *data)
|
||||
{ ansi_stream *as = handle;
|
||||
|
||||
switch( op )
|
||||
{ case SIO_FLUSHOUTPUT:
|
||||
return flush_ansi(as);
|
||||
case SIO_SETENCODING:
|
||||
return -1; /* We cannot change the encoding! */
|
||||
case SIO_LASTERROR:
|
||||
return 0; /* TBD */
|
||||
default:
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/*******************************
|
||||
* USER WIN32 CONSOLE *
|
||||
*******************************/
|
||||
|
||||
static ssize_t
|
||||
Sread_win32_console(void *handle, char *buffer, size_t size)
|
||||
{ GET_LD
|
||||
ansi_stream *as = handle;
|
||||
BOOL rc;
|
||||
DWORD done;
|
||||
DWORD mode;
|
||||
int isRaw = FALSE;
|
||||
|
||||
if ( Suser_input &&
|
||||
Suser_input->handle == handle &&
|
||||
PL_ttymode(Suser_input) == PL_RAWTTY )
|
||||
{ if ( GetConsoleMode(as->hConsole, &mode) &&
|
||||
SetConsoleMode(as->hConsole,
|
||||
mode & ~(ENABLE_LINE_INPUT|ENABLE_ECHO_INPUT)) )
|
||||
isRaw = TRUE;
|
||||
}
|
||||
|
||||
if ( !PL_wait_for_console_input(as->hConsole) )
|
||||
goto error;
|
||||
|
||||
rc = ReadConsoleW(as->hConsole,
|
||||
buffer,
|
||||
(DWORD)(size / sizeof(wchar_t)),
|
||||
&done,
|
||||
NULL);
|
||||
|
||||
if ( rc )
|
||||
{ if ( isRaw )
|
||||
SetConsoleMode(as->hConsole, mode);
|
||||
return done * sizeof(wchar_t);
|
||||
}
|
||||
|
||||
error:
|
||||
if ( isRaw )
|
||||
SetConsoleMode(as->hConsole, mode);
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
|
||||
static int
|
||||
wrap_console(HANDLE h, IOSTREAM *s, IOFUNCTIONS *funcs)
|
||||
{ ansi_stream *as;
|
||||
|
||||
as = PL_malloc(sizeof(*as));
|
||||
memset(as, 0, sizeof(*as));
|
||||
|
||||
as->hConsole = h;
|
||||
as->pStream = s;
|
||||
as->saved_handle = s->handle;
|
||||
|
||||
s->handle = as;
|
||||
s->encoding = ENC_WCHAR;
|
||||
s->functions = funcs;
|
||||
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
||||
static void
|
||||
init_output(void *handle, CONSOLE_SCREEN_BUFFER_INFO *info)
|
||||
{ ansi_stream *as = handle;
|
||||
|
||||
as->def_attr = info->wAttributes;
|
||||
}
|
||||
|
||||
|
||||
int
|
||||
PL_w32_wrap_ansi_console(void)
|
||||
{ HANDLE hIn = GetStdHandle(STD_INPUT_HANDLE);
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
HANDLE hError = GetStdHandle(STD_ERROR_HANDLE);
|
||||
CONSOLE_SCREEN_BUFFER_INFO info;
|
||||
|
||||
if ( hIn == INVALID_HANDLE_VALUE ||
|
||||
hOut == INVALID_HANDLE_VALUE ||
|
||||
hError == INVALID_HANDLE_VALUE ||
|
||||
!GetConsoleScreenBufferInfo(hOut, &info) )
|
||||
return FALSE;
|
||||
|
||||
saved_functions = Sinput->functions;
|
||||
con_functions = *Sinput->functions;
|
||||
con_functions.read = Sread_win32_console;
|
||||
con_functions.write = write_ansi;
|
||||
con_functions.close = close_ansi;
|
||||
con_functions.control = control_ansi;
|
||||
con_functions.seek = NULL;
|
||||
|
||||
wrap_console(hIn, Sinput, &con_functions);
|
||||
wrap_console(hOut, Soutput, &con_functions);
|
||||
wrap_console(hError, Serror, &con_functions);
|
||||
|
||||
init_output(Soutput->handle, &info);
|
||||
init_output(Serror->handle, &info);
|
||||
|
||||
PL_set_prolog_flag("tty_control", PL_BOOL, TRUE);
|
||||
return TRUE;
|
||||
}
|
||||
1061
console/LGPL/pl-ntmain.c
Executable file
1061
console/LGPL/pl-ntmain.c
Executable file
File diff suppressed because it is too large
Load Diff
@ -314,6 +314,83 @@ typedef struct foreign_context *control_t;
|
||||
|
||||
/* end from pl-itf.h */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Output representation for PL_get_chars() and friends. The
|
||||
prepresentation type REP_FN is for PL_get_file_name() and friends. On
|
||||
Windows we use UTF-8 which is translated by the `XOS' layer to Windows
|
||||
UNICODE file functions.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
#define REP_ISO_LATIN_1 0x0000 /* output representation */
|
||||
#define REP_UTF8 0x1000
|
||||
#define REP_MB 0x2000
|
||||
#ifdef __WINDOWS__
|
||||
#define REP_FN REP_UTF8
|
||||
#else
|
||||
#define REP_FN REP_MB
|
||||
#endif
|
||||
|
||||
#define PL_DIFF_LIST 0x20000 /* PL_unify_chars() */
|
||||
|
||||
#ifdef SIO_MAGIC /* defined from <SWI-Stream.h> */
|
||||
|
||||
/*******************************
|
||||
* STREAM SUPPORT *
|
||||
*******************************/
|
||||
|
||||
/* Make IOSTREAM known to Prolog */
|
||||
#define PL_open_stream PL_unify_stream /* compatibility */
|
||||
PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s);
|
||||
PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s);
|
||||
PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
|
||||
PL_EXPORT(IOSTREAM *) PL_open_resource(module_t m,
|
||||
const char *name,
|
||||
const char *rc_class,
|
||||
const char *mode);
|
||||
|
||||
PL_EXPORT(IOSTREAM *)*_PL_streams(void); /* base of streams */
|
||||
#ifndef PL_KERNEL
|
||||
#define Suser_input (_PL_streams()[0])
|
||||
#define Suser_output (_PL_streams()[1])
|
||||
#define Suser_error (_PL_streams()[2])
|
||||
#endif
|
||||
|
||||
#define PL_WRT_QUOTED 0x01 /* quote atoms */
|
||||
#define PL_WRT_IGNOREOPS 0x02 /* ignore list/operators */
|
||||
#define PL_WRT_NUMBERVARS 0x04 /* print $VAR(N) as a variable */
|
||||
#define PL_WRT_PORTRAY 0x08 /* call portray */
|
||||
#define PL_WRT_CHARESCAPES 0x10 /* Output ISO escape sequences */
|
||||
#define PL_WRT_BACKQUOTED_STRING 0x20 /* Write strings as `...` */
|
||||
/* Write attributed variables */
|
||||
#define PL_WRT_ATTVAR_IGNORE 0x040 /* Default: just write the var */
|
||||
#define PL_WRT_ATTVAR_DOTS 0x080 /* Write as Var{...} */
|
||||
#define PL_WRT_ATTVAR_WRITE 0x100 /* Write as Var{Attributes} */
|
||||
#define PL_WRT_ATTVAR_PORTRAY 0x200 /* Use Module:portray_attrs/2 */
|
||||
#define PL_WRT_ATTVAR_MASK \
|
||||
(PL_WRT_ATTVAR_IGNORE | \
|
||||
PL_WRT_ATTVAR_DOTS | \
|
||||
PL_WRT_ATTVAR_WRITE | \
|
||||
PL_WRT_ATTVAR_PORTRAY)
|
||||
#define PL_WRT_BLOB_PORTRAY 0x400 /* Use portray to emit non-text blobs */
|
||||
|
||||
PL_EXPORT(int) PL_write_term(IOSTREAM *s,
|
||||
term_t term,
|
||||
int precedence,
|
||||
int flags);
|
||||
|
||||
/* PL_ttymode() results */
|
||||
#define PL_NOTTY 0 /* -tty in effect */
|
||||
#define PL_RAWTTY 1 /* get_single_char/1 */
|
||||
#define PL_COOKEDTTY 2 /* normal input */
|
||||
|
||||
PL_EXPORT(int) PL_ttymode(IOSTREAM *s);
|
||||
|
||||
#endif /*SIO_MAGIC*/
|
||||
|
||||
PL_EXPORT(int) PL_chars_to_term(const char *chars,
|
||||
term_t term);
|
||||
|
||||
|
||||
/*******************************
|
||||
* CALL-BACK *
|
||||
*******************************/
|
||||
@ -465,6 +542,7 @@ extern X_API int PL_call(term_t, module_t);
|
||||
extern X_API void PL_register_foreign(const char *, int, pl_function_t, int);
|
||||
extern X_API void PL_register_foreign_in_module(const char *, const char *, int, pl_function_t, int);
|
||||
extern X_API void PL_register_extensions(const PL_extension *);
|
||||
extern X_API void PL_register_extensions_in_module(const char *module, const PL_extension *);
|
||||
extern X_API void PL_load_extensions(const PL_extension *);
|
||||
extern X_API int PL_handle_signals(void);
|
||||
extern X_API int PL_thread_self(void);
|
||||
@ -521,9 +599,34 @@ readline overhead.
|
||||
#define PL_DISPATCH_INSTALLED 2 /* dispatch function installed? */
|
||||
|
||||
extern X_API int PL_dispatch(int fd, int wait);
|
||||
PL_EXPORT(void) PL_add_to_protocol(const char *buf, size_t count);
|
||||
PL_EXPORT(char *) PL_prompt_string(int fd);
|
||||
PL_EXPORT(void) PL_write_prompt(int dowrite);
|
||||
PL_EXPORT(void) PL_prompt_next(int fd);
|
||||
PL_EXPORT(char *) PL_atom_generator(const char *prefix, int state);
|
||||
PL_EXPORT(pl_wchar_t*) PL_atom_generator_w(const pl_wchar_t *pref,
|
||||
pl_wchar_t *buffer,
|
||||
size_t buflen,
|
||||
int state);
|
||||
|
||||
typedef int (*PL_dispatch_hook_t)(int fd);
|
||||
|
||||
/*******************************
|
||||
* WINDOWS MESSAGES *
|
||||
*******************************/
|
||||
|
||||
#ifdef _WINDOWS_ /* <windows.h> is included */
|
||||
#define PL_MSG_EXCEPTION_RAISED -1
|
||||
#define PL_MSG_IGNORED 0
|
||||
#define PL_MSG_HANDLED 1
|
||||
|
||||
PL_EXPORT(LRESULT) PL_win_message_proc(HWND hwnd,
|
||||
UINT message,
|
||||
WPARAM wParam,
|
||||
LPARAM lParam);
|
||||
#endif /*_WINDOWS_*/
|
||||
|
||||
|
||||
/********************************
|
||||
* QUERY PROLOG *
|
||||
*********************************/
|
||||
@ -545,54 +648,6 @@ typedef int (*PL_dispatch_hook_t)(int fd);
|
||||
|
||||
X_API intptr_t PL_query(int); /* get information from Prolog */
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Output representation for PL_get_chars() and friends. The
|
||||
prepresentation type REP_FN is for PL_get_file_name() and friends. On
|
||||
Windows we use UTF-8 which is translated by the `XOS' layer to Windows
|
||||
UNICODE file functions.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
#define REP_ISO_LATIN_1 0x0000 /* output representation */
|
||||
#define REP_UTF8 0x1000
|
||||
#define REP_MB 0x2000
|
||||
#ifdef __WINDOWS__
|
||||
#define REP_FN REP_UTF8
|
||||
#else
|
||||
#define REP_FN REP_MB
|
||||
#endif
|
||||
|
||||
#define PL_DIFF_LIST 0x20000 /* PL_unify_chars() */
|
||||
|
||||
#define PL_WRT_QUOTED 0x01 /* quote atoms */
|
||||
#define PL_WRT_IGNOREOPS 0x02 /* ignore list/operators */
|
||||
#define PL_WRT_NUMBERVARS 0x04 /* print $VAR(N) as a variable */
|
||||
#define PL_WRT_PORTRAY 0x08 /* call portray */
|
||||
#define PL_WRT_CHARESCAPES 0x10 /* Output ISO escape sequences */
|
||||
#define PL_WRT_BACKQUOTED_STRING 0x20 /* Write strings as `...` */
|
||||
/* Write attributed variables */
|
||||
#define PL_WRT_ATTVAR_IGNORE 0x040 /* Default: just write the var */
|
||||
#define PL_WRT_ATTVAR_DOTS 0x080 /* Write as Var{...} */
|
||||
#define PL_WRT_ATTVAR_WRITE 0x100 /* Write as Var{Attributes} */
|
||||
#define PL_WRT_ATTVAR_PORTRAY 0x200 /* Use Module:portray_attrs/2 */
|
||||
#define PL_WRT_ATTVAR_MASK \
|
||||
(PL_WRT_ATTVAR_IGNORE | \
|
||||
PL_WRT_ATTVAR_DOTS | \
|
||||
PL_WRT_ATTVAR_WRITE | \
|
||||
PL_WRT_ATTVAR_PORTRAY)
|
||||
|
||||
#ifdef SIO_MAGIC /* defined from <SWI-Stream.h> */
|
||||
/* Make IOSTREAM known to Prolog */
|
||||
PL_EXPORT(int) PL_open_stream(term_t t, IOSTREAM *s);
|
||||
PL_EXPORT(int) PL_unify_stream(term_t t, IOSTREAM *s);
|
||||
#define PL_open_stream PL_unify_stream
|
||||
PL_EXPORT(int) PL_get_stream_handle(term_t t, IOSTREAM **s);
|
||||
PL_EXPORT(int) PL_release_stream(IOSTREAM *s);
|
||||
|
||||
PL_EXPORT(int) PL_write_term(IOSTREAM *s,term_t term,int precedence,int flags);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
/*******************************
|
||||
* BLOBS *
|
||||
*******************************/
|
||||
|
||||
@ -516,6 +516,8 @@ extern X_API int PROTO(YAP_Variant,(YAP_Term,YAP_Term));
|
||||
extern X_API int PROTO(YAP_ExactlyEqual,(YAP_Term,YAP_Term));
|
||||
extern X_API YAP_Int PROTO(YAP_TermHash,(YAP_Term, YAP_Int, YAP_Int, int));
|
||||
|
||||
extern X_API void PROTO(YAP_signal,(int));
|
||||
|
||||
/* stack expansion control */
|
||||
extern X_API int PROTO(YAP_SetYAPFlag,(yap_flag_t,int));
|
||||
|
||||
|
||||
@ -2722,9 +2722,23 @@ X_API void PL_register_foreign_in_module(const char *module, const char *name, i
|
||||
|
||||
X_API void PL_register_extensions(const PL_extension *ptr)
|
||||
{
|
||||
// implemented as register foreign
|
||||
// may cause problems during initialization?
|
||||
PL_load_extensions(ptr);
|
||||
}
|
||||
|
||||
X_API void
|
||||
PL_register_extensions_in_module(const char *module, const PL_extension *e)
|
||||
{
|
||||
// implemented as register foreign
|
||||
/* ignore flags for now */
|
||||
while(e->predicate_name != NULL) {
|
||||
PL_register_foreign_in_module(module, e->predicate_name, e->arity, e->function, e->flags);
|
||||
e++;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
X_API void PL_register_foreign(const char *name, int arity, pl_function_t function, int flags)
|
||||
{
|
||||
PL_register_foreign_in_module(NULL, name, arity, function, flags);
|
||||
@ -3163,6 +3177,17 @@ X_API void PL_on_halt(void (*f)(int, void *), void *closure)
|
||||
Yap_HaltRegisterHook((HaltHookFunc)f,closure);
|
||||
}
|
||||
|
||||
X_API char *PL_atom_generator(const char *prefix, int state)
|
||||
{
|
||||
return NULL;
|
||||
}
|
||||
|
||||
X_API pl_wchar_t *PL_atom_generator_w(const pl_wchar_t *pref, pl_wchar_t *buffer, size_t buflen, int state)
|
||||
{
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
Yap_swi_install(void)
|
||||
{
|
||||
|
||||
@ -7,6 +7,11 @@
|
||||
#define O_XOS 1
|
||||
#endif
|
||||
|
||||
#ifdef THREADS
|
||||
#define O_PLMT 1
|
||||
#endif
|
||||
|
||||
#include <SWI-Stream.h>
|
||||
#include <SWI-Prolog.h>
|
||||
typedef int bool;
|
||||
|
||||
@ -46,7 +51,28 @@ typedef int bool;
|
||||
#endif
|
||||
#if __YAP_PROLOG__
|
||||
#include "pl-yap.h"
|
||||
#if _WIN32
|
||||
typedef int pthread_t;
|
||||
#define __WINDOWS__ 1
|
||||
#else
|
||||
#include <pthread.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#define MAXSIGNAL 64
|
||||
|
||||
#define SIG_PROLOG_OFFSET 32 /* Start of Prolog signals */
|
||||
|
||||
#define SIG_EXCEPTION (SIG_PROLOG_OFFSET+0)
|
||||
#ifdef O_ATOMGC
|
||||
#define SIG_ATOM_GC (SIG_PROLOG_OFFSET+1)
|
||||
#endif
|
||||
#define SIG_GC (SIG_PROLOG_OFFSET+2)
|
||||
#ifdef O_PLMT
|
||||
#define SIG_THREAD_SIGNAL (SIG_PROLOG_OFFSET+3)
|
||||
#endif
|
||||
#define SIG_FREECLAUSES (SIG_PROLOG_OFFSET+4)
|
||||
#define SIG_PLABORT (SIG_PROLOG_OFFSET+5)
|
||||
|
||||
|
||||
/********************************
|
||||
@ -59,7 +85,6 @@ typedef int bool;
|
||||
*********************************/
|
||||
|
||||
#include "pl-table.h"
|
||||
#include "SWI-Stream.h"
|
||||
#include "pl-os.h"
|
||||
#include "pl-error.h"
|
||||
|
||||
@ -81,6 +106,19 @@ typedef int bool;
|
||||
|
||||
#include "pl-privitf.h"
|
||||
|
||||
typedef int simpleMutex;
|
||||
|
||||
typedef struct counting_mutex
|
||||
{ simpleMutex mutex; /* mutex itself */
|
||||
const char *name; /* name of the mutex */
|
||||
long count; /* # times locked */
|
||||
long unlocked; /* # times unlocked */
|
||||
#ifdef O_CONTENTION_STATISTICS
|
||||
long collisions; /* # contentions */
|
||||
#endif
|
||||
struct counting_mutex *next; /* next of allocated chain */
|
||||
} counting_mutex;
|
||||
|
||||
// numbers
|
||||
|
||||
typedef enum
|
||||
@ -113,6 +151,54 @@ typedef enum
|
||||
CLN_DATA /* Remaining data */
|
||||
} cleanup_status;
|
||||
|
||||
typedef struct
|
||||
{ char *state; /* system's boot file */
|
||||
char *startup; /* default user startup file */
|
||||
int local; /* default local stack size (K) */
|
||||
int global; /* default global stack size (K) */
|
||||
int trail; /* default trail stack size (K) */
|
||||
char *goal; /* default initialisation goal */
|
||||
char *toplevel; /* default top level goal */
|
||||
bool notty; /* use tty? */
|
||||
char *arch; /* machine/OS we are using */
|
||||
char *home; /* systems home directory */
|
||||
} pl_defaults_t;
|
||||
|
||||
typedef enum
|
||||
{ LDATA_IDLE = 0,
|
||||
LDATA_SIGNALLED,
|
||||
LDATA_ANSWERING,
|
||||
LDATA_ANSWERED
|
||||
} ldata_status_t;
|
||||
|
||||
typedef struct _PL_thread_info_t
|
||||
{ int pl_tid; /* Prolog thread id */
|
||||
size_t local_size; /* Stack sizes */
|
||||
size_t global_size;
|
||||
size_t trail_size;
|
||||
size_t stack_size; /* system (C-) stack */
|
||||
int (*cancel)(int id); /* cancel function */
|
||||
int open_count; /* for PL_thread_detach_engine() */
|
||||
bool detached; /* detached thread */
|
||||
int status; /* PL_THREAD_* */
|
||||
pthread_t tid; /* Thread identifier */
|
||||
int has_tid; /* TRUE: tid = valid */
|
||||
#ifdef __linux__
|
||||
pid_t pid; /* for identifying */
|
||||
#endif
|
||||
#ifdef __WINDOWS__
|
||||
unsigned long w32id; /* Win32 thread HANDLE */
|
||||
#endif
|
||||
struct PL_local_data *thread_data; /* The thread-local data */
|
||||
module_t module; /* Module for starting goal */
|
||||
record_t goal; /* Goal to start thread */
|
||||
record_t return_value; /* Value (term) returned */
|
||||
atom_t name; /* Name of the thread */
|
||||
ldata_status_t ldata_status; /* status of forThreadLocalData() */
|
||||
} PL_thread_info_t;
|
||||
|
||||
|
||||
|
||||
typedef struct tempfile * TempFile; /* pl-os.c */
|
||||
typedef struct canonical_dir * CanonicalDir; /* pl-os.c */
|
||||
typedef struct on_halt * OnHalt; /* pl-os.c */
|
||||
@ -124,6 +210,8 @@ typedef struct {
|
||||
int io_initialised;
|
||||
cleanup_status cleaning; /* Inside PL_cleanup() */
|
||||
|
||||
pl_defaults_t defaults; /* system default settings */
|
||||
|
||||
struct
|
||||
{ Table table; /* global (read-only) features */
|
||||
} prolog_flag;
|
||||
@ -184,6 +272,24 @@ typedef struct {
|
||||
int _loaded; /* system extensions are loaded */
|
||||
} foreign;
|
||||
|
||||
#ifdef O_PLMT
|
||||
FreeChunk left_over_pool; /* Left-over from threads */
|
||||
|
||||
struct
|
||||
{ struct _at_exit_goal *exit_goals; /* Global thread_at_exit/1 goals */
|
||||
int enabled; /* threads are enabled */
|
||||
Table mutexTable; /* Name --> mutex table */
|
||||
int mutex_next_id; /* next id for anonymous mutexes */
|
||||
struct pl_mutex* MUTEX_load; /* The $load mutex */
|
||||
#ifdef __WINDOWS__
|
||||
HINSTANCE instance; /* Win32 process instance */
|
||||
#endif
|
||||
counting_mutex *mutexes; /* Registered mutexes */
|
||||
int thread_max; /* Maximum # threads */
|
||||
PL_thread_info_t **threads; /* Pointers to thread-info */
|
||||
} thread;
|
||||
#endif /*O_PLMT*/
|
||||
|
||||
} gds_t;
|
||||
|
||||
extern gds_t gds;
|
||||
|
||||
84
packages/PLStream/pl-yap.c
Normal file → Executable file
84
packages/PLStream/pl-yap.c
Normal file → Executable file
@ -653,6 +653,28 @@ X_API int PL_handle_signals(void)
|
||||
return 0;
|
||||
}
|
||||
|
||||
X_API int
|
||||
PL_ttymode(IOSTREAM *s)
|
||||
{ GET_LD
|
||||
|
||||
if ( s == Suser_input )
|
||||
{ if ( !truePrologFlag(PLFLAG_TTY_CONTROL) ) /* -tty in effect */
|
||||
return PL_NOTTY;
|
||||
if ( ttymode == TTY_RAW ) /* get_single_char/1 and friends */
|
||||
return PL_RAWTTY;
|
||||
return PL_COOKEDTTY; /* cooked (readline) input */
|
||||
} else
|
||||
return PL_NOTTY;
|
||||
}
|
||||
|
||||
X_API void
|
||||
PL_prompt_next(int fd)
|
||||
{ GET_LD
|
||||
|
||||
if ( fd == 0 )
|
||||
LD->prompt.next = TRUE;
|
||||
}
|
||||
|
||||
/* just a stub for now */
|
||||
int
|
||||
warning(const char *fm, ...)
|
||||
@ -711,6 +733,68 @@ PL_dispatch(int fd, int wait)
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
#ifdef _WIN32
|
||||
|
||||
#include <windows.h>
|
||||
|
||||
#if O_PLMT
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
PL_w32thread_raise(DWORD id, int sig)
|
||||
Sets the signalled mask for a specific Win32 thread. This is a
|
||||
partial work-around for the lack of proper asynchronous signal
|
||||
handling in the Win32 platform.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
static int thread_highest_id = 1;
|
||||
|
||||
X_API int
|
||||
PL_w32thread_raise(DWORD id, int sig)
|
||||
{ int i;
|
||||
|
||||
if ( sig < 0 || sig > MAXSIGNAL )
|
||||
return FALSE; /* illegal signal */
|
||||
|
||||
LOCK();
|
||||
for(i = 1; i <= thread_highest_id; i++)
|
||||
{ PL_thread_info_t *info = GD->thread.threads[i];
|
||||
|
||||
if ( info && info->w32id == id && info->thread_data )
|
||||
{ raiseSignal(info->thread_data, sig);
|
||||
if ( info->w32id )
|
||||
PostThreadMessage(info->w32id, WM_SIGNALLED, 0, 0L);
|
||||
UNLOCK();
|
||||
DEBUG(1, Sdprintf("Signalled %d to thread %d\n", sig, i));
|
||||
return TRUE;
|
||||
}
|
||||
}
|
||||
UNLOCK();
|
||||
|
||||
return FALSE; /* can't find thread */
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
int
|
||||
PL_w32thread_raise(DWORD id, int sig)
|
||||
{ return PL_raise(sig);
|
||||
}
|
||||
|
||||
#endif
|
||||
#endif /*__WINDOWS__*/
|
||||
|
||||
|
||||
int
|
||||
PL_raise(int sig)
|
||||
{ GET_LD
|
||||
|
||||
if (sig == SIG_PLABORT) {
|
||||
YAP_signal(0x40); /* YAP_INT_SIGNAL */
|
||||
return 1;
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
extern size_t PL_utf8_strlen(const char *s, size_t len);
|
||||
|
||||
X_API size_t
|
||||
|
||||
@ -95,6 +95,7 @@ max(Skel,Arg,Goal) :-
|
||||
arg(Arg, Skel, A0),
|
||||
arg(Arg, Goal, AN),
|
||||
AN =< A0, !,
|
||||
delete(Skel),
|
||||
cache(Goal).
|
||||
max(Skel,_,Goal) :-
|
||||
clean(Skel),
|
||||
@ -106,6 +107,7 @@ min(Skel,Arg,Goal) :-
|
||||
arg(Arg, Skel, A0),
|
||||
arg(Arg, Goal, AN),
|
||||
AN >= A0, !,
|
||||
delete(Skel),
|
||||
cache(Goal).
|
||||
min(Skel,_,Goal) :-
|
||||
clean(Skel),
|
||||
|
||||
Reference in New Issue
Block a user