From 9c1a3cc3b18eb083644a2fb138dccbf3d23cd777 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Thu, 18 Jun 2015 00:59:10 +0100 Subject: [PATCH] support for get and put --- os/charsio.c | 1050 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1050 insertions(+) create mode 100644 os/charsio.c diff --git a/os/charsio.c b/os/charsio.c new file mode 100644 index 000000000..b5bae2466 --- /dev/null +++ b/os/charsio.c @@ -0,0 +1,1050 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: charcodes.c * +* Last rev: 5/2/88 * +* mods: * +* comments: Character codes and character conversion * +* * +*************************************************************************/ +#ifdef SCCS +static char SccsId[] = "%W% %G%"; +#endif + +/* + * This file includes the definition of a pipe related IO. + * + */ + +#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 +#include "iopreds.h" + +static Int get_code( USES_REGS1); +static Int get_byte( USES_REGS1); +//static Int past_eof( USES_REGS1); +static Int put_code( USES_REGS1); +static Int put_byte( USES_REGS1); +static Int skip( USES_REGS1); +static Int flush_output( USES_REGS1); +static Int flush_all_streams( USES_REGS1); + +INLINE_ONLY inline EXTERN Term MkCharTerm (Int c); + +/** + * MkCharTerm: convert a character into a single atom. + * + * @param c the character code + * + * @return the term. + */ +INLINE_ONLY inline EXTERN Term +MkCharTerm (Int c) +{ + wchar_t cs[2]; + cs[0] = c; + cs[0] = '\0'; + return MkAtomTerm(Yap_LookupMaybeWideAtom(cs)); +} + + +/** + * CharOfAtom: convert an atom into a single character. + * + * @param at the atom + * + * @return the char . + */ +INLINE_ONLY inline EXTERN Int +CharOfAtom (Atom at) +{ + if (IsWideAtom(at)) { + return at->WStrOfAE[0]; + } else { + return at->StrOfAE[0]; + } +} + + + +static Int +at_end_of_stream ( USES_REGS1 ) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "past_eof/1"); + Int out; + + if (sno < 0) + return (FALSE); + if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return FALSE; + } + out = GLOBAL_Stream[sno].status & Eof_Stream_f; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return out; +} + +static Int +at_end_of_stream_0 ( USES_REGS1 ) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = LOCAL_c_input_stream; + Int out; + + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return FALSE; + } + out = GLOBAL_Stream[sno].status & Eof_Stream_f; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return out; +} + + +static int +yap_fflush( sno) +{ + Yap_ReadlineFlush( sno ); + if ( (GLOBAL_Stream[sno].status & Output_Stream_f) && + ! (GLOBAL_Stream[sno].status & + (Null_Stream_f| + InMemory_Stream_f| + Socket_Stream_f| + Pipe_Stream_f| + Free_Stream_f)) ) { + return(fflush(GLOBAL_Stream[sno].file)); + } else + return(0); +} + + +static Int +get ( USES_REGS1 ) +{ /* '$get'(Stream,-N) */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get/2"); + int ch; + Int status; + + if (sno < 0) + return FALSE; + status = GLOBAL_Stream[sno].status; + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get/2"); + return FALSE; + } + while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0) + ; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, MkIntegerTerm (ch))); +} + +static Int +get_char ( USES_REGS1 ) +{ /* '$get'(Stream,-N) */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get/2"); + int ch; + Int status; + + if (sno < 0) + return FALSE; + status = GLOBAL_Stream[sno].status; + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get/2"); + return FALSE; + } + ch = GLOBAL_Stream[sno].stream_wgetc(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, MkCharTerm (ch))); +} + +static Int +get_code ( USES_REGS1 ) +{ /* get0(Stream,-N) */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get0/2"); + Int status; + Int out; + + if (sno < 0) + return(FALSE); + status = GLOBAL_Stream[sno].status; + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); + return FALSE; + } + out = GLOBAL_Stream[sno].stream_wgetc(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, MkIntegerTerm (out)) ); +} + + +static Int +get_1 ( USES_REGS1 ) +{ /* get_code1(Stream,-N) */ + int sno = LOCAL_c_input_stream; + int ch; + Int status; + + LOCK(GLOBAL_Stream[sno].streamlock); + status = GLOBAL_Stream[sno].status; + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get_code/1"); + return FALSE; + } + while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0) + ; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG2, MkIntegerTerm (ch))); +} + +static Int +getcode_1 ( USES_REGS1 ) +{ /* get0(Stream,-N) */ + int sno = LOCAL_c_input_stream; + Int status; + Int out; + + status = GLOBAL_Stream[sno].status; + LOCK(GLOBAL_Stream[sno].streamlock); + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); + return FALSE; + } + out = GLOBAL_Stream[sno].stream_wgetc(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG1, MkIntegerTerm (out)) ); +} + +static Int +getchar_1 ( USES_REGS1 ) +{ /* get0(Stream,-N) */ + int sno = LOCAL_c_input_stream; + Int status; + Int out; + + LOCK(GLOBAL_Stream[sno].streamlock); + status = GLOBAL_Stream[sno].status; + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); + return FALSE; + } + out = GLOBAL_Stream[sno].stream_wgetc(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (Yap_unify_constant (ARG1, MkCharTerm (out)) ); +} + + +static Int +get0_line_codes ( USES_REGS1 ) +{ /* '$get0'(Stream,-N) */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get0/2"); + Int status; + Term out; + Int ch = '\0'; + int rewind; + + if (sno < 0) + return(FALSE); + if (GLOBAL_Stream[sno].stream_getc == PlUnGetc) { + ch = PlUnGetc(sno); + rewind = TRUE; + } else { + rewind = FALSE; + } + status = GLOBAL_Stream[sno].status; + if (status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "get0/2"); + return FALSE; + } + out = read_line(sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + if (rewind) + return Yap_unify(MkPairTerm(MkIntegerTerm(ch),out), ARG2); + else + return Yap_unify(out,ARG2); +} + +static Int +get_byte ( USES_REGS1 ) +{ /* '$get_byte'(Stream,-N) */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "get_byte/2"); + Int status; + Term out; + + if (sno < 0) + return(FALSE); + status = GLOBAL_Stream[sno].status; + if (!(status & Binary_Stream_f) && + strictISOFlag()) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "get_byte/2"); + return(FALSE); + } + out = MkIntTerm(GLOBAL_Stream[sno].stream_getc(sno)); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify_constant (ARG2, out); +} + +static Int +get_byte_1 ( USES_REGS1 ) +{ /* '$get_byte'(Stream,-N) */ + int sno = LOCAL_c_input_stream; + Int status; + Term out; + + LOCK(GLOBAL_Stream[sno].streamlock); + status = GLOBAL_Stream[sno].status; + if (!(status & Binary_Stream_f) && + strictISOFlag()) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "get_byte/1"); + return(FALSE); + } + out = MkIntTerm(GLOBAL_Stream[sno].stream_getc(sno)); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return Yap_unify_constant (ARG1, out); +} + +static Int +put_code_1 ( USES_REGS1 ) +{ /* '$put'(,N) */ + int sno = LOCAL_c_output_stream, ch; + Term t2; + + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1"); + return FALSE; + } else if ((ch = IntegerOfTerm (t2)) < -1) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); + return FALSE; + } + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2))); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +put_code ( USES_REGS1 ) +{ /* '$put'(Stream,N) */ + int ch; + Term t2; + int sno; + + if (IsVarTerm(t2 = Deref(ARG2))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1"); + return FALSE; + } else if ((ch = IntegerOfTerm (t2)) < -1) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); + return FALSE; + } + sno = Yap_CheckStream (ARG1, Output_Stream_f, "put/2"); + if (sno < 0) + return (FALSE); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + return(FALSE); + } + + GLOBAL_Stream[sno].stream_wputc (sno, ch); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +put_char_1 ( USES_REGS1 ) +{ /* '$put'(,N) */ + int sno = LOCAL_c_output_stream; + Term t2; + int ch; + + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); + return FALSE; + } else if (!IsAtomTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1"); + return FALSE; + } else if ((ch = CharOfAtom (AtomOfTerm(t2))) < -1) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_char/1"); + return FALSE; + } + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_wputc (sno, ch); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +put_char ( USES_REGS1 ) +{ /* '$put'(Stream,N) */ + Term t2; + int ch; + int sno; + + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); + return FALSE; + } else if (!IsAtomTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1"); + return FALSE; + } else if ((ch = CharOfAtom( AtomOfTerm(t2)) ) < -1) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_char/1"); + return FALSE; + } + sno = Yap_CheckStream (ARG1, Output_Stream_f, "put/2"); + if (sno < 0) + return (FALSE); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2))); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +tab_1 ( USES_REGS1 ) +{ /* nl */ + int sno = LOCAL_c_output_stream; + Term t2; + Int tabs, i; + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1"); + return FALSE; + } else if ((tabs = IntegerOfTerm (t2)) < 0) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1"); + return FALSE; + } + + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0"); + return(FALSE); + } + + for (i= 0; i < tabs; i++) + GLOBAL_Stream[sno].stream_wputc (sno, ' '); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +tab ( USES_REGS1 ) +{ /* nl(Stream) */ + int sno = LOCAL_c_output_stream; + Term t2; + Int tabs, i; + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1"); + return FALSE; + } else if ((tabs = IntegerOfTerm (t2)) < 0) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1"); + return FALSE; + } + sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1"); + if (sno < 0) + return (FALSE); + + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0"); + return(FALSE); + } + + for (i= 0; i < tabs; i++) + GLOBAL_Stream[sno].stream_wputc (sno, ' '); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +nl_1 ( USES_REGS1 ) +{ /* nl */ + int sno = LOCAL_c_output_stream; + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_wputc (sno, 10); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +nl ( USES_REGS1 ) +{ /* nl(Stream) */ + int sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1"); + if (sno < 0) + return (FALSE); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_wputc (sno, 10); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +put_byte ( USES_REGS1 ) +{ /* '$put_byte'(Stream,N) */ + Term t2; + Int ch; + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1"); + return FALSE; + } else if ((ch = IntegerOfTerm (t2)) < -1) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); + return FALSE; + } + int sno = Yap_CheckStream (ARG1, Output_Stream_f, "put/2"); + if (sno < 0) + return (FALSE); + if (!(GLOBAL_Stream[sno].status & Binary_Stream_f) && + strictISOFlag()) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "get0/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_putc(sno, ch); + /* + * if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) + * yap_fflush(GLOBAL_Stream[sno].file); + */ + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +put_byte_1 ( USES_REGS1 ) +{ /* '$put_byte'(Stream,N) */ + Term t2; + Int ch; + int sno = LOCAL_c_output_stream; + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1"); + return FALSE; + } else if ((ch = IntegerOfTerm (t2)) < -1) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1"); + return FALSE; + } + LOCK(GLOBAL_Stream[sno].streamlock); + if (!(GLOBAL_Stream[sno].status & Binary_Stream_f) && + strictISOFlag()) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "get0/2"); + return(FALSE); + } + GLOBAL_Stream[sno].stream_putc(sno, ch); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + + +static Int +skip_1 ( USES_REGS1 ) +{ /* '$skip'(Stream,N) */ + Int n; + Term t2; + int sno; + int ch; + + if (IsVarTerm(t2 = Deref(ARG1))) { + Yap_Error(INSTANTIATION_ERROR, t2, "skip/2"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "skip/2"); + return FALSE; + } else if ((n = IntegerOfTerm (t2)) < 0) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "skip/2"); + return FALSE; + } + sno = Yap_CheckStream (ARG1, Input_Stream_f, "skip/2"); + if (sno < 0) + return (FALSE); + while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != n && ch != -1) + ; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +static Int +skip ( USES_REGS1 ) +{ /* '$skip'(Stream,N) */ + Int n; + Term t2; + int sno; + int ch; + + if (IsVarTerm(t2 = Deref(ARG2))) { + Yap_Error(INSTANTIATION_ERROR, t2, "skip/2"); + return FALSE; + } else if (!IsIntegerTerm (t2)) { + Yap_Error(TYPE_ERROR_INTEGER, t2, "skip/2"); + return FALSE; + } else if ((n = IntegerOfTerm (t2)) < 0) { + Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "skip/2"); + return FALSE; + } + sno = LOCAL_c_input_stream; + LOCK(GLOBAL_Stream[sno].streamlock); + while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != n && ch != -1) + ; + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +/** + * @pred flush_output(+Stream) + * + * Flush the stream _Stream_, that is, make sure all pending output is committed + * before any further execution. + * + * @param +_Stream_ + * + */ +static Int +flush_output ( USES_REGS1 ) +{ /* flush_output(Stream) */ + int sno = Yap_CheckStream (ARG1, Output_Stream_f, "flush_output/1"); + if (sno < 0) + return (FALSE); + yap_fflush (sno); + UNLOCK(GLOBAL_Stream[sno].streamlock); + return (TRUE); +} + +/** + * @pred flush_output + * + * Flush the current output stream, that is, make sure all pending output is committed + * before any further execution. By default this is user_output, but it may be + * changed by current_output/1. + * + */ +static Int +flush_output0 ( USES_REGS1 ) +{ /* flush_output */ + yap_fflush (LOCAL_c_output_stream); + return (TRUE); +} + +static Int +flush_all_streams ( USES_REGS1 ) +{ /* $flush_all_streams */ +#if BROKEN_FFLUSH_NULL + int i; + for (i = 0; i < MaxStreams; ++i) { + LOCK(GLOBAL_Stream[i].streamlock); + yap_fflush (i); + UNLOCK(GLOBAL_Stream[i].streamlock); + } +#else + fflush (NULL); +#endif + + return TRUE; +} + +static Int dopeek( int sno ) +{ + Int ocharcount, olinecount, olinepos; + StreamDesc *s; + Int ch; + + s = GLOBAL_Stream+sno; + ocharcount = s->charcount; + olinecount = s->linecount; + olinepos = s->linepos; + ch = get_wchar(sno); + s->charcount = ocharcount; + s->linecount = olinecount; + s->linepos = olinepos; + /* buffer the character */ + s->och = ch; + /* mark a special function to recover this character */ + s->stream_getc = PlUnGetc; + s->stream_wgetc = get_wchar; + s->stream_gets = DefaultGets; + if (GLOBAL_CharConversionTable != NULL) + s->stream_wgetc_for_read = ISOWGetc; + else + s->stream_wgetc_for_read = s->stream_wgetc; + + return ch; +} + +/** @pred peek(+ _S_, - _C_) is deprecated + + +If _C_ is unbound, or is the code for a character, and +the stream _S_ is a text stream, read the next character from the +current stream and unify its code with _C_, while +leaving the current stream position unaltered. + +*/ + +/** @pred peek_code(+ _S_, - _C_) is iso + + +If _C_ is unbound, or is the code for a character, and +the stream _S_ is a text stream, read the next character from the +current stream and unify its code with _C_, while +leaving the current stream position unaltered. + +*/ +static Int +peek_code ( USES_REGS1 ) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); + Int ch; + + if (sno < 0) + return FALSE; + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_code/2"); + return FALSE; + } + if ((ch = dopeek( sno )) < 0) + return false; + return(Yap_unify_constant(ARG2,MkIntTerm(ch))); +} + + +/** @pred peek_code( - _C_) is iso + + +If _C_ is unbound, or is the code for a character, and +the current input stream is a text stream, read the next character from the +current stream and unify its code with _C_, while +leaving the current stream position unaltered. + +*/ +static Int +peek_code_1 ( USES_REGS1 ) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = LOCAL_c_input_stream; + Int ch; + + LOCK(GLOBAL_Stream[sno].streamlock); + if (GLOBAL_Stream[sno].status & Binary_Stream_f) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_code/2"); + return FALSE; + } + if ((ch = dopeek( sno )) < 0) + return false; + return(Yap_unify_constant(ARG2,MkIntTerm(ch))); +} + + +/** @pred peek_byte(+Stream, - _C_) is iso + + +If _C_ is unbound, or is a character code, and _Stream_ is a +binary stream, read the next byte from the current stream and unify its +code with _C_, while leaving the current stream position unaltered. +*/ +static Int +peek_byte ( USES_REGS1 ) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); + Int ch; + + if (sno < 0) + return(FALSE); + if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); + return(FALSE); + } + if ((ch = dopeek( sno )) < 0) + return false; + return(Yap_unify_constant(ARG2,MkIntTerm(ch))); +} + + +/** @pred peek_byte( - _C_) is iso + + +If _C_ is unbound, or is a character code, and _Stream_ is a +binary stream, read the next byte from the current stream and unify its +code with _C_, while leaving the current stream position unaltered. +*/ +static Int +peek_byte_1 ( USES_REGS1 ) +{ /* at_end_of_stream */ + /* the next character is a EOF */ + int sno = LOCAL_c_input_stream; + Int ch; + + if (sno < 0) + return(FALSE); + LOCK(GLOBAL_Stream[sno].streamlock); + if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); + return(FALSE); + } + if ((ch = dopeek( sno )) < 0) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return false; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + return(Yap_unify_constant(ARG2,MkIntTerm(ch))); +} + + +/** @pred peek_char(+_S_, - _C_) is iso + + +If _C_ is unbound, or is a character code, and the stream _S_ is a +binary stream, read the next byte from the current stream and unify the +atom with _C_, while leaving the stream position unaltered. +*/ +static Int +peek_char ( USES_REGS1 ) +{ + /* the next character is a EOF */ + int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); + wchar_t wsinp[2]; + Int ch; + + if (sno < 0) + return(FALSE); + if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); + return(FALSE); + } + if ((ch = dopeek( sno )) < 0) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return false; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + wsinp[1] = '\0'; + wsinp[0] = ch; + return Yap_unify_constant(ARG2,MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp ))); +} + +/** @pred peek_char( - _C_) is iso + + +If _C_ is unbound, or is a character code, and the current input stream is a +binary stream, read the next byte from the current stream and unify the +atom with _C_, while leaving the stream position unaltered. +*/ +static Int +peek_char_1 ( USES_REGS1 ) +{ + /* the next character is a EOF */ + int sno = LOCAL_c_input_stream; + wchar_t wsinp[2]; + Int ch; + + LOCK(GLOBAL_Stream[sno].streamlock); + if ((ch = dopeek( sno )) < 0) { + UNLOCK(GLOBAL_Stream[sno].streamlock); + return false; + } + UNLOCK(GLOBAL_Stream[sno].streamlock); + wsinp[1] = '\0'; + wsinp[0] = ch; + return Yap_unify_constant(ARG2,MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp ))); +} + + +/** @pred peek(+ _S_, - _C_) is deprecated + + +If _C_ is unbound, or is the code for a character, and +the stream _S_ is a text stream, read the next character from the +current stream and unify its code with _C_, while +leaving the current stream position unaltered. + +Please use the ISO built-in peek_code/2. +*/ + +/** @pred peek( - _C_) is iso + + +If _C_ is unbound, or is the code for a character, and +the currrent input stream is a text stream, read the next character from the +current stream and unify its code with _C_, while +leaving the current stream position unaltered. + +*/ + + + +void Yap_flush(void) +{ + CACHE_REGS + (void)flush_all_streams(PASS_REGS1); +} + +void Yap_FlushStreams(void) +{ + CACHE_REGS + (void)flush_all_streams(PASS_REGS1); +} + +void +Yap_InitCharsio( void ) +{ + Yap_InitCPred ("get", 2, get, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get_code", 2, get_code, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get_char", 2, get_char, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get0", 2, get_code, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get", 1, get_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get_code", 1, getcode_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get_char", 1, getchar_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("get0", 1, getcode_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("$get0_line_codes", 2, get0_line_codes, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("get_byte", 2, get_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("get_byte", 1, get_byte_1, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("put", 1, put_code_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put", 2, put_code, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_code", 1, put_code_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_code", 2, put_code, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_char", 1, put_char_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_char", 2, put_char, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_byte", 2, put_byte, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_byte", 1, put_byte_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_char", 2, put_char, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("put_char1", 1, put_char_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("tab", 2, tab, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("tab1", 1, tab_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("nl", 0, nl_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("nl", 1, nl, SafePredFlag|SyncPredFlag); + + Yap_InitCPred ("$flush_all_streams", 0, flush_all_streams, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred ("flush_output", 1, flush_output, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("flush_output", 0, flush_output0, SafePredFlag|SyncPredFlag); + + Yap_InitCPred ("at_end_of_stream", 1, at_end_of_stream, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("at_end_of_stream_0", 0, at_end_of_stream_0, SafePredFlag|SyncPredFlag); + //Yap_InitCPred ("$past_eof", 1, past_eof, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek", 2, peek_code, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek_code", 2, peek_code, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek_char", 2, peek_char, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek_byte", 2, peek_byte, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek", 1, peek_code_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek_code", 1, peek_code_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek_char", 1, peek_char_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("peek_byte", 1, peek_byte_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("skip", 2, skip, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("skip1", 1, skip_1, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("tab", 2, tab, SafePredFlag|SyncPredFlag); + Yap_InitCPred ("tab1", 1, tab_1, SafePredFlag|SyncPredFlag); + + +}