This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/os/charsio.c

1179 lines
33 KiB
C
Raw Normal View History

2015-06-18 00:59:10 +01:00
/*************************************************************************
* *
* 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
2015-12-15 09:18:36 +00:00
/**
* @file charsio.c
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 11:37:16 2015
* @brief This file includes the definition of character-by-character related
*IO.
*
*
*/
/* @defgroup CharIO Character-Based Input/Output
* @ingroup InputOutput
*
* YAP implements most of the ISO-Prolog built-ins. Input/Output may be
*performed on
* the current stream or on a specified stream, and it may involve a:
* + byte
* + character code
* + character atom
*
* Old-style operations, like get0/2 are still implemented.
*
2015-06-18 00:59:10 +01:00
*
*/
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
2015-12-15 09:14:15 +00:00
#include "YapText.h"
2015-06-18 00:59:10 +01:00
#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>
2015-07-28 04:22:44 +01:00
#endif
2015-06-18 00:59:10 +01:00
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
2015-10-18 11:48:14 +01:00
#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
2015-06-18 00:59:10 +01:00
#endif
#endif
#include "iopreds.h"
2015-10-18 11:48:14 +01:00
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);
2015-06-18 00:59:10 +01:00
2015-07-28 04:22:44 +01:00
/**
2015-06-18 00:59:10 +01:00
* CharOfAtom: convert an atom into a single character.
2015-07-28 04:22:44 +01:00
*
2015-06-18 00:59:10 +01:00
* @param at the atom
2015-07-28 04:22:44 +01:00
*
* @return the char .
2015-06-18 00:59:10 +01:00
*/
2015-10-18 11:48:14 +01:00
INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
2015-06-18 00:59:10 +01:00
if (IsWideAtom(at)) {
return at->WStrOfAE[0];
} else {
return at->StrOfAE[0];
}
}
2015-10-18 11:48:14 +01:00
static int plUnGetc(int sno, int ch) {
return ungetc(ch, GLOBAL_Stream[sno].file);
}
2015-06-18 00:59:10 +01:00
2015-10-18 11:48:14 +01:00
Int Yap_peek(int sno) {
2015-10-08 10:17:57 +01:00
CACHE_REGS
2015-10-18 11:48:14 +01:00
Int ocharcount, olinecount, olinepos;
StreamDesc *s;
Int ch;
2015-10-18 11:48:14 +01:00
s = GLOBAL_Stream + sno;
2016-01-31 10:37:41 +00:00
#if USE_READLINE
if (s->status & Readline_Stream_f
&& trueGlobalPrologFlag(READLINE_FLAG)
) {
2016-01-03 02:06:09 +00:00
ch = Yap_ReadlinePeekChar(sno);
2015-12-15 09:14:15 +00:00
if (ch == EOFCHAR) {
s->stream_getc = EOFPeek;
s->stream_wgetc = EOFWPeek;
s->status |= Push_Eof_Stream_f;
}
return ch;
}
2016-01-31 10:37:41 +00:00
#endif
ocharcount = s->charcount;
olinecount = s->linecount;
olinepos = s->linepos;
2015-10-18 11:48:14 +01:00
ch = s->stream_wgetc(sno);
2016-01-03 02:06:09 +00:00
s->och = ch;
2015-12-15 09:14:15 +00:00
if (ch == EOFCHAR) {
s->stream_getc = EOFPeek;
s->stream_wgetc = EOFWPeek;
s->status |= Push_Eof_Stream_f;
2016-01-03 02:06:09 +00:00
return ch;
2015-12-15 09:14:15 +00:00
}
s->charcount = ocharcount;
s->linecount = olinecount;
s->linepos = olinepos;
/* buffer the character */
2015-10-08 10:17:57 +01:00
if (s->encoding == LOCAL_encoding) {
2015-10-18 11:48:14 +01:00
ungetwc(ch, s->file);
2016-01-03 02:06:09 +00:00
} else if (s->encoding == ENC_OCTET || s->encoding == ENC_ISO_LATIN1 ||
s->encoding == ENC_ISO_ASCII) {
2015-12-15 09:14:15 +00:00
ungetc(ch, s->file);
} else if (s->encoding == ENC_ISO_UTF8) {
unsigned char cs[8];
2016-01-03 02:06:09 +00:00
size_t n = put_utf8(cs, ch);
2015-12-15 09:14:15 +00:00
while (n--) {
2016-01-03 02:06:09 +00:00
ungetc(cs[n - 1], s->file);
2015-12-15 09:14:15 +00:00
}
} else if (s->encoding == ENC_UTF16_BE) {
/* do the ungetc as if a write .. */
unsigned long int c = ch;
2016-01-03 02:06:09 +00:00
if (c > ((1 << 16) - 1)) {
ungetc(c / 1 << 16, s->file);
c %= 1 << 16;
2015-12-15 09:14:15 +00:00
}
ungetc(c, s->file);
} else if (s->encoding == ENC_UTF16_BE) {
/* do the ungetc as if a write .. */
unsigned long int c = ch;
2016-01-03 02:06:09 +00:00
if (c > ((1 << 16) - 1)) {
ungetc(c / 1 << 16, s->file);
c %= 1 << 16;
}
2016-01-31 10:37:41 +00:00
return c;
2015-12-15 09:14:15 +00:00
} else if (s->encoding == ENC_UTF16_LE) {
/* do the ungetc as if a write .. */
2015-12-15 09:14:15 +00:00
unsigned long int c = ch;
2016-01-03 02:06:09 +00:00
if (c > ((1 << 16) - 1)) {
ungetc(c % 1 << 16, s->file);
c /= 1 << 16;
2015-12-15 09:14:15 +00:00
}
ungetc(c, s->file);
2016-01-03 02:06:09 +00:00
} else {
int (*f)(int, int) = s->stream_putc;
s->stream_putc = plUnGetc;
2015-10-18 11:48:14 +01:00
put_wchar(sno, ch);
s->stream_putc = f;
}
return ch;
}
2015-10-18 11:48:14 +01:00
static Int dopeek_byte(int sno) {
Int ocharcount, olinecount, olinepos;
StreamDesc *s;
Int ch;
2015-10-18 11:48:14 +01:00
s = GLOBAL_Stream + sno;
ocharcount = s->charcount;
olinecount = s->linecount;
olinepos = s->linepos;
ch = GLOBAL_Stream[sno].stream_getc(sno);
s->charcount = ocharcount;
s->linecount = olinecount;
s->linepos = olinepos;
/* buffer the character */
ungetc(ch, s->file);
return ch;
}
2015-06-18 00:59:10 +01:00
2015-12-15 09:18:36 +00:00
/** @pred at_end_of_stream(+ _S_) is iso
Succeed if the stream _S_ has stream position end-of-stream or
past-end-of-stream. Note that _S_ must be a readable stream.
*/
2015-10-18 11:48:14 +01:00
static Int at_end_of_stream(USES_REGS1) { /* at_end_of_stream */
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-10-18 11:48:14 +01:00
int sno = Yap_CheckStream(ARG1, Input_Stream_f, NULL);
2015-06-18 00:59:10 +01:00
Int out;
if (sno < 0)
return (FALSE);
out = GLOBAL_Stream[sno].status & Eof_Stream_f;
if (!out) {
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
2015-10-18 11:48:14 +01:00
out = (dopeek_byte(sno) < 0);
} else {
2015-10-18 11:48:14 +01:00
out = (Yap_peek(sno) < 0);
}
}
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
return out;
}
2015-12-15 09:18:36 +00:00
/** @pred at_end_of_stream is iso
Succeed if the current stream has stream position end-of-stream or
past-end-of-stream.
*/
2015-10-18 11:48:14 +01:00
static Int at_end_of_stream_0(USES_REGS1) { /* at_end_of_stream */
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-06-18 00:59:10 +01:00
Int out;
int sno = LOCAL_c_input_stream;
2015-06-18 00:59:10 +01:00
out = GLOBAL_Stream[sno].status & Eof_Stream_f;
if (!out) {
2015-10-18 11:48:14 +01:00
out = (Yap_peek(sno) < 0);
}
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
return out;
}
2015-10-20 07:59:05 +01:00
static int yap_fflush(int sno) {
2016-01-31 10:37:41 +00:00
#if USE_READLINE
2015-10-18 11:48:14 +01:00
Yap_ReadlineFlush(sno);
2016-01-31 10:37:41 +00:00
#endif
2015-10-18 11:48:14 +01:00
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));
2015-06-18 00:59:10 +01:00
} else
2015-10-18 11:48:14 +01:00
return (0);
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get(_S_, - _C_)
The next non-blank character from the stream _S_ is unified
with _C_. Blank characters are the ones whose ASCII codes are not
greater than 32. If there are no more non-blank characters in the
stream, _C_ is unified with -1. If `end_of_stream` has already
been reached in the previous reading, this call will give an error message.
*/
2015-10-18 11:48:14 +01:00
static Int get(USES_REGS1) { /* '$get'(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get/2");
2015-06-18 00:59:10 +01:00
int ch;
2015-10-22 11:51:07 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
if (sno < 0)
return FALSE;
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0)
;
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkIntegerTerm(ch)));
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get_char(+ _S_,- _C_) is iso
If _C_ is unbound, or is an atom representation of a character, and
the stream _S_ is a text stream, read the next character from that
stream and unify its representation as an atom with _C_.
*/
2015-10-18 11:48:14 +01:00
static Int get_char(USES_REGS1) { /* '$get'(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get/2");
2015-06-18 00:59:10 +01:00
int ch;
2015-10-20 07:59:05 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
if (sno < 0)
return FALSE;
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
ch = GLOBAL_Stream[sno].stream_wgetc(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkCharTerm(ch)));
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get_code(+ _S_,- _C_) is iso
If _C_ is unbound, or is a character code, and the stream _S_ is a
text stream, read the next character from that stream and unify its
code with _C_.
*/
2015-10-18 11:48:14 +01:00
static Int get_code(USES_REGS1) { /* get0(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get0/2");
2015-10-22 11:51:07 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
Int out;
if (sno < 0)
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
out = GLOBAL_Stream[sno].stream_wgetc(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkIntegerTerm(out)));
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get(- _C_)
The next non-blank character from the current input stream is unified
with _C_. Blank characters are the ones whose ASCII codes are not
greater than 32. If there are no more non-blank characters in the
stream, _C_ is unified with -1. If `end_of_stream` has already
been reached in the previous reading, this call will give an error message.
*/
2015-10-18 11:48:14 +01:00
static Int get_1(USES_REGS1) { /* get_code1(Stream,-N) */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_input_stream;
int ch;
2015-10-22 11:51:07 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) <= 32 && ch >= 0)
;
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkIntegerTerm(ch)));
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get_code(- _C_) is iso
If _C_ is unbound, or is the code for a character, and
the current stream is a text stream, read the next character from the
current stream and unify its code with _C_.
*/
2015-10-18 11:48:14 +01:00
static Int getcode_1(USES_REGS1) { /* get0(Stream,-N) */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_input_stream;
2015-10-22 11:51:07 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
Int out;
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
out = GLOBAL_Stream[sno].stream_wgetc(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG1, MkIntegerTerm(out)));
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get_char(- _C_) is iso
If _C_ is unbound, or is an atom representation of a character, and
the current stream is a text stream, read the next character from the
current stream and unify its atom representation with _C_.
*/
2015-10-18 11:48:14 +01:00
static Int getchar_1(USES_REGS1) { /* get0(Stream,-N) */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_input_stream;
2015-10-22 11:51:07 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
Int out;
LOCK(GLOBAL_Stream[sno].streamlock);
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
out = GLOBAL_Stream[sno].stream_wgetc(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG1, MkCharTerm(out)));
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
static Int get0_line_codes(USES_REGS1) { /* '$get0'(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get0/2");
2015-10-22 11:51:07 +01:00
// Int status;
2015-06-18 00:59:10 +01:00
Term out;
Int ch = '\0';
int rewind;
if (sno < 0)
2015-10-18 11:48:14 +01:00
return (FALSE);
rewind = FALSE;
2015-10-22 11:51:07 +01:00
// status = GLOBAL_Stream[sno].status;
2015-06-18 00:59:10 +01:00
out = read_line(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-07-28 04:22:44 +01:00
if (rewind)
2015-10-18 11:48:14 +01:00
return Yap_unify(MkPairTerm(MkIntegerTerm(ch), out), ARG2);
2015-06-18 00:59:10 +01:00
else
2015-10-18 11:48:14 +01:00
return Yap_unify(out, ARG2);
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get_byte(+ _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 that stream and unify its
code with _C_.
*/
2015-10-18 11:48:14 +01:00
static Int get_byte(USES_REGS1) { /* '$get_byte'(Stream,-N) */
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "get_byte/2");
2015-06-18 00:59:10 +01:00
Int status;
Term out;
if (sno < 0)
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
status = GLOBAL_Stream[sno].status;
2015-10-18 11:48:14 +01:00
if (!(status & Binary_Stream_f)
//&& strictISOFlag()
) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "get_byte/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
out = MkIntTerm(GLOBAL_Stream[sno].stream_getc(sno));
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return Yap_unify_constant(ARG2, out);
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred get_byte(- _C_) is iso
If _C_ is unbound, or is a character code, and the current stream is a
binary stream, read the next byte from the current stream and unify its
code with _C_.
*/
2015-10-18 11:48:14 +01:00
static Int get_byte_1(USES_REGS1) { /* '$get_byte'(Stream,-N) */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_input_stream;
Int status;
Term out;
LOCK(GLOBAL_Stream[sno].streamlock);
status = GLOBAL_Stream[sno].status;
2015-10-18 11:48:14 +01:00
if (!(status & Binary_Stream_f)
// &&strictISOFlag()
) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "get_byte/1");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
out = MkIntTerm(GLOBAL_Stream[sno].stream_getc(sno));
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return Yap_unify_constant(ARG1, out);
2015-06-18 00:59:10 +01:00
}
2015-12-15 09:18:36 +00:00
/** @pred put_code(+ _N_) is iso
Outputs to the current output stream the character whose ASCII code is
_N_. The current output stream must be a text stream. The character
_N_ must be a legal ASCII character code, an expression yielding such
a code, or a list in which case only the first element is used.
*/
2015-10-18 11:48:14 +01:00
static Int put_code_1(USES_REGS1) { /* '$put'(,N) */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_output_stream, ch;
Term t2;
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((ch = IntegerOfTerm(t2)) < -1) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1");
return FALSE;
}
LOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
GLOBAL_Stream[sno].stream_wputc(sno, (int)IntegerOfTerm(Deref(ARG2)));
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred put_code(+ _S_,+ _N_) is iso
As `put_code(N)`, but to text stream _S_.
*/
2015-10-18 11:48:14 +01:00
static Int put_code(USES_REGS1) { /* '$put'(Stream,N) */
2015-06-18 00:59:10 +01:00
int ch;
Term t2;
int sno;
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "put_code/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((ch = IntegerOfTerm(t2)) < -1) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1");
return FALSE;
}
2015-10-18 11:48:14 +01:00
sno = Yap_CheckTextStream(ARG1, Output_Stream_f, "put/2");
2015-06-18 00:59:10 +01:00
if (sno < 0)
return (FALSE);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "put/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-07-28 04:22:44 +01:00
2015-10-18 11:48:14 +01:00
GLOBAL_Stream[sno].stream_wputc(sno, ch);
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred put_char(+ _N_) is iso
Outputs to the current output stream the character who is used to build
the representation of atom `A`. The current output stream must be a
text stream.
*/
2015-10-18 11:48:14 +01:00
static Int put_char_1(USES_REGS1) { /* '$put'(,N) */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_output_stream;
Term t2;
int ch;
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsAtomTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((ch = CharOfAtom(AtomOfTerm(t2))) < -1) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_char/1");
return FALSE;
}
LOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "put/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
GLOBAL_Stream[sno].stream_wputc(sno, ch);
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred put_char(+ _S_,+ _A_) is iso
As `put_char(A)`, but to text stream _S_.
*/
2015-10-18 11:48:14 +01:00
static Int put_char(USES_REGS1) { /* '$put'(Stream,N) */
2015-06-18 00:59:10 +01:00
Term t2;
int ch;
int sno;
2015-07-28 04:22:44 +01:00
2015-08-07 22:57:53 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
2015-06-18 00:59:10 +01:00
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsAtomTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((ch = CharOfAtom(AtomOfTerm(t2))) < -1) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_char/1");
return FALSE;
}
2015-10-18 11:48:14 +01:00
sno = Yap_CheckTextStream(ARG1, Output_Stream_f, "put/2");
2015-06-18 00:59:10 +01:00
if (sno < 0)
return (FALSE);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "put/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
GLOBAL_Stream[sno].stream_wputc(sno, (int)IntegerOfTerm(Deref(ARG2)));
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2016-01-20 22:18:17 +00:00
/** @pred tab_1(+ _N_)
2015-12-15 09:18:36 +00:00
Outputs _N_ spaces to the current output stream.
*/
2015-10-18 11:48:14 +01:00
static Int tab_1(USES_REGS1) { /* nl */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_output_stream;
Term t2;
Int tabs, i;
2015-08-07 22:57:53 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
2015-06-18 00:59:10 +01:00
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((tabs = IntegerOfTerm(t2)) < 0) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1");
return FALSE;
}
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "nl/0");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
for (i = 0; i < tabs; i++)
GLOBAL_Stream[sno].stream_wputc(sno, ' ');
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred tab(+ _S_,+ _N_)
The same as tab/1, but using stream _S_.
*/
2015-10-18 11:48:14 +01:00
static Int tab(USES_REGS1) { /* nl(Stream) */
2015-11-05 15:39:04 +00:00
int sno;
2015-06-18 00:59:10 +01:00
Term t2;
Int tabs, i;
2015-08-07 22:57:53 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
2015-06-18 00:59:10 +01:00
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "put_char/1");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((tabs = IntegerOfTerm(t2)) < 0) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1");
return FALSE;
}
2015-10-18 11:48:14 +01:00
sno = Yap_CheckTextStream(ARG1, Output_Stream_f, "nl/1");
2015-06-18 00:59:10 +01:00
if (sno < 0)
return (FALSE);
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_TEXT_STREAM, ARG1, "nl/0");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
for (i = 0; i < tabs; i++)
GLOBAL_Stream[sno].stream_wputc(sno, ' ');
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred nl(+ _S_) is iso
Outputs a new line to stream _S_.
*/
2015-10-18 11:48:14 +01:00
static Int nl_1(USES_REGS1) { /* nl */
2015-06-18 00:59:10 +01:00
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");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
GLOBAL_Stream[sno].stream_wputc(sno, 10);
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred nl is iso
Outputs a new line to the current output stream.
*/
2015-10-18 11:48:14 +01:00
static Int nl(USES_REGS1) { /* nl(Stream) */
int sno = Yap_CheckTextStream(ARG1, Output_Stream_f, "nl/1");
2015-06-18 00:59:10 +01:00
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");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
GLOBAL_Stream[sno].stream_wputc(sno, 10);
2015-06-18 00:59:10 +01:00
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred put_byte(+ _S_,+ _N_) is iso
As `put_byte(N)`, but to binary stream _S_.
*/
2015-10-18 11:48:14 +01:00
static Int put_byte(USES_REGS1) { /* '$put_byte'(Stream,N) */
2015-06-18 00:59:10 +01:00
Term t2;
Int ch;
2015-08-07 22:57:53 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/2");
2015-06-18 00:59:10 +01:00
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_BYTE, t2, "put_code/2");
2015-06-18 00:59:10 +01:00
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((ch = IntegerOfTerm(t2)) < -1) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "put_code/1");
return FALSE;
}
2015-10-18 11:48:14 +01:00
int sno = Yap_CheckStream(ARG1, Output_Stream_f, "put/2");
2015-06-18 00:59:10 +01:00
if (sno < 0)
return (FALSE);
2015-10-18 11:48:14 +01:00
if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)
// && strictISOFlag()
) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, NULL);
return false;
2015-06-18 00:59:10 +01:00
}
GLOBAL_Stream[sno].stream_putc(sno, ch);
/*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
2015-07-28 04:22:44 +01:00
* yap_fflush(GLOBAL_Stream[sno].file);
2015-06-18 00:59:10 +01:00
*/
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred put_byte(+ _N_) is iso
Outputs to the current output stream the character whose code is
_N_. The current output stream must be a binary stream.
*/
2015-10-18 11:48:14 +01:00
static Int put_byte_1(USES_REGS1) { /* '$put_byte'(Stream,N) */
2015-06-18 00:59:10 +01:00
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;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
Yap_Error(TYPE_ERROR_BYTE, t2, "put_code/1");
2015-06-18 00:59:10 +01:00
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((ch = IntegerOfTerm(t2)) < -1) {
2015-06-18 00:59:10 +01:00
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()
) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "get0/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
GLOBAL_Stream[sno].stream_putc(sno, ch);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred skip(+ _N_)
Skips input characters until the next occurrence of the character with
ASCII code _N_. The argument to this predicate can take the same forms
as those for `put` (see 6.11).
*/
2015-11-11 08:45:03 +00:00
static Int skip_1(USES_REGS1) { /* 'skip'(N) */
2015-06-18 00:59:10 +01:00
Int n;
Term t2;
int sno;
int ch;
2015-07-28 04:22:44 +01:00
2015-08-07 22:57:53 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
2015-06-18 00:59:10 +01:00
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "skip/2");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((n = IntegerOfTerm(t2)) < 0) {
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "skip/2");
return FALSE;
}
2015-10-18 11:48:14 +01:00
sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "skip/2");
2015-06-18 00:59:10 +01:00
if (sno < 0)
return (FALSE);
while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != n && ch != -1)
;
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-12-15 09:18:36 +00:00
/** @pred skip(+ _S_,- _C_)
Like skip/1, but using stream _S_ instead of the current
input stream.
*/
2015-10-18 11:48:14 +01:00
static Int skip(USES_REGS1) { /* '$skip'(Stream,N) */
2015-06-18 00:59:10 +01:00
Int n;
Term t2;
2015-11-11 08:45:03 +00:00
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "skip/2");
2015-06-18 00:59:10 +01:00
int ch;
2015-07-28 04:22:44 +01:00
2015-11-11 08:45:03 +00:00
if (sno < 0)
return (FALSE);
2015-06-18 00:59:10 +01:00
if (IsVarTerm(t2 = Deref(ARG2))) {
2015-12-15 09:18:36 +00:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-06-18 00:59:10 +01:00
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if (!IsIntegerTerm(t2)) {
2015-12-15 09:18:36 +00:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-06-18 00:59:10 +01:00
Yap_Error(TYPE_ERROR_INTEGER, t2, "skip/2");
return FALSE;
2015-10-18 11:48:14 +01:00
} else if ((n = IntegerOfTerm(t2)) < 0) {
2015-12-15 09:18:36 +00:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-06-18 00:59:10 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "skip/2");
return FALSE;
}
while ((ch = GLOBAL_Stream[sno].stream_wgetc(sno)) != n && ch != -1)
;
UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE);
}
2015-07-28 04:22:44 +01:00
/**
2015-06-18 00:59:10 +01:00
* @pred flush_output(+Stream)
*
* Flush the stream _Stream_, that is, make sure all pending output is committed
* before any further execution.
2015-07-28 04:22:44 +01:00
*
* @param +_Stream_
*
2015-06-18 00:59:10 +01:00
*/
2015-10-18 11:48:14 +01:00
static Int flush_output(USES_REGS1) { /* flush_output(Stream) */
int sno = Yap_CheckStream(ARG1, Output_Stream_f, "flush_output/1");
2015-12-15 09:18:36 +00:00
if (sno < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-06-18 00:59:10 +01:00
return (FALSE);
2015-12-15 09:18:36 +00:00
}
2015-10-18 11:48:14 +01:00
yap_fflush(sno);
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (TRUE);
2015-06-18 00:59:10 +01:00
}
2015-07-28 04:22:44 +01:00
/**
2015-06-18 00:59:10 +01:00
* @pred flush_output
*
2015-10-18 11:48:14 +01:00
* Flush the current output stream, that is, make sure all pending output is
*committed
2015-06-18 00:59:10 +01:00
* before any further execution. By default this is user_output, but it may be
* changed by current_output/1.
2015-07-28 04:22:44 +01:00
*
2015-06-18 00:59:10 +01:00
*/
2015-10-18 11:48:14 +01:00
static Int flush_output0(USES_REGS1) { /* flush_output */
yap_fflush(LOCAL_c_output_stream);
2015-06-18 00:59:10 +01:00
return (TRUE);
}
2015-10-18 11:48:14 +01:00
static Int flush_all_streams(USES_REGS1) { /* $flush_all_streams */
2015-06-18 00:59:10 +01:00
#if BROKEN_FFLUSH_NULL
int i;
for (i = 0; i < MaxStreams; ++i) {
LOCK(GLOBAL_Stream[i].streamlock);
2015-10-18 11:48:14 +01:00
yap_fflush(i);
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[i].streamlock);
}
#else
2015-10-18 11:48:14 +01:00
fflush(NULL);
2015-06-18 00:59:10 +01:00
#endif
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
return TRUE;
}
/** @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
2015-07-28 04:22:44 +01:00
leaving the current stream position unaltered.
2015-06-18 00:59:10 +01:00
*/
2015-10-18 11:48:14 +01:00
static Int peek_code(USES_REGS1) { /* at_end_of_stream */
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-10-18 11:48:14 +01:00
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
2015-06-18 00:59:10 +01:00
Int ch;
if (sno < 0)
return FALSE;
if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2");
2015-06-18 00:59:10 +01:00
return FALSE;
}
2015-10-18 11:48:14 +01:00
if ((ch = Yap_peek(sno)) < 0) {
#ifdef PEEK_EOF
2015-06-19 10:10:02 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return false;
#endif
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkIntTerm(ch)));
2015-06-18 00:59:10 +01:00
}
/** @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
2015-07-28 04:22:44 +01:00
leaving the current stream position unaltered.
2015-06-18 00:59:10 +01:00
*/
2015-10-18 11:48:14 +01:00
static Int peek_code_1(USES_REGS1) { /* at_end_of_stream */
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-06-18 00:59:10 +01:00
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);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_code/2");
2015-06-18 00:59:10 +01:00
return FALSE;
}
2015-10-18 11:48:14 +01:00
if ((ch = Yap_peek(sno)) < 0) {
#ifdef PEEK_EOF
2015-06-19 10:10:02 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-08 10:17:57 +01:00
return false;
2015-10-18 11:48:14 +01:00
#endif
2015-10-08 10:17:57 +01:00
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG1, MkIntTerm(ch)));
2015-06-18 00:59:10 +01:00
}
/** @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.
*/
2015-10-18 11:48:14 +01:00
static Int peek_byte(USES_REGS1) { /* at_end_of_stream */
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-10-18 11:48:14 +01:00
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "peek_byte/2");
Int ch;
2015-06-18 00:59:10 +01:00
if (sno < 0)
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_byte/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
if ((ch = dopeek_byte(sno)) < 0) {
#ifdef PEEK_EOF
2015-06-19 10:10:02 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
return false;
2015-10-18 11:48:14 +01:00
#endif
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkIntTerm(ch)));
2015-06-18 00:59:10 +01:00
}
/** @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.
*/
2015-10-18 11:48:14 +01:00
static Int peek_byte_1(USES_REGS1) { /* at_end_of_stream */
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-06-18 00:59:10 +01:00
int sno = LOCAL_c_input_stream;
Int ch;
if (sno < 0)
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
if (!(GLOBAL_Stream[sno].status & Binary_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
2016-01-03 02:06:09 +00:00
Yap_Error(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_byte/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
if ((ch = dopeek_byte(sno)) < 0) {
#ifdef PEEK_EOF
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
return false;
2015-10-18 11:48:14 +01:00
#endif
2015-06-18 00:59:10 +01:00
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return (Yap_unify_constant(ARG2, MkIntTerm(ch)));
2015-06-18 00:59:10 +01:00
}
/** @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.
*/
2015-10-18 11:48:14 +01:00
static Int peek_char(USES_REGS1) {
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-10-18 11:48:14 +01:00
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
2015-06-18 00:59:10 +01:00
wchar_t wsinp[2];
Int ch;
if (sno < 0)
2015-10-18 11:48:14 +01:00
return false;
2015-06-18 00:59:10 +01:00
if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2");
2015-10-18 11:48:14 +01:00
return (FALSE);
2015-06-18 00:59:10 +01:00
}
2015-10-18 11:48:14 +01:00
if ((ch = Yap_peek(sno)) < 0) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
2015-06-18 00:59:10 +01:00
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
wsinp[1] = '\0';
wsinp[0] = ch;
2015-10-18 11:48:14 +01:00
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
2015-06-18 00:59:10 +01:00
}
/** @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.
*/
2015-10-18 11:48:14 +01:00
static Int peek_char_1(USES_REGS1) {
2015-07-28 04:22:44 +01:00
/* the next character is a EOF */
2015-10-18 11:48:14 +01:00
int sno = LOCAL_c_input_stream;
2015-06-18 00:59:10 +01:00
wchar_t wsinp[2];
Int ch;
2015-07-28 04:22:44 +01:00
2015-06-18 00:59:10 +01:00
LOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
if ((ch = Yap_peek(sno)) < 0) {
2015-06-18 00:59:10 +01:00
UNLOCK(GLOBAL_Stream[sno].streamlock);
2015-10-18 11:48:14 +01:00
return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
// return false;
2015-06-18 00:59:10 +01:00
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
wsinp[1] = '\0';
wsinp[0] = ch;
2015-10-18 11:48:14 +01:00
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
2015-06-18 00:59:10 +01:00
}
/** @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
2015-07-28 04:22:44 +01:00
leaving the current stream position unaltered.
2015-06-18 00:59:10 +01:00
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
2015-07-28 04:22:44 +01:00
leaving the current stream position unaltered.
2015-06-18 00:59:10 +01:00
*/
2015-10-18 11:48:14 +01:00
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);
Yap_InitCPred("get_byte", 1, get_byte_1, SafePredFlag | SyncPredFlag);
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);
2015-06-18 00:59:10 +01:00
}