ag386int.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements an asmoutput class for Intel syntax with Intel i386+
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {
  18. This unit implements an asmoutput class for Intel syntax with Intel i386+
  19. }
  20. unit ag386int;
  21. {$i fpcdefs.inc}
  22. interface
  23. uses
  24. cpubase,
  25. aasmbase,aasmtai,aasmcpu,assemble,cgutils;
  26. type
  27. T386IntelAssembler = class(TExternalAssembler)
  28. private
  29. procedure WriteReference(var ref : treference);
  30. procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
  31. procedure WriteOper_jmp(const o:toper;s : topsize);
  32. public
  33. procedure WriteTree(p:TAAsmoutput);override;
  34. procedure WriteAsmList;override;
  35. Function DoAssemble:boolean;override;
  36. procedure WriteExternals;
  37. end;
  38. implementation
  39. uses
  40. cutils,globtype,globals,systems,cclasses,
  41. verbose,finput,fmodule,script,cpuinfo,
  42. itx86int,
  43. cgbase
  44. ;
  45. const
  46. line_length = 70;
  47. secnames : array[TAsmSectionType] of string[4] = ('',
  48. 'CODE','DATA','DATA','BSS',
  49. '','','','','','',
  50. '','','','','',''
  51. );
  52. function single2str(d : single) : string;
  53. var
  54. hs : string;
  55. p : byte;
  56. begin
  57. str(d,hs);
  58. { nasm expects a lowercase e }
  59. p:=pos('E',hs);
  60. if p>0 then
  61. hs[p]:='e';
  62. p:=pos('+',hs);
  63. if p>0 then
  64. delete(hs,p,1);
  65. single2str:=lower(hs);
  66. end;
  67. function double2str(d : double) : string;
  68. var
  69. hs : string;
  70. p : byte;
  71. begin
  72. str(d,hs);
  73. { nasm expects a lowercase e }
  74. p:=pos('E',hs);
  75. if p>0 then
  76. hs[p]:='e';
  77. p:=pos('+',hs);
  78. if p>0 then
  79. delete(hs,p,1);
  80. double2str:=lower(hs);
  81. end;
  82. function extended2str(e : extended) : string;
  83. var
  84. hs : string;
  85. p : byte;
  86. begin
  87. str(e,hs);
  88. { nasm expects a lowercase e }
  89. p:=pos('E',hs);
  90. if p>0 then
  91. hs[p]:='e';
  92. p:=pos('+',hs);
  93. if p>0 then
  94. delete(hs,p,1);
  95. extended2str:=lower(hs);
  96. end;
  97. function comp2str(d : bestreal) : string;
  98. type
  99. pdouble = ^double;
  100. var
  101. c : comp;
  102. dd : pdouble;
  103. begin
  104. {$ifdef FPC}
  105. c:=comp(d);
  106. {$else}
  107. c:=d;
  108. {$endif}
  109. dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
  110. comp2str:=double2str(dd^);
  111. end;
  112. function fixline(s:string):string;
  113. {
  114. return s with all leading and ending spaces and tabs removed
  115. }
  116. var
  117. i,j,k : longint;
  118. begin
  119. i:=length(s);
  120. while (i>0) and (s[i] in [#9,' ']) do
  121. dec(i);
  122. j:=1;
  123. while (j<i) and (s[j] in [#9,' ']) do
  124. inc(j);
  125. for k:=j to i do
  126. if s[k] in [#0..#31,#127..#255] then
  127. s[k]:='.';
  128. fixline:=Copy(s,j,i-j+1);
  129. end;
  130. {****************************************************************************
  131. T386IntelAssembler
  132. ****************************************************************************}
  133. procedure T386IntelAssembler.WriteReference(var ref : treference);
  134. var
  135. first : boolean;
  136. begin
  137. with ref do
  138. begin
  139. first:=true;
  140. if segment<>NR_NO then
  141. AsmWrite(masm_regname(segment)+':[')
  142. else
  143. AsmWrite('[');
  144. if assigned(symbol) then
  145. begin
  146. if (aktoutputformat = as_i386_tasm) then
  147. AsmWrite('dword ptr ');
  148. AsmWrite(symbol.name);
  149. first:=false;
  150. end;
  151. if (base<>NR_NO) then
  152. begin
  153. if not(first) then
  154. AsmWrite('+')
  155. else
  156. first:=false;
  157. AsmWrite(masm_regname(base));
  158. end;
  159. if (index<>NR_NO) then
  160. begin
  161. if not(first) then
  162. AsmWrite('+')
  163. else
  164. first:=false;
  165. AsmWrite(masm_regname(index));
  166. if scalefactor<>0 then
  167. AsmWrite('*'+tostr(scalefactor));
  168. end;
  169. if offset<0 then
  170. begin
  171. AsmWrite(tostr(offset));
  172. first:=false;
  173. end
  174. else if (offset>0) then
  175. begin
  176. AsmWrite('+'+tostr(offset));
  177. first:=false;
  178. end;
  179. if first then
  180. AsmWrite('0');
  181. AsmWrite(']');
  182. end;
  183. end;
  184. procedure T386IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
  185. begin
  186. case o.typ of
  187. top_reg :
  188. AsmWrite(masm_regname(o.reg));
  189. top_const :
  190. AsmWrite(tostr(longint(o.val)));
  191. top_ref :
  192. begin
  193. if o.ref^.refaddr=addr_no then
  194. begin
  195. if ((opcode <> A_LGS) and (opcode <> A_LSS) and
  196. (opcode <> A_LFS) and (opcode <> A_LDS) and
  197. (opcode <> A_LES)) then
  198. Begin
  199. case s of
  200. S_B : AsmWrite('byte ptr ');
  201. S_W : AsmWrite('word ptr ');
  202. S_L : AsmWrite('dword ptr ');
  203. S_IS : AsmWrite('word ptr ');
  204. S_IL : AsmWrite('dword ptr ');
  205. S_IQ : AsmWrite('qword ptr ');
  206. S_FS : AsmWrite('dword ptr ');
  207. S_FL : AsmWrite('qword ptr ');
  208. S_T,
  209. S_FX : AsmWrite('tbyte ptr ');
  210. S_BW : if dest then
  211. AsmWrite('word ptr ')
  212. else
  213. AsmWrite('byte ptr ');
  214. S_BL : if dest then
  215. AsmWrite('dword ptr ')
  216. else
  217. AsmWrite('byte ptr ');
  218. S_WL : if dest then
  219. AsmWrite('dword ptr ')
  220. else
  221. AsmWrite('word ptr ');
  222. end;
  223. end;
  224. WriteReference(o.ref^);
  225. end
  226. else
  227. begin
  228. AsmWrite('offset ');
  229. if assigned(o.ref^.symbol) then
  230. AsmWrite(o.ref^.symbol.name);
  231. if o.ref^.offset>0 then
  232. AsmWrite('+'+tostr(o.ref^.offset))
  233. else
  234. if o.ref^.offset<0 then
  235. AsmWrite(tostr(o.ref^.offset))
  236. else
  237. if not(assigned(o.ref^.symbol)) then
  238. AsmWrite('0');
  239. end;
  240. end;
  241. else
  242. internalerror(10001);
  243. end;
  244. end;
  245. procedure T386IntelAssembler.WriteOper_jmp(const o:toper;s : topsize);
  246. begin
  247. case o.typ of
  248. top_reg :
  249. AsmWrite(masm_regname(o.reg));
  250. top_const :
  251. AsmWrite(tostr(longint(o.val)));
  252. top_ref :
  253. { what about lcall or ljmp ??? }
  254. begin
  255. if o.ref^.refaddr=addr_no then
  256. begin
  257. if (aktoutputformat <> as_i386_tasm) then
  258. begin
  259. if s=S_FAR then
  260. AsmWrite('far ptr ')
  261. else
  262. AsmWrite('dword ptr ');
  263. end;
  264. WriteReference(o.ref^);
  265. end
  266. else
  267. begin
  268. AsmWrite(o.ref^.symbol.name);
  269. if o.ref^.offset>0 then
  270. AsmWrite('+'+tostr(o.ref^.offset))
  271. else
  272. if o.ref^.offset<0 then
  273. AsmWrite(tostr(o.ref^.offset));
  274. end;
  275. end;
  276. else
  277. internalerror(10001);
  278. end;
  279. end;
  280. var
  281. LasTSectype : TAsmSectionType;
  282. lastfileinfo : tfileposinfo;
  283. infile,
  284. lastinfile : tinputfile;
  285. const
  286. ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=(
  287. #9'FIXME128',#9'FIXME64',#9'DD'#9,#9'DW'#9,#9'DB'#9,
  288. #9'FIXMESLEB',#9'FIXEMEULEB',
  289. #9'RVA'#9,#9'FIXMEINDIRECT'#9
  290. );
  291. Function PadTabs(const p:string;addch:char):string;
  292. var
  293. s : string;
  294. i : longint;
  295. begin
  296. i:=length(p);
  297. if addch<>#0 then
  298. begin
  299. inc(i);
  300. s:=p+addch;
  301. end
  302. else
  303. s:=p;
  304. if i<8 then
  305. PadTabs:=s+#9#9
  306. else
  307. PadTabs:=s+#9;
  308. end;
  309. procedure T386IntelAssembler.WriteTree(p:TAAsmoutput);
  310. const
  311. regallocstr : array[tregalloctype] of string[10]=(' allocated',' released',' sync',' resized');
  312. tempallocstr : array[boolean] of string[10]=(' released',' allocated');
  313. var
  314. s,
  315. prefix,
  316. suffix : string;
  317. hp : tai;
  318. hp1 : tailineinfo;
  319. counter,
  320. lines,
  321. InlineLevel : longint;
  322. i,j,l : longint;
  323. consttyp : taitype;
  324. do_line,DoNotSplitLine,
  325. quoted : boolean;
  326. begin
  327. if not assigned(p) then
  328. exit;
  329. { lineinfo is only needed for codesegment (PFV) }
  330. do_line:=((cs_asm_source in aktglobalswitches) or
  331. (cs_lineinfo in aktmoduleswitches))
  332. and (p=codesegment);
  333. InlineLevel:=0;
  334. DoNotSplitLine:=false;
  335. hp:=tai(p.first);
  336. while assigned(hp) do
  337. begin
  338. if do_line and not(hp.typ in SkipLineInfo) and
  339. not DoNotSplitLine then
  340. begin
  341. hp1:=hp as tailineinfo;
  342. { load infile }
  343. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  344. begin
  345. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  346. if assigned(infile) then
  347. begin
  348. { open only if needed !! }
  349. if (cs_asm_source in aktglobalswitches) then
  350. infile.open;
  351. end;
  352. { avoid unnecessary reopens of the same file !! }
  353. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  354. { be sure to change line !! }
  355. lastfileinfo.line:=-1;
  356. end;
  357. { write source }
  358. if (cs_asm_source in aktglobalswitches) and
  359. assigned(infile) then
  360. begin
  361. if (infile<>lastinfile) then
  362. begin
  363. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  364. if assigned(lastinfile) then
  365. lastinfile.close;
  366. end;
  367. if (hp1.fileinfo.line<>lastfileinfo.line) and
  368. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  369. begin
  370. if (hp1.fileinfo.line<>0) and
  371. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  372. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  373. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  374. { set it to a negative value !
  375. to make that is has been read already !! PM }
  376. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  377. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  378. end;
  379. end;
  380. lastfileinfo:=hp1.fileinfo;
  381. lastinfile:=infile;
  382. end;
  383. DoNotSplitLine:=false;
  384. case hp.typ of
  385. ait_comment : Begin
  386. AsmWrite(target_asm.comment);
  387. AsmWritePChar(tai_comment(hp).str);
  388. AsmLn;
  389. End;
  390. ait_regalloc :
  391. begin
  392. if (cs_asm_regalloc in aktglobalswitches) then
  393. AsmWriteLn(target_asm.comment+'Register '+masm_regname(tai_regalloc(hp).reg)+
  394. regallocstr[tai_regalloc(hp).ratype]);
  395. end;
  396. ait_tempalloc :
  397. begin
  398. if (cs_asm_tempalloc in aktglobalswitches) then
  399. begin
  400. {$ifdef EXTDEBUG}
  401. if assigned(tai_tempalloc(hp).problem) then
  402. AsmWriteLn(target_asm.comment+tai_tempalloc(hp).problem^+' ('+tostr(tai_tempalloc(hp).temppos)+','+
  403. tostr(tai_tempalloc(hp).tempsize)+')')
  404. else
  405. {$endif EXTDEBUG}
  406. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  407. tostr(tai_tempalloc(hp).tempsize)+tempallocstr[tai_tempalloc(hp).allocation]);
  408. end;
  409. end;
  410. ait_section : begin
  411. if LasTSecType<>sec_none then
  412. AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS');
  413. if tai_section(hp).sectype<>sec_none then
  414. begin
  415. AsmLn;
  416. AsmWriteLn('_'+secnames[tai_section(hp).sectype]+#9#9+
  417. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  418. secnames[tai_section(hp).sectype]+'''');
  419. end;
  420. LasTSecType:=tai_section(hp).sectype;
  421. end;
  422. ait_align : begin
  423. { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
  424. { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
  425. { HERE UNDER TASM! }
  426. if tai_align(hp).aligntype>1 then
  427. AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
  428. end;
  429. ait_datablock : begin
  430. if tai_datablock(hp).is_global then
  431. AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name);
  432. AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
  433. end;
  434. ait_const_uleb128bit,
  435. ait_const_sleb128bit,
  436. ait_const_128bit,
  437. ait_const_64bit,
  438. ait_const_32bit,
  439. ait_const_16bit,
  440. ait_const_8bit,
  441. ait_const_rva_symbol,
  442. ait_const_indirect_symbol :
  443. begin
  444. AsmWrite(ait_const2str[hp.typ]);
  445. consttyp:=hp.typ;
  446. l:=0;
  447. repeat
  448. if assigned(tai_const(hp).sym) then
  449. begin
  450. if assigned(tai_const(hp).endsym) then
  451. s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
  452. else
  453. s:=tai_const(hp).sym.name;
  454. if tai_const(hp).value<>0 then
  455. s:=s+tostr_with_plus(tai_const(hp).value);
  456. end
  457. else
  458. s:=tostr(tai_const(hp).value);
  459. AsmWrite(s);
  460. if (l>line_length) or
  461. (hp.next=nil) or
  462. (tai(hp.next).typ<>consttyp) then
  463. break;
  464. hp:=tai(hp.next);
  465. AsmWrite(',');
  466. until false;
  467. AsmLn;
  468. end;
  469. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
  470. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
  471. ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
  472. ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value));
  473. ait_string : begin
  474. counter := 0;
  475. lines := tai_string(hp).len div line_length;
  476. { separate lines in different parts }
  477. if tai_string(hp).len > 0 then
  478. Begin
  479. for j := 0 to lines-1 do
  480. begin
  481. AsmWrite(#9#9'DB'#9);
  482. quoted:=false;
  483. for i:=counter to counter+line_length-1 do
  484. begin
  485. { it is an ascii character. }
  486. if (ord(tai_string(hp).str[i])>31) and
  487. (ord(tai_string(hp).str[i])<128) and
  488. (tai_string(hp).str[i]<>'"') then
  489. begin
  490. if not(quoted) then
  491. begin
  492. if i>counter then
  493. AsmWrite(',');
  494. AsmWrite('"');
  495. end;
  496. AsmWrite(tai_string(hp).str[i]);
  497. quoted:=true;
  498. end { if > 31 and < 128 and ord('"') }
  499. else
  500. begin
  501. if quoted then
  502. AsmWrite('"');
  503. if i>counter then
  504. AsmWrite(',');
  505. quoted:=false;
  506. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  507. end;
  508. end; { end for i:=0 to... }
  509. if quoted then AsmWrite('"');
  510. AsmWrite(target_info.newline);
  511. counter := counter+line_length;
  512. end; { end for j:=0 ... }
  513. { do last line of lines }
  514. if counter<tai_string(hp).len then
  515. AsmWrite(#9#9'DB'#9);
  516. quoted:=false;
  517. for i:=counter to tai_string(hp).len-1 do
  518. begin
  519. { it is an ascii character. }
  520. if (ord(tai_string(hp).str[i])>31) and
  521. (ord(tai_string(hp).str[i])<128) and
  522. (tai_string(hp).str[i]<>'"') then
  523. begin
  524. if not(quoted) then
  525. begin
  526. if i>counter then
  527. AsmWrite(',');
  528. AsmWrite('"');
  529. end;
  530. AsmWrite(tai_string(hp).str[i]);
  531. quoted:=true;
  532. end { if > 31 and < 128 and " }
  533. else
  534. begin
  535. if quoted then
  536. AsmWrite('"');
  537. if i>counter then
  538. AsmWrite(',');
  539. quoted:=false;
  540. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  541. end;
  542. end; { end for i:=0 to... }
  543. if quoted then
  544. AsmWrite('"');
  545. end;
  546. AsmLn;
  547. end;
  548. ait_label : begin
  549. if tai_label(hp).l.is_used then
  550. begin
  551. AsmWrite(tai_label(hp).l.name);
  552. if assigned(hp.next) and not(tai(hp.next).typ in
  553. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  554. ait_const_rva_symbol,
  555. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  556. AsmWriteLn(':')
  557. else
  558. DoNotSplitLine:=true;
  559. end;
  560. end;
  561. ait_direct : begin
  562. AsmWritePChar(tai_direct(hp).str);
  563. AsmLn;
  564. end;
  565. ait_symbol : begin
  566. if tai_symbol(hp).is_global then
  567. AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name);
  568. AsmWrite(tai_symbol(hp).sym.name);
  569. if assigned(hp.next) and not(tai(hp.next).typ in
  570. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  571. ait_const_rva_symbol,
  572. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  573. AsmWriteLn(':')
  574. end;
  575. ait_symbol_end : begin
  576. end;
  577. ait_instruction : begin
  578. taicpu(hp).CheckNonCommutativeOpcodes;
  579. taicpu(hp).SetOperandOrder(op_intel);
  580. { Reset }
  581. suffix:='';
  582. prefix:= '';
  583. { We need to explicitely set
  584. word prefix to get selectors
  585. to be pushed in 2 bytes PM }
  586. if (taicpu(hp).opsize=S_W) and
  587. (
  588. (
  589. (taicpu(hp).opcode=A_PUSH) or
  590. (taicpu(hp).opcode=A_POP)
  591. ) and
  592. (taicpu(hp).oper[0]^.typ=top_reg) and
  593. is_segment_reg(taicpu(hp).oper[0]^.reg)
  594. ) then
  595. AsmWriteln(#9#9'DB'#9'066h');
  596. { added prefix instructions, must be on same line as opcode }
  597. if (taicpu(hp).ops = 0) and
  598. ((taicpu(hp).opcode = A_REP) or
  599. (taicpu(hp).opcode = A_LOCK) or
  600. (taicpu(hp).opcode = A_REPE) or
  601. (taicpu(hp).opcode = A_REPNZ) or
  602. (taicpu(hp).opcode = A_REPZ) or
  603. (taicpu(hp).opcode = A_REPNE)) then
  604. Begin
  605. prefix:=std_op2str[taicpu(hp).opcode]+#9;
  606. hp:=tai(hp.next);
  607. { this is theorically impossible... }
  608. if hp=nil then
  609. begin
  610. AsmWriteLn(#9#9+prefix);
  611. break;
  612. end;
  613. { nasm prefers prefix on a line alone
  614. AsmWriteln(#9#9+prefix); but not masm PM
  615. prefix:=''; }
  616. if aktoutputformat in [as_i386_nasmcoff,as_i386_nasmwin32,as_i386_nasmwdosx,
  617. as_i386_nasmelf,as_i386_nasmobj,as_i386_nasmbeos] then
  618. begin
  619. AsmWriteln(prefix);
  620. prefix:='';
  621. end;
  622. end
  623. else
  624. prefix:= '';
  625. if (aktoutputformat = as_i386_wasm) and
  626. (taicpu(hp).opsize=S_W) and
  627. (taicpu(hp).opcode=A_PUSH) and
  628. (taicpu(hp).oper[0]^.typ=top_const) then
  629. begin
  630. AsmWriteln(#9#9'DB 66h,68h ; pushw imm16');
  631. AsmWrite(#9#9'DW');
  632. end
  633. else
  634. AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix);
  635. if taicpu(hp).ops<>0 then
  636. begin
  637. if is_calljmp(taicpu(hp).opcode) then
  638. begin
  639. AsmWrite(#9);
  640. WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opsize);
  641. end
  642. else
  643. begin
  644. for i:=0to taicpu(hp).ops-1 do
  645. begin
  646. if i=0 then
  647. AsmWrite(#9)
  648. else
  649. AsmWrite(',');
  650. WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
  651. end;
  652. end;
  653. end;
  654. AsmLn;
  655. end;
  656. {$ifdef GDB}
  657. ait_stabn,
  658. ait_stabs,
  659. ait_force_line,
  660. ait_stab_function_name : ;
  661. {$endif GDB}
  662. ait_cutobject : begin
  663. { only reset buffer if nothing has changed }
  664. if AsmSize=AsmStartSize then
  665. AsmClear
  666. else
  667. begin
  668. if LasTSecType<>sec_none then
  669. AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS');
  670. AsmLn;
  671. AsmWriteLn(#9'END');
  672. AsmClose;
  673. DoAssemble;
  674. AsmCreate(tai_cutobject(hp).place);
  675. end;
  676. { avoid empty files }
  677. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  678. begin
  679. if tai(hp.next).typ=ait_section then
  680. lasTSecType:=tai_section(hp.next).sectype;
  681. hp:=tai(hp.next);
  682. end;
  683. AsmWriteLn(#9'.386p');
  684. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  685. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  686. { I was told that this isn't necesarry because }
  687. { the labels generated by FPC are unique (FK) }
  688. { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
  689. if lasTSectype<>sec_none then
  690. AsmWriteLn('_'+secnames[lasTSectype]+#9#9+
  691. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  692. secnames[lasTSectype]+'''');
  693. AsmStartSize:=AsmSize;
  694. end;
  695. ait_marker :
  696. begin
  697. if tai_marker(hp).kind=InlineStart then
  698. inc(InlineLevel)
  699. else if tai_marker(hp).kind=InlineEnd then
  700. dec(InlineLevel);
  701. end;
  702. else
  703. internalerror(10000);
  704. end;
  705. hp:=tai(hp.next);
  706. end;
  707. end;
  708. var
  709. currentasmlist : TExternalAssembler;
  710. procedure writeexternal(p:tnamedindexitem;arg:pointer);
  711. begin
  712. if tasmsymbol(p).defbind=AB_EXTERNAL then
  713. begin
  714. if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then
  715. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name
  716. +': NEAR')
  717. else
  718. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name);
  719. end;
  720. end;
  721. procedure T386IntelAssembler.WriteExternals;
  722. begin
  723. currentasmlist:=self;
  724. objectlibrary.symbolsearch.foreach_static(@writeexternal,nil);
  725. end;
  726. function t386intelassembler.DoAssemble : boolean;
  727. var f : file;
  728. begin
  729. DoAssemble:=Inherited DoAssemble;
  730. { masm does not seem to recognize specific extensions and uses .obj allways PM }
  731. if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then
  732. begin
  733. if not(cs_asm_extern in aktglobalswitches) then
  734. begin
  735. if Not FileExists(objfile) and
  736. FileExists(ForceExtension(objfile,'.obj')) then
  737. begin
  738. Assign(F,ForceExtension(objfile,'.obj'));
  739. Rename(F,objfile);
  740. end;
  741. end
  742. else
  743. AsmRes.AddAsmCommand('mv',ForceExtension(objfile,'.obj')+' '+objfile,objfile);
  744. end;
  745. end;
  746. procedure T386IntelAssembler.WriteAsmList;
  747. begin
  748. {$ifdef EXTDEBUG}
  749. if assigned(current_module.mainsource) then
  750. comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
  751. {$endif}
  752. LasTSecType:=sec_none;
  753. AsmWriteLn(#9'.386p');
  754. { masm 6.11 does not seem to like LOCALS PM }
  755. if (aktoutputformat = as_i386_tasm) then
  756. begin
  757. AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
  758. end;
  759. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  760. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  761. AsmLn;
  762. WriteExternals;
  763. { INTEL ASM doesn't support stabs
  764. WriteTree(debuglist);}
  765. WriteTree(codesegment);
  766. WriteTree(datasegment);
  767. WriteTree(consts);
  768. WriteTree(rttilist);
  769. WriteTree(resourcestringlist);
  770. WriteTree(bsssegment);
  771. AsmWriteLn(#9'END');
  772. AsmLn;
  773. {$ifdef EXTDEBUG}
  774. if assigned(current_module.mainsource) then
  775. comment(v_info,'Done writing intel-styled assembler output for '+current_module.mainsource^);
  776. {$endif EXTDEBUG}
  777. end;
  778. {*****************************************************************************
  779. Initialize
  780. *****************************************************************************}
  781. const
  782. as_i386_tasm_info : tasminfo =
  783. (
  784. id : as_i386_tasm;
  785. idtxt : 'TASM';
  786. asmbin : 'tasm';
  787. asmcmd : '/m2 /ml $ASM $OBJ';
  788. supported_target : system_any; { what should I write here ?? }
  789. flags : [af_allowdirect,af_needar,af_labelprefix_only_inside_procedure];
  790. labelprefix : '@@';
  791. comment : '; ';
  792. );
  793. as_i386_masm_info : tasminfo =
  794. (
  795. id : as_i386_masm;
  796. idtxt : 'MASM';
  797. asmbin : 'masm';
  798. asmcmd : '/c /Cp $ASM /Fo$OBJ';
  799. supported_target : system_any; { what should I write here ?? }
  800. flags : [af_allowdirect,af_needar];
  801. labelprefix : '@@';
  802. comment : '; ';
  803. );
  804. as_i386_wasm_info : tasminfo =
  805. (
  806. id : as_i386_wasm;
  807. idtxt : 'WASM';
  808. asmbin : 'wasm';
  809. asmcmd : '$ASM -6s -fp6 -ms -zq -Fo=$OBJ';
  810. supported_target : system_any; { what should I write here ?? }
  811. flags : [af_allowdirect,af_needar];
  812. labelprefix : '@@';
  813. comment : '; ';
  814. );
  815. initialization
  816. RegisterAssembler(as_i386_tasm_info,T386IntelAssembler);
  817. RegisterAssembler(as_i386_masm_info,T386IntelAssembler);
  818. RegisterAssembler(as_i386_wasm_info,T386IntelAssembler);
  819. end.