Commit 1f6bf30ebcec5bd774b97bdfda5a5ca871602554 - swi-prolog

+12

-1

CMAKE.md less more

93	93	\| `-DUSE_GMP=OFF` \| Drop bignum and rational numbers \|
94	94	\| `-DSWIPL_SHARED_LIB=OFF` \| Build Prolog kernel as static lib \|
95	95	\| `-DSWIPL_INSTALL_IN_LIB=ON` \| Install libswipl.so in <prefix>/lib \|
	96	\| `-DSWIPL_M32=ON` \| Make 32-bit version on 64-bit Linux \|
96	97	\| `-DSWIPL_PACKAGES=OFF` \| Only build the core system \|
97	98	\| `-DSWIPL_PACKAGES_BASIC=OFF` \| Drop all basic packages \|
98	99	\| `-DSWIPL_PACKAGES_ODBC=OFF` \| Drop ODBC and CQL packages \|

175	176	-DINSTALL_DOCUMENTATION=OFF \
176	177	-G Ninja ..
177	178
	179	### Building a 32-bit version on 64-bit Debian based Linux
	180
	181	Building the 32-bit version on a 64 bit platform can be useful for
	182	testing and creating 32-bit .qlf files or saved states. A fairly
	183	complete system is created using the configuration command below.
	184
	185	cmake -DSWIPL_M32=ON \
	186	-DSWIPL_PACKAGES_JAVA=OFF -DSWIPL_PACKAGES_QT=OFF \
	187	-G Ninja ..
	188
178	189	### Cross-building for targets without an emulator
179	190
180	191	In the above scenarios we have an emulator (Wine, Node.js) that can run

188	199	version must have the same _word-size_ (32 or 64-bits) as the
189	200	cross-compiled target. One the core Prolog system (no packages)
190	201	is required and the system only needs to be build, i.e., the
191		_install_ step is allowed but not needed.
	202	_install_ step is allowed but not needed. See above.
192	203
193	204	- Specify `-DSWIPL_NATIVE_FRIEND=native` for the cross-compilation.
194	205	This will cause the above system to be used for the cross

+13

-2

CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(SWI-Prolog)
2	2
3	3	set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} "${CMAKE_CURRENT_SOURCE_DIR}/cmake")

21	21	option(SWIPL_INSTALL_IN_LIB
22	22	"Install library in ${CMAKE_INSTALL_PREFIX}/lib"
23	23	OFF)
	24	option(SWIPL_M32
	25	"Build 32-bit version on 64-bit Linux using multilib and gcc -m32"
	26	OFF)
24	27	option(INSTALL_DOCUMENTATION
25	28	"Install the HTML documentation files"
26	29	ON)

36	39	option(BUILD_SWIPL_LD
37	40	"Create the swipl-ld utility"
38	41	ON)
39		option(INSTALL_TESTS
	42	option(INSTALL_TESTS
40	43	"Install script and files needed to run tests of the final installation"
41	44	OFF)
	45
	46	if(NOT SWIPL_SHARED_LIB)
	47	set(CMAKE_ENABLE_EXPORTS ON)
	48	endif()
42	49
43	50	include(Utils)
44	51	include(BuildType)

121	128	add_compile_options(-Wall)
122	129	endif()
123	130
	131	if(SWIPL_M32)
	132	include(cross/linux_i386)
	133	endif()
	134
124	135	if(BUILD_TESTING)
125	136	enable_testing()
126	137	endif()

+1

-1

VERSION less more

0		8.0.0
	0	8.0.1

+1

-1

cmake/AlignOf.cmake less more

6	6	set(alignof_checker_source_dir ${CMAKE_CURRENT_LIST_DIR})
7	7	try_compile(alignof_checker_ok
8	8	${CMAKE_BINARY_DIR}
9		${alignof_checker_source_dir}/CheckAlignment.cpp
	9	${alignof_checker_source_dir}/CheckAlignment.c
10	10	COPY_FILE ${alignof_checker_target})
11	11
12	12	if(alignof_checker_ok)

+61

-0

cmake/CheckAlignment.c less more

	0	/*******************************************************
	1	* Create ascii pattern to match in order to find
	2	* alignment at compile time
	3	*******************************************************/
	4
	5	// Compile this program and match
	6	// the produced executable against:
	7	// INT64_ALIGNMENT=<code>
	8	// VOIDP_ALIGNMENT=<code>
	9	// DOUBLE_ALIGNMENT=<code>
	10	//
	11	// to get the alignment used by the (cross)compiler.
	12	//
	13	// <code> is the alignment as an ascii digit.
	14
	15	#include <stdint.h>
	16
	17	#if defined(__GNUC__) \|\| defined(__clang__)
	18	#define ALIGNOF(type) (__alignof(type) + 48) // Ascii '1' for 1, '4' for 4, '8' for 8
	19	#else
	20	#define ALIGNOF(type) (sizeof(type) + 48) // Safe fallback
	21	#endif
	22
	23	int prevent_optimization(unsigned char*p, int size) {
	24	unsigned char *d;
	25
	26	//Prevent optimizer from eliminating the constants in main()
	27	unsigned char dummy[size];
	28	d = dummy;
	29	for (int i = 0; i < size; ++i) {
	30	d++ = p++;
	31	}
	32	return dummy[size-1];
	33	}
	34
	35
	36	#define int64_pat_sz 18
	37	#define voidp_pat_sz 18
	38	#define double_pat_sz 19
	39	int main() {
	40
	41	static const unsigned char int64_alignment[int64_pat_sz] = {
	42	'I', 'N','T','6','4','_','A','L','I','G','N','M','E','N','T','=',
	43	ALIGNOF(int64_t), 0x0
	44	};
	45
	46	static const unsigned char voidp_alignment[voidp_pat_sz] = {
	47	'V', 'O','I','D','P','_','A','L','I','G','N','M','E','N','T','=',
	48	ALIGNOF(void*), 0x0
	49	};
	50
	51	static const unsigned char double_alignment[double_pat_sz] = {
	52	'D', 'O','U','B','L','E','_','A','L','I','G','N','M','E','N','T','=',
	53	ALIGNOF(double), 0x0
	54	};
	55
	56	//Not used, prevent optimization
	57	return prevent_optimization((unsigned char*)int64_alignment, int64_pat_sz) +
	58	prevent_optimization((unsigned char*)voidp_alignment, voidp_pat_sz) +
	59	prevent_optimization((unsigned char*)double_alignment, double_pat_sz);
	60	}

+0

-61

~~cmake/CheckAlignment.cpp~~ less more

0		/*******************************************************
1		* Create ascii pattern to match in order to find
2		* alignment at compile time
3		*******************************************************/
4
5		// Compile this program and match
6		// the produced executable against:
7		// INT64_ALIGNMENT=<code>
8		// VOIDP_ALIGNMENT=<code>
9		// DOUBLE_ALIGNMENT=<code>
10		//
11		// to get the alignment used by the (cross)compiler.
12		//
13		// <code> is the alignment as an ascii digit.
14
15		#include <stdint.h>
16
17		#if __cplusplus >= 201103L
18		#define ALIGNOF(type) (alignof(type) + 48) // Ascii '1' for 1, '4' for 4, '8' for 8
19		#else
20		#define ALIGNOF(type) (sizeof(type) + 48) // Safe fallback
21		#endif
22
23		int prevent_optimization(unsigned char*p, int size) {
24		unsigned char *d;
25
26		//Prevent optimizer from eliminating the constants in main()
27		unsigned char dummy[size];
28		d = dummy;
29		for (int i = 0; i < size; ++i) {
30		d++ = p++;
31		}
32		return dummy[size-1];
33		}
34
35
36		int main() {
37		const int int64_pat_sz = 18;
38		const int voidp_pat_sz = 18;
39		const int double_pat_sz = 19;
40
41		static const unsigned char int64_alignment[int64_pat_sz] = {
42		'I', 'N','T','6','4','_','A','L','I','G','N','M','E','N','T','=',
43		ALIGNOF(int64_t), 0x0
44		};
45
46		static const unsigned char voidp_alignment[voidp_pat_sz] = {
47		'V', 'O','I','D','P','_','A','L','I','G','N','M','E','N','T','=',
48		ALIGNOF(void*), 0x0
49		};
50
51		static const unsigned char double_alignment[double_pat_sz] = {
52		'D', 'O','U','B','L','E','_','A','L','I','G','N','M','E','N','T','=',
53		ALIGNOF(double), 0x0
54		};
55
56		//Not used, prevent optimization
57		return prevent_optimization((unsigned char*)int64_alignment, int64_pat_sz) +
58		prevent_optimization((unsigned char*)voidp_alignment, voidp_pat_sz) +
59		prevent_optimization((unsigned char*)double_alignment, double_pat_sz);
60		}

+37

-0

cmake/cross/linux_i386.cmake less more

	0	# This is supposed to be a TOOLCHAIN file for compiling a 32-bit version
	1	# on 64-bit Linux, but that doesn't work somehow. The work around is to
	2	# configure using
	3	#
	4	# cmake -DSWIPL_M32=ON ...
	5	#
	6	# Note that all packages, gcc and g++ need to be installed for i386,
	7	# e.g.
	8	#
	9	# apt install gcc-multilib g++-multilib
	10
	11	# apt install \
	12	# libarchive-dev:i386 libc6-dev:i386 libc6-dev-i386 \
	13	# libdb-dev:i386 libedit-dev:i386 libgmp-dev:i386 \
	14	# libice-dev:i386 libjpeg-dev:i386 libjpeg8-dev:i386 \
	15	# libncurses5-dev:i386 libossp-uuid-dev:i386 \
	16	# libpcre3-dev:i386 libssl1.0-dev:i386 \
	17	# libstdc++-7-dev:i386 libxext-dev:i386 libxft-dev:i386 \
	18	# libxinerama-dev:i386 libxpm-dev:i386 libxt-dev:i386 \
	19	# libyaml-dev:i386 zlib1g-dev:i386
	20
	21	# the name of the target operating system (if TOOLCHAIN works)
	22	# set(CMAKE_SYSTEM_NAME Linux)
	23
	24	# Tell gcc and g++ to generate i386 binaries
	25	set(CMAKE_C_FLAGS -m32)
	26	set(CMAKE_CXX_FLAGS -m32)
	27
	28	# Get this right
	29	set(CMAKE_SIZEOF_VOID_P 4)
	30
	31	# Search in /usr/lib/i386-linux-gnu for the multi archive
	32	# libraries
	33	set(CMAKE_LIBRARY_ARCHITECTURE i386-linux-gnu)
	34
	35	# Make pkg-config search in /usr/lib/i386-linux-gnu/pkgconfig
	36	set(CMAKE_PREFIX_PATH /usr)

+1

-0

library/dialect/swi/syspred_options.pl less more

119	119	:- predicate_options(system:load_files/2, 2,
120	120	[ autoload(boolean),
121	121	derived_from(atom),
	122	dialect(atom),
122	123	encoding(encoding),
123	124	expand(boolean),
124	125	format(oneof([source,qlf])),

+6

-1

library/modules.pl less more

88	88	( @(Setup, Module)
89	89	-> @(Goal, Module)
90	90	),
91		'$destroy_module'(Module)).
	91	destroy_module(Module)).
92	92
93	93	prepare_temporary_module(Module) :-
94	94	var(Module),

102	102	).
103	103	prepare_temporary_module(Module) :-
104	104	set_module(Module:class(temporary)).
	105
	106	destroy_module(Module) :-
	107	retractall(system:'$load_context_module'(_File, Module, _Options)),
	108	'$destroy_module'(Module).
	109

