1 /* Output like sprintf to a buffer of specified size.
2 Also takes args differently: pass one pointer to an array of strings
3 in addition to the format string which is separate.
4 Copyright (C) 1995 Free Software Foundation, Inc.
5 Rewritten by mly to use varargs.h.
6 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
9 This file is part of SXEmacs
11 SXEmacs is free software: you can redistribute it and/or modify
12 it under the terms of the GNU General Public License as published by
13 the Free Software Foundation, either version 3 of the License, or
14 (at your option) any later version.
16 SXEmacs is distributed in the hope that it will be useful,
17 but WITHOUT ANY WARRANTY; without even the implied warranty of
18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 GNU General Public License for more details.
21 You should have received a copy of the GNU General Public License
22 along with this program. If not, see <http://www.gnu.org/licenses/>. */
25 /* Synched up with: Rewritten. Not in FSF. */
33 static const char *const valid_flags = "-+ #0";
34 static const char *const valid_converters = "dic" "oxX" "feEgG" "sS" "b"
35 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
36 defined HAVE_MPQ && defined WITH_GMP
39 #if defined HAVE_MPF && defined WITH_GMP || \
40 defined HAVE_MPFR && defined WITH_MPFR
43 #if defined HAVE_PSEUG && defined WITH_PSEUG
46 #if defined HAVE_MPC && defined WITH_MPC || \
47 defined HAVE_PSEUC && defined WITH_PSEUC
51 static const char *const int_converters = "dic";
52 static const char *const base_converters = "boxX";
53 static const char *const double_converters = "feEgG";
54 static const char *const string_converters = "sS";
55 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
56 defined HAVE_MPQ && defined WITH_GMP
57 static const char *const bigz_converters = "ZQ";
59 #if defined HAVE_MPF && defined WITH_GMP || \
60 defined HAVE_MPFR && defined WITH_MPFR
61 static const char *const bigf_converters = "FR";
63 #if defined HAVE_PSEUG && defined WITH_PSEUG
64 static const char *const bigg_converters = "B";
66 #if defined HAVE_MPC && defined WITH_MPC || \
67 defined HAVE_PSEUC && defined WITH_PSEUC
68 static const char *const bigc_converters = "C";
72 typedef struct printf_spec_s *printf_spec_t;
73 typedef struct printf_spec_s printf_spec; /* to make Wing's dynarrs happy */
74 struct printf_spec_s {
75 int argnum; /* which argument does this spec want? This is
76 one-based: The first argument given is
77 numbered 1, the second is 2, etc. This is to
78 handle %##$x-type specs. */
85 /* print 0x78 instead of just 78 */
87 /* prefers 0x-2 to -0x2 */
88 bool sign_after_hash_flag:1;
89 /* uses #x2 instead of 0x2 */
90 bool lisp_reader_syntax:1;
97 bool forwarding_precision:1;
98 /* caching approach */
100 char converter; /* converter character or 0 for dummy marker
101 indicating literal text at the end of the
103 Bytecount text_before; /* position of the first character of the
104 block of literal text before this spec */
105 Bytecount text_before_len; /* length of that text */
106 char pad_char; /* char to use for padding */
109 typedef union printf_arg_u printf_arg_t;
110 typedef union printf_arg_u printf_arg; /* to make Wing's dynarrs happy */
119 /* We maintain a list of all the % specs in the specification,
120 along with the offset and length of the block of literal text
121 before each spec. In addition, we have a "dummy" spec that
122 represents all the literal text at the end of the specification.
123 Its converter is 0. */
126 Dynarr_declare(struct printf_spec_s);
127 } printf_spec_dynarr;
130 Dynarr_declare(union printf_arg_u);
133 /* Append STRING (of length LEN bytes) to STREAM.
134 MINLEN is the minimum field width.
135 If MINUS_FLAG is set, left-justify the string in its field;
136 otherwise, right-justify.
137 If ZERO_FLAG is set, pad with 0's; otherwise pad with spaces.
138 If MAXLEN is non-negative, the string is first truncated on the
139 right to that many characters.
141 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
144 doprnt_1(Lisp_Object stream, const Bufbyte * string, Bytecount len,
145 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
147 Lstream *lstr = XLSTREAM(stream);
148 Charcount cclen = bytecount_to_charcount(string, len);
149 int to_add = minlen - cclen;
151 /* Padding at beginning to right-justify ... */
154 Lstream_putc(lstr, zero_flag ? '0' : ' ');
156 if (0 <= maxlen && maxlen < cclen)
157 len = charcount_to_bytecount(string, maxlen);
158 Lstream_write(lstr, string, len);
160 /* Padding at end to left-justify ... */
163 Lstream_putc(lstr, zero_flag ? '0' : ' ');
166 static const Bufbyte *parse_off_posnum(const Bufbyte * start,
167 const Bufbyte * end, int *returned_num)
169 Bufbyte arg_convert[100];
170 REGISTER Bufbyte *arg_ptr = arg_convert;
173 while (start != end && isdigit(*start)) {
174 if ((size_t) (arg_ptr - arg_convert) >= sizeof(arg_convert) - 1)
175 error("Format converter number too large");
176 *arg_ptr++ = *start++;
179 if (arg_convert != arg_ptr)
180 *returned_num = atoi((char *)arg_convert);
184 #define NEXT_ASCII_BYTE(ch) \
186 if (fmt == fmt_end) \
187 error ("Premature end of format string"); \
190 error ("Non-ASCII character in format " \
195 #define RESOLVE_FLAG_CONFLICTS(spec) \
197 if (spec.space_flag && spec.plus_flag) \
198 spec.space_flag = 0; \
201 static printf_spec_dynarr *
202 parse_doprnt_spec(const Bufbyte * format, Bytecount format_length)
204 const Bufbyte *fmt = format;
205 const Bufbyte *fmt_end = format + format_length;
206 printf_spec_dynarr *specs = Dynarr_new(printf_spec);
210 struct printf_spec_s spec;
211 const Bufbyte *text_end;
215 if (fmt == fmt_end) {
218 text_end = (Bufbyte *) memchr(fmt, '%', fmt_end - fmt);
222 spec.text_before = fmt - format;
223 spec.text_before_len = text_end - fmt;
226 if (fmt != fmt_end) {
227 fmt++; /* skip over % */
229 /* A % is special -- no arg number.
230 According to ANSI specs, field width does
231 not apply to %% conversion. */
232 if (fmt != fmt_end && *fmt == '%') {
233 spec.converter = '%';
234 Dynarr_add(specs, spec);
239 /* Is there a field number specifier? */
245 parse_off_posnum(fmt, fmt_end, &fieldspec);
246 if (fieldspec > 0 && ptr != fmt_end
248 /* There is a format specifier */
249 prev_argnum = fieldspec;
253 spec.argnum = prev_argnum;
256 /* Parse off any flags */
261 spec.minus_flag = true;
264 spec.plus_flag = true;
267 spec.space_flag = true;
270 spec.number_flag = true;
273 spec.number_flag = true;
274 spec.lisp_reader_syntax = true;
276 spec.sign_after_hash_flag = true;
279 spec.group_flag = true;
282 spec.zero_flag = true;
288 case '\000': /* steve's favourite */
297 /* Parse off the minimum field width */
301 * * means the field width was passed as an argument.
302 * Mark the current spec as one that forwards its
303 * field width and flags to the next spec in the array.
304 * Then create a new spec and continue with the parsing.
306 if (fmt != fmt_end && *fmt == '*') {
307 spec.converter = '*';
308 RESOLVE_FLAG_CONFLICTS(spec);
309 Dynarr_add(specs, spec);
310 spec.argnum = ++prev_argnum;
313 fmt = parse_off_posnum(fmt, fmt_end,
315 if (spec.minwidth == -1)
319 /* Parse off any precision specified */
323 * * means the precision was passed as an argument.
324 * Mark the current spec as one that forwards its
325 * fieldwidth, flags and precision to the next spec in
326 * the array. Then create a new spec and continue
329 if (fmt != fmt_end && *fmt == '*') {
330 spec.converter = '*';
331 spec.forwarding_precision = 1;
332 RESOLVE_FLAG_CONFLICTS(spec);
333 Dynarr_add(specs, spec);
334 spec.argnum = ++prev_argnum;
338 parse_off_posnum(fmt, fmt_end,
340 if (spec.precision == -1)
345 /* No precision specified */
349 /* Parse off h or l flag */
350 if (ch == 'h' || ch == 'l') {
358 if (!strchr(valid_converters, ch))
359 error("Invalid converter character %c", ch);
363 RESOLVE_FLAG_CONFLICTS(spec);
364 Dynarr_add(specs, spec);
367 RETURN_NOT_REACHED(specs) /* suppress compiler warning */
370 static int get_args_needed(printf_spec_dynarr *specs)
375 /* Figure out how many args are needed. This may be less than
376 the number of specs because a spec could be %% or could be
377 missing (literal text at end of format string) or there
378 could be specs where the field number is explicitly given.
379 We just look for the maximum argument number that's referenced. */
381 for (i = 0; i < Dynarr_length(specs); i++) {
382 char ch = Dynarr_at(specs, i).converter;
383 if (ch && ch != '%') {
384 int argnum = Dynarr_at(specs, i).argnum;
385 if (argnum > args_needed)
386 args_needed = argnum;
393 static printf_arg_dynarr *
394 get_doprnt_args(printf_spec_dynarr *specs, va_list vargs)
396 printf_arg_dynarr *args = Dynarr_new(printf_arg);
399 int args_needed = get_args_needed(specs);
403 spec_len = Dynarr_length(specs);
406 for (i = 1; i <= args_needed; i++) {
409 printf_spec_t spec = 0;
411 for (j = 0; j < spec_len; j++) {
412 spec = Dynarr_atp(specs, j);
413 if (spec->argnum == i) {
419 error("No conversion spec for argument %d", i);
421 ch = spec->converter;
423 if (strchr(int_converters, ch)) {
425 arg.l = va_arg(vargs, long);
427 /* int even if ch == 'c' or spec->h_flag: "the
428 type used in va_arg is supposed to match the
429 actual type **after default promotions**."
430 Hence we read an int, not a short, if
432 arg.l = va_arg(vargs, int);
433 } else if (strchr(base_converters, ch)) {
435 arg.l = va_arg(vargs, int);
437 /* unsigned int even if ch == 'c'
439 arg.l = va_arg(vargs, int);
441 } else if (strchr(double_converters, ch)) {
442 arg.d = va_arg(vargs, double);
443 } else if (strchr(string_converters, ch)) {
444 arg.bp = va_arg(vargs, Bufbyte *);
445 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
446 defined HAVE_MPQ && defined WITH_GMP
447 } else if (strchr(bigz_converters, ch)) {
448 arg.obj = va_arg(vargs, Lisp_Object);
450 #if defined HAVE_MPF && defined WITH_GMP || \
451 defined HAVE_MPFR && defined WITH_MPFR
452 } else if (strchr(bigf_converters, ch)) {
453 arg.obj = va_arg(vargs, Lisp_Object);
458 Dynarr_add(args, arg);
464 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
465 Output goes in BUFFER, which has room for BUFSIZE bytes.
466 If the output does not fit, truncate it to fit.
467 Returns the number of bytes stored into BUFFER.
468 LARGS or VARGS points to the arguments, and NARGS says how many.
469 if LARGS is non-zero, it should be a pointer to NARGS worth of
470 Lisp arguments. Otherwise, VARGS should be a va_list referring
474 /* we divide the emacs_doprnt_1 into readable chunks */
476 static void emacs_doprnt_number(
477 Lisp_Object, const Lisp_Object *,
478 printf_arg_dynarr *, printf_spec_t, char);
481 #define DOPRNT_AND_FREE(b, l) \
483 doprnt_1(stream, b, l, 0, -1, 0, 0); \
488 __ulong_to_bit_string(char *p, long unsigned int number)
490 int i, seen_high_order = 0;
493 for (i = ((SIZEOF_LONG * 8) - 1); i >= 0; --i) {
494 if (number & 1UL << i) {
498 if (seen_high_order) {
504 return (int)(p - origp);
508 __nnaughts(printf_spec_t s, int nlen, int tlen)
510 /* return the number of naughts to insert, given specs S and a
511 * pure length of the number of NLEN and a overall length of the
513 * the result will always be nonnegative */
517 if (UNLIKELY(s->precision == 0)) {
520 } else if (s->precision > 0) {
521 if ((result = s->precision - nlen) < 0) {
524 } else if (s->zero_flag && !s->minus_flag) {
525 /* in this case use s->minwidth */
526 if ((result = s->minwidth - tlen) < 0) {
534 __bsize_smZ(printf_spec_t s, EMACS_INT SXE_UNUSED(Z))
535 __attribute__((always_inline));
537 __bsize_smZ(printf_spec_t s, EMACS_INT SXE_UNUSED(Z))
539 return 32 + s->minwidth + sizeof(long int) *
540 /* if binary representation is wanted, use an
541 * awful lot more space */
542 (s->converter != 'b' ? 3 : 8) + s->precision +
543 3 /* for 0x and friends */;
546 #if defined HAVE_MPZ && defined WITH_GMP
548 __bsize_Z(printf_spec_t s, bigz Z)
549 __attribute__((always_inline));
551 __bsize_Z(printf_spec_t s, bigz Z)
555 switch (s->converter) {
557 ms = mpz_sizeinbase(Z, 10);
561 ms = mpz_sizeinbase(Z, 16);
564 ms = mpz_sizeinbase(Z, 8);
567 ms = mpz_sizeinbase(Z, 2);
570 if ((long int)ms < s->minwidth) {
571 return 32 + s->minwidth + s->precision +
572 3 /* for 0x and friends */;
574 return 32 + ms + s->precision + 3;
579 __bsize_Q(printf_spec_t s, bigq Q)
580 __attribute__((always_inline));
582 __bsize_Q(printf_spec_t s, bigq Q)
587 switch (s->converter) {
602 ms = mpz_sizeinbase(mpq_numref(Q), base)
603 + mpz_sizeinbase(mpq_denref(Q), base) + 3;
605 if ((long int)ms < s->minwidth) {
606 return 32 + s->minwidth + s->precision +
607 3 /* for 0x and friends */;
609 return 32 + ms + s->precision + 3;
612 #endif /* HAVE_MPZ && HAVE_GMP */
614 #define __assign_sign_Z(s, p) \
616 if (s->negativep) { \
618 } else if (s->plus_flag) { \
620 } else if (s->space_flag && \
621 !s->lisp_reader_syntax) { \
627 __postproc2(printf_spec_t s, char *restrict, size_t, size_t)
628 __attribute__((always_inline));
630 __postproc2(printf_spec_t s, char *restrict text, size_t text_len, size_t allsz)
632 int nnaughts = 0, num_len = text_len;
633 int ini_len = 0, pre_len = 0, post_len = 0;
634 char *restrict num, *restrict ini, *restrict pre, *restrict post;
635 bool base_conv = (strchr(base_converters, s->converter) != NULL);
637 /* determine how much stuff to put in front */
638 if (base_conv && s->number_flag) {
641 if (s->negativep || s->plus_flag ||
642 (s->space_flag && !s->lisp_reader_syntax)) {
645 /* determine the number of zeroes */
646 text_len = num_len + ini_len;
647 text_len += (nnaughts = __nnaughts(s, num_len, text_len));
649 if ((long int)text_len < s->minwidth) {
651 post_len = s->minwidth - num_len;
653 pre_len = s->minwidth - text_len;
655 text_len = s->minwidth;
658 /* move the number to the final location */
659 pre = text + pre_len;
661 num = ini + nnaughts;
662 post = num + num_len;
663 memmove(num, text, num_len);
666 if (LIKELY(!s->sign_after_hash_flag)) {
667 __assign_sign_Z(s, pre);
671 if (base_conv && s->number_flag) {
672 if (LIKELY(!s->lisp_reader_syntax)) {
677 /* the idea behind that is to just swap the
678 * leading zero with a # et voila the number
679 * can be read in again
681 switch (s->converter) {
699 if (UNLIKELY(s->sign_after_hash_flag)) {
700 __assign_sign_Z(s, pre);
703 /* we pad with zeroes before the number, if desired */
705 memset(ini, '0', nnaughts);
708 /* care about s->minwidth, we move the entire immobile block */
710 memset(post, s->pad_char, post_len);
712 memset(text, s->pad_char, pre_len);
718 emacs_doprnt_smZ(Lisp_Object stream, EMACS_INT Z, printf_spec_t s, char ch)
720 /* ASCII Decimal representation uses 2.4 times as many
721 bits as machine binary. */
722 char constructed_spec[100];
723 char *p = constructed_spec;
724 int alloc_sz = __bsize_smZ(s, Z), text_len = 0;
725 /* get a chunk of space to load off the result */
726 /* C99 we need you so badly */
730 *p++ = 'l'; /* use long */
734 s->negativep = Z < 0L;
735 if (ch != 'b' && Z < 0L) {
736 /* We cannot simply use sprintf,
737 * sprintf would return a two-complement
738 * on negative numbers
739 * however for further movements we hav to advance
740 * cruft_len because that minus char must stay
742 text_len = snprintf(text, alloc_sz, constructed_spec, -Z);
743 } else if (ch != 'b' /* && Z >= 0L */) {
744 text_len = snprintf(text, alloc_sz, constructed_spec, Z);
745 } else if (ch == 'b' && Z < 0) {
746 text_len = __ulong_to_bit_string(text, -Z);
747 } else /* ch == 'b' */ {
748 text_len = __ulong_to_bit_string(text, Z);
750 assert(text_len >= 0 && text_len < alloc_sz);
751 /* postprocess, move stuff around, insert naughts, etc. */
752 text_len = __postproc2(s, text, text_len, alloc_sz);
754 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
758 #if defined(HAVE_MPZ) && defined WITH_GMP
760 emacs_doprnt_Z(Lisp_Object stream, Lisp_Object obj, printf_spec_t s, char ch)
763 int alloc_sz = __bsize_Z(s, XBIGZ_DATA(obj)), text_len = 0;
764 /* get a chunk of space to load off the result */
765 /* C99 we need you so badly */
783 s->negativep = bigz_sign(XBIGZ_DATA(obj)) < 0;
784 bigz_to_string2(text, XBIGZ_DATA(obj), base);
785 text_len = strlen(text);
787 /* special case %X, MPZ does not upcase hex chars,
788 * so we have to do it here
792 for (q = (char*)text; *q != '\0'; q++) {
793 if (strchr("abcdef", *q))
799 text_len = __postproc2(s, text, text_len, alloc_sz);
800 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
803 text_len = __postproc2(s, text+1, text_len-1, alloc_sz);
804 doprnt_1(stream, (Bufbyte*)text+1, text_len, 0, -1, 0, 0);
810 emacs_doprnt_Q(Lisp_Object stream, Lisp_Object obj, printf_spec_t s, char ch)
812 int alloc_sz = __bsize_Q(s, XBIGQ_DATA(obj)), text_len = 0;
813 /* get a chunk of space to load off the result */
814 /* C99 we need you so badly */
817 s->negativep = bigq_sign(XBIGQ_DATA(obj)) < 0;
818 /* the following two are meaningless for rationals */
819 s->zero_flag = false;
822 bigq_to_string2(text, XBIGQ_DATA(obj), 10);
823 text_len = strlen(text);
825 /* special case %X, MPZ does not upcase hex chars,
826 * so we have to do it here
830 for (q = (char*)text; *q != '\0'; q++) {
831 if (strchr("abcdef", *q))
837 text_len = __postproc2(s, text, text_len, alloc_sz);
838 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
841 text_len = __postproc2(s, text+1, text_len-1, alloc_sz);
842 doprnt_1(stream, (Bufbyte*)text+1, text_len, 0, -1, 0, 0);
846 #endif /* HAVE_MPZ && WITH_GMP */
849 emacs_doprnt_number(Lisp_Object stream,
850 const Lisp_Object *largs,
851 printf_arg_dynarr *args,
855 /* Must be a number. */
860 arg = Dynarr_at(args, spec->argnum - 1);
863 obj = largs[spec->argnum - 1];
865 obj = make_int(XCHAR(obj));
867 obj = make_int(marker_position(obj));
870 if (!NUMBERP(obj) && !NILP(obj)) {
871 error("format specifier %%%c "
872 "doesn't match argument type", ch);
877 } else if (ch == 'c') {
878 /* always convert to int if we deal with characters */
879 obj = Fcoerce_number(obj, Qint, Qnil);
881 } else if (strchr(int_converters, ch) && (ch != 'c')) {
882 obj = Fcoerce_number(obj, Qinteger, Qnil);
884 } else if (strchr(base_converters, ch)) {
885 /* must that really be int?
886 * The ENT libraries have support for printing floats
887 * or fractions in hex and octal
889 obj = Fcoerce_number(obj, Qinteger, Qnil);
891 } else if (strchr(double_converters, ch)) {
892 obj = Fcoerce_number(obj, Qfloat, Qnil);
894 #if defined(HAVE_MPZ) && (defined WITH_GMP || defined WITH_MP)
895 } else if (ch == 'Z') {
896 obj = Fcoerce_number(obj, Qbigz, Qnil);
898 #endif /* HAVE_MPZ */
899 #if defined(HAVE_MPQ) && defined WITH_GMP
900 } else if (ch == 'Q') {
901 obj = Fcoerce_number(obj, Qbigq, Qnil);
903 #endif /* HAVE_MPQ */
904 #if defined(HAVE_MPFR) && defined WITH_MPFR
905 } else if (ch == 'F') {
906 obj = Fcoerce_number(obj, Qbigfr, Qnil);
908 #elif defined(HAVE_MPF) && defined WITH_GMP
909 } else if (ch == 'F') {
910 obj = Fcoerce_number(obj, Qbigf, Qnil);
912 #endif /* HAVE_MPFR || HAVE_MPF */
913 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
914 defined(HAVE_MPF) && defined WITH_GMP
915 } else if (ch == 'R') {
916 obj = Fcoerce_number(obj, Qreal, Qnil);
923 #if defined(HAVE_PSEUG) && defined WITH_PSEUG
924 } else if (strchr(bigg_converters, ch)) {
925 obj = Fcoerce_number(obj, Qbigg, Qnil);
928 #if defined HAVE_MPC && defined WITH_MPC || \
929 defined HAVE_PSEUC && defined WITH_PSEUC
930 } else if (strchr(bigc_converters, ch)) {
931 obj = Fcoerce_number(obj, Qbigc, Qnil);
939 } else if ((NILP(obj) || INTP(obj)) && ch == 'c') {
942 Bufbyte charbuf[MAX_EMCHAR_LEN];
947 a = (Emchar)XINT(obj);
949 if (!valid_char_p(a))
950 error("invalid character value %d to %%c spec", a);
952 charlen = set_charptr_emchar(charbuf, a);
953 doprnt_1(stream, charbuf, charlen,
954 spec->minwidth, -1, spec->minus_flag,
958 } else if ((NILP(obj) || FLOATP(obj)) &&
959 strchr(double_converters, ch)) {
961 /* ASCII Decimal representation uses 2.4 times as many
962 bits as machine binary. */
964 char constructed_spec[100];
965 char *p = constructed_spec;
966 int length, alloca_sz = max_float_print_size;
967 int min = spec->minwidth, prec = spec->precision;
968 int max_spec = sizeof(constructed_spec);
971 /* absolute non-sense :O ...
972 anyone actually computed the size which is stated here?! */
974 32 + max(spec->minwidth,
975 (EMACS_INT)max(sizeof(double), sizeof(long))
976 * 3 + max(spec->precision, 0));
983 if (32+min+prec > alloca_sz)
984 alloca_sz = 32 + min + prec;
986 text_to_print = alloca_array(char, alloca_sz);
988 /* Mostly reconstruct the spec and use sprintf() to
989 format the string. */
994 if (spec->space_flag)
996 if (spec->number_flag)
998 if (spec->minus_flag)
1000 if (spec->zero_flag)
1003 if (spec->minwidth >= 0) {
1004 long_to_string(p, spec->minwidth, max_spec);
1005 max_spec -= strlen(p);
1008 if (spec->precision >= 0) {
1011 long_to_string(p, spec->precision, max_spec);
1012 max_spec -= strlen(p);
1016 #if fpfloat_long_double_p
1024 assert(max_spec >= 0);
1026 length = snprintf(text_to_print, alloca_sz,
1027 constructed_spec, arg.d);
1029 length = snprintf(text_to_print, alloca_sz,
1030 constructed_spec, XFLOAT_DATA(obj));
1032 if (length > alloca_sz) {
1033 /* should we really silently truncate?! */
1036 doprnt_1(stream, (Bufbyte *)text_to_print, length, 0, -1, 0, 0);
1039 } else if ((NILP(obj) || INTP(obj)) && (ch != 'c')) {
1045 XINTobj = XINT(obj);
1047 emacs_doprnt_smZ(stream, XINTobj, spec, ch);
1049 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1050 } else if (BIGZP(obj)) {
1051 emacs_doprnt_Z(stream, obj, spec, ch);
1052 #endif /* HAVE_MPZ */
1053 #if defined HAVE_MPQ && defined WITH_GMP
1054 } else if (BIGQP(obj)) {
1055 emacs_doprnt_Q(stream, obj, spec, ch);
1058 Bufbyte *text_to_print;
1078 (Bufbyte*)bigq_to_string(XBIGQ_DATA(obj), base);
1079 ttp_len = strlen((char*)text_to_print);
1081 /* now maybe print the signed or spaced version */
1082 if ((spec->plus_flag || spec->space_flag) &&
1083 (bigq_sign(XBIGQ_DATA(obj))>=0)) {
1084 XREALLOC_ARRAY(text_to_print, Bufbyte,
1086 memmove(text_to_print+1, text_to_print, ttp_len);
1088 if (spec->plus_flag)
1089 text_to_print[0] = '+';
1090 if (spec->space_flag)
1091 text_to_print[0] = ' ';
1094 /* care about spec->minwidth */
1095 if (ttp_len < spec->minwidth) {
1096 XREALLOC_ARRAY(text_to_print, Bufbyte, spec->minwidth);
1097 if (spec->minus_flag)
1098 memset(text_to_print+ttp_len, ' ',
1099 spec->minwidth-ttp_len);
1101 memmove(text_to_print+spec->minwidth-ttp_len,
1102 text_to_print, ttp_len);
1103 if (spec->zero_flag && spec->precision <= 0)
1104 memset(text_to_print, '0',
1105 spec->minwidth-ttp_len);
1107 memset(text_to_print, ' ',
1108 spec->minwidth-ttp_len);
1110 ttp_len = spec->minwidth;
1113 DOPRNT_AND_FREE(text_to_print, ttp_len);
1116 #endif /* HAVE_MPZ */
1117 #if defined HAVE_MPFR && defined WITH_MPFR
1118 } else if (BIGFRP(obj)) {
1119 Bufbyte *text_to_print;
1121 long preradix_len, postradix_len;
1140 (Bufbyte*)bigfr_to_string(XBIGFR_DATA(obj), base);
1141 ttp_len = strlen((char*)text_to_print);
1143 /* if obj is an infinite point or not-a-number dont care about
1145 * also dont care about space or plus flag since the infinities
1146 * always carry their sign, and not-a-number cannot have a sign
1148 if (bigfr_nan_p(XBIGFR_DATA(obj)) ||
1149 bigfr_inf_p(XBIGFR_DATA(obj))) {
1150 DOPRNT_AND_FREE(text_to_print, ttp_len);
1154 /* examine the lengths of digits before and after
1157 if ((preradix_len = (long int)
1158 (void*)strchr((char *)text_to_print, '.'))) {
1159 preradix_len = preradix_len - (long)text_to_print;
1160 postradix_len = ttp_len - preradix_len - 1;
1162 preradix_len = ttp_len;
1166 /* now cut unwanted places after the decimal dot */
1167 if (postradix_len > spec->precision &&
1168 spec->precision >= 0) {
1169 text_to_print[ttp_len -
1171 spec->precision] = '\0';
1172 ttp_len = ttp_len - postradix_len + spec->precision;
1173 if (spec->precision == 0) {
1174 text_to_print[ttp_len] = '\0';
1178 /* now extend to wanted places after the decimal dot */
1179 } else if (postradix_len < spec->precision &&
1180 postradix_len > 0) {
1181 XREALLOC_ARRAY(text_to_print, Bufbyte,
1182 ttp_len - postradix_len +
1184 text_to_print[preradix_len] = '.';
1185 memset(text_to_print+ttp_len, '0',
1186 spec->precision - postradix_len);
1187 ttp_len = ttp_len - postradix_len + spec->precision;
1189 /* now extend to wanted places, insert a decimal dot first */
1190 } else if (postradix_len < spec->precision &&
1191 postradix_len == 0) {
1192 XREALLOC_ARRAY(text_to_print, Bufbyte,
1193 ttp_len + spec->precision + 1);
1194 text_to_print[preradix_len] = '.';
1195 memset(text_to_print+preradix_len+1, '0',
1197 ttp_len = ttp_len + spec->precision + 1;
1200 /* now maybe print the signed or spaced version */
1201 if ((spec->plus_flag || spec->space_flag) &&
1202 (bigfr_sign(XBIGFR_DATA(obj))>=0)) {
1203 XREALLOC_ARRAY(text_to_print, Bufbyte,
1205 memmove(text_to_print+1, text_to_print, ttp_len);
1207 if (spec->plus_flag)
1208 text_to_print[0] = '+';
1209 if (spec->space_flag)
1210 text_to_print[0] = ' ';
1213 /* care about spec->minwidth */
1214 if (ttp_len < spec->minwidth) {
1215 XREALLOC_ARRAY(text_to_print, Bufbyte, spec->minwidth);
1216 if (spec->minus_flag)
1217 memset(text_to_print+ttp_len, ' ',
1218 spec->minwidth-ttp_len);
1220 memmove(text_to_print+spec->minwidth-ttp_len,
1221 text_to_print, ttp_len);
1222 if (spec->zero_flag && spec->precision <= 0)
1223 memset(text_to_print, '0',
1224 spec->minwidth-ttp_len);
1226 memset(text_to_print, ' ',
1227 spec->minwidth-ttp_len);
1229 ttp_len = spec->minwidth;
1232 DOPRNT_AND_FREE(text_to_print, ttp_len);
1234 #endif /* HAVE_MPFR */
1235 #if defined HAVE_PSEUG && defined WITH_PSEUG
1236 } else if (BIGGP(obj)) {
1238 int old_argnum, old_plus_flag, old_space_flag;
1239 Lisp_Object *modobj = alloca_array(Lisp_Object, 1);
1241 /* Actually, %a.bB is a rewrite for %a.bd%+a.bd */
1243 old_argnum = spec->argnum;
1244 old_plus_flag = spec->plus_flag;
1245 old_space_flag = spec->space_flag;
1247 /* rewrite the real part */
1249 modobj[0] = Freal_part(obj);
1250 emacs_doprnt_number(stream, modobj, args, spec, 'Z');
1252 /* rewrite the imaginary part */
1254 spec->plus_flag = 1;
1255 spec->space_flag = 0;
1256 modobj[0] = Fimaginary_part(obj);
1257 emacs_doprnt_number(stream, modobj, args, spec, 'Z');
1258 /* print the imaginary unit now */
1259 doprnt_1(stream, (Bufbyte*)"i", 1, 1, -1, 0, 0);
1261 spec->argnum = old_argnum;
1262 spec->plus_flag = old_plus_flag;
1263 spec->space_flag = old_space_flag;
1265 #endif /* HAVE_PSEUG */
1266 #if defined HAVE_MPC && defined WITH_MPC || \
1267 defined HAVE_PSEUC && defined WITH_PSEUC
1268 } else if (BIGCP(obj)) {
1270 int old_argnum, old_plus_flag, old_space_flag;
1271 Lisp_Object *modobj = alloca_array(Lisp_Object, 1);
1273 /* Actually, %a.bC is a rewrite for %a.bF%+a.bF */
1275 old_argnum = spec->argnum;
1276 old_plus_flag = spec->plus_flag;
1277 old_space_flag = spec->space_flag;
1279 /* rewrite the real part */
1281 modobj[0] = Freal_part(obj);
1282 emacs_doprnt_number(stream, modobj, args, spec, 'F');
1284 /* rewrite the imaginary part */
1286 spec->plus_flag = 1;
1287 spec->space_flag = 0;
1288 modobj[0] = Fimaginary_part(obj);
1289 emacs_doprnt_number(stream, modobj, args, spec, 'F');
1290 /* print the imaginary unit now */
1291 doprnt_1(stream, (Bufbyte*)"i", 1, 1, -1, 0, 0);
1293 spec->argnum = old_argnum;
1294 spec->plus_flag = old_plus_flag;
1295 spec->space_flag = old_space_flag;
1297 #endif /* HAVE_MPC */
1303 emacs_doprnt_1(Lisp_Object stream, const Bufbyte * format_nonreloc,
1304 Lisp_Object format_reloc, Bytecount format_length, int nargs,
1305 /* #### Gag me, gag me, gag me */
1306 const Lisp_Object * largs, va_list vargs)
1308 printf_spec_dynarr *specs = 0;
1309 printf_arg_dynarr *args = 0;
1311 int init_byte_count = Lstream_byte_count(XLSTREAM(stream));
1313 if (!NILP(format_reloc)) {
1314 format_nonreloc = XSTRING_DATA(format_reloc);
1315 format_length = XSTRING_LENGTH(format_reloc);
1317 if (format_length < 0)
1319 (Bytecount) strlen((const char *)format_nonreloc);
1321 specs = parse_doprnt_spec(format_nonreloc, format_length);
1324 /* allow too many args for string, but not too few */
1325 if (nargs < get_args_needed(specs))
1326 signal_error(Qwrong_number_of_arguments,
1329 !NILP(format_reloc) ? format_reloc :
1330 make_string(format_nonreloc,
1333 args = get_doprnt_args(specs, vargs);
1336 for (i = 0; specs && i < Dynarr_length(specs); i++) {
1337 printf_spec_t spec = Dynarr_atp(specs, i);
1340 /* Copy the text before */
1341 if (!NILP(format_reloc)) /* refetch in case of GC below */
1342 format_nonreloc = XSTRING_DATA(format_reloc);
1344 doprnt_1(stream, format_nonreloc + spec->text_before,
1345 spec->text_before_len, 0, -1, 0, 0);
1347 ch = spec->converter;
1353 doprnt_1(stream, (Bufbyte *) & ch, 1, 0, -1, 0, 0);
1357 /* The char '*' as converter means the field width, precision
1358 was specified as an argument. Extract the data and forward
1359 it to the next spec, to which it will apply. */
1362 error("Invalid largs and '*' converter in emacs_doprnt_1");
1364 printf_spec_t nextspec = Dynarr_atp(specs, i + 1);
1365 Lisp_Object obj = largs[spec->argnum - 1];
1368 if (spec->forwarding_precision) {
1369 nextspec->precision = XINT(obj);
1370 nextspec->minwidth = spec->minwidth;
1372 nextspec->minwidth = XINT(obj);
1373 if (XINT(obj) < 0) {
1374 spec->minus_flag = 1;
1375 nextspec->minwidth =
1376 -nextspec->minwidth;
1379 nextspec->minus_flag = spec->minus_flag;
1380 nextspec->plus_flag = spec->plus_flag;
1381 nextspec->space_flag = spec->space_flag;
1382 nextspec->number_flag = spec->number_flag;
1383 nextspec->zero_flag = spec->zero_flag;
1389 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
1390 error("Invalid repositioning argument %d",
1393 else if (ch == 'S' || ch == 's') {
1395 Bytecount string_len;
1398 string = Dynarr_at(args, spec->argnum - 1).bp;
1399 /* error() can be called with null string
1400 arguments. E.g., in fileio.c, the return
1401 value of strerror() is never checked. We'll
1402 print (null), like some printf
1403 implementations do. Would it be better (and
1404 safe) to signal an error instead? Or should
1405 we just use the empty string?
1406 -dkindred@cs.cmu.edu 8/1997
1409 string = (Bufbyte *) "(null)";
1410 string_len = strlen((char *)string);
1412 Lisp_Object obj = largs[spec->argnum - 1];
1416 /* For `S', prin1 the argument and
1417 * then treat like a string.
1420 Fprin1_to_string(obj, Qnil);
1422 } else if (STRINGP(obj)) {
1424 } else if (SYMBOLP(obj)) {
1425 ls = XSYMBOL(obj)->name;
1427 /* convert to string using princ. */
1429 Fprin1_to_string(obj, Qt);
1432 string = string_data(ls);
1433 string_len = string_length(ls);
1436 doprnt_1(stream, string, string_len, spec->minwidth,
1437 spec->precision, spec->minus_flag,
1440 /* Must be a number. */
1441 emacs_doprnt_number(stream, largs, args, spec, ch);
1445 /* #### will not get freed if error */
1450 return Lstream_byte_count(XLSTREAM(stream)) - init_byte_count;
1453 /* You really don't want to know why this is necessary... */
1455 emacs_doprnt_2(Lisp_Object stream, const Bufbyte * format_nonreloc,
1456 Lisp_Object format_reloc, Bytecount format_length, int nargs,
1457 const Lisp_Object * largs, ...)
1461 va_start(vargs, largs);
1462 val = emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1463 format_length, nargs, largs, vargs);
1468 /*********************** external entry points ***********************/
1471 /* A note about I18N3 translating: the format string should get
1472 translated, but not under all circumstances. When the format
1473 string is a Lisp string, what should happen is that Fformat()
1474 should format the untranslated args[0] and return that, and also
1475 call Fgettext() on args[0] and, if that is different, format it
1476 and store it in the `string-translatable' property of
1477 the returned string. See Fgettext(). */
1480 /* Send formatted output to STREAM. The format string comes from
1481 either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
1482 strlen() to determine the length) or from FORMAT_RELOC, which
1483 should be a Lisp string. Return the number of bytes written
1486 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
1487 parameter, because this function can cause GC. */
1490 emacs_doprnt_c(Lisp_Object stream, const Bufbyte * format_nonreloc,
1491 Lisp_Object format_reloc, Bytecount format_length, ...)
1496 va_start(vargs, format_length);
1497 val = emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1498 format_length, 0, 0, vargs);
1503 /* Like emacs_doprnt_c but the args come in va_list format. */
1506 emacs_doprnt_va(Lisp_Object stream, const Bufbyte * format_nonreloc,
1507 Lisp_Object format_reloc, Bytecount format_length,
1510 return emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1511 format_length, 0, 0, vargs);
1514 /* Like emacs_doprnt_c but the args are Lisp objects instead of
1515 C arguments. This causes somewhat different behavior from
1516 the above two functions (which should act like printf).
1517 See `format' for a description of this behavior. */
1520 emacs_doprnt_lisp(Lisp_Object stream, const Bufbyte * format_nonreloc,
1521 Lisp_Object format_reloc, Bytecount format_length,
1522 int nargs, const Lisp_Object * largs)
1524 return emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1525 format_length, nargs, largs);
1528 /* Like the previous function but takes a variable number of arguments. */
1531 emacs_doprnt_lisp_2(Lisp_Object stream, const Bufbyte * format_nonreloc,
1532 Lisp_Object format_reloc, Bytecount format_length,
1537 Lisp_Object *foo = alloca_array(Lisp_Object, nargs);
1539 va_start(vargs, nargs);
1540 for (i = 0; i < nargs; i++)
1541 foo[i] = va_arg(vargs, Lisp_Object);
1544 return emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1545 format_length, nargs, foo);
1548 /* The following four functions work like the above three but
1549 return their output as a Lisp string instead of sending it
1553 emacs_doprnt_string_c(const Bufbyte * format_nonreloc,
1554 Lisp_Object format_reloc, Bytecount format_length, ...)
1558 Lisp_Object stream = make_resizing_buffer_output_stream();
1559 struct gcpro gcpro1;
1562 va_start(vargs, format_length);
1563 emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1564 format_length, 0, 0, vargs);
1566 Lstream_flush(XLSTREAM(stream));
1567 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1568 Lstream_byte_count(XLSTREAM(stream)));
1570 Lstream_delete(XLSTREAM(stream));
1575 emacs_doprnt_string_va(const Bufbyte * format_nonreloc,
1576 Lisp_Object format_reloc, Bytecount format_length,
1579 /* I'm fairly sure that this function cannot actually GC.
1580 That can only happen when the arguments to emacs_doprnt_1() are
1581 Lisp objects rather than C args. */
1583 Lisp_Object stream = make_resizing_buffer_output_stream();
1584 struct gcpro gcpro1;
1587 emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1588 format_length, 0, 0, vargs);
1589 Lstream_flush(XLSTREAM(stream));
1590 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1591 Lstream_byte_count(XLSTREAM(stream)));
1593 Lstream_delete(XLSTREAM(stream));
1598 emacs_doprnt_string_lisp(const Bufbyte * format_nonreloc,
1599 Lisp_Object format_reloc, Bytecount format_length,
1600 int nargs, const Lisp_Object * largs)
1603 Lisp_Object stream = make_resizing_buffer_output_stream();
1604 struct gcpro gcpro1;
1607 emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1608 format_length, nargs, largs);
1609 Lstream_flush(XLSTREAM(stream));
1610 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1611 Lstream_byte_count(XLSTREAM(stream)));
1613 Lstream_delete(XLSTREAM(stream));
1618 emacs_doprnt_string_lisp_2(const Bufbyte * format_nonreloc,
1619 Lisp_Object format_reloc, Bytecount format_length,
1623 Lisp_Object stream = make_resizing_buffer_output_stream();
1624 struct gcpro gcpro1;
1627 Lisp_Object *foo = alloca_array(Lisp_Object, nargs);
1629 va_start(vargs, nargs);
1630 for (i = 0; i < nargs; i++)
1631 foo[i] = va_arg(vargs, Lisp_Object);
1635 emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1636 format_length, nargs, foo);
1637 Lstream_flush(XLSTREAM(stream));
1638 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1639 Lstream_byte_count(XLSTREAM(stream)));
1641 Lstream_delete(XLSTREAM(stream));