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

init fields 

lots of docs, boolean -> booleanFlag
This commit is contained in:
Vítor Santos Costa 2016-01-31 10:39:15 +00:00
parent 794d04c851
commit 06a2caf7a9
10 changed files with 397 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
os/YapIOConfig.h.cmake
View File

@ -1,6 +1,6 @@
/* Define if you have libreadline */
#ifndef HAVE_LIBREADLINE
#cmakedefine USE_READLINE ${USE_READLINE}
#cmakedefine HAVE_LIBREADLINE ${HAVE_LIBREADLINE}
#endif
/* Define to 1 if you have the <readline/history.h> header file. */
@ -10,7 +10,11 @@
/* Define to 1 if you have the <readline/readline.h> header file. */
#ifndef HAVE_READLINE_READLINE_H
#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H}
#cmakedefine HAVE_READLINE_READLINE_H ${HAVE_READLINE_READLINE_H}
#endif
#if defined(HAVE_LIBREADLINE) && defined(HAVE_READLINE_READLINE_H)
#define USE_READLINE 1
#endif
/* Define to 1 if you have the declaration of `rl_catch_signals ', and to 0 if

30
os/iopreds.h
View File

@ -13,6 +13,11 @@ static char SccsId[] = "%W% %G%";
#ifndef IOPREDS_H
#define IOPREDS_H 1
#if _WIN32
#define USE_SOCKET 1
#define HAVE_SOCKET 1
#endif
#include <stdlib.h>
#include "Yap.h"
#include "Atoms.h"
@ -32,6 +37,15 @@ extern size_t Yap_page_size;
#include <wchar.h>
#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *);
#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *);
extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags,
Atom open_mode);
#if HAVE_SOCKET
extern int Yap_sockets_io;
@ -50,14 +64,7 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
af_unix /* or AF_FILE */
} socket_domain;
extern bool Yap_initStream(int sno, FILE *fd, const char *name, Term file_name,
encoding_t encoding, stream_flags_t flags,
Atom open_mode);
extern Term Yap_InitSocketStream(int, socket_info, socket_domain);
#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *);
#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *);
extern int Yap_CheckSocketStream(Term, const char *);
extern socket_domain Yap_GetSocketDomain(int);
extern socket_info Yap_GetSocketStatus(int);
@ -181,11 +188,7 @@ typedef struct stream_desc
} file;
memHandle mem_string;
struct {
#if defined(__MINGW32__) || defined(_MSC_VER)
HANDLE hdl;
#else
int fd;
#endif
} pipe;
#if HAVE_SOCKET
struct {
@ -239,7 +242,6 @@ Yap_GetStreamHandle(Term t)
#define YAP_ERROR NIL
/// maximum number of open streams
#define MaxStreams 64
#define EXPAND_FILENAME 0x000080
@ -277,6 +279,7 @@ Term Yap_scan_num(struct stream_desc *);
void Yap_DefaultStreamOps( StreamDesc *st );
void Yap_PipeOps( StreamDesc *st );
void Yap_MemOps( StreamDesc *st );
bool Yap_CloseMemoryStream( int sno );
void Yap_ConsolePipeOps( StreamDesc *st );
void Yap_SocketOps( StreamDesc *st );
void Yap_ConsoleSocketOps( StreamDesc *st );
@ -295,7 +298,8 @@ void Yap_InitSockets( void );
void Yap_InitSocketLayer(void);
void Yap_InitMems( void );
void Yap_InitConsole( void );
void Yap_InitReadline( void );
void Yap_InitReadlinePreds( void );
bool Yap_InitReadline( Term );
void Yap_InitChtypes(void);
void Yap_InitCharsio(void);
void Yap_InitFormat(void);

2
os/open_memstream.c
View File

@ -29,7 +29,7 @@
// #include "verify.h"
#if !HAVE_OPEN_MEMSTREAM
#if !HAVE_OPEN_MEMSTREAM && !_WIN32
#if !HAVE_FUNOPEN
# error Sorry, not ported to your platform yet

75
os/pipes.c
View File

@ -47,6 +47,12 @@ static char SccsId[] = "%W% %G%";
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include "iopreds.h"
static int PipePutc( int, int);
@ -66,15 +72,6 @@ ConsolePipePutc (int sno, int ch)
ch = '\n';
}
#endif
#if _MSC_VER || defined(__MINGW32__)
{
DWORD written;
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &written, NULL) == FALSE) {
PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "write to pipe returned error");
return EOF;
}
}
#else
{
int out = 0;
while (!out) {
@ -88,7 +85,6 @@ ConsolePipePutc (int sno, int ch)
}
}
}
#endif
count_output_char(ch,s);
return ((int) ch);
}
@ -104,15 +100,6 @@ PipePutc (int sno, int ch)
ch = '\n';
}
#endif
#if _MSC_VER || defined(__MINGW32__)
{
DWORD written;
if (WriteFile(s->u.pipe.hdl, &c, sizeof(c), &written, NULL) == FALSE) {
PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "write to pipe returned error");
return EOF;
}
}
#else
{
int out = 0;
while (!out) {
@ -126,7 +113,6 @@ PipePutc (int sno, int ch)
}
}
}
#endif
console_count_output_char(ch,s);
return ((int) ch);
}
@ -159,19 +145,10 @@ ConsolePipeGetc(int sno)
strncpy(LOCAL_Prompt, RepAtom (LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
LOCAL_newline = false;
}
#if _MSC_VER || defined(__MINGW32__)
if (ReadFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
LOCAL_PrologMode |= ConsoleGetcMode;
Yap_WinError("read from console pipe returned error");
LOCAL_PrologMode &= ~ConsoleGetcMode;
return console_post_process_eof(s);
}
#else
/* should be able to use a buffer */
LOCAL_PrologMode |= ConsoleGetcMode;
count = read(s->u.pipe.fd, &c, sizeof(char));
LOCAL_PrologMode &= ~ConsoleGetcMode;
#endif
if (count == 0) {
return console_post_process_eof(s);
} else if (count > 0) {
@ -192,16 +169,8 @@ PipeGetc(int sno)
char c;
/* should be able to use a buffer */
#if _MSC_VER || defined(__MINGW32__)
DWORD count;
if (ReadFile(s->u.pipe.hdl, &c, sizeof(c), &count, NULL) == FALSE) {
Yap_WinError("read from pipe returned error");
return EOF;
}
#else
int count;
count = read(s->u.pipe.fd, &c, sizeof(char));
#endif
if (count == 0) {
return post_process_eof(s);
} else if (count > 0) {
@ -237,25 +206,19 @@ open_pipe_stream (USES_REGS1)
Term t1, t2;
StreamDesc *st;
int sno;
#if _MSC_VER || defined(__MINGW32__)
HANDLE ReadPipe, WritePipe;
SECURITY_ATTRIBUTES satt;
satt.nLength = sizeof(satt);
satt.lpSecurityDescriptor = NULL;
satt.bInheritHandle = TRUE;
if (!CreatePipe(&ReadPipe, &WritePipe, &satt, 0))
{
return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "open_pipe_stream/2 could not create pipe"));
}
#else
int filedes[2];
if (pipe(filedes) != 0)
if (
#if _MSC_VER || defined(__MINGW32__)
// assume for now only text streams...
_pipe(filedes, 1024, O_TEXT)
#else
pipe(filedes)
#endif
!= 0)
{
return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "open_pipe_stream/2 could not create pipe"));
return (PlIOError (SYSTEM_ERROR_INTERNAL,TermNil, "error %s", strerror(errno)) );
}
#endif
sno = GetFreeStreamD();
if (sno < 0)
return (PlIOError (RESOURCE_ERROR_MAX_STREAMS,TermNil, "new stream not available for open_pipe_stream/2"));
@ -268,11 +231,7 @@ open_pipe_stream (USES_REGS1)
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
Yap_DefaultStreamOps( st );
#if _MSC_VER || defined(__MINGW32__)
st->u.pipe.hdl = ReadPipe;
#else
st->u.pipe.fd = filedes[0];
#endif
st->file = fdopen( filedes[0], "r");
UNLOCK(st->streamlock);
sno = GetFreeStreamD();
@ -286,11 +245,7 @@ open_pipe_stream (USES_REGS1)
st->stream_putc = PipePutc;
st->stream_getc = PipeGetc;
Yap_DefaultStreamOps( st );
#if _MSC_VER || defined(__MINGW32__)
st->u.pipe.hdl = WritePipe;
#else
st->u.pipe.fd = filedes[1];
#endif
st->file = fdopen( filedes[1], "w");
UNLOCK(st->streamlock);
t2 = Yap_MkStream (sno);

