Clarify binary compatibility with HAL/Fujitsu SPARC64 family.
[openssl.git] / crypto / bn / asm / sparcv9a-mont.pl
1 #!/usr/bin/env perl
2
3 # ====================================================================
4 # Written by Andy Polyakov <appro@fy.chalmers.se> for the OpenSSL
5 # project. Rights for redistribution and usage in source and binary
6 # forms are granted according to the OpenSSL license.
7 # ====================================================================
8
9 # October 2005
10 #
11 # "Teaser" Montgomery multiplication module for UltraSPARC. Why FPU?
12 # Because unlike integer multiplier, which simply stalls whole CPU,
13 # FPU is fully pipelined and can effectively emit 48 bit partial
14 # product every cycle. Why not blended SPARC v9? One can argue that
15 # making this module dependent on UltraSPARC VIS extension limits its
16 # binary compatibility. Well yes, it does exclude SPARC64 prior-V(!)
17 # implementations from compatibility matrix. But the rest, whole Sun
18 # UltraSPARC family and brand new Fujitsu's SPARC64 V, all support
19 # VIS extension instructions used in this module. This is considered
20 # good enough to recommend HAL SPARC64 users [if any] to simply fall
21 # down to no-asm configuration.
22
23 # USI&II cores currently exhibit uniform 2x improvement [over pre-
24 # bn_mul_mont codebase] for all key lengths and benchmarks. On USIII
25 # performance improves few percents for shorter keys and worsens few
26 # percents for longer keys. This is because USIII integer multiplier
27 # is >3x faster than USI&II one, which is harder to match [but see
28 # TODO list below]. It should also be noted that SPARC64 V features
29 # out-of-order execution, which *might* mean that integer multiplier
30 # is pipelined, which in turn *might* be impossible to match... On
31 # additional note, SPARC64 V implements FP Multiply-Add instruction,
32 # which is perfectly usable in this context... In other words, as far
33 # as HAL/Fujitsu SPARC64 family goes, talk to the author:-)
34
35 # In 32-bit context the implementation implies following additional
36 # limitations on input arguments:
37 # - num may not be less than 4;
38 # - num has to be even;
39 # - ap, bp, rp, np has to be 64-bit aligned [which is not a problem
40 #   as long as BIGNUM.d are malloc-ated];
41 # Failure to meet either condition has no fatal effects, simply
42 # doesn't give any performance gain.
43
44 # TODO:
45 # - modulo-schedule inner loop for better performance (on in-order
46 #   execution core such as UltraSPARC this shall result in further
47 #   noticeable(!) improvement);
48 # - dedicated squaring procedure[?];
49
50 $fname="bn_mul_mont";
51 $bits=32;
52 for (@ARGV) {
53         $bits=64    if (/\-m64/        || /\-xarch\=v9/);
54         $vis=1      if (/\-mcpu=ultra/ || /\-xarch\=v[9|8plus]\S/);
55 }
56
57 if (!$vis) {
58 print<<___;
59 .section        ".text",#alloc,#execinstr
60 .global $fname
61 $fname:
62         retl
63         xor     %o0,%o0,%o0     ! just signal "not implemented"
64 .type   $fname,#function
65 .size   $fname,(.-$fname)
66 ___
67 exit;
68 }
69
70 if ($bits==64) {
71         $bias=2047;
72         $frame=192;
73 } else {
74         $bias=0;
75         $frame=128;     # 96 rounded up to largest known cache-line
76 }
77 $locals=64;
78
79 # In order to provide for 32-/64-bit ABI duality, I keep integers wider
80 # than 32 bit in %g1-%g4 and %o0-%o5. %l0-%l7 and %i0-%i5 are used
81 # exclusively for pointers, indexes and other small values...
82 # int bn_mul_mont(
83 $rp="%i0";      # BN_ULONG *rp,
84 $ap="%i1";      # const BN_ULONG *ap,
85 $bp="%i2";      # const BN_ULONG *bp,
86 $np="%i3";      # const BN_ULONG *np,
87 $n0="%i4";      # const BN_ULONG *n0,
88 $num="%i5";     # int num);
89
90 $tp="%l0";      # t[num]
91 $ap_l="%l1";    # a[num],n[num] are smashed to 32-bit words and saved
92 $ap_h="%l2";    # to these four vectors as double-precision FP values.
93 $np_l="%l3";    # This way a bunch of fxtods are eliminated in second
94 $np_h="%l4";    # loop and L1-cache aliasing is minimized...
95 $i="%l5";
96 $j="%l6";
97 $mask="%l7";    # 16-bit mask, 0xffff
98
99 $n0="%g4";      # reassigned(!) to "64-bit" register
100 $carry="%i4";   # %i4 reused(!) for a carry bit
101
102 # FP register naming chart
103 #
104 #     ..HILO
105 #       dcba
106 #   --------
107 #        LOa
108 #       LOb
109 #      LOc
110 #     LOd
111 #      HIa
112 #     HIb
113 #    HIc
114 #   HId
115 #    ..a
116 #   ..b
117 $ba="%f0";    $bb="%f2";    $bc="%f4";    $bd="%f6";
118 $na="%f8";    $nb="%f10";   $nc="%f12";   $nd="%f14";
119 $alo="%f16";  $alo_="%f17"; $ahi="%f18";  $ahi_="%f19";
120 $nlo="%f20";  $nlo_="%f21"; $nhi="%f22";  $nhi_="%f23";
121
122 $dota="%f24"; $dotb="%f26";
123
124 $aloa="%f32"; $alob="%f34"; $aloc="%f36"; $alod="%f38";
125 $ahia="%f40"; $ahib="%f42"; $ahic="%f44"; $ahid="%f46";
126 $nloa="%f48"; $nlob="%f50"; $nloc="%f52"; $nlod="%f54";
127 $nhia="%f56"; $nhib="%f58"; $nhic="%f60"; $nhid="%f62";
128
129 $ASI_FL16_P=0xD2;       # magic ASI value to engage 16-bit FP load
130
131 $code=<<___;
132 .ident          "UltraSPARC Montgomery multiply by <appro\@fy.chalmers.se>"
133 .section        ".text",#alloc,#execinstr
134
135 .global $fname
136 .align  32
137 $fname:
138         save    %sp,-$frame-$locals,%sp
139         sethi   %hi(0xffff),$mask
140         or      $mask,%lo(0xffff),$mask
141 ___
142 $code.=<<___ if ($bits==64);
143         ldx     [%i4],$n0               ! $n0 reassigned, remember?
144 ___
145 $code.=<<___ if ($bits==32);
146         cmp     $num,4
147         bl,a,pn %icc,.Lret
148         clr     %i0
149         andcc   $num,1,%g0              ! $num has to be even...
150         bnz,a,pn %icc,.Lret
151         clr     %i0                     ! signal "unsupported input value"
152         or      $bp,$ap,%l0
153         srl     $num,1,$num
154         or      $rp,$np,%l1
155         or      %l0,%l1,%l0
156         andcc   %l0,7,%g0               ! ...and pointers has to be 8-byte aligned
157         bnz,a,pn %icc,.Lret
158         clr     %i0                     ! signal "unsupported input value"
159         ld      [%i4+0],$n0             ! $n0 reassigned, remember?
160         ld      [%i4+4],%o0
161         sllx    %o0,32,%o0
162         or      %o0,$n0,$n0             ! $n0=n0[1].n0[0]
163 ___
164 $code.=<<___;
165         sll     $num,3,$num             ! num*=8
166
167         add     %sp,$bias,%o0           ! real top of stack
168         sll     $num,2,%o1
169         add     %o1,$num,%o1            ! %o1=num*5
170         sub     %o0,%o1,%o0
171         and     %o0,-2048,%o0           ! optimize TLB utilization
172         sub     %o0,$bias,%sp           ! alloca(5*num*8)
173
174         rd      %asi,%o7                ! save %asi
175         add     %sp,$bias+$frame+$locals,$tp
176         add     $tp,$num,$ap_l
177         add     $ap_l,$num,$ap_l        ! [an]p_[lh] point at the vectors' ends !
178         add     $ap_l,$num,$ap_h
179         add     $ap_h,$num,$np_l
180         add     $np_l,$num,$np_h
181
182         wr      %g0,$ASI_FL16_P,%asi    ! setup %asi for 16-bit FP loads
183
184         add     $rp,$num,$rp            ! readjust input pointers to point
185         add     $ap,$num,$ap            ! at the ends too...
186         add     $bp,$num,$bp
187         add     $np,$num,$np
188
189         stx     %o7,[%sp+$bias+$frame+48]       ! save %asi
190 \f
191         sub     %g0,$num,$i
192         sub     %g0,$num,$j
193
194         add     $ap,$j,%o3
195         add     $bp,$i,%o4
196 ___
197 $code.=<<___ if ($bits==64);
198         ldx     [$bp+$i],%o0            ! bp[0]
199         ldx     [$ap+$j],%o1            ! ap[0]
200 ___
201 $code.=<<___ if ($bits==32);
202         ldd     [$bp+$i],%o0            ! bp[0]
203         ldd     [$ap+$j],%g2            ! ap[0]
204         sllx    %o1,32,%o1
205         sllx    %g3,32,%g3
206         or      %o0,%o1,%o0
207         or      %g2,%g3,%o1
208 ___
209 $code.=<<___;
210         add     $np,$j,%o5
211
212         mulx    %o1,%o0,%o0             ! ap[0]*bp[0]
213         mulx    $n0,%o0,%o0             ! ap[0]*bp[0]*n0
214         stx     %o0,[%sp+$bias+$frame+0]
215
216         ld      [%o3+`$bits==32 ? 0 : 4`],$alo_ ! load a[j] as pair of 32-bit words
217         fzeros  $alo
218         ld      [%o3+`$bits==32 ? 4 : 0`],$ahi_
219         fzeros  $ahi
220         ld      [%o5+`$bits==32 ? 0 : 4`],$nlo_ ! load n[j] as pair of 32-bit words
221         fzeros  $nlo
222         ld      [%o5+`$bits==32 ? 4 : 0`],$nhi_
223         fzeros  $nhi
224
225         ! transfer b[i] to FPU as 4x16-bit values
226         ldda    [%o4+`$bits==32 ? 2 : 6`]%asi,$ba
227         fxtod   $alo,$alo
228         ldda    [%o4+`$bits==32 ? 0 : 4`]%asi,$bb
229         fxtod   $ahi,$ahi
230         ldda    [%o4+`$bits==32 ? 6 : 2`]%asi,$bc
231         fxtod   $nlo,$nlo
232         ldda    [%o4+`$bits==32 ? 4 : 0`]%asi,$bd
233         fxtod   $nhi,$nhi
234
235         ! transfer ap[0]*b[0]*n0 to FPU as 4x16-bit values
236         ldda    [%sp+$bias+$frame+6]%asi,$na
237         fxtod   $ba,$ba
238         ldda    [%sp+$bias+$frame+4]%asi,$nb
239         fxtod   $bb,$bb
240         ldda    [%sp+$bias+$frame+2]%asi,$nc
241         fxtod   $bc,$bc
242         ldda    [%sp+$bias+$frame+0]%asi,$nd
243         fxtod   $bd,$bd
244
245         std     $alo,[$ap_l+$j]         ! save smashed ap[j] in double format
246         fxtod   $na,$na
247         std     $ahi,[$ap_h+$j]
248         fxtod   $nb,$nb
249         std     $nlo,[$np_l+$j]         ! save smashed np[j] in double format
250         fxtod   $nc,$nc
251         std     $nhi,[$np_h+$j]
252         fxtod   $nd,$nd
253
254                 fmuld   $alo,$ba,$aloa
255                 fmuld   $nlo,$na,$nloa
256                 fmuld   $alo,$bb,$alob
257                 fmuld   $nlo,$nb,$nlob
258                 fmuld   $alo,$bc,$aloc
259                 fmuld   $nlo,$nc,$nloc
260         faddd   $aloa,$nloa,$nloa
261                 fmuld   $alo,$bd,$alod
262                 fmuld   $nlo,$nd,$nlod
263         faddd   $alob,$nlob,$nlob
264                 fmuld   $ahi,$ba,$ahia
265                 fmuld   $nhi,$na,$nhia
266         faddd   $aloc,$nloc,$nloc
267                 fmuld   $ahi,$bb,$ahib
268                 fmuld   $nhi,$nb,$nhib
269         faddd   $alod,$nlod,$nlod
270                 fmuld   $ahi,$bc,$ahic
271                 fmuld   $nhi,$nc,$nhic
272         faddd   $ahia,$nhia,$nhia
273                 fmuld   $ahi,$bd,$ahid
274                 fmuld   $nhi,$nd,$nhid
275
276         faddd   $ahib,$nhib,$nhib
277         faddd   $ahic,$nhic,$dota       ! $nhic
278         faddd   $ahid,$nhid,$dotb       ! $nhid
279
280         faddd   $nloc,$nhia,$nloc
281         faddd   $nlod,$nhib,$nlod
282
283         fdtox   $nloa,$nloa
284         fdtox   $nlob,$nlob
285         fdtox   $nloc,$nloc
286         fdtox   $nlod,$nlod
287
288         std     $nloa,[%sp+$bias+$frame+0]
289         std     $nlob,[%sp+$bias+$frame+8]
290         std     $nloc,[%sp+$bias+$frame+16]
291         std     $nlod,[%sp+$bias+$frame+24]
292         ldx     [%sp+$bias+$frame+0],%o0
293         ldx     [%sp+$bias+$frame+8],%o1
294         ldx     [%sp+$bias+$frame+16],%o2
295         ldx     [%sp+$bias+$frame+24],%o3
296
297         srlx    %o0,16,%o7
298         add     %o7,%o1,%o1
299         srlx    %o1,16,%o7
300         add     %o7,%o2,%o2
301         srlx    %o2,16,%o7
302         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
303         !and    %o0,$mask,%o0
304         !and    %o1,$mask,%o1
305         !and    %o2,$mask,%o2
306         !sllx   %o1,16,%o1
307         !sllx   %o2,32,%o2
308         !sllx   %o3,48,%o7
309         !or     %o1,%o0,%o0
310         !or     %o2,%o0,%o0
311         !or     %o7,%o0,%o0             ! 64-bit result
312         srlx    %o3,16,%g1              ! 34-bit carry
313 \f
314         ba      .L1st
315         add     $j,8,$j
316 .align  32
317 .L1st:
318         add     $ap,$j,%o3
319         add     $np,$j,%o4
320         ld      [%o3+`$bits==32 ? 0 : 4`],$alo_ ! load a[j] as pair of 32-bit words
321         fzeros  $alo
322         ld      [%o3+`$bits==32 ? 4 : 0`],$ahi_
323         fzeros  $ahi
324         ld      [%o4+`$bits==32 ? 0 : 4`],$nlo_ ! load n[j] as pair of 32-bit words
325         fzeros  $nlo
326         ld      [%o4+`$bits==32 ? 4 : 0`],$nhi_
327         fzeros  $nhi
328
329         fxtod   $alo,$alo
330         fxtod   $ahi,$ahi
331         fxtod   $nlo,$nlo
332         fxtod   $nhi,$nhi
333
334         std     $alo,[$ap_l+$j]         ! save smashed ap[j] in double format
335                 fmuld   $alo,$ba,$aloa
336         std     $ahi,[$ap_h+$j]
337                 fmuld   $nlo,$na,$nloa
338         std     $nlo,[$np_l+$j]         ! save smashed np[j] in double format
339                 fmuld   $alo,$bb,$alob
340         std     $nhi,[$np_h+$j]
341                 fmuld   $nlo,$nb,$nlob
342                 fmuld   $alo,$bc,$aloc
343                 fmuld   $nlo,$nc,$nloc
344         faddd   $aloa,$nloa,$nloa
345                 fmuld   $alo,$bd,$alod
346                 fmuld   $nlo,$nd,$nlod
347         faddd   $alob,$nlob,$nlob
348                 fmuld   $ahi,$ba,$ahia
349                 fmuld   $nhi,$na,$nhia
350         faddd   $aloc,$nloc,$nloc
351                 fmuld   $ahi,$bb,$ahib
352                 fmuld   $nhi,$nb,$nhib
353         faddd   $alod,$nlod,$nlod
354                 fmuld   $ahi,$bc,$ahic
355                 fmuld   $nhi,$nc,$nhic
356         faddd   $ahia,$nhia,$nhia
357                 fmuld   $ahi,$bd,$ahid
358                 fmuld   $nhi,$nd,$nhid
359         faddd   $ahib,$nhib,$nhib
360
361         faddd   $dota,$nloa,$nloa
362         faddd   $dotb,$nlob,$nlob
363         faddd   $ahic,$nhic,$dota       ! $nhic
364         faddd   $ahid,$nhid,$dotb       ! $nhid
365
366         faddd   $nloc,$nhia,$nloc
367         faddd   $nlod,$nhib,$nlod
368
369         fdtox   $nloa,$nloa
370         fdtox   $nlob,$nlob
371         fdtox   $nloc,$nloc
372         fdtox   $nlod,$nlod
373
374         std     $nloa,[%sp+$bias+$frame+0]
375         std     $nlob,[%sp+$bias+$frame+8]
376         std     $nloc,[%sp+$bias+$frame+16]
377         std     $nlod,[%sp+$bias+$frame+24]
378         ldx     [%sp+$bias+$frame+0],%o0
379         ldx     [%sp+$bias+$frame+8],%o1
380         ldx     [%sp+$bias+$frame+16],%o2
381         ldx     [%sp+$bias+$frame+24],%o3
382
383         srlx    %o0,16,%o7
384         add     %o7,%o1,%o1
385         srlx    %o1,16,%o7
386         add     %o7,%o2,%o2
387         srlx    %o2,16,%o7
388         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
389         and     %o0,$mask,%o0
390         and     %o1,$mask,%o1
391         and     %o2,$mask,%o2
392         sllx    %o1,16,%o1
393         sllx    %o2,32,%o2
394         sllx    %o3,48,%o7
395         or      %o1,%o0,%o0
396         or      %o2,%o0,%o0
397         or      %o7,%o0,%o0             ! 64-bit result
398         addcc   %g1,%o0,%o0
399         srlx    %o3,16,%g1              ! 34-bit carry
400         bcs,a   %xcc,.+8
401         add     %g1,1,%g1
402
403         stx     %o0,[$tp]               ! tp[j-1]=
404         addcc   $j,8,$j
405         bnz,pt  %icc,.L1st
406         add     $tp,8,$tp
407 \f
408         fdtox   $dota,$dota
409         fdtox   $dotb,$dotb
410         std     $dota,[%sp+$bias+$frame+32]
411         std     $dotb,[%sp+$bias+$frame+40]
412         ldx     [%sp+$bias+$frame+32],%o0
413         ldx     [%sp+$bias+$frame+40],%o1
414
415         srlx    %o0,16,%o7
416         add     %o7,%o1,%o1
417         and     %o0,$mask,%o0
418         sllx    %o1,16,%o7
419         or      %o7,%o0,%o0
420         addcc   %g1,%o0,%o0
421         srlx    %o1,48,%g1
422         bcs,a   %xcc,.+8
423         add     %g1,1,%g1
424
425         mov     %g1,$carry
426         stx     %o0,[$tp]               ! tp[num-1]=
427 \f
428         ba      .Louter
429         add     $i,8,$i
430 .align  32
431 .Louter:
432         sub     %g0,$num,$j
433         add     %sp,$bias+$frame+$locals,$tp
434
435         add     $bp,$i,%o4
436 ___
437 $code.=<<___ if ($bits==64);
438         ldx     [$bp+$i],%o0            ! bp[i]
439         ldx     [$ap+$j],%o1            ! ap[0]
440 ___
441 $code.=<<___ if ($bits==32);
442         ldd     [$bp+$i],%o0            ! bp[i]
443         ldd     [$ap+$j],%g2            ! ap[0]
444         sllx    %o1,32,%o1
445         sllx    %g3,32,%g3
446         or      %o0,%o1,%o0
447         or      %g2,%g3,%o1
448 ___
449 $code.=<<___;
450         ldx     [$tp],%o2               ! tp[0]
451         mulx    %o1,%o0,%o0
452         addcc   %o2,%o0,%o0
453         mulx    $n0,%o0,%o0             ! (ap[0]*bp[i]+t[0])*n0
454         stx     %o0,[%sp+$bias+$frame+0]
455
456
457         ! transfer b[i] to FPU as 4x16-bit values
458         ldda    [%o4+`$bits==32 ? 2 : 6`]%asi,$ba
459         ldda    [%o4+`$bits==32 ? 0 : 4`]%asi,$bb
460         ldda    [%o4+`$bits==32 ? 6 : 2`]%asi,$bc
461         ldda    [%o4+`$bits==32 ? 4 : 0`]%asi,$bd
462
463         ! transfer (ap[0]*b[i]+t[0])*n0 to FPU as 4x16-bit values
464         ldda    [%sp+$bias+$frame+6]%asi,$na
465         fxtod   $ba,$ba
466         ldda    [%sp+$bias+$frame+4]%asi,$nb
467         fxtod   $bb,$bb
468         ldda    [%sp+$bias+$frame+2]%asi,$nc
469         fxtod   $bc,$bc
470         ldda    [%sp+$bias+$frame+0]%asi,$nd
471         fxtod   $bd,$bd
472         ldd     [$ap_l+$j],$alo         ! load a[j] in double format
473         fxtod   $na,$na
474         ldd     [$ap_h+$j],$ahi
475         fxtod   $nb,$nb
476         ldd     [$np_l+$j],$nlo         ! load n[j] in double format
477         fxtod   $nc,$nc
478         ldd     [$np_h+$j],$nhi
479         fxtod   $nd,$nd
480
481                 fmuld   $alo,$ba,$aloa
482                 fmuld   $nlo,$na,$nloa
483                 fmuld   $alo,$bb,$alob
484                 fmuld   $nlo,$nb,$nlob
485                 fmuld   $alo,$bc,$aloc
486                 fmuld   $nlo,$nc,$nloc
487         faddd   $aloa,$nloa,$nloa
488                 fmuld   $alo,$bd,$alod
489                 fmuld   $nlo,$nd,$nlod
490         faddd   $alob,$nlob,$nlob
491                 fmuld   $ahi,$ba,$ahia
492                 fmuld   $nhi,$na,$nhia
493         faddd   $aloc,$nloc,$nloc
494                 fmuld   $ahi,$bb,$ahib
495                 fmuld   $nhi,$nb,$nhib
496         faddd   $alod,$nlod,$nlod
497                 fmuld   $ahi,$bc,$ahic
498                 fmuld   $nhi,$nc,$nhic
499         faddd   $ahia,$nhia,$nhia
500                 fmuld   $ahi,$bd,$ahid
501                 fmuld   $nhi,$nd,$nhid
502
503         faddd   $ahib,$nhib,$nhib
504         faddd   $ahic,$nhic,$dota       ! $nhic
505         faddd   $ahid,$nhid,$dotb       ! $nhid
506
507         faddd   $nloc,$nhia,$nloc
508         faddd   $nlod,$nhib,$nlod
509
510         fdtox   $nloa,$nloa
511         fdtox   $nlob,$nlob
512         fdtox   $nloc,$nloc
513         fdtox   $nlod,$nlod
514
515         std     $nloa,[%sp+$bias+$frame+0]
516         std     $nlob,[%sp+$bias+$frame+8]
517         std     $nloc,[%sp+$bias+$frame+16]
518         std     $nlod,[%sp+$bias+$frame+24]
519         ldx     [%sp+$bias+$frame+0],%o0
520         ldx     [%sp+$bias+$frame+8],%o1
521         ldx     [%sp+$bias+$frame+16],%o2
522         ldx     [%sp+$bias+$frame+24],%o3
523
524         srlx    %o0,16,%o7
525         add     %o7,%o1,%o1
526         srlx    %o1,16,%o7
527         add     %o7,%o2,%o2
528         srlx    %o2,16,%o7
529         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
530         ! why?
531         and     %o0,$mask,%o0
532         and     %o1,$mask,%o1
533         and     %o2,$mask,%o2
534         sllx    %o1,16,%o1
535         sllx    %o2,32,%o2
536         sllx    %o3,48,%o7
537         or      %o1,%o0,%o0
538         or      %o2,%o0,%o0
539         or      %o7,%o0,%o0             ! 64-bit result
540         ldx     [$tp],%o7
541         addcc   %o7,%o0,%o0
542         ! end-of-why?
543         srlx    %o3,16,%g1              ! 34-bit carry
544         bcs,a   %xcc,.+8
545         add     %g1,1,%g1
546 \f
547         ba      .Linner
548         add     $j,8,$j
549 .align  32
550 .Linner:
551         ldd     [$ap_l+$j],$alo         ! load a[j] in double format
552         ldd     [$ap_h+$j],$ahi
553         ldd     [$np_l+$j],$nlo         ! load n[j] in double format
554         ldd     [$np_h+$j],$nhi
555
556                 fmuld   $alo,$ba,$aloa
557                 fmuld   $nlo,$na,$nloa
558                 fmuld   $alo,$bb,$alob
559                 fmuld   $nlo,$nb,$nlob
560                 fmuld   $alo,$bc,$aloc
561                 fmuld   $nlo,$nc,$nloc
562         faddd   $aloa,$nloa,$nloa
563                 fmuld   $alo,$bd,$alod
564                 fmuld   $nlo,$nd,$nlod
565         faddd   $alob,$nlob,$nlob
566                 fmuld   $ahi,$ba,$ahia
567                 fmuld   $nhi,$na,$nhia
568         faddd   $aloc,$nloc,$nloc
569                 fmuld   $ahi,$bb,$ahib
570                 fmuld   $nhi,$nb,$nhib
571         faddd   $alod,$nlod,$nlod
572                 fmuld   $ahi,$bc,$ahic
573                 fmuld   $nhi,$nc,$nhic
574         faddd   $ahia,$nhia,$nhia
575                 fmuld   $ahi,$bd,$ahid
576                 fmuld   $nhi,$nd,$nhid
577
578         faddd   $ahib,$nhib,$nhib
579         faddd   $dota,$nloa,$nloa
580         faddd   $dotb,$nlob,$nlob
581         faddd   $ahic,$nhic,$dota       ! $nhic
582         faddd   $ahid,$nhid,$dotb       ! $nhid
583
584         faddd   $nloc,$nhia,$nloc
585         faddd   $nlod,$nhib,$nlod
586
587         fdtox   $nloa,$nloa
588         fdtox   $nlob,$nlob
589         fdtox   $nloc,$nloc
590         fdtox   $nlod,$nlod
591
592         std     $nloa,[%sp+$bias+$frame+0]
593         std     $nlob,[%sp+$bias+$frame+8]
594         std     $nloc,[%sp+$bias+$frame+16]
595         std     $nlod,[%sp+$bias+$frame+24]
596         ldx     [%sp+$bias+$frame+0],%o0
597         ldx     [%sp+$bias+$frame+8],%o1
598         ldx     [%sp+$bias+$frame+16],%o2
599         ldx     [%sp+$bias+$frame+24],%o3
600
601         srlx    %o0,16,%o7
602         add     %o7,%o1,%o1
603         srlx    %o1,16,%o7
604         add     %o7,%o2,%o2
605         srlx    %o2,16,%o7
606         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
607         and     %o0,$mask,%o0
608         and     %o1,$mask,%o1
609         and     %o2,$mask,%o2
610         sllx    %o1,16,%o1
611         sllx    %o2,32,%o2
612         sllx    %o3,48,%o7
613         or      %o1,%o0,%o0
614         or      %o2,%o0,%o0
615         or      %o7,%o0,%o0             ! 64-bit result
616         addcc   %g1,%o0,%o0
617         srlx    %o3,16,%g1              ! 34-bit carry
618         bcs,a   %xcc,.+8
619         add     %g1,1,%g1
620
621         ldx     [$tp+8],%o7             ! tp[j]
622         addcc   %o7,%o0,%o0
623         bcs,a   %xcc,.+8
624         add     %g1,1,%g1
625
626         stx     %o0,[$tp]               ! tp[j-1]
627         addcc   $j,8,$j
628         bnz,pt  %icc,.Linner
629         add     $tp,8,$tp
630 \f
631         fdtox   $dota,$dota
632         fdtox   $dotb,$dotb
633         std     $dota,[%sp+$bias+$frame+32]
634         std     $dotb,[%sp+$bias+$frame+40]
635         ldx     [%sp+$bias+$frame+32],%o0
636         ldx     [%sp+$bias+$frame+40],%o1
637
638         srlx    %o0,16,%o7
639         add     %o7,%o1,%o1
640         and     %o0,$mask,%o0
641         sllx    %o1,16,%o7
642         or      %o7,%o0,%o0
643         addcc   %g1,%o0,%o0
644         srlx    %o1,48,%g1
645         bcs,a   %xcc,.+8
646         add     %g1,1,%g1
647
648         addcc   $carry,%o0,%o0
649         stx     %o0,[$tp]               ! tp[num-1]
650         mov     %g1,$carry
651         bcs,a   %xcc,.+8
652         add     $carry,1,$carry
653
654         addcc   $i,8,$i
655         bnz     %icc,.Louter
656         nop
657 \f
658         sub     %g0,$num,%o7            ! n=-num
659         cmp     $carry,0                ! clears %icc.c
660         bne,pn  %icc,.Lsub
661         add     $tp,8,$tp               ! adjust tp to point at the end
662
663         ld      [$tp-8],%o0
664         ld      [$np-`$bits==32 ? 4 : 8`],%o1
665         cmp     %o0,%o1                 ! compare topmost words
666         bcs,pt  %icc,.Lcopy             ! %icc.c is clean if not taken
667         nop
668
669 .align  32,0x1000000
670 .Lsub:
671         ldd     [$tp+%o7],%o0
672         ldd     [$np+%o7],%o2
673 ___
674 $code.=<<___ if ($bits==64);
675         subccc  %o1,%o3,%o3
676         subccc  %o0,%o2,%o2
677 ___
678 $code.=<<___ if ($bits==32);
679         subccc  %o1,%o2,%o2
680         subccc  %o0,%o3,%o3
681 ___
682 $code.=<<___;
683         std     %o2,[$rp+%o7]
684         add     %o7,8,%o7
685         brnz,pt %o7,.Lsub
686         nop
687         subccc  $carry,0,$carry
688         bcc,pt  %icc,.Lzap
689         sub     %g0,$num,%o7
690
691 .align  16,0x1000000
692 .Lcopy:
693         ldx     [$tp+%o7],%o0
694 ___
695 $code.=<<___ if ($bits==64);
696         stx     %o0,[$rp+%o7]
697 ___
698 $code.=<<___ if ($bits==32);
699         srlx    %o0,32,%o1
700         std     %o0,[$rp+%o7]
701 ___
702 $code.=<<___;
703         add     %o7,8,%o7
704         brnz,pt %o7,.Lcopy
705         nop
706         ba      .Lzap
707         sub     %g0,$num,%o7
708
709 .align  32
710 .Lzap:
711         stx     %g0,[$tp+%o7]
712         stx     %g0,[$ap_l+%o7]
713         stx     %g0,[$ap_h+%o7]
714         stx     %g0,[$np_l+%o7]
715         stx     %g0,[$np_h+%o7]
716         add     %o7,8,%o7
717         brnz,pt %o7,.Lzap
718         nop
719
720         ldx     [%sp+$bias+$frame+48],%o7
721         wr      %g0,%o7,%asi            ! restore %asi
722
723         mov     1,%i0
724 .Lret:
725         ret
726         restore
727 .type   $fname,#function
728 .size   $fname,(.-$fname)
729 ___
730
731 $code =~ s/\`([^\`]*)\`/eval($1)/gem;
732 print $code;
733 close STDOUT;