ag386int.pas 38 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056
  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;
  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. {$ifdef delphi}
  42. sysutils,
  43. {$endif}
  44. cutils,globtype,globals,systems,cclasses,
  45. verbose,finput,fmodule,script,cpuinfo,
  46. itx86int,
  47. cgbase
  48. ;
  49. const
  50. line_length = 70;
  51. function single2str(d : single) : string;
  52. var
  53. hs : string;
  54. p : byte;
  55. begin
  56. str(d,hs);
  57. { nasm expects a lowercase e }
  58. p:=pos('E',hs);
  59. if p>0 then
  60. hs[p]:='e';
  61. p:=pos('+',hs);
  62. if p>0 then
  63. delete(hs,p,1);
  64. single2str:=lower(hs);
  65. end;
  66. function double2str(d : double) : string;
  67. var
  68. hs : string;
  69. p : byte;
  70. begin
  71. str(d,hs);
  72. { nasm expects a lowercase e }
  73. p:=pos('E',hs);
  74. if p>0 then
  75. hs[p]:='e';
  76. p:=pos('+',hs);
  77. if p>0 then
  78. delete(hs,p,1);
  79. double2str:=lower(hs);
  80. end;
  81. function extended2str(e : extended) : string;
  82. var
  83. hs : string;
  84. p : byte;
  85. begin
  86. str(e,hs);
  87. { nasm expects a lowercase e }
  88. p:=pos('E',hs);
  89. if p>0 then
  90. hs[p]:='e';
  91. p:=pos('+',hs);
  92. if p>0 then
  93. delete(hs,p,1);
  94. extended2str:=lower(hs);
  95. end;
  96. function comp2str(d : bestreal) : string;
  97. type
  98. pdouble = ^double;
  99. var
  100. c : comp;
  101. dd : pdouble;
  102. begin
  103. {$ifdef FPC}
  104. c:=comp(d);
  105. {$else}
  106. c:=d;
  107. {$endif}
  108. dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
  109. comp2str:=double2str(dd^);
  110. end;
  111. function fixline(s:string):string;
  112. {
  113. return s with all leading and ending spaces and tabs removed
  114. }
  115. var
  116. i,j,k : longint;
  117. begin
  118. i:=length(s);
  119. while (i>0) and (s[i] in [#9,' ']) do
  120. dec(i);
  121. j:=1;
  122. while (j<i) and (s[j] in [#9,' ']) do
  123. inc(j);
  124. for k:=j to i do
  125. if s[k] in [#0..#31,#127..#255] then
  126. s[k]:='.';
  127. fixline:=Copy(s,j,i-j+1);
  128. end;
  129. {****************************************************************************
  130. T386IntelAssembler
  131. ****************************************************************************}
  132. procedure T386IntelAssembler.WriteReference(var ref : treference);
  133. var
  134. first : boolean;
  135. begin
  136. with ref do
  137. begin
  138. first:=true;
  139. if segment<>NR_NO then
  140. AsmWrite(masm_regname(segment)+':[')
  141. else
  142. AsmWrite('[');
  143. if assigned(symbol) then
  144. begin
  145. if (aktoutputformat = as_i386_tasm) then
  146. AsmWrite('dword ptr ');
  147. AsmWrite(symbol.name);
  148. first:=false;
  149. end;
  150. if (base<>NR_NO) then
  151. begin
  152. if not(first) then
  153. AsmWrite('+')
  154. else
  155. first:=false;
  156. AsmWrite(masm_regname(base));
  157. end;
  158. if (index<>NR_NO) then
  159. begin
  160. if not(first) then
  161. AsmWrite('+')
  162. else
  163. first:=false;
  164. AsmWrite(masm_regname(index));
  165. if scalefactor<>0 then
  166. AsmWrite('*'+tostr(scalefactor));
  167. end;
  168. if offset<0 then
  169. begin
  170. AsmWrite(tostr(offset));
  171. first:=false;
  172. end
  173. else if (offset>0) then
  174. begin
  175. AsmWrite('+'+tostr(offset));
  176. first:=false;
  177. end;
  178. if first then
  179. AsmWrite('0');
  180. AsmWrite(']');
  181. end;
  182. end;
  183. procedure T386IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
  184. begin
  185. case o.typ of
  186. top_reg :
  187. AsmWrite(masm_regname(o.reg));
  188. top_const :
  189. AsmWrite(tostr(longint(o.val)));
  190. top_ref :
  191. begin
  192. if o.ref^.refaddr=addr_no then
  193. begin
  194. if ((opcode <> A_LGS) and (opcode <> A_LSS) and
  195. (opcode <> A_LFS) and (opcode <> A_LDS) and
  196. (opcode <> A_LES)) then
  197. Begin
  198. case s of
  199. S_B : AsmWrite('byte ptr ');
  200. S_W : AsmWrite('word ptr ');
  201. S_L : AsmWrite('dword ptr ');
  202. S_IS : AsmWrite('word ptr ');
  203. S_IL : AsmWrite('dword ptr ');
  204. S_IQ : AsmWrite('qword ptr ');
  205. S_FS : AsmWrite('dword ptr ');
  206. S_FL : AsmWrite('qword ptr ');
  207. S_FX : AsmWrite('tbyte ptr ');
  208. S_BW : if dest then
  209. AsmWrite('word ptr ')
  210. else
  211. AsmWrite('byte ptr ');
  212. S_BL : if dest then
  213. AsmWrite('dword ptr ')
  214. else
  215. AsmWrite('byte ptr ');
  216. S_WL : if dest then
  217. AsmWrite('dword ptr ')
  218. else
  219. AsmWrite('word ptr ');
  220. end;
  221. end;
  222. WriteReference(o.ref^);
  223. end
  224. else
  225. begin
  226. AsmWrite('offset ');
  227. if assigned(o.ref^.symbol) then
  228. AsmWrite(o.ref^.symbol.name);
  229. if o.ref^.offset>0 then
  230. AsmWrite('+'+tostr(o.ref^.offset))
  231. else
  232. if o.ref^.offset<0 then
  233. AsmWrite(tostr(o.ref^.offset))
  234. else
  235. if not(assigned(o.ref^.symbol)) then
  236. AsmWrite('0');
  237. end;
  238. end;
  239. else
  240. internalerror(10001);
  241. end;
  242. end;
  243. procedure T386IntelAssembler.WriteOper_jmp(const o:toper;s : topsize);
  244. begin
  245. case o.typ of
  246. top_reg :
  247. AsmWrite(masm_regname(o.reg));
  248. top_const :
  249. AsmWrite(tostr(longint(o.val)));
  250. top_ref :
  251. { what about lcall or ljmp ??? }
  252. begin
  253. if o.ref^.refaddr=addr_no then
  254. begin
  255. if (aktoutputformat <> as_i386_tasm) then
  256. begin
  257. if s=S_FAR then
  258. AsmWrite('far ptr ')
  259. else
  260. AsmWrite('dword ptr ');
  261. end;
  262. WriteReference(o.ref^);
  263. end
  264. else
  265. begin
  266. AsmWrite(o.ref^.symbol.name);
  267. if o.ref^.offset>0 then
  268. AsmWrite('+'+tostr(o.ref^.offset))
  269. else
  270. if o.ref^.offset<0 then
  271. AsmWrite(tostr(o.ref^.offset));
  272. end;
  273. end;
  274. else
  275. internalerror(10001);
  276. end;
  277. end;
  278. var
  279. LasTSec : TSection;
  280. lastfileinfo : tfileposinfo;
  281. infile,
  282. lastinfile : tinputfile;
  283. const
  284. ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  285. (#9'DD'#9,#9'DW'#9,#9'DB'#9);
  286. Function PadTabs(const p:string;addch:char):string;
  287. var
  288. s : string;
  289. i : longint;
  290. begin
  291. i:=length(p);
  292. if addch<>#0 then
  293. begin
  294. inc(i);
  295. s:=p+addch;
  296. end
  297. else
  298. s:=p;
  299. if i<8 then
  300. PadTabs:=s+#9#9
  301. else
  302. PadTabs:=s+#9;
  303. end;
  304. procedure T386IntelAssembler.WriteTree(p:TAAsmoutput);
  305. const
  306. allocstr : array[boolean] of string[10]=(' released',' allocated');
  307. var
  308. s,
  309. prefix,
  310. suffix : string;
  311. hp : tai;
  312. hp1 : tailineinfo;
  313. counter,
  314. lines,
  315. InlineLevel : longint;
  316. i,j,l : longint;
  317. consttyp : taitype;
  318. found,
  319. do_line,DoNotSplitLine,
  320. quoted : boolean;
  321. begin
  322. if not assigned(p) then
  323. exit;
  324. { lineinfo is only needed for codesegment (PFV) }
  325. do_line:=((cs_asm_source in aktglobalswitches) or
  326. (cs_lineinfo in aktmoduleswitches))
  327. and (p=codesegment);
  328. InlineLevel:=0;
  329. DoNotSplitLine:=false;
  330. hp:=tai(p.first);
  331. while assigned(hp) do
  332. begin
  333. if do_line and not(hp.typ in SkipLineInfo) and
  334. not DoNotSplitLine then
  335. begin
  336. hp1:=hp as tailineinfo;
  337. { load infile }
  338. if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then
  339. begin
  340. infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex);
  341. if assigned(infile) then
  342. begin
  343. { open only if needed !! }
  344. if (cs_asm_source in aktglobalswitches) then
  345. infile.open;
  346. end;
  347. { avoid unnecessary reopens of the same file !! }
  348. lastfileinfo.fileindex:=hp1.fileinfo.fileindex;
  349. { be sure to change line !! }
  350. lastfileinfo.line:=-1;
  351. end;
  352. { write source }
  353. if (cs_asm_source in aktglobalswitches) and
  354. assigned(infile) then
  355. begin
  356. if (infile<>lastinfile) then
  357. begin
  358. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  359. if assigned(lastinfile) then
  360. lastinfile.close;
  361. end;
  362. if (hp1.fileinfo.line<>lastfileinfo.line) and
  363. ((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  364. begin
  365. if (hp1.fileinfo.line<>0) and
  366. ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then
  367. AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+
  368. fixline(infile.GetLineStr(hp1.fileinfo.line)));
  369. { set it to a negative value !
  370. to make that is has been read already !! PM }
  371. if (infile.linebuf^[hp1.fileinfo.line]>=0) then
  372. infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1;
  373. end;
  374. end;
  375. lastfileinfo:=hp1.fileinfo;
  376. lastinfile:=infile;
  377. end;
  378. DoNotSplitLine:=false;
  379. case hp.typ of
  380. ait_comment : Begin
  381. AsmWrite(target_asm.comment);
  382. AsmWritePChar(tai_comment(hp).str);
  383. AsmLn;
  384. End;
  385. ait_regalloc :
  386. begin
  387. if (cs_asm_regalloc in aktglobalswitches) then
  388. AsmWriteLn(target_asm.comment+'Register '+masm_regname(tai_regalloc(hp).reg)+
  389. allocstr[tai_regalloc(hp).allocation]);
  390. end;
  391. ait_tempalloc :
  392. begin
  393. if (cs_asm_tempalloc in aktglobalswitches) then
  394. begin
  395. {$ifdef EXTDEBUG}
  396. if assigned(tai_tempalloc(hp).problem) then
  397. AsmWriteLn(target_asm.comment+tai_tempalloc(hp).problem^+' ('+tostr(tai_tempalloc(hp).temppos)+','+
  398. tostr(tai_tempalloc(hp).tempsize)+')')
  399. else
  400. {$endif EXTDEBUG}
  401. AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+
  402. tostr(tai_tempalloc(hp).tempsize)+allocstr[tai_tempalloc(hp).allocation]);
  403. end;
  404. end;
  405. ait_section : begin
  406. if LasTSec<>sec_none then
  407. AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
  408. if tai_section(hp).sec<>sec_none then
  409. begin
  410. AsmLn;
  411. AsmWriteLn('_'+target_asm.secnames[tai_section(hp).sec]+#9#9+
  412. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  413. target_asm.secnames[tai_section(hp).sec]+'''');
  414. end;
  415. LasTSec:=tai_section(hp).sec;
  416. end;
  417. ait_align : begin
  418. { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
  419. { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
  420. { HERE UNDER TASM! }
  421. AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
  422. end;
  423. ait_datablock : begin
  424. if tai_datablock(hp).is_global then
  425. AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name);
  426. AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
  427. end;
  428. ait_const_32bit,
  429. ait_const_8bit,
  430. ait_const_16bit : begin
  431. AsmWrite(ait_const2str[hp.typ]+tostru(tai_const(hp).value));
  432. consttyp:=hp.typ;
  433. l:=0;
  434. repeat
  435. found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
  436. if found then
  437. begin
  438. hp:=tai(hp.next);
  439. s:=','+tostru(tai_const(hp).value);
  440. AsmWrite(s);
  441. inc(l,length(s));
  442. end;
  443. until (not found) or (l>line_length);
  444. AsmLn;
  445. end;
  446. ait_const_symbol : begin
  447. AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym.name);
  448. if tai_const_symbol(hp).offset>0 then
  449. AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
  450. else if tai_const_symbol(hp).offset<0 then
  451. AsmWrite(tostr(tai_const_symbol(hp).offset));
  452. AsmLn;
  453. end;
  454. ait_const_rva : begin
  455. AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym.name);
  456. end;
  457. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
  458. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
  459. ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
  460. ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value));
  461. ait_string : begin
  462. counter := 0;
  463. lines := tai_string(hp).len div line_length;
  464. { separate lines in different parts }
  465. if tai_string(hp).len > 0 then
  466. Begin
  467. for j := 0 to lines-1 do
  468. begin
  469. AsmWrite(#9#9'DB'#9);
  470. quoted:=false;
  471. for i:=counter to counter+line_length do
  472. begin
  473. { it is an ascii character. }
  474. if (ord(tai_string(hp).str[i])>31) and
  475. (ord(tai_string(hp).str[i])<128) and
  476. (tai_string(hp).str[i]<>'"') then
  477. begin
  478. if not(quoted) then
  479. begin
  480. if i>counter then
  481. AsmWrite(',');
  482. AsmWrite('"');
  483. end;
  484. AsmWrite(tai_string(hp).str[i]);
  485. quoted:=true;
  486. end { if > 31 and < 128 and ord('"') }
  487. else
  488. begin
  489. if quoted then
  490. AsmWrite('"');
  491. if i>counter then
  492. AsmWrite(',');
  493. quoted:=false;
  494. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  495. end;
  496. end; { end for i:=0 to... }
  497. if quoted then AsmWrite('"');
  498. AsmWrite(target_info.newline);
  499. counter := counter+line_length;
  500. end; { end for j:=0 ... }
  501. { do last line of lines }
  502. AsmWrite(#9#9'DB'#9);
  503. quoted:=false;
  504. for i:=counter to tai_string(hp).len-1 do
  505. begin
  506. { it is an ascii character. }
  507. if (ord(tai_string(hp).str[i])>31) and
  508. (ord(tai_string(hp).str[i])<128) and
  509. (tai_string(hp).str[i]<>'"') then
  510. begin
  511. if not(quoted) then
  512. begin
  513. if i>counter then
  514. AsmWrite(',');
  515. AsmWrite('"');
  516. end;
  517. AsmWrite(tai_string(hp).str[i]);
  518. quoted:=true;
  519. end { if > 31 and < 128 and " }
  520. else
  521. begin
  522. if quoted then
  523. AsmWrite('"');
  524. if i>counter then
  525. AsmWrite(',');
  526. quoted:=false;
  527. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  528. end;
  529. end; { end for i:=0 to... }
  530. if quoted then
  531. AsmWrite('"');
  532. end;
  533. AsmLn;
  534. end;
  535. ait_label : begin
  536. if tai_label(hp).l.is_used then
  537. begin
  538. AsmWrite(tai_label(hp).l.name);
  539. if assigned(hp.next) and not(tai(hp.next).typ in
  540. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  541. ait_const_symbol,ait_const_rva,
  542. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  543. AsmWriteLn(':')
  544. else
  545. DoNotSplitLine:=true;
  546. end;
  547. end;
  548. ait_direct : begin
  549. AsmWritePChar(tai_direct(hp).str);
  550. AsmLn;
  551. end;
  552. ait_symbol : begin
  553. if tai_symbol(hp).is_global then
  554. AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name);
  555. AsmWrite(tai_symbol(hp).sym.name);
  556. if assigned(hp.next) and not(tai(hp.next).typ in
  557. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  558. ait_const_symbol,ait_const_rva,
  559. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  560. AsmWriteLn(':')
  561. end;
  562. ait_symbol_end : begin
  563. end;
  564. ait_instruction : begin
  565. taicpu(hp).CheckNonCommutativeOpcodes;
  566. taicpu(hp).SetOperandOrder(op_intel);
  567. { Reset }
  568. suffix:='';
  569. prefix:= '';
  570. { We need to explicitely set
  571. word prefix to get selectors
  572. to be pushed in 2 bytes PM }
  573. if (taicpu(hp).opsize=S_W) and
  574. (
  575. (
  576. (taicpu(hp).opcode=A_PUSH) or
  577. (taicpu(hp).opcode=A_POP)
  578. ) and
  579. (taicpu(hp).oper[0]^.typ=top_reg) and
  580. is_segment_reg(taicpu(hp).oper[0]^.reg)
  581. ) then
  582. AsmWriteln(#9#9'DB'#9'066h');
  583. { added prefix instructions, must be on same line as opcode }
  584. if (taicpu(hp).ops = 0) and
  585. ((taicpu(hp).opcode = A_REP) or
  586. (taicpu(hp).opcode = A_LOCK) or
  587. (taicpu(hp).opcode = A_REPE) or
  588. (taicpu(hp).opcode = A_REPNZ) or
  589. (taicpu(hp).opcode = A_REPZ) or
  590. (taicpu(hp).opcode = A_REPNE)) then
  591. Begin
  592. prefix:=std_op2str[taicpu(hp).opcode]+#9;
  593. hp:=tai(hp.next);
  594. { this is theorically impossible... }
  595. if hp=nil then
  596. begin
  597. AsmWriteLn(#9#9+prefix);
  598. break;
  599. end;
  600. { nasm prefers prefix on a line alone
  601. AsmWriteln(#9#9+prefix); but not masm PM
  602. prefix:=''; }
  603. if (aktoutputformat = as_i386_masm) then
  604. begin
  605. AsmWriteln(s);
  606. prefix:='';
  607. end;
  608. end
  609. else
  610. prefix:= '';
  611. if (aktoutputformat = as_i386_wasm) and
  612. (taicpu(hp).opsize=S_W) and
  613. (taicpu(hp).opcode=A_PUSH) and
  614. (taicpu(hp).oper[0]^.typ=top_const) then
  615. begin
  616. AsmWriteln(#9#9'DB 66h,68h ; pushw imm16');
  617. AsmWrite(#9#9'DW');
  618. end
  619. else
  620. AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix);
  621. if taicpu(hp).ops<>0 then
  622. begin
  623. if is_calljmp(taicpu(hp).opcode) then
  624. begin
  625. AsmWrite(#9);
  626. WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opsize);
  627. end
  628. else
  629. begin
  630. for i:=0to taicpu(hp).ops-1 do
  631. begin
  632. if i=0 then
  633. AsmWrite(#9)
  634. else
  635. AsmWrite(',');
  636. WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
  637. end;
  638. end;
  639. end;
  640. AsmLn;
  641. end;
  642. {$ifdef GDB}
  643. ait_stabn,
  644. ait_stabs,
  645. ait_force_line,
  646. ait_stab_function_name : ;
  647. {$endif GDB}
  648. ait_cut : begin
  649. { only reset buffer if nothing has changed }
  650. if AsmSize=AsmStartSize then
  651. AsmClear
  652. else
  653. begin
  654. if LasTSec<>sec_none then
  655. AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
  656. AsmLn;
  657. AsmWriteLn(#9'END');
  658. AsmClose;
  659. DoAssemble;
  660. AsmCreate(tai_cut(hp).place);
  661. end;
  662. { avoid empty files }
  663. while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
  664. begin
  665. if tai(hp.next).typ=ait_section then
  666. begin
  667. lasTSec:=tai_section(hp.next).sec;
  668. end;
  669. hp:=tai(hp.next);
  670. end;
  671. AsmWriteLn(#9'.386p');
  672. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  673. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  674. { I was told that this isn't necesarry because }
  675. { the labels generated by FPC are unique (FK) }
  676. { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
  677. if lasTSec<>sec_none then
  678. AsmWriteLn('_'+target_asm.secnames[lasTSec]+#9#9+
  679. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  680. target_asm.secnames[lasTSec]+'''');
  681. AsmStartSize:=AsmSize;
  682. end;
  683. ait_marker :
  684. begin
  685. if tai_marker(hp).kind=InlineStart then
  686. inc(InlineLevel)
  687. else if tai_marker(hp).kind=InlineEnd then
  688. dec(InlineLevel);
  689. end;
  690. else
  691. internalerror(10000);
  692. end;
  693. hp:=tai(hp.next);
  694. end;
  695. end;
  696. var
  697. currentasmlist : TExternalAssembler;
  698. procedure writeexternal(p:tnamedindexitem;arg:pointer);
  699. begin
  700. if tasmsymbol(p).defbind=AB_EXTERNAL then
  701. begin
  702. if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then
  703. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name
  704. +': NEAR')
  705. else
  706. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name);
  707. end;
  708. end;
  709. procedure T386IntelAssembler.WriteExternals;
  710. begin
  711. currentasmlist:=self;
  712. objectlibrary.symbolsearch.foreach_static({$ifdef fpcprocvar}@{$endif}writeexternal,nil);
  713. end;
  714. function t386intelassembler.DoAssemble : boolean;
  715. var f : file;
  716. begin
  717. DoAssemble:=Inherited DoAssemble;
  718. { masm does not seem to recognize specific extensions and uses .obj allways PM }
  719. if (aktoutputformat in [as_i386_masm,as_i386_wasm]) then
  720. begin
  721. if not(cs_asm_extern in aktglobalswitches) then
  722. begin
  723. if Not FileExists(objfile) and
  724. FileExists(ForceExtension(objfile,'.obj')) then
  725. begin
  726. Assign(F,ForceExtension(objfile,'.obj'));
  727. Rename(F,objfile);
  728. end;
  729. end
  730. else
  731. AsmRes.AddAsmCommand('mv',ForceExtension(objfile,'.obj')+' '+objfile,objfile);
  732. end;
  733. end;
  734. procedure T386IntelAssembler.WriteAsmList;
  735. begin
  736. {$ifdef EXTDEBUG}
  737. if assigned(current_module.mainsource) then
  738. comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
  739. {$endif}
  740. LasTSec:=sec_none;
  741. AsmWriteLn(#9'.386p');
  742. { masm 6.11 does not seem to like LOCALS PM }
  743. if (aktoutputformat = as_i386_tasm) then
  744. begin
  745. AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
  746. end;
  747. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  748. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  749. AsmLn;
  750. WriteExternals;
  751. { INTEL ASM doesn't support stabs
  752. WriteTree(debuglist);}
  753. WriteTree(codesegment);
  754. WriteTree(datasegment);
  755. WriteTree(consts);
  756. WriteTree(rttilist);
  757. WriteTree(resourcestringlist);
  758. WriteTree(bsssegment);
  759. AsmWriteLn(#9'END');
  760. AsmLn;
  761. {$ifdef EXTDEBUG}
  762. if assigned(current_module.mainsource) then
  763. comment(v_info,'Done writing intel-styled assembler output for '+current_module.mainsource^);
  764. {$endif EXTDEBUG}
  765. end;
  766. {*****************************************************************************
  767. Initialize
  768. *****************************************************************************}
  769. const
  770. as_i386_tasm_info : tasminfo =
  771. (
  772. id : as_i386_tasm;
  773. idtxt : 'TASM';
  774. asmbin : 'tasm';
  775. asmcmd : '/m2 /ml $ASM $OBJ';
  776. supported_target : system_any; { what should I write here ?? }
  777. outputbinary: false;
  778. allowdirect : true;
  779. needar : true;
  780. labelprefix_only_inside_procedure : true;
  781. labelprefix : '@@';
  782. comment : '; ';
  783. secnames : ('',
  784. 'CODE','DATA','BSS',
  785. '','','','','','',
  786. '','','')
  787. );
  788. as_i386_masm_info : tasminfo =
  789. (
  790. id : as_i386_masm;
  791. idtxt : 'MASM';
  792. asmbin : 'masm';
  793. asmcmd : '/c /Cp $ASM /Fo$OBJ';
  794. supported_target : system_any; { what should I write here ?? }
  795. outputbinary: false;
  796. allowdirect : true;
  797. needar : true;
  798. labelprefix_only_inside_procedure : false;
  799. labelprefix : '@@';
  800. comment : '; ';
  801. secnames : ('',
  802. 'CODE','DATA','BSS',
  803. '','','','','','',
  804. '','','')
  805. );
  806. as_i386_wasm_info : tasminfo =
  807. (
  808. id : as_i386_wasm;
  809. idtxt : 'WASM';
  810. asmbin : 'wasm';
  811. asmcmd : '$ASM -6s -fp6 -ms -zq -Fo=$OBJ';
  812. supported_target : system_any; { what should I write here ?? }
  813. outputbinary: false;
  814. allowdirect : true;
  815. needar : true;
  816. labelprefix_only_inside_procedure : false;
  817. labelprefix : '@@';
  818. comment : '; ';
  819. secnames : ('',
  820. 'CODE','DATA','BSS',
  821. '','','','','','',
  822. '','','')
  823. );
  824. initialization
  825. RegisterAssembler(as_i386_tasm_info,T386IntelAssembler);
  826. RegisterAssembler(as_i386_masm_info,T386IntelAssembler);
  827. RegisterAssembler(as_i386_wasm_info,T386IntelAssembler);
  828. end.
  829. {
  830. $Log$
  831. Revision 1.46 2004-02-27 10:21:05 florian
  832. * top_symbol killed
  833. + refaddr to treference added
  834. + refsymbol to treference added
  835. * top_local stuff moved to an extra record to save memory
  836. + aint introduced
  837. * tppufile.get/putint64/aint implemented
  838. Revision 1.45 2003/12/15 15:58:17 peter
  839. * wasm args fix from wiktor
  840. Revision 1.44 2003/12/14 22:42:39 peter
  841. * fixed range check errors
  842. Revision 1.43 2003/10/21 15:15:36 peter
  843. * taicpu_abstract.oper[] changed to pointers
  844. Revision 1.42 2003/10/19 01:34:30 florian
  845. * some ppc stuff fixed
  846. * memory leak fixed
  847. Revision 1.41 2003/10/18 09:16:45 hajny
  848. * Watcom patch by Wiktor Sywula
  849. Revision 1.40 2003/09/30 08:39:50 michael
  850. + Patch from Wiktor Sywula for watcom support
  851. Revision 1.39 2003/09/23 17:56:06 peter
  852. * locals and paras are allocated in the code generation
  853. * tvarsym.localloc contains the location of para/local when
  854. generating code for the current procedure
  855. Revision 1.38 2003/09/05 17:41:13 florian
  856. * merged Wiktor's Watcom patches in 1.1
  857. Revision 1.37 2003/09/03 15:55:01 peter
  858. * NEWRA branch merged
  859. Revision 1.36.2.3 2003/08/31 15:46:26 peter
  860. * more updates for tregister
  861. Revision 1.36.2.2 2003/08/27 21:07:03 peter
  862. * more updates
  863. Revision 1.36.2.1 2003/08/27 19:55:54 peter
  864. * first tregister patch
  865. Revision 1.36 2003/08/18 11:52:57 marco
  866. * fix for 2592, pushw imm
  867. Revision 1.35 2003/08/09 18:56:54 daniel
  868. * cs_regalloc renamed to cs_regvars to avoid confusion with register
  869. allocator
  870. * Some preventive changes to i386 spillinh code
  871. Revision 1.34 2003/03/08 08:59:07 daniel
  872. + $define newra will enable new register allocator
  873. + getregisterint will return imaginary registers with $newra
  874. + -sr switch added, will skip register allocation so you can see
  875. the direct output of the code generator before register allocation
  876. Revision 1.33 2003/02/19 22:00:15 daniel
  877. * Code generator converted to new register notation
  878. - Horribily outdated todo.txt removed
  879. Revision 1.32 2003/01/08 18:43:57 daniel
  880. * Tregister changed into a record
  881. Revision 1.31 2002/12/24 18:10:34 peter
  882. * Long symbol names support
  883. Revision 1.30 2002/11/17 16:31:58 carl
  884. * memory optimization (3-4%) : cleanup of tai fields,
  885. cleanup of tdef and tsym fields.
  886. * make it work for m68k
  887. Revision 1.29 2002/11/15 01:58:56 peter
  888. * merged changes from 1.0.7 up to 04-11
  889. - -V option for generating bug report tracing
  890. - more tracing for option parsing
  891. - errors for cdecl and high()
  892. - win32 import stabs
  893. - win32 records<=8 are returned in eax:edx (turned off by default)
  894. - heaptrc update
  895. - more info for temp management in .s file with EXTDEBUG
  896. Revision 1.28 2002/08/20 21:40:44 florian
  897. + target macos for ppc added
  898. + frame work for mpw assembler output
  899. Revision 1.27 2002/08/18 20:06:28 peter
  900. * inlining is now also allowed in interface
  901. * renamed write/load to ppuwrite/ppuload
  902. * tnode storing in ppu
  903. * nld,ncon,nbas are already updated for storing in ppu
  904. Revision 1.26 2002/08/12 15:08:41 carl
  905. + stab register indexes for powerpc (moved from gdb to cpubase)
  906. + tprocessor enumeration moved to cpuinfo
  907. + linker in target_info is now a class
  908. * many many updates for m68k (will soon start to compile)
  909. - removed some ifdef or correct them for correct cpu
  910. Revision 1.25 2002/08/11 14:32:29 peter
  911. * renamed current_library to objectlibrary
  912. Revision 1.24 2002/08/11 13:24:16 peter
  913. * saving of asmsymbols in ppu supported
  914. * asmsymbollist global is removed and moved into a new class
  915. tasmlibrarydata that will hold the info of a .a file which
  916. corresponds with a single module. Added librarydata to tmodule
  917. to keep the library info stored for the module. In the future the
  918. objectfiles will also be stored to the tasmlibrarydata class
  919. * all getlabel/newasmsymbol and friends are moved to the new class
  920. Revision 1.23 2002/07/26 21:15:43 florian
  921. * rewrote the system handling
  922. Revision 1.22 2002/07/01 18:46:29 peter
  923. * internal linker
  924. * reorganized aasm layer
  925. Revision 1.21 2002/05/18 13:34:21 peter
  926. * readded missing revisions
  927. Revision 1.20 2002/05/16 19:46:50 carl
  928. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  929. + try to fix temp allocation (still in ifdef)
  930. + generic constructor calls
  931. + start of tassembler / tmodulebase class cleanup
  932. Revision 1.18 2002/05/12 16:53:16 peter
  933. * moved entry and exitcode to ncgutil and cgobj
  934. * foreach gets extra argument for passing local data to the
  935. iterator function
  936. * -CR checks also class typecasts at runtime by changing them
  937. into as
  938. * fixed compiler to cycle with the -CR option
  939. * fixed stabs with elf writer, finally the global variables can
  940. be watched
  941. * removed a lot of routines from cga unit and replaced them by
  942. calls to cgobj
  943. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  944. u32bit then the other is typecasted also to u32bit without giving
  945. a rangecheck warning/error.
  946. * fixed pascal calling method with reversing also the high tree in
  947. the parast, detected by tcalcst3 test
  948. Revision 1.17 2002/04/15 19:12:09 carl
  949. + target_info.size_of_pointer -> pointer_size
  950. + some cleanup of unused types/variables
  951. * move several constants from cpubase to their specific units
  952. (where they are used)
  953. + att_Reg2str -> gas_reg2str
  954. + int_reg2str -> std_reg2str
  955. Revision 1.16 2002/04/04 19:06:07 peter
  956. * removed unused units
  957. * use tlocation.size in cg.a_*loc*() routines
  958. Revision 1.15 2002/04/02 17:11:33 peter
  959. * tlocation,treference update
  960. * LOC_CONSTANT added for better constant handling
  961. * secondadd splitted in multiple routines
  962. * location_force_reg added for loading a location to a register
  963. of a specified size
  964. * secondassignment parses now first the right and then the left node
  965. (this is compatible with Kylix). This saves a lot of push/pop especially
  966. with string operations
  967. * adapted some routines to use the new cg methods
  968. }