+1

-1

man/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-doc-core)
2	2
3	3	include(Documentation)

+8

-2

man/builtin.doc less more

929	929	conditional compilation. See \secref{conditionalcompilation}.
930	930
931	931	\item Call term_expansion/2. This predicate is first tried in
932		the module that is being compiled and then in the module
933		\const{user}.
	932	the module that is being compiled and then in modules from which
	933	this module inherits according to default_module/2. The output
	934	of the expansion in a module is used as input for the next
	935	module. Using the default setup and when compiling a normal
	936	application module \arg{M}, this implies expansion is executed
	937	in \arg{M}, \const{user} and finally in \const{system}. Library
	938	modules inherit directly from \const{system} and can thus not be
	939	re-interpreted by term expansion rules in \const{user}.
934	940
935	941	\item Call DCG expansion (dcg_translate_rule/2).
936	942

+1

-1

man/main.doc less more

58	58
59	59	\newcommand{\vmajor}{8}
60	60	\newcommand{\vminor}{0}
61		\newcommand{\vpatch}{0}
	61	\newcommand{\vpatch}{1}
62	62	\newcommand{\vtag}{}
63	63	\newcommand{\vmonth}{January}
64	64	\newcommand{\vyear}{2019}

+4

-6

man/runtime.doc less more

106	106	options:
107	107
108	108	\begin{description}
109		\termitem{local}{+KBytes}
110		Limit for the local stack. See \secref{stacksizes}.
111		\termitem{global}{+KBytes}
112		Limit for the global stack. See \secref{stacksizes}.
113		\termitem{trail}{+KBytes}
114		Limit for the trail stack. See \secref{stacksizes}.
	109	\termitem{stack_limit}{+Bytes}
	110	Sets default stack limit for the new process. See the command line
	111	option \cmdlineoption{--stack-limit} and the Prolog flag
	112	\prologflag{stack_limit}.
115	113	\termitem{goal}{:Callable}
116	114	Initialization goal for the new executable (see \cmdlineoption{-g}).
117	115	\termitem{toplevel}{:Callable}

+1

-1

man/tabling.doc less more

186	186	and does not need to deal with maintaining consistency between the
187	187	tables and ground facts.
188	188
189		\section{Mode directed tabling}
	189	\section{Answer subsumption or mode directed tabling}
190	190	\label{sec:tabling-mode-directed}
191	191
192	192	\index{answer subsumption,tabling}%

+1

-1

packages/PDT/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-PDT)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/RDF/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-RDF)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/archive/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-archive)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/bdb/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-bdb)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/chr/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-chr)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/clib/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-clib)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/clpqr/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-clpqr)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/cpp/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-cpp)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/cql/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-cql)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/http/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-http)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/http/http_client.pl less more

101	101	- 'application/json' \| 'application/jsonrequest'
102	102	Processed if library(http/http_json) is loaded. The option
103	103	json_object(As) can be used to return a term json(Attributes)
104		(`As` is `term`) or a dict (`As` is `json`).
	104	(`As` is `term`) or a dict (`As` is `dict`).
