From 06a2caf7a9aa638b65283abd7025132680acca93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 31 Jan 2016 10:39:15 +0000 Subject: [PATCH] init fields lots of docs, boolean -> booleanFlag --- os/YapIOConfig.h.cmake | 8 +- os/iopreds.h | 30 +-- os/open_memstream.c | 2 +- os/pipes.c | 75 ++------ os/random.c | 35 +++- os/readline.c | 43 +++-- os/readterm.c | 411 ++++++++++++++++++++++++----------------- os/sig.c | 43 ++++- os/streams.c | 27 +-- os/writeterm.c | 22 +-- 10 files changed, 397 insertions(+), 299 deletions(-) diff --git a/os/YapIOConfig.h.cmake b/os/YapIOConfig.h.cmake index f374e1916..b5ab16c19 100644 --- a/os/YapIOConfig.h.cmake +++ b/os/YapIOConfig.h.cmake @@ -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 header file. */ @@ -10,7 +10,11 @@ /* Define to 1 if you have the 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 diff --git a/os/iopreds.h b/os/iopreds.h index 499723efd..301b65c1f 100644 --- a/os/iopreds.h +++ b/os/iopreds.h @@ -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 #include "Yap.h" #include "Atoms.h" @@ -32,6 +37,15 @@ extern size_t Yap_page_size; #include +#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); diff --git a/os/open_memstream.c b/os/open_memstream.c index 44c2c6aef..ab9c805a8 100644 --- a/os/open_memstream.c +++ b/os/open_memstream.c @@ -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 diff --git a/os/pipes.c b/os/pipes.c index 9b383cc07..b09dd7559 100644 --- a/os/pipes.c +++ b/os/pipes.c @@ -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 +#endif +#if HAVE_FCNTL_H +#include +#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); diff --git a/os/random.c b/os/random.c index b34850b48..90bde48f1 100644 --- a/os/random.c +++ b/os/random.c @@ -1,7 +1,34 @@ - - -#include "sysbits.h" - +#include "Yap.h" +#include "Yatom.h" +#include "YapHeap.h" +#include "yapio.h" +#include +#if HAVE_UNISTD_H +#include +#endif +#if HAVE_STDARG_H +#include +#endif +#ifdef _WIN32 +#if HAVE_IO_H +/* Windows */ +#include +#endif +#if HAVE_SOCKET +#include +#endif +#include +#ifndef S_ISDIR +#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) +#endif +#endif +#if HAVE_ERRNO_H +#include +#endif +#if HAVE_FCNTL_H +#include +#endif +#include "iopreds.h" #if HAVE_TIME_H #include diff --git a/os/readline.c b/os/readline.c index e5b383df2..ed7ea0bc7 100644 --- a/os/readline.c +++ b/os/readline.c @@ -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 #include @@ -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 diff --git a/os/readterm.c b/os/readterm.c index c197b2ea3..f1a123e87 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -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); diff --git a/os/sig.c b/os/sig.c index b04010a5a..2cc4c5052 100644 --- a/os/sig.c +++ b/os/sig.c @@ -1,15 +1,7 @@ - #include "sysbits.h" -#if HAVE_SIGNAL_H - -#include - -#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 ) { diff --git a/os/streams.c b/os/streams.c index ad5d88201..c925cb3c1 100644 --- a/os/streams.c +++ b/os/streams.c @@ -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); diff --git a/os/writeterm.c b/os/writeterm.c index d8564dd26..337b3317e 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -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 )