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 # The implementation implies following "non-natural" limitations on
  36 # 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_fpu";
  51 $bits=32;
  52 for (@ARGV) { $bits=64 if (/\-m64/ || /\-xarch\=v9/); }
  53
  54 if ($bits==64) {
  55         $bias=2047;
  56         $frame=192;
  57 } else {
  58         $bias=0;
  59         $frame=128;     # 96 rounded up to largest known cache-line
  60 }
  61 $locals=64;
  62
  63 # In order to provide for 32-/64-bit ABI duality, I keep integers wider
  64 # than 32 bit in %g1-%g4 and %o0-%o5. %l0-%l7 and %i0-%i5 are used
  65 # exclusively for pointers, indexes and other small values...
  66 # int bn_mul_mont(
  67 $rp="%i0";      # BN_ULONG *rp,
  68 $ap="%i1";      # const BN_ULONG *ap,
  69 $bp="%i2";      # const BN_ULONG *bp,
  70 $np="%i3";      # const BN_ULONG *np,
  71 $n0="%i4";      # const BN_ULONG *n0,
  72 $num="%i5";     # int num);
  73
  74 $tp="%l0";      # t[num]
  75 $ap_l="%l1";    # a[num],n[num] are smashed to 32-bit words and saved
  76 $ap_h="%l2";    # to these four vectors as double-precision FP values.
  77 $np_l="%l3";    # This way a bunch of fxtods are eliminated in second
  78 $np_h="%l4";    # loop and L1-cache aliasing is minimized...
  79 $i="%l5";
  80 $j="%l6";
  81 $mask="%l7";    # 16-bit mask, 0xffff
  82
  83 $n0="%g4";      # reassigned(!) to "64-bit" register
  84 $carry="%i4";   # %i4 reused(!) for a carry bit
  85
  86 # FP register naming chart
  87 #
  88 #     ..HILO
  89 #       dcba
  90 #   --------
  91 #        LOa
  92 #       LOb
  93 #      LOc
  94 #     LOd
  95 #      HIa
  96 #     HIb
  97 #    HIc
  98 #   HId
  99 #    ..a
 100 #   ..b
 101 $ba="%f0";    $bb="%f2";    $bc="%f4";    $bd="%f6";
 102 $na="%f8";    $nb="%f10";   $nc="%f12";   $nd="%f14";
 103 $alo="%f16";  $alo_="%f17"; $ahi="%f18";  $ahi_="%f19";
 104 $nlo="%f20";  $nlo_="%f21"; $nhi="%f22";  $nhi_="%f23";
 105
 106 $dota="%f24"; $dotb="%f26";
 107
 108 $aloa="%f32"; $alob="%f34"; $aloc="%f36"; $alod="%f38";
 109 $ahia="%f40"; $ahib="%f42"; $ahic="%f44"; $ahid="%f46";
 110 $nloa="%f48"; $nlob="%f50"; $nloc="%f52"; $nlod="%f54";
 111 $nhia="%f56"; $nhib="%f58"; $nhic="%f60"; $nhid="%f62";
 112
 113 $ASI_FL16_P=0xD2;       # magic ASI value to engage 16-bit FP load
 114
 115 $code=<<___;
 116 .ident          "UltraSPARC Montgomery multiply by <appro\@fy.chalmers.se>"
 117 .section        ".text",#alloc,#execinstr
 118
 119 .global $fname
 120 .align  32
 121 $fname:
 122         save    %sp,-$frame-$locals,%sp
 123         sethi   %hi(0xffff),$mask
 124         or      $mask,%lo(0xffff),$mask
 125
 126         cmp     $num,4
 127         bl,a,pn %icc,.Lret
 128         clr     %i0
 129         andcc   $num,1,%g0              ! $num has to be even...
 130         bnz,a,pn %icc,.Lret
 131         clr     %i0                     ! signal "unsupported input value"
 132         or      $bp,$ap,%l0
 133         srl     $num,1,$num
 134         or      $rp,$np,%l1
 135         or      %l0,%l1,%l0
 136         andcc   %l0,7,%g0               ! ...and pointers has to be 8-byte aligned
 137         bnz,a,pn %icc,.Lret
 138         clr     %i0                     ! signal "unsupported input value"
 139         ld      [%i4+0],$n0             ! $n0 reassigned, remember?
 140         ld      [%i4+4],%o0
 141         sllx    %o0,32,%o0
 142         or      %o0,$n0,$n0             ! $n0=n0[1].n0[0]
 143
 144         sll     $num,3,$num             ! num*=8
 145
 146         add     %sp,$bias,%o0           ! real top of stack
 147         sll     $num,2,%o1
 148         add     %o1,$num,%o1            ! %o1=num*5
 149         sub     %o0,%o1,%o0
 150         and     %o0,-2048,%o0           ! optimize TLB utilization
 151         sub     %o0,$bias,%sp           ! alloca(5*num*8)
 152
 153         rd      %asi,%o7                ! save %asi
 154         add     %sp,$bias+$frame+$locals,$tp
 155         add     $tp,$num,$ap_l
 156         add     $ap_l,$num,$ap_l        ! [an]p_[lh] point at the vectors' ends !
 157         add     $ap_l,$num,$ap_h
 158         add     $ap_h,$num,$np_l
 159         add     $np_l,$num,$np_h
 160
 161         wr      %g0,$ASI_FL16_P,%asi    ! setup %asi for 16-bit FP loads
 162
 163         add     $rp,$num,$rp            ! readjust input pointers to point
 164         add     $ap,$num,$ap            ! at the ends too...
 165         add     $bp,$num,$bp
 166         add     $np,$num,$np
 167
 168         stx     %o7,[%sp+$bias+$frame+48]       ! save %asi
 169 \f
 170         sub     %g0,$num,$i             ! i=-num
 171         sub     %g0,$num,$j             ! j=-num
 172
 173         add     $ap,$j,%o3
 174         add     $bp,$i,%o4
 175
 176         ldx     [$bp+$i],%o0            ! bp[0]
 177         ldx     [$ap+$j],%o1            ! ap[0]
 178         sllx    %o0,32,%g1
 179         sllx    %o1,32,%g5
 180         srlx    %o0,32,%o0
 181         srlx    %o1,32,%o1
 182         or      %g1,%o0,%o0
 183         or      %g5,%o1,%o1
 184
 185         add     $np,$j,%o5
 186
 187         mulx    %o1,%o0,%o0             ! ap[0]*bp[0]
 188         mulx    $n0,%o0,%o0             ! ap[0]*bp[0]*n0
 189         stx     %o0,[%sp+$bias+$frame+0]
 190
 191         ld      [%o3+0],$alo_   ! load a[j] as pair of 32-bit words
 192         fzeros  $alo
 193         ld      [%o3+4],$ahi_
 194         fzeros  $ahi
 195         ld      [%o5+0],$nlo_   ! load n[j] as pair of 32-bit words
 196         fzeros  $nlo
 197         ld      [%o5+4],$nhi_
 198         fzeros  $nhi
 199
 200         ! transfer b[i] to FPU as 4x16-bit values
 201         ldda    [%o4+2]%asi,$ba
 202         fxtod   $alo,$alo
 203         ldda    [%o4+0]%asi,$bb
 204         fxtod   $ahi,$ahi
 205         ldda    [%o4+6]%asi,$bc
 206         fxtod   $nlo,$nlo
 207         ldda    [%o4+4]%asi,$bd
 208         fxtod   $nhi,$nhi
 209
 210         ! transfer ap[0]*b[0]*n0 to FPU as 4x16-bit values
 211         ldda    [%sp+$bias+$frame+6]%asi,$na
 212         fxtod   $ba,$ba
 213         ldda    [%sp+$bias+$frame+4]%asi,$nb
 214         fxtod   $bb,$bb
 215         ldda    [%sp+$bias+$frame+2]%asi,$nc
 216         fxtod   $bc,$bc
 217         ldda    [%sp+$bias+$frame+0]%asi,$nd
 218         fxtod   $bd,$bd
 219
 220         std     $alo,[$ap_l+$j]         ! save smashed ap[j] in double format
 221         fxtod   $na,$na
 222         std     $ahi,[$ap_h+$j]
 223         fxtod   $nb,$nb
 224         std     $nlo,[$np_l+$j]         ! save smashed np[j] in double format
 225         fxtod   $nc,$nc
 226         std     $nhi,[$np_h+$j]
 227         fxtod   $nd,$nd
 228
 229                 fmuld   $alo,$ba,$aloa
 230                 fmuld   $nlo,$na,$nloa
 231                 fmuld   $alo,$bb,$alob
 232                 fmuld   $nlo,$nb,$nlob
 233                 fmuld   $alo,$bc,$aloc
 234         faddd   $aloa,$nloa,$nloa
 235                 fmuld   $nlo,$nc,$nloc
 236                 fmuld   $alo,$bd,$alod
 237         faddd   $alob,$nlob,$nlob
 238                 fmuld   $nlo,$nd,$nlod
 239                 fmuld   $ahi,$ba,$ahia
 240         faddd   $aloc,$nloc,$nloc
 241                 fmuld   $nhi,$na,$nhia
 242                 fmuld   $ahi,$bb,$ahib
 243         faddd   $alod,$nlod,$nlod
 244                 fmuld   $nhi,$nb,$nhib
 245                 fmuld   $ahi,$bc,$ahic
 246         faddd   $ahia,$nhia,$nhia
 247                 fmuld   $nhi,$nc,$nhic
 248                 fmuld   $ahi,$bd,$ahid
 249         faddd   $ahib,$nhib,$nhib
 250                 fmuld   $nhi,$nd,$nhid
 251
 252         faddd   $ahic,$nhic,$dota       ! $nhic
 253         faddd   $ahid,$nhid,$dotb       ! $nhid
 254
 255         faddd   $nloc,$nhia,$nloc
 256         faddd   $nlod,$nhib,$nlod
 257
 258         fdtox   $nloa,$nloa
 259         fdtox   $nlob,$nlob
 260         fdtox   $nloc,$nloc
 261         fdtox   $nlod,$nlod
 262
 263         std     $nloa,[%sp+$bias+$frame+0]
 264         std     $nlob,[%sp+$bias+$frame+8]
 265         std     $nloc,[%sp+$bias+$frame+16]
 266         std     $nlod,[%sp+$bias+$frame+24]
 267         ldx     [%sp+$bias+$frame+0],%o0
 268         ldx     [%sp+$bias+$frame+8],%o1
 269         ldx     [%sp+$bias+$frame+16],%o2
 270         ldx     [%sp+$bias+$frame+24],%o3
 271
 272         srlx    %o0,16,%o7
 273         add     %o7,%o1,%o1
 274         srlx    %o1,16,%o7
 275         add     %o7,%o2,%o2
 276         srlx    %o2,16,%o7
 277         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
 278         !and    %o0,$mask,%o0
 279         !and    %o1,$mask,%o1
 280         !and    %o2,$mask,%o2
 281         !sllx   %o1,16,%o1
 282         !sllx   %o2,32,%o2
 283         !sllx   %o3,48,%o7
 284         !or     %o1,%o0,%o0
 285         !or     %o2,%o0,%o0
 286         !or     %o7,%o0,%o0             ! 64-bit result
 287         srlx    %o3,16,%g1              ! 34-bit carry
 288 \f
 289         add     $j,8,$j
 290         add     $ap,$j,%o4
 291         add     $np,$j,%o5
 292         ld      [%o4+0],$alo_   ! load a[j] as pair of 32-bit words
 293         fzeros  $alo
 294         ld      [%o4+4],$ahi_
 295         fzeros  $ahi
 296         ld      [%o5+0],$nlo_   ! load n[j] as pair of 32-bit words
 297         fzeros  $nlo
 298         ld      [%o5+4],$nhi_
 299         fzeros  $nhi
 300
 301         fxtod   $alo,$alo
 302         fxtod   $ahi,$ahi
 303         fxtod   $nlo,$nlo
 304         fxtod   $nhi,$nhi
 305
 306         std     $alo,[$ap_l+$j]         ! save smashed ap[j] in double format
 307                 fmuld   $alo,$ba,$aloa
 308         std     $ahi,[$ap_h+$j]
 309                 fmuld   $nlo,$na,$nloa
 310         std     $nlo,[$np_l+$j]         ! save smashed np[j] in double format
 311                 fmuld   $alo,$bb,$alob
 312         std     $nhi,[$np_h+$j]
 313                 fmuld   $nlo,$nb,$nlob
 314                 fmuld   $alo,$bc,$aloc
 315         faddd   $aloa,$nloa,$nloa
 316                 fmuld   $nlo,$nc,$nloc
 317                 fmuld   $alo,$bd,$alod
 318         faddd   $alob,$nlob,$nlob
 319                 fmuld   $nlo,$nd,$nlod
 320                 fmuld   $ahi,$ba,$ahia
 321         faddd   $aloc,$nloc,$nloc
 322                 fmuld   $nhi,$na,$nhia
 323                 fmuld   $ahi,$bb,$ahib
 324         faddd   $alod,$nlod,$nlod
 325                 fmuld   $nhi,$nb,$nhib
 326                 fmuld   $ahi,$bc,$ahic
 327         faddd   $ahia,$nhia,$nhia
 328                 fmuld   $nhi,$nc,$nhic
 329                 fmuld   $ahi,$bd,$ahid
 330         faddd   $ahib,$nhib,$nhib
 331                 fmuld   $nhi,$nd,$nhid
 332
 333         faddd   $dota,$nloa,$nloa
 334         faddd   $dotb,$nlob,$nlob
 335         faddd   $ahic,$nhic,$dota       ! $nhic
 336         faddd   $ahid,$nhid,$dotb       ! $nhid
 337
 338         faddd   $nloc,$nhia,$nloc
 339         faddd   $nlod,$nhib,$nlod
 340
 341         fdtox   $nloa,$nloa
 342         fdtox   $nlob,$nlob
 343         fdtox   $nloc,$nloc
 344         fdtox   $nlod,$nlod
 345
 346         std     $nloa,[%sp+$bias+$frame+0]
 347         std     $nlob,[%sp+$bias+$frame+8]
 348         std     $nloc,[%sp+$bias+$frame+16]
 349         std     $nlod,[%sp+$bias+$frame+24]
 350 \f
 351         addcc   $j,8,$j
 352         bz,pn   %icc,.L1stskip
 353 .align  32,0x1000000
 354 .L1st:
 355         ldx     [%sp+$bias+$frame+0],%o0
 356         ldx     [%sp+$bias+$frame+8],%o1
 357         ldx     [%sp+$bias+$frame+16],%o2
 358         ldx     [%sp+$bias+$frame+24],%o3
 359
 360         srlx    %o0,16,%o7
 361         add     %o7,%o1,%o1
 362         srlx    %o1,16,%o7
 363         add     %o7,%o2,%o2
 364         srlx    %o2,16,%o7
 365         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
 366         and     %o0,$mask,%o0
 367         and     %o1,$mask,%o1
 368         and     %o2,$mask,%o2
 369         sllx    %o1,16,%o1
 370         sllx    %o2,32,%o2
 371         sllx    %o3,48,%o7
 372         or      %o1,%o0,%o0
 373         or      %o2,%o0,%o0
 374         or      %o7,%o0,%o0             ! 64-bit result
 375         addcc   %g1,%o0,%o0
 376         srlx    %o3,16,%g1              ! 34-bit carry
 377         bcs,a   %xcc,.+8
 378         add     %g1,1,%g1
 379
 380         stx     %o0,[$tp]               ! tp[j-1]=
 381
 382
 383         add     $ap,$j,%o4
 384         add     $np,$j,%o5
 385         ld      [%o4+0],$alo_   ! load a[j] as pair of 32-bit words
 386         fzeros  $alo
 387         ld      [%o4+4],$ahi_
 388         fzeros  $ahi
 389         ld      [%o5+0],$nlo_   ! load n[j] as pair of 32-bit words
 390         fzeros  $nlo
 391         ld      [%o5+4],$nhi_
 392         fzeros  $nhi
 393
 394         fxtod   $alo,$alo
 395         fxtod   $ahi,$ahi
 396         fxtod   $nlo,$nlo
 397         fxtod   $nhi,$nhi
 398
 399         std     $alo,[$ap_l+$j]         ! save smashed ap[j] in double format
 400                 fmuld   $alo,$ba,$aloa
 401         std     $ahi,[$ap_h+$j]
 402                 fmuld   $nlo,$na,$nloa
 403         std     $nlo,[$np_l+$j]         ! save smashed np[j] in double format
 404                 fmuld   $alo,$bb,$alob
 405         std     $nhi,[$np_h+$j]
 406                 fmuld   $nlo,$nb,$nlob
 407                 fmuld   $alo,$bc,$aloc
 408         faddd   $aloa,$nloa,$nloa
 409                 fmuld   $nlo,$nc,$nloc
 410                 fmuld   $alo,$bd,$alod
 411         faddd   $alob,$nlob,$nlob
 412                 fmuld   $nlo,$nd,$nlod
 413                 fmuld   $ahi,$ba,$ahia
 414         faddd   $aloc,$nloc,$nloc
 415                 fmuld   $nhi,$na,$nhia
 416                 fmuld   $ahi,$bb,$ahib
 417         faddd   $alod,$nlod,$nlod
 418                 fmuld   $nhi,$nb,$nhib
 419                 fmuld   $ahi,$bc,$ahic
 420         faddd   $ahia,$nhia,$nhia
 421                 fmuld   $nhi,$nc,$nhic
 422                 fmuld   $ahi,$bd,$ahid
 423         faddd   $ahib,$nhib,$nhib
 424                 fmuld   $nhi,$nd,$nhid
 425
 426         faddd   $dota,$nloa,$nloa
 427         faddd   $dotb,$nlob,$nlob
 428         faddd   $ahic,$nhic,$dota       ! $nhic
 429         faddd   $ahid,$nhid,$dotb       ! $nhid
 430
 431         faddd   $nloc,$nhia,$nloc
 432         faddd   $nlod,$nhib,$nlod
 433
 434         fdtox   $nloa,$nloa
 435         fdtox   $nlob,$nlob
 436         fdtox   $nloc,$nloc
 437         fdtox   $nlod,$nlod
 438
 439         std     $nloa,[%sp+$bias+$frame+0]
 440         std     $nlob,[%sp+$bias+$frame+8]
 441         std     $nloc,[%sp+$bias+$frame+16]
 442         std     $nlod,[%sp+$bias+$frame+24]
 443
 444         addcc   $j,8,$j
 445         bnz,pt  %icc,.L1st
 446         add     $tp,8,$tp
 447 \f
 448 .L1stskip:
 449         ldx     [%sp+$bias+$frame+0],%o0
 450         ldx     [%sp+$bias+$frame+8],%o1
 451         ldx     [%sp+$bias+$frame+16],%o2
 452         ldx     [%sp+$bias+$frame+24],%o3
 453
 454         srlx    %o0,16,%o7
 455         add     %o7,%o1,%o1
 456         srlx    %o1,16,%o7
 457         add     %o7,%o2,%o2
 458         srlx    %o2,16,%o7
 459         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
 460         and     %o0,$mask,%o0
 461         and     %o1,$mask,%o1
 462         and     %o2,$mask,%o2
 463         sllx    %o1,16,%o1
 464         sllx    %o2,32,%o2
 465         sllx    %o3,48,%o7
 466         or      %o1,%o0,%o0
 467         or      %o2,%o0,%o0
 468         or      %o7,%o0,%o0             ! 64-bit result
 469         addcc   %g1,%o0,%o0
 470         srlx    %o3,16,%g1              ! 34-bit carry
 471         bcs,a   %xcc,.+8
 472         add     %g1,1,%g1
 473
 474         stx     %o0,[$tp]               ! tp[j-1]=
 475         add     $tp,8,$tp
 476 \f
 477         fdtox   $dota,$dota
 478         fdtox   $dotb,$dotb
 479         std     $dota,[%sp+$bias+$frame+32]
 480         std     $dotb,[%sp+$bias+$frame+40]
 481         ldx     [%sp+$bias+$frame+32],%o0
 482         ldx     [%sp+$bias+$frame+40],%o1
 483
 484         srlx    %o0,16,%o7
 485         add     %o7,%o1,%o1
 486         and     %o0,$mask,%o0
 487         sllx    %o1,16,%o7
 488         or      %o7,%o0,%o0
 489         addcc   %g1,%o0,%o0
 490         srlx    %o1,48,%g1
 491         bcs,a   %xcc,.+8
 492         add     %g1,1,%g1
 493
 494         mov     %g1,$carry
 495         stx     %o0,[$tp]               ! tp[num-1]=
 496 \f
 497         ba      .Louter
 498         add     $i,8,$i
 499 .align  32
 500 .Louter:
 501         sub     %g0,$num,$j             ! j=-num
 502         add     %sp,$bias+$frame+$locals,$tp
 503
 504         add     $bp,$i,%o4
 505
 506         ldx     [$bp+$i],%o0            ! bp[i]
 507         ldx     [$ap+$j],%o1            ! ap[0]
 508         sllx    %o0,32,%g1
 509         sllx    %o1,32,%g5
 510         srlx    %o0,32,%o0
 511         srlx    %o1,32,%o1
 512         or      %g1,%o0,%o0
 513         or      %g5,%o1,%o1
 514
 515         ldx     [$tp],%o2               ! tp[0]
 516         mulx    %o1,%o0,%o0
 517         addcc   %o2,%o0,%o0
 518         mulx    $n0,%o0,%o0             ! (ap[0]*bp[i]+t[0])*n0
 519         stx     %o0,[%sp+$bias+$frame+0]
 520
 521         ! transfer b[i] to FPU as 4x16-bit values
 522         ldda    [%o4+2]%asi,$ba
 523         ldda    [%o4+0]%asi,$bb
 524         ldda    [%o4+6]%asi,$bc
 525         ldda    [%o4+4]%asi,$bd
 526
 527         ! transfer (ap[0]*b[i]+t[0])*n0 to FPU as 4x16-bit values
 528         ldda    [%sp+$bias+$frame+6]%asi,$na
 529         fxtod   $ba,$ba
 530         ldda    [%sp+$bias+$frame+4]%asi,$nb
 531         fxtod   $bb,$bb
 532         ldda    [%sp+$bias+$frame+2]%asi,$nc
 533         fxtod   $bc,$bc
 534         ldda    [%sp+$bias+$frame+0]%asi,$nd
 535         fxtod   $bd,$bd
 536         ldd     [$ap_l+$j],$alo         ! load a[j] in double format
 537         fxtod   $na,$na
 538         ldd     [$ap_h+$j],$ahi
 539         fxtod   $nb,$nb
 540         ldd     [$np_l+$j],$nlo         ! load n[j] in double format
 541         fxtod   $nc,$nc
 542         ldd     [$np_h+$j],$nhi
 543         fxtod   $nd,$nd
 544
 545                 fmuld   $alo,$ba,$aloa
 546                 fmuld   $nlo,$na,$nloa
 547                 fmuld   $alo,$bb,$alob
 548                 fmuld   $nlo,$nb,$nlob
 549                 fmuld   $alo,$bc,$aloc
 550         faddd   $aloa,$nloa,$nloa
 551                 fmuld   $nlo,$nc,$nloc
 552                 fmuld   $alo,$bd,$alod
 553         faddd   $alob,$nlob,$nlob
 554                 fmuld   $nlo,$nd,$nlod
 555                 fmuld   $ahi,$ba,$ahia
 556         faddd   $aloc,$nloc,$nloc
 557                 fmuld   $nhi,$na,$nhia
 558                 fmuld   $ahi,$bb,$ahib
 559         faddd   $alod,$nlod,$nlod
 560                 fmuld   $nhi,$nb,$nhib
 561                 fmuld   $ahi,$bc,$ahic
 562         faddd   $ahia,$nhia,$nhia
 563                 fmuld   $nhi,$nc,$nhic
 564                 fmuld   $ahi,$bd,$ahid
 565         faddd   $ahib,$nhib,$nhib
 566                 fmuld   $nhi,$nd,$nhid
 567
 568         faddd   $ahic,$nhic,$dota       ! $nhic
 569         faddd   $ahid,$nhid,$dotb       ! $nhid
 570
 571         faddd   $nloc,$nhia,$nloc
 572         faddd   $nlod,$nhib,$nlod
 573
 574         fdtox   $nloa,$nloa
 575         fdtox   $nlob,$nlob
 576         fdtox   $nloc,$nloc
 577         fdtox   $nlod,$nlod
 578
 579         std     $nloa,[%sp+$bias+$frame+0]
 580         std     $nlob,[%sp+$bias+$frame+8]
 581         std     $nloc,[%sp+$bias+$frame+16]
 582         std     $nlod,[%sp+$bias+$frame+24]
 583         ldx     [%sp+$bias+$frame+0],%o0
 584         ldx     [%sp+$bias+$frame+8],%o1
 585         ldx     [%sp+$bias+$frame+16],%o2
 586         ldx     [%sp+$bias+$frame+24],%o3
 587
 588         srlx    %o0,16,%o7
 589         add     %o7,%o1,%o1
 590         srlx    %o1,16,%o7
 591         add     %o7,%o2,%o2
 592         srlx    %o2,16,%o7
 593         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
 594         ! why?
 595         and     %o0,$mask,%o0
 596         and     %o1,$mask,%o1
 597         and     %o2,$mask,%o2
 598         sllx    %o1,16,%o1
 599         sllx    %o2,32,%o2
 600         sllx    %o3,48,%o7
 601         or      %o1,%o0,%o0
 602         or      %o2,%o0,%o0
 603         or      %o7,%o0,%o0             ! 64-bit result
 604         ldx     [$tp],%o7
 605         addcc   %o7,%o0,%o0
 606         ! end-of-why?
 607         srlx    %o3,16,%g1              ! 34-bit carry
 608         bcs,a   %xcc,.+8
 609         add     %g1,1,%g1
 610 \f
 611         add     $j,8,$j
 612         ldd     [$ap_l+$j],$alo         ! load a[j] in double format
 613         ldd     [$ap_h+$j],$ahi
 614         ldd     [$np_l+$j],$nlo         ! load n[j] in double format
 615         ldd     [$np_h+$j],$nhi
 616
 617                 fmuld   $alo,$ba,$aloa
 618                 fmuld   $nlo,$na,$nloa
 619                 fmuld   $alo,$bb,$alob
 620                 fmuld   $nlo,$nb,$nlob
 621                 fmuld   $alo,$bc,$aloc
 622         faddd   $aloa,$nloa,$nloa
 623                 fmuld   $nlo,$nc,$nloc
 624                 fmuld   $alo,$bd,$alod
 625         faddd   $alob,$nlob,$nlob
 626                 fmuld   $nlo,$nd,$nlod
 627                 fmuld   $ahi,$ba,$ahia
 628         faddd   $aloc,$nloc,$nloc
 629                 fmuld   $nhi,$na,$nhia
 630                 fmuld   $ahi,$bb,$ahib
 631         faddd   $alod,$nlod,$nlod
 632                 fmuld   $nhi,$nb,$nhib
 633                 fmuld   $ahi,$bc,$ahic
 634         faddd   $ahia,$nhia,$nhia
 635                 fmuld   $nhi,$nc,$nhic
 636                 fmuld   $ahi,$bd,$ahid
 637         faddd   $ahib,$nhib,$nhib
 638                 fmuld   $nhi,$nd,$nhid
 639
 640         faddd   $dota,$nloa,$nloa
 641         faddd   $dotb,$nlob,$nlob
 642         faddd   $ahic,$nhic,$dota       ! $nhic
 643         faddd   $ahid,$nhid,$dotb       ! $nhid
 644
 645         faddd   $nloc,$nhia,$nloc
 646         faddd   $nlod,$nhib,$nlod
 647
 648         fdtox   $nloa,$nloa
 649         fdtox   $nlob,$nlob
 650         fdtox   $nloc,$nloc
 651         fdtox   $nlod,$nlod
 652
 653         std     $nloa,[%sp+$bias+$frame+0]
 654         std     $nlob,[%sp+$bias+$frame+8]
 655         std     $nloc,[%sp+$bias+$frame+16]
 656         std     $nlod,[%sp+$bias+$frame+24]
 657 \f
 658         addcc   $j,8,$j
 659         bz,pn   %icc,.Linnerskip
 660 .align  32,0x1000000
 661 .Linner:
 662         ldx     [%sp+$bias+$frame+0],%o0
 663         ldx     [%sp+$bias+$frame+8],%o1
 664         ldx     [%sp+$bias+$frame+16],%o2
 665         ldx     [%sp+$bias+$frame+24],%o3
 666
 667         srlx    %o0,16,%o7
 668         add     %o7,%o1,%o1
 669         srlx    %o1,16,%o7
 670         add     %o7,%o2,%o2
 671         srlx    %o2,16,%o7
 672         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
 673         and     %o0,$mask,%o0
 674         and     %o1,$mask,%o1
 675         and     %o2,$mask,%o2
 676         sllx    %o1,16,%o1
 677         sllx    %o2,32,%o2
 678         sllx    %o3,48,%o7
 679         or      %o1,%o0,%o0
 680         or      %o2,%o0,%o0
 681         or      %o7,%o0,%o0             ! 64-bit result
 682         addcc   %g1,%o0,%o0
 683         srlx    %o3,16,%g1              ! 34-bit carry
 684         bcs,a   %xcc,.+8
 685         add     %g1,1,%g1
 686
 687         ldx     [$tp+8],%o7             ! tp[j]
 688         addcc   %o7,%o0,%o0
 689         bcs,a   %xcc,.+8
 690         add     %g1,1,%g1
 691
 692         stx     %o0,[$tp]               ! tp[j-1]
 693
 694
 695         ldd     [$ap_l+$j],$alo         ! load a[j] in double format
 696         ldd     [$ap_h+$j],$ahi
 697         ldd     [$np_l+$j],$nlo         ! load n[j] in double format
 698         ldd     [$np_h+$j],$nhi
 699
 700                 fmuld   $alo,$ba,$aloa
 701                 fmuld   $nlo,$na,$nloa
 702                 fmuld   $alo,$bb,$alob
 703                 fmuld   $nlo,$nb,$nlob
 704                 fmuld   $alo,$bc,$aloc
 705         faddd   $aloa,$nloa,$nloa
 706                 fmuld   $nlo,$nc,$nloc
 707                 fmuld   $alo,$bd,$alod
 708         faddd   $alob,$nlob,$nlob
 709                 fmuld   $nlo,$nd,$nlod
 710                 fmuld   $ahi,$ba,$ahia
 711         faddd   $aloc,$nloc,$nloc
 712                 fmuld   $nhi,$na,$nhia
 713                 fmuld   $ahi,$bb,$ahib
 714         faddd   $alod,$nlod,$nlod
 715                 fmuld   $nhi,$nb,$nhib
 716                 fmuld   $ahi,$bc,$ahic
 717         faddd   $ahia,$nhia,$nhia
 718                 fmuld   $nhi,$nc,$nhic
 719                 fmuld   $ahi,$bd,$ahid
 720         faddd   $ahib,$nhib,$nhib
 721                 fmuld   $nhi,$nd,$nhid
 722
 723         faddd   $dota,$nloa,$nloa
 724         faddd   $dotb,$nlob,$nlob
 725         faddd   $ahic,$nhic,$dota       ! $nhic
 726         faddd   $ahid,$nhid,$dotb       ! $nhid
 727
 728         faddd   $nloc,$nhia,$nloc
 729         faddd   $nlod,$nhib,$nlod
 730
 731         fdtox   $nloa,$nloa
 732         fdtox   $nlob,$nlob
 733         fdtox   $nloc,$nloc
 734         fdtox   $nlod,$nlod
 735
 736         std     $nloa,[%sp+$bias+$frame+0]
 737         std     $nlob,[%sp+$bias+$frame+8]
 738         std     $nloc,[%sp+$bias+$frame+16]
 739         std     $nlod,[%sp+$bias+$frame+24]
 740
 741         addcc   $j,8,$j
 742         bnz,pt  %icc,.Linner
 743         add     $tp,8,$tp
 744 \f
 745 .Linnerskip:
 746         ldx     [%sp+$bias+$frame+0],%o0
 747         ldx     [%sp+$bias+$frame+8],%o1
 748         ldx     [%sp+$bias+$frame+16],%o2
 749         ldx     [%sp+$bias+$frame+24],%o3
 750
 751         srlx    %o0,16,%o7
 752         add     %o7,%o1,%o1
 753         srlx    %o1,16,%o7
 754         add     %o7,%o2,%o2
 755         srlx    %o2,16,%o7
 756         add     %o7,%o3,%o3             ! %o3.%o2[0..15].%o1[0..15].%o0[0..15]
 757         and     %o0,$mask,%o0
 758         and     %o1,$mask,%o1
 759         and     %o2,$mask,%o2
 760         sllx    %o1,16,%o1
 761         sllx    %o2,32,%o2
 762         sllx    %o3,48,%o7
 763         or      %o1,%o0,%o0
 764         or      %o2,%o0,%o0
 765         or      %o7,%o0,%o0             ! 64-bit result
 766         addcc   %g1,%o0,%o0
 767         srlx    %o3,16,%g1              ! 34-bit carry
 768         bcs,a   %xcc,.+8
 769         add     %g1,1,%g1
 770
 771         ldx     [$tp+8],%o7             ! tp[j]
 772         addcc   %o7,%o0,%o0
 773         bcs,a   %xcc,.+8
 774         add     %g1,1,%g1
 775
 776         stx     %o0,[$tp]               ! tp[j-1]
 777         add     $tp,8,$tp
 778 \f
 779         fdtox   $dota,$dota
 780         fdtox   $dotb,$dotb
 781         std     $dota,[%sp+$bias+$frame+32]
 782         std     $dotb,[%sp+$bias+$frame+40]
 783         ldx     [%sp+$bias+$frame+32],%o0
 784         ldx     [%sp+$bias+$frame+40],%o1
 785
 786         srlx    %o0,16,%o7
 787         add     %o7,%o1,%o1
 788         and     %o0,$mask,%o0
 789         sllx    %o1,16,%o7
 790         or      %o7,%o0,%o0
 791         addcc   %g1,%o0,%o0
 792         srlx    %o1,48,%g1
 793         bcs,a   %xcc,.+8
 794         add     %g1,1,%g1
 795
 796         addcc   $carry,%o0,%o0
 797         stx     %o0,[$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;