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

improve SWI compatibility, especilaly for threaded stuff.

Browse Source
This commit is contained in:
Vítor Santos Costa 2010-08-04 11:37:12 +01:00
parent 6ee0ce8e48
commit bebb236e32
16 changed files with 439 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
C/iopreds.c
View File

@ -272,6 +272,9 @@ yap_fflush(int sno)
Socket_Stream_f|
Pipe_Stream_f|
Free_Stream_f)) ) {
if (Stream[sno].status & SWI_Stream_f) {
return SWIFlush(Stream[sno].u.swi_stream.swi_ptr);
}
return(fflush(Stream[sno].u.file.file));
} else
return(0);
@ -2697,7 +2700,7 @@ static Int p_change_alias_to_stream (void)
if ((sno = CheckStream (tstream, Input_Stream_f | Output_Stream_f | Append_Stream_f | Socket_Stream_f, "change_stream_alias/2")) == -1) {
UNLOCK(Stream[sno].streamlock);
return(FALSE);
}
}
SetAlias(at, sno);
UNLOCK(Stream[sno].streamlock);
return(TRUE);
@ -3647,14 +3650,13 @@ p_peek_byte (void)
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek/2");
return(FALSE);
}
UNLOCK(Stream[sno].streamlock);
if (Stream[sno].stream_getc == PlUnGetc) {
ch = MkIntTerm(Stream[sno].och);
/* sequence of peeks */
UNLOCK(Stream[sno].streamlock);
return Yap_unify_constant(ARG2,ch);
}
if (status & Eof_Stream_f) {
UNLOCK(Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_INPUT_PAST_END_OF_STREAM, ARG1, "peek/2");
return(FALSE);
}
@ -3698,17 +3700,20 @@ p_peek (void)
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek/2");
return FALSE;
}
UNLOCK(Stream[sno].streamlock);
if (Stream[sno].stream_getc == PlUnGetc) {
ch = MkIntTerm(Stream[sno].och);
UNLOCK(Stream[sno].streamlock);
/* sequence of peeks */
return Yap_unify_constant(ARG2,ch);
}
LOCK(Stream[sno].streamlock);
s = Stream+sno;
ocharcount = s->charcount;
olinecount = s->linecount;
olinepos = s->linepos;
UNLOCK(Stream[sno].streamlock);
ch = get_wchar(sno);
LOCK(Stream[sno].streamlock);
s->charcount = ocharcount;
s->linecount = olinecount;
s->linepos = olinepos;
@ -4693,8 +4698,8 @@ p_get (void)
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get/2");
return FALSE;
}
while ((ch = Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0);
UNLOCK(Stream[sno].streamlock);
while ((ch = Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0);
return (Yap_unify_constant (ARG2, MkIntegerTerm (ch)));
}
@ -4713,8 +4718,8 @@ p_get0 (void)
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2");
return FALSE;
}
out = Stream[sno].stream_wgetc(sno);
UNLOCK(Stream[sno].streamlock);
out = Stream[sno].stream_wgetc(sno);
return (Yap_unify_constant (ARG2, MkIntegerTerm (out)) );
}
@ -4754,8 +4759,8 @@ p_get0_line_codes (void)
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2");
return FALSE;
}
out = read_line(sno);
UNLOCK(Stream[sno].streamlock);
out = read_line(sno);
if (rewind)
return Yap_unify(MkPairTerm(MkIntegerTerm(ch),out), ARG2);
else
@ -5816,8 +5821,8 @@ p_skip (void)
UNLOCK(Stream[sno].streamlock);
return (FALSE);
}
while ((ch = Stream[sno].stream_wgetc(sno)) != n && ch != -1);
UNLOCK(Stream[sno].streamlock);
while ((ch = Stream[sno].stream_wgetc(sno)) != n && ch != -1);
return (TRUE);
}

5
H/YapHeap.h
View File

