format/2
This commit is contained in:
Vítor Santos Costa
parent
f4e4220130
commit
a721aa5a3c
978
os/format.c
Normal file
978
os/format.c
Normal file
@ -0,0 +1,978 @@
|
||||
|
||||
/*************************************************************************
|
||||
* *
|
||||
* 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( char *fstr, Term *targs)
|
||||
{
|
||||
if (fstr)
|
||||
Yap_FreeAtomSpace(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;
|
||||
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;
|
||||
|
||||
fstr = fptr = Yap_AllocAtomSpace(sz*sizeof(char));
|
||||
if ((fr = copy_format_string(tail, fstr, sz)) == fst_ok)
|
||||
break;
|
||||
if (fr == fst_error) return FALSE;
|
||||
sz += 256;
|
||||
Yap_FreeCodeSpace(fstr);
|
||||
} while (TRUE);
|
||||
} else if (IsAtomTerm(tail)) {
|
||||
fstr = fptr = RepAtom(AtomOfTerm(tail))->StrOfAE;
|
||||
} 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();
|
||||
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 (!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( 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);
|
||||
break;
|
||||
case '+':
|
||||
if (osno) {
|
||||
Yap_CloseStream(sno);
|
||||
sno = osno;
|
||||
osno = 0;
|
||||
}
|
||||
repeats = (repeats < 0 ? 0 : repeats);
|
||||
fill_pads( sno, repeats, &finfo);
|
||||
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);
|
||||
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( 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)) {
|
||||
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( fstr, targs);
|
||||
return (TRUE);
|
||||
}
|
||||
|
||||
static Int
|
||||
format2(Term tin, Term tf, Term tas USES_REGS)
|
||||
{
|
||||
bool mem_stream = false;
|
||||
int output_stream;
|
||||
Functor f;
|
||||
Int out;
|
||||
|
||||
if (IsVarTerm(tin)) {
|
||||
Yap_Error(INSTANTIATION_ERROR,tin,"format/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();
|
||||
mem_stream = true;
|
||||
} 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 = doformat(tf,tas,output_stream PASS_REGS);
|
||||
if (mem_stream) {
|
||||
Term tat;
|
||||
Term inp = Deref(ARG1);
|
||||
if (out) {
|
||||
char *s = GLOBAL_Stream[output_stream].u.mem_string.buf;
|
||||
s[GLOBAL_Stream[output_stream].u.mem_string.pos] = '\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
|
||||
format( USES_REGS1 )
|
||||
{ /* 'format'(Stream,Control,Args) */
|
||||
Int res;
|
||||
res = format2(MkAtomTerm(AtomUserOut), Deref(ARG1),Deref(ARG2) PASS_REGS);
|
||||
return res;
|
||||
}
|
||||
|
||||
static Int
|
||||
format3( USES_REGS1 )
|
||||
{ /* 'format'(Stream,Control,Args) */
|
||||
Int res;
|
||||
res = format2(Deref(ARG1), Deref(ARG2),Deref(ARG3) PASS_REGS);
|
||||
return res;
|
||||
}
|
||||
|
||||
void
|
||||
Yap_InitFormat(void)
|
||||
{
|
||||
Yap_InitCPred ("format", 2, format, SyncPredFlag);
|
||||
Yap_InitCPred ("format", 3, format3, SyncPredFlag);
|
||||
}
|
||||
Reference in New Issue
Block a user