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);
402 for (i = 1; i <= args_needed; i++) {
405 printf_spec_t spec = 0;
407 for (j = 0; j < Dynarr_length(specs); j++) {
408 spec = Dynarr_atp(specs, j);
409 if (spec->argnum == i) {
414 if (j == Dynarr_length(specs))
415 error("No conversion spec for argument %d", i);
417 ch = spec->converter;
419 if (strchr(int_converters, ch)) {
421 arg.l = va_arg(vargs, long);
423 /* int even if ch == 'c' or spec->h_flag: "the
424 type used in va_arg is supposed to match the
425 actual type **after default promotions**."
426 Hence we read an int, not a short, if
428 arg.l = va_arg(vargs, int);
429 } else if (strchr(base_converters, ch)) {
431 arg.l = va_arg(vargs, int);
433 /* unsigned int even if ch == 'c'
435 arg.l = va_arg(vargs, int);
437 } else if (strchr(double_converters, ch)) {
438 arg.d = va_arg(vargs, double);
439 } else if (strchr(string_converters, ch)) {
440 arg.bp = va_arg(vargs, Bufbyte *);
441 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
442 defined HAVE_MPQ && defined WITH_GMP
443 } else if (strchr(bigz_converters, ch)) {
444 arg.obj = va_arg(vargs, Lisp_Object);
446 #if defined HAVE_MPF && defined WITH_GMP || \
447 defined HAVE_MPFR && defined WITH_MPFR
448 } else if (strchr(bigf_converters, ch)) {
449 arg.obj = va_arg(vargs, Lisp_Object);
454 Dynarr_add(args, arg);
460 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
461 Output goes in BUFFER, which has room for BUFSIZE bytes.
462 If the output does not fit, truncate it to fit.
463 Returns the number of bytes stored into BUFFER.
464 LARGS or VARGS points to the arguments, and NARGS says how many.
465 if LARGS is non-zero, it should be a pointer to NARGS worth of
466 Lisp arguments. Otherwise, VARGS should be a va_list referring
470 /* we divide the emacs_doprnt_1 into readable chunks */
472 static void emacs_doprnt_number(
473 Lisp_Object, const Lisp_Object *,
474 printf_arg_dynarr *, printf_spec_t, char);
477 #define DOPRNT_AND_FREE(b, l) \
479 doprnt_1(stream, b, l, 0, -1, 0, 0); \
484 __ulong_to_bit_string(char *p, long unsigned int number)
486 int i, seen_high_order = 0;
489 for (i = ((SIZEOF_LONG * 8) - 1); i >= 0; --i) {
490 if (number & 1UL << i) {
494 if (seen_high_order) {
500 return (int)(p - origp);
504 __nnaughts(printf_spec_t s, int nlen, int tlen)
506 /* return the number of naughts to insert, given specs S and a
507 * pure length of the number of NLEN and a overall length of the
509 * the result will always be nonnegative */
513 if (UNLIKELY(s->precision == 0)) {
516 } else if (s->precision > 0) {
517 if ((result = s->precision - nlen) < 0) {
520 } else if (s->zero_flag && !s->minus_flag) {
521 /* in this case use s->minwidth */
522 if ((result = s->minwidth - tlen) < 0) {
530 __bsize_smZ(printf_spec_t s, EMACS_INT UNUSED(Z))
531 __attribute__((always_inline));
533 __bsize_smZ(printf_spec_t s, EMACS_INT UNUSED(Z))
535 return 32 + s->minwidth + sizeof(long int) *
536 /* if binary representation is wanted, use an
537 * awful lot more space */
538 (s->converter != 'b' ? 3 : 8) + s->precision +
539 3 /* for 0x and friends */;
542 #if defined HAVE_MPZ && defined WITH_GMP
544 __bsize_Z(printf_spec_t s, bigz Z)
545 __attribute__((always_inline));
547 __bsize_Z(printf_spec_t s, bigz Z)
551 switch (s->converter) {
553 ms = mpz_sizeinbase(Z, 10);
557 ms = mpz_sizeinbase(Z, 16);
560 ms = mpz_sizeinbase(Z, 8);
563 ms = mpz_sizeinbase(Z, 2);
566 if ((long int)ms < s->minwidth) {
567 return 32 + s->minwidth + s->precision +
568 3 /* for 0x and friends */;
570 return 32 + ms + s->precision + 3;
575 __bsize_Q(printf_spec_t s, bigq Q)
576 __attribute__((always_inline));
578 __bsize_Q(printf_spec_t s, bigq Q)
583 switch (s->converter) {
598 ms = mpz_sizeinbase(mpq_numref(Q), base)
599 + mpz_sizeinbase(mpq_denref(Q), base) + 3;
601 if ((long int)ms < s->minwidth) {
602 return 32 + s->minwidth + s->precision +
603 3 /* for 0x and friends */;
605 return 32 + ms + s->precision + 3;
608 #endif /* HAVE_MPZ && HAVE_GMP */
610 #define __assign_sign_Z(s, p) \
612 if (s->negativep) { \
614 } else if (s->plus_flag) { \
616 } else if (s->space_flag && \
617 !s->lisp_reader_syntax) { \
623 __postproc2(printf_spec_t s, char *restrict, size_t, size_t)
624 __attribute__((always_inline));
626 __postproc2(printf_spec_t s, char *restrict text, size_t text_len, size_t allsz)
628 int nnaughts = 0, num_len = text_len;
629 int ini_len = 0, pre_len = 0, post_len = 0;
630 char *restrict num, *restrict ini, *restrict pre, *restrict post;
631 bool base_conv = (strchr(base_converters, s->converter) != NULL);
633 /* determine how much stuff to put in front */
634 if (base_conv && s->number_flag) {
637 if (s->negativep || s->plus_flag ||
638 (s->space_flag && !s->lisp_reader_syntax)) {
641 /* determine the number of zeroes */
642 text_len = num_len + ini_len;
643 text_len += (nnaughts = __nnaughts(s, num_len, text_len));
645 if ((long int)text_len < s->minwidth) {
647 post_len = s->minwidth - num_len;
649 pre_len = s->minwidth - text_len;
651 text_len = s->minwidth;
654 /* move the number to the final location */
655 pre = text + pre_len;
657 num = ini + nnaughts;
658 post = num + num_len;
659 memmove(num, text, num_len);
662 if (LIKELY(!s->sign_after_hash_flag)) {
663 __assign_sign_Z(s, pre);
667 if (base_conv && s->number_flag) {
668 if (LIKELY(!s->lisp_reader_syntax)) {
673 /* the idea behind that is to just swap the
674 * leading zero with a # et voila the number
675 * can be read in again
677 switch (s->converter) {
695 if (UNLIKELY(s->sign_after_hash_flag)) {
696 __assign_sign_Z(s, pre);
699 /* we pad with zeroes before the number, if desired */
701 memset(ini, '0', nnaughts);
704 /* care about s->minwidth, we move the entire immobile block */
706 memset(post, s->pad_char, post_len);
708 memset(text, s->pad_char, pre_len);
714 emacs_doprnt_smZ(Lisp_Object stream, EMACS_INT Z, printf_spec_t s, char ch)
716 /* ASCII Decimal representation uses 2.4 times as many
717 bits as machine binary. */
718 char constructed_spec[100];
719 char *p = constructed_spec;
720 int alloc_sz = __bsize_smZ(s, Z), text_len = 0;
721 /* get a chunk of space to load off the result */
722 /* C99 we need you so badly */
726 *p++ = 'l'; /* use long */
730 s->negativep = Z < 0L;
731 if (ch != 'b' && Z < 0L) {
732 /* We cannot simply use sprintf,
733 * sprintf would return a two-complement
734 * on negative numbers
735 * however for further movements we hav to advance
736 * cruft_len because that minus char must stay
738 text_len = snprintf(text, alloc_sz, constructed_spec, -Z);
739 } else if (ch != 'b' /* && Z >= 0L */) {
740 text_len = snprintf(text, alloc_sz, constructed_spec, Z);
741 } else if (ch == 'b' && Z < 0) {
742 text_len = __ulong_to_bit_string(text, -Z);
743 } else /* ch == 'b' */ {
744 text_len = __ulong_to_bit_string(text, Z);
747 /* postprocess, move stuff around, insert naughts, etc. */
748 text_len = __postproc2(s, text, text_len, alloc_sz);
750 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
754 #if defined(HAVE_MPZ) && defined WITH_GMP
756 emacs_doprnt_Z(Lisp_Object stream, Lisp_Object obj, printf_spec_t s, char ch)
759 int alloc_sz = __bsize_Z(s, XBIGZ_DATA(obj)), text_len = 0;
760 /* get a chunk of space to load off the result */
761 /* C99 we need you so badly */
779 s->negativep = bigz_sign(XBIGZ_DATA(obj)) < 0;
780 bigz_to_string2(text, XBIGZ_DATA(obj), base);
781 text_len = strlen(text);
783 /* special case %X, MPZ does not upcase hex chars,
784 * so we have to do it here
788 for (q = (char*)text; *q != '\0'; q++) {
789 if (strchr("abcdef", *q))
795 text_len = __postproc2(s, text, text_len, alloc_sz);
796 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
799 text_len = __postproc2(s, text+1, text_len-1, alloc_sz);
800 doprnt_1(stream, (Bufbyte*)text+1, text_len, 0, -1, 0, 0);
806 emacs_doprnt_Q(Lisp_Object stream, Lisp_Object obj, printf_spec_t s, char ch)
808 int alloc_sz = __bsize_Q(s, XBIGQ_DATA(obj)), text_len = 0;
809 /* get a chunk of space to load off the result */
810 /* C99 we need you so badly */
813 s->negativep = bigq_sign(XBIGQ_DATA(obj)) < 0;
814 /* the following two are meaningless for rationals */
815 s->zero_flag = false;
818 bigq_to_string2(text, XBIGQ_DATA(obj), 10);
819 text_len = strlen(text);
821 /* special case %X, MPZ does not upcase hex chars,
822 * so we have to do it here
826 for (q = (char*)text; *q != '\0'; q++) {
827 if (strchr("abcdef", *q))
833 text_len = __postproc2(s, text, text_len, alloc_sz);
834 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
837 text_len = __postproc2(s, text+1, text_len-1, alloc_sz);
838 doprnt_1(stream, (Bufbyte*)text+1, text_len, 0, -1, 0, 0);
842 #endif /* HAVE_MPZ && WITH_GMP */
845 emacs_doprnt_number(Lisp_Object stream,
846 const Lisp_Object *largs,
847 printf_arg_dynarr *args,
851 /* Must be a number. */
856 arg = Dynarr_at(args, spec->argnum - 1);
859 obj = largs[spec->argnum - 1];
861 obj = make_int(XCHAR(obj));
863 obj = make_int(marker_position(obj));
866 if (!NUMBERP(obj) && !NILP(obj)) {
867 error("format specifier %%%c "
868 "doesn't match argument type", ch);
873 } else if (ch == 'c') {
874 /* always convert to int if we deal with characters */
875 obj = Fcoerce_number(obj, Qint, Qnil);
877 } else if (strchr(int_converters, ch) && (ch != 'c')) {
878 obj = Fcoerce_number(obj, Qinteger, Qnil);
880 } else if (strchr(base_converters, ch)) {
881 /* must that really be int?
882 * The ENT libraries have support for printing floats
883 * or fractions in hex and octal
885 obj = Fcoerce_number(obj, Qinteger, Qnil);
887 } else if (strchr(double_converters, ch)) {
888 obj = Fcoerce_number(obj, Qfloat, Qnil);
890 #if defined(HAVE_MPZ) && (defined WITH_GMP || defined WITH_MP)
891 } else if (ch == 'Z') {
892 obj = Fcoerce_number(obj, Qbigz, Qnil);
894 #endif /* HAVE_MPZ */
895 #if defined(HAVE_MPQ) && defined WITH_GMP
896 } else if (ch == 'Q') {
897 obj = Fcoerce_number(obj, Qbigq, Qnil);
899 #endif /* HAVE_MPQ */
900 #if defined(HAVE_MPFR) && defined WITH_MPFR
901 } else if (ch == 'F') {
902 obj = Fcoerce_number(obj, Qbigfr, Qnil);
904 #elif defined(HAVE_MPF) && defined WITH_GMP
905 } else if (ch == 'F') {
906 obj = Fcoerce_number(obj, Qbigf, Qnil);
908 #endif /* HAVE_MPFR || HAVE_MPF */
909 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
910 defined(HAVE_MPF) && defined WITH_GMP
911 } else if (ch == 'R') {
912 obj = Fcoerce_number(obj, Qreal, Qnil);
919 #if defined(HAVE_PSEUG) && defined WITH_PSEUG
920 } else if (strchr(bigg_converters, ch)) {
921 obj = Fcoerce_number(obj, Qbigg, Qnil);
924 #if defined HAVE_MPC && defined WITH_MPC || \
925 defined HAVE_PSEUC && defined WITH_PSEUC
926 } else if (strchr(bigc_converters, ch)) {
927 obj = Fcoerce_number(obj, Qbigc, Qnil);
935 } else if ((NILP(obj) || INTP(obj)) && ch == 'c') {
938 Bufbyte charbuf[MAX_EMCHAR_LEN];
943 a = (Emchar)XINT(obj);
945 if (!valid_char_p(a))
946 error("invalid character value %d to %%c spec", a);
948 charlen = set_charptr_emchar(charbuf, a);
949 doprnt_1(stream, charbuf, charlen,
950 spec->minwidth, -1, spec->minus_flag,
954 } else if ((NILP(obj) || FLOATP(obj)) &&
955 strchr(double_converters, ch)) {
957 /* ASCII Decimal representation uses 2.4 times as many
958 bits as machine binary. */
960 char constructed_spec[100];
961 char *p = constructed_spec;
962 int length, alloca_sz = max_float_print_size;
963 int min = spec->minwidth, prec = spec->precision;
966 /* absolute non-sense :O ...
967 anyone actually computed the size which is stated here?! */
969 32 + max(spec->minwidth,
970 (EMACS_INT)max(sizeof(double), sizeof(long))
971 * 3 + max(spec->precision, 0));
978 if (32+min+prec > alloca_sz)
979 alloca_sz = 32 + min + prec;
981 text_to_print = alloca_array(char, alloca_sz);
983 /* Mostly reconstruct the spec and use sprintf() to
984 format the string. */
989 if (spec->space_flag)
991 if (spec->number_flag)
993 if (spec->minus_flag)
998 if (spec->minwidth >= 0) {
999 long_to_string(p, spec->minwidth);
1002 if (spec->precision >= 0) {
1004 long_to_string(p, spec->precision);
1008 #if fpfloat_long_double_p
1014 length = snprintf(text_to_print, alloca_sz,
1015 constructed_spec, arg.d);
1017 length = snprintf(text_to_print, alloca_sz,
1018 constructed_spec, XFLOAT_DATA(obj));
1020 if (length > alloca_sz)
1023 doprnt_1(stream, (Bufbyte *)text_to_print, length, 0, -1, 0, 0);
1026 } else if ((NILP(obj) || INTP(obj)) && (ch != 'c')) {
1032 XINTobj = XINT(obj);
1034 emacs_doprnt_smZ(stream, XINTobj, spec, ch);
1036 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1037 } else if (BIGZP(obj)) {
1038 emacs_doprnt_Z(stream, obj, spec, ch);
1039 #endif /* HAVE_MPZ */
1040 #if defined HAVE_MPQ && defined WITH_GMP
1041 } else if (BIGQP(obj)) {
1042 emacs_doprnt_Q(stream, obj, spec, ch);
1045 Bufbyte *text_to_print;
1065 (Bufbyte*)bigq_to_string(XBIGQ_DATA(obj), base);
1066 ttp_len = strlen((char*)text_to_print);
1068 /* now maybe print the signed or spaced version */
1069 if ((spec->plus_flag || spec->space_flag) &&
1070 (bigq_sign(XBIGQ_DATA(obj))>=0)) {
1071 XREALLOC_ARRAY(text_to_print, Bufbyte,
1073 memmove(text_to_print+1, text_to_print, ttp_len);
1075 if (spec->plus_flag)
1076 text_to_print[0] = '+';
1077 if (spec->space_flag)
1078 text_to_print[0] = ' ';
1081 /* care about spec->minwidth */
1082 if (ttp_len < spec->minwidth) {
1083 XREALLOC_ARRAY(text_to_print, Bufbyte, spec->minwidth);
1084 if (spec->minus_flag)
1085 memset(text_to_print+ttp_len, ' ',
1086 spec->minwidth-ttp_len);
1088 memmove(text_to_print+spec->minwidth-ttp_len,
1089 text_to_print, ttp_len);
1090 if (spec->zero_flag && spec->precision <= 0)
1091 memset(text_to_print, '0',
1092 spec->minwidth-ttp_len);
1094 memset(text_to_print, ' ',
1095 spec->minwidth-ttp_len);
1097 ttp_len = spec->minwidth;
1100 DOPRNT_AND_FREE(text_to_print, ttp_len);
1103 #endif /* HAVE_MPZ */
1104 #if defined HAVE_MPFR && defined WITH_MPFR
1105 } else if (BIGFRP(obj)) {
1106 Bufbyte *text_to_print;
1108 long preradix_len, postradix_len;
1127 (Bufbyte*)bigfr_to_string(XBIGFR_DATA(obj), base);
1128 ttp_len = strlen((char*)text_to_print);
1130 /* if obj is an infinite point or not-a-number dont care about
1132 * also dont care about space or plus flag since the infinities
1133 * always carry their sign, and not-a-number cannot have a sign
1135 if (bigfr_nan_p(XBIGFR_DATA(obj)) ||
1136 bigfr_inf_p(XBIGFR_DATA(obj))) {
1137 DOPRNT_AND_FREE(text_to_print, ttp_len);
1141 /* examine the lengths of digits before and after
1144 if ((preradix_len = (long int)
1145 (void*)strchr((char *)text_to_print, '.'))) {
1146 preradix_len = preradix_len - (long)text_to_print;
1147 postradix_len = ttp_len - preradix_len - 1;
1149 preradix_len = ttp_len;
1153 /* now cut unwanted places after the decimal dot */
1154 if (postradix_len > spec->precision &&
1155 spec->precision >= 0) {
1156 text_to_print[ttp_len -
1158 spec->precision] = '\0';
1159 ttp_len = ttp_len - postradix_len + spec->precision;
1160 if (spec->precision == 0) {
1161 text_to_print[ttp_len] = '\0';
1165 /* now extend to wanted places after the decimal dot */
1166 } else if (postradix_len < spec->precision &&
1167 postradix_len > 0) {
1168 XREALLOC_ARRAY(text_to_print, Bufbyte,
1169 ttp_len - postradix_len +
1171 text_to_print[preradix_len] = '.';
1172 memset(text_to_print+ttp_len, '0',
1173 spec->precision - postradix_len);
1174 ttp_len = ttp_len - postradix_len + spec->precision;
1176 /* now extend to wanted places, insert a decimal dot first */
1177 } else if (postradix_len < spec->precision &&
1178 postradix_len == 0) {
1179 XREALLOC_ARRAY(text_to_print, Bufbyte,
1180 ttp_len + spec->precision + 1);
1181 text_to_print[preradix_len] = '.';
1182 memset(text_to_print+preradix_len+1, '0',
1184 ttp_len = ttp_len + spec->precision + 1;
1187 /* now maybe print the signed or spaced version */
1188 if ((spec->plus_flag || spec->space_flag) &&
1189 (bigfr_sign(XBIGFR_DATA(obj))>=0)) {
1190 XREALLOC_ARRAY(text_to_print, Bufbyte,
1192 memmove(text_to_print+1, text_to_print, ttp_len);
1194 if (spec->plus_flag)
1195 text_to_print[0] = '+';
1196 if (spec->space_flag)
1197 text_to_print[0] = ' ';
1200 /* care about spec->minwidth */
1201 if (ttp_len < spec->minwidth) {
1202 XREALLOC_ARRAY(text_to_print, Bufbyte, spec->minwidth);
1203 if (spec->minus_flag)
1204 memset(text_to_print+ttp_len, ' ',
1205 spec->minwidth-ttp_len);
1207 memmove(text_to_print+spec->minwidth-ttp_len,
1208 text_to_print, ttp_len);
1209 if (spec->zero_flag && spec->precision <= 0)
1210 memset(text_to_print, '0',
1211 spec->minwidth-ttp_len);
1213 memset(text_to_print, ' ',
1214 spec->minwidth-ttp_len);
1216 ttp_len = spec->minwidth;
1219 DOPRNT_AND_FREE(text_to_print, ttp_len);
1221 #endif /* HAVE_MPFR */
1222 #if defined HAVE_PSEUG && defined WITH_PSEUG
1223 } else if (BIGGP(obj)) {
1225 int old_argnum, old_plus_flag, old_space_flag;
1226 Lisp_Object *modobj = alloca_array(Lisp_Object, 1);
1228 /* Actually, %a.bB is a rewrite for %a.bd%+a.bd */
1230 old_argnum = spec->argnum;
1231 old_plus_flag = spec->plus_flag;
1232 old_space_flag = spec->space_flag;
1234 /* rewrite the real part */
1236 modobj[0] = Freal_part(obj);
1237 emacs_doprnt_number(stream, modobj, args, spec, 'Z');
1239 /* rewrite the imaginary part */
1241 spec->plus_flag = 1;
1242 spec->space_flag = 0;
1243 modobj[0] = Fimaginary_part(obj);
1244 emacs_doprnt_number(stream, modobj, args, spec, 'Z');
1245 /* print the imaginary unit now */
1246 doprnt_1(stream, (Bufbyte*)"i", 1, 1, -1, 0, 0);
1248 spec->argnum = old_argnum;
1249 spec->plus_flag = old_plus_flag;
1250 spec->space_flag = old_space_flag;
1252 #endif /* HAVE_PSEUG */
1253 #if defined HAVE_MPC && defined WITH_MPC || \
1254 defined HAVE_PSEUC && defined WITH_PSEUC
1255 } else if (BIGCP(obj)) {
1257 int old_argnum, old_plus_flag, old_space_flag;
1258 Lisp_Object *modobj = alloca_array(Lisp_Object, 1);
1260 /* Actually, %a.bC is a rewrite for %a.bF%+a.bF */
1262 old_argnum = spec->argnum;
1263 old_plus_flag = spec->plus_flag;
1264 old_space_flag = spec->space_flag;
1266 /* rewrite the real part */
1268 modobj[0] = Freal_part(obj);
1269 emacs_doprnt_number(stream, modobj, args, spec, 'F');
1271 /* rewrite the imaginary part */
1273 spec->plus_flag = 1;
1274 spec->space_flag = 0;
1275 modobj[0] = Fimaginary_part(obj);
1276 emacs_doprnt_number(stream, modobj, args, spec, 'F');
1277 /* print the imaginary unit now */
1278 doprnt_1(stream, (Bufbyte*)"i", 1, 1, -1, 0, 0);
1280 spec->argnum = old_argnum;
1281 spec->plus_flag = old_plus_flag;
1282 spec->space_flag = old_space_flag;
1284 #endif /* HAVE_MPC */
1290 emacs_doprnt_1(Lisp_Object stream, const Bufbyte * format_nonreloc,
1291 Lisp_Object format_reloc, Bytecount format_length, int nargs,
1292 /* #### Gag me, gag me, gag me */
1293 const Lisp_Object * largs, va_list vargs)
1295 printf_spec_dynarr *specs = 0;
1296 printf_arg_dynarr *args = 0;
1298 int init_byte_count = Lstream_byte_count(XLSTREAM(stream));
1300 if (!NILP(format_reloc)) {
1301 format_nonreloc = XSTRING_DATA(format_reloc);
1302 format_length = XSTRING_LENGTH(format_reloc);
1304 if (format_length < 0)
1306 (Bytecount) strlen((const char *)format_nonreloc);
1308 specs = parse_doprnt_spec(format_nonreloc, format_length);
1311 /* allow too many args for string, but not too few */
1312 if (nargs < get_args_needed(specs))
1313 signal_error(Qwrong_number_of_arguments,
1316 !NILP(format_reloc) ? format_reloc :
1317 make_string(format_nonreloc,
1320 args = get_doprnt_args(specs, vargs);
1323 for (i = 0; i < Dynarr_length(specs); i++) {
1324 printf_spec_t spec = Dynarr_atp(specs, i);
1327 /* Copy the text before */
1328 if (!NILP(format_reloc)) /* refetch in case of GC below */
1329 format_nonreloc = XSTRING_DATA(format_reloc);
1331 doprnt_1(stream, format_nonreloc + spec->text_before,
1332 spec->text_before_len, 0, -1, 0, 0);
1334 ch = spec->converter;
1340 doprnt_1(stream, (Bufbyte *) & ch, 1, 0, -1, 0, 0);
1344 /* The char '*' as converter means the field width, precision
1345 was specified as an argument. Extract the data and forward
1346 it to the next spec, to which it will apply. */
1348 printf_spec_t nextspec = Dynarr_atp(specs, i + 1);
1349 Lisp_Object obj = largs[spec->argnum - 1];
1352 if (spec->forwarding_precision) {
1353 nextspec->precision = XINT(obj);
1354 nextspec->minwidth = spec->minwidth;
1356 nextspec->minwidth = XINT(obj);
1357 if (XINT(obj) < 0) {
1358 spec->minus_flag = 1;
1359 nextspec->minwidth =
1360 -nextspec->minwidth;
1363 nextspec->minus_flag = spec->minus_flag;
1364 nextspec->plus_flag = spec->plus_flag;
1365 nextspec->space_flag = spec->space_flag;
1366 nextspec->number_flag = spec->number_flag;
1367 nextspec->zero_flag = spec->zero_flag;
1372 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
1373 error("Invalid repositioning argument %d",
1376 else if (ch == 'S' || ch == 's') {
1378 Bytecount string_len;
1381 string = Dynarr_at(args, spec->argnum - 1).bp;
1382 /* error() can be called with null string
1383 arguments. E.g., in fileio.c, the return
1384 value of strerror() is never checked. We'll
1385 print (null), like some printf
1386 implementations do. Would it be better (and
1387 safe) to signal an error instead? Or should
1388 we just use the empty string?
1389 -dkindred@cs.cmu.edu 8/1997
1392 string = (Bufbyte *) "(null)";
1393 string_len = strlen((char *)string);
1395 Lisp_Object obj = largs[spec->argnum - 1];
1399 /* For `S', prin1 the argument and
1400 * then treat like a string.
1403 Fprin1_to_string(obj, Qnil);
1405 } else if (STRINGP(obj)) {
1407 } else if (SYMBOLP(obj)) {
1408 ls = XSYMBOL(obj)->name;
1410 /* convert to string using princ. */
1412 Fprin1_to_string(obj, Qt);
1415 string = string_data(ls);
1416 string_len = string_length(ls);
1419 doprnt_1(stream, string, string_len, spec->minwidth,
1420 spec->precision, spec->minus_flag,
1423 /* Must be a number. */
1424 emacs_doprnt_number(stream, largs, args, spec, ch);
1428 /* #### will not get freed if error */
1433 return Lstream_byte_count(XLSTREAM(stream)) - init_byte_count;
1436 /* You really don't want to know why this is necessary... */
1438 emacs_doprnt_2(Lisp_Object stream, const Bufbyte * format_nonreloc,
1439 Lisp_Object format_reloc, Bytecount format_length, int nargs,
1440 const Lisp_Object * largs, ...)
1444 va_start(vargs, largs);
1445 val = emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1446 format_length, nargs, largs, vargs);
1451 /*********************** external entry points ***********************/
1454 /* A note about I18N3 translating: the format string should get
1455 translated, but not under all circumstances. When the format
1456 string is a Lisp string, what should happen is that Fformat()
1457 should format the untranslated args[0] and return that, and also
1458 call Fgettext() on args[0] and, if that is different, format it
1459 and store it in the `string-translatable' property of
1460 the returned string. See Fgettext(). */
1463 /* Send formatted output to STREAM. The format string comes from
1464 either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
1465 strlen() to determine the length) or from FORMAT_RELOC, which
1466 should be a Lisp string. Return the number of bytes written
1469 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
1470 parameter, because this function can cause GC. */
1473 emacs_doprnt_c(Lisp_Object stream, const Bufbyte * format_nonreloc,
1474 Lisp_Object format_reloc, Bytecount format_length, ...)
1479 va_start(vargs, format_length);
1480 val = emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1481 format_length, 0, 0, vargs);
1486 /* Like emacs_doprnt_c but the args come in va_list format. */
1489 emacs_doprnt_va(Lisp_Object stream, const Bufbyte * format_nonreloc,
1490 Lisp_Object format_reloc, Bytecount format_length,
1493 return emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1494 format_length, 0, 0, vargs);
1497 /* Like emacs_doprnt_c but the args are Lisp objects instead of
1498 C arguments. This causes somewhat different behavior from
1499 the above two functions (which should act like printf).
1500 See `format' for a description of this behavior. */
1503 emacs_doprnt_lisp(Lisp_Object stream, const Bufbyte * format_nonreloc,
1504 Lisp_Object format_reloc, Bytecount format_length,
1505 int nargs, const Lisp_Object * largs)
1507 return emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1508 format_length, nargs, largs);
1511 /* Like the previous function but takes a variable number of arguments. */
1514 emacs_doprnt_lisp_2(Lisp_Object stream, const Bufbyte * format_nonreloc,
1515 Lisp_Object format_reloc, Bytecount format_length,
1520 Lisp_Object *foo = alloca_array(Lisp_Object, nargs);
1522 va_start(vargs, nargs);
1523 for (i = 0; i < nargs; i++)
1524 foo[i] = va_arg(vargs, Lisp_Object);
1527 return emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1528 format_length, nargs, foo);
1531 /* The following four functions work like the above three but
1532 return their output as a Lisp string instead of sending it
1536 emacs_doprnt_string_c(const Bufbyte * format_nonreloc,
1537 Lisp_Object format_reloc, Bytecount format_length, ...)
1541 Lisp_Object stream = make_resizing_buffer_output_stream();
1542 struct gcpro gcpro1;
1545 va_start(vargs, format_length);
1546 emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1547 format_length, 0, 0, vargs);
1549 Lstream_flush(XLSTREAM(stream));
1550 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1551 Lstream_byte_count(XLSTREAM(stream)));
1553 Lstream_delete(XLSTREAM(stream));
1558 emacs_doprnt_string_va(const Bufbyte * format_nonreloc,
1559 Lisp_Object format_reloc, Bytecount format_length,
1562 /* I'm fairly sure that this function cannot actually GC.
1563 That can only happen when the arguments to emacs_doprnt_1() are
1564 Lisp objects rather than C args. */
1566 Lisp_Object stream = make_resizing_buffer_output_stream();
1567 struct gcpro gcpro1;
1570 emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1571 format_length, 0, 0, vargs);
1572 Lstream_flush(XLSTREAM(stream));
1573 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1574 Lstream_byte_count(XLSTREAM(stream)));
1576 Lstream_delete(XLSTREAM(stream));
1581 emacs_doprnt_string_lisp(const Bufbyte * format_nonreloc,
1582 Lisp_Object format_reloc, Bytecount format_length,
1583 int nargs, const Lisp_Object * largs)
1586 Lisp_Object stream = make_resizing_buffer_output_stream();
1587 struct gcpro gcpro1;
1590 emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1591 format_length, nargs, largs);
1592 Lstream_flush(XLSTREAM(stream));
1593 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1594 Lstream_byte_count(XLSTREAM(stream)));
1596 Lstream_delete(XLSTREAM(stream));
1601 emacs_doprnt_string_lisp_2(const Bufbyte * format_nonreloc,
1602 Lisp_Object format_reloc, Bytecount format_length,
1606 Lisp_Object stream = make_resizing_buffer_output_stream();
1607 struct gcpro gcpro1;
1610 Lisp_Object *foo = alloca_array(Lisp_Object, nargs);
1612 va_start(vargs, nargs);
1613 for (i = 0; i < nargs; i++)
1614 foo[i] = va_arg(vargs, Lisp_Object);
1618 emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1619 format_length, nargs, foo);
1620 Lstream_flush(XLSTREAM(stream));
1621 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1622 Lstream_byte_count(XLSTREAM(stream)));
1624 Lstream_delete(XLSTREAM(stream));