@ -27,6 +27,7 @@ typedef int (*SWI_GetFunction)(void *);
typedef int (*SWI_PutWideFunction)(int, void *);
typedef int (*SWI_GetWideFunction)(void *);
typedef int (*SWI_CloseFunction)(void *);
typedef int (*SWI_FlushFunction)(void *);
#include "../include/dswiatoms.h"
@ -105,6 +106,10 @@ typedef struct restore_info {
ADDR old_HeapTop;
} restoreinfo;
/* SWI Emulation */
#define SWI_BUF_SIZE 512
#define SWI_TMP_BUF_SIZE 2*SWI_BUF_SIZE
#define SWI_BUF_RINGS 16
#ifdef THREADS
typedef struct thandle {

4
H/dglobals.h
View File

@ -149,6 +149,9 @@
#define putc_cur_buf WL->putc_cur_buf_
#define putc_cur_lim WL->putc_cur_lim_
#define putc_cur_flags WL->putc_cur_flags_
#define SWI_buffers WL->SWI_buffers_
#define SWI_buffers_sz WL->SWI_buffers_sz_
#define SWI_buf_index WL->SWI_buf_index_
#define execution WL->_execution
#if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
@ -183,6 +186,7 @@
#define SWIWideGetc Yap_global->swi_wgetc
#define SWIWidePutc Yap_global->swi_wputc
#define SWIClose Yap_global->swi_close
#define SWIFlush Yap_global->swi_flush
#define Yap_AllowLocalExpansion Yap_global->allow_local_expansion
#define Yap_AllowGlobalExpansion Yap_global->allow_global_expansion

4
H/hglobals.h
View File

@ -151,6 +151,9 @@ typedef struct worker_local {
char* putc_cur_buf_;
char* putc_cur_lim_;
UInt putc_cur_flags_;
char* SWI_buffers_[1+SWI_BUF_RINGS];
size_t SWI_buffers_sz_[1+SWI_BUF_RINGS];
int SWI_buf_index_;
struct open_query_struct* _execution;
#if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
@ -185,6 +188,7 @@ typedef struct worker_shared {
SWI_GetWideFunction swi_wgetc;
SWI_PutWideFunction swi_wputc;
SWI_CloseFunction swi_close;
SWI_FlushFunction swi_flush;
int allow_local_expansion;
int allow_global_expansion;

4
H/iglobals.h
View File

@ -149,6 +149,9 @@ static void InitWorker(int wid) {
FOREIGN_WL(wid)->putc_cur_buf_ = NULL;
FOREIGN_WL(wid)->putc_cur_lim_ = NULL;
FOREIGN_WL(wid)->putc_cur_flags_ = 0L;
InitSWIBuffers(wid);
FOREIGN_WL(wid)->SWI_buf_index_ = 0;
FOREIGN_WL(wid)->_execution = NULL;
#if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
@ -183,6 +186,7 @@ static void InitGlobal(void) {
Yap_global->swi_wgetc = NULL;
Yap_global->swi_wputc = NULL;
Yap_global->swi_close = NULL;
Yap_global->swi_flush = NULL;
Yap_global->allow_local_expansion = TRUE;
Yap_global->allow_global_expansion = TRUE;

4
H/rglobals.h
View File

@ -151,6 +151,9 @@ static void RestoreWorker(int wid) {
#if (defined(YAPOR) || defined(TABLING)) && defined(THREADS)
#endif
@ -194,6 +197,7 @@ static void RestoreGlobal(void) {
#if HAVE_LIBREADLINE

1
include/SWI-Prolog.h
View File

@ -669,6 +669,7 @@ typedef struct SWI_IO {
void *put_c;
void *get_w;
void *put_w;
void *flush_s;
void *close_s;
} swi_io_struct;

3
library/Makefile.in
View File

@ -91,7 +91,8 @@ DIALECT_PROGRAMS= \
DIALECT_SWI= \
$(srcdir)/dialect/swi/INDEX.pl \
$(srcdir)/dialect/swi/listing.pl
$(srcdir)/dialect/swi/listing.pl \
$(srcdir)/dialect/swi/readutil.pl
install: $(PROGRAMS) install_myddas

242
library/dialect/swi/readutil.pl Normal file
View File

@ -0,0 +1,242 @@
/* $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 program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program 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 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
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(read_util,
[ read_line_to_codes/2, % +Fd, -Codes (without trailing \n)
read_line_to_codes/3, % +Fd, -Codes, ?Tail
read_stream_to_codes/2, % +Fd, -Codes
read_stream_to_codes/3, % +Fd, -Codes, ?Tail
read_file_to_codes/3, % +File, -Codes, +Options
read_file_to_terms/3 % +File, -Terms, +Options
]).
:- use_module(library(shlib)).
:- use_module(library(lists), [select/3]).
:- use_module(library(error)).
/** <module> Read utilities
This library provides some commonly used reading predicates. As these
predicates have proven to be time-critical in some applications we moved
them to C. For compatibility as well as to reduce system dependency, we
link the foreign code at runtime and fallback to the Prolog
implementation if the shared object cannot be found.
*/
:- volatile
read_line_to_codes/2,
read_line_to_codes/3,
read_stream_to_codes/2,
read_stream_to_codes/3.
link_foreign :-
catch(load_foreign_library(foreign(readutil)), _, fail), !.
link_foreign :-
assertz((read_line_to_codes(Stream, Line) :-
pl_read_line_to_codes(Stream, Line))),
assertz((read_line_to_codes(Stream, Line, Tail) :-
pl_read_line_to_codes(Stream, Line, Tail))),
assertz((read_stream_to_codes(Stream, Content) :-
pl_read_stream_to_codes(Stream, Content))),
assertz((read_stream_to_codes(Stream, Content, Tail) :-
pl_read_stream_to_codes(Stream, Content, Tail))),
compile_predicates([ read_line_to_codes/2,
read_line_to_codes/3,
read_stream_to_codes/2,
read_stream_to_codes/3
]).
:- initialization(link_foreign, now).
/*******************************
* LINES *
*******************************/
%% read_line_to_codes(+In:stream, -Line:codes) is det.
%
% Read a line of input from In into a list of character codes.
% Trailing newline and or return are deleted. Upon reaching
% end-of-file Line is unified to the atom =end_of_file=.
pl_read_line_to_codes(Fd, Codes) :-
get_code(Fd, C0),
( C0 == -1
-> Codes = end_of_file
; read_1line_to_codes(C0, Fd, Codes0)
),
Codes = Codes0.
read_1line_to_codes(-1, _, []) :- !.
read_1line_to_codes(10, _, []) :- !.
read_1line_to_codes(13, Fd, L) :- !,
get_code(Fd, C2),
read_1line_to_codes(C2, Fd, L).
read_1line_to_codes(C, Fd, [C|T]) :-
get_code(Fd, C2),
read_1line_to_codes(C2, Fd, T).
%% read_line_to_codes(+Fd, -Line, ?Tail) is det.
%
% Read a line of input as a difference list. This should be used
% to read multiple lines efficiently. On reaching end-of-file,
% Tail is bound to the empty list.
pl_read_line_to_codes(Fd, Codes, Tail) :-
get_code(Fd, C0),
read_line_to_codes(C0, Fd, Codes0, Tail),
Codes = Codes0.
read_line_to_codes(-1, _, Tail, Tail) :- !,
Tail = [].
read_line_to_codes(10, _, [10|Tail], Tail) :- !.
read_line_to_codes(C, Fd, [C|T], Tail) :-
get_code(Fd, C2),
read_line_to_codes(C2, Fd, T, Tail).
/*******************************
* STREAM (ENTIRE INPUT) *
*******************************/
%% read_stream_to_codes(+Stream, -Codes) is det.
%% read_stream_to_codes(+Stream, -Codes, ?Tail) is det.
%
% Read input from Stream to a list of character codes. The version
% read_stream_to_codes/3 creates a difference-list.
pl_read_stream_to_codes(Fd, Codes) :-
pl_read_stream_to_codes(Fd, Codes, []).
pl_read_stream_to_codes(Fd, Codes, Tail) :-
get_code(Fd, C0),
read_stream_to_codes(C0, Fd, Codes0, Tail),
Codes = Codes0.
read_stream_to_codes(-1, _, Tail, Tail) :- !.
read_stream_to_codes(C, Fd, [C|T], Tail) :-
get_code(Fd, C2),
read_stream_to_codes(C2, Fd, T, Tail).
%% read_stream_to_terms(+Stream, -Terms, ?Tail, +Options) is det.
read_stream_to_terms(Fd, Terms, Tail, Options) :-
read_term(Fd, C0, Options),
read_stream_to_terms(C0, Fd, Terms0, Tail, Options),
Terms = Terms0.
read_stream_to_terms(end_of_file, _, Tail, Tail, _) :- !.
read_stream_to_terms(C, Fd, [C|T], Tail, Options) :-
read_term(Fd, C2, Options),
read_stream_to_terms(C2, Fd, T, Tail, Options).
/*******************************
* FILE (ENTIRE INPUT) *
*******************************/
%% read_file_to_codes(+Spec, -Codes, +Options) is det.
%
% Read the file Spec into a list of Codes. Options is split into
% options for absolute_file_name/3 and open/4.
read_file_to_codes(Spec, Codes, Options) :-
must_be(proper_list, Options),
( select(tail(Tail), Options, Options1)
-> true
; Tail = [],
Options1 = Options
),
split_options(Options1, file_option, FileOptions, OpenOptions),
absolute_file_name(Spec,
[ access(read)
| FileOptions
],
Path),
open(Path, read, Fd, OpenOptions),
call_cleanup(read_stream_to_codes(Fd, Codes0, Tail),
close(Fd)),
Codes = Codes0.
%% read_file_to_terms(+Spec, -Terms, +Options) is det.
%
% Read the file Spec into a list of terms. Options is split over
% absolute_file_name/3, open/4 and read_term/3.
read_file_to_terms(Spec, Terms, Options) :-
must_be(proper_list, Options),
( select(tail(Tail), Options, Options1)
-> true
; Tail = [],
Options1 = Options
),
split_options(Options1, file_option, FileOptions, Options2),
split_options(Options2, read_option, ReadOptions, OpenOptions),
absolute_file_name(Spec,
[ access(read)
| FileOptions
],
Path),
open(Path, read, Fd, OpenOptions),
call_cleanup(read_stream_to_terms(Fd, Terms0, Tail, ReadOptions),
close(Fd)),
Terms = Terms0.
split_options([], _, [], []).
split_options([H|T], G, File, Open) :-
( call(G, H)
-> File = [H|FT],
OT = Open
; Open = [H|OT],
FT = File
),
split_options(T, G, FT, OT).
read_option(module(_)).
read_option(syntax_errors(_)).
read_option(character_escapes(_)).
read_option(double_quotes(_)).
read_option(backquoted_string(_)).
file_option(extensions(_)).
file_option(file_type(_)).
file_option(file_errors(_)).
file_option(relative_to(_)).
file_option(expand(_)).
/*******************************
* XREF *
*******************************/
:- multifile prolog:meta_goal/2.
:- dynamic prolog:meta_goal/2.
prolog:meta_goal(split_options(_,G,_,_), [G+1]).

88
library/yap2swi/yap2swi.c
View File

@ -45,10 +45,6 @@
#include <fcntl.h>
#endif
#define BUF_SIZE 512
#define TMP_BUF_SIZE 2*BUF_SIZE
#define BUF_RINGS 16
/* Required by PL_error */
#define ERR_NO_ERROR 0
#define ERR_INSTANTIATION 1 /* void */
@ -247,25 +243,21 @@ UserCPredicate(char *a, CPredicate def, unsigned long int arity, Term mod, int f
CurrentModule = cm;
}
static char *buffers[1+BUF_RINGS];
static size_t buffers_sz[1+BUF_RINGS];
static int buf_index = 0;
static char *
alloc_ring_buf(void)
{
buf_index++;
if (buf_index == BUF_RINGS)
buf_index = 0;
if (buffers_sz[buf_index+1] == 0) {
SWI_buf_index++;
if (SWI_buf_index == SWI_BUF_RINGS)
SWI_buf_index = 0;
if (SWI_buffers_sz[SWI_buf_index+1] == 0) {
char * new;
if (!(new = malloc(512))) {
return NULL;
}
buffers_sz[buf_index+1] = 512;
buffers[buf_index+1] = new;
SWI_buffers_sz[SWI_buf_index+1] = 512;
SWI_buffers[SWI_buf_index+1] = new;
}
return buffers[buf_index+1];
return SWI_buffers[SWI_buf_index+1];
}
static char *
@ -274,7 +266,7 @@ ensure_space(char **sp, size_t room, unsigned flags) {
int i = 0;
char *ptr = *sp;
if (room < BUF_SIZE)
if (room < SWI_BUF_SIZE)
return *sp;
while (min < room)
min += 512;
@ -284,21 +276,21 @@ ensure_space(char **sp, size_t room, unsigned flags) {
*sp = malloc(room);
return *sp;
} else if (flags & BUF_RING) {
for (i=1; i<= BUF_RINGS; i++)
if (buffers[i] == ptr)
for (i=1; i<= SWI_BUF_RINGS; i++)
if (SWI_buffers[i] == ptr)
break;
} else {
i = 0;
}
if (buffers_sz[i] >= room)
if (SWI_buffers_sz[i] >= room)
return ptr;
free(buffers[i]);
buffers[i] = malloc(min);
if (buffers[i])
buffers_sz[i] = min;
free(SWI_buffers[i]);
SWI_buffers[i] = malloc(min);
if (SWI_buffers[i])
SWI_buffers_sz[i] = min;
else
buffers_sz[i] = 0;
*sp = buffers[i];
SWI_buffers_sz[i] = 0;
*sp = SWI_buffers[i];
return *sp;
}
@ -520,12 +512,12 @@ static int do_yap_putc(int sno, wchar_t ch) {
UInt bufsize = putc_cur_lim-putc_cur_buf;
UInt bufpos = putc_curp-putc_cur_buf;
if (!(putc_cur_buf = realloc(putc_cur_buf, bufsize+BUF_SIZE))) {
if (!(putc_cur_buf = realloc(putc_cur_buf, bufsize+SWI_BUF_SIZE))) {
/* we can+t go forever */
return FALSE;
}
putc_curp = putc_cur_buf+bufpos;
putc_cur_lim = putc_cur_buf+(bufsize+BUF_SIZE);
putc_cur_lim = putc_cur_buf+(bufsize+SWI_BUF_SIZE);
return do_yap_putc(sno, ch);
}
return FALSE;
@ -539,9 +531,9 @@ CvtToGenericTerm(Term t, char *tmp, unsigned flags, char **sp)
putc_cur_buf = putc_curp = tmp;
putc_cur_flags = flags;
if ((flags & BUF_RING)) {
putc_cur_lim = tmp+(TMP_BUF_SIZE-1);
putc_cur_lim = tmp+(SWI_TMP_BUF_SIZE-1);
} else {
putc_cur_lim = tmp+(BUF_SIZE-1);
putc_cur_lim = tmp+(SWI_BUF_SIZE-1);
}
if (flags & CVT_WRITE_CANONICAL) {
wflags |= (YAP_WRITE_IGNORE_OPS|YAP_WRITE_QUOTED);
@ -572,9 +564,9 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
if ((flags & BUF_RING)) {
tmp = alloc_ring_buf();
} else if ((flags & BUF_MALLOC)) {
tmp = malloc(BUF_SIZE);
tmp = malloc(SWI_BUF_SIZE);
} else {
tmp = buffers[0];
tmp = SWI_buffers[0];
}
*sp = tmp;
if (IsVarTerm(t)) {
@ -602,21 +594,21 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
if (IsFloatTerm(t)) {
if (!(flags & (CVT_FLOAT|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
snprintf(tmp,BUF_SIZE,"%f",FloatOfTerm(t));
snprintf(tmp,SWI_BUF_SIZE,"%f",FloatOfTerm(t));
} else {
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
#if _WIN64
snprintf(tmp,BUF_SIZE,"%I64d",IntegerOfTerm(t));
snprintf(tmp,SWI_BUF_SIZE,"%I64d",IntegerOfTerm(t));
#else
snprintf(tmp,BUF_SIZE,"%ld",IntegerOfTerm(t));
snprintf(tmp,SWI_BUF_SIZE,"%ld",IntegerOfTerm(t));
#endif
}
} else if (IsPairTerm(t)) {
if (!(flags & (CVT_LIST|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) {
return cv_error(flags);
}
if (CvtToStringTerm(t,tmp,tmp+BUF_SIZE) == 0) {
if (CvtToStringTerm(t,tmp,tmp+SWI_BUF_SIZE) == 0) {
if (flags & (CVT_WRITE|CVT_WRITE_CANONICAL)) {
if (!CvtToGenericTerm(t, tmp, flags, sp))
return 0;
@ -628,13 +620,13 @@ X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
if (IsBigIntTerm(t)) {
if (!(flags & (CVT_INTEGER|CVT_NUMBER|CVT_ATOMIC|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL)))
return cv_error(flags);
Yap_gmp_to_string(t, tmp, BUF_SIZE-1, 10);
Yap_gmp_to_string(t, tmp, SWI_BUF_SIZE-1, 10);
} else if (IsBlobStringTerm(t)) {
if (!(flags & (CVT_STRING|CVT_WRITE|CVT_WRITE_CANONICAL|CVT_ALL))) {
return cv_error(flags);
} else {
char *s = Yap_BlobStringOfTerm(t);
strncat(tmp, s, BUF_SIZE-1);
strncat(tmp, s, SWI_BUF_SIZE-1);
}
} else {
if (!(flags & (CVT_WRITE|CVT_WRITE_CANONICAL))) {
@ -683,9 +675,10 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
sz = wcslen(wbuf);
*len = sz;
} else {
if (!PL_get_nchars(l, len, &sp, nflags))
if (!PL_get_nchars(l, &sz, &sp, nflags))
return 0;
sz = *len;
if (len)
*len = sz;
}
room = (sz+1)*sizeof(wchar_t);
if (flags & BUF_MALLOC) {
@ -694,7 +687,7 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
*wsp = (wchar_t *)alloc_ring_buf();
buf = (wchar_t *)ensure_space((char **)wsp, room, flags);
} else {
*wsp = (wchar_t *)buffers[0];
*wsp = (wchar_t *)SWI_buffers[0];
buf = (wchar_t *)ensure_space((char **)wsp, room, flags);
}
if (!buf) {
@ -706,9 +699,9 @@ X_API int PL_get_wchars(term_t l, size_t *len, wchar_t **wsp, unsigned flags)
wcsncpy(buf, wbuf, sz);
} else {
sp0 = sp;
buf[sz] = '\0';
for (i=0; i< sz; i++)
*buf++ = *sp++;
buf[sz] = '\0';
free(sp0);
}
return 1;
@ -1133,7 +1126,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
{
va_list ap;
int arity, i;
Term *tmp = (Term *)buffers[0];
Term *tmp = (Term *)SWI_buffers[0];
Functor ff = SWIFunctorToFunctor(f);
if (IsAtomTerm((Term)ff)) {
@ -1141,7 +1134,7 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
return TRUE;
}
arity = ArityOfFunctor(ff);
if (arity > TMP_BUF_SIZE/sizeof(YAP_CELL)) {
if (arity > SWI_TMP_BUF_SIZE/sizeof(YAP_CELL)) {
fprintf(stderr,"PL_cons_functor: arity too large (%d)\n", arity);
return FALSE;
}
@ -3240,6 +3233,7 @@ PL_YAP_InitSWIIO(struct SWI_IO *swio)
SWIPutc = swio->put_c;
SWIWideGetc = swio->get_w;
SWIWidePutc = swio->put_w;
SWIFlush = swio->flush_s;
SWIClose = swio->close_s;
}
@ -3259,14 +3253,6 @@ void Yap_swi_install(void);
void
Yap_swi_install(void)
{
int i;
buffers[0] = malloc(BUF_SIZE);
buffers_sz[0] = BUF_SIZE;
for (i=1; i <= BUF_RINGS; i++) {
buffers[i] = NULL;
buffers_sz[i] = 0;
}
YAP_UserCPredicate("ctime", SWI_ctime, 2);
}

5
misc/GLOBALS
View File

@ -163,6 +163,10 @@ char* putc_curp_ putc_curp =NULL
char* putc_cur_buf_ putc_cur_buf =NULL
char* putc_cur_lim_ putc_cur_lim =NULL
UInt putc_cur_flags_ putc_cur_flags =0L
char* SWI_buffers_[1+SWI_BUF_RINGS] SWI_buffers InitSWIBuffers(wid)
size_t SWI_buffers_sz_[1+SWI_BUF_RINGS] SWI_buffers_sz void
int SWI_buf_index_ SWI_buf_index =0
struct open_query_struct* _execution execution =NULL
@ -205,6 +209,7 @@ SWI_PutFunction swi_putc SWIPutc =NULL
SWI_GetWideFunction swi_wgetc SWIWideGetc =NULL
SWI_PutWideFunction swi_wputc SWIWidePutc =NULL
SWI_CloseFunction swi_close SWIClose =NULL
SWI_FlushFunction swi_flush SWIFlush =NULL
// stack overflow expansion/gc control
int allow_local_expansion Yap_AllowLocalExpansion =TRUE

1
packages/PLStream/pl-file.c
View File

@ -4322,6 +4322,7 @@ init_yap_extras()
swiio.put_c = Sputc;
swiio.get_w = Sgetcode;
swiio.put_w = Sputcode;
swiio.flush_s = Sflush;
swiio.close_s = Sclose;
PL_YAP_InitSWIIO(&swiio);
initCharTypes();

75
packages/PLStream/pl-incl.h
View File

@ -128,6 +128,12 @@ typedef struct {
{ Table table; /* global (read-only) features */
} prolog_flag;
#if THREADS
struct
{ int enabled; /* threads are enabled */
} thread;
#endif
struct
{ Table tmp_files; /* Known temporary files */
CanonicalDir _canonical_dirlist;
@ -387,8 +393,70 @@ extern PL_local_data_t lds;
/* Support PL_LOCK in the interface */
#define PL_LOCK(X)
#define PL_UNLOCK(X)
#if THREADS
typedef pthread_mutex_t simpleMutex;
#define simpleMutexInit(p) pthread_mutex_init(p, NULL)
#define simpleMutexDelete(p) pthread_mutex_destroy(p)
#define simpleMutexLock(p) pthread_mutex_lock(p)
#define simpleMutexUnlock(p) pthread_mutex_unlock(p)
extern counting_mutex _PL_mutexes[]; /* Prolog mutexes */
#define L_MISC 0
#define L_ALLOC 1
#define L_ATOM 2
#define L_FLAG 3
#define L_FUNCTOR 4
#define L_RECORD 5
#define L_THREAD 6
#define L_PREDICATE 7
#define L_MODULE 8
#define L_TABLE 9
#define L_BREAK 10
#define L_FILE 11
#define L_PLFLAG 12
#define L_OP 13
#define L_INIT 14
#define L_TERM 15
#define L_GC 16
#define L_AGC 17
#define L_FOREIGN 18
#define L_OS 19
#define IF_MT(id, g) if ( id == L_THREAD || GD->thread.enabled ) g
#ifdef O_CONTENTION_STATISTICS
#define countingMutexLock(cm) \
do \
{ if ( pthread_mutex_trylock(&(cm)->mutex) == EBUSY ) \
{ (cm)->collisions++; \
pthread_mutex_lock(&(cm)->mutex); \
} \
(cm)->count++; \
} while(0)
#else
#define countingMutexLock(cm) \
do \
{ simpleMutexLock(&(cm)->mutex); \
(cm)->count++; \
} while(0)
#endif
#define countingMutexUnlock(cm) \
do \
{ (cm)->unlocked++; \
assert((cm)->unlocked <= (cm)->count); \
simpleMutexUnlock(&(cm)->mutex); \
} while(0)
#define PL_LOCK(id) IF_MT(id, countingMutexLock(&_PL_mutexes[id]))
#define PL_UNLOCK(id) IF_MT(id, countingMutexUnlock(&_PL_mutexes[id]))
#else
#define PL_LOCK(X)
#define PL_UNLOCK(X)
#endif
#ifndef TRUE
@ -658,6 +726,9 @@ void initFiles(void);
int RemoveFile(const char *path);
int PL_get_file_name(term_t n, char **namep, int flags);
/**** stuff from pl-utf8.c ****/
size_t utf8_strlen(const char *s, size_t len);
/* empty stub */
void setPrologFlag(const char *name, int flags, ...);
void PL_set_prolog_flag(const char *name, int flags, ...);

37
packages/PLStream/pl-yap.c
View File

@ -133,7 +133,9 @@ callProlog(module_t module, term_t goal, int flags, term_t *ex)
}
}
int
extern X_API int PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags);
X_API int
PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags)
{
int nflags = 0;
@ -709,10 +711,41 @@ PL_dispatch(int fd, int wait)
return TRUE;
}
extern size_t PL_utf8_strlen(const char *s, size_t len);
extern size_t PL_utf8_strlen(const char *s, size_t len);
X_API size_t
PL_utf8_strlen(const char *s, size_t len)
{ return utf8_strlen(s, len);
}
#define COUNT_MUTEX_INITIALIZER(name) \
{ PTHREAD_MUTEX_INITIALIZER, \
name, \
0L \
}
#if THREADS
counting_mutex _PL_mutexes[] =
{ COUNT_MUTEX_INITIALIZER("L_MISC"),
COUNT_MUTEX_INITIALIZER("L_ALLOC"),
COUNT_MUTEX_INITIALIZER("L_ATOM"),
COUNT_MUTEX_INITIALIZER("L_FLAG"),
COUNT_MUTEX_INITIALIZER("L_FUNCTOR"),
COUNT_MUTEX_INITIALIZER("L_RECORD"),
COUNT_MUTEX_INITIALIZER("L_THREAD"),
COUNT_MUTEX_INITIALIZER("L_PREDICATE"),
COUNT_MUTEX_INITIALIZER("L_MODULE"),
COUNT_MUTEX_INITIALIZER("L_TABLE"),
COUNT_MUTEX_INITIALIZER("L_BREAK"),
COUNT_MUTEX_INITIALIZER("L_FILE"),
COUNT_MUTEX_INITIALIZER("L_PLFLAG"),
COUNT_MUTEX_INITIALIZER("L_OP"),
COUNT_MUTEX_INITIALIZER("L_INIT"),
COUNT_MUTEX_INITIALIZER("L_TERM"),
COUNT_MUTEX_INITIALIZER("L_GC"),
COUNT_MUTEX_INITIALIZER("L_AGC"),
COUNT_MUTEX_INITIALIZER("L_FOREIGN"),
COUNT_MUTEX_INITIALIZER("L_OS")
};
#endif

2
packages/PLStream/pl-yap.h
View File

@ -97,7 +97,7 @@ YAP_Int YAP_PLArityOfSWIFunctor(functor_t f);
#define valReal(w) YAP_FloatOfTerm((w))
#define valFloat(w) YAP_FloatOfTerm((w))
#define AtomLength(w) YAP_AtomNameLength(w)
#define atomValue(atom) AtomOfTerm(atom)
#define atomValue(atom) YAP_AtomOfTerm(atom)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) (t = YAP_Deref(t))
#define canBind(t) FALSE

16
packages/zlib/test_zlib.pl
View File

@ -27,7 +27,7 @@ test(gunzip,
]) :-
gzopen('plunit-tmp.gz', read, ZIn),
call_cleanup(read_stream_to_codes(ZIn, Codes0), close(ZIn)),
read_file_to_codes('test_zlib.pl', Codes1),
this_read_file_to_codes('test_zlib.pl', Codes1),
Codes0 == Codes1.
% gzip: Can gunzip read our compressed file
@ -35,11 +35,11 @@ test(gunzip,
test(gzip,
[ cleanup(delete_file('plunit-tmp.gz'))
]) :-
read_file_to_codes('test_zlib.pl', Codes),
this_read_file_to_codes('test_zlib.pl', Codes),
gzopen('plunit-tmp.gz', write, ZOut),
format(ZOut, '~s', [Codes]),
close(ZOut),
read_file_to_codes(pipe('gunzip < plunit-tmp.gz'), Codes1),
this_read_file_to_codes(pipe('gunzip < plunit-tmp.gz'), Codes1),
Codes == Codes1.
% deflate: test read/write of deflate format
@ -47,12 +47,12 @@ test(gzip,
test(deflate,
[ cleanup(delete_file('plunit-tmp.z'))
]) :-
read_file_to_codes('test_zlib.pl', Codes),
open('plunit-tmp.z', write, Out),
this_read_file_to_codes('test_zlib.pl', Codes),
system:swi_open('plunit-tmp.z', write, Out),
zopen(Out, ZOut, []),
format(ZOut, '~s', [Codes]),
close(ZOut),
open('plunit-tmp.z', read, In),
system:swi_open('plunit-tmp.z', read, In),
zopen(In, ZIn, []),
read_stream_to_codes(ZIn, Codes1),
close(ZIn),
@ -198,7 +198,7 @@ get_data(ZIn, N) :-
* UTIL *
*******************************/
read_file_to_codes(File, Codes) :-
open(File, read, In),
this_read_file_to_codes(File, Codes) :-
system:swi_open(File, read, In),
call_cleanup(read_stream_to_codes(In, Codes), close(In)).