ag386int.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements an asmoutput class for Intel syntax with Intel i386+
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {
  19. This unit implements an asmoutput class for Intel syntax with Intel i386+
  20. }
  21. unit ag386int;
  22. {$i fpcdefs.inc}
  23. interface
  24. uses
  25. cpubase,
  26. aasmbase,aasmtai,aasmcpu,assemble,cgutils;
  27. type
  28. T386IntelAssembler = class(TExternalAssembler)
  29. private
  30. procedure WriteReference(var ref : treference);
  31. procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
  32. procedure WriteOper_jmp(const o:toper;s : topsize);
  33. public
  34. procedure WriteTree(p:TAAsmoutput);override;
  35. procedure WriteAsmList;override;
  36. Function DoAssemble:boolean;override;
  37. procedure WriteExternals;
  38. end;
  39. implementation
  40. uses
  41. cutils,globtype,globals,systems,cclasses,
  42. verbose,finput,fmodule,script,cpuinfo,
  43. itx86int,
  44. cgbase
  45. ;
  46. const
  47. line_length = 70;
  48. secnames : array[TAsmSectionType] of string[4] = ('',
  49. 'CODE','DATA','DATA','BSS',
  50. '','','','','','',
  51. '','','','','',''
  52. );
  53. function single2str(d : single) : string;
  54. var
  55. hs : string;
  56. p : byte;
  57. begin
  58. str(d,hs);
  59. { nasm expects a lowercase e }
  60. p:=pos('E',hs);
  61. if p>0 then
  62. hs[p]:='e';
  63. p:=pos('+',hs);
  64. if p>0 then
  65. delete(hs,p,1);
  66. single2str:=lower(hs);
  67. end;
  68. function double2str(d : double) : string;
  69. var
  70. hs : string;
  71. p : byte;
  72. begin
  73. str(d,hs);
  74. { nasm expects a lowercase e }
  75. p:=pos('E',hs);
  76. if p>0 then
  77. hs[p]:='e';
  78. p:=pos('+',hs);
  79. if p>0 then
  80. delete(hs,p,1);
  81. double2str:=lower(hs);
  82. end;
  83. function extended2str(e : extended) : string;
  84. var
  85. hs : string;
  86. p : byte;
  87. begin
  88. str(e,hs);
  89. { nasm expects a lowercase e }
  90. p:=pos('E',hs);
  91. if p>0 then
  92. hs[p]:='e';
  93. p:=pos('+',hs);
  94. if p>0 then
  95. delete(hs,p,1);
  96. extended2str:=lower(hs);
  97. end;
  98. function comp2str(d : bestreal) : string;
  99. type
  100. pdouble = ^double;
  101. var
  102. c : comp;
  103. dd : pdouble;
  104. begin
  105. {$ifdef FPC}
  106. c:=comp(d);
  107. {$else}
  108. c:=d;
  109. {$endif}
  110. dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
  111. comp2str:=double2str(dd^);
  112. end;
  113. function fixline(s:string):string;
  114. {
  115. return s with all leading and ending spaces and tabs removed
  116. }
  117. var
  118. i,j,k : longint;
  119. begin
  120. i:=length(s);
  121. while (i>0) and (s[i] in [#9,' ']) do
  122. dec(i);
  123. j:=1;
  124. while (j<i) and (s[j] in [#9,' ']) do
  125. inc(j);
  126. for k:=j to i do
  127. if s[k] in [#0..#31,#127..#255] then
  128. s[k]:='.';
  129. fixline:=Copy(s,j,i-j+1);
  130. end;
  131. {****************************************************************************
  132. T386IntelAssembler
  133. ****************************************************************************}
  134. procedure T386IntelAssembler.WriteReference(var ref : treference);
  135. var
  136. first : boolean;
  137. begin
  138. with ref do
  139. begin
  140. first:=true;
  141. if segment<>NR_NO then
  142. AsmWrite(masm_regname(segment)+':[')
  143. else
  144. AsmWrite('[');
  145. if assigned(symbol) then
  146. begin
  147. if (aktoutputformat = as_i386_tasm) then
  148. AsmWrite('dword ptr ');
  149. AsmWrite(symbol.name);
  150. first:=false;
  151. end;
  152. if (base<>NR_NO) then
  153. begin
  154. if not(first) then
  155. AsmWrite('+')
  156. else
  157. first:=false;
  158. AsmWrite(masm_regname(base));
  159. end;
  160. if (index<>NR_NO) then
  161. begin
  162. if not(first) then
  163. AsmWrite('+')
  164. else
  165. first:=false;
  166. AsmWrite(masm_regname(index));
  167. if scalefactor<>0 then
  168. AsmWrite('*'+tostr(scalefactor));
  169. end;
  170. if offset<0 then
  171. begin
  172. AsmWrite(tostr(offset));
  173. first:=false;
  174. end
  175. else if (offset>0) then
  176. begin
  177. AsmWrite('+'+tostr(offset));
  178. first:=false;
  179. end;
  180. if first then
  181. AsmWrite('0');
  182. AsmWrite(']');
  183. end;
  184. end;
  185. procedure T386IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
  186. begin
  187. case o.typ of
  188. top_reg :
  189. AsmWrite(masm_regname(o.reg));
  190. top_const :
  191. AsmWrite(tostr(longint(o.val)));
  192. top_ref :
  193. begin
  194. if o.ref^.refaddr=addr_no then
  195. begin
  196. if ((opcode <> A_LGS) and (opcode <> A_LSS) and
  197. (opcode <> A_LFS) and (opcode <> A_LDS) and
  198. (opcode <> A_LES)) then
  199. Begin
  200. case s of
  201. S_B : AsmWrite('byte ptr ');
  202. S_W : AsmWrite('word ptr ');
  203. S_L : AsmWrite('dword ptr ');
  204. S_IS : AsmWrite('word ptr ');
  205. S_IL : AsmWrite('dword ptr ');
  206. S_IQ : AsmWrite('qword ptr ');
  207. S_FS : AsmWrite('dword ptr ');
  208. S_FL : AsmWrite('qword ptr ');
  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]=(' released',' allocated',' 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 = as_i386_masm) then
  617. begin
  618. AsmWriteln(s);
  619. prefix:='';
  620. end;
  621. end
  622. else
  623. prefix:= '';
  624. if (aktoutputformat = as_i386_wasm) and
  625. (taicpu(hp).opsize=S_W) and
  626. (taicpu(hp).opcode=A_PUSH) and
  627. (taicpu(hp).oper[0]^.typ=top_const) then
  628. begin
  629. AsmWriteln(#9#9'DB 66h,68h ; pushw imm16');
  630. AsmWrite(#9#9'DW');
  631. end
  632. else
  633. AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix);
  634. if taicpu(hp).ops<>0 then
  635. begin
  636. if is_calljmp(taicpu(hp).opcode) then
  637. begin
  638. AsmWrite(#9);
  639. WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opsize);
  640. end
  641. else
  642. begin
  643. for i:=0to taicpu(hp).ops-1 do
  644. begin
  645. if i=0 then
  646. AsmWrite(#9)
  647. else
  648. AsmWrite(',');
  649. WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
  650. end;
  651. end;
  652. end;
  653. AsmLn;
  654. end;
  655. {$ifdef GDB}
  656. ait_stabn,
  657. ait_stabs,
  658. ait_force_line,
  659. ait_stab_function_name : ;
  660. {$endif GDB}
  661. ait_cutobject : begin
  662. { only reset buffer if nothing has changed }
  663. if AsmSize=AsmStartSize then
  664. AsmClear
  665. else
  666. begin
  667. if LasTSecType<>sec_none then
  668. AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS');
  669. AsmLn;
  670. AsmWriteLn(#9'END');
  671. AsmClose;
  672. DoAssemble;
  673. AsmCreate(tai_cutobject(hp).place);
  674. end;
  675. { avoid empty files }
  676. while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
  677. begin
  678. if tai(hp.next).typ=ait_section then
  679. lasTSecType:=tai_section(hp.next).sectype;
  680. hp:=tai(hp.next);
  681. end;
  682. AsmWriteLn(#9'.386p');
  683. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  684. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  685. { I was told that this isn't necesarry because }
  686. { the labels generated by FPC are unique (FK) }
  687. { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
  688. if lasTSectype<>sec_none then
  689. AsmWriteLn('_'+secnames[lasTSectype]+#9#9+
  690. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  691. secnames[lasTSectype]+'''');
  692. AsmStartSize:=AsmSize;
  693. end;
  694. ait_marker :
  695. begin
  696. if tai_marker(hp).kind=InlineStart then
  697. inc(InlineLevel)
  698. else if tai_marker(hp).kind=InlineEnd then
  699. dec(InlineLevel);
  700. end;
  701. else
  702. internalerror(10000);
  703. end;
  704. hp:=tai(hp.next);
  705. end;
  706. end;
  707. var
  708. currentasmlist : TExternalAssembler;
  709. procedure writeexternal(p:tnamedindexitem;arg:pointer);
  710. begin
  711. if tasmsymbol(p).defbind=AB_EXTERNAL then
  712. begin
  713. if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then
  714. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name
  715. +': NEAR')
  716. else
  717. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name);
  718. end;
  719. end;
  720. procedure T386IntelAssembler.WriteExternals;
  721. begin
  722. currentasmlist:=self;
  723. objectlibrary.symbolsearch.foreach_static(@writeexternal,nil);
  724. end;
  725. function t386intelassembler.DoAssemble : boolean;
  726. var f : file;
  727. begin
  728. DoAssemble:=Inherited DoAssemble;
  729. { masm does not seem to recognize specific extensions and uses .obj allways PM }
  730. if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then
  731. begin
  732. if not(cs_asm_extern in aktglobalswitches) then
  733. begin
  734. if Not FileExists(objfile) and
  735. FileExists(ForceExtension(objfile,'.obj')) then
  736. begin
  737. Assign(F,ForceExtension(objfile,'.obj'));
  738. Rename(F,objfile);
  739. end;
  740. end
  741. else
  742. AsmRes.AddAsmCommand('mv',ForceExtension(objfile,'.obj')+' '+objfile,objfile);
  743. end;
  744. end;
  745. procedure T386IntelAssembler.WriteAsmList;
  746. begin
  747. {$ifdef EXTDEBUG}
  748. if assigned(current_module.mainsource) then
  749. comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
  750. {$endif}
  751. LasTSecType:=sec_none;
  752. AsmWriteLn(#9'.386p');
  753. { masm 6.11 does not seem to like LOCALS PM }
  754. if (aktoutputformat = as_i386_tasm) then
  755. begin
  756. AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
  757. end;
  758. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  759. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  760. AsmLn;
  761. WriteExternals;
  762. { INTEL ASM doesn't support stabs
  763. WriteTree(debuglist);}
  764. WriteTree(codesegment);
  765. WriteTree(datasegment);
  766. WriteTree(consts);
  767. WriteTree(rttilist);
  768. WriteTree(resourcestringlist);
  769. WriteTree(bsssegment);
  770. AsmWriteLn(#9'END');
  771. AsmLn;
  772. {$ifdef EXTDEBUG}
  773. if assigned(current_module.mainsource) then
  774. comment(v_info,'Done writing intel-styled assembler output for '+current_module.mainsource^);
  775. {$endif EXTDEBUG}
  776. end;
  777. {*****************************************************************************
  778. Initialize
  779. *****************************************************************************}
  780. const
  781. as_i386_tasm_info : tasminfo =
  782. (
  783. id : as_i386_tasm;
  784. idtxt : 'TASM';
  785. asmbin : 'tasm';
  786. asmcmd : '/m2 /ml $ASM $OBJ';
  787. supported_target : system_any; { what should I write here ?? }
  788. flags : [af_allowdirect,af_needar,af_labelprefix_only_inside_procedure];
  789. labelprefix : '@@';
  790. comment : '; ';
  791. );
  792. as_i386_masm_info : tasminfo =
  793. (
  794. id : as_i386_masm;
  795. idtxt : 'MASM';
  796. asmbin : 'masm';
  797. asmcmd : '/c /Cp $ASM /Fo$OBJ';
  798. supported_target : system_any; { what should I write here ?? }
  799. flags : [af_allowdirect,af_needar];
  800. labelprefix : '@@';
  801. comment : '; ';
  802. );
  803. as_i386_wasm_info : tasminfo =
  804. (
  805. id : as_i386_wasm;
  806. idtxt : 'WASM';
  807. asmbin : 'wasm';
  808. asmcmd : '$ASM -6s -fp6 -ms -zq -Fo=$OBJ';
  809. supported_target : system_any; { what should I write here ?? }
  810. flags : [af_allowdirect,af_needar];
  811. labelprefix : '@@';
  812. comment : '; ';
  813. );
  814. initialization
  815. RegisterAssembler(as_i386_tasm_info,T386IntelAssembler);
  816. RegisterAssembler(as_i386_masm_info,T386IntelAssembler);
  817. RegisterAssembler(as_i386_wasm_info,T386IntelAssembler);
  818. end.
  819. {
  820. $Log$
  821. Revision 1.53 2004-10-31 21:45:03 peter
  822. * generic tlocation
  823. * move tlocation to cgutils
  824. Revision 1.52 2004/10/15 09:16:21 mazen
  825. - remove $IFDEF DELPHI and related code
  826. - remove $IFDEF FPCPROCVAR and related code
  827. Revision 1.51 2004/09/26 17:45:30 peter
  828. * simple regvar support, not yet finished
  829. Revision 1.50 2004/06/20 08:55:31 florian
  830. * logs truncated
  831. Revision 1.49 2004/06/16 20:07:10 florian
  832. * dwarf branch merged
  833. Revision 1.48 2004/05/22 23:34:28 peter
  834. tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
  835. Revision 1.47.2.6 2004/05/01 16:02:10 peter
  836. * POINTER_SIZE replaced with sizeof(aint)
  837. * aint,aword,tconst*int moved to globtype
  838. Revision 1.47.2.5 2004/04/29 19:07:22 peter
  839. * compile fixes
  840. Revision 1.47.2.4 2004/04/12 19:34:46 peter
  841. * basic framework for dwarf CFI
  842. }