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. */
34 static const char *const valid_flags = "-+ #0";
35 static const char *const valid_converters = "dic" "oxX" "feEgG" "sS" "b"
36 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
37 defined HAVE_MPQ && defined WITH_GMP
40 #if defined HAVE_MPF && defined WITH_GMP || \
41 defined HAVE_MPFR && defined WITH_MPFR
44 #if defined HAVE_PSEUG && defined WITH_PSEUG
47 #if defined HAVE_MPC && defined WITH_MPC || \
48 defined HAVE_PSEUC && defined WITH_PSEUC
52 static const char *const int_converters = "dic";
53 static const char *const base_converters = "boxX";
54 static const char *const double_converters = "feEgG";
55 static const char *const string_converters = "sS";
56 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
57 defined HAVE_MPQ && defined WITH_GMP
58 static const char *const bigz_converters = "ZQ";
60 #if defined HAVE_MPF && defined WITH_GMP || \
61 defined HAVE_MPFR && defined WITH_MPFR
62 static const char *const bigf_converters = "FR";
64 #if defined HAVE_PSEUG && defined WITH_PSEUG
65 static const char *const bigg_converters = "B";
67 #if defined HAVE_MPC && defined WITH_MPC || \
68 defined HAVE_PSEUC && defined WITH_PSEUC
69 static const char *const bigc_converters = "C";
73 typedef struct printf_spec_s *printf_spec_t;
74 typedef struct printf_spec_s printf_spec; /* to make Wing's dynarrs happy */
75 struct printf_spec_s {
76 int argnum; /* which argument does this spec want? This is
77 one-based: The first argument given is
78 numbered 1, the second is 2, etc. This is to
79 handle %##$x-type specs. */
86 /* print 0x78 instead of just 78 */
88 /* prefers 0x-2 to -0x2 */
89 bool sign_after_hash_flag:1;
90 /* uses #x2 instead of 0x2 */
91 bool lisp_reader_syntax:1;
98 bool forwarding_precision:1;
99 /* caching approach */
101 char converter; /* converter character or 0 for dummy marker
102 indicating literal text at the end of the
104 Bytecount text_before; /* position of the first character of the
105 block of literal text before this spec */
106 Bytecount text_before_len; /* length of that text */
107 char pad_char; /* char to use for padding */
110 typedef union printf_arg_u printf_arg_t;
111 typedef union printf_arg_u printf_arg; /* to make Wing's dynarrs happy */
120 /* We maintain a list of all the % specs in the specification,
121 along with the offset and length of the block of literal text
122 before each spec. In addition, we have a "dummy" spec that
123 represents all the literal text at the end of the specification.
124 Its converter is 0. */
127 Dynarr_declare(struct printf_spec_s);
128 } printf_spec_dynarr;
131 Dynarr_declare(union printf_arg_u);
134 /* Append STRING (of length LEN bytes) to STREAM.
135 MINLEN is the minimum field width.
136 If MINUS_FLAG is set, left-justify the string in its field;
137 otherwise, right-justify.
138 If ZERO_FLAG is set, pad with 0's; otherwise pad with spaces.
139 If MAXLEN is non-negative, the string is first truncated on the
140 right to that many characters.
142 Note that MINLEN and MAXLEN are Charcounts but LEN is a Bytecount. */
145 doprnt_1(Lisp_Object stream, const Bufbyte * string, Bytecount len,
146 Charcount minlen, Charcount maxlen, int minus_flag, int zero_flag)
148 Lstream *lstr = XLSTREAM(stream);
149 Charcount cclen = bytecount_to_charcount(string, len);
150 int to_add = minlen - cclen;
152 /* Padding at beginning to right-justify ... */
155 Lstream_putc(lstr, zero_flag ? '0' : ' ');
157 if (0 <= maxlen && maxlen < cclen)
158 len = charcount_to_bytecount(string, maxlen);
159 Lstream_write(lstr, string, len);
161 /* Padding at end to left-justify ... */
164 Lstream_putc(lstr, zero_flag ? '0' : ' ');
167 static const Bufbyte *parse_off_posnum(const Bufbyte * start,
168 const Bufbyte * end, int *returned_num)
170 Bufbyte arg_convert[100];
171 REGISTER Bufbyte *arg_ptr = arg_convert;
174 while (start != end && isdigit(*start)) {
175 if ((size_t) (arg_ptr - arg_convert) >= sizeof(arg_convert) - 1)
176 error("Format converter number too large");
177 *arg_ptr++ = *start++;
180 if (arg_convert != arg_ptr)
181 *returned_num = atoi((char *)arg_convert);
185 #define NEXT_ASCII_BYTE(ch) \
187 if (fmt == fmt_end) \
188 error ("Premature end of format string"); \
191 error ("Non-ASCII character in format " \
196 #define RESOLVE_FLAG_CONFLICTS(spec) \
198 if (spec.space_flag && spec.plus_flag) \
199 spec.space_flag = 0; \
202 static printf_spec_dynarr *
203 parse_doprnt_spec(const Bufbyte * format, Bytecount format_length)
205 const Bufbyte *fmt = format;
206 const Bufbyte *fmt_end = format + format_length;
207 printf_spec_dynarr *specs = Dynarr_new(printf_spec);
211 struct printf_spec_s spec;
212 const Bufbyte *text_end;
216 if (fmt == fmt_end) {
219 text_end = (Bufbyte *) memchr(fmt, '%', fmt_end - fmt);
223 spec.text_before = fmt - format;
224 spec.text_before_len = text_end - fmt;
227 if (fmt != fmt_end) {
228 fmt++; /* skip over % */
230 /* A % is special -- no arg number.
231 According to ANSI specs, field width does
232 not apply to %% conversion. */
233 if (fmt != fmt_end && *fmt == '%') {
234 spec.converter = '%';
235 Dynarr_add(specs, spec);
240 /* Is there a field number specifier? */
246 parse_off_posnum(fmt, fmt_end, &fieldspec);
247 if (fieldspec > 0 && ptr != fmt_end
249 /* There is a format specifier */
250 prev_argnum = fieldspec;
254 spec.argnum = prev_argnum;
257 /* Parse off any flags */
262 spec.minus_flag = true;
265 spec.plus_flag = true;
268 spec.space_flag = true;
271 spec.number_flag = true;
274 spec.number_flag = true;
275 spec.lisp_reader_syntax = true;
277 spec.sign_after_hash_flag = true;
280 spec.group_flag = true;
283 spec.zero_flag = true;
289 case '\000': /* steve's favourite */
298 /* Parse off the minimum field width */
302 * * means the field width was passed as an argument.
303 * Mark the current spec as one that forwards its
304 * field width and flags to the next spec in the array.
305 * Then create a new spec and continue with the parsing.
307 if (fmt != fmt_end && *fmt == '*') {
308 spec.converter = '*';
309 RESOLVE_FLAG_CONFLICTS(spec);
310 Dynarr_add(specs, spec);
311 spec.argnum = ++prev_argnum;
314 fmt = parse_off_posnum(fmt, fmt_end,
316 if (spec.minwidth == -1)
320 /* Parse off any precision specified */
324 * * means the precision was passed as an argument.
325 * Mark the current spec as one that forwards its
326 * fieldwidth, flags and precision to the next spec in
327 * the array. Then create a new spec and continue
330 if (fmt != fmt_end && *fmt == '*') {
331 spec.converter = '*';
332 spec.forwarding_precision = 1;
333 RESOLVE_FLAG_CONFLICTS(spec);
334 Dynarr_add(specs, spec);
335 spec.argnum = ++prev_argnum;
339 parse_off_posnum(fmt, fmt_end,
341 if (spec.precision == -1)
346 /* No precision specified */
350 /* Parse off h or l flag */
351 if (ch == 'h' || ch == 'l') {
359 if (!strchr(valid_converters, ch))
360 error("Invalid converter character %c", ch);
364 RESOLVE_FLAG_CONFLICTS(spec);
365 Dynarr_add(specs, spec);
368 RETURN_NOT_REACHED(specs) /* suppress compiler warning */
371 static int get_args_needed(printf_spec_dynarr *specs)
376 /* Figure out how many args are needed. This may be less than
377 the number of specs because a spec could be %% or could be
378 missing (literal text at end of format string) or there
379 could be specs where the field number is explicitly given.
380 We just look for the maximum argument number that's referenced. */
382 for (i = 0; i < Dynarr_length(specs); i++) {
383 char ch = Dynarr_at(specs, i).converter;
384 if (ch && ch != '%') {
385 int argnum = Dynarr_at(specs, i).argnum;
386 if (argnum > args_needed)
387 args_needed = argnum;
394 static printf_arg_dynarr *
395 get_doprnt_args(printf_spec_dynarr *specs, va_list vargs)
397 printf_arg_dynarr *args = Dynarr_new(printf_arg);
400 int args_needed = get_args_needed(specs);
404 spec_len = Dynarr_length(specs);
407 for (i = 1; i <= args_needed; i++) {
410 printf_spec_t spec = 0;
412 for (j = 0; j < spec_len; j++) {
413 spec = Dynarr_atp(specs, j);
414 if (spec->argnum == i) {
420 error("No conversion spec for argument %d", i);
422 ch = spec->converter;
424 if (strchr(int_converters, ch)) {
426 arg.l = va_arg(vargs, long);
428 /* int even if ch == 'c' or spec->h_flag: "the
429 type used in va_arg is supposed to match the
430 actual type **after default promotions**."
431 Hence we read an int, not a short, if
433 arg.l = va_arg(vargs, int);
434 } else if (strchr(base_converters, ch)) {
436 arg.l = va_arg(vargs, int);
438 /* unsigned int even if ch == 'c'
440 arg.l = va_arg(vargs, int);
442 } else if (strchr(double_converters, ch)) {
443 arg.d = va_arg(vargs, double);
444 } else if (strchr(string_converters, ch)) {
445 arg.bp = va_arg(vargs, Bufbyte *);
446 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP) || \
447 defined HAVE_MPQ && defined WITH_GMP
448 } else if (strchr(bigz_converters, ch)) {
449 arg.obj = va_arg(vargs, Lisp_Object);
451 #if defined HAVE_MPF && defined WITH_GMP || \
452 defined HAVE_MPFR && defined WITH_MPFR
453 } else if (strchr(bigf_converters, ch)) {
454 arg.obj = va_arg(vargs, Lisp_Object);
459 Dynarr_add(args, arg);
465 /* Generate output from a format-spec FORMAT, of length FORMAT_LENGTH.
466 Output goes in BUFFER, which has room for BUFSIZE bytes.
467 If the output does not fit, truncate it to fit.
468 Returns the number of bytes stored into BUFFER.
469 LARGS or VARGS points to the arguments, and NARGS says how many.
470 if LARGS is non-zero, it should be a pointer to NARGS worth of
471 Lisp arguments. Otherwise, VARGS should be a va_list referring
475 /* we divide the emacs_doprnt_1 into readable chunks */
477 static void emacs_doprnt_number(
478 Lisp_Object, const Lisp_Object *,
479 printf_arg_dynarr *, printf_spec_t, char);
482 #define DOPRNT_AND_FREE(b, l) \
484 doprnt_1(stream, b, l, 0, -1, 0, 0); \
489 __ulong_to_bit_string(char *p, long unsigned int number)
491 int i, seen_high_order = 0;
494 for (i = ((SIZEOF_LONG * 8) - 1); i >= 0; --i) {
495 if (number & 1UL << i) {
499 if (seen_high_order) {
505 return (int)(p - origp);
509 __nnaughts(printf_spec_t s, int nlen, int tlen)
511 /* return the number of naughts to insert, given specs S and a
512 * pure length of the number of NLEN and a overall length of the
514 * the result will always be nonnegative */
518 if (UNLIKELY(s->precision == 0)) {
521 } else if (s->precision > 0) {
522 if ((result = s->precision - nlen) < 0) {
525 } else if (s->zero_flag && !s->minus_flag) {
526 /* in this case use s->minwidth */
527 if ((result = s->minwidth - tlen) < 0) {
535 __bsize_smZ(printf_spec_t s, EMACS_INT SXE_UNUSED(Z))
536 __attribute__((always_inline));
538 __bsize_smZ(printf_spec_t s, EMACS_INT SXE_UNUSED(Z))
540 return 32 + s->minwidth + sizeof(long int) *
541 /* if binary representation is wanted, use an
542 * awful lot more space */
543 (s->converter != 'b' ? 3 : 8) + s->precision +
544 3 /* for 0x and friends */;
547 #if defined HAVE_MPZ && defined WITH_GMP
549 __bsize_Z(printf_spec_t s, bigz Z)
550 __attribute__((always_inline));
552 __bsize_Z(printf_spec_t s, bigz Z)
556 switch (s->converter) {
558 ms = mpz_sizeinbase(Z, 10);
562 ms = mpz_sizeinbase(Z, 16);
565 ms = mpz_sizeinbase(Z, 8);
568 ms = mpz_sizeinbase(Z, 2);
571 if ((long int)ms < s->minwidth) {
572 return 32 + s->minwidth + s->precision +
573 3 /* for 0x and friends */;
575 return 32 + ms + s->precision + 3;
580 __bsize_Q(printf_spec_t s, bigq Q)
581 __attribute__((always_inline));
583 __bsize_Q(printf_spec_t s, bigq Q)
588 switch (s->converter) {
603 ms = mpz_sizeinbase(mpq_numref(Q), base)
604 + mpz_sizeinbase(mpq_denref(Q), base) + 3;
606 if ((long int)ms < s->minwidth) {
607 return 32 + s->minwidth + s->precision +
608 3 /* for 0x and friends */;
610 return 32 + ms + s->precision + 3;
613 #endif /* HAVE_MPZ && HAVE_GMP */
615 #define __assign_sign_Z(s, p) \
617 if (s->negativep) { \
619 } else if (s->plus_flag) { \
621 } else if (s->space_flag && \
622 !s->lisp_reader_syntax) { \
628 __postproc2(printf_spec_t s, char *restrict, size_t, size_t)
629 __attribute__((always_inline));
631 __postproc2(printf_spec_t s, char *restrict text, size_t text_len, size_t allsz)
633 int nnaughts = 0, num_len = text_len;
634 int ini_len = 0, pre_len = 0, post_len = 0;
635 char *restrict num, *restrict ini, *restrict pre, *restrict post;
636 bool base_conv = (strchr(base_converters, s->converter) != NULL);
638 /* determine how much stuff to put in front */
639 if (base_conv && s->number_flag) {
642 if (s->negativep || s->plus_flag ||
643 (s->space_flag && !s->lisp_reader_syntax)) {
646 /* determine the number of zeroes */
647 text_len = num_len + ini_len;
648 text_len += (nnaughts = __nnaughts(s, num_len, text_len));
650 if ((long int)text_len < s->minwidth) {
652 post_len = s->minwidth - num_len;
654 pre_len = s->minwidth - text_len;
656 text_len = s->minwidth;
659 /* move the number to the final location */
660 pre = text + pre_len;
662 num = ini + nnaughts;
663 post = num + num_len;
664 memmove(num, text, num_len);
667 if (LIKELY(!s->sign_after_hash_flag)) {
668 __assign_sign_Z(s, pre);
672 if (base_conv && s->number_flag) {
673 if (LIKELY(!s->lisp_reader_syntax)) {
678 /* the idea behind that is to just swap the
679 * leading zero with a # et voila the number
680 * can be read in again
682 switch (s->converter) {
700 if (UNLIKELY(s->sign_after_hash_flag)) {
701 __assign_sign_Z(s, pre);
704 /* we pad with zeroes before the number, if desired */
706 memset(ini, '0', nnaughts);
709 /* care about s->minwidth, we move the entire immobile block */
711 memset(post, s->pad_char, post_len);
713 memset(text, s->pad_char, pre_len);
719 emacs_doprnt_smZ(Lisp_Object stream, EMACS_INT Z, printf_spec_t s, char ch)
721 /* ASCII Decimal representation uses 2.4 times as many
722 bits as machine binary. */
723 char constructed_spec[100];
724 char *p = constructed_spec;
725 int alloc_sz = __bsize_smZ(s, Z), text_len = 0;
726 /* get a chunk of space to load off the result */
727 /* C99 we need you so badly */
731 *p++ = 'l'; /* use long */
735 s->negativep = Z < 0L;
736 if (ch != 'b' && Z < 0L) {
737 /* We cannot simply use sprintf,
738 * sprintf would return a two-complement
739 * on negative numbers
740 * however for further movements we hav to advance
741 * cruft_len because that minus char must stay
743 text_len = snprintf(text, alloc_sz, constructed_spec, -Z);
744 } else if (ch != 'b' /* && Z >= 0L */) {
745 text_len = snprintf(text, alloc_sz, constructed_spec, Z);
746 } else if (ch == 'b' && Z < 0) {
747 text_len = __ulong_to_bit_string(text, -Z);
748 } else /* ch == 'b' */ {
749 text_len = __ulong_to_bit_string(text, Z);
751 assert(text_len >= 0 && text_len < alloc_sz);
752 /* postprocess, move stuff around, insert naughts, etc. */
753 text_len = __postproc2(s, text, text_len, alloc_sz);
755 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
759 #if defined(HAVE_MPZ) && defined WITH_GMP
761 emacs_doprnt_Z(Lisp_Object stream, Lisp_Object obj, printf_spec_t s, char ch)
764 int alloc_sz = __bsize_Z(s, XBIGZ_DATA(obj)), text_len = 0;
765 /* get a chunk of space to load off the result */
766 /* C99 we need you so badly */
784 s->negativep = bigz_sign(XBIGZ_DATA(obj)) < 0;
785 bigz_to_string2(text, XBIGZ_DATA(obj), base);
786 text_len = strlen(text);
788 /* special case %X, MPZ does not upcase hex chars,
789 * so we have to do it here
793 for (q = (char*)text; *q != '\0'; q++) {
794 if (strchr("abcdef", *q))
800 text_len = __postproc2(s, text, text_len, alloc_sz);
801 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
804 text_len = __postproc2(s, text+1, text_len-1, alloc_sz);
805 doprnt_1(stream, (Bufbyte*)text+1, text_len, 0, -1, 0, 0);
811 emacs_doprnt_Q(Lisp_Object stream, Lisp_Object obj, printf_spec_t s, char ch)
813 int alloc_sz = __bsize_Q(s, XBIGQ_DATA(obj)), text_len = 0;
814 /* get a chunk of space to load off the result */
815 /* C99 we need you so badly */
818 s->negativep = bigq_sign(XBIGQ_DATA(obj)) < 0;
819 /* the following two are meaningless for rationals */
820 s->zero_flag = false;
823 bigq_to_string2(text, XBIGQ_DATA(obj), 10);
824 text_len = strlen(text);
826 /* special case %X, MPZ does not upcase hex chars,
827 * so we have to do it here
831 for (q = (char*)text; *q != '\0'; q++) {
832 if (strchr("abcdef", *q))
838 text_len = __postproc2(s, text, text_len, alloc_sz);
839 doprnt_1(stream, (Bufbyte*)text, text_len, 0, -1, 0, 0);
842 text_len = __postproc2(s, text+1, text_len-1, alloc_sz);
843 doprnt_1(stream, (Bufbyte*)text+1, text_len, 0, -1, 0, 0);
847 #endif /* HAVE_MPZ && WITH_GMP */
850 emacs_doprnt_number(Lisp_Object stream,
851 const Lisp_Object *largs,
852 printf_arg_dynarr *args,
856 /* Must be a number. */
861 arg = Dynarr_at(args, spec->argnum - 1);
864 obj = largs[spec->argnum - 1];
866 obj = make_int(XCHAR(obj));
868 obj = make_int(marker_position(obj));
871 if (!NUMBERP(obj) && !NILP(obj)) {
872 error("format specifier %%%c "
873 "doesn't match argument type", ch);
878 } else if (ch == 'c') {
879 /* always convert to int if we deal with characters */
880 obj = Fcoerce_number(obj, Qint, Qnil);
882 } else if (strchr(int_converters, ch) && (ch != 'c')) {
883 obj = Fcoerce_number(obj, Qinteger, Qnil);
885 } else if (strchr(base_converters, ch)) {
886 /* must that really be int?
887 * The ENT libraries have support for printing floats
888 * or fractions in hex and octal
890 obj = Fcoerce_number(obj, Qinteger, Qnil);
892 } else if (strchr(double_converters, ch)) {
893 obj = Fcoerce_number(obj, Qfloat, Qnil);
895 #if defined(HAVE_MPZ) && (defined WITH_GMP || defined WITH_MP)
896 } else if (ch == 'Z') {
897 obj = Fcoerce_number(obj, Qbigz, Qnil);
899 #endif /* HAVE_MPZ */
900 #if defined(HAVE_MPQ) && defined WITH_GMP
901 } else if (ch == 'Q') {
902 obj = Fcoerce_number(obj, Qbigq, Qnil);
904 #endif /* HAVE_MPQ */
905 #if defined(HAVE_MPFR) && defined WITH_MPFR
906 } else if (ch == 'F') {
907 obj = Fcoerce_number(obj, Qbigfr, Qnil);
909 #elif defined(HAVE_MPF) && defined WITH_GMP
910 } else if (ch == 'F') {
911 obj = Fcoerce_number(obj, Qbigf, Qnil);
913 #endif /* HAVE_MPFR || HAVE_MPF */
914 #if defined(HAVE_MPFR) && defined WITH_MPFR || \
915 defined(HAVE_MPF) && defined WITH_GMP
916 } else if (ch == 'R') {
917 obj = Fcoerce_number(obj, Qreal, Qnil);
924 #if defined(HAVE_PSEUG) && defined WITH_PSEUG
925 } else if (strchr(bigg_converters, ch)) {
926 obj = Fcoerce_number(obj, Qbigg, Qnil);
929 #if defined HAVE_MPC && defined WITH_MPC || \
930 defined HAVE_PSEUC && defined WITH_PSEUC
931 } else if (strchr(bigc_converters, ch)) {
932 obj = Fcoerce_number(obj, Qbigc, Qnil);
940 } else if ((NILP(obj) || INTP(obj)) && ch == 'c') {
943 Bufbyte charbuf[MAX_EMCHAR_LEN];
948 a = (Emchar)XINT(obj);
950 if (!valid_char_p(a))
951 error("invalid character value %d to %%c spec", a);
953 charlen = set_charptr_emchar(charbuf, a);
954 doprnt_1(stream, charbuf, charlen,
955 spec->minwidth, -1, spec->minus_flag,
959 } else if ((NILP(obj) || FLOATP(obj)) &&
960 strchr(double_converters, ch)) {
962 /* ASCII Decimal representation uses 2.4 times as many
963 bits as machine binary. */
965 char constructed_spec[100];
966 char *p = constructed_spec;
967 int length, alloca_sz = max_float_print_size;
968 int min = spec->minwidth, prec = spec->precision;
969 int max_spec = sizeof(constructed_spec);
972 /* absolute non-sense :O ...
973 anyone actually computed the size which is stated here?! */
975 32 + max(spec->minwidth,
976 (EMACS_INT)max(sizeof(double), sizeof(long))
977 * 3 + max(spec->precision, 0));
984 if (32+min+prec > alloca_sz)
985 alloca_sz = 32 + min + prec;
987 text_to_print = alloca_array(char, alloca_sz);
989 /* Mostly reconstruct the spec and use sprintf() to
990 format the string. */
995 if (spec->space_flag)
997 if (spec->number_flag)
999 if (spec->minus_flag)
1001 if (spec->zero_flag)
1004 if (spec->minwidth >= 0) {
1005 long_to_string(p, spec->minwidth, max_spec);
1006 max_spec -= strlen(p);
1009 if (spec->precision >= 0) {
1012 long_to_string(p, spec->precision, max_spec);
1013 max_spec -= strlen(p);
1017 #if fpfloat_long_double_p
1025 assert(max_spec >= 0);
1027 length = snprintf(text_to_print, alloca_sz,
1028 constructed_spec, arg.d);
1030 length = snprintf(text_to_print, alloca_sz,
1031 constructed_spec, XFLOAT_DATA(obj));
1033 if (length > alloca_sz) {
1034 /* should we really silently truncate?! */
1037 doprnt_1(stream, (Bufbyte *)text_to_print, length, 0, -1, 0, 0);
1040 } else if ((NILP(obj) || INTP(obj)) && (ch != 'c')) {
1046 XINTobj = XINT(obj);
1048 emacs_doprnt_smZ(stream, XINTobj, spec, ch);
1050 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1051 } else if (BIGZP(obj)) {
1052 emacs_doprnt_Z(stream, obj, spec, ch);
1053 #endif /* HAVE_MPZ */
1054 #if defined HAVE_MPQ && defined WITH_GMP
1055 } else if (BIGQP(obj)) {
1056 emacs_doprnt_Q(stream, obj, spec, ch);
1059 Bufbyte *text_to_print;
1079 (Bufbyte*)bigq_to_string(XBIGQ_DATA(obj), base);
1080 ttp_len = strlen((char*)text_to_print);
1082 /* now maybe print the signed or spaced version */
1083 if ((spec->plus_flag || spec->space_flag) &&
1084 (bigq_sign(XBIGQ_DATA(obj))>=0)) {
1085 XREALLOC_ARRAY(text_to_print, Bufbyte,
1087 memmove(text_to_print+1, text_to_print, ttp_len);
1089 if (spec->plus_flag)
1090 text_to_print[0] = '+';
1091 if (spec->space_flag)
1092 text_to_print[0] = ' ';
1095 /* care about spec->minwidth */
1096 if (ttp_len < spec->minwidth) {
1097 XREALLOC_ARRAY(text_to_print, Bufbyte, spec->minwidth);
1098 if (spec->minus_flag)
1099 memset(text_to_print+ttp_len, ' ',
1100 spec->minwidth-ttp_len);
1102 memmove(text_to_print+spec->minwidth-ttp_len,
1103 text_to_print, ttp_len);
1104 if (spec->zero_flag && spec->precision <= 0)
1105 memset(text_to_print, '0',
1106 spec->minwidth-ttp_len);
1108 memset(text_to_print, ' ',
1109 spec->minwidth-ttp_len);
1111 ttp_len = spec->minwidth;
1114 DOPRNT_AND_FREE(text_to_print, ttp_len);
1117 #endif /* HAVE_MPZ */
1118 #if defined HAVE_MPFR && defined WITH_MPFR
1119 } else if (BIGFRP(obj)) {
1120 Bufbyte *text_to_print;
1122 long preradix_len, postradix_len;
1141 (Bufbyte*)bigfr_to_string(XBIGFR_DATA(obj), base);
1142 ttp_len = strlen((char*)text_to_print);
1144 /* if obj is an infinite point or not-a-number dont care about
1146 * also dont care about space or plus flag since the infinities
1147 * always carry their sign, and not-a-number cannot have a sign
1149 if (bigfr_nan_p(XBIGFR_DATA(obj)) ||
1150 bigfr_inf_p(XBIGFR_DATA(obj))) {
1151 DOPRNT_AND_FREE(text_to_print, ttp_len);
1155 /* examine the lengths of digits before and after
1158 if ((preradix_len = (long int)
1159 (void*)strchr((char *)text_to_print, '.'))) {
1160 preradix_len = preradix_len - (long)text_to_print;
1161 postradix_len = ttp_len - preradix_len - 1;
1163 preradix_len = ttp_len;
1167 /* now cut unwanted places after the decimal dot */
1168 if (postradix_len > spec->precision &&
1169 spec->precision >= 0) {
1170 text_to_print[ttp_len -
1172 spec->precision] = '\0';
1173 ttp_len = ttp_len - postradix_len + spec->precision;
1174 if (spec->precision == 0) {
1175 text_to_print[ttp_len] = '\0';
1179 /* now extend to wanted places after the decimal dot */
1180 } else if (postradix_len < spec->precision &&
1181 postradix_len > 0) {
1182 XREALLOC_ARRAY(text_to_print, Bufbyte,
1183 ttp_len - postradix_len +
1185 text_to_print[preradix_len] = '.';
1186 memset(text_to_print+ttp_len, '0',
1187 spec->precision - postradix_len);
1188 ttp_len = ttp_len - postradix_len + spec->precision;
1190 /* now extend to wanted places, insert a decimal dot first */
1191 } else if (postradix_len < spec->precision &&
1192 postradix_len == 0) {
1193 XREALLOC_ARRAY(text_to_print, Bufbyte,
1194 ttp_len + spec->precision + 1);
1195 text_to_print[preradix_len] = '.';
1196 memset(text_to_print+preradix_len+1, '0',
1198 ttp_len = ttp_len + spec->precision + 1;
1201 /* now maybe print the signed or spaced version */
1202 if ((spec->plus_flag || spec->space_flag) &&
1203 (bigfr_sign(XBIGFR_DATA(obj))>=0)) {
1204 XREALLOC_ARRAY(text_to_print, Bufbyte,
1206 memmove(text_to_print+1, text_to_print, ttp_len);
1208 if (spec->plus_flag)
1209 text_to_print[0] = '+';
1210 if (spec->space_flag)
1211 text_to_print[0] = ' ';
1214 /* care about spec->minwidth */
1215 if (ttp_len < spec->minwidth) {
1216 XREALLOC_ARRAY(text_to_print, Bufbyte, spec->minwidth);
1217 if (spec->minus_flag)
1218 memset(text_to_print+ttp_len, ' ',
1219 spec->minwidth-ttp_len);
1221 memmove(text_to_print+spec->minwidth-ttp_len,
1222 text_to_print, ttp_len);
1223 if (spec->zero_flag && spec->precision <= 0)
1224 memset(text_to_print, '0',
1225 spec->minwidth-ttp_len);
1227 memset(text_to_print, ' ',
1228 spec->minwidth-ttp_len);
1230 ttp_len = spec->minwidth;
1233 DOPRNT_AND_FREE(text_to_print, ttp_len);
1235 #endif /* HAVE_MPFR */
1236 #if defined HAVE_PSEUG && defined WITH_PSEUG
1237 } else if (BIGGP(obj)) {
1239 int old_argnum, old_plus_flag, old_space_flag;
1240 Lisp_Object *modobj = alloca_array(Lisp_Object, 1);
1242 /* Actually, %a.bB is a rewrite for %a.bd%+a.bd */
1244 old_argnum = spec->argnum;
1245 old_plus_flag = spec->plus_flag;
1246 old_space_flag = spec->space_flag;
1248 /* rewrite the real part */
1250 modobj[0] = Freal_part(obj);
1251 emacs_doprnt_number(stream, modobj, args, spec, 'Z');
1253 /* rewrite the imaginary part */
1255 spec->plus_flag = 1;
1256 spec->space_flag = 0;
1257 modobj[0] = Fimaginary_part(obj);
1258 emacs_doprnt_number(stream, modobj, args, spec, 'Z');
1259 /* print the imaginary unit now */
1260 doprnt_1(stream, (Bufbyte*)"i", 1, 1, -1, 0, 0);
1262 spec->argnum = old_argnum;
1263 spec->plus_flag = old_plus_flag;
1264 spec->space_flag = old_space_flag;
1266 #endif /* HAVE_PSEUG */
1267 #if defined HAVE_MPC && defined WITH_MPC || \
1268 defined HAVE_PSEUC && defined WITH_PSEUC
1269 } else if (BIGCP(obj)) {
1271 int old_argnum, old_plus_flag, old_space_flag;
1272 Lisp_Object *modobj = alloca_array(Lisp_Object, 1);
1274 /* Actually, %a.bC is a rewrite for %a.bF%+a.bF */
1276 old_argnum = spec->argnum;
1277 old_plus_flag = spec->plus_flag;
1278 old_space_flag = spec->space_flag;
1280 /* rewrite the real part */
1282 modobj[0] = Freal_part(obj);
1283 emacs_doprnt_number(stream, modobj, args, spec, 'F');
1285 /* rewrite the imaginary part */
1287 spec->plus_flag = 1;
1288 spec->space_flag = 0;
1289 modobj[0] = Fimaginary_part(obj);
1290 emacs_doprnt_number(stream, modobj, args, spec, 'F');
1291 /* print the imaginary unit now */
1292 doprnt_1(stream, (Bufbyte*)"i", 1, 1, -1, 0, 0);
1294 spec->argnum = old_argnum;
1295 spec->plus_flag = old_plus_flag;
1296 spec->space_flag = old_space_flag;
1298 #endif /* HAVE_MPC */
1304 emacs_doprnt_1(Lisp_Object stream, const Bufbyte * format_nonreloc,
1305 Lisp_Object format_reloc, Bytecount format_length, int nargs,
1306 /* #### Gag me, gag me, gag me */
1307 const Lisp_Object * largs, va_list vargs)
1309 printf_spec_dynarr *specs = 0;
1310 printf_arg_dynarr *args = 0;
1312 int init_byte_count = Lstream_byte_count(XLSTREAM(stream));
1314 if (!NILP(format_reloc)) {
1315 format_nonreloc = XSTRING_DATA(format_reloc);
1316 format_length = XSTRING_LENGTH(format_reloc);
1318 if (format_length < 0)
1320 (Bytecount) strlen((const char *)format_nonreloc);
1322 specs = parse_doprnt_spec(format_nonreloc, format_length);
1325 /* allow too many args for string, but not too few */
1326 if (nargs < get_args_needed(specs))
1327 signal_error(Qwrong_number_of_arguments,
1330 !NILP(format_reloc) ? format_reloc :
1331 make_string(format_nonreloc,
1334 args = get_doprnt_args(specs, vargs);
1337 for (i = 0; specs && i < Dynarr_length(specs); i++) {
1338 printf_spec_t spec = Dynarr_atp(specs, i);
1341 /* Copy the text before */
1342 if (!NILP(format_reloc)) /* refetch in case of GC below */
1343 format_nonreloc = XSTRING_DATA(format_reloc);
1345 doprnt_1(stream, format_nonreloc + spec->text_before,
1346 spec->text_before_len, 0, -1, 0, 0);
1348 ch = spec->converter;
1354 doprnt_1(stream, (Bufbyte *) & ch, 1, 0, -1, 0, 0);
1358 /* The char '*' as converter means the field width, precision
1359 was specified as an argument. Extract the data and forward
1360 it to the next spec, to which it will apply. */
1363 error("Invalid largs and '*' converter in emacs_doprnt_1");
1365 printf_spec_t nextspec = Dynarr_atp(specs, i + 1);
1366 Lisp_Object obj = largs[spec->argnum - 1];
1369 if (spec->forwarding_precision) {
1370 nextspec->precision = XINT(obj);
1371 nextspec->minwidth = spec->minwidth;
1373 nextspec->minwidth = XINT(obj);
1374 if (XINT(obj) < 0) {
1375 spec->minus_flag = 1;
1376 nextspec->minwidth =
1377 -nextspec->minwidth;
1380 nextspec->minus_flag = spec->minus_flag;
1381 nextspec->plus_flag = spec->plus_flag;
1382 nextspec->space_flag = spec->space_flag;
1383 nextspec->number_flag = spec->number_flag;
1384 nextspec->zero_flag = spec->zero_flag;
1390 if (largs && (spec->argnum < 1 || spec->argnum > nargs))
1391 error("Invalid repositioning argument %d",
1394 else if (ch == 'S' || ch == 's') {
1396 Bytecount string_len;
1399 string = Dynarr_at(args, spec->argnum - 1).bp;
1400 /* error() can be called with null string
1401 arguments. E.g., in fileio.c, the return
1402 value of strerror() is never checked. We'll
1403 print (null), like some printf
1404 implementations do. Would it be better (and
1405 safe) to signal an error instead? Or should
1406 we just use the empty string?
1407 -dkindred@cs.cmu.edu 8/1997
1410 string = (Bufbyte *) "(null)";
1411 string_len = strlen((char *)string);
1413 Lisp_Object obj = largs[spec->argnum - 1];
1417 /* For `S', prin1 the argument and
1418 * then treat like a string.
1421 Fprin1_to_string(obj, Qnil);
1423 } else if (STRINGP(obj)) {
1425 } else if (SYMBOLP(obj)) {
1426 ls = XSYMBOL(obj)->name;
1428 /* convert to string using princ. */
1430 Fprin1_to_string(obj, Qt);
1433 string = string_data(ls);
1434 string_len = string_length(ls);
1437 doprnt_1(stream, string, string_len, spec->minwidth,
1438 spec->precision, spec->minus_flag,
1441 /* Must be a number. */
1442 emacs_doprnt_number(stream, largs, args, spec, ch);
1446 /* #### will not get freed if error */
1451 return Lstream_byte_count(XLSTREAM(stream)) - init_byte_count;
1454 /* You really don't want to know why this is necessary... */
1456 emacs_doprnt_2(Lisp_Object stream, const Bufbyte * format_nonreloc,
1457 Lisp_Object format_reloc, Bytecount format_length, int nargs,
1458 const Lisp_Object * largs, ...)
1462 va_start(vargs, largs);
1463 val = emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1464 format_length, nargs, largs, vargs);
1469 /*********************** external entry points ***********************/
1472 /* A note about I18N3 translating: the format string should get
1473 translated, but not under all circumstances. When the format
1474 string is a Lisp string, what should happen is that Fformat()
1475 should format the untranslated args[0] and return that, and also
1476 call Fgettext() on args[0] and, if that is different, format it
1477 and store it in the `string-translatable' property of
1478 the returned string. See Fgettext(). */
1481 /* Send formatted output to STREAM. The format string comes from
1482 either FORMAT_NONRELOC (of length FORMAT_LENGTH; -1 means use
1483 strlen() to determine the length) or from FORMAT_RELOC, which
1484 should be a Lisp string. Return the number of bytes written
1487 DO NOT pass the data from a Lisp string as the FORMAT_NONRELOC
1488 parameter, because this function can cause GC. */
1491 emacs_doprnt_c(Lisp_Object stream, const Bufbyte * format_nonreloc,
1492 Lisp_Object format_reloc, Bytecount format_length, ...)
1497 va_start(vargs, format_length);
1498 val = emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1499 format_length, 0, 0, vargs);
1504 /* Like emacs_doprnt_c but the args come in va_list format. */
1507 emacs_doprnt_va(Lisp_Object stream, const Bufbyte * format_nonreloc,
1508 Lisp_Object format_reloc, Bytecount format_length,
1511 return emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1512 format_length, 0, 0, vargs);
1515 /* Like emacs_doprnt_c but the args are Lisp objects instead of
1516 C arguments. This causes somewhat different behavior from
1517 the above two functions (which should act like printf).
1518 See `format' for a description of this behavior. */
1521 emacs_doprnt_lisp(Lisp_Object stream, const Bufbyte * format_nonreloc,
1522 Lisp_Object format_reloc, Bytecount format_length,
1523 int nargs, const Lisp_Object * largs)
1525 return emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1526 format_length, nargs, largs);
1529 /* Like the previous function but takes a variable number of arguments. */
1532 emacs_doprnt_lisp_2(Lisp_Object stream, const Bufbyte * format_nonreloc,
1533 Lisp_Object format_reloc, Bytecount format_length,
1538 Lisp_Object *foo = alloca_array(Lisp_Object, nargs);
1540 va_start(vargs, nargs);
1541 for (i = 0; i < nargs; i++)
1542 foo[i] = va_arg(vargs, Lisp_Object);
1545 return emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1546 format_length, nargs, foo);
1549 /* The following four functions work like the above three but
1550 return their output as a Lisp string instead of sending it
1554 emacs_doprnt_string_c(const Bufbyte * format_nonreloc,
1555 Lisp_Object format_reloc, Bytecount format_length, ...)
1559 Lisp_Object stream = make_resizing_buffer_output_stream();
1560 struct gcpro gcpro1;
1563 va_start(vargs, format_length);
1564 emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1565 format_length, 0, 0, vargs);
1567 Lstream_flush(XLSTREAM(stream));
1568 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1569 Lstream_byte_count(XLSTREAM(stream)));
1571 Lstream_delete(XLSTREAM(stream));
1576 emacs_doprnt_string_va(const Bufbyte * format_nonreloc,
1577 Lisp_Object format_reloc, Bytecount format_length,
1580 /* I'm fairly sure that this function cannot actually GC.
1581 That can only happen when the arguments to emacs_doprnt_1() are
1582 Lisp objects rather than C args. */
1584 Lisp_Object stream = make_resizing_buffer_output_stream();
1585 struct gcpro gcpro1;
1588 emacs_doprnt_1(stream, format_nonreloc, format_reloc,
1589 format_length, 0, 0, vargs);
1590 Lstream_flush(XLSTREAM(stream));
1591 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1592 Lstream_byte_count(XLSTREAM(stream)));
1594 Lstream_delete(XLSTREAM(stream));
1599 emacs_doprnt_string_lisp(const Bufbyte * format_nonreloc,
1600 Lisp_Object format_reloc, Bytecount format_length,
1601 int nargs, const Lisp_Object * largs)
1604 Lisp_Object stream = make_resizing_buffer_output_stream();
1605 struct gcpro gcpro1;
1608 emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1609 format_length, nargs, largs);
1610 Lstream_flush(XLSTREAM(stream));
1611 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1612 Lstream_byte_count(XLSTREAM(stream)));
1614 Lstream_delete(XLSTREAM(stream));
1619 emacs_doprnt_string_lisp_2(const Bufbyte * format_nonreloc,
1620 Lisp_Object format_reloc, Bytecount format_length,
1624 Lisp_Object stream = make_resizing_buffer_output_stream();
1625 struct gcpro gcpro1;
1628 Lisp_Object *foo = alloca_array(Lisp_Object, nargs);
1630 va_start(vargs, nargs);
1631 for (i = 0; i < nargs; i++)
1632 foo[i] = va_arg(vargs, Lisp_Object);
1636 emacs_doprnt_2(stream, format_nonreloc, format_reloc,
1637 format_length, nargs, foo);
1638 Lstream_flush(XLSTREAM(stream));
1639 obj = make_string(resizing_buffer_stream_ptr(XLSTREAM(stream)),
1640 Lstream_byte_count(XLSTREAM(stream)));
1642 Lstream_delete(XLSTREAM(stream));