yap-6.3/os/format.c

/*************************************************************************
 *									 *
 *	 YAP Prolog 							 *
 *									 *
 *	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
 *									 *
 * Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
 *									 *
 **************************************************************************
 *									 *
 * File:		charcodes.c						 *
 * Last rev:	5/2/88							 *
 * mods:									 *
 * comments:	Character codes and character conversion		 *
 *									 *
 *************************************************************************/
#ifdef SCCS
static char SccsId[] = "%W% %G%";
#endif

/*
 * This file includes the definition of a pipe related IO.
 *
 */

#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "yapio.h"
#include "YapText.h"
#include <stdlib.h>
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifdef _WIN32
#if HAVE_IO_H
/* Windows */
#include <io.h>
#endif
#if HAVE_SOCKET
#include <winsock2.h>
#endif
#include <windows.h>
#ifndef S_ISDIR
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif
#endif
#include "iopreds.h"
#include "eval.h"


#define FORMAT_MAX_SIZE 256

typedef struct {
  Int len, start;                   /* tab point */
  Int filler;                /* character to dump */
  char *pad;                  /* ok, it's not standard english */
} pads;

typedef struct format_status {
  char *mem; // direct access to stream fields
  int format_error;
  pads pad_entries[16];
  int padders;
} format_info;

static int
fill(int sno, int n, wchar_t nch)
{
  int (* f_putc)(int, wchar_t);
  f_putc = GLOBAL_Stream[sno].stream_wputc;
  while (n--)
    f_putc(sno, nch);
  return nch;
}

static int
f_puts(int sno, char *s, int n)
{
  int (* f_putc)(int, wchar_t);
  f_putc = GLOBAL_Stream[sno].stream_wputc;
  while (n--)
    f_putc(sno, *s++);
  return *s;
}


// uses directly the buffer in the memory stream.
static bool fill_pads(int sno, int nchars, format_info *fg USES_REGS)
{
  int nfillers, fill_space, lfill_space;

  if (nchars < 0) nchars = 0; /* ignore */
  nfillers =fg->padders;
  if (fg->padders == 0) {
    return fill( sno, nchars, ' ' );
  }
  fill_space = nchars/nfillers;
  lfill_space = nchars%nfillers;

  pads *padi = fg->pad_entries;

  while (fg->padders--) {
    if (!fg->padders)
      fill_space += lfill_space;
    // give remainder to last block.
    fill( sno, fill_space, padi->filler);
    if (padi->pad) {
      f_puts( sno,  padi->pad, padi->len);
      free(padi->pad);
      padi->pad = NULL;
    }
    padi++;
  }
  return true;
}

static int
format_print_str (Int sno, Int size, Int has_size, Term args, int (* f_putc)(int, wchar_t))
{
  Term arghd;
  while (!has_size || size > 0) {
    if (IsVarTerm(args)) {
      Yap_Error(INSTANTIATION_ERROR, args, "format/2");
      return FALSE;
    } else if (args == TermNil) {
      return TRUE;
    }
    else if (!IsPairTerm (args)) {
      Yap_Error(TYPE_ERROR_LIST, args, "format/2");
      return FALSE;
    }
    arghd = HeadOfTerm (args);
    args = TailOfTerm (args);
    if (IsVarTerm(arghd)) {
      Yap_Error(INSTANTIATION_ERROR, arghd, "format/2");
      return FALSE;
    } else if (!IsIntTerm (arghd)) {
      Yap_Error(TYPE_ERROR_LIST, arghd, "format/2");
      return FALSE;
    }
    f_putc(sno, (int) IntOfTerm (arghd));
    size--;
  }
  return TRUE;
}

typedef enum {
  fst_ok,
  fst_error,
  fst_too_long
} format_cp_res;

