diff --git a/src/ATOMS b/src/ATOMS index b647ced44f..6c52f9bdf8 100644 --- a/src/ATOMS +++ b/src/ATOMS @@ -403,6 +403,7 @@ A heap_gc "heap_gc" A heapused "heapused" A heartbeat "heartbeat" A help "help" +A hex "hex" A hidden "hidden" A hide_childs "hide_childs" A history_depth "history_depth" @@ -594,6 +595,7 @@ A numbervars "numbervars" A numerator "numerator" A obfuscate "obfuscate" A occurs_check "occurs_check" +A octal "octal" A octet "octet" A off "off" A offset "offset" diff --git a/src/os/pl-fmt.c b/src/os/pl-fmt.c index bb81793894..b4717bb0b3 100644 --- a/src/os/pl-fmt.c +++ b/src/os/pl-fmt.c @@ -51,14 +51,13 @@ source should also use format() to produce error messages, etc. #include #include #include +#include "pl-fmt.h" #ifdef __WINDOWS__ #include "../pl-nt.h" #endif typedef foreign_t (*Func1)(term_t a1); -static char * formatInteger(PL_locale *locale, int div, int radix, - bool smll, Number n, Buffer out); static char * formatFloat(PL_locale *locale, int how, int arg, Number f, Buffer out); @@ -1052,7 +1051,15 @@ revert_string(char *s, size_t len) } } -static char * +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +Format the integer `i` to the buffer `out`. `div` is for supporting +fixed point numbers. `radix` is the base and `smll` defines whether +to use capitals (`false`) or lowercase letters for digit values above +9. +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + + +char * formatInteger(PL_locale *locale, int div, int radix, bool smll, Number i, Buffer out) { const char *grouping = NULL; @@ -1725,12 +1732,24 @@ formatFloat(PL_locale *locale, int how, int arg, Number f, Buffer out) int size = 0; if ( how == 'h' || how == 'H' ) - { if ( !growBuffer(out, 100) ) - { PL_no_memory(); - return NULL; + { size_t space = 32; + + for(int n=0; n<2; n++) + { size_t sz; + + if ( !growBuffer(out, space) ) + { PL_no_memory(); + return NULL; + } + sz = format_float(out->base, space, f->value.f, + arg, how == 'H' ? 'E' : 'e'); + if ( sz < space ) + { written = sz; + break; + } else + { space = sz+1; + } } - format_float(f->value.f, arg, how == 'H' ? 'E' : 'e', out->base); - written = strlen(out->base); } else { Ssprintf(tmp, "%%.%d%c", arg, how); while(written >= size) diff --git a/src/os/pl-fmt.h b/src/os/pl-fmt.h new file mode 100644 index 0000000000..15c1efe5e2 --- /dev/null +++ b/src/os/pl-fmt.h @@ -0,0 +1,43 @@ +/* Part of SWI-Prolog + + Author: Jan Wielemaker + E-mail: J.Wielemaker@vu.nl + WWW: http://www.swi-prolog.org + Copyright (c) 2024, University of Amsterdam + VU University Amsterdam + CWI, Amsterdam + All rights reserved. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. + + THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS + "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT + LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS + FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE + COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, + INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, + BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; + LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN + ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE + POSSIBILITY OF SUCH DAMAGE. +*/ + +#ifndef FMT_H_INCLUDED +#define FMT_H_INCLUDED + +COMMON(char *) formatInteger(PL_locale *locale, int div, int radix, + bool smll, Number n, Buffer out); + +#endif /*FMT_H_INCLUDED*/ diff --git a/src/os/pl-text.c b/src/os/pl-text.c index 714a24a980..a53fbe1b63 100644 --- a/src/os/pl-text.c +++ b/src/os/pl-text.c @@ -282,11 +282,23 @@ PL_get_text(DECL_LD term_t l, PL_chars_t *text, int flags) text->encoding = ENC_ISO_LATIN_1; text->canonical = true; } else if ( (flags & CVT_FLOAT) && isFloat(w) ) - { format_float(valFloat(w), 3, 'e', text->buf); - text->text.t = text->buf; - text->length = strlen(text->text.t); + { size_t sz = format_float(text->buf, sizeof(text->buf), + valFloat(w), 3, 'e'); + if ( sz < sizeof(text->buf) ) + { text->text.t = text->buf; + text->length = sz; + text->storage = PL_CHARS_LOCAL; + } else + { Buffer b = findBuffer(BUF_STACK); + + if ( !growBuffer(b, sz+1) ) + outOfCore(); + format_float(b->base, sz+1, valFloat(w), 3, 'e'); + text->text.t = baseBuffer(b, char); + text->length = sz; + text->storage = PL_CHARS_STACK; + } text->encoding = ENC_ISO_LATIN_1; - text->storage = PL_CHARS_LOCAL; text->canonical = true; } else if ( (flags & CVT_LIST) ) { Buffer b; diff --git a/src/pl-fli.c b/src/pl-fli.c index c9a6c08f82..c765853c7f 100644 --- a/src/pl-fli.c +++ b/src/pl-fli.c @@ -787,6 +787,13 @@ static int compareUCSAtom(atom_t h1, atom_t h2); static int saveUCSAtom(atom_t a, IOSTREAM *fd); static atom_t loadUCSAtom(IOSTREAM *fd); +static int +blob_write_usc_atom(IOSTREAM *fd, atom_t atom, int flags) +{ bool rc = writeUCSAtom(fd, atom, flags); + + return rc ? 1 : -1; +} + static PL_blob_t ucs_atom = { PL_BLOB_MAGIC, PL_BLOB_UNIQUE|PL_BLOB_TEXT|PL_BLOB_WCHAR, @@ -794,7 +801,7 @@ static PL_blob_t ucs_atom = "ucs_text", NULL, /* release */ compareUCSAtom, /* compare */ - writeUCSAtom, /* write */ + blob_write_usc_atom, /* write */ NULL, /* acquire */ saveUCSAtom, /* save load to/from .qlf files */ loadUCSAtom diff --git a/src/pl-ressymbol.c b/src/pl-ressymbol.c index ade4bc4147..c229d6bb48 100644 --- a/src/pl-ressymbol.c +++ b/src/pl-ressymbol.c @@ -3,7 +3,8 @@ Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org - Copyright (c) 2013-2017, VU University Amsterdam + Copyright (c) 2013-2024, VU University Amsterdam + SWI-Prolog Solutions b.v. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -43,6 +44,13 @@ static int compareReservedSymbol(atom_t h1, atom_t h2); +static int +blob_write_reserved_symbol(IOSTREAM *fd, atom_t atom, int flags) +{ bool rc = writeReservedSymbol(fd, atom, flags); + + return rc ? 1 : -1; +} + static PL_blob_t reserved_symbol = { PL_BLOB_MAGIC, PL_BLOB_UNIQUE, @@ -50,7 +58,7 @@ static PL_blob_t reserved_symbol = "reserved_symbol", NULL, /* release */ compareReservedSymbol, /* compare */ - writeReservedSymbol, /* write */ + blob_write_reserved_symbol, /* write */ NULL, /* acquire */ NULL, /* save load to/from .qlf files */ NULL, diff --git a/src/pl-write.c b/src/pl-write.c index 3432481ba2..2234852123 100644 --- a/src/pl-write.c +++ b/src/pl-write.c @@ -51,6 +51,7 @@ #include "os/pl-ctype.h" #include "os/pl-utf8.h" #include "os/pl-prologflag.h" +#include "os/pl-fmt.h" #include /* sprintf() */ #include #ifdef HAVE_LOCALE_H @@ -67,10 +68,16 @@ #define HAVE_FPCLASSIFY 1 #endif +#define RADIX_DECIMAL -10 +#define RADIX_HEX -16 +#define RADIX_OCTAL -8 +#define RADIX_BINARY -2 + typedef struct { unsigned int flags; /* PL_WRT_* flags */ int max_depth; /* depth limit */ int depth; /* current depth */ + int radix; /* Radix for printing integers */ atom_t spacing; /* Where to insert spaces */ Module module; /* Module for operators */ IOSTREAM *out; /* stream to write to */ @@ -79,6 +86,11 @@ typedef struct term_t prec_opt; /* term in write options with prec */ } write_options; +#define WRITE_OPTIONS_DEFAULTS \ + { .radix = RADIX_DECIMAL, \ + .spacing = ATOM_standard \ + } + #define W_OP_ARG 1 /* writeTerm() location argument */ #define W_TOP 0 /* top term */ @@ -497,7 +509,7 @@ needSpace(int c, IOSTREAM *s) } -static int +static int /* false, true, TRUE_WITH_SPACE */ PutOpenToken(int c, IOSTREAM *s) { if ( needSpace(c, s) ) { TRY(Putc(' ', s)); @@ -508,7 +520,7 @@ PutOpenToken(int c, IOSTREAM *s) } -static int +static int /* false, true, TRUE_WITH_SPACE */ PutToken(const char *s, IOSTREAM *stream) { if ( s[0] ) { int rc; @@ -523,7 +535,7 @@ PutToken(const char *s, IOSTREAM *stream) } -static int +static int /* false, true, TRUE_WITH_SPACE */ PutTokenN(const char *s, size_t len, IOSTREAM *stream) { if ( len > 0 ) { int rc; @@ -546,7 +558,7 @@ openbrace to avoid interpretation as a term. E.g. not (a,b) instead of not(a,b). Reported by Stefan.Mueller@dfki.de. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ -static int +static int /* false, true, TRUE_WITH_SPACE */ PutOpenBrace(IOSTREAM *s) { int rc; @@ -781,19 +793,18 @@ writeAtom(atom_t a, write_options *options) } -int +bool writeAtomToStream(IOSTREAM *s, atom_t atom) -{ write_options options; +{ write_options options = WRITE_OPTIONS_DEFAULTS; - memset(&options, 0, sizeof(options)); options.out = s; options.module = MODULE_user; - return writeAtom(atom, &options); + return !!writeAtom(atom, &options); } -int +bool writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags) { Atom a = atomValue(atom); const pl_wchar_t *s = (const pl_wchar_t*)a->name; @@ -835,7 +846,7 @@ writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags) } #ifdef O_RESERVED_SYMBOLS -int +bool writeReservedSymbol(IOSTREAM *fd, atom_t atom, int flags) { Atom a = atomValue(atom); const char *s = a->name; @@ -843,7 +854,7 @@ writeReservedSymbol(IOSTREAM *fd, atom_t atom, int flags) const char *e = &s[len]; if ( atom == ATOM_nil ) - return PutToken("[]", fd); + return !!PutToken("[]", fd); if ( (flags&PL_WRT_QUOTED) ) { char quote = '\''; @@ -1035,14 +1046,6 @@ NaN_value(double f) } -static char * -writeNaN(double f, char *buf) -{ format_float(NaN_value(f), 3, 'e', buf); - strcat(buf, "NaN"); - return buf; -} - - strnumstat make_nan(double *f) { union ieee754_double u; @@ -1058,39 +1061,53 @@ make_nan(double *f) } -static char * -writeINF(double f, char *buf) +static size_t +writeNaN(char *buf, size_t len, double f) +{ size_t sz = format_float(buf, len, NaN_value(f), 3, 'e'); + + if ( sz+4 < len ) + strcpy(buf+sz, "NaN"); + return sz+3; +} + +static size_t +writeINF(char *buf, size_t len, double f) { number n; n.value.f = f; n.type = V_FLOAT; if ( ar_signbit(&n) < 0 ) - return strcpy(buf, "-1.0Inf"); - else - return strcpy(buf, "1.0Inf"); + { if ( len >= 8 ) + strcpy(buf, "-1.0Inf"); + return 7; + } else + { if ( len >= 7 ) + strcpy(buf, "1.0Inf"); + return 6; + } } -static char * -format_special_float(double f, char *buf) +static size_t +format_special_float(char *buf, size_t len, double f) { #ifdef HAVE_FPCLASSIFY switch(fpclassify(f)) { case FP_NAN: - return writeNaN(f, buf); + return writeNaN(buf, len, f); case FP_INFINITE: - return writeINF(f, buf); + return writeINF(buf, len, f); } #else #ifdef HAVE_FPCLASS switch(fpclass(f)) { case FP_SNAN: case FP_QNAN: - return writeNaN(f, buf); + return writeNaN(buf, len, f); case FP_NINF: case FP_PINF: - return writeINF(f, buf); + return writeINF(buf, len, f); case FP_NDENORM: /* pos/neg denormalized non-zero */ case FP_PDENORM: case FP_NNORM: /* pos/neg normalized non-zero */ @@ -1104,73 +1121,95 @@ format_special_float(double f, char *buf) switch(_fpclass(f)) { case _FPCLASS_SNAN: case _FPCLASS_QNAN: - return writeNaN(f, buf); + return writeNaN(buf, len, f); case _FPCLASS_NINF: case _FPCLASS_PINF: - return writeINF(f, buf); + return writeINF(buf, len, f); } #else #ifdef HAVE_ISINF if ( isinf(f) ) - { return writeINF(f, buf); + { return writeINF(buf, len, f); } else #endif #ifdef HAVE_ISNAN if ( isnan(f) ) - { return writeNaN(f, buf); + { return writeNaN(buf, len, f); } #endif #endif /*HAVE__FPCLASS*/ #endif /*HAVE_FPCLASS*/ #endif /*HAVE_FPCLASSIFY*/ - return NULL; + return 0; } -char * -format_float(double f, int N, char E, char *buf) +/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +Format a float in fixed point or exponential notation with the minimal +number of digits such that it is read back to the same value. + +Parameters: + - `buf` is where the result is stored. + - `size` is the size of `buf` + - `f` is the float to be formatted + - `N` is the number as used by format `~Nh`. See format/2. + - `E` is 'e' or 'E' + +Return: + - Number of characters output, minus the terminating 0 + - If truncated, the return value >= size +- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ + +size_t +format_float(char *buf, size_t size, double f, int N, char E) { char *end, *o=buf, *s; int decpt, sign; + size_t sz; + char *limit = &buf[size]; - if ( (s=format_special_float(f, buf)) ) - return s; + if ( (sz=format_special_float(buf, size, f)) ) + return sz; s = dtoa(f, 0, 30, &decpt, &sign, &end); DEBUG(MSG_WRITE_FLOAT, Sdprintf("dtoa(): decpt=%d, sign=%d, len = %d, '%s'\n", decpt, sign, end-s, s)); +#define OUT(c) \ + do { if ( o 1 ) - { memcpy(o, s+1, end-s-1); - o += end-s-1; + { OUTN(s+1, end-s-1); } else - *o++ = '0'; - sprintf(o, "%c%03d", E, e); + OUT('0'); + char eb[16]; + snprintf(eb, sizeof(eb), "%c%03d", E, e); + OUTS(eb); } else { int i; - *o++ = '0'; - *o++ = '.'; + OUT('0'); + OUT('.'); for(i=0; i < -decpt; i++) - *o++ = '0'; - memcpy(o, s, end-s); - o[end-s] = 0; + OUT('0'); + OUTN(s, end-s); } } else if ( N >=0 && end-s > decpt ) /* decimal dot inside */ - { memcpy(o, s, decpt); - o += decpt; - *o++ = '.'; - memcpy(o, s+decpt, end-s-decpt); - o[end-s-decpt] = 0; + { OUTN(s, decpt); + OUT('.'); + OUTN(s+decpt, end-s-decpt); } else /* decimal dot after */ { int i; int d = (int)(end-s); @@ -1181,33 +1220,36 @@ format_float(double f, int N, char E, char *buf) Sdprintf("trailing = %d; exp=%d; d=%d; N=%d\n", trailing, exp, d, N)); if ( N < 0 || exp >= N+d ) /* over precision: use eE */ - { *o++ = s[0]; - *o++ = '.'; + { OUT(s[0]); + OUT('.'); if ( d > 1 ) - { memcpy(o, s+1, d-1); - o += d-1; + { OUTN(s+1, d-1); } else - *o++ = '0'; - sprintf(o, "%c+%02d", E, exp); + OUT('0'); + char eb[16]; + snprintf(eb, sizeof(eb), "%c+%02d", E, exp); + OUTS(eb); } else /* within precision trail with .0 */ - { memcpy(o, s, end-s); - o += end-s; + { OUTN(s, end-s); for(i=d; i 0 ) + buf[size-1] = 0; + return o-buf; } #ifdef O_BIGNUM -static int +static bool mpz_get_str_ex(char *buf, int base, mpz_t mpz) { int rc; @@ -1223,12 +1265,12 @@ mpz_get_str_ex(char *buf, int base, mpz_t mpz) #define writeMPZ(mpz, options) LDFUNC(writeMPZ, mpz, options) -static int +static bool writeMPZ(DECL_LD mpz_t mpz, write_options *options) { char tmp[1024]; char *buf; size_t sz = (mpz_sizeinbase(mpz, 2)*10)/3 + 10; /* log2(10)=3.322 */ - int rc; + bool rc; if ( sz <= sizeof(tmp) ) buf = tmp; @@ -1252,8 +1294,26 @@ writeMPZ(DECL_LD mpz_t mpz, write_options *options) } #endif -static int -WriteNumber(Number n, write_options *options) +static bool +put_radix(int radix, IOSTREAM *out) +{ if ( radix > 0 ) + { char tmp[16]; + snprintf(tmp, sizeof(tmp), "%d'", radix); + return !!PutToken(tmp, out); + } else if ( radix == RADIX_HEX ) + { return !!PutToken("0x", out); + } else if ( radix == RADIX_OCTAL ) + { return !!PutToken("0o", out); + } else if ( radix == RADIX_BINARY ) + { return !!PutToken("0b", out); + } else + { assert(0); + return false; + } +} + +static bool +writeNumber(Number n, write_options *options) { #ifdef O_GMP GET_LD @@ -1261,14 +1321,29 @@ WriteNumber(Number n, write_options *options) switch(n->type) { case V_INTEGER: - { char buf[32]; +#ifdef O_BIGNUM + case V_MPZ: +#endif + { tmp_buffer b; + bool rc; + int radix = options->radix >= 0 ? options->radix + : -options->radix; + + initBuffer(&b); + char *s = formatInteger(NULL, 0, radix, true, n, (Buffer)&b); + if ( s ) + { if ( options->radix != RADIX_DECIMAL ) + rc = ( put_radix(options->radix, options->out) && + PutString(s, options->out) ); + else + rc = !!PutToken(s, options->out); + } else + rc = false; + discardBuffer(&b); - sprintf(buf, "%" PRId64, n->value.i); - return PutToken(buf, options->out); + return rc; } #ifdef O_BIGNUM - case V_MPZ: - return writeMPZ(n->value.mpz, options); case V_MPQ: { mpz_t num, den; /* num/den */ char sep = ison(options, PL_WRT_RAT_NATURAL) ? '/' : 'r'; @@ -1284,8 +1359,8 @@ WriteNumber(Number n, write_options *options) case V_FLOAT: { char buf[100]; - format_float(n->value.f, 3, 'e', buf); - return PutToken(buf, options->out); + format_float(buf, sizeof(buf), n->value.f, 3, 'e'); + return !!PutToken(buf, options->out); } default: assert(0); @@ -1317,7 +1392,7 @@ writePrimitive(term_t t, write_options *options) { number n; PL_get_number(t, &n); - return WriteNumber(&n, options); + return writeNumber(&n, options); } #if O_STRING @@ -2004,6 +2079,7 @@ static const PL_option_t write_term_options[] = { ATOM_nl, OPT_BOOL }, { ATOM_fullstop, OPT_BOOL }, { ATOM_no_lists, OPT_BOOL }, + { ATOM_radix, OPT_TERM }, { NULL_ATOM, 0 } }; @@ -2017,6 +2093,7 @@ pl_write_term3(term_t stream, term_t term, term_t opts) int numbervars = -1; /* not set */ int portray = false; term_t gportray = 0; + term_t radix = 0; atom_t bq = 0; int charescape = -1; /* not set */ int charescape_unicode = -1; @@ -2032,12 +2109,9 @@ pl_write_term3(term_t stream, term_t term, term_t opts) int no_lists = false; term_t varnames = 0; IOSTREAM *s = NULL; - write_options options; + write_options options = WRITE_OPTIONS_DEFAULTS; int rc; - memset(&options, 0, sizeof(options)); - options.spacing = ATOM_standard; - if ( !PL_scan_options(opts, 0, "write_option", write_term_options, "ed, "e_non_ascii, &ignore_ops, &dotlists, &braceterms, &numbervars, &portray, &portray, &gportray, @@ -2045,8 +2119,8 @@ pl_write_term3(term_t stream, term_t term, term_t opts) &options.max_depth, &mname, &bq, &attr, &priority, &partial, &options.spacing, &blobs, &cycles, &varnames, &nl, &fullstop, - &no_lists) ) - fail; + &no_lists, &radix) ) + return false; if ( attr == ATOM_nil ) { options.flags |= LD->prolog_flag.write_attributes; @@ -2103,6 +2177,26 @@ pl_write_term3(term_t stream, term_t term, term_t opts) if ( isoff(&options, PL_WRT_BLOB_PORTRAY) ) portray = true; } + if ( radix ) + { atom_t a; + int r; + + if ( PL_get_atom(radix, &a) ) + { if ( a == ATOM_decimal ) + options.radix = RADIX_DECIMAL; + else if ( a == ATOM_hex ) + options.radix = RADIX_HEX; + else if ( a == ATOM_octal ) + options.radix = RADIX_OCTAL; + else if ( a == ATOM_binary ) + options.radix = RADIX_BINARY; + else + return PL_domain_error("radix", radix); + } else if ( PL_get_integer(radix, &r) && r >= 2 && r <= 36 ) + { options.radix = r; + } else + return PL_domain_error("radix", radix); + } if ( numbervars == -1 ) numbervars = (portray ? true : false); @@ -2170,10 +2264,9 @@ pl_write_term(term_t term, term_t options) bool PL_write_term(IOSTREAM *s, term_t term, int precedence, int flags) -{ write_options options; +{ write_options options = WRITE_OPTIONS_DEFAULTS; int rc; - memset(&options, 0, sizeof(options)); options.flags = flags & ~PL_WRT_NEWLINE; options.out = s; options.module = MODULE_user; @@ -2202,10 +2295,9 @@ do_write2(term_t stream, term_t term, int flags, int canonical) IOSTREAM *s; if ( getTextOutputStream(stream, &s) ) - { write_options options; + { write_options options = WRITE_OPTIONS_DEFAULTS; int rc; - memset(&options, 0, sizeof(options)); options.flags = flags; if ( !canonical ) options.flags |= LD->prolog_flag.write_attributes; diff --git a/src/pl-write.h b/src/pl-write.h index 99cbb3f611..2d7c7f6d6f 100644 --- a/src/pl-write.h +++ b/src/pl-write.h @@ -66,10 +66,10 @@ foreign_t pl_writeln2(term_t stream, term_t term); foreign_t pl_writeq2(term_t stream, term_t term); foreign_t pl_print2(term_t stream, term_t term); int writeAttributeMask(atom_t name); -int writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags); -int writeReservedSymbol(IOSTREAM *fd, atom_t atom, int flags); -int writeAtomToStream(IOSTREAM *s, atom_t atom); -char * format_float(double f, int N, char E, char *buf); +bool writeUCSAtom(IOSTREAM *fd, atom_t atom, int flags); +bool writeReservedSymbol(IOSTREAM *fd, atom_t atom, int flags); +bool writeAtomToStream(IOSTREAM *s, atom_t atom); +size_t format_float(char *buf, size_t size, double f, int N, char E); int unquoted_atom(atom_t a); strnumstat make_nan(double *f); double NaN_value(double f);