freeswan/libcrypto/perlasm/alpha.pl

   1 #!/usr/local/bin/perl
   2
   3 package alpha;
   4 use Carp qw(croak cluck);
   5
   6 $label="100";
   7
   8 $n_debug=0;
   9 $smear_regs=1;
  10 $reg_alloc=1;
  11
  12 $align="3";
  13 $com_start="#";
  14
  15 sub main'asm_init_output { @out=(); }
  16 sub main'asm_get_output { return(@out); }
  17 sub main'get_labels { return(@labels); }
  18 sub main'external_label { push(@labels,@_); }
  19
  20 # General registers
  21
  22 %regs=( 'r0',   '$0',
  23         'r1',   '$1',
  24         'r2',   '$2',
  25         'r3',   '$3',
  26         'r4',   '$4',
  27         'r5',   '$5',
  28         'r6',   '$6',
  29         'r7',   '$7',
  30         'r8',   '$8',
  31         'r9',   '$22',
  32         'r10',  '$23',
  33         'r11',  '$24',
  34         'r12',  '$25',
  35         'r13',  '$27',
  36         'r14',  '$28',
  37         'r15',  '$21', # argc == 5
  38         'r16',  '$20', # argc == 4
  39         'r17',  '$19', # argc == 3
  40         'r18',  '$18', # argc == 2
  41         'r19',  '$17', # argc == 1
  42         'r20',  '$16', # argc == 0
  43         'r21',  '$9',  # save 0
  44         'r22',  '$10', # save 1
  45         'r23',  '$11', # save 2
  46         'r24',  '$12', # save 3
  47         'r25',  '$13', # save 4
  48         'r26',  '$14', # save 5
  49
  50         'a0',   '$16',
  51         'a1',   '$17',
  52         'a2',   '$18',
  53         'a3',   '$19',
  54         'a4',   '$20',
  55         'a5',   '$21',
  56
  57         's0',   '$9',
  58         's1',   '$10',
  59         's2',   '$11',
  60         's3',   '$12',
  61         's4',   '$13',
  62         's5',   '$14',
  63         'zero', '$31',
  64         'sp',   '$30',
  65         );
  66
  67 $main'reg_s0="r21";
  68 $main'reg_s1="r22";
  69 $main'reg_s2="r23";
  70 $main'reg_s3="r24";
  71 $main'reg_s4="r25";
  72 $main'reg_s5="r26";
  73
  74 @reg=(  '$0', '$1' ,'$2' ,'$3' ,'$4' ,'$5' ,'$6' ,'$7' ,'$8',
  75         '$22','$23','$24','$25','$20','$21','$27','$28');
  76
  77
  78 sub main'sub    { &out3("subq",@_); }
  79 sub main'add    { &out3("addq",@_); }
  80 sub main'mov    { &out3("bis",$_[0],$_[0],$_[1]); }
  81 sub main'or     { &out3("bis",@_); }
  82 sub main'bis    { &out3("bis",@_); }
  83 sub main'br     { &out1("br",@_); }
  84 sub main'ld     { &out2("ldq",@_); }
  85 sub main'st     { &out2("stq",@_); }
  86 sub main'cmpult { &out3("cmpult",@_); }
  87 sub main'cmplt  { &out3("cmplt",@_); }
  88 sub main'bgt    { &out2("bgt",@_); }
  89 sub main'ble    { &out2("ble",@_); }
  90 sub main'blt    { &out2("blt",@_); }
  91 sub main'mul    { &out3("mulq",@_); }
  92 sub main'muh    { &out3("umulh",@_); }
  93
  94 $main'QWS=8;
  95
  96 sub main'asm_add
  97         {
  98         push(@out,@_);
  99         }
 100
 101 sub main'asm_finish
 102         {
 103         &main'file_end();
 104         print &main'asm_get_output();
 105         }
 106
 107 sub main'asm_init
 108         {
 109         ($type,$fn)=@_;
 110         $filename=$fn;
 111
 112         &main'asm_init_output();
 113         &main'comment("Don't even think of reading this code");
 114         &main'comment("It was automatically generated by $filename");
 115         &main'comment("Which is a perl program used to generate the alpha assember.");
 116         &main'comment("eric <eay\@cryptsoft.com>");
 117         &main'comment("");
 118
 119         $filename =~ s/\.pl$//;
 120         &main'file($filename);
 121         }
 122
 123 sub conv
 124         {
 125         local($r)=@_;
 126         local($v);
 127
 128         return($regs{$r}) if defined($regs{$r});
 129         return($r);
 130         }
 131
 132 sub main'QWPw
 133         {
 134         local($off,$reg)=@_;
 135
 136         return(&main'QWP($off*8,$reg));
 137         }
 138
 139 sub main'QWP
 140         {
 141         local($off,$reg)=@_;
 142
 143         $ret="$off(".&conv($reg).")";
 144         return($ret);
 145         }
 146
 147 sub out3
 148         {
 149         local($name,$p1,$p2,$p3)=@_;
 150
 151         $p1=&conv($p1);
 152         $p2=&conv($p2);
 153         $p3=&conv($p3);
 154         push(@out,"\t$name\t");
 155         $l=length($p1)+1;
 156         push(@out,$p1.",");
 157         $ll=3-($l+9)/8;
 158         $tmp1=sprintf("\t" x $ll);
 159         push(@out,$tmp1);
 160
 161         $l=length($p2)+1;
 162         push(@out,$p2.",");
 163         $ll=3-($l+9)/8;
 164         $tmp1=sprintf("\t" x $ll);
 165         push(@out,$tmp1);
 166
 167         push(@out,&conv($p3)."\n");
 168         }
 169
 170 sub out2
 171         {
 172         local($name,$p1,$p2,$p3)=@_;
 173
 174         $p1=&conv($p1);
 175         $p2=&conv($p2);
 176         push(@out,"\t$name\t");
 177         $l=length($p1)+1;
 178         push(@out,$p1.",");
 179         $ll=3-($l+9)/8;
 180         $tmp1=sprintf("\t" x $ll);
 181         push(@out,$tmp1);
 182
 183         push(@out,&conv($p2)."\n");
 184         }
 185
 186 sub out1
 187         {
 188         local($name,$p1)=@_;
 189
 190         $p1=&conv($p1);
 191         push(@out,"\t$name\t".$p1."\n");
 192         }
 193
 194 sub out0
 195         {
 196         push(@out,"\t$_[0]\n");
 197         }
 198
 199 sub main'file
 200         {
 201         local($file)=@_;
 202
 203         local($tmp)=<<"EOF";
 204  # DEC Alpha assember
 205  # Generated from perl scripts contains in SSLeay
 206         .file   1 "$file.s"
 207         .set noat
 208 EOF
 209         push(@out,$tmp);
 210         }
 211
 212 sub main'function_begin
 213         {
 214         local($func)=@_;
 215
 216 print STDERR "$func\n";
 217         local($tmp)=<<"EOF";
 218         .text
 219         .align $align
 220         .globl $func
 221         .ent $func
 222 ${func}:
 223 ${func}..ng:
 224         .frame \$30,0,\$26,0
 225         .prologue 0
 226 EOF
 227         push(@out,$tmp);
 228         $stack=0;
 229         }
 230
 231 sub main'function_end
 232         {
 233         local($func)=@_;
 234
 235         local($tmp)=<<"EOF";
 236         ret     \$31,(\$26),1
 237         .end $func
 238 EOF
 239         push(@out,$tmp);
 240         $stack=0;
 241         %label=();
 242         }
 243
 244 sub main'function_end_A
 245         {
 246         local($func)=@_;
 247
 248         local($tmp)=<<"EOF";
 249         ret     \$31,(\$26),1
 250 EOF
 251         push(@out,$tmp);
 252         }
 253
 254 sub main'function_end_B
 255         {
 256         local($func)=@_;
 257
 258         $func=$under.$func;
 259
 260         push(@out,"\t.end $func\n");
 261         $stack=0;
 262         %label=();
 263         }
 264
 265 sub main'wparam
 266         {
 267         local($num)=@_;
 268
 269         if ($num < 6)
 270                 {
 271                 $num=20-$num;
 272                 return("r$num");
 273                 }
 274         else
 275                 { return(&main'QWP($stack+$num*8,"sp")); }
 276         }
 277
 278 sub main'stack_push
 279         {
 280         local($num)=@_;
 281         $stack+=$num*8;
 282         &main'sub("sp",$num*8,"sp");
 283         }
 284
 285 sub main'stack_pop
 286         {
 287         local($num)=@_;
 288         $stack-=$num*8;
 289         &main'add("sp",$num*8,"sp");
 290         }
 291
 292 sub main'swtmp
 293         {
 294         return(&main'QWP(($_[0])*8,"sp"));
 295         }
 296
 297 # Should use swtmp, which is above sp.  Linix can trash the stack above esp
 298 #sub main'wtmp
 299 #       {
 300 #       local($num)=@_;
 301 #
 302 #       return(&main'QWP(-($num+1)*4,"esp","",0));
 303 #       }
 304
 305 sub main'comment
 306         {
 307         foreach (@_)
 308                 {
 309                 if (/^\s*$/)
 310                         { push(@out,"\n"); }
 311                 else
 312                         { push(@out,"\t$com_start $_ $com_end\n"); }
 313                 }
 314         }
 315
 316 sub main'label
 317         {
 318         if (!defined($label{$_[0]}))
 319                 {
 320                 $label{$_[0]}=$label;
 321                 $label++;
 322                 }
 323         return('$'.$label{$_[0]});
 324         }
 325
 326 sub main'set_label
 327         {
 328         if (!defined($label{$_[0]}))
 329                 {
 330                 $label{$_[0]}=$label;
 331                 $label++;
 332                 }
 333 #       push(@out,".align $align\n") if ($_[1] != 0);
 334         push(@out,'$'."$label{$_[0]}:\n");
 335         }
 336
 337 sub main'file_end
 338         {
 339         }
 340
 341 sub main'data_word
 342         {
 343         push(@out,"\t.long $_[0]\n");
 344         }
 345
 346 @pool_free=();
 347 @pool_taken=();
 348 $curr_num=0;
 349 $max=0;
 350
 351 sub main'init_pool
 352         {
 353         local($args)=@_;
 354         local($i);
 355
 356         @pool_free=();
 357         for ($i=(14+(6-$args)); $i >= 0; $i--)
 358                 {
 359                 push(@pool_free,"r$i");
 360                 }
 361         print STDERR "START :register pool:@pool_free\n";
 362         $curr_num=$max=0;
 363         }
 364
 365 sub main'fin_pool
 366         {
 367         printf STDERR "END %2d:register pool:@pool_free\n",$max;
 368         }
 369
 370 sub main'GR
 371         {
 372         local($r)=@_;
 373         local($i,@n,$_);
 374
 375         foreach (@pool_free)
 376                 {
 377                 if ($r ne $_)
 378                         { push(@n,$_); }
 379                 else
 380                         {
 381                         $curr_num++;
 382                         $max=$curr_num if ($curr_num > $max);
 383                         }
 384                 }
 385         @pool_free=@n;
 386 print STDERR "GR:@pool_free\n" if $reg_alloc;
 387         return(@_);
 388         }
 389
 390 sub main'NR
 391         {
 392         local($num)=@_;
 393         local(@ret);
 394
 395         $num=1 if $num == 0;
 396         ($#pool_free >= ($num-1)) || croak "out of registers: want $num, have @pool_free";
 397         while ($num > 0)
 398                 {
 399                 push(@ret,pop @pool_free);
 400                 $curr_num++;
 401                 $max=$curr_num if ($curr_num > $max);
 402                 $num--
 403                 }
 404         print STDERR "nr @ret\n" if $n_debug;
 405 print STDERR "NR:@pool_free\n" if $reg_alloc;
 406         return(@ret);
 407
 408         }
 409
 410 sub main'FR
 411         {
 412         local(@r)=@_;
 413         local(@a,$v,$w);
 414
 415         print STDERR "fr @r\n" if $n_debug;
 416 #       cluck "fr @r";
 417         for $w (@pool_free)
 418                 {
 419                 foreach $v (@r)
 420                         {
 421                         croak "double register free of $v (@pool_free)" if $w eq $v;
 422                         }
 423                 }
 424         foreach $v (@r)
 425                 {
 426                 croak "bad argument to FR" if ($v !~ /^r\d+$/);
 427                 if ($smear_regs)
 428                         { unshift(@pool_free,$v); }
 429                 else    { push(@pool_free,$v); }
 430                 $curr_num--;
 431                 }
 432 print STDERR "FR:@pool_free\n" if $reg_alloc;
 433         }
 434 1;