Support for .asciz directive in perlasm modules.
[openssl.git] / crypto / perlasm / x86_64-xlate.pl
index c4c9b121debd8a981cfb6bf17a2cd0051799ac70..4370a97b6af2c2552ee7c675b3bb540a07c29589 100755 (executable)
 # 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is
 #    required to identify the spots, where to inject Win64 epilogue!
 #    But on the pros, it's then prefixed with rep automatically:-)
+# 7. Due to MASM limitations [and certain general counter-intuitivity
+#    of ip-relative addressing] generation of position-independent
+#    code is assisted by synthetic directive, .picmeup, which puts
+#    address of the *next* instruction into target register.
+#
+#    Example 1:
+#              .picmeup        %rax
+#              lea             .Label-.(%rax),%rax
+#    Example 2:
+#              .picmeup        %rcx
+#      .Lpic_point:
+#              ...
+#              lea             .Label-.Lpic_point(%rcx),%rbp
 
 my $output = shift;
 open STDOUT,">$output" || die "can't open $output: $!";
@@ -118,7 +131,17 @@ my $current_function;
     }
     sub out {
        my $self = shift;
-       sprintf $masm?"%s":"\$%s",$self->{value};
+
+       if (!$masm) {
+           # Solaris /usr/ccs/bin/as can't handle multiplications
+           # in $self->{value}
+           $self->{value} =~ s/(?<![0-9a-f])(0[x0-9a-f]+)/oct($1)/egi;
+           $self->{value} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg;
+           sprintf "\$%s",$self->{value};
+       } else {
+           $self->{value} =~ s/0x([0-9a-f]+)/0$1h/ig;
+           sprintf "%s",$self->{value};
+       }
     }
 }
 { package ea;          # pick up effective addresses: expr(%reg,%reg,scale)
@@ -134,7 +157,6 @@ my $current_function;
            $ret = $self;
            $line = substr($line,@+[0]); $line =~ s/^\s+//;
 
-           $self->{label} =~ s/\.L/\$L/g;
            $self->{base}  =~ s/^%//;
            $self->{index} =~ s/^%// if (defined($self->{index}));
        }
@@ -145,29 +167,38 @@ my $current_function;
        my $self = shift;
        my $sz = shift;
 
+       # Silently convert all EAs to 64-bit. This is required for
+       # elder GNU assembler and results in more compact code,
+       # *but* most importantly AES module depends on this feature!
+       $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
+       $self->{base}  =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
+
        if (!$masm) {
-           # elder GNU assembler insists on 64-bit EAs:-(
-           # on pros side, this results in more compact code:-)
-           $self->{index} =~ s/^[er](.?[0-9xp])[d]?$/r\1/;
-           $self->{base}  =~ s/^[er](.?[0-9xp])[d]?$/r\1/;
+           # Solaris /usr/ccs/bin/as can't handle multiplications
+           # in $self->{label}
+           $self->{label} =~ s/(?<![0-9a-f])(0[x0-9a-f]+)/oct($1)/egi;
+           $self->{label} =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg;
 
            if (defined($self->{index})) {
-               sprintf "%s(%%%s,%%%s,%d)",     $self->{label},$self->{base},
+               sprintf "%s(%%%s,%%%s,%d)",
+                                       $self->{label},$self->{base},
                                        $self->{index},$self->{scale};
-           }
-           else {
+           } else {
                sprintf "%s(%%%s)",     $self->{label},$self->{base};
            }
        } else {
            %szmap = ( b=>"BYTE", w=>"WORD", l=>"DWORD", q=>"QWORD" );
 
+           $self->{label} =~ s/\./\$/g;
+           $self->{label} =~ s/0x([0-9a-f]+)/0$1h/ig;
+           $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/);
+
            if (defined($self->{index})) {
                sprintf "%s PTR %s[%s*%d+%s]",$szmap{$sz},
                                        $self->{label},
                                        $self->{index},$self->{scale},
                                        $self->{base};
-           }
-           else {
+           } else {
                sprintf "%s PTR %s[%s]",$szmap{$sz},
                                        $self->{label},$self->{base};
            }
@@ -275,13 +306,28 @@ my $current_function;
        local   *line = shift;
        undef   $ret;
        my      $dir;
