2
0

arm-xlate.pl 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214
  1. #! /usr/bin/env perl
  2. # Copyright 2015-2023 The OpenSSL Project Authors. All Rights Reserved.
  3. #
  4. # Licensed under the Apache License 2.0 (the "License"). You may not use
  5. # this file except in compliance with the License. You can obtain a copy
  6. # in the file LICENSE in the source distribution or at
  7. # https://www.openssl.org/source/license.html
  8. use strict;
  9. my $flavour = shift;
  10. my $output = shift;
  11. open STDOUT,">$output" || die "can't open $output: $!";
  12. $flavour = "linux32" if (!$flavour or $flavour eq "void");
  13. my %GLOBALS;
  14. my $dotinlocallabels=($flavour=~/linux/)?1:0;
  15. ################################################################
  16. # directives which need special treatment on different platforms
  17. ################################################################
  18. my $arch = sub {
  19. if ($flavour =~ /linux/) { ".arch\t".join(',',@_); }
  20. elsif ($flavour =~ /win64/) { ".arch\t".join(',',@_); }
  21. else { ""; }
  22. };
  23. my $fpu = sub {
  24. if ($flavour =~ /linux/) { ".fpu\t".join(',',@_); }
  25. else { ""; }
  26. };
  27. my $rodata = sub {
  28. SWITCH: for ($flavour) {
  29. /linux/ && return ".section\t.rodata";
  30. /ios/ && return ".section\t__TEXT,__const";
  31. last;
  32. }
  33. };
  34. my $hidden = sub {
  35. if ($flavour =~ /ios/) { ".private_extern\t".join(',',@_); }
  36. elsif ($flavour =~ /win64/) { ""; }
  37. else { ".hidden\t".join(',',@_); }
  38. };
  39. my $comm = sub {
  40. my @args = split(/,\s*/,shift);
  41. my $name = @args[0];
  42. my $global = \$GLOBALS{$name};
  43. my $ret;
  44. if ($flavour =~ /ios32/) {
  45. $ret = ".comm\t_$name,@args[1]\n";
  46. $ret .= ".non_lazy_symbol_pointer\n";
  47. $ret .= "$name:\n";
  48. $ret .= ".indirect_symbol\t_$name\n";
  49. $ret .= ".long\t0";
  50. $name = "_$name";
  51. } else { $ret = ".comm\t".join(',',@args); }
  52. $$global = $name;
  53. $ret;
  54. };
  55. my $globl = sub {
  56. my $name = shift;
  57. my $global = \$GLOBALS{$name};
  58. my $ret;
  59. SWITCH: for ($flavour) {
  60. /ios/ && do { $name = "_$name";
  61. last;
  62. };
  63. }
  64. $ret = ".globl $name" if (!$ret);
  65. $$global = $name;
  66. $ret;
  67. };
  68. my $global = $globl;
  69. my $extern = sub {
  70. &$globl(@_);
  71. return; # return nothing
  72. };
  73. my $type = sub {
  74. if ($flavour =~ /linux/) { ".type\t".join(',',@_); }
  75. elsif ($flavour =~ /ios32/) { if (join(',',@_) =~ /(\w+),%function/) {
  76. "#ifdef __thumb2__\n".
  77. ".thumb_func $1\n".
  78. "#endif";
  79. }
  80. }
  81. elsif ($flavour =~ /win64/) { if (join(',',@_) =~ /(\w+),%function/) {
  82. # See https://sourceware.org/binutils/docs/as/Pseudo-Ops.html
  83. # Per https://docs.microsoft.com/en-us/windows/win32/debug/pe-format#coff-symbol-table,
  84. # the type for functions is 0x20, or 32.
  85. ".def $1\n".
  86. " .type 32\n".
  87. ".endef";
  88. }
  89. }
  90. else { ""; }
  91. };
  92. my $size = sub {
  93. if ($flavour =~ /linux/) { ".size\t".join(',',@_); }
  94. else { ""; }
  95. };
  96. my $inst = sub {
  97. if ($flavour =~ /linux/) { ".inst\t".join(',',@_); }
  98. else { ".long\t".join(',',@_); }
  99. };
  100. my $asciz = sub {
  101. my $line = join(",",@_);
  102. if ($line =~ /^"(.*)"$/)
  103. { ".byte " . join(",",unpack("C*",$1),0) . "\n.align 2"; }
  104. else
  105. { ""; }
  106. };
  107. my $adrp = sub {
  108. my ($args,$comment) = split(m|\s*//|,shift);
  109. "\tadrp\t$args\@PAGE";
  110. } if ($flavour =~ /ios64/);
  111. sub range {
  112. my ($r,$sfx,$start,$end) = @_;
  113. join(",",map("$r$_$sfx",($start..$end)));
  114. }
  115. sub expand_line {
  116. my $line = shift;
  117. my @ret = ();
  118. pos($line)=0;
  119. while ($line =~ m/\G[^@\/\{\"]*/g) {
  120. if ($line =~ m/\G(@|\/\/|$)/gc) {
  121. last;
  122. }
  123. elsif ($line =~ m/\G\{/gc) {
  124. my $saved_pos = pos($line);
  125. $line =~ s/\G([rdqv])([0-9]+)([^\-]*)\-\1([0-9]+)\3/range($1,$3,$2,$4)/e;
  126. pos($line) = $saved_pos;
  127. $line =~ m/\G[^\}]*\}/g;
  128. }
  129. elsif ($line =~ m/\G\"/gc) {
  130. $line =~ m/\G[^\"]*\"/g;
  131. }
  132. }
  133. $line =~ s/\b(\w+)/$GLOBALS{$1} or $1/ge;
  134. if ($flavour =~ /ios64/) {
  135. $line =~ s/#:lo12:(\w+)/$1\@PAGEOFF/;
  136. }
  137. return $line;
  138. }
  139. while(my $line=<>) {
  140. if ($line =~ m/^\s*(#|@|\/\/)/) { print $line; next; }
  141. $line =~ s|/\*.*\*/||; # get rid of C-style comments...
  142. $line =~ s|^\s+||; # ... and skip whitespace in beginning...
  143. $line =~ s|\s+$||; # ... and at the end
  144. {
  145. $line =~ s|[\b\.]L(\w{2,})|L$1|g; # common denominator for Locallabel
  146. $line =~ s|\bL(\w{2,})|\.L$1|g if ($dotinlocallabels);
  147. }
  148. {
  149. if ($line =~ s|(^[\.\w]+)\:\s*||) {
  150. my $label = $1;
  151. printf "%s:",($GLOBALS{$label} or $label);
  152. }
  153. }
  154. if ($line !~ m/^[#@]/) {
  155. $line =~ s|^\s*(\.?)(\S+)\s*||;
  156. my $c = $1; $c = "\t" if ($c eq "");
  157. my $mnemonic = $2;
  158. my $opcode;
  159. if ($mnemonic =~ m/([^\.]+)\.([^\.]+)/) {
  160. $opcode = eval("\$$1_$2");
  161. } else {
  162. $opcode = eval("\$$mnemonic");
  163. }
  164. my $arg=expand_line($line);
  165. if (ref($opcode) eq 'CODE') {
  166. $line = &$opcode($arg);
  167. } elsif ($mnemonic) {
  168. $line = $c.$mnemonic;
  169. $line.= "\t$arg" if ($arg ne "");
  170. }
  171. }
  172. # ldr REG, #VALUE psuedo-instruction - avoid clang issue with Neon registers
  173. #
  174. if ($line =~ /^\s*ldr\s+([qd]\d\d?)\s*,\s*=(\w+)/i) {
  175. # Immediate load via literal pool into qN or DN - clang max is 2^32-1
  176. my ($reg, $value) = ($1, $2);
  177. # If $value is hex, 0x + 8 hex chars = 10 chars total will be okay
  178. # If $value is decimal, 2^32 - 1 = 4294967295 will be okay (also 10 chars)
  179. die("$line: immediate load via literal pool into $reg: value too large for clang - redo manually") if length($value) > 10;
  180. }
  181. print $line if ($line);
  182. print "\n";
  183. }
  184. close STDOUT or die "error closing STDOUT: $!";