in regards to "FPU 80 bit extended precision"

[srvaldez]

in regards to "FPU 80 bit extended precision" https://forum.lazarus.freepascal.org/index.php/topic,62198.0.html
the use of the units sfpux80 and ufloatx80 was suggested, though I couldn't find them anywhere.
it was also mentioned that conversion to string was still missing in those units, that's where this post comes in
there's public domain code by Stephen L. Moshier http://www.moshier.net/#Rubid_pc file smldbl12.zip
the relevant file in the archive is contrib\smldbl12\v203\ioldoubl.c
I had to add the following at the top of ioldoubl.c

Code: C  [Select][+][-]

1. #include <string.h>
2. #include <malloc.h>
3.  

for best results I suggest that you use the following MinGW distribution https://github.com/brechtsanders/winlibs_mingw/releases/tag/9.3.0-7.0.0-sjlj-r3
compile ioldoubl.c gcc -c -O2 ioldoubl.c
copy ioldoubl.o and the libraries libmsvcrt.a and libgcc.a from the MinGW distribution into the folder where your test program resides
the output is sci format

Code: Pascal  [Select][+][-]

1.         {$MODE OBJFPC}{$H+}
2.         {$MINFPCONSTPREC 64}
3.  
4.         {$LINK ioldoubl}
5.         {$LINKLIB libmsvcrt}
6.         {$LINKLIB libgcc}
7.  
8.         program ioldouble_test1;
9.         uses ctypes, sysutils, windows, math;
10.        
11.         type extfloat = record
12.                 ext_number : array[0..15] of uint8;
13.         end;
14.        
15.         type extfloatp = ^extfloat;
16.  
17.         function strtold ( s : pchar; var ps : pchar):extfloat; cdecl; external name '_strtold';
18.         procedure ldtostr(x:extfloatp; string_: pchar; ndigs:uint32; flags:int32; fmt: pchar);cdecl; external name '_IO_ldtostr';
19.         function ldtoa(d:extfloatp; mode:int32; ndigits:int32; var decpt:int32; var sign:int32; var rve:pchar):pchar; cdecl; external name '_IO_ldtoa';
20.         function snprintf ( s:pchar; n:csize_t; format:pchar):cint; varargs; cdecl; external name 'snprintf';
21.         function atof(s: PChar):double; cdecl; external name 'atof';
22.        
23.         function extsqrt(x: extfloat):extfloat;
24.         var
25.           y:extfloat;
26.         begin
27.           {$ASMMODE att}
28.                 asm
29.                   fldt     x
30.                   fsqrt
31.                   fstpt y
32.                 end;
33.                 extsqrt:=y;
34.         end;
35.  
36.         function extadd(a: extfloat; b: extfloat):extfloat;
37.  
38.         var
39.           y:extfloat;
40.         begin
41.           {$ASMMODE att}
42.                 asm
43.                   fldt     a
44.                   fldt     b
45.                   faddp   %st, %st(1)
46.                   fstpt y
47.                 end;
48.                 extadd:=y;
49.         end;
50.        
51.         function extsub(a: extfloat; b: extfloat):extfloat;
52.  
53.         var
54.           y:extfloat;
55.         begin
56.           {$ASMMODE att}
57.                 asm
58.                   fldt     a
59.                   fldt     b
60.                   fsubrp   %st, %st(1)
61.                   fstpt y
62.                 end;
63.                 extsub:=y;
64.         end;
65.  
66.         function extmul(a: extfloat; b: extfloat):extfloat;
67.  
68.         var
69.           y:extfloat;
70.         begin
71.           {$ASMMODE att}
72.                 asm
73.                   fldt     a
74.                   fldt     b
75.                   fmulp   %st, %st(1)
76.                   fstpt y
77.                 end;
78.                 extmul:=y;
79.         end;
80.        
81.         function extdiv(a: extfloat; b: extfloat):extfloat;
82.  
83.         var
84.           y:extfloat;
85.         begin
86.           {$ASMMODE att}
87.                 asm
88.                   fldt     a
89.                   fldt     b
90.                   fdivrp   %st, %st(1)
91.                   fstpt y
92.                 end;
93.                 extdiv:=y;
94.         end;
95.  
96.         function extval( s:ansistring):extfloat;
97.         var
98.                 pc, ppc:pchar;
99.                 y:extfloat;
100.         begin
101.                 pc:=pchar(s+#0);
102.                 ppc:=#0;
103.                 y:=strtold(pc, ppc);
104.                 extval:=y;
105.         end;
106.  
107.         function extstr( x:extfloat):ansistring;
108.         var
109.                 s:pchar;
110.                 res:ansistring;
111.         begin
112.                 res:='                                                                        ';
113.                 s:=pchar(res+#0);
114.                 ldtostr(@x, s, 17, 0, 'E');
115.                 extstr:=s;
116.         end;
117.  
118.         function extstr( x:double):ansistring;
119.         var
120.                 s:pchar;
121.                 res:ansistring;
122.         begin
123.                 res:='                                                                        ';
124.                 s:=pchar(res+#0);
125.                 snprintf(s, 64, '%.15g', x);
126.                 extstr:=s;
127.         end;
128.  
129. (**********************************************************************)
130.  
131.         operator := (r : ansistring) z : double;  
132.         var s : pchar;
133.         begin
134.                 s:=pchar(r);
135.                 z:=atof(s);
136.         end;
137.        
138.         operator := (r : ansistring) z : extfloat;  
139.          
140.         begin  
141.                 z:=extval(r);
142.         end;
143.        
144.         operator := (r : int32) z : extfloat;  
145.         var
146.           y:extfloat;
147.         begin
148.           {$ASMMODE att}
149.                 asm
150.                   fild    r
151.                   fstpt y
152.                 end;
153.           z:=y;
154.         end;
155.  
156.         operator := (r : int64) z : extfloat;  
157.         var
158.           y:extfloat;
159.         begin
160.           {$ASMMODE att}
161.                 asm
162.                   fildl    r
163.                   fstpt y
164.                 end;
165.           z:=y;
166.         end;
167.  
168.         operator := (r : double) z : extfloat;  
169.         var
170.           y:extfloat;
171.         begin
172.           {$ASMMODE att}
173.                 asm
174.                   fldl    r
175.                   fstpt y
176.                 end;
177.           z:=y;
178.         end;
179.  
180.         operator + (x : extfloat; y : extfloat) z : extfloat;  
181.          
182.         begin  
183.           z:=extadd(x, y);
184.         end;
185.        
186.         operator + (x : extfloat; y : int32) z : extfloat;  
187.         var
188.                 w:extfloat;
189.         begin
190.                 w:=y;
191.                 z:=extadd(x, w);
192.         end;
193.        
194.         operator + (x : extfloat; y : int64) z : extfloat;  
195.         var
196.                 w:extfloat;
197.         begin
198.                 w:=y;
199.                 z:=extadd(x, w);
200.         end;
201.        
202.         operator + (x : extfloat; y : double) z : extfloat;  
203.         var
204.                 w:extfloat;
205.         begin
206.                 w:=y;
207.                 z:=extadd(x, w);
208.         end;
209.        
210.         operator - (x : extfloat; y : extfloat) z : extfloat;  
211.          
212.         begin  
213.           z:=extsub(x, y);
214.         end;
215.        
216.         operator - (x : extfloat; y : int32) z : extfloat;  
217.         var
218.                 w:extfloat;
219.         begin
220.                 w:=y;
221.                 z:=extsub(x, w);
222.         end;
223.        
224.         operator - (x : extfloat; y : int64) z : extfloat;  
225.         var
226.                 w:extfloat;
227.         begin
228.                 w:=y;
229.                 z:=extsub(x, w);
230.         end;
231.        
232.         operator - (x : extfloat; y : double) z : extfloat;  
233.         var
234.                 w:extfloat;
235.         begin
236.                 w:=y;
237.                 z:=extsub(x, w);
238.         end;
239.        
240.         operator * (x : extfloat; y : extfloat) z : extfloat;  
241.          
242.         begin  
243.           z:=extmul(x, y);
244.         end;
245.        
246.         operator * (x : extfloat; y : int32) z : extfloat;  
247.         var
248.                 w:extfloat;
249.         begin
250.                 w:=y;
251.                 z:=extmul(x, w);
252.         end;
253.        
254.         operator * (x : extfloat; y : int64) z : extfloat;  
255.         var
256.                 w:extfloat;
257.         begin
258.                 w:=y;
259.                 z:=extmul(x, w);
260.         end;
261.        
262.         operator * (x : extfloat; y : double) z : extfloat;  
263.         var
264.                 w:extfloat;
265.         begin
266.                 w:=y;
267.                 z:=extmul(x, w);
268.         end;
269.  
270.         operator / (x : extfloat; y : extfloat) z : extfloat;  
271.          
272.         begin  
273.           z:=extdiv(x, y);
274.         end;
275.        
276.         operator / (x : extfloat; y : int32) z : extfloat;  
277.         var
278.                 w:extfloat;
279.         begin
280.                 w:=y;
281.                 z:=extdiv(x, w);
282.         end;
283.        
284.         operator / (x : extfloat; y : int64) z : extfloat;  
285.         var
286.                 w:extfloat;
287.         begin
288.                 w:=y;
289.                 z:=extdiv(x, w);
290.         end;
291.        
292.         operator / (x : extfloat; y : double) z : extfloat;  
293.         var
294.                 w:extfloat;
295.         begin
296.                 w:=y;
297.                 z:=extdiv(x, w);
298.         end;
299.        
300.         function sqrt(x : extfloat): extfloat;Overload;
301.         begin
302.                 result:=extsqrt(x);
303.         end;
304. (**********************************************************************)
305.  
306. // main test code
307.                
308.         var x, y, z:extfloat;
309.  
310.         begin
311.                 x:='1.23456789';
312.                 y:=123;
313.                 z:=x+y;
314.                 writeln(extstr(z));
315.                 x:=8;
316.                 y:=9;
317.                 z:=x/y;
318.                 writeln(extstr(z));
319.                 x:=2;
320.                 z:=sqrt(x);
321.                 writeln(extstr(z));
322.         end.
323.  

[srvaldez]

if you want to write a function to format the output, you can use ldtoa like in the following example

Code: Pascal  [Select][+][-]

1.         {$MODE OBJFPC}{$H+}
2.         {$MINFPCONSTPREC 64}
3.  
4.         {$LINK ioldoubl}
5.         {$LINKLIB libmsvcrt}
6.         {$LINKLIB libgcc}
7.  
8.         program ioldouble_test1;
9.         uses ctypes, sysutils, windows, math;
10.        
11.         type extfloat = record
12.                 ext_number : array[0..15] of uint8;
13.         end;
14.        
15.         type extfloatp = ^extfloat;
16.  
17.         function strtold ( s : pchar; var ps : pchar):extfloat; cdecl; external name '_strtold';
18.         procedure ldtostr(x:extfloatp; string_: pchar; ndigs:uint32; flags:int32; fmt: pchar);cdecl; external name '_IO_ldtostr';
19.         function ldtoa(d:extfloatp; mode:int32; ndigits:int32; var decpt:int32; var sign:int32; var rve:pchar):pchar; cdecl; external name '_IO_ldtoa';
20.        
21.         var x:extfloat;
22.                 s:ansistring;
23.                 pc, ppc, rve:pchar;
24.                 sign, decpt:int32;
25.                
26.         begin
27.                 s:='314.15926535897932384626433832795e1000';
28.                 pc:=pchar(s+#0);
29.                 x:=strtold(pc, ppc);
30.                 s:='                                                                ';
31.                 pc:=pchar(s+#0);
32.                 pc:=ldtoa(@x, 1, 11, decpt, sign, rve);
33.                 writeln('sign = ', sign);
34.                 writeln('decimal exponent = ', decpt);
35.                 writeln(pc);
36.  
37.         end.
38.  

[PascalDragon]

in regards to "FPU 80 bit extended precision" https://forum.lazarus.freepascal.org/index.php/topic,62198.0.html
the use of the units sfpux80 and ufloatx80 was suggested, though I couldn't find them anywhere.

For 3.2.2 you need the source of FPC and then you'll find them in rtl/inc. You then need to compile them.
In main (and I think also 3.2.3 and newer) they'll be provided by default.

[srvaldez]

the unit source is nowhere to be found and I can't find any documentation on the afore mentioned units, is the source kept in a secret place?
I am also intrigued about the unit ufloat128 but without any documentation or source it's a dead end

[TRon]

the unit source is nowhere to be found and I can't find any documentation on the afore mentioned units, is the source kept in a secret place?
I am also intrigued about the unit ufloat128 but without any documentation or source it's a dead end

It is stored in one of the most top secret locations on earth, this in order to prevent big tech companies from scraping it 

It is on gitlab. Sam ecan be found on github. It is just part of the compiler sources.

[srvaldez]

 
thanks TRon

[Martin_fr]

the unit source is nowhere to be found and I can't find any documentation on the afore mentioned units, is the source kept in a secret place?
I am also intrigued about the unit ufloat128 but without any documentation or source it's a dead end

It is also in the sources distributed with Lazarus. C:\lazarus\fpc\3.2.2\source\rtl\inc\sfpux80.pp

[TRon]

@srvaldez:
Keep in mind though that the link I posted is from trunk/main. You would need the version that matches your version of FPC.

In that regards Martin_fr's answer is more accurate.

Gitlab (as well as github) allows to select the correct compiler version by changing the branch/tag at the top where it reads "main"

[Martin_fr]

the unit source is nowhere to be found and I can't find any documentation on the afore mentioned units, is the source kept in a secret place?
I am also intrigued about the unit ufloat128 but without any documentation or source it's a dead end

It is also in the sources distributed with Lazarus. C:\lazarus\fpc\3.2.2\source\rtl\inc\sfpux80.pp

ufloat128.pp is in the same folder.

As for using them:

Code: Pascal  [Select][+][-]

1. program Project1;
2. uses
3.   ufloatx80, sfpux80, SysUtils;
4.  
5. type
6.   Extended = floatx80; // You do not need to map this / and if you do make sure it doesn't get mixed up
7.  
8. var
9. //  a, b: floatx80; // without mapping
10.   a, b: Extended;
11.  
12. begin
13.   a := 1 / 3;
14.   b := 1 / 7;
15.   writeln(FloatToStrF(a, ffExponent, 21, 0));
16.   writeln(FloatToStrF(b, ffExponent, 21, 0));
17.   readln;
18. end.
19.  

Tested with fpc 3.2.3.

So, I did not build the files on their own. If you want to compile them from 3.2.2 you need to
- copy them to a new folder
- compile them
- find any units or inc files that are reported missing => and copy them too
- compile again
... repeat until success

EDIT: gonna be lots of work to get the inc files.... Better use FpcUpDeluxe and install 3.2.3 (if you are fine with using fixes branch)

--------------
EDIT

Actually FloatToStrF does not support them, as it is in the normal rtl.
So at that point the value would have been converted to double. And the output would be not exact.

You have to check in the 2 units what functions are supplied.

FloatToStrF has the operators, so you can do +.* and /

sfpux80 provides lots of functions, e.g. (and more):
function floatx80_round_to_int( a: floatx80 ): floatx80;
function floatx80_add( a: floatx80; b: floatx80 ): floatx80;
function floatx80_sub( a: floatx80; b: floatx80 ): floatx80;
function floatx80_mul( a: floatx80; b: floatx80 ): floatx80;
function floatx80_div( a: floatx80; b: floatx80 ): floatx80;
function floatx80_rem( a: floatx80; b: floatx80 ): floatx80;
function floatx80_sqrt( a: floatx80 ): floatx80;
function floatx80_eq( a: floatx80; b: floatx80 ): flag;
function floatx80_le( a: floatx80; b: floatx80 ): flag;
function floatx80_lt( a: floatx80; b: floatx80 ): flag;
function floatx80_eq_signaling( a: floatx80; b: floatx80 ): flag;
function floatx80_le_quiet( a: floatx80; b: floatx80 ): flag;
function floatx80_lt_quiet( a: floatx80; b: floatx80 ): flag;
function floatx80_is_signaling_nan( a: floatx80 ): flag;
function floatx80_is_nan(a : floatx80 ): flag;
function floatx80_to_int64( a: floatx80 ): int64;
function floatx80_to_int64_round_to_zero( a: floatx80 ): int64;

[srvaldez]

I edited ioldoubl.c to expose the 128-bit from/to string conversions, you may download the complete lot from https://u.pcloud.link/publink/show?code=XZYsBL5ZwBlYlvpJTVugHQcSxbmJEYfqigWk

Code: Pascal  [Select][+][-]

1.         {$MODE OBJFPC}{$H+}
2.         {$MINFPCONSTPREC 64}
3.  
4.         {$LINK ioldoubl}
5.         {$LINKLIB libmsvcrt}
6.         {$LINKLIB libgcc}
7.                
8.         program ioldouble_test1;
9.         uses ufloat128, ctypes, sysutils, windows, math;
10.  
11.         type extfloat = record
12.                 ext_number : array[0..15] of uint8;
13.         end;
14.        
15.         type extfloatp = ^extfloat;
16.         type float128p = ^float128;
17.        
18.         procedure e80toasc ( x : extfloatp; s : pchar; n : uint32); cdecl; external name 'e64toasc';
19.         procedure asctoe80 ( s : pchar; x : extfloatp ); cdecl; external name 'asctoe64';
20.         procedure e128toasc ( x : float128p; s : pchar; n:int32 );cdecl; external name 'e113toasc';
21.         procedure asctoe128 ( s : pchar; y : float128p );cdecl; external name 'asctoe113';
22.  
23.         function e128val( s:ansistring):float128;
24.         var
25.                 pc:pchar;
26.                 y:float128;
27.         begin
28.                 pc:=pchar(s+#0);
29.                 asctoe128(pc, @y);
30.                 e128val:=y;
31.         end;
32.  
33.         function e128str( x:float128):ansistring;
34.         var
35.                 s:pchar;
36.                 res:ansistring;
37.         begin
38.                 res:='                                                                        ';
39.                 s:=pchar(res+#0);
40.                 e128toasc(@x, s, 33);
41.                 e128str:=s;
42.         end;
43.  
44.         operator := (r : ansistring) z : float128;  
45.          
46.         begin  
47.                 z:=e128val(r);
48.         end;
49.        
50. // main test
51.  
52.         var x, y, z:float128;
53.                 //s:ansistring;
54.  
55.         begin
56.                 x:='3.333333333333333333333333333333333';
57.                 y:='5.555555555555555555555555555555555';
58.                 z:=x+y;
59.                 writeln(e128str(z));
60.  
61.         end.
62.  

output

8.888888888888888888888888888888889E0

but if you need/want a full suit of 80-bit floating point functions  then you can build a dll from the libmingwex library that's included in a MinGW distribution, there's a link here for the dll and test code https://forum.lazarus.freepascal.org/index.php/topic,62198.msg547123.html#msg547123