Generalised floating point multiplication: Difference between revisions

m
→‎{{header|ALGOL 68}}: remove broken optimsation
m (→‎{{header|ALGOL 68}}: {{incorrect|ALGOL 68|The result a*(b-c) should be about -262510.90267998143}})
m (→‎{{header|ALGOL 68}}: remove broken optimsation)
Line 55:
-->
=={{header|ALGOL 68}}==
{{incorrect|ALGOL 68|The result a*(b-c) should be about -262510.90267998143}}
{{works with|ALGOL 68|Revision 1 - one minor extension to language used - PRAGMA READ, similar to C's #include directive.}}
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.3.3 algol68g-2.3.3].}}
Line 80 ⟶ 79:
DIGIT zero = ZERO LOC DIGIT;
DIGIT one = IDENTITY LOC DIGIT;
[order + MSD a+MSD b: LSD a+LSD b]DIGIT a timesx b;
 
FOR place FROM LSD a+LSD b BY order TO LSD a+MSD b DO
a timesx b[place] := zero # pad the MSDs of the result wihtwith Zero #
OD;
FOR place a FROM LSD a BY order TO MSD a DO
Line 90 ⟶ 89:
FOR place b FROM LSD b BY order TO MSD b DO
DIGIT digit b = b[place b];
REF DIGIT digit ab = a timesx b[place a + place b];
IF SIGNcarry digitOF b /= 0arithmetic THEN # zeroused for big number optimisationarithmetic #
IF MOID(carry OF:= arithmetic( THENdigit #ab used+:= for big number arithmeticcarry #));
DIGIT MOID(carryprod := ( digit ab +:= carry ))a;
MOID(carry +:= DIGIT( prod *:= digit ab ));
MOID(carry +:= ( proddigit *ab +:= digit bprod ));
ELSE # MOID(carry +:= (0 digitso abwe +:=can prodjust ignore the carry ))#
ELSEDIGIT # carryprod := 0 so we can just ignore the carrydigit #a;
DIGIT MOID(prod *:= digit ab);
MOID(proddigit *ab +:= digit bprod);
MOID(digit ab +:= prod)
FI
FI
OD;
a timesx b[place a + MSD b + order] := carry
OD;
INITDIGITS a timesx b # normalise #
FI
);
Line 124 ⟶ 121:
# First: define the attributes of the arithmetic we are using. #
################################################################
) CO arithmetic := (
CO STRUCT (
BOOL balanced,
carry, # aka "carry" between digits #
INT base,
digit width,
digit places,
digit order,
USTRING repr
) CO arithmetic := (
# balanced = # TRUE,
# carry = # TRUE,
Line 153 ⟶ 142:
BIGREAL out;
BIGREAL base of arithmetic = INITBIGREAL base OF arithmetic; # Todo: Opt #
INT point := UPB s-1; # put the point on the extreme right #
FOR iplace FROM LWB s TO UPB s DO
IF s[iplace]="." THEN
point := iplace
ELSE
out := out SHR digit order OF arithmetic + INITDIGIT s[iplace]
FI
OD;
out SHR (UPB s-point)
);</lang>'''File: test.Balanced_ternary_float.Multiplication.a68'''<lang algol68>#!/usr/local/bin/a68g --script #
 
####################################################################
# A program to test arbitrary length floating point multiplication #
Line 215 ⟶ 203:
<pre>
a = +523.23914037494284407864655 +-0++0+.+-0++0+
b = -436.43600000000000000000000 --++-0--.--0+-00+++-0-+---0-+0++++0--0000+00-+-+--+0-0-00--++0-+00---+0+-+++0+-0----0++
c = +65.26748971193415637860082 +-++-.+-++-
a*(b-c) -385143262510.8748439394456931749790267998140903693919 --+-+++0-00++000-.0+0+.0++0-0++-00+---00+--0-00+0+-+-+--00+-0++--000---++0-000-+0+-----000+++-+-0+-+0+0++0+0-++00-++0+00-00--00++++
 
# | * |+ #1 |+- #2 |+0 #3 |++ #4 |+-- #5 |+-0 #6 |+-+ #7 |+0- #8 |+e+- #9|+0+ #10|++- #11|++0 #12|
Line 227 ⟶ 215:
6 |+-0 |+-0 |++0 |+-e+- |+0-0 |+0+0 |++e+- | | | | | | |
7 |+-+ |+-+ |+--- |+-+0 |+00+ |++0- |+---0 |+--++ | | | | | |
8 |+0- |+0- |+--+ |+0-0 |++-- |++++ |+--+0 |+-0+- |+-+0+ | | | | |
9 |+e+- |+e+- |+-e+- |+e+0 |++e+- |+--e+- |+-e+0 |+-+e+- |+0-e+- |+e++ | | | |
10|+0+ |+0+ |+-+- |+0+0 |++++ |+-0-- |+-+-0 |+0--+ |+000- |+0+e+- |+-0+-0+ | | |
11|++- |++- |+-++ |++-0 |+--0- |+-00+ |+-++0 |+00-- |+0+-+ |++-e+- |++0+- |+++++ | |
12|++0 |++0 |+0-0 |++e+- |+--+0 |+-+-0 |+0-e+- |+00+0 |++--0 |++e+0 |++++0 |+--0-0 |+--+e+-|
13|+++ |+++ |+00- |+++0 |+-0-+ |+-++- |+00-0 |+0+0+ |++0-- |+++e+- |+-+--++ |+--+0- |+-0-+0 |
14|+--- |+--- |+00+ |+---0 |+-0+- |+0--+ |+00+0 |++-0- |--++0++ |+---e+-|+0--+-- |+-0-0+ |+-0+-0 |
15|+--0 |+--0 |+0+0 |+--e+- |+-+-0 |+0-+0 |+0+e+- |++0-0 |--++++0 |+--e+0 |+-0--0 |+-00+0 |+-+-e+-|
16|+--+ |+--+ |++-- |+--+0 |+-+0+ |+000- |++--0 |++0++ |+---+- |+--+e+-|+-00-+ |+-+--- |+-+0+0 |
17|+-0- |+-0- |++-+ |+-0-0 |+0--- |+00++ |++-+0 |++++- |+--00+ |+-0-e+-|++-0+0- |+-+0-+ |+0---0 |
18|+-e+-|+-e+- |++e+- |+-e+0 |+0-e+- |+0+e+- |++e+0 |+---e+-|+--+e+-|+-e++ |+-+-e+-|+-++e+-|+0-e+0 |
19|+-0+ |+-0+ |+++- |+-0+0 |+0-++ |++--- |+++-0 |+--0-+ |+0-0-0- |+-0+e+-|+-+00+ |+0--+- |+0-++0 |
20|+-+- |+-+- |++++ |+-+-0 |+000- |++-0+ |++++0 |+--+-- |+-00-+ |+-+-e+-|++-+++- |+0-0++ |+000-0 |
21|+-+0 |+-+0 |+---0 |+-+e+- |+00+0 |++0-0 |+---e+-|+--++0 |+-0+-0 |+-+e+0 |+--0--+0 |+00--0 |+00+e+-|
22|+-++ |+-++ |+--0- |+-++0 |+0+-+ |++0+- |+--0-0 |+-0-0+ |+00-+--- |+-++e+-|+--0-0++ |+0000- |+0+-+0 |
23|+0-- |+0-- |+--0+ |+0--0 |+0++- |+++-+ |+--0+0 |+-000- |+-+-++ |+0--e+-|+00--- |+00+0+ |+0++-0 |
24|+0-0 |+0-0 |+--+0 |+0-e+- |++--0 |++++0 |+--+e+-|+-0+-0 |+-+0+0 |+0-e+0 |+000-0 |+0+-+0 |++--e+-|
25|+0-+ |+0-+ |+-0-- |+0-+0 |++-0+ |+---0- |+-0--0 |+-0+++ |+-+++- |+0-+e+-|+00+-+ |+0++-- |++-0+0 |
26|+00- |+00- |+-0-+ |+00-0 |++0-- |+---++ |+-0-+0 |+-+-+- |+0--0+ |+00-e+-|+0+-0- |++---+ |++0--0 |
27|+e+0 |+e+0 |+-e+0 |+e++ |++e+0 |+--e+0 |+-e++ |+-+e+0 |+0-e+0 |+e+-- |+0+e+0 |++-e+0 |++e++ |
 
</pre>
[[Category:Arbitrary precision]]