static format_cp_res
copy_format_string(Term inp, char *out, int max)
{
  int i = 0;
  while (inp != TermNil) {
    Term hd;
    int ch;

    if (IsVarTerm(inp)) {
      Yap_Error(INSTANTIATION_ERROR,inp,"format/2");
      return fst_error;
    }
    if (!IsPairTerm(inp)) {
      Yap_Error(TYPE_ERROR_LIST,inp,"format/2");
      return fst_error;
    }
    hd = HeadOfTerm(inp);
    if (IsVarTerm(hd)) {
      Yap_Error(INSTANTIATION_ERROR,hd,"format/2");
      return fst_error;
    }
    if (!IsIntTerm(hd)) {
      Yap_Error(TYPE_ERROR_INTEGER,hd,"format/2");
      return fst_error;
    }
    ch = IntOfTerm(hd);
    if (ch < 0) {
      Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,hd,"format/2");
      return fst_error;
    }
    if (i+1 == max) {
      return fst_too_long;
    }
    /* we've got a character */
    out[i++] = ch;
    /* done */
    inp = TailOfTerm(inp);
  }
  out[i] = '\0';
  return fst_ok;
}

#define FORMAT_COPY_ARGS_ERROR    -1
#define FORMAT_COPY_ARGS_OVERFLOW -2

static Int
format_copy_args(Term args, Term *targs, Int tsz)
{
  Int n = 0;
  while (args != TermNil) {
    if (IsVarTerm(args)) {
      Yap_Error(INSTANTIATION_ERROR,args,"format/2");
      return FORMAT_COPY_ARGS_ERROR;
    }
    if (!IsPairTerm(args)) {
      Yap_Error(TYPE_ERROR_LIST,args,"format/2");
      return FORMAT_COPY_ARGS_ERROR;
    }
    if (n == tsz)
      return FORMAT_COPY_ARGS_OVERFLOW;
    targs[n] = HeadOfTerm(args);
    args = TailOfTerm(args);
    n++;
  }
  return n;

}

static void

format_clean_up( int sno, const char *fstr, Term *targs)
{
  if (fstr)
    Yap_FreeAtomSpace((void  *)fstr);
  if (targs)
    Yap_FreeAtomSpace((char *)targs);
}

static Int
fetch_index_from_args(Term t)
{
  Int i;

  if (IsVarTerm(t))
    return -1;
  if (!IsIntegerTerm(t))
    return -1;
  i = IntegerOfTerm(t);
  if (i < 0)
    return -1;
  return i;
}


static wchar_t
base_dig(Int dig, Int ch)
{
  if (dig < 10)
    return dig+'0';
  else if (ch == 'r')
    return (dig-10)+'a';
  else /* ch == 'R' */
    return (dig-10)+'A';
}

#define TMP_STRING_SIZE 1024