105	105	*/
106	106
107	107	/*******************************

+9

-1

packages/http/json.pl less more

930	930	!,
931	931	Value = Value0.
932	932	term_to_dict(List0, List, Options) :-
933		assertion(is_list(List0)),
	933	is_list(List0),
	934	!,
934	935	terms_to_dicts(List0, List, Options).
	936	term_to_dict(Special, Special, Options) :-
	937	( json_options_true(Options, Special)
	938	; json_options_false(Options, Special)
	939	; json_options_null(Options, Special)
	940	; json_options_end_of_file(Options, Special)
	941	),
	942	!.
935	943
936	944	json_dict_pairs([], [], _).
937	945	json_dict_pairs([Name=Value0\|T0], [Name=Value\|T], Options) :-

+1

-1

packages/inclpr/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-inclpr)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/jpl/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-jpl)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/jpl/src/java/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-jpl-jar)
2	2
3	3	find_package(Java COMPONENTS Development)

+1

-1

packages/libedit/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-libedit)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/ltx2htm/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-ltx2htm)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/nlp/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-nlp)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/nlp/libstemmer_c/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(libstemmer)
2	2
3	3	set(STEMMER_SOURCE

+74

-66

packages/nlp/porter_stem.c less more

572	572	}
573	573
574	574	if ( !(call)((const char)st, s-st, type, closure) )
575		{ while(s<se && iswalnum(*s))
	575	{ if ( PL_exception(0) )
	576	return FALSE;
	577	while(s<se && iswalnum(*s))
576	578	s++;
577	579	if ( !(call)((const char)st, s-st, TOK_WORD, closure) )
578	580	return FALSE;

642	644	}
643	645
644	646	if ( !(call)((const wchar_t)st, s-st, type, closure) )
645		{ while(s<se && iswalnum(*s))
	647	{ if ( PL_exception(0) )
	648	return FALSE;
	649	while(s<se && iswalnum(*s))
646	650	s++;
647	651	if ( !(call)((const wchar_t)st, s-st, TOK_WORD, closure) )
648	652	return FALSE;

675	679	unify_tokenA(const char s, size_t len, toktype type, void closure)
676	680	{ list *l = closure;
677	681
678		if ( PL_unify_list(l->tail, l->head, l->tail) )
679		{ switch(type)
680		{ case TOK_INT:
681		case TOK_FLOAT:
682		{ char buf[100];
683		char a, o;
684		const char *i;
685		int rc;
686
687		if ( len+1 > sizeof(buf) )
688		{ if ( !(a = malloc(len+1)) )
689		return PL_resource_error("memory");
690		} else
691		{ a = buf;
692		}
693
694		for(i=s,o=a; len-- > 0; )
695		o++ = (char)i++;
696		*o = '\0';
697
698		rc = ( PL_chars_to_term(a, l->tmp) &&
699		PL_unify(l->head, l->tmp)
700		);
701		if ( a != buf )
702		free(a);
	682	switch(type)
	683	{ case TOK_INT:
	684	case TOK_FLOAT:
	685	{ char buf[100];
	686	char a, o;
	687	const char *i;
	688	int rc;
	689
	690	if ( len+1 > sizeof(buf) )
	691	{ if ( !(a = malloc(len+1)) )
	692	return PL_resource_error("memory");
	693	} else
	694	{ a = buf;
	695	}
	696
	697	for(i=s,o=a; len-- > 0; )
	698	o++ = (char)i++;
	699	*o = '\0';
	700
	701	rc = PL_chars_to_term(a, l->tmp);
	702	if ( a != buf )
	703	free(a);
	704	if ( !rc )
703	705	return rc;
704		}
705		default:
706		return PL_unify_atom_nchars(l->head, len, s);
707		}
708		}
709
710		return FALSE;
	706	break;
	707	}
	708	default:
	709	if ( !PL_put_atom_nchars(l->tmp, len, s) )
	710	return FALSE;
	711	break;
	712	}
	713
	714	return ( PL_unify_list(l->tail, l->head, l->tail) &&
	715	PL_unify(l->head, l->tmp) );
711	716	}
712	717
713	718

715	720	unify_tokenW(const wchar_t s, size_t len, toktype type, void closure)
716	721	{ list *l = closure;
717	722
718		if ( PL_unify_list(l->tail, l->head, l->tail) )
719		{ switch(type)
720		{ case TOK_INT:
721		case TOK_FLOAT:
722		{ char buf[100];
723		char a, o;
724		const wchar_t *i;
725		int rc;
726
727		if ( len+1 > sizeof(buf) )
728		{ if ( !(a = malloc(len+1)) )
729		return PL_resource_error("memory");
730		} else
731		{ a = buf;
732		}
733
734		for(i=s,o=a; len-- > 0; )
735		o++ = (char)i++;
736		*o = '\0';
737
738		rc = ( PL_chars_to_term(a, l->tmp) &&
739		PL_unify(l->head, l->tmp)
740		);
741		if ( a != buf )
742		free(a);
	723	switch(type)
	724	{ case TOK_INT:
	725	case TOK_FLOAT:
	726	{ char buf[100];
	727	char a, o;
	728	const wchar_t *i;
	729	int rc;
	730
	731	if ( len+1 > sizeof(buf) )
	732	{ if ( !(a = malloc(len+1)) )
	733	return PL_resource_error("memory");
	734	} else
	735	{ a = buf;
	736	}
	737
	738	for(i=s,o=a; len-- > 0; )
	739	o++ = (char)i++;
	740	*o = '\0';
	741
	742	rc = PL_chars_to_term(a, l->tmp);
	743
	744	if ( a != buf )
	745	free(a);
	746	if ( !rc )
743	747	return rc;
744		}
745		default:
746		return PL_unify_wchars(l->head, PL_ATOM, len, s);
747		}
748		}
749
750		return FALSE;
	748	break;
	749	}
	750	default:
	751	if ( !PL_put_variable(l->tmp) \|\|
	752	!PL_unify_wchars(l->tmp, PL_ATOM, len, s) )
	753	return FALSE;
	754	break;
	755	}
	756
	757	return ( PL_unify_list(l->tail, l->head, l->tail) &&
	758	PL_unify(l->head, l->tmp) );
751	759	}
752	760
753	761

+1

-1

packages/odbc/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-odbc)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/paxos/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-paxos)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/pcre/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-pcre)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/pengines/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-pengines)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/pldoc/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-pldoc)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/plunit/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-plunit)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/protobufs/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-protobufs)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/readline/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-readline)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/semweb/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-semweb)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/sgml/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-sgml)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/ssl/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-ssl)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+2

-1

packages/table/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-table)
2	2
3	3	include("../cmake/PrologPackage.cmake")

12	12	C_SOURCES table.c order.c error.c
13	13	PL_LIBS table.pl table_util.pl)
14	14
	15	pkg_doc(table)

+1

-1

packages/tipc/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-tipc)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/utf8proc/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-utf8proc)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+12

-0

packages/windows/CMakeLists.txt less more

	0	cmake_minimum_required(VERSION 3.5)
	1	project(swipl-windows)
	2
	3	include("../cmake/PrologPackage.cmake")
	4
	5	if(WIN32)
	6	swipl_plugin(
	7	windows
	8	MODULE plregtry
	9	C_SOURCES plregtry.c
	10	PL_LIBS registry.pl)
	11	endif()

+41

-0

packages/windows/README less more

	0	This directory contains two examples of foreign-language extensions.
	1
	2	# dlltest.dll
	3	Simple code illustrating very basic functionality of the
	4	interface. Load it using:
	5
	6	?- load_foreign_library(dlltest).
	7
	8	It defines the following predicates:
	9
	10	say_hello(+Text)
	11	Shows a simple Windows message-box containing
	12	Text.
	13	mclock(-MilliSeconds)
	14	Return the number of milli-seconds elapsed since
	15	the library was loaded.
	16	rlc_color(+Which, +R, +G, +B)
	17	Set the color of the plwin window. Which is one
	18	of {window, text, highlight, highlighttext}, RGB
	19	are integers between 0 and 255 for the color
	20	components.
	21
	22	In addition, it illustrates how to hook into a Prolog abort.
	23
	24	# plregtry.dll
	25	Defines predicates to access the Windows registry. It is a much
	26	more elaborate example, and also a useful library. Its not
	27	documented, but with some knowledge of the Windows API it should
	28	be fairly easy to figure out how it works.
	29
	30	The .dsp files are Microsoft Visual C++ 5.0 project files. Basically, to
	31	compile them:
	32
	33	* Ensure the compile has the SWI-Prolog include directory
	34	in the search-path for header-files.
	35
	36	* Ensure the compiler has the SWI-Prolog lib directory in
	37	the search-path for libraries.
	38
	39	* Ensure WIN32 is a defined symbol (-DWIN32). MSVC normally
	40	defines this for you.

+167

-0

packages/windows/dlltest.c less more

	0	/* Part of SWI-Prolog
	1
	2	Author: Jan Wielemaker
	3	E-mail: J.Wielemaker@vu.nl
	4	WWW: http://www.swi-prolog.org
	5	Copyright (c) 2011-2013, University of Amsterdam
	6	All rights reserved.
	7
	8	Redistribution and use in source and binary forms, with or without
	9	modification, are permitted provided that the following conditions
	10	are met:
	11
	12	1. Redistributions of source code must retain the above copyright
	13	notice, this list of conditions and the following disclaimer.
	14
	15	2. Redistributions in binary form must reproduce the above copyright
	16	notice, this list of conditions and the following disclaimer in
	17	the documentation and/or other materials provided with the
	18	distribution.
	19
	20	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	21	"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
	22	LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	23	FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	24	COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	25	INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	26	BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	27	LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	28	CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	29	LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	30	ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	31	POSSIBILITY OF SUCH DAMAGE.
	32	*/
	33
	34	#include <windows.h>
	35	#include "../../src/win32/console/console.h"
	36	#include <SWI-Prolog.h>
	37	#include <stdio.h>
	38	#include <sys/timeb.h>
	39
	40	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	41	pl_say_hello() illustrates a simple foreign language predicate
	42	implementation calling a Windows function. By convention, such
	43	functions are called pl_<name_of_predicate>. Their type is foreign_t
	44	and all arguments are of type term_t.
	45	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	46
	47	static foreign_t
	48	pl_say_hello(term_t to)
	49	{ char *msg;
	50
	51	if ( PL_get_atom_chars(to, &msg) )
	52	{ MessageBox(NULL, msg, "DLL test", MB_OK\|MB_TASKMODAL);
	53
	54	PL_succeed;
	55	}
	56
	57	PL_fail;
	58	}
	59
	60
	61	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	62	Interface function to modify the console:
	63	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	64
	65	static foreign_t
	66	pl_rlc_color(term_t which, term_t r, term_t b, term_t g)
	67	{ int w;
	68	char *s;
	69	int tr, tb, tg;
	70
	71	if ( PL_get_atom_chars(which, &s) )
	72	{ if ( strcmp(s, "window") == 0 )
	73	w = RLC_WINDOW;
	74	else if ( strcmp(s, "text") == 0 )
	75	w = RLC_TEXT;
	76	else if ( strcmp(s, "highlight") == 0 )
	77	w = RLC_HIGHLIGHT;
	78	else if ( strcmp(s, "highlighttext") == 0 )
	79	w = RLC_HIGHLIGHTTEXT;
	80	else
	81	goto usage;
	82	} else
	83	goto usage;
	84
	85	if ( PL_get_integer(r, &tr) &&
	86	PL_get_integer(b, &tb) &&
	87	PL_get_integer(g, &tg) )
	88	{ if ( tr < 0 \|\| tr > 255 \|\| (tb < 0) \|\| tb > 255 \|\| tg < 0 \|\| tg > 255 )
	89	goto usage;
	90
	91	rlc_color(NULL, w, RGB(tr,tb,tg));
	92	PL_succeed;
	93	}
	94
	95	usage:
	96	PL_warning("rlc_color({window,text,highlight,highlighttext}, R, G, B)");
	97	PL_fail;
	98	}
	99
	100
	101	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	102	This function is a handle called from abort/1. The function should
	103	perform cleanup as Prolog is going to perform a long_jmp() back to the
	104	toplevel.
	105	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	106
	107	static void
	108	my_abort(void)
	109	{ MessageBox(NULL,
	110	"Execution aborted", "Abort handle test",
	111	MB_OK\|MB_TASKMODAL);
	112	}
	113
	114
	115	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	116	Define mclock/1 to query time since Prolog was started in milliseconds.
	117	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	118
	119	static struct _timeb epoch;
	120
	121	void
	122	initMClock()
	123	{ _ftime(&epoch);
	124	}
	125
	126
	127	int64_t
	128	mclock()
	129	{ struct _timeb now;
	130
	131	_ftime(&now);
	132	return (now.time - epoch.time) * 1000 +
	133	(now.millitm - epoch.millitm);
	134	}
	135
	136
	137	foreign_t
	138	pl_mclock(term_t msecs)
	139	{ return PL_unify_int64(msecs, mclock());
	140	}
	141
	142
	143	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	144	(un)install functions. Predicates registered with PL_register_foreign()
	145	donot need to be uninstalled as the Prolog toplevel driver
	146	unload_foreign_library/[1,2] will to this automatically for you.
	147
	148	As only hooks need to be uninstalled, you won't need this function very
	149	often.
	150	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	151
	152	install_t
	153	install()
	154	{ PL_register_foreign("say_hello", 1, pl_say_hello, 0);
	155	PL_register_foreign("rlc_color", 4, pl_rlc_color, 0);
	156	PL_register_foreign("mclock", 1, pl_mclock, 0);
	157
	158	initMClock();
	159	PL_abort_hook(my_abort);
	160	}
	161
	162
	163	install_t
	164	uninstall()
	165	{ PL_abort_unhook(my_abort);
	166	}

