ag386int.pas 31 KB

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