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

warnings and stream read wchar simplification

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-08-01 19:17:56 -05:00
parent a82a72fc14
commit 304489c74f
6 changed files with 394 additions and 328 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
os/format.c
View File

@ -982,8 +982,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
goto do_format_control_sequence_error; goto do_format_control_sequence_error;
t = targs[targ++]; t = targs[targ++];
yhandle_t slf = Yap_StartSlots(); yhandle_t slf = Yap_StartSlots();
Yap_plwrite(t, GLOBAL_Stream + sno, 0, Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f,
Handle_vars_f | To_heap_f,
GLOBAL_MaxPriority); GLOBAL_MaxPriority);
Yap_CloseSlots(slf); Yap_CloseSlots(slf);
break; break;
@ -993,7 +992,7 @@ static Int doformat(volatile Term otail, volatile Term oargs,
targ -= 2; targ -= 2;
{ {
yhandle_t slf = Yap_StartSlots(); yhandle_t slf = Yap_StartSlots();
if (!Yap_WriteTerm( sno, targs[1], targs[0] PASS_REGS)) { if (!Yap_WriteTerm(sno, targs[1], targs[0] PASS_REGS)) {
Yap_CloseSlots(slf); Yap_CloseSlots(slf);
goto do_default_error; goto do_default_error;
}; };
@ -1200,7 +1199,7 @@ static Int with_output_to(USES_REGS1) {
Term tin = Deref(ARG1); Term tin = Deref(ARG1);
Functor f; Functor f;
bool out; bool out;
bool mem_stream = false; bool my_mem_stream;
yhandle_t hdl = Yap_PushHandle(tin); yhandle_t hdl = Yap_PushHandle(tin);
if (IsVarTerm(tin)) { if (IsVarTerm(tin)) {
Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3"); Yap_Error(INSTANTIATION_ERROR, tin, "with_output_to/3");
@ -1215,6 +1214,7 @@ static Int with_output_to(USES_REGS1) {
/* needs to change LOCAL_c_output_stream for write */ /* needs to change LOCAL_c_output_stream for write */
output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3"); output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3");
my_mem_stream = false; my_mem_stream = false;
f = NIL;
} }
if (output_stream == -1) { if (output_stream == -1) {
return false; return false;
@ -1223,7 +1223,7 @@ static Int with_output_to(USES_REGS1) {
out = Yap_Execute(Deref(ARG2) PASS_REGS); out = Yap_Execute(Deref(ARG2) PASS_REGS);
LOCK(GLOBAL_Stream[output_stream].streamlock); LOCK(GLOBAL_Stream[output_stream].streamlock);
LOCAL_c_output_stream = old_out; LOCAL_c_output_stream = old_out;
if (mem_stream) { if (my_mem_stream) {
Term tat; Term tat;
Term inp = Yap_GetFromHandle(hdl); Term inp = Yap_GetFromHandle(hdl);
if (out) { if (out) {

100
os/getw.h
View File

@ -2,9 +2,9 @@
/// compose a wide char from a sequence of getchars /// compose a wide char from a sequence of getchars
/// this is a slow lane routine, called if no specialised code /// this is a slow lane routine, called if no specialised code
/// isavailable. /// isavailable.
static int GETW(int sno) { extern int get_wchar(int sno) {
StreamDesc *st = GLOBAL_Stream + sno; StreamDesc *st = GLOBAL_Stream + sno;
int ch = GETC(); int ch = st->stream_getc(sno);
if (ch == -1) if (ch == -1)
return post_process_weof(st); return post_process_weof(st);
@ -31,7 +31,7 @@ static int GETW(int sno) {
buf[0] = ch; buf[0] = ch;
int n = 1; int n = 1;
while ((out = mbrtowc(&wch, buf, 1, &(mbstate))) != 1) { while ((out = mbrtowc(&wch, buf, 1, &(mbstate))) != 1) {
int ch = buf[0] = GETC(); int ch = buf[0] = st->stream_getc(sno);
n++; n++;
if (ch == -1) if (ch == -1)
return post_process_weof(st); return post_process_weof(st);
@ -49,7 +49,7 @@ static int GETW(int sno) {
// if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8; // if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8;
if (ch < 0xe0) { // 2-byte sequence if (ch < 0xe0) { // 2-byte sequence
// Must have valid continuation character // Must have valid continuation character
int c1 = buf[0] = GETC(); int c1 = buf[0] = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
// if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8; // if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8;
@ -62,22 +62,22 @@ static int GETW(int sno) {
// Check for surrogate chars // Check for surrogate chars
// if (ch == 0xed && *str > 0x9f) // if (ch == 0xed && *str > 0x9f)
// return UTF8PROC_ERROR_INVALIDUTF8; // return UTF8PROC_ERROR_INVALIDUTF8;
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
int c2 = GETC(); int c2 = st->stream_getc(sno);
if (c2 == -1) if (c2 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f); wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f);
return post_process_read_wchar(wch, 3, st); return post_process_read_wchar(wch, 3, st);
} else { } else {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
int c2 = GETC(); int c2 = st->stream_getc(sno);
if (c2 == -1) if (c2 == -1)
return post_process_weof(st); return post_process_weof(st);
int c3 = GETC(); int c3 = st->stream_getc(sno);
if (c3 == -1) if (c3 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = ((ch & 7) << 18) | ((c1 & 0x3f) << 12) | ((c2 & 0x3f) << 6) | wch = ((ch & 7) << 18) | ((c1 & 0x3f) << 12) | ((c2 & 0x3f) << 6) |
@ -89,15 +89,15 @@ static int GETW(int sno) {
// little-endian: start with big shot // little-endian: start with big shot
{ {
int wch; int wch;
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (c1 << 8) + ch; wch = (c1 << 8) + ch;
if (wch >= 0xd800 && wch < 0xdc00) { if (wch >= 0xd800 && wch < 0xdc00) {
int c2 = GETC(); int c2 = st->stream_getc(sno);
if (c2 == -1) if (c2 == -1)
return post_process_weof(st); return post_process_weof(st);
int c3 = GETC(); int c3 = st->stream_getc(sno);
if (c3 == -1) if (c3 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET; wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET;
@ -110,15 +110,15 @@ static int GETW(int sno) {
// little-endian: start with big shot // little-endian: start with big shot
{ {
int wch; int wch;
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (c1) + (ch << 8); wch = (c1) + (ch << 8);
if (wch >= 0xd800 && wch < 0xdc00) { if (wch >= 0xd800 && wch < 0xdc00) {
int c3 = GETC(); int c3 = st->stream_getc(sno);
if (c3 == -1) if (c3 == -1)
return post_process_weof(st); return post_process_weof(st);
int c2 = GETC(); int c2 = st->stream_getc(sno);
if (c2 == -1) if (c2 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (((c3 << 8) + c2) << 10) + wch + SURROGATE_OFFSET; wch = (((c3 << 8) + c2) << 10) + wch + SURROGATE_OFFSET;
@ -131,7 +131,7 @@ static int GETW(int sno) {
// little-endian: start with big shot // little-endian: start with big shot
{ {
int wch; int wch;
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (c1) + (ch << 8); wch = (c1) + (ch << 8);
@ -142,7 +142,7 @@ static int GETW(int sno) {
// little-endian: start with big shot // little-endian: start with big shot
{ {
int wch; int wch;
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (c1 << 8) + ch; wch = (c1 << 8) + ch;
@ -155,19 +155,19 @@ static int GETW(int sno) {
{ {
int wch = ch; int wch = ch;
{ {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = wch + c1; wch = wch + c1;
} }
{ {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (wch << 8) + c1; wch = (wch << 8) + c1;
} }
{ {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch = (wch << 8) + c1; wch = (wch << 8) + c1;
@ -179,19 +179,19 @@ static int GETW(int sno) {
{ {
int wch = ch; int wch = ch;
{ {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch += c1 << 8; wch += c1 << 8;
} }
{ {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch += c1 << 16; wch += c1 << 16;
} }
{ {
int c1 = GETC(); int c1 = st->stream_getc(sno);
if (c1 == -1) if (c1 == -1)
return post_process_weof(st); return post_process_weof(st);
wch += c1 << 24; wch += c1 << 24;
@ -204,3 +204,57 @@ static int GETW(int sno) {
return -1; return -1;
} }
} }
extern int get_wchar_UTF8(int sno) {
StreamDesc *st = GLOBAL_Stream + sno;
int ch = st->stream_getc(sno);
if (ch == -1)
return post_process_weof(st);
else {
int wch;
unsigned char buf[8];
if (ch < 0x80) {
return post_process_read_wchar(ch, 1, st);
}
// if ((ch - 0xc2) > (0xf4-0xc2)) return UTF8PROC_ERROR_INVALIDUTF8;
if (ch < 0xe0) { // 2-byte sequence
// Must have valid continuation character
int c1 = buf[0] = st->stream_getc(sno);
if (c1 == -1)
return post_process_weof(st);
// if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8;
wch = ((ch & 0x1f) << 6) | (c1 & 0x3f);
return post_process_read_wchar(wch, 2, st);
}
if (ch < 0xf0) { // 3-byte sequence
// if ((str + 1 >= end) || !utf_cont(*str) || !utf_cont(str[1]))
// return UTF8PROC_ERROR_INVALIDUTF8;
// Check for surrogate chars
// if (ch == 0xed && *str > 0x9f)
// return UTF8PROC_ERROR_INVALIDUTF8;
int c1 = st->stream_getc(sno);
if (c1 == -1)
return post_process_weof(st);
int c2 = st->stream_getc(sno);
if (c2 == -1)
return post_process_weof(st);
wch = ((ch & 0xf) << 12) | ((c1 & 0x3f) << 6) | (c2 & 0x3f);
return post_process_read_wchar(wch, 3, st);
} else {
int c1 = st->stream_getc(sno);
if (c1 == -1)
return post_process_weof(st);
int c2 = st->stream_getc(sno);
if (c2 == -1)
return post_process_weof(st);
int c3 = st->stream_getc(sno);
if (c3 == -1)
return post_process_weof(st);
wch = ((ch & 7) << 18) | ((c1 & 0x3f) << 12) | ((c2 & 0x3f) << 6) |
(c3 & 0x3f);
return post_process_read_wchar(wch, 4, st);
}
}
}

20
os/iopreds.c
View File

@ -97,16 +97,9 @@ static char SccsId[] = "%W% %G%";
#define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR) #define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR)
#endif #endif
#endif #endif
#include "iopreds.h"
//#define GETW get_wchar_from_FILE
//#endif
#define GETC() fgetwc(st->file)
#include "getw.h"
#undef GETW #include "iopreds.h"
#undef GETC
#define GETW get_wchar
#define GETC() st->stream_getc(sno)
#include "getw.h" #include "getw.h"
static int get_wchar_from_file(int); static int get_wchar_from_file(int);
@ -254,7 +247,7 @@ static void unix_upd_stream_info(StreamDesc *s) {
void Yap_DefaultStreamOps(StreamDesc *st) { void Yap_DefaultStreamOps(StreamDesc *st) {
CACHE_REGS CACHE_REGS
st->stream_wputc = put_wchar; st->stream_wputc = put_wchar;
st->stream_wgetc = get_wchar; st->stream_wgetc = get_wchar_UTF8;
st->stream_putc = FilePutc; st->stream_putc = FilePutc;
st->stream_getc = PlGetc; st->stream_getc = PlGetc;
if (st->status & (Promptable_Stream_f)) { if (st->status & (Promptable_Stream_f)) {
@ -664,10 +657,9 @@ int PlGetc(int sno) {
} }
// layered version // layered version
static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); } static inline int get_wchar_from_file(int sno) {
return post_process_read_wchar(fgetwc(GLOBAL_Stream[sno].file), 1,
static int get_wchar_from_file(int sno) { GLOBAL_Stream + sno);
return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno);
} }
#ifndef MB_LEN_MAX #ifndef MB_LEN_MAX

329
os/readterm.c
View File

@ -1,28 +1,28 @@
/************************************************************************* /*************************************************************************
* * * *
* YAP Prolog * * YAP Prolog *
* * * *
* Yap Prolog was developed at NCCUP - Universidade do Porto * * Yap Prolog was developed at NCCUP - Universidade do Porto *
* * * *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* * * *
************************************************************************** **************************************************************************
* * * *
* File: iopreds.c * * File: iopreds.c *
* Last rev: 5/2/88 * * Last rev: 5/2/88 *
* mods: * * mods: *
* comments: Input/Output C implemented predicates * * comments: Input/Output C implemented predicates *
* * * *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
#endif #endif
/* /*
* This file includes the definition of a miscellania of standard predicates * This file includes the definition of a miscellania of standard predicates
* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output,
* *
*/ */
#include "Yap.h" #include "Yap.h"
#include "YapFlags.h" #include "YapFlags.h"
@ -110,11 +110,11 @@ static void clean_vars(VarEntry *p) {
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
/** '$qq_open'(+QQRange, -Stream) is det. /** '$qq_open'(+QQRange, -Stream) is det.
Opens a quasi-quoted memory range. Opens a quasi-quoted memory range.
@arg QQRange is a term '$quasi_quotation'(ReadData, Start, Length) @arg QQRange is a term '$quasi_quotation'(ReadData, Start, Length)
@arg Stream is a UTF-8 encoded string, whose position indication @arg Stream is a UTF-8 encoded string, whose position indication
reflects the location in the real file. reflects the location in the real file.
*/ */
static Int qq_open(USES_REGS1) { static Int qq_open(USES_REGS1) {
@ -207,14 +207,14 @@ static const param_t read_defs[] = {READ_DEFS()};
#undef PAR #undef PAR
/** /**
* Syntax Error Handler * Syntax Error Handler
* *
* @par tokptr: the sequence of tokens * @par tokptr: the sequence of tokens
* @par sno: the stream numbet * @par sno: the stream numbet
* *
* Implicit arguments: * Implicit arguments:
* + * +
*/ */
static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
CACHE_REGS CACHE_REGS
Term info; Term info;
@ -264,58 +264,76 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
t0[0] = TermNil; t0[0] = TermNil;
} }
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break; }
case QuasiQuotes_tok: { break;
case QuasiQuotes_tok:
{
Term t0[2]; Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>")); t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break; }
case WQuasiQuotes_tok: { break;
case WQuasiQuotes_tok:
{
Term t0[2]; Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>")); t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break; }
break;
case Number_tok: case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo)); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
break; break;
case Var_tok: { case Var_tok:
{
Term t[2]; Term t[2];
VarEntry *varinfo = (VarEntry *)info; VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0); t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS); t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
} break; }
case String_tok: { break;
case String_tok:
{
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) { if (!t0) {
return 0; return 0;
} }
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; }
case WString_tok: { break;
case WString_tok:
{
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS); Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
if (!t0) if (!t0)
return 0; return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; }
case BQString_tok: { break;
case BQString_tok:
{
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; }
case WBQString_tok: { break;
case WBQString_tok:
{
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS); Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; }
case Error_tok: { break;
case Error_tok:
{
ts[0] = MkAtomTerm(AtomError); ts[0] = MkAtomTerm(AtomError);
} break; }
break;
case eot_tok: case eot_tok:
endline = MkIntegerTerm(tok->TokPos); endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT")); ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
break; break;
case Ponctuation_tok: { case Ponctuation_tok:
{
char s[2]; char s[2];
s[1] = '\0'; s[1] = '\0';
if ((info) == 'l') { if ((info) == 'l') {
@ -326,9 +344,13 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
ts[0] = MkAtomTerm(Yap_LookupAtom(s)); ts[0] = MkAtomTerm(Yap_LookupAtom(s));
} }
} }
if (tok->TokNext) {
tok = tok->TokNext; tok = tok->TokNext;
if (!tok) } else {
endline = MkIntegerTerm(tok->TokPos);
tok = NULL;
break; break;
}
*tailp = MkPairTerm(ts[0], TermNil); *tailp = MkPairTerm(ts[0], TermNil);
tailp = RepPair(*tailp) + 1; tailp = RepPair(*tailp) + 1;
} }
@ -939,7 +961,8 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
case YAP_PARSING_ERROR: case YAP_PARSING_ERROR:
state = parseError(&re, &fe, inp_stream); state = parseError(&re, &fe, inp_stream);
break; break;
case YAP_PARSING_FINISHED: { case YAP_PARSING_FINISHED:
{
CACHE_REGS CACHE_REGS
bool done; bool done;
if (fe.reading_clause) if (fe.reading_clause)
@ -965,7 +988,7 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) {
} }
static Int static Int
read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */ read_term2(USES_REGS1) { /* '$read'(+Flag,?Term,?Module,?Vars,-Pos,-Err) */
Term rc; Term rc;
yhandle_t h = Yap_PushHandle(ARG1); yhandle_t h = Yap_PushHandle(ARG1);
if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0) if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0)
@ -1077,11 +1100,11 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
} }
/** /**
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det
* *
u* Same as read_clause/3, but from the standard input stream. u* Same as read_clause/3, but from the standard input stream.
* *
*/ */
static Int read_clause2(USES_REGS1) { static Int read_clause2(USES_REGS1) {
Term rc; Term rc;
yhandle_t h = Yap_InitSlot(ARG1); yhandle_t h = Yap_InitSlot(ARG1);
@ -1092,26 +1115,26 @@ static Int read_clause2(USES_REGS1) {
} }
/** /**
* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det
* *
* This predicate receives a set of options _OPts_ based on read_term/3, but * This predicate receives a set of options _OPts_ based on read_term/3, but
*specific *specific
* to readin clauses. The following options are considered: * to readin clauses. The following options are considered:
* *
* + The `comments` option unifies its argument with the comments in the term, * + The `comments` option unifies its argument with the comments in the term,
* represented as strings * represented as strings
* + The `process_comments` option calls a hook, it is current ignored by YAP. * + The `process_comments` option calls a hook, it is current ignored by YAP.
* + The `term_position` unifies its argument with a term describing the * + The `term_position` unifies its argument with a term describing the
* position of the term. * position of the term.
* + The `syntax_errors` flag controls response to syntactic errors, the * + The `syntax_errors` flag controls response to syntactic errors, the
*default is `dec10`. *default is `dec10`.
* *
* The next two options are called implicitly: * The next two options are called implicitly:
* *
* + The `module` option is initialized to the current source module, by * + The `module` option is initialized to the current source module, by
*default. *default.
* + The `singletons` option is set from the single var flag * + The `singletons` option is set from the single var flag
*/ */
static Int read_clause( static Int read_clause(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream; int inp_stream;
@ -1141,34 +1164,34 @@ static Int read_clause(
} }
/** /**
* @pred source_location( - _File_ , _Line_ ) * @pred source_location( - _File_ , _Line_ )
* *
* unify _File_ and _Line_ wuth the position of the last term read, if the term * unify _File_ and _Line_ wuth the position of the last term read, if the term
* comes from a stream created by opening a file-system path with open/3 and * comes from a stream created by opening a file-system path with open/3 and
*friends.>position *friends.>position
* It ignores user_input or * It ignores user_input or
* sockets. * sockets.
* *
* @param - _File_ * @param - _File_
* @param - _Line_ * @param - _Line_
* *
* @note SWI-Prolog built-in. * @note SWI-Prolog built-in.
*/ */
static Int source_location(USES_REGS1) { static Int source_location(USES_REGS1) {
return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) && return Yap_unify(ARG1, MkAtomTerm(LOCAL_SourceFileName)) &&
Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno)); Yap_unify(ARG2, MkIntegerTerm(LOCAL_SourceFileLineno));
} }
/** /**
* @pred read(+ _Stream_, - _Term_ ) is iso * @pred read(+ _Stream_, - _Term_ ) is iso
* *
* Reads term _T_ from the stream _S_ instead of from the current input * Reads term _T_ from the stream _S_ instead of from the current input
* stream. * stream.
* *
* @param - _Stream_ * @param - _Stream_
* @param - _Term_ * @param - _Term_
* *
*/ */
static Int read2( static Int read2(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
int inp_stream; int inp_stream;
@ -1186,12 +1209,12 @@ static Int read2(
/** @pred read(- _T_) is iso /** @pred read(- _T_) is iso
Reads the next term from the current input stream, and unifies it with Reads the next term from the current input stream, and unifies it with
_T_. The term must be followed by a dot (`.`) and any blank-character _T_. The term must be followed by a dot (`.`) and any blank-character
as previously defined. The syntax of the term must match the current as previously defined. The syntax of the term must match the current
declarations for operators (see op). If the end-of-stream is reached, declarations for operators (see op). If the end-of-stream is reached,
_T_ is unified with the atom `end_of_file`. Further reads from of _T_ is unified with the atom `end_of_file`. Further reads from of
the same stream may cause an error failure (see open/3). the same stream may cause an error failure (see open/3).
*/ */
static Int read1( static Int read1(
@ -1202,8 +1225,8 @@ static Int read1(
/** @pred fileerrors /** @pred fileerrors
Switches on the file_errors flag so that in certain error conditions Switches on the file_errors flag so that in certain error conditions
Input/Output predicates will produce an appropriated message and abort. Input/Output predicates will produce an appropriated message and abort.
*/ */
static Int fileerrors(USES_REGS1) { static Int fileerrors(USES_REGS1) {
@ -1211,12 +1234,12 @@ static Int fileerrors(USES_REGS1) {
} }
/** /**
@pred nofileerrors @pred nofileerrors
Switches off the `file_errors` flag, so that the predicates see/1, Switches off the `file_errors` flag, so that the predicates see/1,
tell/1, open/3 and close/1 just fail, instead of producing tell/1, open/3 and close/1 just fail, instead of producing
an error message and aborting whenever the specified file cannot be an error message and aborting whenever the specified file cannot be
opened or closed. opened or closed.
*/ */
static Int nofileerrors( static Int nofileerrors(
@ -1294,21 +1317,20 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
return rval; return rval;
} }
/** /**
* @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_ * @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_
* *
* read a term _T_ stored in constant _Atom_ according to _Options_ * read a term _T_ stored in constant _Atom_ according to _Options_
* *
* @param _Atom_ the source _Atom_ * @param _Atom_ the source _Atom_
* @param _T_ the output term _T_, may be any term * @param _T_ the output term _T_, may be any term
* @param _Options_ read_term/3 options. * @param _Options_ read_term/3 options.
* *
* @notes Originally from SWI-Prolog, in YAP only works with internalised atoms * @notes Originally from SWI-Prolog, in YAP only works with internalised atoms
* Check read_term_from_atomic/3 for the general version. Also, the built-in is * Check read_term_from_atomic/3 for the general version. Also, the built-in is
*supposed to *supposed to
* use YAP's internal encoding, so please avoid the encoding/1 option. * use YAP's internal encoding, so please avoid the encoding/1 option.
*/ */
static Int read_term_from_atom(USES_REGS1) { static Int read_term_from_atom(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1), rc;
Atom at; Atom at;
@ -1347,17 +1369,17 @@ Term Yap_AtomToTerm(Atom a, Term opts) {
} }
/** /**
* @pred read_term_from_string( +_String_ , - _T_ , + _Options_ * @pred read_term_from_string( +_String_ , - _T_ , + _Options_
* *
* read a term _T_ stored in constant _String_ according to _Options_ * read a term _T_ stored in constant _String_ according to _Options_
* *
* @param _String_ the source _String_ * @param _String_ the source _String_
* @param _T_ the output term _T_, may be any term * @param _T_ the output term _T_, may be any term
* @param _Options_ read_term/3 options. * @param _Options_ read_term/3 options.
* *
* @notes Idea from SWI-Prolog, in YAP only works with strings * @notes Idea from SWI-Prolog, in YAP only works with strings
* Check read_term_from_atomic/3 for the general version. * Check read_term_from_atomic/3 for the general version.
*/ */
static Int read_term_from_string(USES_REGS1) { static Int read_term_from_string(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1), rc;
const unsigned char *s; const unsigned char *s;
@ -1397,8 +1419,7 @@ static Int string_to_term(USES_REGS1) {
len = strlen_utf8((const unsigned char *)s); len = strlen_utf8((const unsigned char *)s);
} }
encoding_t enc = ENC_ISO_UTF8; encoding_t enc = ENC_ISO_UTF8;
rc = Yap_StringToTerm(s, len, &enc, rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3);
1200, &ARG3);
if (!rc) if (!rc)
return false; return false;
return Yap_unify(rc, ARG2); return Yap_unify(rc, ARG2);
@ -1420,8 +1441,7 @@ static Int atomic_to_term(USES_REGS1) {
len = strlen_utf8((unsigned char *)s); len = strlen_utf8((unsigned char *)s);
} }
encoding_t enc = ENC_ISO_UTF8; encoding_t enc = ENC_ISO_UTF8;
rc = Yap_StringToTerm(s, len, &enc, rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3);
1200, &ARG3);
if (!rc) if (!rc)
return false; return false;
return Yap_unify(rc, ARG2); return Yap_unify(rc, ARG2);
@ -1443,27 +1463,26 @@ static Int atom_to_term(USES_REGS1) {
len = strlen_utf8((const unsigned char *)s); len = strlen_utf8((const unsigned char *)s);
} }
encoding_t enc = ENC_ISO_UTF8; encoding_t enc = ENC_ISO_UTF8;
rc = Yap_StringToTerm(s, len, &enc, rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3);
1200, &ARG3);
if (!rc) if (!rc)
return false; return false;
return Yap_unify(rc, ARG2); return Yap_unify(rc, ARG2);
} }
/** /**
* @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _Options_ ) * @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _Options_ )
* *
* read a term _T_ stored in text _Atomic_ according to _Options_ * read a term _T_ stored in text _Atomic_ according to _Options_
* *
* @param _Atomic_ the source may be an atom, string, list of codes, or list of * @param _Atomic_ the source may be an atom, string, list of codes, or list of
*chars. *chars.
* @param _T_ the output term _T_, may be any term * @param _T_ the output term _T_, may be any term
* @param _Options_ read_term/3 options. * @param _Options_ read_term/3 options.
* *
* @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and * @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and
*atom. *atom.
* Encoding is fixed in atoms and strings. * Encoding is fixed in atoms and strings.
*/ */
static Int read_term_from_atomic(USES_REGS1) { static Int read_term_from_atomic(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1), rc;
const unsigned char *s; const unsigned char *s;

7
os/streams.c
View File

@ -248,11 +248,12 @@ has_reposition(int sno,
} }
char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) { char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
size_t maxs = max(255, max);
if (!nameb) { if (!nameb) {
nameb = malloc(max(256, max)); nameb = malloc(maxs + 1);
} }
if (!file) { if (!file) {
strcpy(nameb, "memory buffer"); strncpy(nameb, "memory buffer", maxs);
return nameb; return nameb;
} }
int f = fileno(file); int f = fileno(file);
@ -275,7 +276,7 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) {
return NULL; return NULL;
else { else {
int i; int i;
unsigned char *ptr = nameb; unsigned char *ptr = (unsigned char *)nameb;
for (i = 0; i < strlen(path); i++) for (i = 0; i < strlen(path); i++)
ptr += put_utf8(ptr, path[i]); ptr += put_utf8(ptr, path[i]);
*ptr = '\0'; *ptr = '\0';

2
os/sysbits.c
View File

@ -1181,7 +1181,7 @@ const char *Yap_findFile(const char *isource, const char *idef,
YAP_file_type_t ftype, bool expand_root, bool in_lib) { YAP_file_type_t ftype, bool expand_root, bool in_lib) {
char *save_buffer = NULL; char *save_buffer = NULL;
const char *root, *source = isource; const char *root = iroot, *source = isource;
int rc = FAIL_RESTORE; int rc = FAIL_RESTORE;
int try int try
= 0; = 0;