2
0

x86_64-xlate.pl 45 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497
  1. #! /usr/bin/env perl
  2. # Copyright 2005-2022 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. # Ascetic x86_64 AT&T to MASM/NASM assembler translator by <appro>.
  9. #
  10. # Why AT&T to MASM and not vice versa? Several reasons. Because AT&T
  11. # format is way easier to parse. Because it's simpler to "gear" from
  12. # Unix ABI to Windows one [see cross-reference "card" at the end of
  13. # file]. Because Linux targets were available first...
  14. #
  15. # In addition the script also "distills" code suitable for GNU
  16. # assembler, so that it can be compiled with more rigid assemblers,
  17. # such as Solaris /usr/ccs/bin/as.
  18. #
  19. # This translator is not designed to convert *arbitrary* assembler
  20. # code from AT&T format to MASM one. It's designed to convert just
  21. # enough to provide for dual-ABI OpenSSL modules development...
  22. # There *are* limitations and you might have to modify your assembler
  23. # code or this script to achieve the desired result...
  24. #
  25. # Currently recognized limitations:
  26. #
  27. # - can't use multiple ops per line;
  28. #
  29. # Dual-ABI styling rules.
  30. #
  31. # 1. Adhere to Unix register and stack layout [see cross-reference
  32. # ABI "card" at the end for explanation].
  33. # 2. Forget about "red zone," stick to more traditional blended
  34. # stack frame allocation. If volatile storage is actually required
  35. # that is. If not, just leave the stack as is.
  36. # 3. Functions tagged with ".type name,@function" get crafted with
  37. # unified Win64 prologue and epilogue automatically. If you want
  38. # to take care of ABI differences yourself, tag functions as
  39. # ".type name,@abi-omnipotent" instead.
  40. # 4. To optimize the Win64 prologue you can specify number of input
  41. # arguments as ".type name,@function,N." Keep in mind that if N is
  42. # larger than 6, then you *have to* write "abi-omnipotent" code,
  43. # because >6 cases can't be addressed with unified prologue.
  44. # 5. Name local labels as .L*, do *not* use dynamic labels such as 1:
  45. # (sorry about latter).
  46. # 6. Don't use [or hand-code with .byte] "rep ret." "ret" mnemonic is
  47. # required to identify the spots, where to inject Win64 epilogue!
  48. # But on the pros, it's then prefixed with rep automatically:-)
  49. # 7. Stick to explicit ip-relative addressing. If you have to use
  50. # GOTPCREL addressing, stick to mov symbol@GOTPCREL(%rip),%r??.
  51. # Both are recognized and translated to proper Win64 addressing
  52. # modes.
  53. #
  54. # 8. In order to provide for structured exception handling unified
  55. # Win64 prologue copies %rsp value to %rax. For further details
  56. # see SEH paragraph at the end.
  57. # 9. .init segment is allowed to contain calls to functions only.
  58. # a. If function accepts more than 4 arguments *and* >4th argument
  59. # is declared as non 64-bit value, do clear its upper part.
  60. use strict;
  61. my $flavour = shift;
  62. my $output = shift;
  63. if ($flavour =~ /\./) { $output = $flavour; undef $flavour; }
  64. open STDOUT,">$output" || die "can't open $output: $!"
  65. if (defined($output));
  66. my $gas=1; $gas=0 if ($output =~ /\.asm$/);
  67. my $elf=1; $elf=0 if (!$gas);
  68. my $win64=0;
  69. my $prefix="";
  70. my $decor=".L";
  71. my $masmref=8 + 50727*2**-32; # 8.00.50727 shipped with VS2005
  72. my $masm=0;
  73. my $PTR=" PTR";
  74. my $nasmref=2.03;
  75. my $nasm=0;
  76. # GNU as indicator, as opposed to $gas, which indicates acceptable
  77. # syntax
  78. my $gnuas=0;
  79. if ($flavour eq "mingw64") { $gas=1; $elf=0; $win64=1;
  80. $prefix=`echo __USER_LABEL_PREFIX__ | $ENV{CC} -E -P -`;
  81. $prefix =~ s|\R$||; # Better chomp
  82. }
  83. elsif ($flavour eq "macosx") { $gas=1; $elf=0; $prefix="_"; $decor="L\$"; }
  84. elsif ($flavour eq "masm") { $gas=0; $elf=0; $masm=$masmref; $win64=1; $decor="\$L\$"; }
  85. elsif ($flavour eq "nasm") { $gas=0; $elf=0; $nasm=$nasmref; $win64=1; $decor="\$L\$"; $PTR=""; }
  86. elsif (!$gas)
  87. { if ($ENV{ASM} =~ m/nasm/ && `nasm -v` =~ m/version ([0-9]+)\.([0-9]+)/i)
  88. { $nasm = $1 + $2*0.01; $PTR=""; }
  89. elsif (`ml64 2>&1` =~ m/Version ([0-9]+)\.([0-9]+)(\.([0-9]+))?/)
  90. { $masm = $1 + $2*2**-16 + $4*2**-32; }
  91. die "no assembler found on %PATH%" if (!($nasm || $masm));
  92. $win64=1;
  93. $elf=0;
  94. $decor="\$L\$";
  95. }
  96. # Find out if we're using GNU as
  97. elsif (`$ENV{CC} -Wa,-v -c -o /dev/null -x assembler /dev/null 2>&1`
  98. =~ /GNU assembler version ([2-9]\.[0-9]+)/)
  99. {
  100. $gnuas=1;
  101. }
  102. elsif (`$ENV{CC} --version 2>/dev/null`
  103. =~ /clang .*/)
  104. {
  105. $gnuas=1;
  106. }
  107. my $cet_property;
  108. if ($flavour =~ /elf/) {
  109. # Always generate .note.gnu.property section for ELF outputs to
  110. # mark Intel CET support since all input files must be marked
  111. # with Intel CET support in order for linker to mark output with
  112. # Intel CET support.
  113. my $p2align=3; $p2align=2 if ($flavour eq "elf32");
  114. my $section='.note.gnu.property, #alloc';
  115. $section='".note.gnu.property", "a"' if $gnuas;
  116. $cet_property = <<_____;
  117. .section $section
  118. .p2align $p2align
  119. .long 1f - 0f
  120. .long 4f - 1f
  121. .long 5
  122. 0:
  123. # "GNU" encoded with .byte, since .asciz isn't supported
  124. # on Solaris.
  125. .byte 0x47
  126. .byte 0x4e
  127. .byte 0x55
  128. .byte 0
  129. 1:
  130. .p2align $p2align
  131. .long 0xc0000002
  132. .long 3f - 2f
  133. 2:
  134. .long 3
  135. 3:
  136. .p2align $p2align
  137. 4:
  138. _____
  139. }
  140. my $current_segment;
  141. my $current_function;
  142. my %globals;
  143. { package opcode; # pick up opcodes
  144. sub re {
  145. my ($class, $line) = @_;
  146. my $self = {};
  147. my $ret;
  148. if ($$line =~ /^([a-z][a-z0-9]*)/i) {
  149. bless $self,$class;
  150. $self->{op} = $1;
  151. $ret = $self;
  152. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  153. undef $self->{sz};
  154. if ($self->{op} =~ /^(movz)x?([bw]).*/) { # movz is pain...
  155. $self->{op} = $1;
  156. $self->{sz} = $2;
  157. } elsif ($self->{op} =~ /call|jmp/) {
  158. $self->{sz} = "";
  159. } elsif ($self->{op} =~ /^p/ && $' !~ /^(ush|op|insrw)/) { # SSEn
  160. $self->{sz} = "";
  161. } elsif ($self->{op} =~ /^[vk]/) { # VEX or k* such as kmov
  162. $self->{sz} = "";
  163. } elsif ($self->{op} =~ /mov[dq]/ && $$line =~ /%xmm/) {
  164. $self->{sz} = "";
  165. } elsif ($self->{op} =~ /([a-z]{3,})([qlwb])$/) {
  166. $self->{op} = $1;
  167. $self->{sz} = $2;
  168. }
  169. }
  170. $ret;
  171. }
  172. sub size {
  173. my ($self, $sz) = @_;
  174. $self->{sz} = $sz if (defined($sz) && !defined($self->{sz}));
  175. $self->{sz};
  176. }
  177. sub out {
  178. my $self = shift;
  179. if ($gas) {
  180. if ($self->{op} eq "movz") { # movz is pain...
  181. sprintf "%s%s%s",$self->{op},$self->{sz},shift;
  182. } elsif ($self->{op} =~ /^set/) {
  183. "$self->{op}";
  184. } elsif ($self->{op} eq "ret") {
  185. my $epilogue = "";
  186. if ($win64 && $current_function->{abi} eq "svr4") {
  187. $epilogue = "movq 8(%rsp),%rdi\n\t" .
  188. "movq 16(%rsp),%rsi\n\t";
  189. }
  190. $epilogue . ".byte 0xf3,0xc3";
  191. } elsif ($self->{op} eq "call" && !$elf && $current_segment eq ".init") {
  192. ".p2align\t3\n\t.quad";
  193. } else {
  194. "$self->{op}$self->{sz}";
  195. }
  196. } else {
  197. $self->{op} =~ s/^movz/movzx/;
  198. if ($self->{op} eq "ret") {
  199. $self->{op} = "";
  200. if ($win64 && $current_function->{abi} eq "svr4") {
  201. $self->{op} = "mov rdi,QWORD$PTR\[8+rsp\]\t;WIN64 epilogue\n\t".
  202. "mov rsi,QWORD$PTR\[16+rsp\]\n\t";
  203. }
  204. $self->{op} .= "DB\t0F3h,0C3h\t\t;repret";
  205. } elsif ($self->{op} =~ /^(pop|push)f/) {
  206. $self->{op} .= $self->{sz};
  207. } elsif ($self->{op} eq "call" && $current_segment eq ".CRT\$XCU") {
  208. $self->{op} = "\tDQ";
  209. }
  210. $self->{op};
  211. }
  212. }
  213. sub mnemonic {
  214. my ($self, $op) = @_;
  215. $self->{op}=$op if (defined($op));
  216. $self->{op};
  217. }
  218. }
  219. { package const; # pick up constants, which start with $
  220. sub re {
  221. my ($class, $line) = @_;
  222. my $self = {};
  223. my $ret;
  224. if ($$line =~ /^\$([^,]+)/) {
  225. bless $self, $class;
  226. $self->{value} = $1;
  227. $ret = $self;
  228. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  229. }
  230. $ret;
  231. }
  232. sub out {
  233. my $self = shift;
  234. $self->{value} =~ s/\b(0b[0-1]+)/oct($1)/eig;
  235. if ($gas) {
  236. # Solaris /usr/ccs/bin/as can't handle multiplications
  237. # in $self->{value}
  238. my $value = $self->{value};
  239. no warnings; # oct might complain about overflow, ignore here...
  240. $value =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
  241. if ($value =~ s/([0-9]+\s*[\*\/\%]\s*[0-9]+)/eval($1)/eg) {
  242. $self->{value} = $value;
  243. }
  244. sprintf "\$%s",$self->{value};
  245. } else {
  246. my $value = $self->{value};
  247. $value =~ s/0x([0-9a-f]+)/0$1h/ig if ($masm);
  248. sprintf "%s",$value;
  249. }
  250. }
  251. }
  252. { package ea; # pick up effective addresses: expr(%reg,%reg,scale)
  253. my %szmap = ( b=>"BYTE$PTR", w=>"WORD$PTR",
  254. l=>"DWORD$PTR", d=>"DWORD$PTR",
  255. q=>"QWORD$PTR", o=>"OWORD$PTR",
  256. x=>"XMMWORD$PTR", y=>"YMMWORD$PTR",
  257. z=>"ZMMWORD$PTR" ) if (!$gas);
  258. sub re {
  259. my ($class, $line, $opcode) = @_;
  260. my $self = {};
  261. my $ret;
  262. # optional * ----vvv--- appears in indirect jmp/call
  263. if ($$line =~ /^(\*?)([^\(,]*)\(([%\w,]+)\)((?:{[^}]+})*)/) {
  264. bless $self, $class;
  265. $self->{asterisk} = $1;
  266. $self->{label} = $2;
  267. ($self->{base},$self->{index},$self->{scale})=split(/,/,$3);
  268. $self->{scale} = 1 if (!defined($self->{scale}));
  269. $self->{opmask} = $4;
  270. $ret = $self;
  271. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  272. if ($win64 && $self->{label} =~ s/\@GOTPCREL//) {
  273. die if ($opcode->mnemonic() ne "mov");
  274. $opcode->mnemonic("lea");
  275. }
  276. $self->{base} =~ s/^%//;
  277. $self->{index} =~ s/^%// if (defined($self->{index}));
  278. $self->{opcode} = $opcode;
  279. }
  280. $ret;
  281. }
  282. sub size {}
  283. sub out {
  284. my ($self, $sz) = @_;
  285. $self->{label} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
  286. $self->{label} =~ s/\.L/$decor/g;
  287. # Silently convert all EAs to 64-bit. This is required for
  288. # elder GNU assembler and results in more compact code,
  289. # *but* most importantly AES module depends on this feature!
  290. $self->{index} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
  291. $self->{base} =~ s/^[er](.?[0-9xpi])[d]?$/r\1/;
  292. # Solaris /usr/ccs/bin/as can't handle multiplications
  293. # in $self->{label}...
  294. use integer;
  295. $self->{label} =~ s/(?<![\w\$\.])(0x?[0-9a-f]+)/oct($1)/egi;
  296. $self->{label} =~ s/\b([0-9]+\s*[\*\/\%]\s*[0-9]+)\b/eval($1)/eg;
  297. # Some assemblers insist on signed presentation of 32-bit
  298. # offsets, but sign extension is a tricky business in perl...
  299. if ((1<<31)<<1) {
  300. $self->{label} =~ s/\b([0-9]+)\b/$1<<32>>32/eg;
  301. } else {
  302. $self->{label} =~ s/\b([0-9]+)\b/$1>>0/eg;
  303. }
  304. # if base register is %rbp or %r13, see if it's possible to
  305. # flip base and index registers [for better performance]
  306. if (!$self->{label} && $self->{index} && $self->{scale}==1 &&
  307. $self->{base} =~ /(rbp|r13)/) {
  308. $self->{base} = $self->{index}; $self->{index} = $1;
  309. }
  310. if ($gas) {
  311. $self->{label} =~ s/^___imp_/__imp__/ if ($flavour eq "mingw64");
  312. if (defined($self->{index})) {
  313. sprintf "%s%s(%s,%%%s,%d)%s",
  314. $self->{asterisk},$self->{label},
  315. $self->{base}?"%$self->{base}":"",
  316. $self->{index},$self->{scale},
  317. $self->{opmask};
  318. } else {
  319. sprintf "%s%s(%%%s)%s", $self->{asterisk},$self->{label},
  320. $self->{base},$self->{opmask};
  321. }
  322. } else {
  323. $self->{label} =~ s/\./\$/g;
  324. $self->{label} =~ s/(?<![\w\$\.])0x([0-9a-f]+)/0$1h/ig;
  325. $self->{label} = "($self->{label})" if ($self->{label} =~ /[\*\+\-\/]/);
  326. my $mnemonic = $self->{opcode}->mnemonic();
  327. ($self->{asterisk}) && ($sz="q") ||
  328. ($mnemonic =~ /^v?mov([qd])$/) && ($sz=$1) ||
  329. ($mnemonic =~ /^v?pinsr([qdwb])$/) && ($sz=$1) ||
  330. ($mnemonic =~ /^vpbroadcast([qdwb])$/) && ($sz=$1) ||
  331. ($mnemonic =~ /^v(?!perm)[a-z]+[fi]128$/) && ($sz="x");
  332. $self->{opmask} =~ s/%(k[0-7])/$1/;
  333. if (defined($self->{index})) {
  334. sprintf "%s[%s%s*%d%s]%s",$szmap{$sz},
  335. $self->{label}?"$self->{label}+":"",
  336. $self->{index},$self->{scale},
  337. $self->{base}?"+$self->{base}":"",
  338. $self->{opmask};
  339. } elsif ($self->{base} eq "rip") {
  340. sprintf "%s[%s]",$szmap{$sz},$self->{label};
  341. } else {
  342. sprintf "%s[%s%s]%s", $szmap{$sz},
  343. $self->{label}?"$self->{label}+":"",
  344. $self->{base},$self->{opmask};
  345. }
  346. }
  347. }
  348. }
  349. { package register; # pick up registers, which start with %.
  350. sub re {
  351. my ($class, $line, $opcode) = @_;
  352. my $self = {};
  353. my $ret;
  354. # optional * ----vvv--- appears in indirect jmp/call
  355. if ($$line =~ /^(\*?)%(\w+)((?:{[^}]+})*)/) {
  356. bless $self,$class;
  357. $self->{asterisk} = $1;
  358. $self->{value} = $2;
  359. $self->{opmask} = $3;
  360. $opcode->size($self->size());
  361. $ret = $self;
  362. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  363. }
  364. $ret;
  365. }
  366. sub size {
  367. my $self = shift;
  368. my $ret;
  369. if ($self->{value} =~ /^r[\d]+b$/i) { $ret="b"; }
  370. elsif ($self->{value} =~ /^r[\d]+w$/i) { $ret="w"; }
  371. elsif ($self->{value} =~ /^r[\d]+d$/i) { $ret="l"; }
  372. elsif ($self->{value} =~ /^r[\w]+$/i) { $ret="q"; }
  373. elsif ($self->{value} =~ /^[a-d][hl]$/i){ $ret="b"; }
  374. elsif ($self->{value} =~ /^[\w]{2}l$/i) { $ret="b"; }
  375. elsif ($self->{value} =~ /^[\w]{2}$/i) { $ret="w"; }
  376. elsif ($self->{value} =~ /^e[a-z]{2}$/i){ $ret="l"; }
  377. $ret;
  378. }
  379. sub out {
  380. my $self = shift;
  381. if ($gas) { sprintf "%s%%%s%s", $self->{asterisk},
  382. $self->{value},
  383. $self->{opmask}; }
  384. else { $self->{opmask} =~ s/%(k[0-7])/$1/;
  385. $self->{value}.$self->{opmask}; }
  386. }
  387. }
  388. { package label; # pick up labels, which end with :
  389. sub re {
  390. my ($class, $line) = @_;
  391. my $self = {};
  392. my $ret;
  393. if ($$line =~ /(^[\.\w]+)\:/) {
  394. bless $self,$class;
  395. $self->{value} = $1;
  396. $ret = $self;
  397. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  398. $self->{value} =~ s/^\.L/$decor/;
  399. }
  400. $ret;
  401. }
  402. sub out {
  403. my $self = shift;
  404. if ($gas) {
  405. my $func = ($globals{$self->{value}} or $self->{value}) . ":";
  406. if ($win64 && $current_function->{name} eq $self->{value}
  407. && $current_function->{abi} eq "svr4") {
  408. $func .= "\n";
  409. $func .= " movq %rdi,8(%rsp)\n";
  410. $func .= " movq %rsi,16(%rsp)\n";
  411. $func .= " movq %rsp,%rax\n";
  412. $func .= "${decor}SEH_begin_$current_function->{name}:\n";
  413. my $narg = $current_function->{narg};
  414. $narg=6 if (!defined($narg));
  415. $func .= " movq %rcx,%rdi\n" if ($narg>0);
  416. $func .= " movq %rdx,%rsi\n" if ($narg>1);
  417. $func .= " movq %r8,%rdx\n" if ($narg>2);
  418. $func .= " movq %r9,%rcx\n" if ($narg>3);
  419. $func .= " movq 40(%rsp),%r8\n" if ($narg>4);
  420. $func .= " movq 48(%rsp),%r9\n" if ($narg>5);
  421. }
  422. $func;
  423. } elsif ($self->{value} ne "$current_function->{name}") {
  424. # Make all labels in masm global.
  425. $self->{value} .= ":" if ($masm);
  426. $self->{value} . ":";
  427. } elsif ($win64 && $current_function->{abi} eq "svr4") {
  428. my $func = "$current_function->{name}" .
  429. ($nasm ? ":" : "\tPROC $current_function->{scope}") .
  430. "\n";
  431. $func .= " mov QWORD$PTR\[8+rsp\],rdi\t;WIN64 prologue\n";
  432. $func .= " mov QWORD$PTR\[16+rsp\],rsi\n";
  433. $func .= " mov rax,rsp\n";
  434. $func .= "${decor}SEH_begin_$current_function->{name}:";
  435. $func .= ":" if ($masm);
  436. $func .= "\n";
  437. my $narg = $current_function->{narg};
  438. $narg=6 if (!defined($narg));
  439. $func .= " mov rdi,rcx\n" if ($narg>0);
  440. $func .= " mov rsi,rdx\n" if ($narg>1);
  441. $func .= " mov rdx,r8\n" if ($narg>2);
  442. $func .= " mov rcx,r9\n" if ($narg>3);
  443. $func .= " mov r8,QWORD$PTR\[40+rsp\]\n" if ($narg>4);
  444. $func .= " mov r9,QWORD$PTR\[48+rsp\]\n" if ($narg>5);
  445. $func .= "\n";
  446. } else {
  447. "$current_function->{name}".
  448. ($nasm ? ":" : "\tPROC $current_function->{scope}");
  449. }
  450. }
  451. }
  452. { package expr; # pick up expressions
  453. sub re {
  454. my ($class, $line, $opcode) = @_;
  455. my $self = {};
  456. my $ret;
  457. if ($$line =~ /(^[^,]+)/) {
  458. bless $self,$class;
  459. $self->{value} = $1;
  460. $ret = $self;
  461. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  462. $self->{value} =~ s/\@PLT// if (!$elf);
  463. $self->{value} =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
  464. $self->{value} =~ s/\.L/$decor/g;
  465. $self->{opcode} = $opcode;
  466. }
  467. $ret;
  468. }
  469. sub out {
  470. my $self = shift;
  471. if ($nasm && $self->{opcode}->mnemonic()=~m/^j(?![re]cxz)/) {
  472. "NEAR ".$self->{value};
  473. } else {
  474. $self->{value};
  475. }
  476. }
  477. }
  478. { package cfi_directive;
  479. # CFI directives annotate instructions that are significant for
  480. # stack unwinding procedure compliant with DWARF specification,
  481. # see http://dwarfstd.org/. Besides naturally expected for this
  482. # script platform-specific filtering function, this module adds
  483. # three auxiliary synthetic directives not recognized by [GNU]
  484. # assembler:
  485. #
  486. # - .cfi_push to annotate push instructions in prologue, which
  487. # translates to .cfi_adjust_cfa_offset (if needed) and
  488. # .cfi_offset;
  489. # - .cfi_pop to annotate pop instructions in epilogue, which
  490. # translates to .cfi_adjust_cfa_offset (if needed) and
  491. # .cfi_restore;
  492. # - [and most notably] .cfi_cfa_expression which encodes
  493. # DW_CFA_def_cfa_expression and passes it to .cfi_escape as
  494. # byte vector;
  495. #
  496. # CFA expressions were introduced in DWARF specification version
  497. # 3 and describe how to deduce CFA, Canonical Frame Address. This
  498. # becomes handy if your stack frame is variable and you can't
  499. # spare register for [previous] frame pointer. Suggested directive
  500. # syntax is made-up mix of DWARF operator suffixes [subset of]
  501. # and references to registers with optional bias. Following example
  502. # describes offloaded *original* stack pointer at specific offset
  503. # from *current* stack pointer:
  504. #
  505. # .cfi_cfa_expression %rsp+40,deref,+8
  506. #
  507. # Final +8 has everything to do with the fact that CFA is defined
  508. # as reference to top of caller's stack, and on x86_64 call to
  509. # subroutine pushes 8-byte return address. In other words original
  510. # stack pointer upon entry to a subroutine is 8 bytes off from CFA.
  511. # Below constants are taken from "DWARF Expressions" section of the
  512. # DWARF specification, section is numbered 7.7 in versions 3 and 4.
  513. my %DW_OP_simple = ( # no-arg operators, mapped directly
  514. deref => 0x06, dup => 0x12,
  515. drop => 0x13, over => 0x14,
  516. pick => 0x15, swap => 0x16,
  517. rot => 0x17, xderef => 0x18,
  518. abs => 0x19, and => 0x1a,
  519. div => 0x1b, minus => 0x1c,
  520. mod => 0x1d, mul => 0x1e,
  521. neg => 0x1f, not => 0x20,
  522. or => 0x21, plus => 0x22,
  523. shl => 0x24, shr => 0x25,
  524. shra => 0x26, xor => 0x27,
  525. );
  526. my %DW_OP_complex = ( # used in specific subroutines
  527. constu => 0x10, # uleb128
  528. consts => 0x11, # sleb128
  529. plus_uconst => 0x23, # uleb128
  530. lit0 => 0x30, # add 0-31 to opcode
  531. reg0 => 0x50, # add 0-31 to opcode
  532. breg0 => 0x70, # add 0-31 to opcole, sleb128
  533. regx => 0x90, # uleb28
  534. fbreg => 0x91, # sleb128
  535. bregx => 0x92, # uleb128, sleb128
  536. piece => 0x93, # uleb128
  537. );
  538. # Following constants are defined in x86_64 ABI supplement, for
  539. # example available at https://www.uclibc.org/docs/psABI-x86_64.pdf,
  540. # see section 3.7 "Stack Unwind Algorithm".
  541. my %DW_reg_idx = (
  542. "%rax"=>0, "%rdx"=>1, "%rcx"=>2, "%rbx"=>3,
  543. "%rsi"=>4, "%rdi"=>5, "%rbp"=>6, "%rsp"=>7,
  544. "%r8" =>8, "%r9" =>9, "%r10"=>10, "%r11"=>11,
  545. "%r12"=>12, "%r13"=>13, "%r14"=>14, "%r15"=>15
  546. );
  547. my ($cfa_reg, $cfa_rsp);
  548. my @cfa_stack;
  549. # [us]leb128 format is variable-length integer representation base
  550. # 2^128, with most significant bit of each byte being 0 denoting
  551. # *last* most significant digit. See "Variable Length Data" in the
  552. # DWARF specification, numbered 7.6 at least in versions 3 and 4.
  553. sub sleb128 {
  554. use integer; # get right shift extend sign
  555. my $val = shift;
  556. my $sign = ($val < 0) ? -1 : 0;
  557. my @ret = ();
  558. while(1) {
  559. push @ret, $val&0x7f;
  560. # see if remaining bits are same and equal to most
  561. # significant bit of the current digit, if so, it's
  562. # last digit...
  563. last if (($val>>6) == $sign);
  564. @ret[-1] |= 0x80;
  565. $val >>= 7;
  566. }
  567. return @ret;
  568. }
  569. sub uleb128 {
  570. my $val = shift;
  571. my @ret = ();
  572. while(1) {
  573. push @ret, $val&0x7f;
  574. # see if it's last significant digit...
  575. last if (($val >>= 7) == 0);
  576. @ret[-1] |= 0x80;
  577. }
  578. return @ret;
  579. }
  580. sub const {
  581. my $val = shift;
  582. if ($val >= 0 && $val < 32) {
  583. return ($DW_OP_complex{lit0}+$val);
  584. }
  585. return ($DW_OP_complex{consts}, sleb128($val));
  586. }
  587. sub reg {
  588. my $val = shift;
  589. return if ($val !~ m/^(%r\w+)(?:([\+\-])((?:0x)?[0-9a-f]+))?/);
  590. my $reg = $DW_reg_idx{$1};
  591. my $off = eval ("0 $2 $3");
  592. return (($DW_OP_complex{breg0} + $reg), sleb128($off));
  593. # Yes, we use DW_OP_bregX+0 to push register value and not
  594. # DW_OP_regX, because latter would require even DW_OP_piece,
  595. # which would be a waste under the circumstances. If you have
  596. # to use DWP_OP_reg, use "regx:N"...
  597. }
  598. sub cfa_expression {
  599. my $line = shift;
  600. my @ret;
  601. foreach my $token (split(/,\s*/,$line)) {
  602. if ($token =~ /^%r/) {
  603. push @ret,reg($token);
  604. } elsif ($token =~ /((?:0x)?[0-9a-f]+)\((%r\w+)\)/) {
  605. push @ret,reg("$2+$1");
  606. } elsif ($token =~ /(\w+):(\-?(?:0x)?[0-9a-f]+)(U?)/i) {
  607. my $i = 1*eval($2);
  608. push @ret,$DW_OP_complex{$1}, ($3 ? uleb128($i) : sleb128($i));
  609. } elsif (my $i = 1*eval($token) or $token eq "0") {
  610. if ($token =~ /^\+/) {
  611. push @ret,$DW_OP_complex{plus_uconst},uleb128($i);
  612. } else {
  613. push @ret,const($i);
  614. }
  615. } else {
  616. push @ret,$DW_OP_simple{$token};
  617. }
  618. }
  619. # Finally we return DW_CFA_def_cfa_expression, 15, followed by
  620. # length of the expression and of course the expression itself.
  621. return (15,scalar(@ret),@ret);
  622. }
  623. sub re {
  624. my ($class, $line) = @_;
  625. my $self = {};
  626. my $ret;
  627. if ($$line =~ s/^\s*\.cfi_(\w+)\s*//) {
  628. bless $self,$class;
  629. $ret = $self;
  630. undef $self->{value};
  631. my $dir = $1;
  632. SWITCH: for ($dir) {
  633. # What is $cfa_rsp? Effectively it's difference between %rsp
  634. # value and current CFA, Canonical Frame Address, which is
  635. # why it starts with -8. Recall that CFA is top of caller's
  636. # stack...
  637. /startproc/ && do { ($cfa_reg, $cfa_rsp) = ("%rsp", -8); last; };
  638. /endproc/ && do { ($cfa_reg, $cfa_rsp) = ("%rsp", 0);
  639. # .cfi_remember_state directives that are not
  640. # matched with .cfi_restore_state are
  641. # unnecessary.
  642. die "unpaired .cfi_remember_state" if (@cfa_stack);
  643. last;
  644. };
  645. /def_cfa_register/
  646. && do { $cfa_reg = $$line; last; };
  647. /def_cfa_offset/
  648. && do { $cfa_rsp = -1*eval($$line) if ($cfa_reg eq "%rsp");
  649. last;
  650. };
  651. /adjust_cfa_offset/
  652. && do { $cfa_rsp -= 1*eval($$line) if ($cfa_reg eq "%rsp");
  653. last;
  654. };
  655. /def_cfa/ && do { if ($$line =~ /(%r\w+)\s*,\s*(.+)/) {
  656. $cfa_reg = $1;
  657. $cfa_rsp = -1*eval($2) if ($cfa_reg eq "%rsp");
  658. }
  659. last;
  660. };
  661. /push/ && do { $dir = undef;
  662. $cfa_rsp -= 8;
  663. if ($cfa_reg eq "%rsp") {
  664. $self->{value} = ".cfi_adjust_cfa_offset\t8\n";
  665. }
  666. $self->{value} .= ".cfi_offset\t$$line,$cfa_rsp";
  667. last;
  668. };
  669. /pop/ && do { $dir = undef;
  670. $cfa_rsp += 8;
  671. if ($cfa_reg eq "%rsp") {
  672. $self->{value} = ".cfi_adjust_cfa_offset\t-8\n";
  673. }
  674. $self->{value} .= ".cfi_restore\t$$line";
  675. last;
  676. };
  677. /cfa_expression/
  678. && do { $dir = undef;
  679. $self->{value} = ".cfi_escape\t" .
  680. join(",", map(sprintf("0x%02x", $_),
  681. cfa_expression($$line)));
  682. last;
  683. };
  684. /remember_state/
  685. && do { push @cfa_stack, [$cfa_reg, $cfa_rsp];
  686. last;
  687. };
  688. /restore_state/
  689. && do { ($cfa_reg, $cfa_rsp) = @{pop @cfa_stack};
  690. last;
  691. };
  692. }
  693. $self->{value} = ".cfi_$dir\t$$line" if ($dir);
  694. $$line = "";
  695. }
  696. return $ret;
  697. }
  698. sub out {
  699. my $self = shift;
  700. return ($elf ? $self->{value} : undef);
  701. }
  702. }
  703. { package directive; # pick up directives, which start with .
  704. sub re {
  705. my ($class, $line) = @_;
  706. my $self = {};
  707. my $ret;
  708. my $dir;
  709. # chain-call to cfi_directive
  710. $ret = cfi_directive->re($line) and return $ret;
  711. if ($$line =~ /^\s*(\.\w+)/) {
  712. bless $self,$class;
  713. $dir = $1;
  714. $ret = $self;
  715. undef $self->{value};
  716. $$line = substr($$line,@+[0]); $$line =~ s/^\s+//;
  717. SWITCH: for ($dir) {
  718. /\.global|\.globl|\.extern/
  719. && do { $globals{$$line} = $prefix . $$line;
  720. $$line = $globals{$$line} if ($prefix);
  721. last;
  722. };
  723. /\.type/ && do { my ($sym,$type,$narg) = split(',',$$line);
  724. if ($type eq "\@function") {
  725. undef $current_function;
  726. $current_function->{name} = $sym;
  727. $current_function->{abi} = "svr4";
  728. $current_function->{narg} = $narg;
  729. $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE";
  730. } elsif ($type eq "\@abi-omnipotent") {
  731. undef $current_function;
  732. $current_function->{name} = $sym;
  733. $current_function->{scope} = defined($globals{$sym})?"PUBLIC":"PRIVATE";
  734. }
  735. $$line =~ s/\@abi\-omnipotent/\@function/;
  736. $$line =~ s/\@function.*/\@function/;
  737. last;
  738. };
  739. /\.asciz/ && do { if ($$line =~ /^"(.*)"$/) {
  740. $dir = ".byte";
  741. $$line = join(",",unpack("C*",$1),0);
  742. }
  743. last;
  744. };
  745. /\.rva|\.long|\.quad|\.byte/
  746. && do { $$line =~ s/([_a-z][_a-z0-9]*)/$globals{$1} or $1/gei;
  747. $$line =~ s/\.L/$decor/g;
  748. last;
  749. };
  750. }
  751. if ($gas) {
  752. $self->{value} = $dir . "\t" . $$line;
  753. if ($dir =~ /\.extern/) {
  754. $self->{value} = ""; # swallow extern
  755. } elsif (!$elf && $dir =~ /\.type/) {
  756. $self->{value} = "";
  757. $self->{value} = ".def\t" . ($globals{$1} or $1) . ";\t" .
  758. (defined($globals{$1})?".scl 2;":".scl 3;") .
  759. "\t.type 32;\t.endef"
  760. if ($win64 && $$line =~ /([^,]+),\@function/);
  761. } elsif (!$elf && $dir =~ /\.size/) {
  762. $self->{value} = "";
  763. if (defined($current_function)) {
  764. $self->{value} .= "${decor}SEH_end_$current_function->{name}:"
  765. if ($win64 && $current_function->{abi} eq "svr4");
  766. undef $current_function;
  767. }
  768. } elsif (!$elf && $dir =~ /\.align/) {
  769. $self->{value} = ".p2align\t" . (log($$line)/log(2));
  770. } elsif ($dir eq ".section") {
  771. $current_segment=$$line;
  772. if (!$elf && $current_segment eq ".init") {
  773. if ($flavour eq "macosx") { $self->{value} = ".mod_init_func"; }
  774. elsif ($flavour eq "mingw64") { $self->{value} = ".section\t.ctors"; }
  775. }
  776. } elsif ($dir =~ /\.(text|data)/) {
  777. $current_segment=".$1";
  778. } elsif ($dir =~ /\.hidden/) {
  779. if ($flavour eq "macosx") { $self->{value} = ".private_extern\t$prefix$$line"; }
  780. elsif ($flavour eq "mingw64") { $self->{value} = ""; }
  781. } elsif ($dir =~ /\.comm/) {
  782. $self->{value} = "$dir\t$prefix$$line";
  783. $self->{value} =~ s|,([0-9]+),([0-9]+)$|",$1,".log($2)/log(2)|e if ($flavour eq "macosx");
  784. }
  785. $$line = "";
  786. return $self;
  787. }
  788. # non-gas case or nasm/masm
  789. SWITCH: for ($dir) {
  790. /\.text/ && do { my $v=undef;
  791. if ($nasm) {
  792. $v="section .text code align=64\n";
  793. } else {
  794. $v="$current_segment\tENDS\n" if ($current_segment);
  795. $current_segment = ".text\$";
  796. $v.="$current_segment\tSEGMENT ";
  797. $v.=$masm>=$masmref ? "ALIGN(256)" : "PAGE";
  798. $v.=" 'CODE'";
  799. }
  800. $self->{value} = $v;
  801. last;
  802. };
  803. /\.data/ && do { my $v=undef;
  804. if ($nasm) {
  805. $v="section .data data align=8\n";
  806. } else {
  807. $v="$current_segment\tENDS\n" if ($current_segment);
  808. $current_segment = "_DATA";
  809. $v.="$current_segment\tSEGMENT";
  810. }
  811. $self->{value} = $v;
  812. last;
  813. };
  814. /\.section/ && do { my $v=undef;
  815. $$line =~ s/([^,]*).*/$1/;
  816. $$line = ".CRT\$XCU" if ($$line eq ".init");
  817. if ($nasm) {
  818. $v="section $$line";
  819. if ($$line=~/\.([px])data/) {
  820. $v.=" rdata align=";
  821. $v.=$1 eq "p"? 4 : 8;
  822. } elsif ($$line=~/\.CRT\$/i) {
  823. $v.=" rdata align=8";
  824. }
  825. } else {
  826. $v="$current_segment\tENDS\n" if ($current_segment);
  827. $v.="$$line\tSEGMENT";
  828. if ($$line=~/\.([px])data/) {
  829. $v.=" READONLY";
  830. $v.=" ALIGN(".($1 eq "p" ? 4 : 8).")" if ($masm>=$masmref);
  831. } elsif ($$line=~/\.CRT\$/i) {
  832. $v.=" READONLY ";
  833. $v.=$masm>=$masmref ? "ALIGN(8)" : "DWORD";
  834. }
  835. }
  836. $current_segment = $$line;
  837. $self->{value} = $v;
  838. last;
  839. };
  840. /\.extern/ && do { $self->{value} = "EXTERN\t".$$line;
  841. $self->{value} .= ":NEAR" if ($masm);
  842. last;
  843. };
  844. /\.globl|.global/
  845. && do { $self->{value} = $masm?"PUBLIC":"global";
  846. $self->{value} .= "\t".$$line;
  847. last;
  848. };
  849. /\.size/ && do { if (defined($current_function)) {
  850. undef $self->{value};
  851. if ($current_function->{abi} eq "svr4") {
  852. $self->{value}="${decor}SEH_end_$current_function->{name}:";
  853. $self->{value}.=":\n" if($masm);
  854. }
  855. $self->{value}.="$current_function->{name}\tENDP" if($masm && $current_function->{name});
  856. undef $current_function;
  857. }
  858. last;
  859. };
  860. /\.align/ && do { my $max = ($masm && $masm>=$masmref) ? 256 : 4096;
  861. $self->{value} = "ALIGN\t".($$line>$max?$max:$$line);
  862. last;
  863. };
  864. /\.(value|long|rva|quad)/
  865. && do { my $sz = substr($1,0,1);
  866. my @arr = split(/,\s*/,$$line);
  867. my $last = pop(@arr);
  868. my $conv = sub { my $var=shift;
  869. $var=~s/^(0b[0-1]+)/oct($1)/eig;
  870. $var=~s/^0x([0-9a-f]+)/0$1h/ig if ($masm);
  871. if ($sz eq "D" && ($current_segment=~/.[px]data/ || $dir eq ".rva"))
  872. { $var=~s/^([_a-z\$\@][_a-z0-9\$\@]*)/$nasm?"$1 wrt ..imagebase":"imagerel $1"/egi; }
  873. $var;
  874. };
  875. $sz =~ tr/bvlrq/BWDDQ/;
  876. $self->{value} = "\tD$sz\t";
  877. for (@arr) { $self->{value} .= &$conv($_).","; }
  878. $self->{value} .= &$conv($last);
  879. last;
  880. };
  881. /\.byte/ && do { my @str=split(/,\s*/,$$line);
  882. map(s/(0b[0-1]+)/oct($1)/eig,@str);
  883. map(s/0x([0-9a-f]+)/0$1h/ig,@str) if ($masm);
  884. while ($#str>15) {
  885. $self->{value}.="DB\t"
  886. .join(",",@str[0..15])."\n";
  887. foreach (0..15) { shift @str; }
  888. }
  889. $self->{value}.="DB\t"
  890. .join(",",@str) if (@str);
  891. last;
  892. };
  893. /\.comm/ && do { my @str=split(/,\s*/,$$line);
  894. my $v=undef;
  895. if ($nasm) {
  896. $v.="common $prefix@str[0] @str[1]";
  897. } else {
  898. $v="$current_segment\tENDS\n" if ($current_segment);
  899. $current_segment = "_DATA";
  900. $v.="$current_segment\tSEGMENT\n";
  901. $v.="COMM @str[0]:DWORD:".@str[1]/4;
  902. }
  903. $self->{value} = $v;
  904. last;
  905. };
  906. }
  907. $$line = "";
  908. }
  909. $ret;
  910. }
  911. sub out {
  912. my $self = shift;
  913. $self->{value};
  914. }
  915. }
  916. # Upon initial x86_64 introduction SSE>2 extensions were not introduced
  917. # yet. In order not to be bothered by tracing exact assembler versions,
  918. # but at the same time to provide a bare security minimum of AES-NI, we
  919. # hard-code some instructions. Extensions past AES-NI on the other hand
  920. # are traced by examining assembler version in individual perlasm
  921. # modules...
  922. my %regrm = ( "%eax"=>0, "%ecx"=>1, "%edx"=>2, "%ebx"=>3,
  923. "%esp"=>4, "%ebp"=>5, "%esi"=>6, "%edi"=>7 );
  924. sub rex {
  925. my $opcode=shift;
  926. my ($dst,$src,$rex)=@_;
  927. $rex|=0x04 if($dst>=8);
  928. $rex|=0x01 if($src>=8);
  929. push @$opcode,($rex|0x40) if ($rex);
  930. }
  931. my $movq = sub { # elderly gas can't handle inter-register movq
  932. my $arg = shift;
  933. my @opcode=(0x66);
  934. if ($arg =~ /%xmm([0-9]+),\s*%r(\w+)/) {
  935. my ($src,$dst)=($1,$2);
  936. if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
  937. rex(\@opcode,$src,$dst,0x8);
  938. push @opcode,0x0f,0x7e;
  939. push @opcode,0xc0|(($src&7)<<3)|($dst&7); # ModR/M
  940. @opcode;
  941. } elsif ($arg =~ /%r(\w+),\s*%xmm([0-9]+)/) {
  942. my ($src,$dst)=($2,$1);
  943. if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
  944. rex(\@opcode,$src,$dst,0x8);
  945. push @opcode,0x0f,0x6e;
  946. push @opcode,0xc0|(($src&7)<<3)|($dst&7); # ModR/M
  947. @opcode;
  948. } else {
  949. ();
  950. }
  951. };
  952. my $pextrd = sub {
  953. if (shift =~ /\$([0-9]+),\s*%xmm([0-9]+),\s*(%\w+)/) {
  954. my @opcode=(0x66);
  955. my $imm=$1;
  956. my $src=$2;
  957. my $dst=$3;
  958. if ($dst =~ /%r([0-9]+)d/) { $dst = $1; }
  959. elsif ($dst =~ /%e/) { $dst = $regrm{$dst}; }
  960. rex(\@opcode,$src,$dst);
  961. push @opcode,0x0f,0x3a,0x16;
  962. push @opcode,0xc0|(($src&7)<<3)|($dst&7); # ModR/M
  963. push @opcode,$imm;
  964. @opcode;
  965. } else {
  966. ();
  967. }
  968. };
  969. my $pinsrd = sub {
  970. if (shift =~ /\$([0-9]+),\s*(%\w+),\s*%xmm([0-9]+)/) {
  971. my @opcode=(0x66);
  972. my $imm=$1;
  973. my $src=$2;
  974. my $dst=$3;
  975. if ($src =~ /%r([0-9]+)/) { $src = $1; }
  976. elsif ($src =~ /%e/) { $src = $regrm{$src}; }
  977. rex(\@opcode,$dst,$src);
  978. push @opcode,0x0f,0x3a,0x22;
  979. push @opcode,0xc0|(($dst&7)<<3)|($src&7); # ModR/M
  980. push @opcode,$imm;
  981. @opcode;
  982. } else {
  983. ();
  984. }
  985. };
  986. my $pshufb = sub {
  987. if (shift =~ /%xmm([0-9]+),\s*%xmm([0-9]+)/) {
  988. my @opcode=(0x66);
  989. rex(\@opcode,$2,$1);
  990. push @opcode,0x0f,0x38,0x00;
  991. push @opcode,0xc0|($1&7)|(($2&7)<<3); # ModR/M
  992. @opcode;
  993. } else {
  994. ();
  995. }
  996. };
  997. my $palignr = sub {
  998. if (shift =~ /\$([0-9]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
  999. my @opcode=(0x66);
  1000. rex(\@opcode,$3,$2);
  1001. push @opcode,0x0f,0x3a,0x0f;
  1002. push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M
  1003. push @opcode,$1;
  1004. @opcode;
  1005. } else {
  1006. ();
  1007. }
  1008. };
  1009. my $pclmulqdq = sub {
  1010. if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
  1011. my @opcode=(0x66);
  1012. rex(\@opcode,$3,$2);
  1013. push @opcode,0x0f,0x3a,0x44;
  1014. push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M
  1015. my $c=$1;
  1016. push @opcode,$c=~/^0/?oct($c):$c;
  1017. @opcode;
  1018. } else {
  1019. ();
  1020. }
  1021. };
  1022. my $rdrand = sub {
  1023. if (shift =~ /%[er](\w+)/) {
  1024. my @opcode=();
  1025. my $dst=$1;
  1026. if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
  1027. rex(\@opcode,0,$dst,8);
  1028. push @opcode,0x0f,0xc7,0xf0|($dst&7);
  1029. @opcode;
  1030. } else {
  1031. ();
  1032. }
  1033. };
  1034. my $rdseed = sub {
  1035. if (shift =~ /%[er](\w+)/) {
  1036. my @opcode=();
  1037. my $dst=$1;
  1038. if ($dst !~ /[0-9]+/) { $dst = $regrm{"%e$dst"}; }
  1039. rex(\@opcode,0,$dst,8);
  1040. push @opcode,0x0f,0xc7,0xf8|($dst&7);
  1041. @opcode;
  1042. } else {
  1043. ();
  1044. }
  1045. };
  1046. # Not all AVX-capable assemblers recognize AMD XOP extension. Since we
  1047. # are using only two instructions hand-code them in order to be excused
  1048. # from chasing assembler versions...
  1049. sub rxb {
  1050. my $opcode=shift;
  1051. my ($dst,$src1,$src2,$rxb)=@_;
  1052. $rxb|=0x7<<5;
  1053. $rxb&=~(0x04<<5) if($dst>=8);
  1054. $rxb&=~(0x01<<5) if($src1>=8);
  1055. $rxb&=~(0x02<<5) if($src2>=8);
  1056. push @$opcode,$rxb;
  1057. }
  1058. my $vprotd = sub {
  1059. if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
  1060. my @opcode=(0x8f);
  1061. rxb(\@opcode,$3,$2,-1,0x08);
  1062. push @opcode,0x78,0xc2;
  1063. push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M
  1064. my $c=$1;
  1065. push @opcode,$c=~/^0/?oct($c):$c;
  1066. @opcode;
  1067. } else {
  1068. ();
  1069. }
  1070. };
  1071. my $vprotq = sub {
  1072. if (shift =~ /\$([x0-9a-f]+),\s*%xmm([0-9]+),\s*%xmm([0-9]+)/) {
  1073. my @opcode=(0x8f);
  1074. rxb(\@opcode,$3,$2,-1,0x08);
  1075. push @opcode,0x78,0xc3;
  1076. push @opcode,0xc0|($2&7)|(($3&7)<<3); # ModR/M
  1077. my $c=$1;
  1078. push @opcode,$c=~/^0/?oct($c):$c;
  1079. @opcode;
  1080. } else {
  1081. ();
  1082. }
  1083. };
  1084. # Intel Control-flow Enforcement Technology extension. All functions and
  1085. # indirect branch targets will have to start with this instruction...
  1086. my $endbranch = sub {
  1087. (0xf3,0x0f,0x1e,0xfa);
  1088. };
  1089. ########################################################################
  1090. if ($nasm) {
  1091. print <<___;
  1092. default rel
  1093. %define XMMWORD
  1094. %define YMMWORD
  1095. %define ZMMWORD
  1096. ___
  1097. } elsif ($masm) {
  1098. print <<___;
  1099. OPTION DOTNAME
  1100. ___
  1101. }
  1102. while(defined(my $line=<>)) {
  1103. $line =~ s|\R$||; # Better chomp
  1104. $line =~ s|[#!].*$||; # get rid of asm-style comments...
  1105. $line =~ s|/\*.*\*/||; # ... and C-style comments...
  1106. $line =~ s|^\s+||; # ... and skip whitespaces in beginning
  1107. $line =~ s|\s+$||; # ... and at the end
  1108. if (my $label=label->re(\$line)) { print $label->out(); }
  1109. if (my $directive=directive->re(\$line)) {
  1110. printf "%s",$directive->out();
  1111. } elsif (my $opcode=opcode->re(\$line)) {
  1112. my $asm = eval("\$".$opcode->mnemonic());
  1113. if ((ref($asm) eq 'CODE') && scalar(my @bytes=&$asm($line))) {
  1114. print $gas?".byte\t":"DB\t",join(',',@bytes),"\n";
  1115. next;
  1116. }
  1117. my @args;
  1118. ARGUMENT: while (1) {
  1119. my $arg;
  1120. ($arg=register->re(\$line, $opcode))||
  1121. ($arg=const->re(\$line)) ||
  1122. ($arg=ea->re(\$line, $opcode)) ||
  1123. ($arg=expr->re(\$line, $opcode)) ||
  1124. last ARGUMENT;
  1125. push @args,$arg;
  1126. last ARGUMENT if ($line !~ /^,/);
  1127. $line =~ s/^,\s*//;
  1128. } # ARGUMENT:
  1129. if ($#args>=0) {
  1130. my $insn;
  1131. my $sz=$opcode->size();
  1132. if ($gas) {
  1133. $insn = $opcode->out($#args>=1?$args[$#args]->size():$sz);
  1134. @args = map($_->out($sz),@args);
  1135. printf "\t%s\t%s",$insn,join(",",@args);
  1136. } else {
  1137. $insn = $opcode->out();
  1138. foreach (@args) {
  1139. my $arg = $_->out();
  1140. # $insn.=$sz compensates for movq, pinsrw, ...
  1141. if ($arg =~ /^xmm[0-9]+$/) { $insn.=$sz; $sz="x" if(!$sz); last; }
  1142. if ($arg =~ /^ymm[0-9]+$/) { $insn.=$sz; $sz="y" if(!$sz); last; }
  1143. if ($arg =~ /^zmm[0-9]+$/) { $insn.=$sz; $sz="z" if(!$sz); last; }
  1144. if ($arg =~ /^mm[0-9]+$/) { $insn.=$sz; $sz="q" if(!$sz); last; }
  1145. }
  1146. @args = reverse(@args);
  1147. undef $sz if ($nasm && $opcode->mnemonic() eq "lea");
  1148. printf "\t%s\t%s",$insn,join(",",map($_->out($sz),@args));
  1149. }
  1150. } else {
  1151. printf "\t%s",$opcode->out();
  1152. }
  1153. }
  1154. print $line,"\n";
  1155. }
  1156. print "$cet_property" if ($cet_property);
  1157. print "\n$current_segment\tENDS\n" if ($current_segment && $masm);
  1158. print "END\n" if ($masm);
  1159. close STDOUT or die "error closing STDOUT: $!;"
  1160. #################################################
  1161. # Cross-reference x86_64 ABI "card"
  1162. #
  1163. # Unix Win64
  1164. # %rax * *
  1165. # %rbx - -
  1166. # %rcx #4 #1
  1167. # %rdx #3 #2
  1168. # %rsi #2 -
  1169. # %rdi #1 -
  1170. # %rbp - -
  1171. # %rsp - -
  1172. # %r8 #5 #3
  1173. # %r9 #6 #4
  1174. # %r10 * *
  1175. # %r11 * *
  1176. # %r12 - -
  1177. # %r13 - -
  1178. # %r14 - -
  1179. # %r15 - -
  1180. #
  1181. # (*) volatile register
  1182. # (-) preserved by callee
  1183. # (#) Nth argument, volatile
  1184. #
  1185. # In Unix terms top of stack is argument transfer area for arguments
  1186. # which could not be accommodated in registers. Or in other words 7th
  1187. # [integer] argument resides at 8(%rsp) upon function entry point.
  1188. # 128 bytes above %rsp constitute a "red zone" which is not touched
  1189. # by signal handlers and can be used as temporal storage without
  1190. # allocating a frame.
  1191. #
  1192. # In Win64 terms N*8 bytes on top of stack is argument transfer area,
  1193. # which belongs to/can be overwritten by callee. N is the number of
  1194. # arguments passed to callee, *but* not less than 4! This means that
  1195. # upon function entry point 5th argument resides at 40(%rsp), as well
  1196. # as that 32 bytes from 8(%rsp) can always be used as temporal
  1197. # storage [without allocating a frame]. One can actually argue that
  1198. # one can assume a "red zone" above stack pointer under Win64 as well.
  1199. # Point is that at apparently no occasion Windows kernel would alter
  1200. # the area above user stack pointer in true asynchronous manner...
  1201. #
  1202. # All the above means that if assembler programmer adheres to Unix
  1203. # register and stack layout, but disregards the "red zone" existence,
  1204. # it's possible to use following prologue and epilogue to "gear" from
  1205. # Unix to Win64 ABI in leaf functions with not more than 6 arguments.
  1206. #
  1207. # omnipotent_function:
  1208. # ifdef WIN64
  1209. # movq %rdi,8(%rsp)
  1210. # movq %rsi,16(%rsp)
  1211. # movq %rcx,%rdi ; if 1st argument is actually present
  1212. # movq %rdx,%rsi ; if 2nd argument is actually ...
  1213. # movq %r8,%rdx ; if 3rd argument is ...
  1214. # movq %r9,%rcx ; if 4th argument ...
  1215. # movq 40(%rsp),%r8 ; if 5th ...
  1216. # movq 48(%rsp),%r9 ; if 6th ...
  1217. # endif
  1218. # ...
  1219. # ifdef WIN64
  1220. # movq 8(%rsp),%rdi
  1221. # movq 16(%rsp),%rsi
  1222. # endif
  1223. # ret
  1224. #
  1225. #################################################
  1226. # Win64 SEH, Structured Exception Handling.
  1227. #
  1228. # Unlike on Unix systems(*) lack of Win64 stack unwinding information
  1229. # has undesired side-effect at run-time: if an exception is raised in
  1230. # assembler subroutine such as those in question (basically we're
  1231. # referring to segmentation violations caused by malformed input
  1232. # parameters), the application is briskly terminated without invoking
  1233. # any exception handlers, most notably without generating memory dump
  1234. # or any user notification whatsoever. This poses a problem. It's
  1235. # possible to address it by registering custom language-specific
  1236. # handler that would restore processor context to the state at
  1237. # subroutine entry point and return "exception is not handled, keep
  1238. # unwinding" code. Writing such handler can be a challenge... But it's
  1239. # doable, though requires certain coding convention. Consider following
  1240. # snippet:
  1241. #
  1242. # .type function,@function
  1243. # function:
  1244. # movq %rsp,%rax # copy rsp to volatile register
  1245. # pushq %r15 # save non-volatile registers
  1246. # pushq %rbx
  1247. # pushq %rbp
  1248. # movq %rsp,%r11
  1249. # subq %rdi,%r11 # prepare [variable] stack frame
  1250. # andq $-64,%r11
  1251. # movq %rax,0(%r11) # check for exceptions
  1252. # movq %r11,%rsp # allocate [variable] stack frame
  1253. # movq %rax,0(%rsp) # save original rsp value
  1254. # magic_point:
  1255. # ...
  1256. # movq 0(%rsp),%rcx # pull original rsp value
  1257. # movq -24(%rcx),%rbp # restore non-volatile registers
  1258. # movq -16(%rcx),%rbx
  1259. # movq -8(%rcx),%r15
  1260. # movq %rcx,%rsp # restore original rsp
  1261. # magic_epilogue:
  1262. # ret
  1263. # .size function,.-function
  1264. #
  1265. # The key is that up to magic_point copy of original rsp value remains
  1266. # in chosen volatile register and no non-volatile register, except for
  1267. # rsp, is modified. While past magic_point rsp remains constant till
  1268. # the very end of the function. In this case custom language-specific
  1269. # exception handler would look like this:
  1270. #
  1271. # EXCEPTION_DISPOSITION handler (EXCEPTION_RECORD *rec,ULONG64 frame,
  1272. # CONTEXT *context,DISPATCHER_CONTEXT *disp)
  1273. # { ULONG64 *rsp = (ULONG64 *)context->Rax;
  1274. # ULONG64 rip = context->Rip;
  1275. #
  1276. # if (rip >= magic_point)
  1277. # { rsp = (ULONG64 *)context->Rsp;
  1278. # if (rip < magic_epilogue)
  1279. # { rsp = (ULONG64 *)rsp[0];
  1280. # context->Rbp = rsp[-3];
  1281. # context->Rbx = rsp[-2];
  1282. # context->R15 = rsp[-1];
  1283. # }
  1284. # }
  1285. # context->Rsp = (ULONG64)rsp;
  1286. # context->Rdi = rsp[1];
  1287. # context->Rsi = rsp[2];
  1288. #
  1289. # memcpy (disp->ContextRecord,context,sizeof(CONTEXT));
  1290. # RtlVirtualUnwind(UNW_FLAG_NHANDLER,disp->ImageBase,
  1291. # dips->ControlPc,disp->FunctionEntry,disp->ContextRecord,
  1292. # &disp->HandlerData,&disp->EstablisherFrame,NULL);
  1293. # return ExceptionContinueSearch;
  1294. # }
  1295. #
  1296. # It's appropriate to implement this handler in assembler, directly in
  1297. # function's module. In order to do that one has to know members'
  1298. # offsets in CONTEXT and DISPATCHER_CONTEXT structures and some constant
  1299. # values. Here they are:
  1300. #
  1301. # CONTEXT.Rax 120
  1302. # CONTEXT.Rcx 128
  1303. # CONTEXT.Rdx 136
  1304. # CONTEXT.Rbx 144
  1305. # CONTEXT.Rsp 152
  1306. # CONTEXT.Rbp 160
  1307. # CONTEXT.Rsi 168
  1308. # CONTEXT.Rdi 176
  1309. # CONTEXT.R8 184
  1310. # CONTEXT.R9 192
  1311. # CONTEXT.R10 200
  1312. # CONTEXT.R11 208
  1313. # CONTEXT.R12 216
  1314. # CONTEXT.R13 224
  1315. # CONTEXT.R14 232
  1316. # CONTEXT.R15 240
  1317. # CONTEXT.Rip 248
  1318. # CONTEXT.Xmm6 512
  1319. # sizeof(CONTEXT) 1232
  1320. # DISPATCHER_CONTEXT.ControlPc 0
  1321. # DISPATCHER_CONTEXT.ImageBase 8
  1322. # DISPATCHER_CONTEXT.FunctionEntry 16
  1323. # DISPATCHER_CONTEXT.EstablisherFrame 24
  1324. # DISPATCHER_CONTEXT.TargetIp 32
  1325. # DISPATCHER_CONTEXT.ContextRecord 40
  1326. # DISPATCHER_CONTEXT.LanguageHandler 48
  1327. # DISPATCHER_CONTEXT.HandlerData 56
  1328. # UNW_FLAG_NHANDLER 0
  1329. # ExceptionContinueSearch 1
  1330. #
  1331. # In order to tie the handler to the function one has to compose
  1332. # couple of structures: one for .xdata segment and one for .pdata.
  1333. #
  1334. # UNWIND_INFO structure for .xdata segment would be
  1335. #
  1336. # function_unwind_info:
  1337. # .byte 9,0,0,0
  1338. # .rva handler
  1339. #
  1340. # This structure designates exception handler for a function with
  1341. # zero-length prologue, no stack frame or frame register.
  1342. #
  1343. # To facilitate composing of .pdata structures, auto-generated "gear"
  1344. # prologue copies rsp value to rax and denotes next instruction with
  1345. # .LSEH_begin_{function_name} label. This essentially defines the SEH
  1346. # styling rule mentioned in the beginning. Position of this label is
  1347. # chosen in such manner that possible exceptions raised in the "gear"
  1348. # prologue would be accounted to caller and unwound from latter's frame.
  1349. # End of function is marked with respective .LSEH_end_{function_name}
  1350. # label. To summarize, .pdata segment would contain
  1351. #
  1352. # .rva .LSEH_begin_function
  1353. # .rva .LSEH_end_function
  1354. # .rva function_unwind_info
  1355. #
  1356. # Reference to function_unwind_info from .xdata segment is the anchor.
  1357. # In case you wonder why references are 32-bit .rvas and not 64-bit
  1358. # .quads. References put into these two segments are required to be
  1359. # *relative* to the base address of the current binary module, a.k.a.
  1360. # image base. No Win64 module, be it .exe or .dll, can be larger than
  1361. # 2GB and thus such relative references can be and are accommodated in
  1362. # 32 bits.
  1363. #
  1364. # Having reviewed the example function code, one can argue that "movq
  1365. # %rsp,%rax" above is redundant. It is not! Keep in mind that on Unix
  1366. # rax would contain an undefined value. If this "offends" you, use
  1367. # another register and refrain from modifying rax till magic_point is
  1368. # reached, i.e. as if it was a non-volatile register. If more registers
  1369. # are required prior [variable] frame setup is completed, note that
  1370. # nobody says that you can have only one "magic point." You can
  1371. # "liberate" non-volatile registers by denoting last stack off-load
  1372. # instruction and reflecting it in finer grade unwind logic in handler.
  1373. # After all, isn't it why it's called *language-specific* handler...
  1374. #
  1375. # SE handlers are also involved in unwinding stack when executable is
  1376. # profiled or debugged. Profiling implies additional limitations that
  1377. # are too subtle to discuss here. For now it's sufficient to say that
  1378. # in order to simplify handlers one should either a) offload original
  1379. # %rsp to stack (like discussed above); or b) if you have a register to
  1380. # spare for frame pointer, choose volatile one.
  1381. #
  1382. # (*) Note that we're talking about run-time, not debug-time. Lack of
  1383. # unwind information makes debugging hard on both Windows and
  1384. # Unix. "Unlike" refers to the fact that on Unix signal handler
  1385. # will always be invoked, core dumped and appropriate exit code
  1386. # returned to parent (for user notification).