+238

-0

packages/windows/install-sh less more

	0	#!/bin/sh
	1	#
	2	# install - install a program, script, or datafile
	3	# This comes from X11R5.
	4	#
	5	# Calling this script install-sh is preferred over install.sh, to prevent
	6	# `make' implicit rules from creating a file called install from it
	7	# when there is no Makefile.
	8	#
	9	# This script is compatible with the BSD install script, but was written
	10	# from scratch.
	11	#
	12
	13
	14	# set DOITPROG to echo to test this script
	15
	16	# Don't use :- since 4.3BSD and earlier shells don't like it.
	17	doit="${DOITPROG-}"
	18
	19
	20	# put in absolute paths if you don't have them in your path; or use env. vars.
	21
	22	mvprog="${MVPROG-mv}"
	23	cpprog="${CPPROG-cp}"
	24	chmodprog="${CHMODPROG-chmod}"
	25	chownprog="${CHOWNPROG-chown}"
	26	chgrpprog="${CHGRPPROG-chgrp}"
	27	stripprog="${STRIPPROG-strip}"
	28	rmprog="${RMPROG-rm}"
	29	mkdirprog="${MKDIRPROG-mkdir}"
	30
	31	tranformbasename=""
	32	transform_arg=""
	33	instcmd="$mvprog"
	34	chmodcmd="$chmodprog 0755"
	35	chowncmd=""
	36	chgrpcmd=""
	37	stripcmd=""
	38	rmcmd="$rmprog -f"
	39	mvcmd="$mvprog"
	40	src=""
	41	dst=""
	42	dir_arg=""
	43
	44	while [ x"$1" != x ]; do
	45	case $1 in
	46	-c) instcmd="$cpprog"
	47	shift
	48	continue;;
	49
	50	-d) dir_arg=true
	51	shift
	52	continue;;
	53
	54	-m) chmodcmd="$chmodprog $2"
	55	shift
	56	shift
	57	continue;;
	58
	59	-o) chowncmd="$chownprog $2"
	60	shift
	61	shift
	62	continue;;
	63
	64	-g) chgrpcmd="$chgrpprog $2"
	65	shift
	66	shift
	67	continue;;
	68
	69	-s) stripcmd="$stripprog"
	70	shift
	71	continue;;
	72
	73	-t=*) transformarg=`echo $1 \| sed 's/-t=//'`
	74	shift
	75	continue;;
	76
	77	-b=*) transformbasename=`echo $1 \| sed 's/-b=//'`
	78	shift
	79	continue;;
	80
	81	*) if [ x"$src" = x ]
	82	then
	83	src=$1
	84	else
	85	# this colon is to work around a 386BSD /bin/sh bug
	86	:
	87	dst=$1
	88	fi
	89	shift
	90	continue;;
	91	esac
	92	done
	93
	94	if [ x"$src" = x ]
	95	then
	96	echo "install: no input file specified"
	97	exit 1
	98	else
	99	true
	100	fi
	101
	102	if [ x"$dir_arg" != x ]; then
	103	dst=$src
	104	src=""
	105
	106	if [ -d $dst ]; then
	107	instcmd=:
	108	else
	109	instcmd=mkdir
	110	fi
	111	else
	112
	113	# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
	114	# might cause directories to be created, which would be especially bad
	115	# if $src (and thus $dsttmp) contains '*'.
	116
	117	if [ -f $src -o -d $src ]
	118	then
	119	true
	120	else
	121	echo "install: $src does not exist"
	122	exit 1
	123	fi
	124
	125	if [ x"$dst" = x ]
	126	then
	127	echo "install: no destination specified"
	128	exit 1
	129	else
	130	true
	131	fi
	132
	133	# If destination is a directory, append the input filename; if your system
	134	# does not like double slashes in filenames, you may need to add some logic
	135
	136	if [ -d $dst ]
	137	then
	138	dst="$dst"/`basename $src`
	139	else
	140	true
	141	fi
	142	fi
	143
	144	## this sed command emulates the dirname command
	145	dstdir=`echo $dst \| sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
	146
	147	# Make sure that the destination directory exists.
	148	# this part is taken from Noah Friedman's mkinstalldirs script
	149
	150	# Skip lots of stat calls in the usual case.
	151	if [ ! -d "$dstdir" ]; then
	152	defaultIFS='
	153	'
	154	IFS="${IFS-${defaultIFS}}"
	155
	156	oIFS="${IFS}"
	157	# Some sh's can't handle IFS=/ for some reason.
	158	IFS='%'
	159	set - `echo ${dstdir} \| sed -e 's@/@%@g' -e 's@^%@/@'`
	160	IFS="${oIFS}"
	161
	162	pathcomp=''
	163
	164	while [ $# -ne 0 ] ; do
	165	pathcomp="${pathcomp}${1}"
	166	shift
	167
	168	if [ ! -d "${pathcomp}" ] ;
	169	then
	170	$mkdirprog "${pathcomp}"
	171	else
	172	true
	173	fi
	174
	175	pathcomp="${pathcomp}/"
	176	done
	177	fi
	178
	179	if [ x"$dir_arg" != x ]
	180	then
	181	$doit $instcmd $dst &&
	182
	183	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
	184	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
	185	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
	186	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
	187	else
	188
	189	# If we're going to rename the final executable, determine the name now.
	190
	191	if [ x"$transformarg" = x ]
	192	then
	193	dstfile=`basename $dst`
	194	else
	195	dstfile=`basename $dst $transformbasename \|
	196	sed $transformarg`$transformbasename
	197	fi
	198
	199	# don't allow the sed command to completely eliminate the filename
	200
	201	if [ x"$dstfile" = x ]
	202	then
	203	dstfile=`basename $dst`
	204	else
	205	true
	206	fi
	207
	208	# Make a temp file name in the proper directory.
	209
	210	dsttmp=$dstdir/#inst.$$#
	211
	212	# Move or copy the file name to the temp name
	213
	214	$doit $instcmd $src $dsttmp &&
	215
	216	trap "rm -f ${dsttmp}" 0 &&
	217
	218	# and set any options; do chmod last to preserve setuid bits
	219
	220	# If any of these fail, we abort the whole thing. If we want to
	221	# ignore errors from any of these, just make sure not to ignore
	222	# errors from the above "$doit $instcmd $src $dsttmp" command.
	223
	224	if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
	225	if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
	226	if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
	227	if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
	228
	229	# Now rename the file to the real destination.
	230
	231	$doit $rmcmd -f $dstdir/$dstfile &&
	232	$doit $mvcmd $dsttmp $dstdir/$dstfile
	233
	234	fi &&
	235
	236
	237	exit 0

+736

-0

packages/windows/plregtry.c less more

	0	/* Part of SWI-Prolog
	1
	2	Author: Jan Wielemaker
	3	E-mail: J.Wielemaker@vu.nl
	4	WWW: http://www.swi-prolog.org
	5	Copyright (c) 2011-2015, University of Amsterdam
	6	VU University Amsterdam
	7	All rights reserved.
	8
	9	Redistribution and use in source and binary forms, with or without
	10	modification, are permitted provided that the following conditions
	11	are met:
	12
	13	1. Redistributions of source code must retain the above copyright
	14	notice, this list of conditions and the following disclaimer.
	15
	16	2. Redistributions in binary form must reproduce the above copyright
	17	notice, this list of conditions and the following disclaimer in
	18	the documentation and/or other materials provided with the
	19	distribution.
	20
	21	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	22	"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
	23	LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	24	FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	25	COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	26	INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	27	BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	28	LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	29	CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	30	LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	31	ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	32	POSSIBILITY OF SUCH DAMAGE.
	33	*/
	34
	35	#define PL_ARITY_AS_SIZE 1
	36	#include <SWI-Prolog.h>
	37	#include <windows.h>
	38	#include <shlobj.h>
	39	#include <malloc.h>
	40	#include <assert.h>
	41	#include <limits.h>
	42
	43	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	44	This file serves two purposes. It both provides a reasonable set of
	45	examples for using the SWI-Prolog foreign (C) interface, and it provides
	46	access to the Win32 registry database. The library(registry) uses this
	47	file to register .PL files as Prolog SourceFiles and allow you for
	48	consulting and editing Prolog files immediately from the Windows 95
	49	explorer.
	50	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	51
	52	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	53	These atoms and functors (handles to a name/arity identifier are used
	54	throughout the code. We look them up at initialisation and store them in
	55	global variables. Though this module isn't very time critical, in
	56	general it provides an enormous speedup to avoid excessive lookup of
	57	atoms and functors.
	58	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	59
	60	static atom_t ATOM_classes_root;
	61	static atom_t ATOM_current_user;
	62	static atom_t ATOM_local_machine;
	63	static atom_t ATOM_users;
	64	static atom_t ATOM_all_access;
	65	static atom_t ATOM_create_link;
	66	static atom_t ATOM_create_sub_key;
	67	static atom_t ATOM_enumerate_sub_keys;
	68	static atom_t ATOM_execute;
	69	static atom_t ATOM_notify;
	70	static atom_t ATOM_query_value;
	71	static atom_t ATOM_read;
	72	static atom_t ATOM_set_value;
	73	static atom_t ATOM_write;
	74	static atom_t ATOM_volatile;
	75
	76	static functor_t FUNCTOR_binary1;
	77	static functor_t FUNCTOR_link1;
	78	static functor_t FUNCTOR_expand1;
	79
	80	static void
	81	init_constants()
	82	{ ATOM_classes_root = PL_new_atom("classes_root");
	83	ATOM_current_user = PL_new_atom("current_user");
	84	ATOM_local_machine = PL_new_atom("local_machine");
	85	ATOM_users = PL_new_atom("users");
	86	ATOM_all_access = PL_new_atom("all_access");
	87	ATOM_create_link = PL_new_atom("create_link");
	88	ATOM_create_sub_key = PL_new_atom("create_sub_key");
	89	ATOM_enumerate_sub_keys = PL_new_atom("enumerate_sub_keys");
	90	ATOM_execute = PL_new_atom("execute");
	91	ATOM_notify = PL_new_atom("notify");
	92	ATOM_query_value = PL_new_atom("query_value");
	93	ATOM_read = PL_new_atom("read");
	94	ATOM_set_value = PL_new_atom("set_value");
	95	ATOM_write = PL_new_atom("write");
	96	ATOM_volatile = PL_new_atom("volatile");
	97
	98	FUNCTOR_binary1 = PL_new_functor(PL_new_atom("binary"), 1);
	99	FUNCTOR_link1 = PL_new_functor(PL_new_atom("link"), 1);
	100	FUNCTOR_expand1 = PL_new_functor(PL_new_atom("expand"), 1);
	101	}
	102
	103
	104	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	105	Just a function to translate a Windows error code to a message. It
	106	exploits the static nature of Prolog atoms to avoid storing multiple
	107	copies of the same message.
	108	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	109
	110	static const char *
	111	APIError(DWORD id)
	112	{ char *msg;
	113	static WORD lang;
	114	static int lang_initialised = 0;
	115
	116	if ( !lang_initialised )
	117	lang = MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_UK);
	118
	119	again:
	120	if ( FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER\|
	121	FORMAT_MESSAGE_IGNORE_INSERTS\|
	122	FORMAT_MESSAGE_FROM_SYSTEM,
	123	NULL, /* source */
	124	id, /* identifier */
	125	lang,
	126	(LPTSTR) &msg,
	127	0, /* size */
	128	NULL) ) /* arguments */
	129	{ atom_t a = PL_new_atom(msg);
	130
	131	LocalFree(msg);
	132	lang_initialised = 1;
	133
	134	return PL_atom_chars(a);
	135	} else
	136	{ if ( lang_initialised == 0 )
	137	{ lang = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
	138	lang_initialised = 1;
	139	goto again;
	140	}
	141
	142	return "Unknown Windows error";
	143	}
	144	}
	145
	146
	147	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	148
	149	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	150
	151	#define CompoundArg(name, arity) \
	152	PL_FUNCTOR, PL_new_functor(PL_new_atom(name), (arity))
	153	#define AtomArg(name) \
	154	PL_CHARS, name
	155	#define IntArg(i) \
	156	PL_INTEGER, (i)
	157	#define TermArg(t) \
	158	PL_TERM, (t)
	159
	160	#include <winerror.h>
	161
	162	static int
	163	api_exception(DWORD err, const char *action, term_t key)
	164	{ term_t except = PL_new_term_ref();
	165	term_t formal = PL_new_term_ref();
	166	term_t swi = PL_new_term_ref();
	167	const char *msg = NULL;
	168	int rc;
	169
	170	switch(err)
	171	{ case ERROR_ACCESS_DENIED:
	172	{ rc = PL_unify_term(formal,
	173	CompoundArg("permission_error", 3),
	174	AtomArg(action),
	175	AtomArg("key"),
	176	TermArg(key));
	177	break;
	178	}
	179	default:
	180	rc = PL_unify_atom_chars(formal, "system_error");
	181	msg = APIError(err);
	182	break;
	183	}
	184
	185	if ( rc && msg )
	186	{ term_t msgterm = PL_new_term_ref();
	187
	188	if ( msg )
	189	{ PL_put_atom_chars(msgterm, msg);
	190	}
	191
	192	rc = PL_unify_term(swi,
	193	CompoundArg("context", 2),
	194	PL_VARIABLE,
	195	PL_TERM, msgterm);
	196	}
	197
	198	if ( rc )
	199	{ rc = PL_unify_term(except,
	200	CompoundArg("error", 2),
	201	PL_TERM, formal,
	202	PL_TERM, swi);
	203	}
	204
	205	if ( rc )
	206	return PL_raise_exception(except);
	207
	208	return rc;
	209	}
	210
	211
	212	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	213	Translate a term, that is either an atom, indicating one of the
	214	predefined roots of the registry, or an integer that is an open registry
	215	handle. Integers are 32-bit wide, so it is generally ok to store handles
	216	in Prolog integers. Note however that Prolog integers above
	217	max_tagged_integer require considerably more space.
	218	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	219
	220	static HKEY
	221	to_key(term_t h)
	222	{ atom_t n;
	223	int k;
	224
	225	if ( PL_get_atom(h, &n) ) /* named key */
	226	{ if ( n == ATOM_classes_root )
	227	return HKEY_CLASSES_ROOT;
	228	if ( n == ATOM_current_user )
	229	return HKEY_CURRENT_USER;
	230	if ( n == ATOM_local_machine )
	231	return HKEY_LOCAL_MACHINE;
	232	if ( n == ATOM_users )
	233	return HKEY_USERS;
	234	}
	235
	236	if ( PL_get_integer(h, &k) )
	237	return (HKEY)(intptr_t)k; /* integer key */
	238
	239	return 0; /* invalid key */
	240	}
	241
	242
	243	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	244	reg_subkeys(+Super, -Subs)
	245	Return list of keys below Super. The list of keys is of the
	246	form key(KeyName, KeyClass).
	247
	248	****
	249
	250	This predicate illustrates returning a list of atoms. First, the
	251	argument reference is copied into the `tail' reference. This is not
	252	strictly necessary, but if you don't do this, the tracer will always
	253	think this predicate succeeded with the empty list. `head' is just a new
	254	term reference, used for handling the various cells.
	255	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	256
	257	foreign_t
	258	pl_reg_subkeys(term_t h, term_t l)
	259	{ HKEY k = to_key(h);
	260	int i;
	261	term_t tail = PL_copy_term_ref(l);
	262	term_t head = PL_new_term_ref();
	263
	264	if ( !k )
	265	PL_fail;
	266
	267	for(i=0;;i++)
	268	{ long rval;
	269	char kname[256];
	270	size_t sk = sizeof(kname);
	271	char cname[256];
	272	size_t sc = sizeof(cname);
	273	FILETIME t;
	274
	275	rval = RegEnumKeyEx(k, i, kname, (LPDWORD)&sk, NULL, cname, (LPDWORD)&sc, &t);
	276	if ( rval == ERROR_SUCCESS )
	277	{ if ( PL_unify_list(tail, head, tail) &&
	278	PL_unify_atom_chars(head, kname) )
	279	continue;
	280	else
	281	PL_fail; /* close key? */
	282	} else if ( rval == ERROR_NO_MORE_ITEMS )
	283	{ return PL_unify_nil(tail);
	284	} else
	285	{ return api_exception(rval, "enum_subkeys", h);
	286	}
	287	}
	288	}
	289
	290
	291	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	292	Maybe better in a table ...
	293	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	294
	295	static REGSAM
	296	access_code(atom_t name)
	297	{ if ( name == ATOM_all_access )
	298	return KEY_ALL_ACCESS;
	299	if ( name == ATOM_create_link )
	300	return KEY_CREATE_LINK;
	301	if ( name == ATOM_create_sub_key )
	302	return KEY_CREATE_SUB_KEY;
	303	if ( name == ATOM_enumerate_sub_keys )
	304	return KEY_ENUMERATE_SUB_KEYS;
	305	if ( name == ATOM_execute )
	306	return KEY_EXECUTE;
	307	if ( name == ATOM_notify )
	308	return KEY_NOTIFY;
	309	if ( name == ATOM_query_value )
	310	return KEY_QUERY_VALUE;
	311	if ( name == ATOM_read )
	312	return KEY_READ;
	313	if ( name == ATOM_set_value )
	314	return KEY_SET_VALUE;
	315	if ( name == ATOM_write )
	316	return KEY_WRITE;
	317
	318	return 0; /* bad key */
	319	}
	320
	321
	322	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	323	Read a list. Instead of PL_unify_list(), this uses PL_get_list(), which
	324	fails if the argument is not instantiated to a list.
	325	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	326
	327	static int
	328	get_access(term_t access, REGSAM *mode)
	329	{ atom_t a;
	330
	331	if ( PL_get_atom(access, &a) )
	332	*mode = access_code(a);
	333	else
	334	{ term_t tail = PL_copy_term_ref(access);
	335	term_t head = PL_new_term_ref();
	336
	337	*mode = 0;
	338	while(PL_get_list(tail, head, tail))
	339	{ if ( PL_get_atom(head, &a) )
	340	*mode \|= access_code(a);
	341	else
	342	return FALSE;
	343	}
	344	if ( !PL_get_nil(tail) )
	345	return FALSE;
	346	}
	347
	348	return TRUE;
	349	}
	350
	351
	352	foreign_t
	353	pl_reg_open_key(term_t parent, term_t name, term_t access, term_t handle)
	354	{ HKEY kp;
	355	char *s;
	356	REGSAM mode;
	357	HKEY rk;
	358	long rval;
	359
	360	if ( !(kp = to_key(parent)) \|\|
	361	!PL_get_atom_chars(name, &s) \|\|
	362	!get_access(access, &mode) )
	363	PL_fail;
	364
	365	rval = RegOpenKeyEx(kp, s, 0L, mode, &rk);
	366	if ( rval == ERROR_SUCCESS )
	367	return PL_unify_integer(handle, (int)(intptr_t)rk);
	368	if ( rval == ERROR_FILE_NOT_FOUND )
	369	PL_fail;
	370
	371	return api_exception(rval, "open", name);
	372	}
	373
	374
	375	foreign_t
	376	pl_reg_close_key(term_t h)
	377	{ HKEY k;
	378
	379	if ( PL_is_integer(h) && (k = to_key(h)) )
	380	{ RegCloseKey(k);
	381	}
	382
	383	PL_succeed;
	384	}
	385
	386
	387	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	388	reg_delete_key(+ParentHandle, +Name)
	389	Delete key from parent.
	390	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	391
	392	foreign_t
	393	pl_reg_delete_key(term_t h, term_t sub)
	394	{ HKEY k;
	395	char *s;
	396	DWORD rval;
	397
	398	if ( !(k = to_key(h)) \|\|
	399	!PL_get_atom_chars(sub, &s) )
	400	PL_fail;
	401
	402	if ( (rval = RegDeleteKey(k, s)) == ERROR_SUCCESS )
	403	PL_succeed;
	404
	405	return api_exception(rval, "delete", sub);
	406	}
	407
	408	/*******************************
	409	* VALUE *
	410	*******************************/
	411
	412	foreign_t
	413	pl_reg_value_names(term_t h, term_t names)
	414	{ HKEY k;
	415	DWORD rval;
	416	term_t tail = PL_copy_term_ref(names);
	417	term_t head = PL_new_term_ref();
	418	DWORD i;
	419
	420	if ( !(k = to_key(h)) )
	421	PL_fail;
	422
	423	for(i=0;;i++)
	424	{ char name[256];
	425	DWORD sizen = sizeof(name);
	426
	427	rval = RegEnumValue(k, i, name, &sizen, NULL, NULL, NULL, NULL);
	428	if ( rval == ERROR_SUCCESS )
	429	{ if ( PL_unify_list(tail, head, tail) &&
	430	PL_unify_atom_chars(head, name) )
	431	continue;
	432	} else if ( rval == ERROR_NO_MORE_ITEMS )
	433	{ return PL_unify_nil(tail);
	434	} else
	435	return api_exception(rval, "names", h);
	436	}
	437	}
	438
	439
	440	foreign_t
	441	pl_reg_value(term_t h, term_t name, term_t value)
	442	{ HKEY k;
	443	char *vname;
	444	DWORD rval;
	445	BYTE databuf[1024];
	446	LPBYTE data = databuf;
	447	DWORD sizedata = sizeof(databuf);
	448	DWORD type;
	449
	450	if ( !(k = to_key(h)) \|\| !PL_get_atom_chars(name, &vname) )
	451	PL_fail;
	452
	453	rval = RegQueryValueEx(k, vname, NULL, &type, data, &sizedata);
	454	if ( rval == ERROR_MORE_DATA )
	455	{ data = alloca(sizedata);
	456	rval = RegQueryValueEx(k, vname, NULL, &type, data, &sizedata);
	457	}
	458
	459	if ( rval == ERROR_SUCCESS )
	460	{ switch(type)
	461	{ case REG_BINARY:
	462	{ term_t head = PL_new_term_ref();
	463	term_t tail = PL_new_term_ref();
	464
	465	if ( PL_unify_term(value, PL_FUNCTOR, FUNCTOR_binary1,
	466	PL_TERM, tail) )
	467	{ DWORD i;
	468
	469	for(i=0; i<sizedata; i++)
	470	{ if ( !PL_unify_list(tail, head, tail) \|\|
	471	!PL_unify_integer(head, data[i]) )
	472	PL_fail;
	473	}
	474
	475	return PL_unify_nil(tail);
	476	}
	477
	478	PL_fail;
	479	}
	480	{ DWORD v;
	481	case REG_DWORD_BIG_ENDIAN:
	482	{ DWORD v0 = ((DWORD )data);
	483
	484	v = ((v0 >> 0) % 0xff) << 24 \|
	485	((v0 >> 8) % 0xff) << 16 \|
	486	((v0 >> 16) % 0xff) << 8 \|
	487	((v0 >> 24) % 0xff) << 0;
	488	goto case_dword;
	489	}
	490	/* case REG_DWORD: */
	491	case REG_DWORD_LITTLE_ENDIAN:
	492	v = ((DWORD )data);
	493	case_dword:
	494	return PL_unify_integer(value, v);
	495	}
	496	/* case REG_QWORD: */
	497	case REG_QWORD_LITTLE_ENDIAN:
	498	{ DWORD64 v = ((DWORD64 )data);
	499	return PL_unify_integer(value, v);
	500	}
	501	case REG_EXPAND_SZ:
	502	{ return PL_unify_term(value, PL_FUNCTOR, FUNCTOR_expand1,
	503	PL_CHARS, (char *)data);
	504	}
	505	case REG_LINK:
	506	{ return PL_unify_term(value, PL_FUNCTOR, FUNCTOR_link1,
	507	PL_CHARS, (char *)data);
	508	}
	509	case REG_MULTI_SZ:
	510	{ term_t tail = PL_copy_term_ref(value);
	511	term_t head = PL_new_term_ref();
	512	char s = (char )data;
	513
	514	while(*s)
	515	{ if ( !PL_unify_list(tail, head, tail) \|\|
	516	!PL_unify_atom_chars(head, s) )
	517	PL_fail;
	518
	519	s += strlen(s) + 1;
	520	}
	521
	522	return PL_unify_nil(tail);
	523	}
	524	case REG_NONE:
	525	return PL_unify_atom_chars(value, "<none>");
	526	case REG_RESOURCE_LIST:
	527	return PL_unify_atom_chars(value, "<resource_list>");
	528	case REG_SZ:
	529	return PL_unify_atom_chars(value, (char *)data);
	530	}
	531	} else
	532	return api_exception(rval, "write", h);
	533
	534	assert(0);
	535	return FALSE;
	536	}
	537
	538
	539	foreign_t
	540	pl_reg_set_value(term_t h, term_t name, term_t value)
	541	{ HKEY k;
	542	char *vname;
	543	DWORD rval, type;
	544	int64_t intval;
	545	size_t len;
	546	BYTE *data;
	547
	548	if ( !(k = to_key(h)) \|\| !PL_get_atom_chars(name, &vname) )
	549	PL_fail;
	550
	551	switch(PL_term_type(value))
	552	{ case PL_ATOM:
	553	{ if ( !PL_get_atom_chars(value, (char**)&data) )
	554	goto instantiation_error;
	555	len = strlen((char*)data) + 1;
	556	type = REG_SZ;
	557	break;
	558	}
	559	case PL_STRING:
	560	{ size_t l;
	561	if ( !PL_get_string(value, (char**)&data, &l) )
	562	goto instantiation_error;
	563	len = l;
	564	type = REG_SZ;
	565	break;
	566	}
	567	case PL_INTEGER:
	568	{ if ( !PL_get_int64(value, &intval) )
	569	goto instantiation_error;
	570	data = (BYTE *) &intval;
	571	if ( intval > INT_MAX \|\| intval < INT_MIN )
	572	{ len = sizeof(DWORD64);
	573	type = REG_QWORD;
	574	}
	575	else
	576	{ len = sizeof(DWORD);
	577	type = REG_DWORD;
	578	}
	579	break;
	580	}
	581	case PL_TERM:
	582	{ if ( PL_is_functor(value, FUNCTOR_link1) )
	583	{ type = REG_LINK;
	584	goto argdata;
	585	} else if ( PL_is_functor(value, FUNCTOR_expand1) )
	586	{ term_t a;
	587
	588	type = REG_EXPAND_SZ;
	589
	590	argdata:
	591	a = PL_new_term_ref();
	592	if ( !(PL_get_arg(1, value, a) &&
	593	PL_get_atom_chars(a, (char**)&data)) )
	594	goto instantiation_error;
	595	len = strlen((char*)data) + 1;
	596	break;
	597	} else { /* TBD: MULTI_SZ (list) */
	598	goto domain_error;
	599	}
	600	}
	601	case PL_VARIABLE:
	602	instantiation_error:
	603	{ return PL_instantiation_error(value);
	604	}
	605	default:
	606	domain_error:
	607	{ return PL_domain_error("registry_value", value);
	608	}
	609	}
	610
	611	rval = RegSetValueEx(k, vname, 0L, type, data, (DWORD)len);
	612	if ( rval == ERROR_SUCCESS )
	613	PL_succeed;
	614
	615	return api_exception(rval, "write", h);
	616	}
	617
	618
	619	foreign_t
	620	pl_reg_delete_value(term_t h, term_t name)
	621	{ HKEY k;
	622	char *vname;
	623	LONG rval;
	624
	625	if ( !(k = to_key(h)) \|\| !PL_get_atom_chars(name, &vname) )
	626	PL_fail;
	627
	628	if ( (rval = RegDeleteValue(k, vname)) == ERROR_SUCCESS )
	629	PL_succeed;
	630
	631	return api_exception(rval, "delete", name);
	632	}
	633
	634
	635
	636
	637	foreign_t
	638	pl_reg_flush(term_t h)
	639	{ HKEY k;
	640
	641	if ( (k = to_key(h)) )
	642	{ DWORD rval;
	643
	644	if ( (rval = RegFlushKey(k)) == ERROR_SUCCESS )
	645	PL_succeed;
	646
	647	return api_exception(rval, "flush", h);
	648	}
	649
	650	PL_fail;
	651	}
	652
	653
	654	foreign_t
	655	pl_reg_create_key(term_t h, term_t name,
	656	term_t class, term_t options, term_t access,
	657	term_t key)
	658	{ HKEY k, skey;
	659	char kname; / key-name */
	660	char cname; / class-name */
	661	REGSAM mode;
	662	DWORD ops = REG_OPTION_NON_VOLATILE;
	663	term_t tail = PL_copy_term_ref(options);
	664	term_t head = PL_new_term_ref();
	665	DWORD rval;
	666	DWORD disp;
	667
	668	if ( !(k = to_key(h)) \|\|
	669	!PL_get_atom_chars(name, &kname) \|\|
	670	!PL_get_atom_chars(class, &cname) \|\|
	671	!get_access(access, &mode) )
	672	PL_fail;
	673
	674	while(PL_get_list(tail, head, tail))
	675	{ atom_t a;
	676
	677	if ( PL_get_atom(head, &a) )
	678	{ if ( a == ATOM_volatile )
	679	{ ops &= ~REG_OPTION_NON_VOLATILE;
	680	ops \|= REG_OPTION_VOLATILE;
	681	continue;
	682	}
	683	}
	684
	685	PL_fail;
	686	}
	687	if ( !PL_get_nil(tail) )
	688	PL_fail;
	689
	690	rval = RegCreateKeyEx(k, kname, 0L, cname, ops, mode, NULL, &skey, &disp);
	691	if ( rval == ERROR_SUCCESS )
	692	return PL_unify_integer(key, (int)(intptr_t)skey);
	693	else
	694	return api_exception(rval, "create", name);
	695	}
	696
	697	/*******************************
	698	* FLUSH SHELL *
	699	*******************************/
	700
	701	static foreign_t
	702	win_flush_filetypes()
	703	{ SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_FLUSHNOWAIT, NULL, NULL);
	704
	705	return TRUE;
	706	}
	707
	708	/*******************************
	709	* INSTALL *
	710	*******************************/
	711
	712	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	713	Finally, register the predicates. Simply calling
	714
	715	?- load_foreign_library(plregtry).
	716
	717	will makes these available in the calling context module.
	718	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	719
	720	install_t
	721	install()
	722	{ init_constants();
	723
	724	PL_register_foreign("reg_subkeys", 2, pl_reg_subkeys, 0);
	725	PL_register_foreign("reg_open_key", 4, pl_reg_open_key, 0);
	726	PL_register_foreign("reg_close_key", 1, pl_reg_close_key, 0);
	727	PL_register_foreign("reg_delete_key", 2, pl_reg_delete_key, 0);
	728	PL_register_foreign("reg_value_names", 2, pl_reg_value_names, 0);
	729	PL_register_foreign("reg_value", 3, pl_reg_value, 0);
	730	PL_register_foreign("reg_set_value", 3, pl_reg_set_value, 0);
	731	PL_register_foreign("reg_delete_value",2, pl_reg_delete_value,0);
	732	PL_register_foreign("reg_flush", 1, pl_reg_flush, 0);
	733	PL_register_foreign("reg_create_key", 6, pl_reg_create_key, 0);
	734	PL_register_foreign("win_flush_filetypes", 0, win_flush_filetypes, 0);
	735	}

+237

-0

packages/windows/registry.pl less more

	0	/* Part of SWI-Prolog
	1
	2	Author: Jan Wielemaker
	3	E-mail: J.Wielemaker@vu.nl
	4	WWW: http://www.swi-prolog.org
	5	Copyright (c) 2011-2013, University of Amsterdam
	6	All rights reserved.
	7
	8	Redistribution and use in source and binary forms, with or without
	9	modification, are permitted provided that the following conditions
	10	are met:
	11
	12	1. Redistributions of source code must retain the above copyright
	13	notice, this list of conditions and the following disclaimer.
	14
	15	2. Redistributions in binary form must reproduce the above copyright
	16	notice, this list of conditions and the following disclaimer in
	17	the documentation and/or other materials provided with the
	18	distribution.
	19
	20	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
	21	"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
	22	LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
	23	FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
	24	COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
	25	INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
	26	BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
	27	LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	28	CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	29	LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
	30	ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
	31	POSSIBILITY OF SUCH DAMAGE.
	32	*/
	33
	34	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	35	This module requires plregtry.ddl, for which the sources are in the
	36	dlldemo directory.
	37	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	38
	39	:- module(win_registry,
	40	[ registry_get_key/2, % +Path, -Value
	41	registry_get_key/3, % +Path, +Name, -Value
	42	registry_set_key/2, % +Path, +Value
	43	registry_set_key/3, % +Path, +Name, +Value
	44	registry_delete_key/1, % +Path
	45	registry_lookup_key/3, % +Path, +Access, -Key
	46	win_flush_filetypes/0, % Flush changes filetypes to shell
	47
	48	shell_register_file_type/4, % +Ext, +Type, +Name, +Open
	49	shell_register_file_type/5, % +Ext, +Type, +Name, +Open, +Icon
	50	shell_register_dde/6, % +Type, +Action,
	51	% +Service, Topic, +DDECommand
	52	% +IfNotRunning
	53	shell_register_prolog/1 % +Extension
	54	]).
	55
	56	:- use_foreign_library(foreign(plregtry)). % load plregtry.ddl
	57
	58	/*******************************
	59	* REGISTER PROLOG *
	60	*******************************/
	61
	62	shell_register_prolog(Ext) :-
	63	current_prolog_flag(executable, Me),
	64	atomic_list_concat(['"', Me, '" "%1"'], OpenCommand),
	65	atom_concat(Me, ',0', Icon),
	66	shell_register_file_type(Ext, 'prolog.type', 'Prolog Source',
	67	OpenCommand, Icon),
	68	shell_register_dde('prolog.type', consult,
	69	prolog, control, 'consult(''%1'')', Me),
	70	shell_register_dde('prolog.type', edit,
	71	prolog, control, 'edit(''%1'')', Me),
	72	win_flush_filetypes.
	73
	74
	75	/*******************************
	76	* WINDOWS SHELL STUFF *
	77	*******************************/
	78
	79	%! shell_register_file_type(+Ext, +Type, +Name, +Open) is det.
	80	%! shell_register_file_type(+Ext, +Type, +Name, +Open, +Icon) is det.
	81	%
	82	% Register an extension to a type. The open command for the type
	83	% is defined and files with this extension will be given Name as
	84	% their description in the explorer. For example:
	85	%
	86	% ==
	87	% ?- shell_register_file_type(pl, 'prolog.type', 'Prolog Source',
	88	% '"c:\\pl\\bin\\plwin.exe" "%1"').
	89	% ==
	90	%
	91	% The icon command is of the form File.exe,N or File.ico,0
	92
	93	shell_register_file_type(Ext, Type, Name, Open) :-
	94	ensure_dot(Ext, DExt),
	95	registry_set_key(classes_root/DExt, Type),
	96	registry_set_key(classes_root/Type, Name),
	97	registry_set_key(classes_root/Type/shell/open/command, Open),
	98	win_flush_filetypes.
	99	shell_register_file_type(Ext, Type, Name, Open, Icon) :-
	100	shell_register_file_type(Ext, Type, Name, Open),
	101	registry_set_key(classes_root/Type/'DefaultIcon', Icon),
	102	win_flush_filetypes.
	103
	104	ensure_dot(Ext, Ext) :-
	105	atom_concat('.', _, Ext),
	106	!.
	107	ensure_dot(Ext, DExt) :-
	108	atom_concat('.', Ext, DExt).
	109
	110	%! shell_register_dde(+Type, +Action, +Service,
	111	%! +Topic, +DDECommand, +IfNotRunning) is det.
	112	%
	113	% Register a DDE command for the type. The example below will
	114	% send DDE_EXECUTE command `consult('<File>') to the service
	115	% prolog, given the topic control.
	116	%
	117	% ==
	118	% shell_register_dde('prolog.type', consult,
	119	% prolog, control, 'consult(''%1'')',
	120	% 'c:\\pl\\bin\\plwin.exe -g "edit(''%1'')"').
	121	% ==
	122
	123	shell_register_dde(Type, Action, Service, Topic, DDECommand, IfNotRunning) :-
	124	registry_make_key(classes_root/Type/shell/Action/ddeexec,
	125	all_access, EKey),
	126	registry_set_key(classes_root/Type/shell/Action/command, IfNotRunning),
	127	reg_set_value(EKey, '', DDECommand),
	128	registry_set_key(EKey/'Application', Service),
	129	registry_set_key(EKey/ifexec, ''),
	130	registry_set_key(EKey/topic, Topic),
	131	reg_close_key(EKey).
	132
	133	/*******************************
	134	* REGISTRY STUFF *
	135	*******************************/
	136
	137	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	138	In the commands below, Path refers to the path-name of the registry. A
	139	path is a '/' separated description, where the / should be interpreted
	140	as a Prolog operator. For example, classes_root/'prolog.type'/shell. The
	141	components should be atoms.
	142	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	143
	144	%! registry_set_key(+Path, +Value) is det.
	145	%! registry_set_key(+Path, +Name, +Value) is det.
	146	%
	147	% Associate a (string) value with the key described by Path. If
	148	% part of the path does not exist, the required keys will be created.
	149
	150	registry_set_key(Path, Value) :-
	151	registry_set_key(Path, '', Value).
	152	registry_set_key(Path, Name, Value) :-
	153	registry_make_key(Path, write, Key, Close),
	154	reg_set_value(Key, Name, Value),
	155	Close.
	156
	157	%! registry_get_key(+Path, -Value) is semidet.
	158	%! registry_get_key(+Path, +Name, -Value) is semidet.
	159	%
	160	% Get the value associated with the given key. If the key does not
	161	% exists, the predicate fails silently.
	162
	163	registry_get_key(Path, Value) :-
	164	registry_get_key(Path, '', Value).
	165	registry_get_key(Path, Name, Value) :-
	166	registry_lookup_key(Path, read, Key, Close),
	167	( reg_value(Key, Name, RawVal)
	168	-> Close,
	169	Value = RawVal
	170	; Close,
	171	fail
	172	).
	173
	174	%! registry_delete_key(+Path)
	175	%
	176	% Delete the gven key and all its subkeys and values. Note that
	177	% the root-keys cannot be deleted.
	178
	179	registry_delete_key(Parent/Node) :-
	180	!,
	181	registry_lookup_key(Parent, all_access, PKey),
	182	( reg_open_key(PKey, Node, all_access, Key)
	183	-> delete_subkeys(Key),
	184	reg_close_key(Key),
	185	reg_delete_key(PKey, Node)
	186	),
	187	reg_close_key(PKey).
	188
	189	delete_subkeys(Parent) :-
	190	reg_subkeys(Parent, Subs),
	191	forall(member(Sub, Subs),
	192	delete_subkey(Parent, Sub)).
	193
	194	delete_subkey(Parent, Sub) :-
	195	reg_open_key(Parent, Sub, all_access, Key),
	196	delete_subkeys(Key),
	197	reg_close_key(Key),
	198	reg_delete_key(Parent, Sub).
	199
	200	%! registry_make_key(+Path, +Access, -Key)
	201	%
	202	% Open the given key and create required keys if the path does not
	203	% exist.
	204
	205	registry_make_key(Path, Access, Key) :-
	206	registry_make_key(Path, Access, Key, _).
	207
	208	registry_make_key(A/B, Access, Key, Close) :-
	209	!,
	210	registry_make_key(A, Access, Parent, CloseParent),
	211	( reg_open_key(Parent, B, Access, RawKey)
	212	-> true
	213	; reg_create_key(Parent, B, '', [], Access, RawKey)
	214	),
	215	CloseParent,
	216	Close = reg_close_key(RawKey),
	217	Key = RawKey.
	218	registry_make_key(Key, _, Key, true).
	219
	220	%! registry_lookup_key(+Path, +Access, -Key)
	221	%
	222	% Open the given key, fail silently if the key doesn't
	223	% exist.
	224
	225	registry_lookup_key(Path, Access, Key) :-
	226	registry_lookup_key(Path, Access, Key, _).
	227
	228	registry_lookup_key(A/B, Access, Key, Close) :-
	229	!,
	230	registry_lookup_key(A, Access, Parent, CloseParent),
	231	reg_open_key(Parent, B, Access, RawKey),
	232	CloseParent,
	233	Close = reg_close_key(RawKey),
	234	Key = RawKey.
	235	registry_lookup_key(Key, _, Key, true).
	236

