1054 lines
29 KiB
C
1054 lines
29 KiB
C
/*************************************************************************
|
|
* *
|
|
* 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 <stdlib.h>
|
|
#if HAVE_UNISTD_H
|
|
#include <unistd.h>
|
|
#endif
|
|
#if HAVE_STDARG_H
|
|
#include <stdarg.h>
|
|
#endif
|
|
#ifdef _WIN32
|
|
#if HAVE_IO_H
|
|
/* Windows */
|
|
#include <io.h>
|
|
#endif
|
|
#if HAVE_SOCKET
|
|
#include <winsock2.h>
|
|
#endif
|
|
#include <windows.h>
|
|
#ifndef S_ISDIR
|
|
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
|
|
#endif
|
|
#endif
|
|
#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);
|
|
PlIOError(PERMISSION_ERROR_INPUT_BINARY_STREAM, ARG1, "peek_code/2");
|
|
return FALSE;
|
|
}
|
|
if ((ch = dopeek( sno )) < 0)
|
|
return false;
|
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
|
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;
|
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
|
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;
|
|
UNLOCK(GLOBAL_Stream[sno].streamlock);
|
|
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);
|
|
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);
|
|
|
|
|
|
}
|