memstream

C/text.c

@@ -215,10 +215,7 @@ void *Yap_InitTextAllocator(void) {
   return new;
 }
 
-static size_t MaxTmp(USES_REGS1) {
+static size_t MaxTmp(USES_REGS1) { return 1025; }
-
-  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");
+    Yap_ThrowError(TYPE_ERROR_LIST, t, "scanning list of codes");
-        return NULL;
+    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_ActiveError->errorRawTerm = inp->val.t;
-        LOCAL_Error_TYPE = TYPE_ERROR_LIST;
       } 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);
+      out = Malloc(4);
-      memset(o, 0, 4);
+      memset(out, 0, 4);
-      return pop_output_text_stack(lvl, o);
+      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);
+      size_t sz = strlen(at->StrOfAE);
-    strcpy(o, at->StrOfAE);
+      out = Malloc(sz + 1);
-    return pop_output_text_stack(lvl, o);
+      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);
+      out = Malloc(4);
-      memset(o, 0, 4);
+      memset(out, 0, 4);
-      return pop_output_text_stack(lvl, o);
+      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;
+    out = Malloc(2 * MaxTmp(PASS_REGS1));
-    s = Malloc(2 * MaxTmp(PASS_REGS1));
+    if (snprintf(out, MaxTmp(PASS_REGS1) - 1, Int_FORMAT,
-    if (snprintf(s, 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;
+    out = Malloc(2 * MaxTmp(PASS_REGS1));
-    // Yap_DebugPlWriteln(inp->val.t);
+    if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &out, 1024)) {
-    if (!Yap_FormatFloat(FloatOfTerm(inp->val.t), &s, 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;
+    out = Malloc(MaxTmp());
-    s = Malloc(MaxTmp());
+    if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), out, MaxTmp() - 1,
-    if (!Yap_mpz_to_string(Yap_BigIntOfTerm(inp->val.t), s, MaxTmp() - 1, 10)) {
+                           10)) {
-      AUX_ERROR(inp->val.t, MaxTmp(PASS_REGS1), s, char);
+      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 Yap_TermToBuffer(inp->val.t, 0);
-      return latin2utf8(inp);
+  }
-    } else if (inp->enc == ENC_ISO_ASCII) {
+
-      return inp->val.uc;
+  if (inp->type & YAP_STRING_CHARS) { 
-    } else { // if (inp->enc == ENC_ISO_UTF8) {
+    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;
 }
 

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 = Yap_MemExportStreamPtr(sno);
-  *s = BaseMalloc(strlen(so) + 1);
-  strcpy(*s, so);
   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;
-}

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) {
+  if (fflush(GLOBAL_Stream[sno].file) < 0) {
-    s = GLOBAL_Stream[sno].nbuf;
+    return NULL;
-    // s[fseek(GLOBAL_Stream[sno].file, 0, SEEK_END)] = '\0';
-    return s;
   }
-  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) {
+  while ((ch = *p++)) {
-    i = fseek(GLOBAL_Stream[sno].file, 0, SEEK_END);
+    HR[0] = MkIntTerm(ch);
-    ptr = GLOBAL_Stream[sno].nbuf;
+    HR[1] = AbsPair(HR+2);
-  }
+    HR += 2;
-  while (i > 0) {
-    --i;
-    tf = MkPairTerm(MkIntTerm(ptr[i]), tf);
     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) {

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);

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'].
+:- '$opdec'(1150,fx,(mode),prolog).
-
-version(yap,[6,4]).
-
-:- op(1150,fx,(mode)).
 
 :- dynamic 'extensions_to_present_answer'/1.
 

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 ),
+	    functor( OldTOpts, opt, LastOpt )
-	    '$lf_opt'('$context_module', OldTOpts, user)
 	),
  	'$lf_option'(last_opt, LastOpt),
 	functor( TOpts, opt, LastOpt ),

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 @@
 	 *
 	 * @}
 	 */
-

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 '$'