+11

-0

packages/windows/testenv less more

	0	#!/bin/sh
	1
	2	# PLARCH is passed from packages/configure
	3
	4	case $PLARCH in
	5	-win32\|-win64)
	6	exit 0
	7	;;
	8	*)
	9	exit 1
	10	esac

+1

-1

packages/xpce/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-xpce)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/yaml/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-yaml)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

packages/zlib/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl-zlib)
2	2
3	3	include("../cmake/PrologPackage.cmake")

+1

-1

scripts/make-src-tape less more

9	9	# This script requires GNU-tar!
10	10
11	11	COREMODULES="bench packages/chr packages/clpqr packages/inclpr packages/jpl"
12		COREMODULES+=" packages/xpce packages/odbc packages/protobufs"
	12	COREMODULES+=" packages/xpce packages/odbc packages/protobufs packages/windows"
13	13	COREMODULES+=" packages/sgml packages/clib packages/http packages/plunit"
14	14	COREMODULES+=" packages/pldoc packages/RDF packages/semweb packages/ssl"
15	15	COREMODULES+=" packages/zlib packages/tipc packages/table packages/ltx2htm"

+1

-1

src/CMakeLists.txt less more

0		cmake_minimum_required(VERSION 2.8.12)
	0	cmake_minimum_required(VERSION 3.5)