static Int
doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
{
  char tmp1[TMP_STRING_SIZE], *tmpbase;
  int ch;
  int column_boundary;
  Term mytargs[8], *targs;
  Int tnum, targ;
  const char *fstr = NULL, *fptr;
  Term args;
  Term tail;
  int (* f_putc)(int, wchar_t);
  int osno = 0;
  jmp_buf format_botch;
  volatile void *old_handler;
  volatile int old_pos;
  format_info finfo;
  char *bufp;
  Term fmod = CurrentModule;
  size_t sz;


  LOCAL_FormatInfo = &finfo;
  finfo.padders = 0;
  finfo.format_error = FALSE;
  if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
    old_handler = GLOBAL_Stream[sno].u.mem_string.error_handler;
    GLOBAL_Stream[sno].u.mem_string.error_handler = (void *)&format_botch;
    old_pos = GLOBAL_Stream[sno].u.mem_string.pos;
    /* set up an error handler */
    if (setjmp(format_botch)) {
      restore_machine_regs();
      *HR++ = oargs;
      *HR++ = otail;
      if (!Yap_growheap(FALSE, LOCAL_Error_Size, NULL)) {
	Yap_Error(OUT_OF_HEAP_ERROR,otail,"format/2");
	return FALSE;
      }
      oargs = HR[-2];
      otail = HR[-1];
      GLOBAL_Stream[sno].u.mem_string.pos = old_pos;
      HR -= 2;
    }
  } else {
    old_handler = NULL;
  }
  args = oargs;
  tail = otail;
  targ = 0;
  column_boundary = 0;
  if (IsVarTerm(tail)) {
    Yap_Error(INSTANTIATION_ERROR,tail,"format/2");
    return(FALSE);
  } else if (IsPairTerm (tail)) {
    int sz = 256;
    do {
      format_cp_res fr;
      char *fstr0;
      

      fstr = fptr = fstr0 = Yap_AllocAtomSpace(sz*sizeof(char));
      if ((fr = copy_format_string(tail, fstr0, sz)) == fst_ok)
	break;
      if (fr == fst_error) return FALSE;
      sz += 256;
      Yap_FreeCodeSpace(fstr0);
    } while (TRUE);
  } else if (IsAtomTerm(tail)) {
    fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE;
  } else if (IsStringTerm(tail)) {
    fstr = fptr = StringOfTerm(tail);
  } else {
    Yap_Error(CONSISTENCY_ERROR, tail, "format/2");
    return FALSE;
  }
  if (IsVarTerm(args)) {
    Yap_Error(INSTANTIATION_ERROR, args, "format/2");
    return FALSE;
  }
  while (IsApplTerm(args) && FunctorOfTerm(args) == FunctorModule) {
    fmod = ArgOfTerm(1,args);
    args = ArgOfTerm(2,args);
    if (IsVarTerm(fmod)) {
      Yap_Error(INSTANTIATION_ERROR, fmod, "format/2");
      return FALSE;
    }
    if (!IsAtomTerm(fmod)) {
      Yap_Error(TYPE_ERROR_ATOM, fmod, "format/2");
      return FALSE;
    }
    if (IsVarTerm(args)) {
      Yap_Error(INSTANTIATION_ERROR, args, "format/2");
      return FALSE;
    }
  }
  if (IsPairTerm(args)) {
    Int tsz = 8;

    targs = mytargs;
    do {
      tnum = format_copy_args(args, targs, tsz);
      if (tnum == FORMAT_COPY_ARGS_ERROR)
	return FALSE;
      else if (tnum == FORMAT_COPY_ARGS_OVERFLOW) {
	if (mytargs != targs) {
	  Yap_FreeCodeSpace((char *)targs);
	}
	tsz += 16;
	targs = (Term *)Yap_AllocAtomSpace(tsz*sizeof(Term));
      } else {
	break;
      }
    } while (TRUE);
  } else if (args != TermNil) {
    tnum = 1;
    mytargs[0] = args;
    targs = mytargs;
  } else {
    tnum = 0;
    targs = mytargs;
  }
  finfo.format_error = FALSE;

  f_putc = GLOBAL_Stream[sno].stream_wputc;
  while ((ch = *fptr++)) {
    Term t = TermNil;
    int has_repeats = FALSE;
    int repeats = 0;

    if (ch == '~') {
      /* start command */
      ch = *fptr++;
      if (ch == '*') {
	ch = *fptr++;
	has_repeats = TRUE;
	if (targ > tnum-1) {
	  goto do_consistency_error;
	}
	repeats = fetch_index_from_args(targs[targ++]);
	if (repeats == -1)
	  goto do_consistency_error;
      } else if (ch == '`') {
	/* next character is kept as code */
	has_repeats = TRUE;
	repeats = *fptr++;
	ch = *fptr++;
      } else if (ch >= '0' && ch <= '9') {
	has_repeats = TRUE;
	repeats = 0;
	while (ch >= '0' && ch <= '9') {
	  repeats = repeats*10+(ch-'0');
	  ch = *fptr++;
	}
      }
      switch (ch) {
      case 'a':
	/* print an atom */
	if (has_repeats || targ > tnum-1)
	  goto do_consistency_error;
	t = targs[targ++];
	if (IsVarTerm(t))
	  goto do_instantiation_error;
	if (!IsAtomTerm(t))
	  goto do_type_atom_error;
	yhandle_t sl = Yap_StartSlots();
          // stream is already locked.
	Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200);
	Yap_CloseSlots(sl);
	LOCAL_FormatInfo = &finfo;
	break;
      case 'c':
	{
	  Int nch, i;

	  if (targ > tnum-1)
	    goto do_consistency_error;
	  t = targs[targ++];
	  if (IsVarTerm(t))
	    goto do_instantiation_error;
	  if (!IsIntegerTerm(t))
	    goto do_type_int_error;
	  nch = IntegerOfTerm(t);
	  if (nch < 0)
	    goto do_domain_not_less_zero_error;
	  if (!has_repeats)
	    repeats = 1;
	  for (i = 0; i < repeats; i++)
	    f_putc(sno, nch);
	  break;
	}
      case 'e':
      case 'E':
      case 'f':
      case 'g':
      case 'G':
	{
	  Float fl;
	  char *ptr;

	  if (targ > tnum-1)
	    goto do_consistency_error;
	  t = targs[targ++];
	  if (IsVarTerm(t))
	    goto do_instantiation_error;
	  if (!IsNumTerm(t))
	    goto do_type_number_error;
	  if (IsIntegerTerm(t)) {
	    fl = (Float)IntegerOfTerm(t);
#ifdef HAVE_GMP
	  } else if (IsBigIntTerm(t)) {
	    fl = Yap_gmp_to_float(t);
#endif
	  } else {
	    fl = FloatOfTerm(t);
	  }
	  if (!has_repeats)
	    repeats = 6;
	  tmp1[0] = '%';
	  tmp1[1] = '.';
	  ptr = tmp1+2;
#if HAVE_SNPRINTF
	  snprintf(ptr,256-5,"%d",repeats);
#else
	  sprintf(ptr,"%d",repeats);
#endif
	  while (*ptr) ptr++;
	  ptr[0] = ch;
	  ptr[1] = '\0';
	  {
	    char *tmp2;
	    if (!(tmp2 = Yap_AllocCodeSpace(repeats+10)))
	      goto do_type_int_error;
#if HAVE_SNPRINTF
	    snprintf (tmp2, repeats+10, tmp1, fl);
#else
	    sprintf (tmp2, tmp1, fl);
#endif
	    ptr = tmp2;
	    while ((ch = *ptr++) != 0)
	      f_putc(sno, ch);
	    Yap_FreeCodeSpace(tmp2);
	  }
	  break;
	case 'd':
	case 'D':
	  /* print a decimal, using weird . stuff */
	  if (targ > tnum-1)
	    goto do_consistency_error;
	  t = targs[targ++];
	  if (IsVarTerm(t))
	    goto do_instantiation_error;
	  if (!IsIntegerTerm(t)
#ifdef HAVE_GMP
	      && !IsBigIntTerm(t)
#endif

	      )
	    goto do_type_int_error;

	  {
	    Int siz = 0;
	    char *ptr = tmp1;
	    tmpbase = tmp1;

	    if (IsIntegerTerm(t)) {
	      Int il = IntegerOfTerm(t);
#if HAVE_SNPRINTF
	      snprintf(tmp1, 256, "%ld", (long int)il);
#else
	      sprintf(tmp1, "%ld", (long int)il);
#endif
	      siz = strlen(tmp1);
	      if (il < 0)  siz--;
#ifdef HAVE_GMP
	    } else if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
	      char *res;

	      tmpbase = tmp1;

	      while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, 10))) {
		if (tmpbase == tmp1) {
		  tmpbase = NULL;
		} else {
		  tmpbase = res;
		  goto do_type_int_error;
		}
	      }
	      tmpbase = res;
	      ptr = tmpbase;
#endif
	      siz = strlen(tmpbase);
	    } else {
	      goto do_type_int_error;
	    }

	    if (tmpbase[0] == '-') {
	      f_putc(sno, (int) '-');
	      ptr++;
	    }
	    if (ch == 'D') {
	      int first = TRUE;

	      while (siz > repeats) {
		if ((siz-repeats) % 3 == 0 &&
		    !first) {
		  f_putc(sno, (int) ',');
		}
		f_putc(sno, (int) (*ptr++));
		first = FALSE;
		siz--;
	      }
	    } else {
	      while (siz > repeats) {
		f_putc(sno, (int) (*ptr++));
		siz--;
	      }
	    }
	    if (repeats) {
	      if (ptr == tmpbase ||
		  ptr[-1] == '-') {
		f_putc(sno, (int) '0');
	      }
	      f_putc(sno, (int) '.');
	      while (repeats > siz) {
		f_putc(sno, (int) '0');
		repeats--;
	      }
	      while (repeats) {
		f_putc(sno, (int) (*ptr++));
		repeats--;
	      }
	    }
	    if (tmpbase != tmp1)
	      free(tmpbase);
	    break;
	  case 'r':
	  case 'R':
	    {
	      Int numb, radix;
	      UInt divfactor = 1, size = 1, i;
	      wchar_t och;

	      /* print a decimal, using weird . stuff */
	      if (targ > tnum-1)
		goto do_consistency_error;
	      t = targs[targ++];
	      if (IsVarTerm(t))
		goto do_instantiation_error;
	      if (!has_repeats)
		radix = 8;
	      else
		radix = repeats;
	      if (radix > 36 || radix < 2)
		goto do_domain_error_radix;
#ifdef HAVE_GMP
	      if (IsBigIntTerm(t) && RepAppl(t)[1] == BIG_INT) {
		char *pt, *res;

		tmpbase = tmp1;
		while (!(res = Yap_gmp_to_string(t, tmpbase, TMP_STRING_SIZE, radix))) {
		  if (tmpbase == tmp1) {
		    tmpbase = NULL;
		  } else {
		    tmpbase = res;
		    goto do_type_int_error;
		  }
		}
		tmpbase = res;
		pt = tmpbase;
		while ((ch = *pt++))
		  f_putc(sno, ch);
		if (tmpbase != tmp1)
		  free(tmpbase);
		break;
	      }
#endif
	      if (!IsIntegerTerm(t))
		goto do_type_int_error;
	      numb = IntegerOfTerm(t);
	      if (numb < 0) {
		numb = -numb;
		f_putc(sno, (int) '-');
	      }
	      while (numb/divfactor >= radix) {
		divfactor *= radix;
		size++;
	      }
	      for (i = 1; i < size; i++) {
		Int dig = numb/divfactor;
		och = base_dig(dig, ch);
		f_putc(sno, och);
		numb %= divfactor;
		divfactor /= radix;
	      }
	      och = base_dig(numb, ch);
	      f_putc(sno, och);
	      break;
	    }
	  case 's':
	    if (targ > tnum-1)
	      goto do_consistency_error;
	    t = targs[targ++];
	    if (IsVarTerm(t))
	      goto do_instantiation_error;
	    if (IsStringTerm(t)) {
	      if (has_repeats)
		goto do_consistency_error;
	      const char *pt = StringOfTerm(t);
	      while(*pt) {
		int ch;
		pt = utf8_get_char(pt, &ch);
		f_putc(sno, ch);	
	      }
	    } else if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
	      goto do_default_error;
	    }
	    break;
	  case 'i':
	    if (targ > tnum-1 || has_repeats)
	      goto do_consistency_error;
	    targ++;
	    break;
	  case 'k':
	    if (targ > tnum-1 || has_repeats)
	      goto do_consistency_error;
	    t = targs[targ++];
	    yhandle_t sl = Yap_StartSlots();
	    Yap_plwrite (t, GLOBAL_Stream+sno,0,  Quote_illegal_f|Ignore_ops_f|To_heap_f , 1200);
	    Yap_CloseSlots(sl);
	    LOCAL_FormatInfo = &finfo;
	    break;
	  case '@':
	    t = targs[targ++];
	    {
	      yhandle_t sl0 = Yap_StartSlots();
	      Int sl = Yap_InitSlot(args);
	      Int sl2;
	      Int res;
	      Term ta[2];
	      Term ts;

	      ta[0] = fmod;
	      ta[1] = t;
	      ta[0] = Yap_MkApplTerm(FunctorModule, 2, ta);
	      ta[1] = MkVarTerm();
	      sl2 = Yap_InitSlot(ta[1]);
	      ts = Yap_MkApplTerm(FunctorGFormatAt, 2, ta);
	      res = Yap_execute_goal(ts, 0, CurrentModule, true);
	      LOCAL_FormatInfo = &finfo;
	      args = Yap_GetFromSlot(sl);
	      if (EX) goto ex_handler;
	      if (!res) return FALSE;
	      ts = Yap_GetFromSlot(sl2);
	      Yap_CloseSlots(sl0);
	      if (!format_print_str (sno, repeats, has_repeats, ts, f_putc)) {
		goto do_default_error;
	      }
	    }
	    break;
	  case 'p':
	    if (targ > tnum-1 || has_repeats)
	      goto do_consistency_error;
	    t = targs[targ++];
	    {
	      Int sl = Yap_InitSlot(args);
	      Yap_plwrite(t, GLOBAL_Stream+sno, 0, Handle_vars_f|Use_portray_f|To_heap_f, 1200);
	      LOCAL_FormatInfo = &finfo;
	      args = Yap_GetFromSlot(sl);
	      Yap_CloseSlots(sl);
	    }
	    if (EX != 0L) {
	      Term ball;

	    ex_handler:
	      ball = Yap_PopTermFromDB(EX);
	      EX = NULL;
	      if (tnum <= 8)
		targs = NULL;
	      if (IsAtomTerm(tail)) {
		fstr = NULL;
	      }
	      if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
		GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
	      }
	      format_clean_up( sno, fstr, targs);
	      Yap_JumpToEnv(ball);
	      return FALSE;
	    }
	    break;
	  case 'q':
	    if (targ > tnum-1 || has_repeats)
	      goto do_consistency_error;
	    t = targs[targ++];
	    yhandle_t sl0 = Yap_StartSlots();
	    Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|Quote_illegal_f|To_heap_f, 1200);
	    Yap_CloseSlots(sl0);
	    LOCAL_FormatInfo = &finfo;
	    break;
	  case 'w':
	    if (targ > tnum-1 || has_repeats)
	      goto do_consistency_error;
	    t = targs[targ++];
	    yhandle_t slf = Yap_StartSlots();
	    Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200);
	    Yap_CloseSlots(slf);
	    LOCAL_FormatInfo = &finfo;
	    break;
	  case '~':
	    if (has_repeats)
	      goto do_consistency_error;
	    f_putc(sno, (int) '~');
	    break;
	  case 'n':
	    if (!has_repeats)
	      repeats = 1;
	    while (repeats--) {
	      f_putc(sno, (int) '\n');
	    }
	    column_boundary = 0;
	    finfo.padders = 0;
	    break;
	  case 'N':
	    if (!has_repeats)
	      has_repeats = 1;
	    if (GLOBAL_Stream[sno].linepos != 0) {
	      f_putc(sno, '\n');
	      column_boundary = 0;
	      finfo.padders = 0;
	    }
	    if (repeats > 1) {
	      Int i;
	      for (i = 1; i < repeats; i++)
		f_putc(sno, '\n');
	      column_boundary = 0;
	      finfo.padders = 0;
	    }
	    break;
	    /* padding */
	  case '|':
	    if (osno) {
	      Yap_CloseStream(sno);
	      sno = osno;
	      osno = 0;
	    }
	    repeats -= GLOBAL_Stream[sno].linepos;
	    repeats = (repeats < 0 ? 0 : repeats);
	    fill_pads( sno, repeats, &finfo PASS_REGS);
	    break;
	  case '+':
	    if (osno) {
	      Yap_CloseStream(sno);
	      sno = osno;
	      osno = 0;
	    }
	    repeats = (repeats < 0 ? 0 : repeats);
	    fill_pads( sno, repeats, &finfo PASS_REGS);
	  break;
	case 't':
	  {
	    int nsno;

	    finfo.pad_entries[finfo.padders].len = sz;
	    finfo.pad_entries[finfo.padders].pad = bufp;
	    bufp = NULL;
	    sz = 0;
	    nsno = Yap_open_buf_write_stream(bufp, sz, GLOBAL_Stream[sno].encoding, 0);
	    if (osno) {
	      GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos;
	      GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount;
	      GLOBAL_Stream[nsno].charcount = GLOBAL_Stream[sno].charcount;
	      Yap_CloseStream(sno);
	    } else {
	      osno = sno;
	      GLOBAL_Stream[nsno].linepos = GLOBAL_Stream[sno].linepos;
	      GLOBAL_Stream[nsno].linecount = GLOBAL_Stream[sno].linecount;
	      GLOBAL_Stream[nsno].charcount = GLOBAL_Stream[sno].charcount;
	    }
	    sno = nsno;
	    finfo.padders++;
	    finfo.pad_entries[finfo.padders].start = GLOBAL_Stream[sno].linepos;
	    if (!has_repeats)
	      finfo.pad_entries[finfo.padders].filler = ' ';
	    else
	      finfo.pad_entries[finfo.padders].filler = fptr[-2];
	  }
	  break;
	  do_instantiation_error:
					       LOCAL_Error_TYPE = INSTANTIATION_ERROR;
					       goto do_default_error;
	  do_type_int_error:
					       LOCAL_Error_TYPE = TYPE_ERROR_INTEGER;
					       goto do_default_error;
	  do_type_number_error:
					       LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
					       goto do_default_error;
	  do_type_atom_error:
					       LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
					       goto do_default_error;
	  do_domain_not_less_zero_error:
					       LOCAL_Error_TYPE = DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
					       goto do_default_error;
	  do_domain_error_radix:
					       LOCAL_Error_TYPE = DOMAIN_ERROR_RADIX;
					       goto do_default_error;
	  do_consistency_error:
	  default:
					       LOCAL_Error_TYPE = CONSISTENCY_ERROR;
	  do_default_error:
					       if (tnum <= 8)
						 targs = NULL;
					       if (IsAtomTerm(tail)) {
						 fstr = NULL;
					       }
					       {
						 Term ta[2];
						 ta[0] = otail;
						 ta[1] = oargs;
						 Yap_Error(LOCAL_Error_TYPE, Yap_MkApplTerm(Yap_MkFunctor(AtomFormat,2),2,ta), "format/2");
					       }
					       if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
						 GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
					       }
					       format_clean_up( sno, fstr, targs);
					       LOCAL_Error_TYPE = YAP_NO_ERROR;
					       return FALSE;
					       }
	}
	/* ok, now we should have a command */
      }
    } else {
      f_putc(sno, ch);
    }
  }
  if (finfo.padders) {
    if (osno) {
      Yap_CloseStream(sno);
      sno = osno;
    }
    //    fill_pads( sno, 0, &finfo);
  }
  if (IsAtomTerm(tail) || IsStringTerm(tail))  {
    fstr = NULL;
  }
  if (tnum <= 8)
    targs = NULL;
  if (GLOBAL_Stream[sno].status & InMemory_Stream_f) {
    GLOBAL_Stream[sno].u.mem_string.error_handler = old_handler;
  }
  format_clean_up( sno, fstr, targs);
  return (TRUE);
}

