From 4b474574d8bd0da81e026814bae3e441cc8da63b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Fri, 13 Jul 2018 12:27:58 +0100 Subject: [PATCH] memstream --- C/text.c | 170 ++++++++++++++++++++++++++----------------------- C/write.c | 25 +------- os/fmem.c | 54 +++++++++------- os/writeterm.c | 19 ++++++ pl/boot.yap | 7 +- pl/consult.yap | 9 ++- pl/imports.yap | 2 - pl/protect.yap | 8 +-- 8 files changed, 153 insertions(+), 141 deletions(-) diff --git a/C/text.c b/C/text.c index 5f225cde7..b1b78aeb9 100644 --- a/C/text.c +++ b/C/text.c @@ -215,10 +215,7 @@ void *Yap_InitTextAllocator(void) { return new; } -static size_t MaxTmp(USES_REGS1) { - - return 1025; -} +static size_t MaxTmp(USES_REGS1) { return 1025; } static Term Globalize(Term v USES_REGS) { if (!IsVarTerm(v = Deref(v))) { @@ -231,7 +228,8 @@ static Term Globalize(Term v USES_REGS) { return v; } -static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) { +static void *codes2buf(Term t0, void *b0, bool get_codes, + bool fixed USES_REGS) { unsigned char *st0, *st, ar[16]; Term t = t0; size_t length = 0; @@ -242,13 +240,14 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) return st0; } if (!IsPairTerm(t)) { - Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes"); - return NULL; + Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes"); + return NULL; } bool codes = IsIntegerTerm(HeadOfTerm(t)); - if (get_codes !=codes && fixed) { + if (get_codes != codes && fixed) { if (codes) { - Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), "scanning list of codes"); + Yap_ThrowError(TYPE_ERROR_INTEGER, HeadOfTerm(t), + "scanning list of codes"); } else { Yap_ThrowError(TYPE_ERROR_ATOM, HeadOfTerm(t), "scanning list of atoms"); } @@ -266,7 +265,8 @@ static void *codes2buf(Term t0, void *b0, bool get_codes, bool fixed USES_REGS) } Int code = IntegerOfTerm(hd); if (code < 0) { - Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, "scanning list of character codes, found %d", code); + Yap_ThrowError(REPRESENTATION_ERROR_CHARACTER_CODE, hd, + "scanning list of character codes, found %d", code); return NULL; } length += put_utf8(ar, code); @@ -420,136 +420,146 @@ static yap_error_number gen_type_error(int flags) { // static int cnt; unsigned char *Yap_readText(seq_tv_t *inp USES_REGS) { - +#define POPRET(x) return pop_output_text_stack(lvl, x) int lvl = push_text_stack(); + char *out = NULL; + yap_error_number err0 = LOCAL_Error_TYPE; /* we know what the term is */ if (!(inp->type & (YAP_STRING_CHARS | YAP_STRING_WCHARS))) { if (!(inp->type & YAP_STRING_TERM)) { if (IsVarTerm(inp->val.t)) { LOCAL_Error_TYPE = INSTANTIATION_ERROR; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { LOCAL_Error_TYPE = TYPE_ERROR_ATOM; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { LOCAL_Error_TYPE = TYPE_ERROR_STRING; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && inp->type == (YAP_STRING_ATOMS_CODES | YAP_STRING_STRING)) { - LOCAL_ActiveError->errorRawTerm = inp->val.t; - LOCAL_Error_TYPE = TYPE_ERROR_LIST; + LOCAL_ActiveError->errorRawTerm = inp->val.t; } else if (!IsPairOrNilTerm(inp->val.t) && !IsStringTerm(inp->val.t) && !IsAtomTerm(inp->val.t) && !(inp->type & YAP_STRING_DATUM)) { LOCAL_Error_TYPE = TYPE_ERROR_TEXT; - LOCAL_ActiveError->errorRawTerm = inp->val.t; } } + if (err0 != LOCAL_Error_TYPE) { + Yap_ThrowError(LOCAL_Error_TYPE, inp->val.t, "while reading text in"); + } } if (IsAtomTerm(inp->val.t) && inp->type & YAP_STRING_ATOM) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); Atom at = AtomOfTerm(inp->val.t); if (RepAtom(at)->UStrOfAE[0] == 0) { - unsigned char *o = Malloc(4); - memset(o, 0, 4); - return pop_output_text_stack(lvl, o); + out = Malloc(4); + memset(out, 0, 4); + POPRET( out ); } if (inp->type & YAP_STRING_WITH_BUFFER) { pop_text_stack(lvl); return at->UStrOfAE; } - size_t sz = strlen(at->StrOfAE); - void *o = Malloc(sz + 1); - strcpy(o, at->StrOfAE); - return pop_output_text_stack(lvl, o); + { + size_t sz = strlen(at->StrOfAE); + out = Malloc(sz + 1); + strcpy(out, at->StrOfAE); + POPRET( out ); + } } if (IsStringTerm(inp->val.t) && inp->type & YAP_STRING_STRING) { // this is a term, extract to a buffer, and representation is wide // Yap_DebugPlWriteln(inp->val.t); const char *s = StringOfTerm(inp->val.t); if (s[0] == 0) { - char *o = Malloc(4); - memset(o, 0, 4); - return pop_output_text_stack(lvl, o); + out = Malloc(4); + memset(out, 0, 4); + POPRET( out ); + } + if (inp->type & YAP_STRING_WITH_BUFFER) { + pop_text_stack(lvl); + return (unsigned char *)UStringOfTerm(inp->val.t); + } + { + inp->type |= YAP_STRING_IN_TMP; + size_t sz = strlen(s); + out = Malloc(sz + 1); + strcpy(out, s); + POPRET( out ); + } + } else if (IsPairOrNilTerm(inp->val.t)) { + if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == + (YAP_STRING_CODES | YAP_STRING_ATOMS))) { + // Yap_DebugPlWriteln(inp->val.t); + out = (char *)Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS); + POPRET( out ); + // this is a term, extract to a sfer, and representation is wide + } + if (inp->type & YAP_STRING_CODES) { + // Yap_DebugPlWriteln(inp->val.t); + out = (char *)Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a sfer, and representation is wide + POPRET( out ); + } + if (inp->type & YAP_STRING_ATOMS) { + // Yap_DebugPlWriteln(inp->val.t); + out = (char *)Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS); + // this is a term, extract to a buffer, and representation is wide + POPRET( out ); } - if (inp->type & YAP_STRING_WITH_BUFFER) - return (unsigned char *)UStringOfTerm(inp->val.t); - inp->type |= YAP_STRING_IN_TMP; - size_t sz = strlen(s); - char *o = Malloc(sz + 1); - strcpy(o, s); - return pop_output_text_stack(lvl, o); - } - if (((inp->type & (YAP_STRING_CODES | YAP_STRING_ATOMS)) == - (YAP_STRING_CODES | YAP_STRING_ATOMS)) && - IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return pop_output_text_stack( - lvl, Yap_ListToBuffer(NULL, inp->val.t, inp PASS_REGS)); - // this is a term, extract to a sfer, and representation is wide - } - if (inp->type & YAP_STRING_CODES && IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return pop_output_text_stack( - lvl, Yap_ListOfCodesToBuffer(NULL, inp->val.t, inp PASS_REGS)); - // this is a term, extract to a sfer, and representation is wide - } - if (inp->type & YAP_STRING_ATOMS && IsPairOrNilTerm(inp->val.t)) { - // Yap_DebugPlWriteln(inp->val.t); - return pop_output_text_stack( - lvl, Yap_ListOfAtomsToBuffer(NULL, inp->val.t, inp PASS_REGS)); - // this is a term, extract to a buffer, and representation is wide } if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { // ASCII, so both LATIN1 and UTF-8 // Yap_DebugPlWriteln(inp->val.t); - char *s; - s = Malloc(2 * MaxTmp(PASS_REGS1)); - if (snprintf(s, MaxTmp(PASS_REGS1) - 1, Int_FORMAT, + out = Malloc(2 * MaxTmp(PASS_REGS1)); + if (snprintf(out, MaxTmp(PASS_REGS1) - 1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) { - AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), s, char); + AUX_ERROR(inp->val.t, 2 * MaxTmp(PASS_REGS1), out, char); } - return pop_output_text_stack(lvl, s); + POPRET( out ); } if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { - char *s; - // Yap_DebugPlWriteln(inp->val.t); - if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 1024)) { + out = Malloc(2 * MaxTmp(PASS_REGS1)); + if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &out, 1024)) { pop_text_stack(lvl); return NULL; } - return pop_output_text_stack(lvl, s); - } + POPRET(out); + } #if USE_GMP if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { // Yap_DebugPlWriteln(inp->val.t); - char *s; - s = Malloc(MaxTmp()); - if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) { - AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char); + out = Malloc(MaxTmp()); + if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), out, MaxTmp() - 1, + 10)) { + AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), out, char); } - return inp->val.uc = pop_output_text_stack(lvl, s); + POPRET(out); } #endif if (inp->type & YAP_STRING_TERM) { - // Yap_DebugPlWriteln(inp->val.t); - char *s = (char *)Yap_TermToBuffer(inp->val.t, 0); - } - if (inp->type & YAP_STRING_CHARS) { pop_text_stack(lvl); - if (inp->enc == ENC_ISO_LATIN1) { - return latin2utf8(inp); - } else if (inp->enc == ENC_ISO_ASCII) { - return inp->val.uc; - } else { // if (inp->enc == ENC_ISO_UTF8) { + return Yap_TermToBuffer(inp->val.t, 0); + } + + if (inp->type & YAP_STRING_CHARS) { + if (inp->enc == ENC_ISO_ASCII) { + pop_text_stack(lvl); return inp->val.uc; } + + if (inp->enc == ENC_ISO_LATIN1) { + POPRET( (char*)latin2utf8(inp)); + } + + if (inp->enc == ENC_ISO_UTF8) { + pop_text_stack(lvl); + return inp->val.c; + } } - pop_text_stack(lvl); if (inp->type & YAP_STRING_WCHARS) { // printf("%S\n",inp->val.w); - return wchar2utf8(inp); + POPRET( (char *)wchar2utf8(inp) ); } + pop_text_stack(lvl); return NULL; } diff --git a/C/write.c b/C/write.c index 104e5648b..9abc1af3f 100644 --- a/C/write.c +++ b/C/write.c @@ -384,9 +384,7 @@ int Yap_FormatFloat(Float f, char **s, size_t sz) { wglb.lw = separator; wglb.stream = GLOBAL_Stream + sno; wrputf(f, &wglb); - so = Yap_MemExportStreamPtr(sno); - *s = BaseMalloc(strlen(so) + 1); - strcpy(*s, so); + *s = Yap_MemExportStreamPtr(sno); Yap_CloseStream(sno); return true; } @@ -1255,24 +1253,3 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags, pop_text_stack(lvl); } -char *Yap_TermToBuffer(Term t, int flags) { - CACHE_REGS - int sno = Yap_open_buf_write_stream(LOCAL_encoding,flags); - const char *sf; - - if (sno < 0) - return NULL; - if (t == 0) - return NULL; - else - t = Deref(t); - GLOBAL_Stream[sno].encoding = LOCAL_encoding; - GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; - Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority); - - sf = Yap_MemExportStreamPtr(sno); - size_t len = strlen(sf); - char *new = realloc((void*)sf,len + 1); - Yap_CloseStream(sno); - return new; -} diff --git a/os/fmem.c b/os/fmem.c index 0257f0c6c..53f9274ca 100644 --- a/os/fmem.c +++ b/os/fmem.c @@ -203,7 +203,9 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) { return -1; st = GLOBAL_Stream + sno; - st->status = Output_Stream_f | InMemory_Stream_f | FreeOnClose_Stream_f; + st->status = Output_Stream_f | InMemory_Stream_f; + if (st->nbuf) + st->status |= FreeOnClose_Stream_f; st->linepos = 0; st->charcount = 0; st->linecount = 1; @@ -212,15 +214,15 @@ int Yap_open_buf_write_stream(encoding_t enc, memBufSource src) { st->buf.on = true; st->nbuf = NULL; st->nsize = 0; + st->status |= Seekable_Stream_f; #if HAVE_OPEN_MEMSTREAM st->file = open_memstream(&st->nbuf, &st->nsize); // setbuf(st->file, NULL); - st->status |= Seekable_Stream_f; -#else - st->file = fmemopen((void *)st->nbuf, st->nsize, "w"); if (!st->nbuf) { return -1; } +#else + st->file = fmemopen((void *)st->nbuf, st->nsize, "w+"); #endif Yap_DefaultStreamOps(st); UNLOCK(st->streamlock); @@ -257,35 +259,41 @@ open_mem_write_stream(USES_REGS1) /* $open_mem_write_stream(-Stream) */ * by other writes.. */ char *Yap_MemExportStreamPtr(int sno) { - char *s; - if (fflush(GLOBAL_Stream[sno].file) == 0) { - s = GLOBAL_Stream[sno].nbuf; - // s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0'; - return s; + + if (fflush(GLOBAL_Stream[sno].file) < 0) { + return NULL; } - return NULL; + size_t len = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END); + char *buf = malloc(len+1); +#if HAVE_OPEN_MEMSTREAM + char *s = GLOBAL_Stream[sno].nbuf; + memcpy(buf, s, len); + // s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0'; +#else + fread(buf, sz, 1, GLOBAL_Stream[sno].file); +#endif + buf[len] = '\0'; + return buf; } static Int peek_mem_write_stream( USES_REGS1) { /* '$peek_mem_write_stream'(+GLOBAL_Stream,?S0,?S) */ Int sno = Yap_CheckStream(ARG1, (Output_Stream_f | InMemory_Stream_f), "close/2"); - Int i; Term tf = ARG2; CELL *HI; - const char *ptr; + char *ptr; + int ch; if (sno < 0) return (FALSE); -restart: + char *p = ptr = Yap_MemExportStreamPtr(sno); + restart: HI = HR; - if (fflush(GLOBAL_Stream[sno].file) == 0) { - i = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END); - ptr = GLOBAL_Stream[sno].nbuf; - } - while (i > 0) { - --i; - tf = MkPairTerm(MkIntTerm(ptr[i]), tf); + while ((ch = *p++)) { + HR[0] = MkIntTerm(ch); + HR[1] = AbsPair(HR+2); + HR += 2; if (HR + 1024 >= ASP) { UNLOCK(GLOBAL_Stream[sno].streamlock); HR = HI; @@ -294,14 +302,14 @@ restart: Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage); return (FALSE); } - i = GLOBAL_Stream[sno].u.mem_string.pos; - tf = ARG2; LOCK(GLOBAL_Stream[sno].streamlock); goto restart; } } + HR[-1] = tf; UNLOCK(GLOBAL_Stream[sno].streamlock); - return (Yap_unify(ARG3, tf)); + free(ptr); + return (Yap_unify(ARG3, AbsPair(HI))); } void Yap_MemOps(StreamDesc *st) { diff --git a/os/writeterm.c b/os/writeterm.c index 02f177327..c4586f8ec 100644 --- a/os/writeterm.c +++ b/os/writeterm.c @@ -711,6 +711,25 @@ static Int term_to_atom(USES_REGS1) { Yap_unify(rc, ARG1); } +char *Yap_TermToBuffer(Term t, int flags) { + CACHE_REGS + int sno = Yap_open_buf_write_stream(LOCAL_encoding,flags); + + if (sno < 0) + return NULL; + if (t == 0) + return NULL; + else + t = Deref(t); + GLOBAL_Stream[sno].encoding = LOCAL_encoding; + GLOBAL_Stream[sno].status |= CloseOnException_Stream_f; + Yap_plwrite(t, GLOBAL_Stream + sno, 0, flags, GLOBAL_MaxPriority); + + char *new = Yap_MemExportStreamPtr(sno); + Yap_CloseStream(sno); + return new; +} + void Yap_InitWriteTPreds(void) { Yap_InitCPred("write_term", 2, write_term2, SyncPredFlag); Yap_InitCPred("write_term", 3, write_term3, SyncPredFlag); diff --git a/pl/boot.yap b/pl/boot.yap index 94ebc41d8..fd3f6c71a 100644 --- a/pl/boot.yap +++ b/pl/boot.yap @@ -262,6 +262,7 @@ initialize_prolog :- :- c_compile( 'preds.yap' ). :- c_compile( 'modules.yap' ). :- c_compile( 'grammar.yap' ). +:- c_compile( 'protect.yap' ). :- ['absf.yap']. @@ -314,11 +315,7 @@ initialize_prolog :- :- multifile prolog:'$system_predicate'/2. -:- ['protect.yap']. - -version(yap,[6,4]). - -:- op(1150,fx,(mode)). +:- '$opdec'(1150,fx,(mode),prolog). :- dynamic 'extensions_to_present_answer'/1. diff --git a/pl/consult.yap b/pl/consult.yap index 9a7dcf8b5..288ef2505 100644 --- a/pl/consult.yap +++ b/pl/consult.yap @@ -274,11 +274,14 @@ load_files(_Files,_Opts). setarg( Id, TOpts, Val ). '$load_files'(Files, Opts, Call) :- - ( '__NB_getval__'('$lf_status', OldTOpts, fail), nonvar(OldTOpts) - '$lf_opt'(autoload, OldTOpts, OldAutoload) +( + '__NB_getval__'('$lf_status', OldTOpts, fail) + -> + '$lf_opt'('$context_module', OldTOpts, Context), + '$lf_opt'(autoload, OldTOpts, OldAutoload) ; '$lf_option'(last_opt, LastOpt), - functor( OldTOpts, opt, LastOpt ), - '$lf_opt'('$context_module', OldTOpts, user) + functor( OldTOpts, opt, LastOpt ) ), '$lf_option'(last_opt, LastOpt), functor( TOpts, opt, LastOpt ), diff --git a/pl/imports.yap b/pl/imports.yap index 2fffed2da..665f4f675 100644 --- a/pl/imports.yap +++ b/pl/imports.yap @@ -27,7 +27,6 @@ '$pred_exists'(G, user). % autoload '$get_undefined_predicates'(G, ImportingMod, G0, ExportingMod) :- - recorded('$dialect',swi,_), prolog_flag(autoload, true), prolog_flag(unknown, OldUnk, fail), ( @@ -67,4 +66,3 @@ * * @} */ - diff --git a/pl/protect.yap b/pl/protect.yap index 23f8a6a8f..7d9bc46dd 100755 --- a/pl/protect.yap +++ b/pl/protect.yap @@ -36,12 +36,12 @@ */ -'$protect' :- +prolog:'$protect' :- '$all_current_modules'(M), ( sub_atom(M,0,1,_, '$') ; M= prolog; M= system ), new_system_module( M ), fail. -'$protect' :- +prolog:'$protect' :- '$current_predicate'(Name,M,P,_), '$is_system_module'(M), functor(P,Name,Arity), @@ -50,13 +50,13 @@ functor(P,Name,Arity), '$hide_predicate'(P,M), fail. -'$protect' :- +prolog:'$protect' :- current_atom(Name), sub_atom(Name,0,1,_, '$'), \+ '$visible'(Name), hide_atom(Name), fail. -'$protect'. +prolog:'$protect'. % hide all atoms who start by '$'