diff --git a/os/format.c b/os/format.c index cb8f68b8d..93703a766 100644 --- a/os/format.c +++ b/os/format.c @@ -982,23 +982,22 @@ static Int doformat(volatile Term otail, volatile Term oargs, goto do_format_control_sequence_error; t = targs[targ++]; yhandle_t slf = Yap_StartSlots(); - Yap_plwrite(t, GLOBAL_Stream + sno, 0, - Handle_vars_f | To_heap_f, + Yap_plwrite(t, GLOBAL_Stream + sno, 0, Handle_vars_f | To_heap_f, GLOBAL_MaxPriority); - Yap_CloseSlots(slf); + Yap_CloseSlots(slf); break; case 'W': if (targ > tnum - 2 || has_repeats) goto do_format_control_sequence_error; - targ -= 2; - { - yhandle_t slf = Yap_StartSlots(); - if (!Yap_WriteTerm( sno, targs[1], targs[0] PASS_REGS)) { + targ -= 2; + { + yhandle_t slf = Yap_StartSlots(); + if (!Yap_WriteTerm(sno, targs[1], targs[0] PASS_REGS)) { + Yap_CloseSlots(slf); + goto do_default_error; + }; Yap_CloseSlots(slf); - goto do_default_error; - }; - Yap_CloseSlots(slf); - } + } break; case '~': if (has_repeats) @@ -1200,7 +1199,7 @@ static Int with_output_to(USES_REGS1) { Term tin = Deref(ARG1); Functor f; bool out; - bool mem_stream = false; + bool my_mem_stream; yhandle_t hdl = Yap_PushHandle(tin); if (IsVarTerm(tin)) { 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 */ output_stream = Yap_CheckStream(ARG1, Output_Stream_f, "format/3"); my_mem_stream = false; + f = NIL; } if (output_stream == -1) { return false; @@ -1223,7 +1223,7 @@ static Int with_output_to(USES_REGS1) { out = Yap_Execute(Deref(ARG2) PASS_REGS); LOCK(GLOBAL_Stream[output_stream].streamlock); LOCAL_c_output_stream = old_out; - if (mem_stream) { + if (my_mem_stream) { Term tat; Term inp = Yap_GetFromHandle(hdl); if (out) { diff --git a/os/getw.h b/os/getw.h index 7b48f8d0b..0a2fc8859 100644 --- a/os/getw.h +++ b/os/getw.h @@ -2,9 +2,9 @@ /// compose a wide char from a sequence of getchars /// this is a slow lane routine, called if no specialised code /// isavailable. -static int GETW(int sno) { +extern int get_wchar(int sno) { StreamDesc *st = GLOBAL_Stream + sno; - int ch = GETC(); + int ch = st->stream_getc(sno); if (ch == -1) return post_process_weof(st); @@ -31,7 +31,7 @@ static int GETW(int sno) { buf[0] = ch; int n = 1; while ((out = mbrtowc(&wch, buf, 1, &(mbstate))) != 1) { - int ch = buf[0] = GETC(); + int ch = buf[0] = st->stream_getc(sno); n++; if (ch == -1) 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 < 0xe0) { // 2-byte sequence // Must have valid continuation character - int c1 = buf[0] = GETC(); + int c1 = buf[0] = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); // if (!utf_cont(*str)) return UTF8PROC_ERROR_INVALIDUTF8; @@ -62,22 +62,22 @@ static int GETW(int sno) { // Check for surrogate chars // if (ch == 0xed && *str > 0x9f) // return UTF8PROC_ERROR_INVALIDUTF8; - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); - int c2 = GETC(); + 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 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); - int c2 = GETC(); + int c2 = st->stream_getc(sno); if (c2 == -1) return post_process_weof(st); - int c3 = GETC(); + int c3 = st->stream_getc(sno); if (c3 == -1) return post_process_weof(st); 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 { int wch; - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = (c1 << 8) + ch; if (wch >= 0xd800 && wch < 0xdc00) { - int c2 = GETC(); + int c2 = st->stream_getc(sno); if (c2 == -1) return post_process_weof(st); - int c3 = GETC(); + int c3 = st->stream_getc(sno); if (c3 == -1) return post_process_weof(st); wch = wch + (((c3 << 8) + c2) << wch) + SURROGATE_OFFSET; @@ -110,15 +110,15 @@ static int GETW(int sno) { // little-endian: start with big shot { int wch; - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = (c1) + (ch << 8); if (wch >= 0xd800 && wch < 0xdc00) { - int c3 = GETC(); + int c3 = st->stream_getc(sno); if (c3 == -1) return post_process_weof(st); - int c2 = GETC(); + int c2 = st->stream_getc(sno); if (c2 == -1) return post_process_weof(st); wch = (((c3 << 8) + c2) << 10) + wch + SURROGATE_OFFSET; @@ -131,7 +131,7 @@ static int GETW(int sno) { // little-endian: start with big shot { int wch; - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = (c1) + (ch << 8); @@ -142,7 +142,7 @@ static int GETW(int sno) { // little-endian: start with big shot { int wch; - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = (c1 << 8) + ch; @@ -155,19 +155,19 @@ static int GETW(int sno) { { int wch = ch; { - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = wch + c1; } { - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = (wch << 8) + c1; } { - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch = (wch << 8) + c1; @@ -179,19 +179,19 @@ static int GETW(int sno) { { int wch = ch; { - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch += c1 << 8; } { - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch += c1 << 16; } { - int c1 = GETC(); + int c1 = st->stream_getc(sno); if (c1 == -1) return post_process_weof(st); wch += c1 << 24; @@ -204,3 +204,57 @@ static int GETW(int sno) { 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); + } + } +} diff --git a/os/iopreds.c b/os/iopreds.c index f77b63682..b9d0d1278 100644 --- a/os/iopreds.c +++ b/os/iopreds.c @@ -97,16 +97,9 @@ static char SccsId[] = "%W% %G%"; #define S_ISDIR(x) (((x)&_S_IFDIR) == _S_IFDIR) #endif #endif -#include "iopreds.h" -//#define GETW get_wchar_from_FILE -//#endif -#define GETC() fgetwc(st->file) -#include "getw.h" -#undef GETW -#undef GETC -#define GETW get_wchar -#define GETC() st->stream_getc(sno) +#include "iopreds.h" + #include "getw.h" static int get_wchar_from_file(int); @@ -254,7 +247,7 @@ static void unix_upd_stream_info(StreamDesc *s) { void Yap_DefaultStreamOps(StreamDesc *st) { CACHE_REGS st->stream_wputc = put_wchar; - st->stream_wgetc = get_wchar; + st->stream_wgetc = get_wchar_UTF8; st->stream_putc = FilePutc; st->stream_getc = PlGetc; if (st->status & (Promptable_Stream_f)) { @@ -664,10 +657,9 @@ int PlGetc(int sno) { } // layered version -static int get_wchar__(int sno) { return fgetwc(GLOBAL_Stream[sno].file); } - -static int get_wchar_from_file(int sno) { - return post_process_read_wchar(get_wchar__(sno), 1, GLOBAL_Stream + sno); +static inline int get_wchar_from_file(int sno) { + return post_process_read_wchar(fgetwc(GLOBAL_Stream[sno].file), 1, + GLOBAL_Stream + sno); } #ifndef MB_LEN_MAX diff --git a/os/readterm.c b/os/readterm.c index 7008277f8..3c5cc31fd 100644 --- a/os/readterm.c +++ b/os/readterm.c @@ -1,28 +1,28 @@ /************************************************************************* -* * -* YAP Prolog * -* * -* Yap Prolog was developed at NCCUP - Universidade do Porto * -* * -* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * -* * -************************************************************************** -* * -* File: iopreds.c * -* Last rev: 5/2/88 * -* mods: * -* comments: Input/Output C implemented predicates * -* * -*************************************************************************/ + * * + * YAP Prolog * + * * + * Yap Prolog was developed at NCCUP - Universidade do Porto * + * * + * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * + * * + ************************************************************************** + * * + * File: iopreds.c * + * Last rev: 5/2/88 * + * mods: * + * comments: Input/Output C implemented predicates * + * * + *************************************************************************/ #ifdef SCCS static char SccsId[] = "%W% %G%"; #endif /* -* This file includes the definition of a miscellania of standard predicates -* for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, -* -*/ + * This file includes the definition of a miscellania of standard predicates + * for yap refering to: Files and GLOBAL_Streams, Simple Input/Output, + * + */ #include "Yap.h" #include "YapFlags.h" @@ -110,19 +110,19 @@ static void clean_vars(VarEntry *p) { #ifdef O_QUASIQUOTATIONS /** '$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 Stream is a UTF-8 encoded string, whose position indication -reflects the location in the real file. + @arg QQRange is a term '$quasi_quotation'(ReadData, Start, Length) + @arg Stream is a UTF-8 encoded string, whose position indication + reflects the location in the real file. */ static Int qq_open(USES_REGS1) { PRED_LD - Term t = Deref(ARG1); + Term t = Deref(ARG1); if (!IsVarTerm(t) && IsApplTerm(t) && FunctorOfTerm(t) = - FunctorDQuasiQuotation) { + FunctorDQuasiQuotation) { void *ptr; char *start; size_t l int s; @@ -173,26 +173,26 @@ static int parse_quasi_quotations(ReadData _PL_rd ARG_LD) { } else return TRUE; } else if (_PL_rd->quasi_quotations) /* user option, but no quotes */ - { - return PL_unify_nil(_PL_rd->quasi_quotations); - } else + { + return PL_unify_nil(_PL_rd->quasi_quotations); + } else return TRUE; } #endif /*O_QUASIQUOTATIONS*/ -#define READ_DEFS() \ - PAR("comments", list_filler, READ_COMMENTS) \ - , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ - PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ - PAR("term_position", filler, READ_TERM_POSITION), \ - PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ - PAR("singletons", filler, READ_SINGLETONS), \ - PAR("variables", filler, READ_VARIABLES), \ - PAR("variable_names", filler, READ_VARIABLE_NAMES), \ - PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ - PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ - PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) +#define READ_DEFS() \ + PAR("comments", list_filler, READ_COMMENTS) \ + , PAR("module", isatom, READ_MODULE), PAR("priority", nat, READ_PRIORITY), \ + PAR("quasi_quotations", filler, READ_QUASI_QUOTATIONS), \ + PAR("term_position", filler, READ_TERM_POSITION), \ + PAR("syntax_errors", isatom, READ_SYNTAX_ERRORS), \ + PAR("singletons", filler, READ_SINGLETONS), \ + PAR("variables", filler, READ_VARIABLES), \ + PAR("variable_names", filler, READ_VARIABLE_NAMES), \ + PAR("character_escapes", booleanFlag, READ_CHARACTER_ESCAPES), \ + PAR("backquoted_string", isatom, READ_BACKQUOTED_STRING), \ + PAR("cycles", ok, READ_CYCLES), PAR(NULL, ok, READ_END) #define PAR(x, y, z) z @@ -200,24 +200,24 @@ typedef enum open_enum_choices { READ_DEFS() } read_choices_t; #undef PAR -#define PAR(x, y, z) \ +#define PAR(x, y, z) \ { x, y, z } static const param_t read_defs[] = {READ_DEFS()}; #undef PAR /** -* Syntax Error Handler -* -* @par tokptr: the sequence of tokens -* @par sno: the stream numbet -* -* Implicit arguments: -* + -*/ + * Syntax Error Handler + * + * @par tokptr: the sequence of tokens + * @par sno: the stream numbet + * + * Implicit arguments: + * + + */ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { CACHE_REGS - Term info; + Term info; Term startline, errline, endline; Term tf[4]; Term *tailp = tf + 3; @@ -264,71 +264,93 @@ static Term syntax_error(TokEntry *errtok, int sno, Term cmod) { t0[0] = TermNil; } ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); - } break; - case QuasiQuotes_tok: { - Term t0[2]; - t0[0] = MkAtomTerm(Yap_LookupAtom("")); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); - } break; - case WQuasiQuotes_tok: { - Term t0[2]; - t0[0] = MkAtomTerm(Yap_LookupAtom("")); - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); - } break; + } + break; + case QuasiQuotes_tok: + { + Term t0[2]; + t0[0] = MkAtomTerm(Yap_LookupAtom("")); + ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); + } + break; + case WQuasiQuotes_tok: + { + Term t0[2]; + t0[0] = MkAtomTerm(Yap_LookupAtom("")); + ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0); + } + break; case Number_tok: ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo)); break; - case Var_tok: { - Term t[2]; - VarEntry *varinfo = (VarEntry *)info; + case Var_tok: + { + Term t[2]; + VarEntry *varinfo = (VarEntry *)info; - t[0] = MkIntTerm(0); - t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS); - 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; + t[0] = MkIntTerm(0); + 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(AtomString, 1), 1, &t0); - } break; - case WString_tok: { - Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS); - if (!t0) - return 0; - ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); - } 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; + 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; + case WString_tok: + { + Term t0 = Yap_WCharsToTDQ((wchar_t *)info, cmod PASS_REGS); + if (!t0) + return 0; + ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); + } + 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: endline = MkIntegerTerm(tok->TokPos); ts[0] = MkAtomTerm(Yap_LookupAtom("EOT")); break; - case Ponctuation_tok: { - char s[2]; - s[1] = '\0'; - if ((info) == 'l') { - s[0] = '('; - } else { - s[0] = (char)info; + case Ponctuation_tok: + { + char s[2]; + s[1] = '\0'; + if ((info) == 'l') { + s[0] = '('; + } else { + s[0] = (char)info; + } + ts[0] = MkAtomTerm(Yap_LookupAtom(s)); } - ts[0] = MkAtomTerm(Yap_LookupAtom(s)); - } } + if (tok->TokNext) { tok = tok->TokNext; - if (!tok) + } else { + endline = MkIntegerTerm(tok->TokPos); + tok = NULL; break; + } *tailp = MkPairTerm(ts[0], TermNil); tailp = RepPair(*tailp) + 1; } @@ -398,7 +420,7 @@ static xarg *setClauseReadEnv(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 - LOCAL_VarTable = NULL; + LOCAL_VarTable = NULL; LOCAL_AnonVarTable = NULL; fe->enc = GLOBAL_Stream[inp_stream].encoding; xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END); @@ -495,7 +517,7 @@ typedef enum { Int Yap_FirstLineInParse(void) { CACHE_REGS - return LOCAL_StartLineCount; + return LOCAL_StartLineCount; } #define PUSHFET(X) *HR++ = fe->X @@ -504,7 +526,7 @@ Int Yap_FirstLineInParse(void) { static void reset_regs(TokEntry *tokstart, FEnv *fe) { CACHE_REGS - restore_machine_regs(); + restore_machine_regs(); /* restart global */ PUSHFET(qq); @@ -531,7 +553,7 @@ static void reset_regs(TokEntry *tokstart, FEnv *fe) { static Term get_variables(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->vp) { while (true) { fe->old_H = HR; @@ -551,7 +573,7 @@ static Term get_variables(FEnv *fe, TokEntry *tokstart) { static Term get_varnames(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->np) { while (true) { fe->old_H = HR; @@ -571,7 +593,7 @@ static Term get_varnames(FEnv *fe, TokEntry *tokstart) { static Term get_singletons(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; if (fe->sp) { while (TRUE) { fe->old_H = HR; @@ -589,7 +611,7 @@ static Term get_singletons(FEnv *fe, TokEntry *tokstart) { static void warn_singletons(FEnv *fe, TokEntry *tokstart) { CACHE_REGS - Term v; + Term v; fe->sp = TermNil; v = get_singletons(fe, tokstart); 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) { CACHE_REGS - Term v; + Term v; if (fe->tp) { while (true) { 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) { CACHE_REGS - Term v1, v2, v3, vc, tp; + Term v1, v2, v3, vc, tp; if (fe->t && fe->vp) v1 = get_variables(fe, tokstart); @@ -657,15 +679,15 @@ static bool complete_processing(FEnv *fe, TokEntry *tokstart) { // trail must be ok by now.] if (fe->t) { 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)) && - (!vc || Yap_unify(vc, fe->tcomms)); + (!v3 || Yap_unify(v3, fe->sp)) && (!tp || Yap_unify(tp, fe->tp)) && + (!vc || Yap_unify(vc, fe->tcomms)); } return true; } static bool complete_clause_processing(FEnv *fe, TokEntry *tokstart) { 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) 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.] if (fe->t) { return (!v_vp || Yap_unify(v_vp, fe->vp)) && - (!v_vnames || Yap_unify(v_vnames, fe->np)) && - (!v_pos || Yap_unify(v_pos, fe->tp)) && - (!v_comments || Yap_unify(v_comments, fe->tcomms)); + (!v_vnames || Yap_unify(v_vnames, fe->np)) && + (!v_pos || Yap_unify(v_pos, fe->tp)) && + (!v_comments || Yap_unify(v_comments, fe->tcomms)); } 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) { CACHE_REGS - // bool store_comments = false; - TokEntry *tokstart = LOCAL_tokptr; + // bool store_comments = false; + TokEntry *tokstart = LOCAL_tokptr; // check for an user abort if (tokstart != NULL && tokstart->Tok != Ord(eot_tok)) { /* 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, int nargs) { CACHE_REGS - LOCAL_ErrorMessage = NULL; + LOCAL_ErrorMessage = NULL; fe->old_TR = TR; LOCAL_Error_TYPE = YAP_NO_ERROR; 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) { CACHE_REGS - /* preserve value of H after scanning: otherwise we may lose strings - and floats */ - LOCAL_tokptr = LOCAL_toktide = + /* preserve value of H after scanning: otherwise we may lose strings + and floats */ + 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) return YAP_SCANNING_ERROR; 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) { CACHE_REGS - fe->t = 0; + fe->t = 0; // running out of memory if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL) { 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) { CACHE_REGS - fe->t = 0; + fe->t = 0; if (LOCAL_Error_TYPE == RESOURCE_ERROR_TRAIL || LOCAL_Error_TYPE == RESOURCE_ERROR_AUXILIARY_STACK || 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) { CACHE_REGS - TokEntry *tokstart = LOCAL_tokptr; + TokEntry *tokstart = LOCAL_tokptr; fe->t = Yap_Parse(re->prio, fe->enc, fe->cmod); fe->toklast = LOCAL_tokptr; LOCAL_tokptr = tokstart; @@ -939,33 +961,34 @@ Term Yap_read_term(int inp_stream, Term opts, int nargs) { case YAP_PARSING_ERROR: state = parseError(&re, &fe, inp_stream); break; - case YAP_PARSING_FINISHED: { - CACHE_REGS - bool done; - if (fe.reading_clause) - done = complete_clause_processing(&fe, LOCAL_tokptr); - else - done = complete_processing(&fe, LOCAL_tokptr); - if (!done) { - state = YAP_PARSING_ERROR; - fe.t = 0; - break; - } - if (LOCAL_Error_TYPE != YAP_NO_ERROR) { - Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage); - } + case YAP_PARSING_FINISHED: + { + CACHE_REGS + bool done; + if (fe.reading_clause) + done = complete_clause_processing(&fe, LOCAL_tokptr); + else + done = complete_processing(&fe, LOCAL_tokptr); + if (!done) { + state = YAP_PARSING_ERROR; + fe.t = 0; + break; + } + if (LOCAL_Error_TYPE != YAP_NO_ERROR) { + Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage); + } #if EMACS - first_char = tokstart->TokPos; + first_char = tokstart->TokPos; #endif /* EMACS */ - return fe.t; - } + return fe.t; + } } } return 0; } 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; yhandle_t h = Yap_PushHandle(ARG1); if ((rc = Yap_read_term(LOCAL_c_input_stream, ARG2, 2)) == 0) @@ -975,7 +998,7 @@ static Int } 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; Term out; @@ -992,14 +1015,14 @@ static Int read_term( return out != 0L && Yap_unify(tf, out); } -#define READ_CLAUSE_DEFS() \ - PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ - , PAR("module", isatom, READ_CLAUSE_MODULE), \ - PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ - PAR("variables", filler, READ_CLAUSE_VARIABLES), \ - PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ - PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ - PAR(NULL, ok, READ_CLAUSE_END) +#define READ_CLAUSE_DEFS() \ + PAR("comments", list_filler, READ_CLAUSE_COMMENTS) \ + , PAR("module", isatom, READ_CLAUSE_MODULE), \ + PAR("variable_names", filler, READ_CLAUSE_VARIABLE_NAMES), \ + PAR("variables", filler, READ_CLAUSE_VARIABLES), \ + PAR("term_position", filler, READ_CLAUSE_TERM_POSITION), \ + PAR("syntax_errors", isatom, READ_CLAUSE_SYNTAX_ERRORS), \ + PAR(NULL, ok, READ_CLAUSE_END) #define PAR(x, y, z) z @@ -1009,7 +1032,7 @@ typedef enum read_clause_enum_choices { #undef PAR -#define PAR(x, y, z) \ +#define PAR(x, y, z) \ { x, y, z } 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) { 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 (LOCAL_Error_TYPE == DOMAIN_ERROR_GENERIC_ARGUMENT) 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. -* -*/ + * + */ static Int read_clause2(USES_REGS1) { Term rc; yhandle_t h = Yap_InitSlot(ARG1); @@ -1092,28 +1115,28 @@ static Int read_clause2(USES_REGS1) { } /** -* @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det -* -* This predicate receives a set of options _OPts_ based on read_term/3, but -*specific -* to readin clauses. The following options are considered: -* -* + The `comments` option unifies its argument with the comments in the term, -* represented as strings -* + The `process_comments` option calls a hook, it is current ignored by YAP. -* + The `term_position` unifies its argument with a term describing the -* position of the term. -* + The `syntax_errors` flag controls response to syntactic errors, the -*default is `dec10`. -* -* The next two options are called implicitly: -* -* + The `module` option is initialized to the current source module, by -*default. -* + The `singletons` option is set from the single var flag -*/ + * @pred read_clause( +_Stream_, -_Clause_, ?_Opts) is det + * + * This predicate receives a set of options _OPts_ based on read_term/3, but + *specific + * to readin clauses. The following options are considered: + * + * + The `comments` option unifies its argument with the comments in the term, + * represented as strings + * + The `process_comments` option calls a hook, it is current ignored by YAP. + * + The `term_position` unifies its argument with a term describing the + * position of the term. + * + The `syntax_errors` flag controls response to syntactic errors, the + *default is `dec10`. + * + * The next two options are called implicitly: + * + * + The `module` option is initialized to the current source module, by + *default. + * + The `singletons` option is set from the single var flag + */ 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; Term out; Term t3 = Deref(ARG3); @@ -1141,36 +1164,36 @@ static Int read_clause( } /** -* @pred source_location( - _File_ , _Line_ ) -* -* 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 -*friends.>position -* It ignores user_input or -* sockets. -* -* @param - _File_ -* @param - _Line_ -* -* @note SWI-Prolog built-in. -*/ + * @pred source_location( - _File_ , _Line_ ) + * + * 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 + *friends.>position + * It ignores user_input or + * sockets. + * + * @param - _File_ + * @param - _Line_ + * + * @note SWI-Prolog built-in. + */ static Int source_location(USES_REGS1) { 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 -* -* Reads term _T_ from the stream _S_ instead of from the current input -* stream. -* -* @param - _Stream_ -* @param - _Term_ -* -*/ + * @pred read(+ _Stream_, - _Term_ ) is iso + * + * Reads term _T_ from the stream _S_ instead of from the current input + * stream. + * + * @param - _Stream_ + * @param - _Term_ + * + */ 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 out; @@ -1186,24 +1209,24 @@ static Int read2( /** @pred read(- _T_) is iso -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 -as previously defined. The syntax of the term must match the current -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 -the same stream may cause an error failure (see open/3). + 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 + as previously defined. The syntax of the term must match the current + 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 + the same stream may cause an error failure (see open/3). */ 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); return out && Yap_unify(ARG1, out); } /** @pred fileerrors -Switches on the file_errors flag so that in certain error conditions -Input/Output predicates will produce an appropriated message and abort. + Switches on the file_errors flag so that in certain error conditions + Input/Output predicates will produce an appropriated message and abort. */ 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, -tell/1, open/3 and close/1 just fail, instead of producing -an error message and aborting whenever the specified file cannot be -opened or closed. + Switches off the `file_errors` flag, so that the predicates see/1, + tell/1, open/3 and close/1 just fail, instead of producing + an error message and aborting whenever the specified file cannot be + opened or closed. */ 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); } @@ -1271,7 +1294,7 @@ static Int style_checker(USES_REGS1) { X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, int prio, Term *bindings) { CACHE_REGS - Term bvar = MkVarTerm(), ctl; + Term bvar = MkVarTerm(), ctl; yhandle_t sl; if (bindings) { @@ -1294,21 +1317,20 @@ X_API Term Yap_StringToTerm(const char *s, size_t len, encoding_t *encp, return rval; } - /** -* @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_ -* -* read a term _T_ stored in constant _Atom_ according to _Options_ -* -* @param _Atom_ the source _Atom_ -* @param _T_ the output term _T_, may be any term -* @param _Options_ read_term/3 options. -* -* @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 -*supposed to -* use YAP's internal encoding, so please avoid the encoding/1 option. -*/ + * @pred read_term_from_atom( +_Atom_ , - _T_ , + _Options_ + * + * read a term _T_ stored in constant _Atom_ according to _Options_ + * + * @param _Atom_ the source _Atom_ + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @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 + *supposed to + * use YAP's internal encoding, so please avoid the encoding/1 option. + */ static Int read_term_from_atom(USES_REGS1) { Term t1 = Deref(ARG1), rc; Atom at; @@ -1347,17 +1369,17 @@ Term Yap_AtomToTerm(Atom a, Term opts) { } /** -* @pred read_term_from_string( +_String_ , - _T_ , + _Options_ -* -* read a term _T_ stored in constant _String_ according to _Options_ -* -* @param _String_ the source _String_ -* @param _T_ the output term _T_, may be any term -* @param _Options_ read_term/3 options. -* -* @notes Idea from SWI-Prolog, in YAP only works with strings -* Check read_term_from_atomic/3 for the general version. -*/ + * @pred read_term_from_string( +_String_ , - _T_ , + _Options_ + * + * read a term _T_ stored in constant _String_ according to _Options_ + * + * @param _String_ the source _String_ + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @notes Idea from SWI-Prolog, in YAP only works with strings + * Check read_term_from_atomic/3 for the general version. + */ static Int read_term_from_string(USES_REGS1) { Term t1 = Deref(ARG1), rc; const unsigned char *s; @@ -1384,7 +1406,7 @@ static Int read_term_from_string(USES_REGS1) { static Int string_to_term(USES_REGS1) { Term t1 = Deref(ARG1), rc; - const char *s; + const char *s; size_t len; if (IsVarTerm(t1)) { 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); } encoding_t enc = ENC_ISO_UTF8; - rc = Yap_StringToTerm(s, len, &enc, - 1200, &ARG3); + rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3); if (!rc) return false; return Yap_unify(rc, ARG2); @@ -1411,7 +1432,7 @@ static Int atomic_to_term(USES_REGS1) { if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); return (FALSE); - } else if (!IsAtomicTerm(t1)) { + } else if (!IsAtomicTerm(t1)) { Yap_Error(TYPE_ERROR_ATOMIC, t1, "read_term_from_atomic/3"); return (FALSE); } else { @@ -1420,8 +1441,7 @@ static Int atomic_to_term(USES_REGS1) { len = strlen_utf8((unsigned char *)s); } encoding_t enc = ENC_ISO_UTF8; - rc = Yap_StringToTerm(s, len, &enc, - 1200, &ARG3); + rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3); if (!rc) return false; return Yap_unify(rc, ARG2); @@ -1429,12 +1449,12 @@ static Int atomic_to_term(USES_REGS1) { static Int atom_to_term(USES_REGS1) { Term t1 = Deref(ARG1), rc; - const char *s; + const char *s; size_t len; if (IsVarTerm(t1)) { Yap_Error(INSTANTIATION_ERROR, t1, "read_term_from_string/3"); return (FALSE); - } else if (!IsAtomTerm(t1)) { + } else if (!IsAtomTerm(t1)) { Yap_Error(TYPE_ERROR_ATOM, t1, "read_term_from_atomic/3"); return (FALSE); } else { @@ -1443,27 +1463,26 @@ static Int atom_to_term(USES_REGS1) { len = strlen_utf8((const unsigned char *)s); } encoding_t enc = ENC_ISO_UTF8; - rc = Yap_StringToTerm(s, len, &enc, - 1200, &ARG3); + rc = Yap_StringToTerm(s, len, &enc, 1200, &ARG3); if (!rc) return false; return Yap_unify(rc, ARG2); } /** -* @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _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 -*chars. -* @param _T_ the output term _T_, may be any term -* @param _Options_ read_term/3 options. -* -* @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and -*atom. -* Encoding is fixed in atoms and strings. -*/ + * @pred read_term_from_atomic( +_Atomic_ , - _T_ , + _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 + *chars. + * @param _T_ the output term _T_, may be any term + * @param _Options_ read_term/3 options. + * + * @notes Idea originally from SWI-Prolog, but in YAP we separate atomic and + *atom. + * Encoding is fixed in atoms and strings. + */ static Int read_term_from_atomic(USES_REGS1) { Term t1 = Deref(ARG1), rc; const unsigned char *s; @@ -1479,11 +1498,11 @@ static Int read_term_from_atomic(USES_REGS1) { s = UStringOfTerm(t); len = strlen_utf8((unsigned char *)s); } - char *ss = (char *)s; + char *ss = (char *)s; encoding_t enc = ENC_ISO_UTF8; int sno = Yap_open_buf_read_stream(ss, len, &enc, MEM_BUF_USER); - rc = Yap_read_term(sno, Deref(ARG3), 3); - Yap_CloseStream(sno); + rc = Yap_read_term(sno, Deref(ARG3), 3); + Yap_CloseStream(sno); if (!rc) return false; 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_atomic", 3, read_term_from_atomic, 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("atomic_to_term", 3, atomic_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("string_to_term", 3, string_to_term, 0); Yap_InitCPred("fileerrors", 0, fileerrors, SyncPredFlag); diff --git a/os/streams.c b/os/streams.c index 775511f62..9b817d00d 100644 --- a/os/streams.c +++ b/os/streams.c @@ -248,11 +248,12 @@ has_reposition(int sno, } char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) { + size_t maxs = max(255, max); if (!nameb) { - nameb = malloc(max(256, max)); + nameb = malloc(maxs + 1); } if (!file) { - strcpy(nameb, "memory buffer"); + strncpy(nameb, "memory buffer", maxs); return nameb; } int f = fileno(file); @@ -275,7 +276,7 @@ char *Yap_guessFileName(FILE *file, int sno, char *nameb, size_t max) { return NULL; else { int i; - unsigned char *ptr = nameb; + unsigned char *ptr = (unsigned char *)nameb; for (i = 0; i < strlen(path); i++) ptr += put_utf8(ptr, path[i]); *ptr = '\0'; diff --git a/os/sysbits.c b/os/sysbits.c index 5ea175596..e2939b453 100644 --- a/os/sysbits.c +++ b/os/sysbits.c @@ -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) { char *save_buffer = NULL; - const char *root, *source = isource; + const char *root = iroot, *source = isource; int rc = FAIL_RESTORE; int try = 0;