/*
 * @pred with_output_to( + _Stream_ , 0:_Goal )
 *
 * Evaluate goal _Goal, such that the output will be sent to _Stream_.
 *
 * As in format/3, we shall have the special streams `chars`/1, `codes/`  and symbtw
 *
 */
static Int
with_output_to( USES_REGS1 )
{
  int old_out = LOCAL_c_output_stream;
  int output_stream;
  Term tin = Deref(ARG1);
  Functor f;
  bool out;
  bool mem_stream = false;
if (IsVarTerm(tin)) {
  Yap_Error(INSTANTIATION_ERROR,tin,"with_output_to/3");
  return false;
}
  if (IsApplTerm(tin) &&
      (f = FunctorOfTerm(tin)) &&
      (f == FunctorAtom || f == FunctorString ||
       f == FunctorCodes1 || f == FunctorCodes ||
       f == FunctorChars1 || f == FunctorChars) )
  {
    output_stream = Yap_OpenBufWriteStream( PASS_REGS1);
  } else {
    /* needs to change LOCAL_c_output_stream for write */
    output_stream = Yap_CheckStream (ARG1, Output_Stream_f, "format/3");
  }
  if (output_stream == -1) {
    return false;
  }
  UNLOCK(GLOBAL_Stream[output_stream].streamlock);
  out = Yap_Execute( Deref(ARG2) PASS_REGS);
  LOCK(GLOBAL_Stream[output_stream].streamlock);
  LOCAL_c_output_stream = old_out;
  if (mem_stream) {
    Term tat;
    Term inp = Deref(ARG1);
    if (out) {
      char *s = GLOBAL_Stream[output_stream].nbuf;
      s[GLOBAL_Stream[output_stream].nsize] = '\0';
      if (f == FunctorAtom) {
        tat =  MkAtomTerm(Yap_LookupAtom(s));
      } else if (f == FunctorCodes) {
        tat = Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2,inp) PASS_REGS);
      } else if (f == FunctorCodes1) {
        tat = Yap_CharsToListOfCodes(s PASS_REGS);
      } else if (f == FunctorChars) {
        tat = Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2,inp) PASS_REGS);
      } else if (f == FunctorChars1) {
        tat = Yap_CharsToListOfAtoms(s PASS_REGS);
      } else if (f == FunctorString1) {
        tat = MkStringTerm(s);
      } else {
        return false;
      }
      out = Yap_unify(tat,ArgOfTerm(1,inp));
    }
  }
  return out;
}

