Skip to content

Commit 1a46e32

Browse files
committed
FEAT: cherry picked Ladislav Mecir's modifications
Correct EVEN? and ODD? for decimals. Optimize and simplify integer ADD. Optimize and simplify integer SUBTRACT. Optimize and simplify integer MULTIPLY. Generalize integer DIVIDE. Generalize integer NEGATE. Generalize and optimize integer ABS. (cherry picked from commit 15892da) Replace code with undefined behaviour. (cherry picked from commit 3224ad2) simplify ABS (overlooked fabs call) (cherry picked from commit 3a168e7)
1 parent c1ce59f commit 1a46e32

File tree

2 files changed

+83
-30
lines changed

2 files changed

+83
-30
lines changed

src/core/t-decimal.c

+19-16
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
** REBOL [R3] Language Interpreter and Run-time Environment
44
**
55
** Copyright 2012 REBOL Technologies
6+
** Copyright 2012-2021 Rebol Open Source Contributors
67
** REBOL is a trademark of REBOL Technologies
78
**
89
** Licensed under the Apache License, Version 2.0 (the "License");
@@ -22,7 +23,7 @@
2223
** Module: t-decimal.c
2324
** Summary: decimal datatype
2425
** Section: datatypes
25-
** Author: Carl Sassenrath
26+
** Author: Carl Sassenrath, Ladislav Mecir, Oldes
2627
** Notes:
2728
**
2829
***********************************************************************/
@@ -45,22 +46,22 @@ static char *gcvt(double value, int digits, char *buffer)
4546

4647
/*
4748
Purpose: {defines the almost_equal comparison function}
48-
Properties: {
49+
Properties: {
4950
since floating point numbers are ordered and there is only
5051
a finite quantity of floating point numbers, it is possible
5152
to assign an ordinal (integer) number to any floating point number so,
5253
that the ordinal numbers of neighbors differ by one
53-
54+
5455
the function compares floating point numbers based on
5556
the difference of their ordinal numbers in the ordering
5657
of floating point numbers
57-
58+
5859
difference of 0 means exact equality, difference of 1 means, that
5960
the numbers are neighbors.
6061
}
6162
Advantages: {
6263
the function detects approximate equality.
63-
64+
6465
the function is more strict in the zero neighborhood than
6566
absolute-error-based approaches
6667
@@ -69,15 +70,15 @@ static char *gcvt(double value, int digits, char *buffer)
6970
meaning that neighbors are deemed equal, max_diff = 10 meaning, that
7071
the numbers are deemed equal if at most 9
7172
distinct floating point numbers can be found between them
72-
73+
7374
the max_diff value may be one of the system options specified in
7475
the system/options object allowing users to exactly define the
7576
strictness of equality checks
7677
}
7778
Differences: {
7879
The approximate comparison currently used in R3 corresponds to the
7980
almost_equal function using max_diff = 10 (according to my tests).
80-
81+
8182
The main differences between the currently used comparison and the
8283
one based on the ordinal number comparison are:
8384
- the max_diff parameter can be adjusted, allowing
@@ -110,7 +111,7 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
110111

111112
int_diff = ua.i - ub.i;
112113
if (int_diff < 0) int_diff = -int_diff;
113-
114+
114115
return ((REBU64) int_diff <= max_diff);
115116
}
116117

@@ -339,13 +340,15 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
339340
case A_NEGATE:
340341
d1 = -d1;
341342
goto setDec;
343+
342344
case A_ABSOLUTE:
343345
if (d1 < 0) d1 = -d1;
344346
goto setDec;
347+
345348
case A_EVENQ:
346349
case A_ODDQ:
347350
d1 = fabs(fmod(d1, 2.0));
348-
DECIDE((action != A_EVENQ) != ((d1 < 0.5) || (d1 >= 1.5)));
351+
DECIDE((action == A_EVENQ) == (d1 < 0.5 || d1 >= 1.5));
349352

350353
case A_MAKE:
351354
case A_TO:
@@ -364,24 +367,24 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
364367
case REB_PERCENT:
365368
d1 = VAL_DECIMAL(val);
366369
goto setDec;
367-
370+
368371
case REB_INTEGER:
369372
d1 = (REBDEC)VAL_INT64(val);
370373
goto setDec;
371-
374+
372375
case REB_MONEY:
373376
d1 = deci_to_decimal(VAL_DECI(val));
374377
goto setDec;
375-
378+
376379
case REB_LOGIC:
377380
if (action != A_MAKE) Trap_Make(type, val);
378381
d1 = VAL_LOGIC(val) ? 1.0 : 0.0;
379382
goto setDec;
380-
383+
381384
case REB_CHAR:
382385
d1 = (REBDEC)VAL_CHAR(val);
383386
goto setDec;
384-
387+
385388
case REB_TIME:
386389
d1 = VAL_TIME(val) * NANO;
387390
break;
@@ -398,12 +401,12 @@ REBOOL almost_equal(REBDEC a, REBDEC b, REBCNT max_diff) {
398401
}
399402
Trap_Make(type, val);;
400403
}
401-
404+
402405
case REB_BINARY:
403406
Binary_To_Decimal(val, D_RET);
404407
d1 = VAL_DECIMAL(D_RET);
405408
break;
406-
409+
407410
#ifdef removed
408411
// case REB_ISSUE:
409412
{

src/core/t-integer.c

+64-14
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
** REBOL [R3] Language Interpreter and Run-time Environment
44
**
55
** Copyright 2012 REBOL Technologies
6+
** Copyright 2012-2021 Rebol Open Source Contributors
67
** REBOL is a trademark of REBOL Technologies
78
**
89
** Licensed under the Apache License, Version 2.0 (the "License");
@@ -22,7 +23,7 @@
2223
** Module: t-integer.c
2324
** Summary: integer datatype
2425
** Section: datatypes
25-
** Author: Carl Sassenrath
26+
** Author: Carl Sassenrath, Ladislav Mecir, Oldes
2627
** Notes:
2728
**
2829
***********************************************************************/
@@ -31,6 +32,9 @@
3132
#include "sys-deci-funcs.h"
3233
#include "sys-int-funcs.h"
3334

