Mercurial > hg > xemacs-beta

comparison src/doprnt.c @ 1983:9c872f33ecbe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-04-05 22:49:31 by james] Add bignum, ratio, and bigfloat support.
author james
date Mon, 05 Apr 2004 22:50:11 +0000
parents b531bf8658e9
children 4e6a63799f08
comparison
equal deleted inserted replaced
1982:a748951fd4fb 1983:9c872f33ecbe
4 Copyright (C) 1995 Free Software Foundation, Inc. 4 Copyright (C) 1995 Free Software Foundation, Inc.
5 Copyright (C) 2001, 2002 Ben Wing. 5 Copyright (C) 2001, 2002 Ben Wing.
6 Rewritten by mly to use varargs.h. 6 Rewritten by mly to use varargs.h.
7 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded 7 Rewritten from scratch by Ben Wing (February 1995) for Mule; expanded
8 to full printf spec. 8 to full printf spec.
9 Support for bignums, ratios, and bigfloats added April 2004 by Jerry James.
9 10
10 This file is part of XEmacs. 11 This file is part of XEmacs.
11 12
12 XEmacs is free software; you can redistribute it and/or modify it 13 XEmacs is free software; you can redistribute it and/or modify it
13 under the terms of the GNU General Public License as published by the 14 under the terms of the GNU General Public License as published by the
31 32
32 #include "buffer.h" 33 #include "buffer.h"
33 #include "lstream.h" 34 #include "lstream.h"
34 35
35 static const char * const valid_flags = "-+ #0"; 36 static const char * const valid_flags = "-+ #0";
36 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS"; 37 static const char * const valid_converters = "dic" "ouxX" "feEgG" "sS"
38 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
39 "npyY"
40 #endif
41 #ifdef HAVE_BIGFLOAT
42 "FhHkK"
43 #endif
44 ;
37 static const char * const int_converters = "dic"; 45 static const char * const int_converters = "dic";
38 static const char * const unsigned_int_converters = "ouxX"; 46 static const char * const unsigned_int_converters = "ouxX";
39 static const char * const double_converters = "feEgG"; 47 static const char * const double_converters = "feEgG";
40 static const char * const string_converters = "sS"; 48 static const char * const string_converters = "sS";
49 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
50 static const char * const bignum_converters = "npyY";
51 #endif
52 #ifdef HAVE_BIGFLOAT
53 static const char * const bigfloat_converters = "FhHkK";
54 #endif
41 55
42 typedef struct printf_spec printf_spec; 56 typedef struct printf_spec printf_spec;
43 struct printf_spec 57 struct printf_spec
44 { 58 {
45 int argnum; /* which argument does this spec want? This is one-based: 59 int argnum; /* which argument does this spec want? This is one-based:
68 { 82 {
69 long l; 83 long l;
70 unsigned long ul; 84 unsigned long ul;
71 double d; 85 double d;
72 Ibyte *bp; 86 Ibyte *bp;
87 Lisp_Object obj;
73 }; 88 };
74 89
75 /* We maintain a list of all the % specs in the specification, 90 /* We maintain a list of all the % specs in the specification,
76 along with the offset and length of the block of literal text 91 along with the offset and length of the block of literal text
77 before each spec. In addition, we have a "dummy" spec that 92 before each spec. In addition, we have a "dummy" spec that
383 } 398 }
384 else if (strchr (double_converters, ch)) 399 else if (strchr (double_converters, ch))
385 arg.d = va_arg (vargs, double); 400 arg.d = va_arg (vargs, double);
386 else if (strchr (string_converters, ch)) 401 else if (strchr (string_converters, ch))
387 arg.bp = va_arg (vargs, Ibyte *); 402 arg.bp = va_arg (vargs, Ibyte *);
403 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
404 else if (strchr (bignum_converters, ch))
405 arg.obj = va_arg (vargs, Lisp_Object);
406 #endif
407 #ifdef HAVE_BIGFLOAT
408 else if (strchr (bigfloat_converters, ch))
409 arg.obj = va_arg (vargs, Lisp_Object);
410 #endif
388 else abort (); 411 else abort ();
389 412
390 Dynarr_add (args, arg); 413 Dynarr_add (args, arg);
391 } 414 }
392 415
566 else 589 else
567 { 590 {
568 Lisp_Object obj = largs[spec->argnum - 1]; 591 Lisp_Object obj = largs[spec->argnum - 1];
569 if (CHARP (obj)) 592 if (CHARP (obj))
570 obj = make_int (XCHAR (obj)); 593 obj = make_int (XCHAR (obj));
594 #ifdef WITH_NUMBER_TYPES
595 if (!NUMBERP (obj))
596 #else
571 if (!INT_OR_FLOATP (obj)) 597 if (!INT_OR_FLOATP (obj))
598 #endif
572 { 599 {
573 syntax_error 600 syntax_error
574 ("format specifier %%%c doesn't match argument type", 601 ("format specifier %%%c doesn't match argument type",
575 make_char (ch)); 602 make_char (ch));
576 } 603 }
577 else if (strchr (double_converters, ch)) 604 else if (strchr (double_converters, ch))
578 arg.d = XFLOATINT (obj); 605 {
606 #ifdef WITH_NUMBER_TYPES
607 if (INTP (obj) || FLOATP (obj))
608 arg.d = XFLOATINT (obj);
609 #ifdef HAVE_BIGNUM
610 else if (BIGNUMP (obj))
611 arg.d = bignum_to_double (XBIGNUM_DATA (obj));
612 #endif
613 #ifdef HAVE_RATIO
614 else if (RATIOP (obj))
615 arg.d = ratio_to_double (XRATIO_DATA (obj));
616 #endif
617 #ifdef HAVE_BIGFLOAT
618 else if (BIGFLOATP (obj))
619 {
620 arg.obj = obj;
621 switch (ch)
622 {
623 case 'f': ch = 'F'; break;
624 case 'e': ch = 'h'; break;
625 case 'E': ch = 'H'; break;
626 case 'g': ch = 'k'; break;
627 case 'G': ch = 'K'; break;
628 }
629 }
630 #endif
631 #else /* !WITH_NUMBER_TYPES */
632 arg.d = XFLOATINT (obj);
633 #endif /* WITH_NUMBER_TYPES */
634 }
579 else 635 else
580 { 636 {
581 if (FLOATP (obj)) 637 if (FLOATP (obj))
582 obj = Ftruncate (obj); 638 obj = Ftruncate (obj);
583 639 #ifdef HAVE_BIGFLOAT
584 if (strchr (unsigned_int_converters, ch)) 640 else if (BIGFLOATP (obj))
585 arg.ul = (unsigned long) XINT (obj); 641 {
586 else 642 #ifdef HAVE_BIGNUM
587 arg.l = XINT (obj); 643 bignum_set_bigfloat (scratch_bignum,
588 } 644 XBIGFLOAT_DATA (obj));
589 } 645 if (strchr (unsigned_int_converters, ch) &&
590 646 bignum_sign (scratch_bignum) < 0)
647 dead_wrong_type_argument (Qnonnegativep, obj);
648 obj =
649 Fcanonicalize_number (make_bignum_bg (scratch_bignum));
650 #else /* !HAVE_BIGNUM */
651 obj = make_int (bigfloat_to_long (XBIGFLOAT_DATA (obj)));
652 #endif /* HAVE_BIGNUM */
653 }
654 #endif /* HAVE_BIGFLOAT */
655 #ifdef HAVE_RATIO
656 else if (RATIOP (obj))
657 {
658 arg.obj = obj;
659 switch (ch)
660 {
661 case 'i': case 'd': ch = 'n'; break;
662 case 'o': ch = 'p'; break;
663 case 'x': ch = 'y'; break;
664 case 'X': ch = 'Y'; break;
665 default: /* ch == 'u' */
666 if (strchr (unsigned_int_converters, ch) &&
667 ratio_sign (XRATIO_DATA (obj)) < 0)
668 dead_wrong_type_argument (Qnonnegativep, obj);
669 else
670 ch = 'n';
671 }
672 }
673 #endif
674 #ifdef HAVE_BIGNUM
675 if (BIGNUMP (obj))
676 {
677 arg.obj = obj;
678 switch (ch)
679 {
680 case 'i': case 'd': ch = 'n'; break;
681 case 'o': ch = 'p'; break;
682 case 'x': ch = 'y'; break;
683 case 'X': ch = 'Y'; break;
684 default: /* ch == 'u' */
685 if (strchr (unsigned_int_converters, ch) &&
686 bignum_sign (XBIGNUM_DATA (obj)) < 0)
687 dead_wrong_type_argument (Qnatnump, obj);
688 else
689 ch = 'n';
690 }
691 }
692 #endif
693 if (INTP (obj))
694 {
695 if (strchr (unsigned_int_converters, ch))
696 {
697 #ifdef HAVE_BIGNUM
698 if (XINT (obj) < 0)
699 dead_wrong_type_argument (Qnatnump, obj);
700 #endif
701 arg.ul = (unsigned long) XUINT (obj);
702 }
703 else
704 arg.l = XINT (obj);
705 }
706 }
707 }
591 708
592 if (ch == 'c') 709 if (ch == 'c')
593 { 710 {
594 Ichar a; 711 Ichar a;
595 Bytecount charlen; 712 Bytecount charlen;
603 720
604 charlen = set_itext_ichar (charbuf, a); 721 charlen = set_itext_ichar (charbuf, a);
605 doprnt_2 (stream, charbuf, charlen, spec->minwidth, 722 doprnt_2 (stream, charbuf, charlen, spec->minwidth,
606 -1, spec->minus_flag, spec->zero_flag); 723 -1, spec->minus_flag, spec->zero_flag);
607 } 724 }
725 #if defined(HAVE_BIGNUM) || defined(HAVE_RATIO)
726 else if (strchr (bignum_converters, ch))
727 {
728 #ifdef HAVE_BIGNUM
729 if (BIGNUMP (arg.obj))
730 {
731 char *text_to_print =
732 bignum_to_string (XBIGNUM_DATA (arg.obj),
733 ch == 'n' ? 10 :
734 (ch == 'p' ? 8 : 16));
735 doprnt_2 (stream, text_to_print, strlen (text_to_print),
736 spec->minwidth, -1, spec->minus_flag,
737 spec->zero_flag);
738 }
739 #endif
740 #ifdef HAVE_RATIO
741 if (RATIOP (arg.obj))
742 {
743 char *text_to_print =
744 ratio_to_string (XRATIO_DATA (arg.obj),
745 ch == 'n' ? 10 :
746 (ch == 'p' ? 8 : 16));
747 doprnt_2 (stream, text_to_print, strlen (text_to_print),
748 spec->minwidth, -1, spec->minus_flag,
749 spec->zero_flag);
750 }
751 #endif
752 }
753 #endif /* HAVE_BIGNUM || HAVE_RATIO */
754 #ifdef HAVE_BIGFLOAT
755 else if (strchr (bigfloat_converters, ch))
756 {
757 char *text_to_print =
758 bigfloat_to_string (XBIGFLOAT_DATA (arg.obj), 10);
759 doprnt_2 (stream, text_to_print, strlen (text_to_print),
760 spec->minwidth, -1, spec->minus_flag, spec->zero_flag);
761 }
762 #endif /* HAVE_BIGFLOAT */
608 else 763 else
609 { 764 {
610 /* ASCII Decimal representation uses 2.4 times as many 765 /* ASCII Decimal representation uses 2.4 times as many
611 bits as machine binary. */ 766 bits as machine binary. */
612 char *text_to_print = 767 char *text_to_print =