ag386int.pas 37 KB

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