+       my      %opcode =       # lea 2f-1f(%rip),%dst; 1: nop; 2:
+               (       "%rax"=>0x01058d48,     "%rcx"=>0x010d8d48,
+                       "%rdx"=>0x01158d48,     "%rbx"=>0x011d8d48,
+                       "%rsp"=>0x01258d48,     "%rbp"=>0x012d8d48,
+                       "%rsi"=>0x01358d48,     "%rdi"=>0x013d8d48,
+                       "%r8" =>0x01058d4c,     "%r9" =>0x010d8d4c,
+                       "%r10"=>0x01158d4c,     "%r11"=>0x011d8d4c,
+                       "%r12"=>0x01258d4c,     "%r13"=>0x012d8d4c,
+                       "%r14"=>0x01358d4c,     "%r15"=>0x013d8d4c      );
 
        if ($line =~ /^\s*(\.\w+)/) {
            if (!$masm) {
                $self->{value} = $1;
                $line =~ s/\@abi\-omnipotent/\@function/;
                $line =~ s/\@function.*/\@function/;
-               $self->{value} = $line;
+               if ($line =~ /\.picmeup\s+(%r[\w]+)/i) {
+                   $self->{value} = sprintf "\t.long\t0x%x,0x90000000",$opcode{$1};
+               } elsif ($line =~ /\.asciz\s+"(.*)"$/) {
+                   $self->{value} = ".byte\t".join(",",unpack("C*",$1),0);
+               } else {
+                   $self->{value} = $line;
+               }
                $line = "";
                return $self;
            }
@@ -291,31 +337,30 @@ my $current_function;
            undef $self->{value};
            $line = substr($line,@+[0]); $line =~ s/^\s+//;
            SWITCH: for ($dir) {
-               /\.(text|data)/
+               /\.(text)/
                            && do { my $v=undef;
                                    $v="$current_segment\tENDS\n" if ($current_segment);
-                                   $current_segment = "_$1";
+                                   $current_segment = "_$1\$";
                                    $current_segment =~ tr/[a-z]/[A-Z]/;
-                                   $v.="$current_segment\tSEGMENT PARA";
+                                   $v.="$current_segment\tSEGMENT ALIGN(64) 'CODE'";
                                    $self->{value} = $v;
                                    last;
                                  };
                /\.globl/   && do { $self->{value} = "PUBLIC\t".$line; last; };
                /\.type/    && do { ($sym,$type,$narg) = split(',',$line);
-                                   if ($type eq "\@function")
-                                   {   undef $current_function;
+                                   if ($type eq "\@function") {
+                                       undef $current_function;
                                        $current_function->{name} = $sym;
                                        $current_function->{abi}  = "svr4";
                                        $current_function->{narg} = $narg;
-                                   }
-                                   elsif ($type eq "\@abi-omnipotent")
-                                   {   undef $current_function;
+                                   } elsif ($type eq "\@abi-omnipotent") {
+                                       undef $current_function;
                                        $current_function->{name} = $sym;
                                    }
                                    last;
                                  };
-               /\.size/    && do { if (defined($current_function))
-                                   {   $self->{value}="$current_function->{name}\tENDP";
+               /\.size/    && do { if (defined($current_function)) {
+                                       $self->{value}="$current_function->{name}\tENDP";
                                        undef $current_function;
                                    }
                                    last;
@@ -332,6 +377,15 @@ my $current_function;
                                    $self->{value} .= sprintf"0%Xh",oct($last);
                                    last;
                                  };
+               /\.picmeup/ && do { $self->{value} = sprintf"\tDD\t 0%Xh,090000000h",$opcode{$line};
+                                   last;
+                                 };
+               /\.asciz/   && do { if ($line =~ /^"(.*)"$/) {
+                                       $self->{value} = "DB\t"
+                                               .join(",",unpack("C*",$1),0);
+                                   }
+                                   last;
+                                 };
            }
            $line = "";
        }
@@ -385,13 +439,11 @@ while($line=<>) {
            if (!$masm) {
                printf "\t%s\t%s,%s",   $opcode->out($dst->size()),
                                        $src->out($sz),$dst->out($sz);
-           }
-           else {
+           } else {
                printf "\t%s\t%s,%s",   $opcode->out(),
                                        $dst->out($sz),$src->out($sz);
            }
-       }
-       elsif (defined($src)) {
+       } elsif (defined($src)) {
            printf "\t%s\t%s",$opcode->out(),$src->out($sz);
        } else {
            printf "\t%s",$opcode->out();
@@ -442,7 +494,10 @@ close STDOUT;
 # arguments passed to callee, *but* not less than 4! This means that
 # upon function entry point 5th argument resides at 40(%rsp), as well
 # as that 32 bytes from 8(%rsp) can always be used as temporal
-# storage [without allocating a frame].
+# storage [without allocating a frame]. One can actually argue that
+# one can assume a "red zone" above stack pointer under Win64 as well.
+# Point is that at apparently no occasion Windows kernel would alter
+# the area above user stack pointer in true asynchronous manner...
 #
 # All the above means that if assembler programmer adheres to Unix
 # register and stack layout, but disregards the "red zone" existense,