1	1	project(swipl)
2	2
3	3	set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} "${CMAKE_CURRENT_SOURCE_DIR}/../cmake")

+1

-1

src/SWI-Prolog.h less more

67	67	/* PLVERSION_TAG: a string, normally "", but for example "rc1" */
68	68
69	69	#ifndef PLVERSION
70		#define PLVERSION 80000
	70	#define PLVERSION 80001
71	71	#endif
72	72	#ifndef PLVERSION_TAG
73	73	#define PLVERSION_TAG ""

+8

-5

src/pl-comp.c less more

2212	2212	#if SIZEOF_VOIDP == 8
2213	2213	Output_1(ci, (where&A_HEAD) ? H_INTEGER : B_INTEGER, (intptr_t)val);
2214	2214	#else
2215		if ( val >= LONG_MIN && val <= LONG_MAX )
	2215	if ( val >= INTPTR_MIN && val <= INTPTR_MAX )
2216	2216	{ Output_1(ci, (where&A_HEAD) ? H_INTEGER : B_INTEGER, (intptr_t)val);
2217	2217	} else
2218	2218	{ int c = ((where&A_HEAD) ? H_INT64 : B_INT64);

3724	3724	/* assert[az]/1 */
3725	3725
3726	3726	if ( false(def, P_DYNAMIC) )
3727		{ if ( !setDynamicDefinition(def, TRUE) )
3728		{ freeClause(clause);
3729		return NULL;
3730		}
	3727	{ if ( isDefinedProcedure(proc) )
	3728	{ PL_error(NULL, 0, NULL, ERR_MODIFY_STATIC_PROC, proc);
	3729	goto error;
	3730	}
	3731	if ( !setDynamicDefinition(def, TRUE) )
	3732	goto error;
3731	3733	}
3732	3734
3733	3735	if ( (cref=assertProcedure(proc, clause, where PASS_LD)) )
3734	3736	return cref->value.clause;
3735	3737
	3738	error:
3736	3739	freeClause(clause);
3737	3740	return NULL;
3738	3741	}

+5

-2

src/pl-vmi.c less more

4678	4678	}
4679	4679
4680	4680
	4681	/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
	4682	This instruction deals with @(Callable, Module), where Module is a
	4683	variable. The module argument can be NULL.
	4684	- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
	4685
