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