static Int
format(Term tout, Term tf, Term tas USES_REGS)
{
  bool mem_stream = false;
  int output_stream;
  Functor f;
  Int out;

  if (IsVarTerm(tout)) {
    Yap_Error(INSTANTIATION_ERROR,tout,"format/3");
    return false;
  }
  if (IsApplTerm(tout) &&
      (f = FunctorOfTerm(tout)) &&
      (f == FunctorAtom || f == FunctorString1 ||
       f == FunctorCodes1 || f == FunctorCodes ||
       f == FunctorChars1 || f == FunctorChars) ) {
    output_stream = Yap_OpenBufWriteStream( PASS_REGS1);
    mem_stream = true;
  } else {
    /* needs to change LOCAL_c_output_stream for write */
    output_stream = Yap_CheckStream (tout, Output_Stream_f, "format/3");
  }
  if (output_stream == -1) {
    return false;
    UNLOCK(GLOBAL_Stream[output_stream].streamlock);
  } else {
      yhandle_t sls  = Yap_CurrentSlot(PASS_REGS1);

      out = doformat(tf,tas,output_stream PASS_REGS);

      Yap_CloseSlots( sls );
      UNLOCK(GLOBAL_Stream[output_stream].streamlock);
    }
  if (mem_stream) {
    Term tat;
    Term inp = Deref(ARG1);
    if (out) {
      char *s = GLOBAL_Stream[output_stream].nbuf;
      s[GLOBAL_Stream[output_stream].nsize] = '\0';
      if (f == FunctorAtom) {
	tat =  MkAtomTerm(Yap_LookupAtom(s));
      } else if (f == FunctorCodes) {
	tat = Yap_CharsToDiffListOfCodes(s, ArgOfTerm(2,inp) PASS_REGS);
      } else if (f == FunctorCodes1) {
	tat = Yap_CharsToListOfCodes(s PASS_REGS);
      } else if (f == FunctorChars) {
	tat = Yap_CharsToDiffListOfAtoms(s, ArgOfTerm(2,inp) PASS_REGS);
      } else if (f == FunctorChars1) {
	tat = Yap_CharsToListOfAtoms(s PASS_REGS);
      } else if (f == FunctorString1) {
	tat = MkStringTerm(s);
      } else {
	return false;
      }
      if (!Yap_unify(tat,ArgOfTerm(1,inp)))
	return FALSE;
    }
    Yap_CloseStream(output_stream);
  }
  return out;
}

static Int
format2( USES_REGS1 )
{				/* 'format'(Stream,Control,Args)          */
  Int res;
  res = format(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS);
  return res;
}

static Int
format3( USES_REGS1 )
{				/* 'format'(Stream,Control,Args)          */
  Int res;
  res = format(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS);
  return res;
}

void
Yap_InitFormat(void)
{
  Yap_InitCPred ("format", 2, format2, SyncPredFlag);
  Yap_InitCPred ("format", 3, format3, SyncPredFlag);
  Yap_InitCPred ("with_output_to", 2, with_output_to, SyncPredFlag);
}