35+
#ifdef _MSC_VER
36+
#pragma warning(disable: 4146) // unary minus operator applied to unsigned type, result still unsigned
37+
#endif
3438

3539
/***********************************************************************
3640
**
@@ -81,8 +85,8 @@
8185
REBI64 arg = 0;
8286
REBINT n;
8387

84-
REBU64 p; // for overflow detection
85-
REBI64 anum;
88+
REBU64 a1, a0, b1, b0;
89+
REBFLG sgn;
8690

8791
num = VAL_INT64(val);
8892

@@ -134,23 +138,66 @@
134138
switch (action) {
135139

136140
case A_ADD:
137-
if (REB_I64_ADD_OF(num, arg, &anum)) Trap0(RE_OVERFLOW);
138-
num = anum;
141+
if(num >= 0) {
142+
if(arg > MAX_I64 - num)
143+
Trap0(RE_OVERFLOW);
144+
} else {
145+
if(arg < MIN_I64 - num)
146+
Trap0(RE_OVERFLOW);
147+
}
148+
num += arg;
139149
break;
140150

141151
case A_SUBTRACT:
142-
if (REB_I64_SUB_OF(num, arg, &anum)) Trap0(RE_OVERFLOW);
143-
num = anum;
152+
if(arg >= 0) {
153+
if(num < MIN_I64 + arg)
154+
Trap0(RE_OVERFLOW);
155+
} else {
156+
if(num > MAX_I64 + arg)
157+
Trap0(RE_OVERFLOW);
158+
}
159+
num -= arg;
144160
break;
145161

146162
case A_MULTIPLY:
147-
if (REB_I64_MUL_OF(num, arg, (REBI64*)&p)) Trap0(RE_OVERFLOW);
148-
num = p;
163+
// handle signs
164+
sgn = num < 0;
165+
if(sgn)
166+
num = -(REBU64) num;
167+
if(arg < 0) {
168+
sgn = !sgn;
169+
arg = -(REBU64) arg;
170+
}
171+
// subdivide the factors
172+
a1 = (REBU64) num >> 32;
173+
b1 = (REBU64) arg >> 32;
174+
a0 = (REBU64) num & 0xFFFFFFFFu;
175+
b0 = (REBU64) arg & 0xFFFFFFFFu;
176+
// multiply the parts
177+
if(!a1)
178+
num = b1 * a0;
179+
else if(!b1)
180+
num = a1 * b0;
181+
else
182+
Trap0(RE_OVERFLOW);
183+
if((REBU64) num > (REBU64) MIN_I64 >> 32)
184+
Trap0(RE_OVERFLOW);
185+
num = ((REBU64) num << 32) + a0 * b0;
186+
if(sgn) {
187+
if((REBU64) num > (REBU64) MIN_I64)
188+
Trap0(RE_OVERFLOW);
189+
num = -(REBU64) num;
190+
} else if((REBU64) num > (REBU64) MAX_I64)
191+
Trap0(RE_OVERFLOW);
149192
break;
150193

151194
case A_DIVIDE:
152195
if (arg == 0) Trap0(RE_ZERO_DIVIDE);
153-
if (num == MIN_I64 && arg == -1) Trap0(RE_OVERFLOW);
196+
if(arg == -1) {
197+
if(num < - MAX_I64) Trap0(RE_OVERFLOW);
198+
num = - num;
199+
break;
200+
}
154201
if (num % arg == 0) {
155202
num = num / arg;
156203
break;
@@ -172,15 +219,18 @@
172219
case A_XOR: num ^= arg; break;
173220

174221
case A_NEGATE:
175-
if (num == MIN_I64) Trap0(RE_OVERFLOW);
222+
if (num < - MAX_I64) Trap0(RE_OVERFLOW);
176223
num = -num;
177224
break;
178225

179226
case A_COMPLEMENT: num = ~num; break;
180227

181-
case A_ABSOLUTE:
182-
if (num == MIN_I64) Trap0(RE_OVERFLOW);
183-
if (num < 0) num = -num;
228+
case A_ABSOLUTE:
229+
if(num < 0) {
230+
if (num < - MAX_I64)
231+
Trap0(RE_OVERFLOW);
232+
num = -num;
233+
}
184234
break;
185235

186236
case A_EVENQ: num = ~num;

0 commit comments

Comments
 (0)