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