2 * The Regina Rexx Interpreter
3 * Copyright (C) 1992-1994 Anders Christensen <anders@pvv.unit.no>
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Library General Public
7 * License as published by the Free Software Foundation; either
8 * version 2 of the License, or (at your option) any later version.
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Library General Public License for more details.
15 * You should have received a copy of the GNU Library General Public
16 * License along with this library; if not, write to the Free
17 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
28 #define log_xor(a,b) (( (a)&&(!(b)) ) || ( (!(a)) && (b) ))
30 # define MAX(a,b) (((a)>(b))?(a):(b))
33 # define MIN(a,b) (((a)<(b))?(a):(b))
35 #define IS_AT_LEAST(ptr,now,min) \
36 if (now<min) { if (ptr) FreeTSD(ptr); ptr=(char *)MallocTSD(now=min) ; } ;
39 #define stringize(x) #x
40 #define stringize_value(x) stringize(x)
42 typedef struct { /* mat_tsd: static variables of this module (thread-safe) */
57 int add_outsize
; /* This values MAY all become one. CHECK THIS! */
66 } mat_tsd_t
; /* thread-specific but only needed by this module. see
70 /* init_math initializes the module.
71 * Currently, we set up the thread specific data and check for environment
72 * variables to change debugging behaviour.
73 * The function returns 1 on success, 0 if memory is short.
75 int init_math( tsd_t
*TSD
)
79 if (TSD
->mat_tsd
!= NULL
)
82 if ( ( TSD
->mat_tsd
= MallocTSD( sizeof(mat_tsd_t
) ) ) == NULL
)
84 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
85 memset( mt
, 0, sizeof(mat_tsd_t
) );
87 mt
->max_exponent_len
= strlen(stringize_value(MAX_EXPONENT
));
92 void mark_descrs( const tsd_t
*TSD
)
96 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
97 if (mt
->rdescr
.num
) markmemory( mt
->rdescr
.num
, TRC_MATH
) ;
98 if (mt
->sdescr
.num
) markmemory( mt
->sdescr
.num
, TRC_MATH
) ;
99 if (mt
->fdescr
.num
) markmemory( mt
->fdescr
.num
, TRC_MATH
) ;
100 if (mt
->edescr
.num
) markmemory( mt
->edescr
.num
, TRC_MATH
) ;
102 if (mt
->outptr1
) markmemory( mt
->outptr1
, TRC_MATH
) ;
103 if (mt
->outptr2
) markmemory( mt
->outptr2
, TRC_MATH
) ;
104 if (mt
->outptr3
) markmemory( mt
->outptr3
, TRC_MATH
) ;
105 if (mt
->outptr4
) markmemory( mt
->outptr4
, TRC_MATH
) ;
106 if (mt
->outptr5
) markmemory( mt
->outptr5
, TRC_MATH
) ;
108 #endif /* TRACEMEM */
110 static streng
*name_of_node( const tsd_t
*TSD
, cnodeptr node
,
111 const num_descr
*val
)
120 switch ( node
->type
)
126 return Str_dupTSD( node
->name
);
130 * Build the complete name of the variable.
132 len
= Str_len( node
->name
);
133 for ( run
= node
->p
[0]; run
; run
= run
->p
[0] )
135 len
+= Str_len( run
->name
) + 1;
137 retval
= Str_makeTSD( len
);
138 Str_catTSD( retval
, node
->name
);
139 for ( run
= node
->p
[0]; run
; run
= run
->p
[0] )
141 Str_catTSD( retval
, run
->name
);
143 retval
->value
[retval
->len
++] = '.';
150 * reformat the number with all possible digits to show the user the
154 num
.used_digits
= ( num
.size
) ? num
.size
: 1;
155 retval
= str_norm( TSD
, &num
, NULL
);
160 #define LOSTDIGITS_CHECK(val,maxdigits,node) { \
161 const char *_ptr = (const char *) ((val)->num); \
162 int _size = (val)->size; \
163 int _digits = maxdigits; \
164 while (_size && *_ptr == '0') \
169 if (_size > _digits) \
177 condition_hook( TSD, \
182 name_of_node( TSD, node, val ), \
193 * ANSI chapter 7, beginning: "...matches that syntax and also has a value
194 * that is 'whole', that is has no non-zero fractional part." The syntax
195 * is that of a plain number.
196 * Thus, 1E1 or 1.00 are allowed.
197 * returns 0 on error, 1 on success. *value is set to the value on success.
199 static int whole_number( const num_descr
*input
, int *value
)
201 /* number must be integer, and must be small enough */
204 if ( input
->size
> input
->exp
)
207 * Check for non-zeros in the fractional part of the number.
209 i
= MAX( 0, input
->exp
);
210 for ( ; i
< input
->size
; i
++ )
212 if ( input
->num
[i
] != '0' )
218 * The number is valid but may be too large. Keep care.
220 for ( i
= 0, result
= 0; i
< input
->exp
; i
++ )
222 if ( result
> INT_MAX
/ 10 )
225 if ( i
< input
->size
)
227 digit
= input
->num
[i
] - '0';
228 if ( result
> INT_MAX
- digit
)
241 * ANSI chapter 7, beginning: "...matches that syntax and also has a value
242 * that is 'whole', that is has no non-zero fractional part." The syntax
243 * is that of a plain number.
244 * Thus, 1E1 or 1.00 are allowed.
245 * returns 0 on error, 1 on success. *value is set to the value on success.
247 static int whole_rx64_number( const num_descr
*input
, rx_64
*value
)
249 /* number must be integer, and must be small enough */
253 if ( input
->size
> input
->exp
)
256 * Check for non-zeros in the fractional part of the number.
258 i
= MAX( 0, input
->exp
);
259 for ( ; i
< input
->size
; i
++ )
261 if ( input
->num
[i
] != '0' )
267 * The number is valid but may be too large. Keep care.
269 for ( i
= 0, result
= 0; i
< input
->exp
; i
++ )
271 if ( result
> RX_64MAX
/ 10 )
274 if ( i
< input
->size
)
276 digit
= input
->num
[i
] - '0';
277 if ( result
> RX_64MAX
- digit
)
289 int descr_to_int( const num_descr
*input
)
293 if ( !whole_number( input
, &result
) )
294 exiterror( ERR_INVALID_INTEGER
, 0 );
300 * strip leading zeros and translate 0e? into a plain 0.
302 void str_strip( num_descr
*num
)
308 if (num
->num
[0] == '0')
316 for ( i
= 0; ( i
< num
->size
- 1 ) && ( num
->num
[i
] == '0'); i
++ )
317 /* Keep at least one character */;
320 for ( j
= 0; j
< num
->size
- i
; j
++ )
322 num
->num
[j
] = num
->num
[j
+ i
];
327 assert( num
->size
> 0 );
330 if ( ( num
->size
== 1 ) && ( num
->num
[0] == '0' ) )
338 int getdescr( const tsd_t
*TSD
, const streng
*num
, num_descr
*descr
)
339 /* converts num into a descr and returns 0 if successfully.
340 * returns 9 or 11 in case of an error. descr contains nonsense in this case.
341 * 9 is returned if the exponent is too big, 11 if num is no number.
342 * The newly generated descr is as short as possible: leading and
343 * trailing zeros (after a period) will be cut, rounding occurs.
344 * We don't use registers and hope the compiler does it better than outselves
345 * in the optimization stage, else try in this order: c, inlen, in, out, exp.
348 const char *in
; /* num->value */
349 int inlen
; /* chars left in "in" */
350 char *out
; /* descr->num */
351 int outpos
; /* position where to write */
352 int outmax
; /* descr->max */
353 char c
, /* tmp var */
354 lastdigit
= 0; /* last digit seen for mantissa, init: error */
355 int pointseen
, /* point in mantissa seen? */
356 exp
, /* exp from mantissa */
357 exp2
, /* exp from "1E1" */
358 expsign
; /* sign of the exp in "1E-1", 1 or -1 */
361 * The maximum size of the mantissa is the worst case of a plain number,
364 outmax
= Str_len(num
);
366 IS_AT_LEAST( descr
->num
, descr
->max
, outmax
);
369 * A new number shall always be printed with the current DIGITS value.
371 descr
->used_digits
= TSD
->currlevel
->currnumsize
;
374 inlen
= Str_len(num
);
375 /* skip leading spaces */
376 while (inlen
&& rx_isspace(*in
))
388 if ((c
== '-') || (c
== '+'))
390 descr
->negative
= (c
== '-') ;
393 while (inlen
&& rx_isspace(*in
)) /* skip leading spaces */
403 descr
->negative
= 0 ;
405 /* cut ending blanks first, a non blank exists (in[0]) at this point */
406 while (rx_isspace(in
[inlen
-1]))
409 while (inlen
&& (*in
== '0')) /* skip leading zeros */
416 { /* Fast breakout in case of a plain "0" or an error */
418 descr
->num
[0] = lastdigit
;
421 if (lastdigit
== '0')
429 /* Transfer digits and check for points */
430 pointseen
= 0; /* never seen */
436 if ((c
= *in
) == '.')
450 if ((c
=='0') && (outpos
==0)) /* skip zeros in "0.0001" */
451 exp
--; /* We must be after a point, see zero parsing above */
468 /* the mantissa is correct now, check for ugly "0.0000" later */
471 /* c is *in at this point, see above */
473 if ((c
!= 'e') && (c
!= 'E'))
475 if (--inlen
== 0) /* at least one digit must follow */
480 if ((c
== '+') || (c
== '-'))
484 if (--inlen
== 0) /* at least one digit must follow */
494 /* a rough test first, assume a mantissa with length < MAX_EXPONENT */
495 if ( exp2
> MAX_EXPONENT
/ 10 )
497 exp2
= exp2
*10 + (c
- '0');
498 if ( expsign
* (exp
+ expsign
* exp2
) - 1 > MAX_EXPONENT
)
506 if (outpos
== 0) /* no digit or 0.000 with or without exp */
515 descr
->size
= outpos
;
516 assert(descr
->size
<= outmax
);
522 * Rounds descr to size digits. If stop_on_cut is set, a LOSTDIGITS condition
523 * is fired if anything other than zeros are truncated.
525 static void descr_round( num_descr
*descr
, int size
, tsd_t
*stop_on_cut
)
530 * We don't touch descr->used_digits here. If the caller really needs it,
531 * it must be done at that level. Rounding itself isn't an operation
532 * creating a number in the terms of Rexx in opposite to TRUNC() or the
533 * normal mathematical operations.
537 * Can't do illegal operations.
542 * Increment size by the number of leading zeros existing.
544 for ( i
= 0; i
< descr
->size
; i
++ )
546 if ( descr
->num
[i
] == '0' )
554 * Do we have to round?
556 if ( descr
->size
<= size
)
561 for ( i
= size
; i
< descr
->size
; i
++ )
563 if ( descr
->num
[i
] != '0' )
565 condition_hook( stop_on_cut
,
570 name_of_node( stop_on_cut
, NULL
, descr
),
575 if ( i
>= descr
->size
)
584 * Is it possibly just a truncation?
586 if ( descr
->num
[size
] < '5' )
592 * increment next digit, and loop if that was a '9'
594 for ( i
= size
- 1; ; )
596 if ( descr
->num
[i
] != '9' )
602 descr
->num
[i
--] = '0';
607 * "Carry", we have to increment the exponent. The complete mantissa
608 * consists of zeros. We have to set it to "1000...".
612 * Just check a few things ... I don't like surprises
614 for ( i
= 0; i
< size
; i
++ )
615 assert( descr
->num
[i
] == '0' );
626 void str_round( num_descr
*descr
, int size
)
628 descr_round( descr
, size
, NULL
);
632 void str_round_lostdigits( tsd_t
*TSD
, num_descr
*descr
, int size
)
634 descr_round( descr
, size
, TSD
);
638 void descr_copy( const tsd_t
*TSD
, const num_descr
*f
, num_descr
*s
)
641 * Check for the special case that these are identical, then we don't
642 * have to do any copying, so just return.
647 s
->negative
= f
->negative
;
650 s
->used_digits
= f
->used_digits
;
652 IS_AT_LEAST( s
->num
, s
->max
, f
->size
) ;
653 memcpy( s
->num
, f
->num
, f
->size
) ;
657 * string_add2 computes
661 * with the current digits() setting of ccns (e.g. TSD->currlevel->currnumsize)
662 * Keep in mind that f or s may be identical to r.
664 * Function rewritten completely on 03.07.2005 by FGC. The former one was
665 * incompatible with the standard. This approach follows the ANSI standard's
668 static void string_add2( tsd_t
*TSD
, const num_descr
*f
, const num_descr
*s
,
669 num_descr
*r
, int ccns
)
671 mat_tsd_t
*mt
; /* mt->add_out is used */
672 int neg
; /* negate the result if set, and also: f WAS negative*/
673 int sneg_factor
; /* -1: s is negative, 1: s is positive */
674 int carry
; /* carry flag */
675 int loan
; /* loan flag */
676 const char *fnum
; /* mantissa start of f */
677 const char *snum
; /* mantissa start of s */
678 char *fpoint
; /* least significant mantissa position of f */
679 const char *spoint
; /* least significant mantissa position of s */
680 /* There is no more digits available if point < num */
681 int h
, h2
, h3
; /* helper */
682 const num_descr
*swp
;/* helper */
684 static const char none
[2] =""; /* just to keep pointers valid */
687 * In opposite to ANSI we don't have to consider NUMERIC FUZZ. The
688 * comparisons are done using string_test.
692 * ANSI results f if s==0 (strict comparison!) and s if f==0 with respect
693 * to the operator which is "+" in string_add2.
695 if ((s
->size
== 1) && (s
->num
[0] == '0'))
697 descr_copy( TSD
, f
, r
);
700 if ((f
->size
== 1) && (f
->num
[0] == '0'))
702 descr_copy( TSD
, s
, r
);
707 * The other shortcut isn't mentioned in ANSI where the exponents differ
708 * so significantly that one operand isn't used at all. So just continue
709 * to try computing 1+1e1000.
712 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
714 * We use a temporary buffer for the result. We don't know the magnitude of
715 * the result in advance (99.99 may be rounded to 100), so we need 2 more
716 * digits: one for the digits after ccns which is calculated to determine
717 * a first rounding and one for the overflow.
718 * Thus, the most significant number which is a template of the result
719 * has a virtual mantissa position of 1 because position 0 is reserved for
722 IS_AT_LEAST( mt
->add_out
, mt
->add_outsize
, ccns
+2 );
724 mt
->outptr5
= mt
->add_out
;
730 * The number with the most significant exponent needs to be the
731 * first one to make things simpler.
739 * It is much easier to reduce the various situations by making the first
741 * -x op y is equivalent to -(x op -y)
745 /* always use a positive number as the left operator */
747 sneg_factor
= s
->negative
? 1 : -1;
752 sneg_factor
= s
->negative
? -1 : 1;
758 * The most significant number is the base of the result. The other number
759 * is aligned to the most significant. Example where the second is the
760 * most significant number:
767 r
->exp
= f
->exp
; /* save now even if s==r */
769 * s may need an adjustement.
771 h2
= MIN( ccns
+ 1, f
->size
); /* h2 = used mantissa length of f */
772 h3
= MIN( ccns
+ 1 - h
, s
->size
); /* h3 = used mantissa length of s */
776 * spoint = snum + h3 - 1 is NOT allowed. h3 may be so small that
777 * spoint becomes really invalid and may cause a segment violation.
784 spoint
= snum
+ h3
- 1;
786 r
->size
= MAX( h2
, h
+ h3
);
789 * We conpute "r = f; r += s;" This is much easier to handle than everything
793 mt
->add_out
[0] = '0';
794 memcpy( mt
->add_out
+ 1, fnum
, h2
);
795 memset( mt
->add_out
+ h2
+ 1, '0', r
->size
- h2
);
800 * Get the fpoint to that position that needs to be added by spoint.
801 * This is a valid position because we filled up with 0 already.
803 fnum
= mt
->add_out
; /* NOT +1, keep it on the starting 0 */
804 fpoint
= (char *) fnum
+ h
+ h3
; /* NOT -1, because fnum is decremented */
807 while ( spoint
>= snum
)
809 c
= *fpoint
+ sneg_factor
* (*spoint
- '0') + carry
- loan
;
810 if ((loan
= (c
< '0')) != 0)
814 if ((carry
= (c
> '9')) != 0)
821 while ( fpoint
> fnum
)
823 c
= *fpoint
+ carry
- loan
;
824 if ((loan
= (c
< '0')) != 0)
828 if ((carry
= (c
> '9')) != 0)
851 * Having a loan means we have a negative result. Reverse the result with
855 for ( h
= r
->size
- 1, carry
= 10; h
>= 0; h
-- )
857 if ( ( fpoint
[h
] = (char) (carry
- (fpoint
[h
] - '0') + '0') ) > '9' )
868 * Added so far. Now accomplish the rounding following ANSI rules.
870 * We can increase the result's accurracy by jumping over one leading
871 * zero if available first, but this breaks ANSI.
874 if ( r
->size
> ccns
)
877 if ( fpoint
[ccns
] > '4' )
880 * Increment mantissa regardless of the true sign.
885 while ( fpoint
>= fnum
)
887 if ( ++(*fpoint
) <= '9' )
890 fpoint
= (char *) fnum
- 1;
908 IS_AT_LEAST( r
->num
, r
->max
, r
->size
) ;
909 memcpy( r
->num
, fpoint
, r
->size
);
914 void string_add( tsd_t
*TSD
, const num_descr
*f
, const num_descr
*s
,
915 num_descr
*r
, cnodeptr left
, cnodeptr right
)
917 int ccns
= TSD
->currlevel
->currnumsize
;
919 LOSTDIGITS_CHECK( f
, ccns
, left
);
920 LOSTDIGITS_CHECK( s
, ccns
, right
);
922 string_add2( TSD
, f
, s
, r
, ccns
);
924 r
->used_digits
= ccns
;
927 streng
*str_format(tsd_t
*TSD
, const streng
*input
, int Before
,
928 int After
, int Expp
, int Expt
)
929 /* According to ANSI X3J18-199X, 9.4.2, this function performs the BIF "format"
930 * with extensions made by Brian.
931 * I rewrote the complete function to allow comparing of this function code
932 * to that one made in Rexx originally.
933 * input is the first arg to "format" and may not be a number.
934 * Before, After, Expp and Expt are the other args to this function and are
935 * -1 if they are missing value.
939 #define Enlarge(Num,atleast) if (Num.size + (atleast) > Num.max) { \
940 char *newnum = (char *)MallocTSD(Num.size + (atleast) + 5); \
941 Num.max = Num.size + (atleast) + 5; \
942 memcpy( newnum, Num.num, Num.size ); \
949 int ShowExp
,Exponent
,ExponentLen
= 0,Afters
,Sign
,Point
,OrigExpp
,h
;
951 char Expart
[80]; /* enough even on a 256-bit-machine for an int */
955 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
958 * Convert the input to a number and check if it is a number at all.
960 if ( ( h
= getdescr( TSD
, input
, &mt
->fdescr
) ) != 0 )
963 exiterror( ERR_INCORRECT_CALL
, h
, "FORMAT", 1, mt
->max_exponent_len
, tmpstr_of( TSD
, input
) );
965 exiterror( ERR_INCORRECT_CALL
, h
, "FORMAT", 1, tmpstr_of( TSD
, input
) );
968 StrictAnsi
= get_options_flag( TSD
->currlevel
, EXT_STRICT_ANSI
);
970 * Round the number according to NUMERIC DIGITS. This is rule 9.2.1.
971 * It is mentioned at several places in 9.4.1 (FORMAT).
972 * FGC: This is bullshit if you want to have format() formatting numbers
973 * with a higher precision than DIGITS. I've put it into STRICT mode.
974 * Regina's normal mode allows any numbers to be formatted. The
975 * default formatting rounds to DIGITS, though.
979 str_round_lostdigits( TSD
, &mt
->fdescr
, TSD
->currlevel
->currnumsize
);
983 * We have done the "call CheckArgs" of the ANSI function.
987 * In the simplest case the first is the only argument.
989 if ( ( Before
== -1 ) && ( After
== -1 ) && ( Expp
== -1 ) && ( Expt
== -1 ) )
990 return str_norm( TSD
, &mt
->fdescr
, NULL
);
993 Expt
= TSD
->currlevel
->currnumsize
;
996 * The number is already set up but check twice that we don't have leading
999 str_strip( &mt
->fdescr
);
1002 * Trailing zeros are confusing, too:
1004 while ( ( mt
->fdescr
.size
> 1 )
1005 && ( mt
->fdescr
.num
[mt
->fdescr
.size
- 1] == '0' ) )
1008 Sign
= ( mt
->fdescr
.negative
) ? 1 : 0;
1011 * Now compute the Exponent str_norm would use to format the number.
1012 * Don't keep care for ENGINEERING. Note that this equals to the result
1013 * We can determine the value of ShowExp en passent. This shortens our
1014 * approach to ANSI's algorithm significantly.
1018 if ( ( ( Expp
!= 0 ) &&
1019 ( ( mt
->fdescr
.exp
< -5 ) || ( mt
->fdescr
.exp
> Expt
) ) ) ||
1020 ( ( Expt
== 0 ) && !StrictAnsi
/* fixes bug 562668 */ ) )
1023 Exponent
= mt
->fdescr
.exp
- 1;
1026 /* The number is normalized, now.
1027 * Usage of the variables:
1028 * mt->fdescr.num: Mantissa in the ANSI-standard and defined as usual, zeros
1029 * may be padded at the end but never at the start because:
1030 * mt->fdescr.exp: true exponent for the mantissa. The point is just before
1032 * Exponent: Used Exponent for the mantissa, e.g.:
1033 * mt->fdescr.num=1,mt->fdescr.exp=2 = 0.1E2 = 10E0
1034 * In this case Exponent may be 0 to reflect the exponent we
1036 * Point: Defined in the standard but not used. It is obviously
1037 * equal to (mt->fdescr.exp-Exponent) where Point must
1038 * be inserted before.
1039 * examples with both mt->fdescr.num=Mantissa="101" and mt->fdescr.exp=-2:
1040 * Exponent=0: output may be "0.00101"
1041 * Exponent=-3: output may be "1.01E-3"
1045 * The fourth and fifth arguments allow for exponential notation.
1047 * Decide whether exponential form to be used, setting ShowExp.
1050 * These tests have to be on the number before any rounding since
1051 * decision on whether to have exponent affects what digits surround
1052 * the decimal point.
1054 * Sign, Mantissa(mt->fdescr.num) and Exponent now reflect the Number.
1055 * Keep in mind that the Mantissa of a num_descr is always normalized to
1056 * a value smaller than 1. Thus, mt->fdescr(num=1,exp=1) means 0.1E1=1)
1058 * ShowExp now indicates whether to show an exponent.
1063 if ( ( TSD
->currlevel
->numform
== NUM_FORM_ENG
) && h
)
1066 * Integer division may return values < 0
1074 * As a side effect, ANSI adds zeros automatically. This must be
1075 * honoured if after isn't given.
1077 Enlarge( mt
->fdescr
, h
);
1078 memset( mt
->fdescr
.num
+ mt
->fdescr
.size
, '0', h
);
1079 mt
->fdescr
.size
+= h
;
1085 * Deal with right of decimal point first since that can affect the
1086 * left. Ensure the requested number of digits there.
1087 * Afters = length(Mantissa) - Point, thus;
1089 Afters
= mt
->fdescr
.size
- ( mt
->fdescr
.exp
- Exponent
);
1091 After
= Afters
; /* Note default. */
1094 * The following happens due to our excessive trimming of zeros.
1099 /* Make Afters match the requested After */
1100 if ( Afters
< After
)
1103 * We have to add (After - Afters) zeros. This can be done more
1104 * efficiently later.
1107 else if ( Afters
> After
)
1110 * Don't forget the most needed thing. We need it later to determine
1111 * the number of zeros being added as 0.
1116 * Round by adding 5 at the right place.
1117 * Regina uses a different algorithm.
1120 h
= mt
->fdescr
.exp
- Exponent
+ After
; /* aka Point + After */
1122 mt
->fdescr
.size
= h
;
1124 if ( ( h
< 0 ) || ( ( h
== 0 ) && ( mt
->fdescr
.num
[0] < '5' ) ) )
1127 * Round to zero. We may not have any usable characters in the
1128 * mantissa, so create one.
1130 mt
->fdescr
.num
[0] = '0';
1131 mt
->fdescr
.size
= 1;
1134 else if ( mt
->fdescr
.num
[h
] >= '5' )
1136 for ( h
--; h
>= 0; h
-- )
1138 if ( ++mt
->fdescr
.num
[h
] <= '9' )
1140 mt
->fdescr
.num
[h
] = '0';
1144 * We have a carry one in front if h < 0.
1145 * In this case we have to re-adjust the Exponent which is pretty
1146 * difficult in ENGINEERING notation.
1150 Enlarge( mt
->fdescr
, 1 );
1151 memmove( mt
->fdescr
.num
+ 1, mt
->fdescr
.num
, mt
->fdescr
.size
);
1153 mt
->fdescr
.num
[0] = '1';
1156 /* The hard part follows */
1157 if ( mt
->fdescr
.exp
- Exponent
> Expt
)
1171 Exponent
= mt
->fdescr
.exp
- 1;
1173 if ( ( TSD
->currlevel
->numform
== NUM_FORM_ENG
) && h
)
1176 * Integer division may return values < 0
1188 * This can leave the result zero. The remaining zero-characters
1189 * shall persist, but the sign may change.
1191 for ( h
--; h
>= 0; h
-- )
1193 if ( mt
->fdescr
.num
[h
] != '0' )
1204 * That's all for now with the right part
1208 * Now deal with the part of the result before the decimal point.
1209 * Point doesn't change never more.
1211 Point
= mt
->fdescr
.exp
- Exponent
;
1215 * missing front of the number?
1216 * assume 1 char for "0" of "0.xxx"
1223 * Make Point match Before
1225 if ( h
> Before
- Sign
)
1227 exiterror( ERR_INCORRECT_CALL
, 38, "FORMAT", 2, tmpstr_of( TSD
, input
) );
1230 * We don't fill up leading zeros as documented in the standard. Useless!
1234 * We check the length of the exponent field, first. This allows to
1235 * allocate a sufficient string for the complete number.
1241 * Format the exponent.
1243 sprintf( Expart
, "%+d", Exponent
);
1244 ExponentLen
= strlen( Expart
) - 1;
1248 if ( ExponentLen
> Expp
)
1250 exiterror( ERR_INCORRECT_CALL
, 38, "FORMAT", 4, tmpstr_of( TSD
, input
) );
1261 bufsize
= Before
+ After
+ Expp
+ 4; /* Point, "E+", term. zero */
1262 buf
= (char *)MallocTSD(bufsize
);
1265 * Now do the formatting, it's a little bit complicated, since the parts
1266 * of the number may not exist (partially).
1268 * Format the part before the point
1273 * denormalized number
1275 assert( Before
>= 1 + Sign
);
1276 memset( buf
, ' ', Before
- 1 );
1277 buf
[Before
- 1] = '0';
1279 buf
[Before
- 2] = '-';
1283 memset( buf
, ' ', Before
- Point
);
1284 if ( ( h
= Point
) > mt
->fdescr
.size
)
1285 h
= mt
->fdescr
.size
;
1286 memcpy( buf
+ Before
- Point
, mt
->fdescr
.num
, h
);
1287 memset( buf
+ Before
- Point
+ h
, '0', Point
- h
);
1289 buf
[Before
- Point
- 1] = '-';
1294 * Process the part after the decimal point
1298 buf
[bufpos
++] = '.';
1302 * Denormalized mantissa, we must fill up with zeros
1306 h
= After
; /* beware of an overrun */
1307 memset( buf
+ bufpos
, '0', h
);
1308 if ( After
- h
<= mt
->fdescr
.size
)
1310 memcpy( buf
+ bufpos
+ h
, mt
->fdescr
.num
, After
- h
);
1314 memcpy( buf
+ bufpos
+ h
, mt
->fdescr
.num
, mt
->fdescr
.size
);
1315 memset( buf
+ bufpos
+ h
+ mt
->fdescr
.size
,
1317 After
- h
- mt
->fdescr
.size
);
1322 if ( After
+ Point
<= mt
->fdescr
.size
)
1324 memcpy( buf
+ bufpos
, mt
->fdescr
.num
+ Point
, After
);
1329 * number of After characters in the mantissa?
1331 if ( ( h
= mt
->fdescr
.size
- Point
) < 0 )
1334 memcpy( buf
+ bufpos
, mt
->fdescr
.num
+ Point
, h
);
1335 memset( buf
+ bufpos
+ h
, '0', After
- h
);
1341 /* Finally process the exponent. ExponentBuffer contents the exponent
1346 if ( Exponent
== 0 )
1348 if ( OrigExpp
!= -1 )
1350 memset( buf
+ bufpos
, ' ', Expp
+ 2 );
1356 buf
[bufpos
++] = 'E';
1357 buf
[bufpos
++] = Expart
[0];
1358 memset( buf
+ bufpos
, '0', Expp
- ExponentLen
);
1359 memcpy( buf
+ bufpos
+ Expp
- ExponentLen
, Expart
+ 1, ExponentLen
);
1364 assert( bufpos
< bufsize
);
1367 retval
= Str_creTSD( buf
);
1374 * str_norm does the "PostOp" operation of the ANSI standard. It throws
1375 * away leading zeros and does some rounding with DIGITS of the time the
1376 * number was generated. try (if non-NULL) is used to print the number and is
1377 * returned. Never use try again after the call with the exception of
1378 * "x = str_norm(?,?,x)".
1380 * The return value is the printable number.
1382 * The value "in" may be rounded and reformatted.
1384 streng
*str_norm( const tsd_t
*TSD
, num_descr
*in
, streng
*trystr
)
1388 int size
,exp
,ccns
,Point
;
1391 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
1393 ccns
= in
->used_digits
;
1395 * We use ccns for the allocation of the string's content. Chop this value
1396 * is case of number which doesn't need billions of digits.
1398 if ( ( exp
= in
->exp
) < 0 )
1400 if ( ccns
> in
->size
+ exp
+ 10 )
1401 ccns
= in
->size
+ exp
+ 10 ;
1403 * The longest number produced from a num_descr is (with DIGITS=i)
1404 * -1.2...iE-MAX_EXPONENT
1405 * and its length is DIGITS + length(MAX_EXPONENT) + strlen(-.E-\0)
1407 IS_AT_LEAST( mt
->norm_out
, mt
->norm_outsize
, ccns
+ mt
->max_exponent_len
+ 6 );
1409 mt
->outptr2
= mt
->norm_out
;
1413 * remove effect of leading zeros in the descriptor
1415 for ( i
= 0; i
< in
->size
; i
++ )
1417 if ( in
->num
[i
] != '0' )
1422 memmove( in
->num
, in
->num
+ i
, in
->size
- i
);
1428 * We may have a number without mantissa. Even a rounding with DIGITS==1
1429 * will always produce a non-zero number. We can therefore do the test
1430 * before every other and return "0" in case of a mantissa with zeros.
1432 if ( in
->size
== 0 )
1442 trystr
->value
[0] = '0';
1447 Free_stringTSD( trystr
);
1448 trystr
= Str_creTSD( "0" );
1452 trystr
= Str_creTSD( "0" );
1458 * Do the rounding needed for DIGITS. It may be to late here for doing this.
1459 * The user may have changed DIGITS between the operation and this function.
1466 if ( in
->num
[i
] >= '5' )
1468 for ( i
--; i
>= 0; i
-- )
1470 if ( ++in
->num
[i
] <= '9' )
1481 memmove( in
->num
+ 1, in
->num
, in
->size
- 1 );
1487 * This may have produced leading zeros.
1492 * Truncation of trailing zeros must be done by the operations themself.
1493 * We are not allowed to cut them away, even after a decimal point.
1499 * Compute the exponent used to display. exp==0 -> don't show an exponent.
1500 * Respect the ENGINEERING format.
1502 if ( ( exp
< -6 ) || ( exp
>= ccns
) )
1505 if ( ( TSD
->currlevel
->numform
== NUM_FORM_ENG
) && i
)
1508 * Integer division may return values < 0.
1514 if ( ( MAX_EXPONENT
< exp
) || ( -MAX_EXPONENT
> exp
) )
1516 exiterror( ERR_ARITH_OVERFLOW
, 0 ) ;
1526 * Point points to the first char in the mantissa which is right of the
1529 Point
= in
->exp
- exp
;
1533 mt
->norm_out
[size
++] = '-';
1536 * Process the part BEFORE the point.
1541 * Something like "0.1". We have to provide an integer part.
1543 mt
->norm_out
[size
++] = '0';
1545 else if ( Point
<= in
->size
)
1548 * Integer part exists and lays in the matissa completely.
1550 memcpy( mt
->norm_out
+ size
, in
->num
, Point
);
1556 * Integer part exists but is partially represented only, something
1557 * like "1e3" without trailing zeros.
1559 memcpy( mt
->norm_out
+ size
, in
->num
, in
->size
);
1561 memset( mt
->norm_out
+ size
, '0', Point
- in
->size
);
1562 size
+= Point
- in
->size
;
1566 * Process the part AFTER the point.
1568 if ( Point
< in
->size
)
1571 * We have to show something as a fractional part.
1573 mt
->norm_out
[size
++] = '.';
1578 * Something like 1E-3, leading zeros are missing.
1580 memset( mt
->norm_out
+ size
, '0', -Point
);
1582 memcpy( mt
->norm_out
+ size
, in
->num
, in
->size
);
1588 * Something of the fractional part is there as induced by the
1591 memcpy( mt
->norm_out
+ size
, in
->num
+ Point
, in
->size
- Point
);
1592 size
+= in
->size
- Point
;
1597 * We can add the exponent and that's it.
1601 size
+= sprintf( mt
->norm_out
+ size
, "E%+d", exp
);
1603 * implicitely adds a \0 at the end.
1606 assert( size
+ 1 <= mt
->norm_outsize
);
1610 if ( trystr
->max
< size
)
1612 Free_stringTSD( trystr
);
1619 result
= Str_makeTSD( size
);
1621 memcpy( result
->value
, mt
->norm_out
, size
);
1626 int string_test( const tsd_t
*TSD
, const num_descr
*first
,
1627 const num_descr
*second
)
1629 int i
=0, top
=0, fnul
=0, snul
=0 ;
1630 char fchar
=' ', schar
=' ' ;
1631 int ccns
= TSD
->currlevel
->currnumsize
;
1633 if ( first
->negative
!= second
->negative
) /* have different signs */
1634 return ( first
->negative
? -1 : 1 ) ;
1636 fnul
= ( first
->size
==1 && first
->exp
==1 && first
->num
[0]=='0') ;
1637 snul
= ( second
->size
==1 && second
->exp
==1 && second
->num
[0]=='0') ;
1640 if (fnul
&& snul
) return 0 ;
1641 if (fnul
) return (second
->negative
? 1 : -1 ) ;
1642 else return (first
->negative
? -1 : 1 ) ;
1645 if ( first
->exp
!= second
->exp
) /* have different order */
1646 return (log_xor( first
->negative
, first
->exp
>second
->exp
) ? 1 : -1 ) ;
1648 /* same order and sign, have to compare ccns - TSD->currlevel->numfuzz first */
1649 top
= MIN( ccns
- TSD
->currlevel
->numfuzz
, MAX( first
->size
, second
->size
)) ;
1650 for ( i
=0; i
<top
; i
++ )
1652 fchar
= (char) ((first
->size
> i
) ? first
->num
[i
] : '0') ;
1653 schar
= (char) ((second
->size
> i
) ? second
->num
[i
] : '0') ;
1654 if ( fchar
!= schar
)
1655 return log_xor( first
->negative
, fchar
>schar
) ? 1 : -1 ;
1658 /* hmmm, last resort: can the numbers be rounded to make a difference */
1659 fchar
= (char) ((first
->size
> i
) ? first
->num
[i
] : '0') ;
1660 schar
= (char) ((second
->size
> i
) ? second
->num
[i
] : '0') ;
1661 if (((fchar
>'4') && (schar
>'4')) || ((fchar
<'5') && (schar
<'5')))
1662 return 0 ; /* equality! */
1664 /* now, one is rounded upwards, the other downwards */
1665 return log_xor( first
->negative
, fchar
>'5' ) ? 1 : -1 ;
1670 num_descr
*string_incr( tsd_t
*TSD
, num_descr
*input
, cnodeptr node
)
1672 int last
,ccns
=TSD
->currlevel
->currnumsize
;
1675 assert( input
->size
> 0 ) ;
1677 if (input
->size
!= input
->exp
|| input
->exp
>= ccns
)
1679 static const num_descr one
= { "1", 0, 1, 1, 1, -1 } ;
1681 string_add( TSD
, input
, (num_descr
*) &one
, input
, node
, NULL
) ;
1682 str_round(input
,ccns
) ;
1690 LOSTDIGITS_CHECK( input
, ccns
, node
);
1692 * No LOSTDIGITS check for "1". If this fails, everything fails...
1698 if (input
->negative
)
1700 if (cptr
[last
] > '1')
1703 input
->used_digits
= ccns
;
1706 else if (cptr
[last
]=='1')
1710 str_strip( input
) ;
1711 input
->used_digits
= ccns
;
1716 assert( cptr
[last
] == '0' ) ;
1718 cptr
[last
--] = '9' ;
1723 if (cptr
[last
] < '9')
1726 input
->used_digits
= ccns
;
1731 assert( cptr
[last
] == '9' ) ;
1732 cptr
[last
--] = '0' ;
1738 if (input
->size
>= input
->max
)
1742 assert( input
->size
== input
->max
) ;
1743 newnum
= (char *)MallocTSD( input
->max
* 2 + 2 ) ;
1744 memcpy( newnum
+1, input
->num
, input
->size
) ;
1748 input
->max
= input
->max
*2 + 2 ;
1749 FreeTSD( input
->num
) ;
1750 cptr
= input
->num
= newnum
;
1754 memmove( input
->num
+1, input
->num
, input
->size
) ;
1757 input
->num
[0] = '0' ;
1766 * tests for an ANSI compatible whole number. Look at myiswnumber()
1767 * for a description.
1769 static int test_whole( const tsd_t
*TSD
, const num_descr
*input
,
1774 if ( input
->size
> input
->exp
)
1777 * Check for non-zeros in the fractional part of the number.
1779 i
= MAX( 0, input
->exp
);
1780 for ( ; i
< input
->size
; i
++ )
1782 if ( input
->num
[i
] != '0' )
1787 if ( !noDigitsLimit
)
1789 for (i
= 0; i
< input
->size
; i
++)
1791 if (input
->num
[i
] != '0')
1794 if (i
< input
->size
)
1797 if (input
->exp
- i
> TSD
->currlevel
->currnumsize
)
1806 * Division in the typical manner we learn in school hopefully.
1808 * type is DIVTYPE_NORMAL for floating point division, DIVTYPE_INTEGER for
1809 * division without remainer, DIVTYPE_REMAINER if the remainer is interested in
1810 * and DIVTYPE_BOTH if both the integer part and the remainer shall be
1813 * We compute f/s with a NUMERIC DIGITS value of ccns.
1815 * The return value is put into *r, *r2 holds the remainer if DIVTYPE_BOTH
1818 * We throw an error on non-floating point division if the COMPLETE integer
1819 * part of the division can't be represented without rounding.
1821 static void string_div2( tsd_t
*TSD
, const num_descr
*f
, const num_descr
*s
,
1822 num_descr
*r
, num_descr
*r2
, int type
, int ccns
)
1824 int ssize
,tstart
,tcnt
,finished
=0,tend
;
1825 int i
,cont
,outp
,test
,loan
;
1826 int origneg
,origexp
;
1829 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
1831 IS_AT_LEAST( mt
->div_out
, mt
->div_outsize
, (ccns
+1) * 2 + 1 );
1832 IS_AT_LEAST( r
->num
, r
->max
, ccns
+1 );
1834 mt
->outptr3
= mt
->div_out
;
1838 * We don't want to strip leading zeros here!
1840 assert( ( ( f
->size
> 1 ) && ( f
->num
[0] != '0' ) ) || ( f
->size
== 1 ) );
1841 assert( ( s
->size
!= 0 ) && ( s
->num
[0] != '0' ) );
1844 * ssize is the count of the used digits from s's mantissa.
1846 ssize
= MIN( s
->size
, ccns
+1 );
1849 * Compute the trivial parts of the result.
1850 * Imagine xxxxx : yy = zzzz, probably with zeros.
1852 r
->exp
= 1 + f
->exp
- s
->exp
;
1853 r
->negative
= log_xor( f
->negative
, s
->negative
);
1856 * Initialize the pointers.
1857 * tstart, tend, tcnt
1860 tend
= tstart
+ MIN( f
->size
, ccns
+1 );
1863 * First, fill div_out with f as the residual. Fill up with zeros.
1865 for ( tcnt
= tstart
; tcnt
< ssize
; tcnt
++ )
1866 mt
->div_out
[tcnt
] = (char) ( ( tcnt
< tend
) ? f
->num
[tcnt
] : '0' );
1869 * Imagine xxxxx : yy again. If the first length(yy) digits of xxxxx
1870 * are smaller than yy, we have to set the first digit of z to 0. For
1871 * entering the main algorithm, we do the step here decrementing the
1872 * result's exponent, which if mathematically the same.
1873 * e.g. 12345 : 23 = 0zzz
1876 for ( i
= 0; i
< ssize
; i
++ )
1878 if ( mt
->div_out
[i
] > s
->num
[i
] )
1880 else if ( mt
->div_out
[i
] < s
->num
[i
] )
1883 * Fetch next digit of f for the next iteration, remember the school.
1885 mt
->div_out
[tcnt
] = (char) ( ( tcnt
< tend
) ? f
->num
[tcnt
] : '0' );
1893 * Situation: s->num[0..ssize-1] contains the divisor, and the array
1894 * div_out[tstart==0..tcnt-1] hold the (first part of the) dividend. The
1895 * array f->num[tcnt..tend-1] (which may be empty) holds the last
1896 * part of the dividend.
1898 * We compute (the first part of) div_out : s
1900 * Iterate through each digit of div_out, fetching the next digit from
1903 for ( outp
= 0; outp
< ccns
+1 && !finished
; outp
++ )
1906 * Assume 0 as the result for the next digit. We may increment it below
1910 if ( ( tcnt
- tstart
> ssize
) && ( mt
->div_out
[tstart
] == '0' ) )
1914 * Stop the iteration if this is integer division, and we have hit the
1917 if ( ( type
!= DIVTYPE_NORMAL
) && ( outp
>= r
->exp
) )
1924 * Try to subtract as many times as possible, that is, compute the
1925 * next digit of the result. Our example in the second step:
1926 * 12 345 : 23 = 0 zzz (before iteration)
1927 * 123 45 : 23 = 05 zz (first iteration)
1928 * 00 84 5 : 23 = 053 z (84 contains 3 times 23)
1930 for ( cont
= 1; cont
; )
1933 * If the current operation works on equal sized numbers (e.g.
1934 * second iteration), we have to compare if we can do the next
1935 * subtraction. This isn't necessary if (tcnt-tstart) > ssize, which
1936 * means the partial dividend (123 in first iteration) is longer
1937 * than the divisor (23, only two chars). xx always is smaller than
1938 * yyy if they don't start with 0.
1940 if ( tcnt
- tstart
== ssize
)
1942 for ( i
= 0; i
< ssize
; i
++ )
1944 test
= mt
->div_out
[tstart
+ i
] - s
->num
[i
];
1953 * If we can continue, subtract it.
1959 for ( i
= 0; i
< ssize
; i
++ )
1961 char h
= (char) ( s
->num
[ssize
-1-i
] - '0' + loan
);
1962 mt
->div_out
[tcnt
-1-i
] = (char) ( mt
->div_out
[tcnt
-1-i
] - h
);
1963 if ( ( loan
= (mt
->div_out
[tcnt
-1-i
] < '0' ) ) != 0 )
1964 mt
->div_out
[tcnt
-1-i
] += 10;
1969 * decrement it and check for '0'
1971 mt
->div_out
[tstart
] -= 1;
1972 if ( ( tcnt
- tstart
> ssize
) &&
1973 ( mt
->div_out
[tstart
] == '0' ) )
1978 } /* for each possible subtraction */
1980 if ( ( tcnt
- tstart
> ssize
) && ( mt
->div_out
[tstart
] == '0' ) )
1984 * Do we have anything left of the dividend? This is only meaningful if
1985 * all digits in the original divident have been processed, it is
1986 * also safe to assume that divident and divisor have equal sizes.
1989 assert( tcnt
-tstart
== ssize
);
1990 mt
->div_out
[tcnt
] = (char) ( ( tcnt
< tend
) ? f
->num
[tcnt
] : '0' );
1991 if ( ++tcnt
> tend
)
1994 for ( i
= tstart
; i
< tcnt
; i
++ )
1996 if ( mt
->div_out
[i
] != '0' )
2004 } /* for each digit wanted in the result */
2006 if ( type
!= DIVTYPE_NORMAL
)
2011 * Perform a validity check. We may got a remainder bigger than
2012 * the residual. It indicates a rounded integer part value.
2013 * The residual in div_out[tstart..tcnt-1] counted from div_out[0] is
2015 * Find the first non-zero in the residiual and continue then.
2018 test
= MIN( MAX( tend
, tcnt
) - tstart
, ccns
+ 1 );
2019 for ( i
= 0; i
< test
; i
++ )
2022 h
= (char) ( ( i
< tcnt
- tstart
) ? mt
->div_out
[tstart
+i
] :
2029 * s begins withs a non-zero as the digit at tstart+i. Only compare the
2030 * numbers if the residual may be greater than s.
2032 if ( ( f
->exp
- tstart
- i
>= s
->exp
) && ( i
< test
) )
2034 if ( f
->exp
- tstart
- i
> s
->exp
)
2037 * The residual has a higher exponent. We have definitely an error.
2044 * This fits many situations. The exponent is the same, we have
2045 * to compare the digits of the number.
2049 test
= MIN( test
- i
, ssize
);
2050 for ( j
= 0; j
< test
; j
++, i
++ )
2053 h
= ( i
< tcnt
- tstart
) ? mt
->div_out
[tstart
+i
] :
2062 * We still can have an error. Imagine a residual of 22 and a
2065 if ( ( j
>= test
) && ( ssize
> test
) && ( test
> 0 ) )
2071 * We perform the operation with DIGITS+1 precision for a later
2072 * rounding and to prevent math errors. We have to check if rounding
2073 * would occur later.
2077 if ( ( outp
> ccns
) && ( r
->num
[ccns
] != '0' ) )
2080 * FGC: I'm not sure whether the following test supersedes the
2081 * the testing of the mantissa above. It should, but who can
2085 if ( !test_whole( TSD
, r
, 0 ) )
2090 volatile char *fs
, *ss
;
2093 h
= name_of_node( TSD
, NULL
, f
);
2094 fs
= tmpstr_of( TSD
, h
);
2095 Free_stringTSD( h
);
2096 h
= name_of_node( TSD
, NULL
, s
);
2097 ss
= tmpstr_of( TSD
, h
);
2098 Free_stringTSD( h
);
2099 exiterror( ERR_INVALID_INTEGER
,
2100 ( type
== DIVTYPE_REMAINDER
) ? 12 : 11,
2106 origneg
= f
->negative
;
2108 if ( type
== DIVTYPE_BOTH
)
2111 * Return both answers
2113 IS_AT_LEAST( r2
->num
, r2
->max
, outp
);
2115 memcpy( r2
->num
, r
->num
, outp
);
2116 r2
->negative
= r
->negative
;
2120 for ( r2
->size
= outp
; ( r2
->size
> r2
->exp
) && ( r2
->size
> 1 );
2123 if ( r2
->num
[r2
->size
-1] != '0' )
2128 if ( ( type
== DIVTYPE_REMAINDER
) || ( type
== DIVTYPE_BOTH
) )
2131 * We are really interested in the remainder, so swap things
2133 for ( i
= 0; i
< MIN( MAX( tend
, tcnt
) - tstart
, ccns
+ 1 ); i
++ )
2134 r
->num
[i
] = (char) ( ( i
< tcnt
- tstart
) ? mt
->div_out
[tstart
+i
] :
2138 r
->exp
= origexp
- tstart
;
2139 r
->negative
= origneg
;
2143 * Then, at the end, we have to strip of trailing zeros that come
2144 * after the decimal point, first do we have any decimals?
2146 for ( r
->size
= outp
; ( r
->size
> r
->exp
) && ( r
->size
> 1 ); r
->size
-- )
2148 if ( r
->num
[r
->size
- 1] != '0' )
2153 void string_div( tsd_t
*TSD
, const num_descr
*f
, const num_descr
*s
,
2154 num_descr
*r
, num_descr
*r2
, int type
, cnodeptr left
,
2157 int ccns
= TSD
->currlevel
->currnumsize
;
2159 LOSTDIGITS_CHECK( f
, ccns
, left
);
2160 LOSTDIGITS_CHECK( s
, ccns
, right
);
2162 string_div2( TSD
, f
, s
, r
, r2
, type
, ccns
);
2165 r
->used_digits
= ccns
;
2167 r2
->used_digits
= ccns
;
2170 /* The multiplication table for two single-digits numbers */
2171 static const char mult
[10][10][3] = {
2172 { "00", "00", "00", "00", "00", "00", "00", "00", "00", "00" },
2173 { "00", "01", "02", "03", "04", "05", "06", "07", "08", "09" },
2174 { "00", "02", "04", "06", "08", "10", "12", "14", "16", "18" },
2175 { "00", "03", "06", "09", "12", "15", "18", "21", "24", "27" },
2176 { "00", "04", "08", "12", "16", "20", "24", "28", "32", "36" },
2177 { "00", "05", "10", "15", "20", "25", "30", "35", "40", "45" },
2178 { "00", "06", "12", "18", "24", "30", "36", "42", "48", "54" },
2179 { "00", "07", "14", "21", "28", "35", "42", "49", "56", "63" },
2180 { "00", "08", "16", "24", "32", "40", "48", "56", "64", "72" },
2181 { "00", "09", "18", "27", "36", "45", "54", "63", "72", "81" },
2185 static void string_mul2( tsd_t
*TSD
, const num_descr
*f
, const num_descr
*s
,
2186 num_descr
*r
, int ccns
)
2190 int i
,sskip
,fskip
,sstart
,fstart
,base
,offset
,carry
,j
;
2193 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2195 IS_AT_LEAST( mt
->mul_out
, mt
->mul_outsize
, 2*(ccns
+1) ) ;
2197 mt
->outptr4
= mt
->mul_out
;
2200 for (i
=0; i
<2*(ccns
+1); mt
->mul_out
[i
++]='0') ;
2201 outp
= &mt
->mul_out
[2*(ccns
+1)-1] ;
2203 for (sskip
=0; (sskip
<s
->size
) && (s
->num
[sskip
]=='0'); sskip
++ ) ;
2204 sstart
= MIN( sskip
+ccns
, s
->size
-1 ) ;
2206 for (fskip
=0; (fskip
<f
->size
) && (f
->num
[fskip
]=='0'); fskip
++ ) ;
2207 fstart
= MIN( fskip
+ccns
, f
->size
-1 ) ;
2209 base
= 2*(ccns
+1)-1 ;
2210 offset
= carry
= 0 ;
2212 * Use a maximum of DIGITS+1 significant digits on input for each operand.
2214 for ( i
=sstart
; i
>=sskip
; i
-- )
2216 offset
= carry
= 0 ;
2217 assert( base
>= 0 ) ;
2218 for ( j
=fstart
; j
>=fskip
; j
-- )
2220 answer
= mult
[f
->num
[j
]-'0'][s
->num
[i
]-'0'] ;
2221 assert( base
-offset
>= 0 ) ;
2222 /* Stupid MSVC likes this only: */
2223 mt
->mul_out
[base
-offset
] = (char) (mt
->mul_out
[base
-offset
] +
2224 answer
[1] - '0' + carry
) ;
2225 carry
= answer
[0] - '0' ;
2226 while ( mt
->mul_out
[base
-offset
] > '9' )
2228 mt
->mul_out
[base
-offset
] -= 10 ;
2233 if (base
-offset
>= 0)
2234 mt
->mul_out
[base
-offset
++] = (char) (carry
+ '0') ;
2236 exiterror( ERR_INTERPRETER_FAILURE
, 1, __FILE__
, __LINE__
, "" ) ;
2241 IS_AT_LEAST( r
->num
, r
->max
, /*2*(ccns+1)*/
2242 outp
- mt
->mul_out
-base
+offset
) ;
2244 for (i
=base
-offset
+2; (i
<=outp
- mt
->mul_out
); i
++ )
2245 r
->num
[j
++] = mt
->mul_out
[i
] ;
2253 r
->exp
= s
->exp
+ f
->exp
;
2255 r
->negative
= log_xor( f
->negative
, s
->negative
) ;
2257 str_round( r
, ccns
) ;
2260 void string_mul( tsd_t
*TSD
, const num_descr
*f
, const num_descr
*s
,
2261 num_descr
*r
, cnodeptr left
, cnodeptr right
)
2263 int ccns
= TSD
->currlevel
->currnumsize
;
2265 LOSTDIGITS_CHECK( f
, ccns
, left
);
2266 LOSTDIGITS_CHECK( s
, ccns
, right
);
2268 string_mul2( TSD
, f
, s
, r
, ccns
);
2270 r
->used_digits
= ccns
;
2273 static void descr_strip( const tsd_t
*TSD
, const num_descr
*from
, num_descr
*to
)
2277 IS_AT_LEAST( to
->num
, to
->max
, TSD
->currlevel
->currnumsize
+1 ) ;
2279 to
->negative
= from
->negative
;
2280 for (i
=0; (i
<from
->size
) && (from
->num
[i
]=='0'); i
++ ) ;
2281 to
->exp
= from
->exp
- i
;
2282 for (j
=0; j
+i
<from
->size
; j
++ )
2283 to
->num
[j
] = from
->num
[i
+j
] ;
2285 if ((to
->exp
-1 > MAX_EXPONENT
) || ( -MAX_EXPONENT
> to
->exp
+1))
2286 exiterror( ERR_ARITH_OVERFLOW
, 0 ) ;
2289 to
->used_digits
= from
->used_digits
;
2294 void string_pow( tsd_t
*TSD
, const num_descr
*num
, num_descr
*acc
,
2295 num_descr
*res
, cnodeptr lname
, cnodeptr rname
)
2297 static const num_descr one
= { "1", 0, 1, 1, 2, -1 } ;
2298 int ineg
=0, pow
, cnt
,power
;
2299 int ccns
= TSD
->currlevel
->currnumsize
;
2301 IS_AT_LEAST( res
->num
, res
->max
, ccns
+1 ) ;
2303 LOSTDIGITS_CHECK( num
, ccns
, lname
);
2304 LOSTDIGITS_CHECK( acc
, ccns
, rname
);
2305 power
= descr_to_int( acc
) ;
2307 IS_AT_LEAST( acc
->num
, acc
->max
, ccns
+1 ) ;
2320 for (cnt
=0; pow
; cnt
++ )
2325 if (power
& (1<<(cnt
-1)))
2327 /* multiply acc with *f, and put answer into acc */
2328 string_mul2( TSD
, acc
, num
, res
, ccns
) ;
2329 assert( acc
->size
<= acc
->max
&& res
->size
<= res
->max
) ;
2330 descr_strip( TSD
, res
, acc
) ;
2331 assert( acc
->size
<= acc
->max
&& res
->size
<= res
->max
) ;
2335 break ; /* horrible example of dataflow */
2337 /* then, square the contents of acc */
2338 string_mul2( TSD
, acc
, acc
, res
, ccns
) ;
2339 assert( acc
->size
<= acc
->max
&& res
->size
<= res
->max
) ;
2340 descr_strip( TSD
, res
, acc
) ;
2341 assert( acc
->size
<= acc
->max
&& res
->size
<= res
->max
) ;
2345 /* may hang if acc==zero ? */
2346 string_div2( TSD
, &one
, acc
, res
, NULL
, DIVTYPE_NORMAL
, ccns
) ;
2348 descr_strip( TSD
, acc
, res
) ;
2349 assert( acc
->size
<= acc
->max
&& res
->size
<= res
->max
) ;
2350 acc
->used_digits
= ccns
;
2354 /* ========= interface routines to the arithmetic routines ========== */
2356 int descr_sign( const void *descr
)
2358 return( ((num_descr
*)descr
)->negative
? -1 : 1 ) ;
2362 void free_a_descr( const tsd_t
*TSD
, num_descr
*in
)
2364 assert( in
->size
<= in
->max
) ;
2367 FreeTSD( in
->num
) ;
2373 num_descr
*get_a_descr( tsd_t
*TSD
, const char *bif
, int argno
,
2377 num_descr
*descr
=NULL
;
2379 descr
= (num_descr
*)MallocTSD( sizeof(num_descr
) ) ;
2383 if ( ( i
= getdescr( TSD
, num
, descr
) ) != 0 )
2385 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2389 exiterror( ERR_BAD_ARITHMETIC
, 0 );
2392 exiterror( ERR_INCORRECT_CALL
, i
, bif
, argno
, mt
->max_exponent_len
, tmpstr_of( TSD
, num
) );
2394 exiterror( ERR_INCORRECT_CALL
, i
, bif
, argno
, tmpstr_of( TSD
, num
) );
2401 int str_true( const tsd_t
*TSD
, const streng
*input
)
2403 if (input
->len
!= 1)
2404 exiterror( ERR_UNLOGICAL_VALUE
, 0 ) ;
2406 switch (input
->value
[0])
2413 exiterror( ERR_UNLOGICAL_VALUE
, 0 ) ;
2416 /* Too keep the compiler happy */
2421 streng
*str_abs( tsd_t
*TSD
, const streng
*input
)
2427 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2428 if ( ( i
= getdescr( TSD
, input
, &mt
->fdescr
) ) != 0 )
2431 exiterror( ERR_INCORRECT_CALL
, i
, "ABS", 1, mt
->max_exponent_len
, tmpstr_of( TSD
, input
) );
2433 exiterror( ERR_INCORRECT_CALL
, i
, "ABS", 1, tmpstr_of( TSD
, input
) );
2436 if ( get_options_flag( TSD
->currlevel
, EXT_STRICT_ANSI
) )
2438 str_round_lostdigits( TSD
, &mt
->fdescr
, TSD
->currlevel
->currnumsize
);
2439 mt
->fdescr
.negative
= 0;
2440 return str_norm( TSD
, &mt
->fdescr
, NULL
);
2443 mt
->fdescr
.negative
= 0;
2444 mt
->fdescr
.used_digits
= mt
->fdescr
.size
;
2445 retval
= str_norm( TSD
, &mt
->fdescr
, NULL
);
2450 streng
*str_sign( tsd_t
*TSD
, const streng
*input
)
2456 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2457 if ( ( i
= getdescr( TSD
, input
, &mt
->fdescr
) ) != 0 )
2460 exiterror( ERR_INCORRECT_CALL
, i
, "SIGN", 1, mt
->max_exponent_len
, tmpstr_of( TSD
, input
) );
2462 exiterror( ERR_INCORRECT_CALL
, i
, "SIGN", 1, tmpstr_of( TSD
, input
) );
2465 if ( get_options_flag( TSD
->currlevel
, EXT_STRICT_ANSI
) )
2467 str_round_lostdigits( TSD
, &mt
->fdescr
, TSD
->currlevel
->currnumsize
);
2470 mant
= mt
->fdescr
.num
;
2471 for ( i
= 0; i
< mt
->fdescr
.size
; i
++ )
2473 if ( mant
[i
] != '0' )
2475 if ( mt
->fdescr
.negative
)
2477 return Str_creTSD( "-1" );
2481 return Str_creTSD( "1" );
2485 return Str_creTSD( "0" );
2489 streng
*str_trunc( tsd_t
*TSD
, const streng
*number
, int deci
)
2491 int i
=0, j
=0, k
=0, size
=0, top
=0 ;
2492 streng
*result
=NULL
;
2495 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2497 /* first, convert number to internal representation */
2498 if ( ( i
= getdescr( TSD
, number
, &mt
->fdescr
) ) != 0 )
2501 exiterror( ERR_INCORRECT_CALL
, i
, "TRUNC", 1, mt
->max_exponent_len
, tmpstr_of( TSD
, number
) );
2503 exiterror( ERR_INCORRECT_CALL
, i
, "TRUNC", 1, tmpstr_of( TSD
, number
) );
2506 /* get rid of possible excessive precision */
2507 if ( get_options_flag( TSD
->currlevel
, EXT_STRICT_ANSI
) )
2509 str_round_lostdigits( TSD
, &mt
->fdescr
, TSD
->currlevel
->currnumsize
);
2512 /* who big must the result string be? */
2513 if ((i
=mt
->fdescr
.exp
) > 0 )
2514 size
= mt
->fdescr
.exp
+ deci
;
2519 * Adrian Sutherland <adrian@dealernet.co.uk>
2520 * Changed the following line from '+ 2' to '+ 3',
2521 * because I was getting core dumps ... I think that we need this
2522 * because negative numbers BIGGER THAN -1 need a sign, a zero and
2523 * a decimal point ... A.
2525 result
= Str_makeTSD( size
+ 3 ) ; /* allow for sign and decimal point */
2528 if (mt
->fdescr
.negative
)
2529 result
->value
[j
++] = '-' ;
2531 /* first fill in the known numerals of the integer part */
2532 top
= MIN( mt
->fdescr
.exp
, mt
->fdescr
.size
) ;
2533 for (i
=0; i
<top
; i
++)
2534 result
->value
[j
++] = mt
->fdescr
.num
[i
] ;
2536 /* pad out with '0' in the integer part, if necessary */
2537 for (k
=i
; k
<mt
->fdescr
.exp
; k
++)
2538 result
->value
[j
++] = '0' ;
2541 result
->value
[j
++] = '0' ;
2546 result
->value
[j
++] = '.' ;
2548 /* pad with zeros between decimal point and number */
2549 for (k
=0; k
>mt
->fdescr
.exp
; k
--)
2550 result
->value
[j
++] = '0' ;
2553 /* fill in with the decimals, if any */
2554 top
= MIN( mt
->fdescr
.size
-mt
->fdescr
.exp
, deci
) + i
+ k
;
2556 result
->value
[j
++] = mt
->fdescr
.num
[i
] ;
2558 /* pad with zeros if necessary */
2559 for (; i
<deci
+MIN(mt
->fdescr
.exp
,mt
->fdescr
.size
); i
++ )
2560 result
->value
[j
++] = '0' ;
2563 assert( (result
->len
<= result
->max
) && (result
->len
<=size
+2) ) ;
2570 /* ------------------------------------------------------------------
2571 * This function converts a packed binary string to a decimal integer.
2572 * It is equivalent of interpreting the binary string as a number of
2573 * base 256, and converting it to base 10 (the actual algorithm uses
2574 * a number of base 2, padded to a multiple of 8 digits). Negative
2575 * numbers are interpreted as two's complement.
2577 * First parameter is the packed binary string; second parameter is
2578 * the number of initial characters to skip (i.e. the position of the
2579 * most significant byte in 'input'; the third parameter is a boolean
2580 * telling if this number is signed or not.
2582 * The significance of the 'too_large' variable: If the number has
2583 * leading zeros, that is not an error, so the 'fdescr' might be set
2584 * to values larger than it can hold. However, the error occurs only
2585 * if that value is used. Therefore, if 'fdescr' becomes bigger than
2586 * the max whole number, 'too_large' is set. If attempts are made to
2587 * use 'fdescr' while 'too_large' is set, an error occurs.
2589 * Note that this algoritm requires that string_mul and string_add
2590 * does not change anything in their first two parameters.
2592 * The 'input' variable is assumed to have at least one digit, so don't
2593 * call this function with a null string. Maybe the compiler could
2594 * optimize this function better if [esf]descr were locals?
2596 * In case of errors we throw SYNTAX(40,35).
2599 streng
*str_digitize( tsd_t
*TSD
, streng
*input
, int start
, int sign
,
2600 const char *bif
, int removeStringOnError
)
2602 int cur_byte
=0 ; /* current byte in 'input' */
2603 int cur_bit
=0 ; /* current bit in 'input' */
2604 int too_large
=0 ; /* error flag (see above) */
2606 int user_ccns
= TSD
->currlevel
->currnumsize
;
2609 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2611 /* do we have anything to work on? */
2612 assert( start
< Str_len(input
) );
2614 ccns
= 3 * Str_len(input
);
2616 /* ensure that temporary number descriptors has enough space */
2617 IS_AT_LEAST( mt
->fdescr
.num
, mt
->fdescr
.max
, ccns
+2 ) ;
2618 IS_AT_LEAST( mt
->edescr
.num
, mt
->edescr
.max
, ccns
+2 ) ;
2619 IS_AT_LEAST( mt
->sdescr
.num
, mt
->sdescr
.max
, ccns
+2 ) ;
2622 * Initialize the temporary number descriptors: 'fdescr', 'sdescr'
2623 * and 'edescr'. They will be initialized to 0, 1 and 2 respectively.
2624 * They are used for:
2626 * fdescr: contains the value of the current bit of the current
2627 * byte, e.g the third last bit in the last byte will
2628 * have the value '0100'b (=4). This value is multiplied
2629 * with two at each iteration of the inner loop. Is
2630 * initialized to the value '1', and will have the same
2633 * sdescr: contains '2', to make doubling of 'fdescr' easy
2635 * edescr: contains the answer, initially set to '0' if 'input'
2636 * is positive, or '-1' if 'input' is negative. The
2637 * descriptor 'fdescr' is added to (or implicitly
2638 * subtracted from) this number.
2640 mt
->fdescr
.size
= mt
->sdescr
.size
= mt
->edescr
.size
= 1 ;
2641 mt
->fdescr
.negative
= mt
->sdescr
.negative
= mt
->edescr
.negative
= 0 ;
2642 mt
->fdescr
.exp
= mt
->sdescr
.exp
= mt
->edescr
.exp
= 1 ;
2644 mt
->edescr
.num
[0] = '0' ; /* the resulting number */
2645 mt
->fdescr
.num
[0] = '1' ; /* the value of each binary digit */
2646 mt
->sdescr
.num
[0] = '2' ; /* the number to multiply 'fdescr' in */
2649 * If 'input' is signed, but positive, treat as if it was unsigned.
2650 * 'sign' is then effectively a boolean stating whether 'input' is
2651 * a negative number. In that case, 'edescr' should be set to '-1'.
2652 * Also, 'fdescr' is set to negative, so that it is subtracted from
2653 * 'edescr' when given to string_add().
2657 if (input
->value
[start
] & 0x80)
2659 mt
->edescr
.num
[0] = '1' ;
2660 mt
->edescr
.negative
= 1 ;
2661 mt
->fdescr
.negative
= 1 ;
2668 * Each iteration of the outer loop will process a byte in 'input',
2669 * starting with the last (least significant) byte. Each iteration
2670 * of the inner loop will process one bit in the byte currently
2671 * processed by the outer loop.
2673 for (cur_byte
=Str_len(input
)-1; cur_byte
>=start
; cur_byte
--)
2675 for (cur_bit
=0; cur_bit
<8; cur_bit
++)
2678 * does the precision hold? if not, set flag
2679 * The error can be considered to be a severe error. We should
2680 * always have "enough" precision. See ccns above.
2682 if (mt
->fdescr
.size
> ccns
)
2686 * If the current bit (the j'th bit in the i'th byte) is set
2687 * and input is positive; or if current bit is not set and
2688 * input is negative, then increase the value of the result.
2689 * This is not really a bitwise xor, but a logical xor, but
2690 * the values are always 1 or 0, so it doesn't matter.
2692 if ((sign
) ^ ((input
->value
[cur_byte
] >> cur_bit
) & 1))
2695 exiterror( ERR_INVALID_INTEGER
, 0 ) ;
2697 string_add2( TSD
, &mt
->edescr
, &mt
->fdescr
, &mt
->edescr
, ccns
);
2701 * Str_ip away any leading zeros. If this is not done, the
2702 * accuracy of the operation will deter, since string_add()
2703 * return answer with leading zero, and the accumulative
2704 * effect of this would make 'edescr' zero after a few
2705 * iterations of the loop.
2707 str_strip( &mt
->edescr
) ;
2710 * Increase the value of 'fdescr', so that it corresponds with
2711 * the significance of the current bit in 'input'. But don't
2712 * do this if 'fdescr' isn't capable of holding that number.
2716 string_mul2( TSD
, &mt
->fdescr
, &mt
->sdescr
, &mt
->fdescr
, ccns
);
2717 str_strip( &mt
->fdescr
) ;
2723 * normalize answer and return to caller. Always show all digits if we
2724 * don't have to support STRICT_ANSI. In ANSI we have to throw a SYNTAX
2725 * in case of number overflow.
2727 if ( get_options_flag( TSD
->currlevel
, EXT_STRICT_ANSI
) )
2729 for (i
= 0; i
< mt
->edescr
.size
; i
++)
2731 if (mt
->edescr
.num
[i
] != '0')
2734 if (i
< mt
->edescr
.size
)
2737 if (mt
->edescr
.exp
- i
> user_ccns
)
2741 if ( removeStringOnError
)
2742 Free_stringTSD( input
);
2743 mt
->edescr
.used_digits
= mt
->edescr
.size
;
2744 input
= str_norm( TSD
, &mt
->edescr
, NULL
);
2745 msg
= tmpstr_of( TSD
, input
);
2746 Free_stringTSD( input
);
2747 /* fixes bug 1112956 */
2748 exiterror( ERR_INCORRECT_CALL
, 35, bif
, msg
);
2751 mt
->edescr
.used_digits
= user_ccns
;
2757 for ( s
= 0; s
< mt
->edescr
.size
; s
++ )
2759 if ( mt
->edescr
.num
[s
] != '0' )
2762 for ( e
= mt
->edescr
.size
- 1; e
> s
; e
-- )
2764 if ( mt
->edescr
.num
[e
] != '0' )
2770 mt
->edescr
.used_digits
= ( e
< user_ccns
) ? user_ccns
: e
;
2772 return str_norm( TSD
, &mt
->edescr
, NULL
);
2775 streng
*str_binerize( tsd_t
*TSD
, num_descr
*num
, int length
)
2781 * We are going to need two number in this algoritm, so we can
2782 * just as well make them right away. We could initialize these on
2783 * the first invocation of this routine, and thereby saving some
2784 * space, but that would 1) take CPU on every invocation; 2) it
2785 * would probably cost just as much space in the text segment.
2786 * (Would have to set NUMERIC DIGIT to at least 4 before calling
2787 * getdescr with these.)
2789 static const num_descr minus_one
= { "1", 1, 1, 1, 2, -1 } ;
2790 static const num_descr byte
= { "256", 0, 3, 3, 4, -1 } ;
2794 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2796 ccns
= ( num
->exp
< 3 ) ? 3 : num
->exp
;
2798 assert( num
== &mt
->edescr
);
2801 * If the length is zero, a special case applies, the return value
2805 result
= nullstringptr();
2808 * Here comes the real work. To ease the implementation it is
2809 * divided into two parts based on whether or not length is
2812 else if ( length
== -1 )
2815 * First, let's estimate the size of the output string that
2816 * we need. A crude (over)estimate is one char for every second
2817 * decimal digits. Also set length, just to chache the value.
2818 * (btw: isn't that MAX( ,0) unneeded? Since number don't have
2819 * a decimal part, and since it must have a integer part (else
2820 * it would be zero, and then trapped above.)
2822 assert( num
->exp
> 0 );
2823 result
= Str_makeTSD( ( length
= ( MAX( num
->exp
, 0 ) ) / 2 ) + 1 );
2826 * Let's loop from the least significant part of edescr. For each
2827 * iteration we divide num by 256, stopping when edescr is
2830 for ( i
= length
; ; i
-- )
2833 * Perform the integer divition, edescr gets the quotient,
2834 * while fdescr get the remainder. Afterwards, perform some
2835 * makeup on the numbers (that might not be needed?)
2837 string_div2( TSD
, num
, &byte
, &mt
->fdescr
, num
, DIVTYPE_BOTH
, ccns
);
2839 str_strip( &mt
->fdescr
);
2842 * Now, fdescr has the remainder, stuff it into the result string
2843 * before it escapes :-) (don't we have to cast lvalue here?)
2844 * Afterwards, check to see if there are more digits to extract.
2846 result
->value
[i
] = (char) descr_to_int( &mt
->fdescr
);
2847 if ( ( num
->num
[0] == '0' ) && ( num
->size
== 1 ) )
2852 * That's it, now we just have to align the answer and set the
2853 * correct length. Have to use memmove() since strings may
2856 memmove( result
->value
, &result
->value
[i
], length
+ 1 - i
);
2857 result
->len
= length
+ 1 - i
;
2862 * We do have a specified length for the number. At least that
2863 * makes it easy to deside how large the result string should be.
2865 result
= Str_makeTSD( length
);
2868 * In the loop, iterate once for each divition of 256, but stop
2869 * only when we have reached the start of the result string.
2870 * Below, edescr gets the quotient and fdescr gets the remainder.
2872 for ( i
= length
- 1; i
>= 0; i
-- )
2874 /* may hang if acc==zero ? */
2875 string_div2( TSD
, num
, &byte
, &mt
->fdescr
, num
, DIVTYPE_BOTH
, ccns
);
2877 str_strip( &mt
->fdescr
);
2880 * If the remainder is negative (i.e. quotient is negative too)
2881 * then add 256 to the remainder, to bring it into the range of
2882 * an unsigned char. To compensate for that, subtract one from
2883 * the quotient. Store the remainder.
2885 if ( mt
->fdescr
.negative
)
2887 /* the following two lines are not needed, but it does not
2888 work without them. */
2889 if ( ( num
->size
== 1 ) && ( num
->num
[0] == '0' ) )
2892 string_add2( TSD
, num
, &minus_one
, num
, ccns
);
2894 string_add2( TSD
, &mt
->fdescr
, &byte
, &mt
->fdescr
, ccns
);
2896 result
->value
[i
] = (char) descr_to_int( &mt
->fdescr
);
2899 * That's it, store the length
2901 result
->len
= length
;
2905 * We're finished ... hope it works ...
2911 streng
*str_normalize( const tsd_t
*TSD
, const streng
*number
)
2916 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2917 if ( ( err
= getdescr( TSD
, number
, &mt
->fdescr
) ) != 0 )
2918 exiterror( ERR_BAD_ARITHMETIC
, 0 ) ;
2920 return str_norm( TSD
, &mt
->fdescr
, NULL
) ;
2925 num_descr
*is_a_descr( const tsd_t
*TSD
, const streng
*number
)
2927 num_descr
*newnum
=NULL
;
2930 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2932 if ( getdescr( TSD
, number
, &mt
->fdescr
) != 0 )
2935 newnum
= (num_descr
*)MallocTSD( sizeof( num_descr
)) ;
2937 newnum
->num
= NULL
;
2939 descr_copy( TSD
, &mt
->fdescr
, newnum
) ;
2944 * ANSI chapter 7, beginning: "...matches that syntax and also has a value
2945 * that is 'whole', that is has no non-zero fractional part." The syntax
2946 * is that of a plain number.
2947 * Thus, 1E1 or 1.00 are allowed.
2948 * This function returns 1 if number is a valid whole number, 0 else.
2950 * The value is loaded into mat_tsd_t.edescr. A pointer to this is
2953 * Added 08.03.2005 (tt.mm.yyyy), FGC: Due to some misinterpretation by my own
2954 * this routine must not round, instead it must check for ANSI WHOLENUM.
2955 * This means that the number must be representable without loss in the
2956 * interval [-(10**digits()-1), 10**digits()-1].
2957 * noDigitsLimit raises digits() virtually to endless. Don't use it in
2958 * ANSI compatible environments.
2960 int myiswnumber( tsd_t
*TSD
, const streng
*number
, num_descr
**num
,
2966 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2968 if ( getdescr( TSD
, number
, &mt
->edescr
) )
2970 input
= &mt
->edescr
;
2974 return test_whole( TSD
, input
, noDigitsLimit
);
2979 * Converts number to an integer. Sets *error to 1 on error (0 otherwise)
2981 * ANSI chapter 7, beginning: "...matches that syntax and also has a value
2982 * that is 'whole', that is has no non-zero fractional part." The syntax
2983 * is that of a plain number.
2984 * Thus, 1E1 or 1.00 are allowed.
2986 int streng_to_int( const tsd_t
*TSD
, const streng
*number
, int *error
)
2991 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
2993 if ( ( *error
= getdescr( TSD
, number
, &mt
->fdescr
) ) != 0 )
2996 if ( ( *error
= !whole_number( &mt
->fdescr
, &result
) ) != 0 )
3003 * Converts number to a 64bit integer. Sets *error to 1 on error (0 otherwise)
3005 * ANSI chapter 7, beginning: "...matches that syntax and also has a value
3006 * that is 'whole', that is has no non-zero fractional part." The syntax
3007 * is that of a plain number.
3008 * Thus, 1E1 or 1.00 are allowed.
3010 rx_64
streng_to_rx64( const tsd_t
*TSD
, const streng
*number
, int *error
)
3015 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
3017 if ( ( *error
= getdescr( TSD
, number
, &mt
->fdescr
) ) != 0 )
3020 if ( ( *error
= !whole_rx64_number( &mt
->fdescr
, &result
) ) != 0 )
3026 int myisnumber( const tsd_t
*TSD
, const streng
*string
)
3030 mt
= (mat_tsd_t
*)TSD
->mat_tsd
;
3032 return getdescr( TSD
, string
, &mt
->edescr
) == 0;