4681	4686	VMI(I_CALLATMV, VIF_BREAK, 3, (CA1_MODULE, CA1_VAR, CA1_PROC))
4682	4687	{ Word ap;
4683	4688	int iv;

4701	4706	popTermRef();
4702	4707	THROW_EXCEPTION;
4703	4708	}
4704
4705		VMI_GOTO(I_CALLM);
4706	4709	}
4707	4710
4708	4711	#endif

+11

-10

src/pl-wic.c less more

1953	1953	saveXRModule(wic_state *state, Module m ARG_LD)
1954	1954	{ IOSTREAM *fd = state->wicFd;
1955	1955
	1956	if ( !m )
	1957	{ Sputc(XR_NULL, fd);
	1958	return;
	1959	}
	1960
1956	1961	if ( savedXRPointer(state, m) )
1957	1962	return;
1958	1963
1959		if ( m )
1960		{ Sputc(XR_MODULE, fd);
1961		DEBUG(MSG_QLF_XR,
1962		Sdprintf("XR(%d) = module %s\n",
1963		state->savedXRTableId, stringAtom(m->name)));
1964		saveXR(state, m->name);
1965		} else
1966		{ Sputc(XR_NULL, fd);
1967		}
	1964	Sputc(XR_MODULE, fd);
	1965	DEBUG(MSG_QLF_XR,
	1966	Sdprintf("XR(%d) = module %s\n",
	1967	state->savedXRTableId, stringAtom(m->name)));
	1968	saveXR(state, m->name);
1968	1969	}
1969	1970
1970	1971

2143	2144	break;
2144	2145	}
2145	2146	case CA1_MODULE:
2146		{ Module m = (Module) *bp++;
	2147	{ Module m = (Module) bp++; / can be NULL, see I_CALLATMV */
2147	2148	saveXRModule(state, m PASS_LD);
2148	2149	break;
2149	2150	}

+2

-2

src/test.pl less more

1300	1300	forall(retract(myfoo(_,_)), true),
1301	1301	\+ clause(myfoo(_,_), _).
1302	1302	proc(retract-2) :-
1303		assert((test(X, Y) :- X is Y + 3)),
1304		retract((test(A, B) :- Body)),
	1303	assert((test_retract_2(X, Y) :- X is Y + 3)),
	1304	retract((test_retract_2(A, B) :- Body)),
1305	1305	Body == (A is B + 3).
1306	1306	proc(retract-3) :-
1307	1307	assert(myunit(1)),