ag386int.pas 35 KB

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