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

26
os/format.c
View File

@ -982,23 +982,22 @@ 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;
case 'W': case 'W':
if (targ > tnum - 2 || has_repeats) if (targ > tnum - 2 || has_repeats)
goto do_format_control_sequence_error; goto do_format_control_sequence_error;
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);
goto do_default_error;
};
Yap_CloseSlots(slf); Yap_CloseSlots(slf);
goto do_default_error; }
};
Yap_CloseSlots(slf);
}
break; break;
case '~': case '~':
if (has_repeats) if (has_repeats)
@ -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

565
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,19 +110,19 @@ 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) {
PRED_LD PRED_LD
Term t = Deref(ARG1); Term t = Deref(ARG1);
if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) = if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) =
FunctorDQuasiQuotation) { FunctorDQuasiQuotation) {
void *ptr; void *ptr;
char *start; char *start;
size_t l int s; size_t l int s;
@ -173,26 +173,26 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) {
} else } else
return TRUE; return TRUE;
} else if (_PL_rd->quasi_quotations) /* user option, but no quotes */ } else if (_PL_rd->quasi_quotations) /* user option, but no quotes */
{ {
return PL_unify_nil(_PL_rd->quasi_quotations); return PL_unify_nil(_PL_rd->quasi_quotations);
} else } else
return TRUE; return TRUE;
} }
#endif /*O_QUASIQUOTATIONS*/ #endif /*O_QUASIQUOTATIONS*/
#define READ_DEFS() \ #define READ_DEFS() \
PAR("comments", list_filler, READ_COMMENTS) \ PAR("comments", list_filler, READ_COMMENTS) \
, PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \
PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \
PAR("term_position", filler, READ_TERM_POSITION), \ PAR("term_position", filler, READ_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \
PAR("singletons", filler, READ_SINGLETONS), \ PAR("singletons", filler, READ_SINGLETONS), \
PAR("variables", filler, READ_VARIABLES), \ PAR("variables", filler, READ_VARIABLES), \
PAR("variable_names", filler, READ_VARIABLE_NAMES), \ PAR("variable_names", filler, READ_VARIABLE_NAMES), \
PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \
PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \
PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END)
#define PAR(x, y, z) z #define PAR(x, y, z) z
@ -200,24 +200,24 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t;
#undef PAR #undef PAR
#define PAR(x, y, z) \ #define PAR(x, y, z) \
{ x, y, z } { x, y, z }
static const param_t read_defs[] = {READ_DEFS()}; 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;
Term startline, errline, endline; Term startline, errline, endline;
Term tf[4]; Term tf[4];
Term *tailp = tf + 3; Term *tailp = tf + 3;
@ -264,71 +264,93 @@ 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;
Term t0[2]; case QuasiQuotes_tok:
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>")); {
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); Term t0[2];
} break; t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
case WQuasiQuotes_tok: { ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
Term t0[2]; }
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>")); break;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); case WQuasiQuotes_tok:
} break; {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
}
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]; {
VarEntry *varinfo = (VarEntry *)info; Term t[2];
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: {
Term t0 = Yap_CharsToTDQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
} }
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); break;
} break; case String_tok:
case WString_tok: { {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod 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); }
} break; ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
case BQString_tok: { }
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS); break;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); case WString_tok:
} break; {
case WBQString_tok: { Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS);
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS); if (!t0)
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); return 0;
} break; ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
case Error_tok: { }
ts[0] = MkAtomTerm(AtomError); break;
} break; case BQString_tok:
{
Term t0 = Yap_CharsToTBQ((char *)info, cmod, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case WBQString_tok:
{
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, cmod PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
}
break;
case Error_tok:
{
ts[0] = MkAtomTerm(AtomError);
}
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]; {
s[1] = '\0'; char s[2];
if ((info) == 'l') { s[1] = '\0';
s[0] = '('; if ((info) == 'l') {
} else { s[0] = '(';
s[0] = (char)info; } else {
s[0] = (char)info;
}
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;
} }
@ -398,7 +420,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream); int inp_stream);
static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
CACHE_REGS CACHE_REGS
LOCAL_VarTable = NULL; LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL; LOCAL_AnonVarTable = NULL;
fe->enc = GLOBAL_Stream[inp_stream].encoding; fe->enc = GLOBAL_Stream[inp_stream].encoding;
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END); xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
@ -495,7 +517,7 @@ typedef enum {
Int Yap_FirstLineInParse(void) { Int Yap_FirstLineInParse(void) {
CACHE_REGS CACHE_REGS
return LOCAL_StartLineCount; return LOCAL_StartLineCount;
} }
#define PUSHFET(X) *HR++ = fe->X #define PUSHFET(X) *HR++ = fe->X
@ -504,7 +526,7 @@ Int Yap_FirstLineInParse(void) {
static void reset_regs(TokEntry *tokstart, FEnv *fe) { static void reset_regs(TokEntry *tokstart, FEnv *fe) {
CACHE_REGS CACHE_REGS
restore_machine_regs(); restore_machine_regs();
/* restart global */ /* restart global */
PUSHFET(qq); PUSHFET(qq);
@ -531,7 +553,7 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) {
static Term get_variables(FEnv *fe, TokEntry *tokstart) { static Term get_variables(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v; Term v;
if (fe->vp) { if (fe->vp) {
while (true) { while (true) {
fe->old_H = HR; fe->old_H = HR;
@ -551,7 +573,7 @@ static Term get_variables(FEnv *fe, TokEntry *tokstart) {
static Term get_varnames(FEnv *fe, TokEntry *tokstart) { static Term get_varnames(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v; Term v;
if (fe->np) { if (fe->np) {
while (true) { while (true) {
fe->old_H = HR; fe->old_H = HR;
@ -571,7 +593,7 @@ static Term get_varnames(FEnv *fe, TokEntry *tokstart) {
static Term get_singletons(FEnv *fe, TokEntry *tokstart) { static Term get_singletons(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v; Term v;
if (fe->sp) { if (fe->sp) {
while (TRUE) { while (TRUE) {
fe->old_H = HR; fe->old_H = HR;
@ -589,7 +611,7 @@ static Term get_singletons(FEnv *fe, TokEntry *tokstart) {
static void warn_singletons(FEnv *fe, TokEntry *tokstart) { static void warn_singletons(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v; Term v;
fe->sp = TermNil; fe->sp = TermNil;
v = get_singletons(fe, tokstart); v = get_singletons(fe, tokstart);
if (v && v != TermNil) { if (v && v != TermNil) {
@ -611,7 +633,7 @@ static void warn_singletons(FEnv *fe, TokEntry *tokstart) {
static Term get_stream_position(FEnv *fe, TokEntry *tokstart) { static Term get_stream_position(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v; Term v;
if (fe->tp) { if (fe->tp) {
while (true) { while (true) {
fe->old_H = HR; fe->old_H = HR;
@ -629,7 +651,7 @@ static Term get_stream_position(FEnv *fe, TokEntry *tokstart) {
static bool complete_processing(FEnv *fe, TokEntry *tokstart) { static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v1, v2, v3, vc, tp; Term v1, v2, v3, vc, tp;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v1 = get_variables(fe, tokstart); v1 = get_variables(fe, tokstart);
@ -657,15 +679,15 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) {
// trail must be ok by now.] // trail must be ok by now.]
if (fe->t) { if (fe->t) {
return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) && return (!v1 || Yap_unify(v1, fe->vp)) && (!v2 || Yap_unify(v2, fe->np)) &&
(!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) && (!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) &&
(!vc || Yap_unify(vc, fe->tcomms)); (!vc || Yap_unify(vc, fe->tcomms));
} }
return true; return true;
} }
static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
CACHE_REGS CACHE_REGS
Term v_vp, v_vnames, v_comments, v_pos; Term v_vp, v_vnames, v_comments, v_pos;
if (fe->t && fe->vp) if (fe->t && fe->vp)
v_vp = get_variables(fe, tokstart); v_vp = get_variables(fe, tokstart);
@ -691,9 +713,9 @@ static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) {
// trail must be ok by now.] // trail must be ok by now.]
if (fe->t) { if (fe->t) {
return (!v_vp || Yap_unify(v_vp, fe->vp)) && return (!v_vp || Yap_unify(v_vp, fe->vp)) &&
(!v_vnames || Yap_unify(v_vnames, fe->np)) && (!v_vnames || Yap_unify(v_vnames, fe->np)) &&
(!v_pos || Yap_unify(v_pos, fe->tp)) && (!v_pos || Yap_unify(v_pos, fe->tp)) &&
(!v_comments || Yap_unify(v_comments, fe->tcomms)); (!v_comments || Yap_unify(v_comments, fe->tcomms));
} }
return true; return true;
} }
@ -711,8 +733,8 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream);
static parser_state_t scanEOF(FEnv *fe, int inp_stream) { static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
CACHE_REGS CACHE_REGS
// bool store_comments = false; // bool store_comments = false;
TokEntry *tokstart = LOCAL_tokptr; TokEntry *tokstart = LOCAL_tokptr;
// check for an user abort // check for an user abort
if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) { if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) {
/* we got the end of file from an abort */ /* we got the end of file from an abort */
@ -752,7 +774,7 @@ static parser_state_t scanEOF(FEnv *fe, int inp_stream) {
static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream, static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
int nargs) { int nargs) {
CACHE_REGS CACHE_REGS
LOCAL_ErrorMessage = NULL; LOCAL_ErrorMessage = NULL;
fe->old_TR = TR; fe->old_TR = TR;
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name; LOCAL_SourceFileName = GLOBAL_Stream[inp_stream].name;
@ -789,11 +811,11 @@ static parser_state_t initParser(Term opts, FEnv *fe, REnv *re, int inp_stream,
static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS CACHE_REGS
/* preserve value of H after scanning: otherwise we may lose strings /* preserve value of H after scanning: otherwise we may lose strings
and floats */ and floats */
LOCAL_tokptr = LOCAL_toktide = LOCAL_tokptr = LOCAL_toktide =
Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos); Yap_tokenizer(GLOBAL_Stream + inp_stream, false, &fe->tpos);
if (LOCAL_ErrorMessage) if (LOCAL_ErrorMessage)
return YAP_SCANNING_ERROR; return YAP_SCANNING_ERROR;
if (LOCAL_tokptr->Tok != Ord(eot_tok)) { if (LOCAL_tokptr->Tok != Ord(eot_tok)) {
@ -814,7 +836,7 @@ static parser_state_t scan(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS CACHE_REGS
fe->t = 0; fe->t = 0;
// running out of memory // running out of memory
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) { if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) {
LOCAL_Error_TYPE = YAP_NO_ERROR; LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -854,7 +876,7 @@ static parser_state_t scanError(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS CACHE_REGS
fe->t = 0; fe->t = 0;
if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL || if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL ||
LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK || LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK ||
LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP || LOCAL_Error_TYPE == RESOURCE_ERROR_HEAP ||
@ -884,7 +906,7 @@ static parser_state_t parseError(REnv *re, FEnv *fe, int inp_stream) {
static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) { static parser_state_t parse(REnv *re, FEnv *fe, int inp_stream) {
CACHE_REGS CACHE_REGS
TokEntry *tokstart = LOCAL_tokptr; TokEntry *tokstart = LOCAL_tokptr;
fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod); fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod);
fe->toklast = LOCAL_tokptr; fe->toklast = LOCAL_tokptr;
LOCAL_tokptr = tokstart; LOCAL_tokptr = tokstart;
@ -939,33 +961,34 @@ 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 {
bool done; CACHE_REGS
if (fe.reading_clause) bool done;
done = complete_clause_processing(&fe, LOCAL_tokptr); if (fe.reading_clause)
else done = complete_clause_processing(&fe, LOCAL_tokptr);
done = complete_processing(&fe, LOCAL_tokptr); else
if (!done) { done = complete_processing(&fe, LOCAL_tokptr);
state = YAP_PARSING_ERROR; if (!done) {
fe.t = 0; state = YAP_PARSING_ERROR;
break; fe.t = 0;
} break;
if (LOCAL_Error_TYPE != YAP_NO_ERROR) { }
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage); if (LOCAL_Error_TYPE != YAP_NO_ERROR) {
} Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
}
#if EMACS #if EMACS
first_char = tokstart->TokPos; first_char = tokstart->TokPos;
#endif /* EMACS */ #endif /* EMACS */
return fe.t; return fe.t;
} }
} }
} }
return 0; return 0;
} }
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)
@ -975,7 +998,7 @@ static Int
} }
static Int read_term( static Int read_term(
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;
Term out; Term out;
@ -992,14 +1015,14 @@ static Int read_term(
return out != 0L && Yap_unify(tf, out); return out != 0L && Yap_unify(tf, out);
} }
#define READ_CLAUSE_DEFS() \ #define READ_CLAUSE_DEFS() \
PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \
, PAR("module", isatom, READ_CLAUSE_MODULE), \ , PAR("module", isatom, READ_CLAUSE_MODULE), \
PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \
PAR("variables", filler, READ_CLAUSE_VARIABLES), \ PAR("variables", filler, READ_CLAUSE_VARIABLES), \
PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \
PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \
PAR(NULL, ok, READ_CLAUSE_END) PAR(NULL, ok, READ_CLAUSE_END)
#define PAR(x, y, z) z #define PAR(x, y, z) z
@ -1009,7 +1032,7 @@ typedef enum read_clause_enum_choices {
#undef PAR #undef PAR
#define PAR(x, y, z) \ #define PAR(x, y, z) \
{ x, y, z } { x, y, z }
static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()}; static const param_t read_clause_defs[] = {READ_CLAUSE_DEFS()};
@ -1019,7 +1042,7 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream) { int inp_stream) {
CACHE_REGS CACHE_REGS
xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END); xarg *args = Yap_ArgListToVector(opts, read_clause_defs, READ_CLAUSE_END);
if (args == NULL) { if (args == NULL) {
if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) if (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT)
LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION; LOCAL_Error_TYPE = DOMAIN_ERROR_READ_OPTION;
@ -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,28 +1115,28 @@ 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;
Term out; Term out;
Term t3 = Deref(ARG3); Term t3 = Deref(ARG3);
@ -1141,36 +1164,36 @@ 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;
Int out; Int out;
@ -1186,24 +1209,24 @@ 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(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
Term out = Yap_read_term(LOCAL_c_input_stream, TermNil, 1); Term out = Yap_read_term(LOCAL_c_input_stream, TermNil, 1);
return out && Yap_unify(ARG1, out); return out && Yap_unify(ARG1, out);
} }
/** @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,16 +1234,16 @@ 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(
USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */ USES_REGS1) { /* '$read2'(+Flag,?Term,?Module,?Vars,-Pos,-Err,+Stream) */
return setYapFlag(TermFileerrors, TermFalse); return setYapFlag(TermFileerrors, TermFalse);
} }
@ -1271,7 +1294,7 @@ static Int style_checker(USES_REGS1) {
X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp,
int prio, Term *bindings) { int prio, Term *bindings) {
CACHE_REGS CACHE_REGS
Term bvar = MkVarTerm(), ctl; Term bvar = MkVarTerm(), ctl;
yhandle_t sl; yhandle_t sl;
if (bindings) { if (bindings) {
@ -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;
@ -1384,7 +1406,7 @@ static Int read_term_from_string(USES_REGS1) {
static Int string_to_term(USES_REGS1) { static Int string_to_term(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1), rc;
const char *s; const char *s;
size_t len; size_t len;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
@ -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);
@ -1411,7 +1432,7 @@ static Int atomic_to_term(USES_REGS1) {
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
return (FALSE); return (FALSE);
} else if (!IsAtomicTerm(t1)) { } else if (!IsAtomicTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3"); Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3");
return (FALSE); return (FALSE);
} else { } else {
@ -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);
@ -1429,12 +1449,12 @@ static Int atomic_to_term(USES_REGS1) {
static Int atom_to_term(USES_REGS1) { static Int atom_to_term(USES_REGS1) {
Term t1 = Deref(ARG1), rc; Term t1 = Deref(ARG1), rc;
const char *s; const char *s;
size_t len; size_t len;
if (IsVarTerm(t1)) { if (IsVarTerm(t1)) {
Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3");
return (FALSE); return (FALSE);
} else if (!IsAtomTerm(t1)) { } else if (!IsAtomTerm(t1)) {
Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3"); Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3");
return (FALSE); return (FALSE);
} else { } else {
@ -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;
@ -1482,8 +1501,8 @@ static Int read_term_from_atomic(USES_REGS1) {
char *ss = (char *)s; char *ss = (char *)s;
encoding_t enc = ENC_ISO_UTF8; encoding_t enc = ENC_ISO_UTF8;
int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER); int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER);
rc = Yap_read_term(sno, Deref(ARG3), 3); rc = Yap_read_term(sno, Deref(ARG3), 3);
Yap_CloseStream(sno); Yap_CloseStream(sno);
if (!rc) if (!rc)
return false; return false;
return Yap_unify(rc, ARG2); return Yap_unify(rc, ARG2);
@ -1499,8 +1518,8 @@ void Yap_InitReadTPreds(void) {
Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0); Yap_InitCPred("read_term_from_atom", 3, read_term_from_atom, 0);
Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0); Yap_InitCPred("read_term_from_atomic", 3, read_term_from_atomic, 0);
Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0); Yap_InitCPred("read_term_from_string", 3, read_term_from_string, 0);
Yap_InitCPred("atom_to_term", 3, atom_to_term, 0); Yap_InitCPred("atom_to_term", 3, atom_to_term, 0);
Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0); Yap_InitCPred("atomic_to_term", 3, atomic_to_term, 0);
Yap_InitCPred("string_to_term", 3, string_to_term, 0); Yap_InitCPred("string_to_term", 3, string_to_term, 0);
Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag);

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;