35
os/random.c
View File

@ -1,7 +1,34 @@
#include "sysbits.h"
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#if HAVE_ERRNO_H
#include <errno.h>
#endif
#if HAVE_FCNTL_H
#include <fcntl.h>
#endif
#include "iopreds.h"
#if HAVE_TIME_H
#include <time.h>

43
os/readline.c
View File

@ -1,4 +1,4 @@
/*************************************************************************
/*************************************************************************
* *
* YAP Prolog *
* *
@ -51,7 +51,7 @@ static char SccsId[] = "%W% %G%";
#include "iopreds.h"
#if defined(USE_READLINE)
#if USE_READLINE
#include <readline/readline.h>
#include <readline/history.h>
@ -191,18 +191,21 @@ static int prolog_complete(int ignore, int key) {
return 0;
}
static void InitReadline(void) {
bool Yap_InitReadline(Term enable) {
// don't call readline within emacs
// if (getenv("ËMACS"))
// return;
if (enable == TermFalse)
return true;
GLOBAL_Stream[StdInStream].u.irl.buf = NULL;
GLOBAL_Stream[StdInStream].u.irl.ptr = NULL;
GLOBAL_Stream[StdInStream].status |= Readline_Stream_f;
#if _MSC_VER || defined(__MINGW32__)
rl_instream = stdin;
#endif
rl_outstream = stderr;
using_history();
char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true);
const char *s = Yap_AbsoluteFile("~/.YAP.history", NULL, true);
if (!read_history(s)) {
FILE *f = fopen(s, "w");
if (f) {
@ -217,6 +220,7 @@ static void InitReadline(void) {
#else
rl_add_defun("prolog-complete", (void *)prolog_complete, '\t');
#endif
return Yap_ReadlineOps(GLOBAL_Stream + StdInStream);
}
static bool getLine(int inp, int out) {
@ -250,6 +254,7 @@ static bool getLine(int inp, int out) {
}
} else {
LOCAL_PrologMode &= ~ConsoleGetcMode;
LOCAL_newline = true;
}
strncpy(LOCAL_Prompt, RepAtom(LOCAL_AtPrompt)->StrOfAE, MAX_PROMPT);
/* window of vulnerability closed */
@ -274,6 +279,7 @@ static int ReadlinePutc(int sno, int ch) {
console_count_output_char(ch, s);
if (ch == 10) {
Yap_ReadlineFlush(sno);
LOCAL_newline = true;
}
return ((int)ch);
}
@ -303,15 +309,15 @@ static int ReadlineGetc(int sno) {
return console_post_process_read_char(ch, s);
}
/**
/**
@brief Yap_ReadlinePeekChar peeks the next char from the
readline buffer, but does not actually grab it.
The idea is to take advantage of the buffering. Special care must be taken with EOF, though.
The idea is to take advantage of the buffering. Special care must be taken
with EOF, though.
*/
Int Yap_ReadlinePeekChar( int sno) {
Int Yap_ReadlinePeekChar(int sno) {
StreamDesc *s = &GLOBAL_Stream[sno];
int ch;
@ -319,13 +325,14 @@ Int Yap_ReadlinePeekChar( int sno) {
const char *ttyptr = s->u.irl.ptr;
ch = *ttyptr;
if (ch == '\0') {
ch = '\n';
ch = '\n';
}
} if (getLine(sno, StdErrStream) ) {
CACHE_REGS
}
if (getLine(sno, StdErrStream)) {
CACHE_REGS
ch = s->u.irl.ptr[0];
if (ch == '\0') {
ch = '\n';
ch = '\n';
}
if (ch == '\n') {
LOCAL_newline = true;
@ -338,7 +345,6 @@ Int Yap_ReadlinePeekChar( int sno) {
return ch;
}
int Yap_ReadlineForSIGINT(void) {
CACHE_REGS
int ch;
@ -372,10 +378,17 @@ static Int has_readline(USES_REGS1) {
#endif
}
void Yap_InitReadline(void) {
void Yap_InitReadlinePreds(void) {
Yap_InitCPred("$has_readline", 0, has_readline,
SafePredFlag | HiddenPredFlag);
InitReadline();
}
#else
bool Yap_InitReadline(Term enable) {
if (enable == TermTrue)
return true;
return false;
}
void Yap_InitReadlinePreds(void) {}
#endif

411
os/readterm.c
View File

@ -95,6 +95,8 @@ static char SccsId[] = "%W% %G%";
#define SYSTEM_STAT stat
#endif
static Term readFromBuffer(const char *s, Term opts);
static void clean_vars(VarEntry *p) {
if (p == NULL)
return;
@ -180,8 +182,8 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
#endif /*O_QUASIQUOTATIONS*/
#define READ_DEFS() \
PAR("comments", filler, READ_COMMENTS), \
PAR("module", isatom, READ_MODULE), \
PAR("comments", list_filler, READ_COMMENTS),\
PAR("module", isatom, READ_MODULE), \
PAR("priority", nat, READ_PRIORITY), \
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
PAR("term_position", filler, READ_TERM_POSITION), \
@ -189,7 +191,7 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
PAR("singletons", filler, READ_SINGLETONS), \
PAR("variables", filler, READ_VARIABLES), \
PAR("variable_names", filler, READ_VARIABLE_NAMES), \
PAR("character_escapes", boolean, READ_CHARACTER_ESCAPES), \
PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END)
@ -374,11 +376,11 @@ typedef struct FEnv {
size_t nargs; /// arity of current procedure
encoding_t enc; /// encoding of the stream being read
Term tcomms; /// Access to comments
Term cmod; /// Access to comments
Term cmod; /// Access to comments
} FEnv;
typedef struct renv {
Term bq;
Term bq;
bool ce, sw;
Term sy;
UInt cpos;
@ -419,6 +421,8 @@ static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
}
if (args[READ_COMMENTS].used) {
fe->tcomms = args[READ_COMMENTS].tvalue;
if (fe->tcomms == TermProlog)
fe->tcomms = PROLOG_MODULE;
} else {
fe->tcomms = 0;
}
@ -520,63 +524,187 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) {
POPFET(qq);
}
static bool complete_clause_processing(FEnv *fe, TokEntry *tokstarts, Term t);
static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v1, v2, v3;
CurrentModule = fe->cmod;
static Term
get_variables(FEnv *fe, TokEntry *tokstart)
{
Term v;
if (fe->vp) {
while (TRUE) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
if ((v1 = Yap_Variables(LOCAL_VarTable, TermNil)))
break;
} else {
reset_regs(tokstart, fe);
}
}
}
if (fe->np) {
while (true) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
if ((v2 = Yap_VarNames(LOCAL_VarTable, TermNil))) {
if ((v = Yap_Variables(LOCAL_VarTable, TermNil))) {
fe->old_H = HR;
break;
return v;
}
} else {
reset_regs(tokstart, fe);
}
}
}
}
return 0;
}
static Term
get_varnames(FEnv *fe, TokEntry *tokstart)
{
Term v;
if (fe->np) {
while (true) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
if ((v = Yap_VarNames(LOCAL_VarTable, TermNil))) {
fe->old_H = HR;
return v;
}
} else {
reset_regs(tokstart, fe);
}
}
}
return 0;
}
static Term
get_singletons(FEnv *fe, TokEntry *tokstart)
{
Term v;
if (fe->sp) {
while (TRUE) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
if ((v3 = Yap_Singletons(LOCAL_VarTable, TermNil)))
break;
if ((v = Yap_Singletons(LOCAL_VarTable, TermNil)))
return v;
} else {
reset_regs(tokstart, fe);
}
}
}
return 0;
}
static void
warn_singletons(FEnv *fe, TokEntry *tokstart)
{
Term v;
fe->sp = TermNil;
v = get_singletons(fe, tokstart);
if (v && v != TermNil) {
Term singls[4];
singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v);
singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno);
singls[2] = MkAtomTerm(LOCAL_SourceFileName);
singls[3] = v;
Term t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls);
singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
singls[1] = TermNil;
Yap_PrintWarning(Yap_MkApplTerm(FunctorError, 2, singls));
}
}
static Term
get_stream_position(FEnv *fe, TokEntry *tokstart)
{
Term v;
if (fe->tp) {
while (true) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
if ((v = CurrentPositionToTerm()))
return v;
} else {
reset_regs(tokstart, fe);
}
}
}
return 0;
}
static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS
Term v1, v2, v3, vc, tp;
CurrentModule = fe->cmod;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (fe->vp)
v1 = get_variables(fe, tokstart);
else
v1 = 0L;
if (fe->np)
v2 = get_varnames(fe, tokstart);
else
v2 = 0L;
if (fe->sp)
v3 = get_singletons(fe, tokstart);
else
v3 = 0L;
if (fe->tcomms)
vc = LOCAL_Comments;
else
vc = 0L;
if (fe->tp)
tp = get_stream_position(fe, tokstart );
else
tp = 0L;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
// trail must be ok by now.]
if ((!fe->vp || Yap_unify(v1, fe->vp)) &&
(!fe->np || Yap_unify(v2, fe->np)) &&
(!fe->sp || Yap_unify(v3, fe->sp)) &&
(!fe->tcomms || Yap_unify(LOCAL_Comments, fe->tcomms)) &&
(!fe->tp || Yap_unify(fe->tp, CurrentPositionToTerm())))
if ( ( !v1 || Yap_unify(v1, fe->vp) ) &&
( !v2 || Yap_unify(v2, fe->np)) &&
( !v3 || Yap_unify(v3, fe->sp)) &&
( !tp || Yap_unify(tp, fe->tp)) &&
( !vc || Yap_unify(vc, fe->tcomms)))
return fe->t;
return 0;
}
static bool complete_clause_processing(FEnv *fe, TokEntry
*tokstart) {
CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos;
CurrentModule = fe->cmod;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (fe->vp)
v_vp = get_variables(fe, tokstart);
else
v_vp = 0L;
if (fe->np)
v_vnames = get_varnames(fe, tokstart);
else
v_vnames = 0L;
if (trueGlobalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) {
warn_singletons(fe, tokstart);
}
if (fe->tcomms)
v_comments = LOCAL_Comments;
else
v_comments = 0L;
if (fe->tp)
v_pos = get_stream_position(fe, tokstart );
else
v_pos = 0L;
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
// trail must be ok by now.]
if ( ( !v_vp || Yap_unify(v_vp, fe->vp) ) &&
( !v_vnames || Yap_unify(v_vnames, fe->np)) &&
( !v_pos || Yap_unify(v_pos, fe->tp)) &&
( !v_comments || Yap_unify(v_comments, fe->tcomms)))
return fe->t;
return 0;
}
static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
int nargs);
@ -680,6 +808,12 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
// next step
return YAP_PARSING;
}
if (LOCAL_tokptr->Tok == eot_tok && LOCAL_tokptr->TokInfo == TermNl) {
LOCAL_ErrorMessage = "Empty clause";
LOCAL_Error_TYPE = SYNTAX_ERROR;
LOCAL_Error_Term = TermEof;
return YAP_PARSING_ERROR;
}
return scanEOF(fe, inp_stream);
}
@ -768,7 +902,7 @@ static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
TR = (tr_fr_ptr)tokstart;
if (fe->t == 0)
return YAP_PARSING_ERROR;
if (fe->reading_clause && !complete_clause_processing(fe, tokstart, fe->t))
if (fe->reading_clause && !complete_clause_processing(fe, tokstart))
fe->t = 0;
else if (!fe->reading_clause && !complete_processing(fe, tokstart))
fe->t = 0;
@ -825,7 +959,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
{
CACHE_REGS
if (fe.reading_clause &&
!complete_clause_processing(&fe, LOCAL_tokptr, fe.t))
!complete_clause_processing(&fe, LOCAL_tokptr))
fe.t = 0;
else if (!fe.reading_clause && !complete_processing(&fe, LOCAL_tokptr))
fe.t = 0;
@ -839,12 +973,11 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
Term rc;
yhandle_t h = Yap_InitSlot(ARG1);
yhandle_t h = Yap_PushHandle(ARG1);
if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0)
return FALSE;
Term tf = Yap_GetFromSlot(h);
Yap_RecoverSlots(1, h);
return Yap_unify(tf, rc);
Term tf = Yap_PopHandle(h);
return rc && Yap_unify(tf, rc);
}
static Int read_term(
@ -853,23 +986,23 @@ static Int read_term(
Int out;
/* needs to change LOCAL_output_stream for write */
yhandle_t h = Yap_InitSlot(ARG2);
yhandle_t h = Yap_PushHandle(ARG2);
inp_stream = Yap_CheckTextStream(ARG1, Input_Stream_f, "read/3");
if (inp_stream == -1) {
return (FALSE);
}
out = Yap_read_term(inp_stream, ARG3, 3);
UNLOCK(GLOBAL_Stream[inp_stream].streamlock);
Term tf = Yap_GetFromSlot(h);
Yap_RecoverSlots(1, h);
Term tf = Yap_PopHandle(h);
return out != 0L && Yap_unify(tf, out);
}
#define READ_CLAUSE_DEFS() \
PAR("comments", filler, READ_CLAUSE_COMMENTS), \
PAR("process_comments", boolean, READ_CLAUSE_PROCESS_COMMENTS), \
PAR("comments", list_filler, READ_CLAUSE_COMMENTS), \
PAR("module", isatom, READ_CLAUSE_MODULE), \
PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
PAR("variables", filler, READ_CLAUSE_VARIABLES), \
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
PAR(NULL, ok, READ_CLAUSE_END)
@ -897,23 +1030,32 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
return NULL;
}
re->bq = getBackQuotesFlag();
fe->enc = GLOBAL_Stream[inp_stream].encoding;
fe->cmod = CurrentModule;
CurrentModule = LOCAL_SourceModule;
if (CurrentModule == TermProlog)
CurrentModule = PROLOG_MODULE;
if (args[READ_CLAUSE_MODULE].used) {
fe->tcomms = args[READ_CLAUSE_MODULE].tvalue;
} else {
fe->tcomms = 0L;
}
fe->sp = 0;
fe->qq = 0;
if (args[READ_CLAUSE_TERM_POSITION].used) {
fe->tp = args[READ_CLAUSE_TERM_POSITION].tvalue;
} else {
fe->tp = 0;
}
if (trueLocalPrologFlag(SINGLE_VAR_WARNINGS_FLAG)) {
fe->sp = TermNil;
} else {
fe->sp = 0;
}
if (args[READ_CLAUSE_COMMENTS].used) {
fe->sp = 0;
if (args[READ_CLAUSE_COMMENTS].used) {
fe->tcomms = args[READ_CLAUSE_COMMENTS].tvalue;
if (fe->tcomms == TermProlog)
fe->tcomms = PROLOG_MODULE;
} else {
fe->tcomms = 0;
} if (args[READ_CLAUSE_SYNTAX_ERRORS].used) {
fe->tcomms = 0L;
}
if (args[READ_CLAUSE_SYNTAX_ERRORS].used) {
re->sy = args[READ_CLAUSE_SYNTAX_ERRORS].tvalue;
} else {
re->sy = TermDec10;
@ -924,6 +1066,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} else {
fe->np = 0;
}
if (args[READ_CLAUSE_VARIABLES].used) {
fe->vp = args[READ_CLAUSE_VARIABLES].tvalue;
} else {
fe->vp = 0;
}
fe->ce = Yap_CharacterEscapes(CurrentModule);
re->seekable = (GLOBAL_Stream[inp_stream].status & Seekable_Stream_f) != 0;
if (re->seekable) {
@ -937,75 +1084,6 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
return args;
}
static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart, Term t) {
CACHE_REGS
Term v1, v2, v3 = TermNil;
CurrentModule = fe->cmod;
{
fe->old_H = HR;
while (TRUE) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
v1 = Yap_VarNames(LOCAL_VarTable, TermNil);
break;
} else {
reset_regs(tokstart, fe);
}
}
}
if (fe->tp) {
fe->old_H = HR;
while (TRUE) {
if (setjmp(LOCAL_IOBotch) == 0) {
v2 = MkIntegerTerm(Yap_FirstLineInParse());
break;
} else {
*HR++ = v1;
reset_regs(tokstart, fe);
v1 = *--HR;
}
}
}
if (fe->sp) {
fe->old_H = HR;
while (TRUE) {
fe->old_H = HR;
if (setjmp(LOCAL_IOBotch) == 0) {
v3 = Yap_Singletons(LOCAL_VarTable, TermNil);
break;
} else {
*HR++ = v1;
*HR++ = v2;
reset_regs(tokstart, fe);
v2 = *--HR;
v1 = *--HR;
}
}
}
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
if (fe->tcomms && Yap_unify(LOCAL_Comments, fe->tcomms))
return false;
if (v3 != TermNil) {
Term singls[4];
singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomSingleton, 1), 1, &v3);
singls[1] = MkIntegerTerm(LOCAL_SourceFileLineno);
singls[2] = MkAtomTerm(LOCAL_SourceFileName);
singls[3] = t;
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, singls);
singls[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 1), 1, &t);
singls[1] = TermNil;
Yap_PrintWarning(Yap_MkApplTerm(FunctorError, 2, singls));
}
if (fe->np && !Yap_unify(v1, fe->np))
return 0;
if (fe->tp && !Yap_unify(v2, fe->tp))
return 0;
return fe->t;
}
/**
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det
*
@ -1015,12 +1093,13 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart, Term t) {
static Int read_clause2(USES_REGS1) {
Term rc;
yhandle_t h = Yap_InitSlot(ARG1);
rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), -2);
rc = Yap_read_term(LOCAL_c_input_stream, Deref(ARG2), 2);
Term tf = Yap_GetFromSlot(h);
Yap_RecoverSlots(1, h);
return rc && Yap_unify(tf, rc);
}
/**
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det
*
@ -1059,6 +1138,7 @@ static Int read_clause(
return out && Yap_unify(tf, out);
}
/**
* @pred source_location( - _File_ , _Line_ )
*
@ -1195,7 +1275,7 @@ Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio,
if (bindings) {
ctl = Yap_MkApplTerm(Yap_MkFunctor(AtomVariableNames, 1), 1, &bvar);
sl = Yap_InitSlot(bvar);
sl = Yap_PushHandle(bvar);
} else {
ctl = TermNil;
sl = 0;
@ -1208,45 +1288,12 @@ Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio,
Yap_CloseStream(stream);
UNLOCK(GLOBAL_Stream[stream].streamlock);
if (rval && bindings) {
*bindings = Yap_GetFromSlot(sl);
}
if (bindings) {
Yap_RecoverSlots(sl, 1);
*bindings = Yap_PopHandle(sl);
}
return rval;
}
Term Yap_ReadFromAtom(Atom a, Term opts) {
Term rval;
int sno;
if (IsWideAtom(a)) {
wchar_t *ws = a->WStrOfAE;
size_t len = wcslen(ws);
encoding_t enc = ENC_ISO_ANSI;
sno = Yap_open_buf_read_stream((char *)ws, len, &enc, MEM_BUF_USER);
} else {
char *s = a->StrOfAE;
size_t len = strlen(s);
encoding_t enc = ENC_ISO_LATIN1;
sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER);
}
rval = Yap_read_term(sno, opts, 3);
Yap_CloseStream(sno);
return rval;
}
static Term readFromBuffer(const char *s, Term opts) {
Term rval;
int sno;
encoding_t enc = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen_utf8((unsigned char *)s),
&enc, MEM_BUF_USER);
rval = Yap_read_term(sno, opts, 3);
Yap_CloseStream(sno);
return rval;
}
/**
* @pred read_term_from_atom( +_Atom_ , - _T_ , + _VarNames_
@ -1320,23 +1367,23 @@ static Int term_to_string(USES_REGS1) {
*
*/
static Int term_to_atom(USES_REGS1) {
Term t1 = Deref(ARG2), ctl, rc = false;
Term t2 = Deref(ARG2), ctl, rc = false;
Atom at;
if (IsVarTerm(t1)) {
if (IsVarTerm(t2)) {
size_t length;
char *s = Yap_TermToString(t1, NULL, 0, &length, NULL,
char *s = Yap_TermToString(Deref(ARG1), NULL, 0, &length, NULL,
Quote_illegal_f | Handle_vars_f);
if (!s || !(at = Yap_LookupAtom(s))) {
Yap_Error(RESOURCE_ERROR_HEAP, t1,
Yap_Error(RESOURCE_ERROR_HEAP, t2,
"Could not get memory from the operating system");
return false;
}
return Yap_unify(ARG2, MkAtomTerm(at));
} else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "atom_to_term/2");
} else if (!IsAtomTerm(t2)) {
Yap_Error(TYPE_ERROR_ATOM, t2, "atom_to_term/2");
return (FALSE);
} else {
at = AtomOfTerm(t1);
at = AtomOfTerm(t2);
}
ctl = TermNil;
return Yap_ReadFromAtom(at, ctl) == 0L && Yap_unify(rc, ARG1);
@ -1373,6 +1420,38 @@ static Int read_term_from_atom(USES_REGS1) {
return Yap_unify(rc, ARG2);
}
Term Yap_ReadFromAtom(Atom a, Term opts) {
Term rval;
int sno;
if (IsWideAtom(a)) {
wchar_t *ws = a->WStrOfAE;
size_t len = wcslen(ws);
encoding_t enc = ENC_ISO_ANSI;
sno = Yap_open_buf_read_stream((char *)ws, len, &enc, MEM_BUF_USER);
} else {
char *s = a->StrOfAE;
size_t len = strlen(s);
encoding_t enc = ENC_ISO_LATIN1;
sno = Yap_open_buf_read_stream((char *)s, len, &enc, MEM_BUF_USER);
}
rval = Yap_read_term(sno, opts, 3);
Yap_CloseStream(sno);
return rval;
}
static Term readFromBuffer(const char *s, Term opts) {
Term rval;
int sno;
encoding_t enc = ENC_ISO_UTF8;
sno = Yap_open_buf_read_stream((char *)s, strlen_utf8((unsigned char *)s),
&enc, MEM_BUF_USER);
rval = Yap_read_term(sno, opts, 3);
Yap_CloseStream(sno);
return rval;
}
/**
* @pred read_term_from_string( +_String_ , - _T_ , + _Options_
*
@ -1452,7 +1531,7 @@ void Yap_InitReadTPreds(void) {
Yap_InitCPred("read", 1, read1, SyncPredFlag);
Yap_InitCPred("read", 2, read2, SyncPredFlag);
Yap_InitCPred("read_term", 2, read_term2, SyncPredFlag);
Yap_InitCPred("read_term", 3, read_term, 0);
Yap_InitCPred("read_term", 3, read_term, SyncPredFlag);
Yap_InitCPred("read_clause", 2, read_clause2, SyncPredFlag);
Yap_InitCPred("read_clause", 3, read_clause, 0);

43
os/sig.c
View File

@ -1,15 +1,7 @@
#include "sysbits.h"
#if HAVE_SIGNAL_H
#include <signal.h>
#ifdef MPW
#define signal sigset
#endif
#if HAVE_SIGNAL
#ifdef MSH
@ -579,6 +571,39 @@ MSCHandleSignal(DWORD dwCtrlType) {
#endif /* HAVE_SIGNAL */
/* wrapper for alarm system call */
#if _MSC_VER || defined(__MINGW32__)
static DWORD WINAPI
DoTimerThread(LPVOID targ)
{
Int *time = (Int *)targ;
HANDLE htimer;
LARGE_INTEGER liDueTime;
htimer = CreateWaitableTimer(NULL, FALSE, NULL);
liDueTime.QuadPart = -10000000;
liDueTime.QuadPart *= time[0];
/* add time in usecs */
liDueTime.QuadPart -= time[1]*10;
/* Copy the relative time into a LARGE_INTEGER. */
if (SetWaitableTimer(htimer, &liDueTime,0,NULL,NULL,0) == 0) {
return(FALSE);
}
if (WaitForSingleObject(htimer, INFINITE) != WAIT_OBJECT_0)
fprintf(stderr,"WaitForSingleObject failed (%ld)\n", GetLastError());
Yap_signal (YAP_WINTIMER_SIGNAL);
/* now, say what is going on */
Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue));
ExitThread(1);
#if _MSC_VER
return(0L);
#endif
}
#endif
static Int
enable_interrupts( USES_REGS1 )
{

27
os/streams.c
View File

@ -189,7 +189,7 @@ static Int is_output(int sno
static Int
has_bom(int sno, Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f;
if (!IsVarTerm(t2) && !boolean(t2)) {
if (!IsVarTerm(t2) && !booleanFlag(t2)) {
return FALSE;
}
if (rc) {
@ -203,7 +203,7 @@ static Int
has_reposition(int sno,
Term t2 USES_REGS) { /* '$set_output'(+Stream,-ErrorMessage) */
bool rc = GLOBAL_Stream[sno].status & Seekable_Stream_f;
if (!IsVarTerm(t2) && !boolean(t2)) {
if (!IsVarTerm(t2) && !booleanFlag(t2)) {
return FALSE;
}
if (rc) {
@ -647,9 +647,9 @@ static Int stream_property(USES_REGS1) { /* Init current_stream */
#define SET_STREAM_DEFS() \
PAR("alias", isatom, SET_STREAM_ALIAS), \
PAR("buffer", boolean, SET_STREAM_BUFFER), \
PAR("buffer", booleanFlag, SET_STREAM_BUFFER), \
PAR("buffer_size", nat, SET_STREAM_BUFFER_SIZE), \
PAR("close_on_abort", boolean, SET_STREAM_CLOSE_ON_ABORT), \
PAR("close_on_abort", booleanFlag, SET_STREAM_CLOSE_ON_ABORT), \
PAR("encoding", isatom, SET_STREAM_ENCODING), \
PAR("eof_action", isatom, SET_STREAM_EOF_ACTION), \
PAR("file_name", isatom, SET_STREAM_FILE_NAME), \
@ -798,18 +798,16 @@ void Yap_CloseStreams(int loud) {
continue;
if ((GLOBAL_Stream[sno].status & Popen_Stream_f))
pclose(GLOBAL_Stream[sno].file);
#if _MSC_VER || defined(__MINGW32__)
if (GLOBAL_Stream[sno].status & Pipe_Stream_f)
CloseHandle(GLOBAL_Stream[sno].u.pipe.hdl);
#else
if (GLOBAL_Stream[sno].status & (Pipe_Stream_f | Socket_Stream_f))
close(GLOBAL_Stream[sno].u.pipe.fd);
#endif
#if USE_SOCKET
else if (GLOBAL_Stream[sno].status & (Socket_Stream_f)) {
Yap_CloseSocket(GLOBAL_Stream[sno].u.socket.fd,
GLOBAL_Stream[sno].u.socket.flags,
GLOBAL_Stream[sno].u.socket.domain);
} else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
}
#endif
else if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE) {
Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf);
} else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) {
@ -846,12 +844,9 @@ static void CloseStream(int sno) {
}
#endif
else if (GLOBAL_Stream[sno].status & Pipe_Stream_f) {
#if _MSC_VER || defined(__MINGW32__)
CloseHandle(GLOBAL_Stream[sno].u.pipe.hdl);
#else
close(GLOBAL_Stream[sno].u.pipe.fd);
#endif
} else if (GLOBAL_Stream[sno].status & (InMemory_Stream_f)) {
Yap_CloseMemoryStream( sno );
if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_CODE)
Yap_FreeAtomSpace(GLOBAL_Stream[sno].u.mem_string.buf);
else if (GLOBAL_Stream[sno].u.mem_string.src == MEM_BUF_MALLOC) {
@ -1329,11 +1324,7 @@ Int Yap_StreamToFileNo(Term t) {
Yap_CheckStream(t, (Input_Stream_f | Output_Stream_f), "StreamToFileNo");
if (GLOBAL_Stream[sno].status & Pipe_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
#if _MSC_VER || defined(__MINGW32__)
return ((Int)(GLOBAL_Stream[sno].u.pipe.hdl));
#else
return (GLOBAL_Stream[sno].u.pipe.fd);
#endif
#if HAVE_SOCKET
} else if (GLOBAL_Stream[sno].status & Socket_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);

22
os/writeterm.c
View File

@ -100,19 +100,19 @@ static char SccsId[] = "%W% %G%";
#define WRITE_DEFS() \
PAR( "module", isatom, WRITE_MODULE ), \
PAR( "attributes", isatom, WRITE_ATTRIBUTES ), \
PAR( "cycles", boolean, WRITE_CYCLES ), \
PAR( "quoted", boolean, WRITE_QUOTED ), \
PAR( "ignore_ops", boolean, WRITE_IGNORE_OPS ), \
PAR( "cycles", booleanFlag, WRITE_CYCLES ), \
PAR( "quoted", booleanFlag, WRITE_QUOTED ), \
PAR( "ignore_ops", booleanFlag, WRITE_IGNORE_OPS ), \
PAR( "max_depth",nat, WRITE_MAX_DEPTH ), \
PAR( "numbervars", boolean, WRITE_NUMBERVARS ), \
PAR( "portrayed", boolean, WRITE_PORTRAYED ), \
PAR( "portray", boolean, WRITE_PORTRAY ), \
PAR( "numbervars", booleanFlag, WRITE_NUMBERVARS ), \
PAR( "portrayed", booleanFlag, WRITE_PORTRAYED ), \
PAR( "portray", booleanFlag, WRITE_PORTRAY ), \
PAR( "priority", nat, WRITE_PRIORITY ), \
PAR( "character_escapes", boolean, WRITE_CHARACTER_ESCAPES ), \
PAR( "backquotes", boolean, WRITE_BACKQUOTES ), \
PAR( "brace_terms", boolean, WRITE_BRACE_TERMS ), \
PAR( "fullstop", boolean, WRITE_FULLSTOP ), \
PAR( "nl", boolean, WRITE_NL ), \
PAR( "character_escapes", booleanFlag, WRITE_CHARACTER_ESCAPES ), \
PAR( "backquotes", booleanFlag, WRITE_BACKQUOTES ), \
PAR( "brace_terms", booleanFlag, WRITE_BRACE_TERMS ), \
PAR( "fullstop", booleanFlag, WRITE_FULLSTOP ), \
PAR( "nl", booleanFlag, WRITE_NL ), \
PAR( "variable_names",ok, WRITE_VARIABLE_NAMES ), \
PAR( NULL, ok, WRITE_END )