diff options
Diffstat (limited to 'crypto/perlasm/alpha.pl')
-rw-r--r-- | crypto/perlasm/alpha.pl | 434 |
1 files changed, 0 insertions, 434 deletions
diff --git a/crypto/perlasm/alpha.pl b/crypto/perlasm/alpha.pl deleted file mode 100644 index 3dac571..0000000 --- a/crypto/perlasm/alpha.pl +++ /dev/null @@ -1,434 +0,0 @@ -#!/usr/local/bin/perl - -package alpha; -use Carp qw(croak cluck); - -$label="100"; - -$n_debug=0; -$smear_regs=1; -$reg_alloc=1; - -$align="3"; -$com_start="#"; - -sub main'asm_init_output { @out=(); } -sub main'asm_get_output { return(@out); } -sub main'get_labels { return(@labels); } -sub main'external_label { push(@labels,@_); } - -# General registers - -%regs=( 'r0', '$0', - 'r1', '$1', - 'r2', '$2', - 'r3', '$3', - 'r4', '$4', - 'r5', '$5', - 'r6', '$6', - 'r7', '$7', - 'r8', '$8', - 'r9', '$22', - 'r10', '$23', - 'r11', '$24', - 'r12', '$25', - 'r13', '$27', - 'r14', '$28', - 'r15', '$21', # argc == 5 - 'r16', '$20', # argc == 4 - 'r17', '$19', # argc == 3 - 'r18', '$18', # argc == 2 - 'r19', '$17', # argc == 1 - 'r20', '$16', # argc == 0 - 'r21', '$9', # save 0 - 'r22', '$10', # save 1 - 'r23', '$11', # save 2 - 'r24', '$12', # save 3 - 'r25', '$13', # save 4 - 'r26', '$14', # save 5 - - 'a0', '$16', - 'a1', '$17', - 'a2', '$18', - 'a3', '$19', - 'a4', '$20', - 'a5', '$21', - - 's0', '$9', - 's1', '$10', - 's2', '$11', - 's3', '$12', - 's4', '$13', - 's5', '$14', - 'zero', '$31', - 'sp', '$30', - ); - -$main'reg_s0="r21"; -$main'reg_s1="r22"; -$main'reg_s2="r23"; -$main'reg_s3="r24"; -$main'reg_s4="r25"; -$main'reg_s5="r26"; - -@reg=( '$0', '$1' ,'$2' ,'$3' ,'$4' ,'$5' ,'$6' ,'$7' ,'$8', - '$22','$23','$24','$25','$20','$21','$27','$28'); - - -sub main'sub { &out3("subq",@_); } -sub main'add { &out3("addq",@_); } -sub main'mov { &out3("bis",$_[0],$_[0],$_[1]); } -sub main'or { &out3("bis",@_); } -sub main'bis { &out3("bis",@_); } -sub main'br { &out1("br",@_); } -sub main'ld { &out2("ldq",@_); } -sub main'st { &out2("stq",@_); } -sub main'cmpult { &out3("cmpult",@_); } -sub main'cmplt { &out3("cmplt",@_); } -sub main'bgt { &out2("bgt",@_); } -sub main'ble { &out2("ble",@_); } -sub main'blt { &out2("blt",@_); } -sub main'mul { &out3("mulq",@_); } -sub main'muh { &out3("umulh",@_); } - -$main'QWS=8; - -sub main'asm_add - { - push(@out,@_); - } - -sub main'asm_finish - { - &main'file_end(); - print &main'asm_get_output(); - } - -sub main'asm_init - { - ($type,$fn)=@_; - $filename=$fn; - - &main'asm_init_output(); - &main'comment("Don't even think of reading this code"); - &main'comment("It was automatically generated by $filename"); - &main'comment("Which is a perl program used to generate the alpha assember."); - &main'comment("eric <eay\@cryptsoft.com>"); - &main'comment(""); - - $filename =~ s/\.pl$//; - &main'file($filename); - } - -sub conv - { - local($r)=@_; - local($v); - - return($regs{$r}) if defined($regs{$r}); - return($r); - } - -sub main'QWPw - { - local($off,$reg)=@_; - - return(&main'QWP($off*8,$reg)); - } - -sub main'QWP - { - local($off,$reg)=@_; - - $ret="$off(".&conv($reg).")"; - return($ret); - } - -sub out3 - { - local($name,$p1,$p2,$p3)=@_; - - $p1=&conv($p1); - $p2=&conv($p2); - $p3=&conv($p3); - push(@out,"\t$name\t"); - $l=length($p1)+1; - push(@out,$p1.","); - $ll=3-($l+9)/8; - $tmp1=sprintf("\t" x $ll); - push(@out,$tmp1); - - $l=length($p2)+1; - push(@out,$p2.","); - $ll=3-($l+9)/8; - $tmp1=sprintf("\t" x $ll); - push(@out,$tmp1); - - push(@out,&conv($p3)."\n"); - } - -sub out2 - { - local($name,$p1,$p2,$p3)=@_; - - $p1=&conv($p1); - $p2=&conv($p2); - push(@out,"\t$name\t"); - $l=length($p1)+1; - push(@out,$p1.","); - $ll=3-($l+9)/8; - $tmp1=sprintf("\t" x $ll); - push(@out,$tmp1); - - push(@out,&conv($p2)."\n"); - } - -sub out1 - { - local($name,$p1)=@_; - - $p1=&conv($p1); - push(@out,"\t$name\t".$p1."\n"); - } - -sub out0 - { - push(@out,"\t$_[0]\n"); - } - -sub main'file - { - local($file)=@_; - - local($tmp)=<<"EOF"; - # DEC Alpha assember - # Generated from perl scripts contains in SSLeay - .file 1 "$file.s" - .set noat -EOF - push(@out,$tmp); - } - -sub main'function_begin - { - local($func)=@_; - -print STDERR "$func\n"; - local($tmp)=<<"EOF"; - .text - .align $align - .globl $func - .ent $func -${func}: -${func}..ng: - .frame \$30,0,\$26,0 - .prologue 0 -EOF - push(@out,$tmp); - $stack=0; - } - -sub main'function_end - { - local($func)=@_; - - local($tmp)=<<"EOF"; - ret \$31,(\$26),1 - .end $func -EOF - push(@out,$tmp); - $stack=0; - %label=(); - } - -sub main'function_end_A - { - local($func)=@_; - - local($tmp)=<<"EOF"; - ret \$31,(\$26),1 -EOF - push(@out,$tmp); - } - -sub main'function_end_B - { - local($func)=@_; - - $func=$under.$func; - - push(@out,"\t.end $func\n"); - $stack=0; - %label=(); - } - -sub main'wparam - { - local($num)=@_; - - if ($num < 6) - { - $num=20-$num; - return("r$num"); - } - else - { return(&main'QWP($stack+$num*8,"sp")); } - } - -sub main'stack_push - { - local($num)=@_; - $stack+=$num*8; - &main'sub("sp",$num*8,"sp"); - } - -sub main'stack_pop - { - local($num)=@_; - $stack-=$num*8; - &main'add("sp",$num*8,"sp"); - } - -sub main'swtmp - { - return(&main'QWP(($_[0])*8,"sp")); - } - -# Should use swtmp, which is above sp. Linix can trash the stack above esp -#sub main'wtmp -# { -# local($num)=@_; -# -# return(&main'QWP(-($num+1)*4,"esp","",0)); -# } - -sub main'comment - { - foreach (@_) - { - if (/^\s*$/) - { push(@out,"\n"); } - else - { push(@out,"\t$com_start $_ $com_end\n"); } - } - } - -sub main'label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}=$label; - $label++; - } - return('$'.$label{$_[0]}); - } - -sub main'set_label - { - if (!defined($label{$_[0]})) - { - $label{$_[0]}=$label; - $label++; - } -# push(@out,".align $align\n") if ($_[1] != 0); - push(@out,'$'."$label{$_[0]}:\n"); - } - -sub main'file_end - { - } - -sub main'data_word - { - push(@out,"\t.long $_[0]\n"); - } - -@pool_free=(); -@pool_taken=(); -$curr_num=0; -$max=0; - -sub main'init_pool - { - local($args)=@_; - local($i); - - @pool_free=(); - for ($i=(14+(6-$args)); $i >= 0; $i--) - { - push(@pool_free,"r$i"); - } - print STDERR "START :register pool:@pool_free\n"; - $curr_num=$max=0; - } - -sub main'fin_pool - { - printf STDERR "END %2d:register pool:@pool_free\n",$max; - } - -sub main'GR - { - local($r)=@_; - local($i,@n,$_); - - foreach (@pool_free) - { - if ($r ne $_) - { push(@n,$_); } - else - { - $curr_num++; - $max=$curr_num if ($curr_num > $max); - } - } - @pool_free=@n; -print STDERR "GR:@pool_free\n" if $reg_alloc; - return(@_); - } - -sub main'NR - { - local($num)=@_; - local(@ret); - - $num=1 if $num == 0; - ($#pool_free >= ($num-1)) || croak "out of registers: want $num, have @pool_free"; - while ($num > 0) - { - push(@ret,pop @pool_free); - $curr_num++; - $max=$curr_num if ($curr_num > $max); - $num-- - } - print STDERR "nr @ret\n" if $n_debug; -print STDERR "NR:@pool_free\n" if $reg_alloc; - return(@ret); - - } - -sub main'FR - { - local(@r)=@_; - local(@a,$v,$w); - - print STDERR "fr @r\n" if $n_debug; -# cluck "fr @r"; - for $w (@pool_free) - { - foreach $v (@r) - { - croak "double register free of $v (@pool_free)" if $w eq $v; - } - } - foreach $v (@r) - { - croak "bad argument to FR" if ($v !~ /^r\d+$/); - if ($smear_regs) - { unshift(@pool_free,$v); } - else { push(@pool_free,$v); } - $curr_num--; - } -print STDERR "FR:@pool_free\n" if $reg_alloc; - } -1; |