ag386int.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899
  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 aasmbase,aasmtai,aasmcpu,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,finput,fmodule,script,cpuinfo
  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. {$ifdef GDB}
  299. ait_stabn,ait_stabs,ait_stab_function_name,
  300. {$endif GDB}
  301. ait_cut,ait_marker,ait_align,ait_section];
  302. var
  303. s,
  304. prefix,
  305. suffix : string;
  306. hp : tai;
  307. counter,
  308. lines,
  309. InlineLevel : longint;
  310. i,j,l : longint;
  311. consttyp : tait;
  312. found,
  313. do_line,DoNotSplitLine,
  314. quoted : boolean;
  315. sep : char;
  316. begin
  317. if not assigned(p) then
  318. exit;
  319. { lineinfo is only needed for codesegment (PFV) }
  320. do_line:=((cs_asm_source in aktglobalswitches) or
  321. (cs_lineinfo in aktmoduleswitches))
  322. and (p=codesegment);
  323. InlineLevel:=0;
  324. DoNotSplitLine:=false;
  325. hp:=tai(p.first);
  326. while assigned(hp) do
  327. begin
  328. if do_line and not(hp.typ in nolinetai) and
  329. not DoNotSplitLine then
  330. begin
  331. { load infile }
  332. if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
  333. begin
  334. infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
  335. if assigned(infile) then
  336. begin
  337. { open only if needed !! }
  338. if (cs_asm_source in aktglobalswitches) then
  339. infile.open;
  340. end;
  341. { avoid unnecessary reopens of the same file !! }
  342. lastfileinfo.fileindex:=hp.fileinfo.fileindex;
  343. { be sure to change line !! }
  344. lastfileinfo.line:=-1;
  345. end;
  346. { write source }
  347. if (cs_asm_source in aktglobalswitches) and
  348. assigned(infile) then
  349. begin
  350. if (infile<>lastinfile) then
  351. begin
  352. AsmWriteLn(target_asm.comment+'['+infile.name^+']');
  353. if assigned(lastinfile) then
  354. lastinfile.close;
  355. end;
  356. if (hp.fileinfo.line<>lastfileinfo.line) and
  357. ((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
  358. begin
  359. if (hp.fileinfo.line<>0) and
  360. ((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
  361. AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
  362. fixline(infile.GetLineStr(hp.fileinfo.line)));
  363. { set it to a negative value !
  364. to make that is has been read already !! PM }
  365. if (infile.linebuf^[hp.fileinfo.line]>=0) then
  366. infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
  367. end;
  368. end;
  369. lastfileinfo:=hp.fileinfo;
  370. lastinfile:=infile;
  371. end;
  372. DoNotSplitLine:=false;
  373. case hp.typ of
  374. ait_comment : Begin
  375. AsmWrite(target_asm.comment);
  376. AsmWritePChar(tai_asm_comment(hp).str);
  377. AsmLn;
  378. End;
  379. ait_regalloc,
  380. ait_tempalloc : ;
  381. ait_section : begin
  382. if LasTSec<>sec_none then
  383. AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
  384. if tai_section(hp).sec<>sec_none then
  385. begin
  386. AsmLn;
  387. AsmWriteLn('_'+target_asm.secnames[tai_section(hp).sec]+#9#9+
  388. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  389. target_asm.secnames[tai_section(hp).sec]+'''');
  390. end;
  391. LasTSec:=tai_section(hp).sec;
  392. end;
  393. ait_align : begin
  394. { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
  395. { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
  396. { HERE UNDER TASM! }
  397. AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
  398. end;
  399. ait_datablock : begin
  400. if tai_datablock(hp).is_global then
  401. AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name);
  402. AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
  403. end;
  404. ait_const_32bit,
  405. ait_const_8bit,
  406. ait_const_16bit : begin
  407. AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value));
  408. consttyp:=hp.typ;
  409. l:=0;
  410. repeat
  411. found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
  412. if found then
  413. begin
  414. hp:=tai(hp.next);
  415. s:=','+tostr(tai_const(hp).value);
  416. AsmWrite(s);
  417. inc(l,length(s));
  418. end;
  419. until (not found) or (l>line_length);
  420. AsmLn;
  421. end;
  422. ait_const_symbol : begin
  423. AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym.name);
  424. if tai_const_symbol(hp).offset>0 then
  425. AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
  426. else if tai_const_symbol(hp).offset<0 then
  427. AsmWrite(tostr(tai_const_symbol(hp).offset));
  428. AsmLn;
  429. end;
  430. ait_const_rva : begin
  431. AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym.name);
  432. end;
  433. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
  434. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
  435. ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
  436. ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value));
  437. ait_string : begin
  438. counter := 0;
  439. lines := tai_string(hp).len div line_length;
  440. { separate lines in different parts }
  441. if tai_string(hp).len > 0 then
  442. Begin
  443. for j := 0 to lines-1 do
  444. begin
  445. AsmWrite(#9#9'DB'#9);
  446. quoted:=false;
  447. for i:=counter to counter+line_length do
  448. begin
  449. { it is an ascii character. }
  450. if (ord(tai_string(hp).str[i])>31) and
  451. (ord(tai_string(hp).str[i])<128) and
  452. (tai_string(hp).str[i]<>'"') then
  453. begin
  454. if not(quoted) then
  455. begin
  456. if i>counter then
  457. AsmWrite(',');
  458. AsmWrite('"');
  459. end;
  460. AsmWrite(tai_string(hp).str[i]);
  461. quoted:=true;
  462. end { if > 31 and < 128 and ord('"') }
  463. else
  464. begin
  465. if quoted then
  466. AsmWrite('"');
  467. if i>counter then
  468. AsmWrite(',');
  469. quoted:=false;
  470. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  471. end;
  472. end; { end for i:=0 to... }
  473. if quoted then AsmWrite('"');
  474. AsmWrite(target_info.newline);
  475. counter := counter+line_length;
  476. end; { end for j:=0 ... }
  477. { do last line of lines }
  478. AsmWrite(#9#9'DB'#9);
  479. quoted:=false;
  480. for i:=counter to tai_string(hp).len-1 do
  481. begin
  482. { it is an ascii character. }
  483. if (ord(tai_string(hp).str[i])>31) and
  484. (ord(tai_string(hp).str[i])<128) and
  485. (tai_string(hp).str[i]<>'"') then
  486. begin
  487. if not(quoted) then
  488. begin
  489. if i>counter then
  490. AsmWrite(',');
  491. AsmWrite('"');
  492. end;
  493. AsmWrite(tai_string(hp).str[i]);
  494. quoted:=true;
  495. end { if > 31 and < 128 and " }
  496. else
  497. begin
  498. if quoted then
  499. AsmWrite('"');
  500. if i>counter then
  501. AsmWrite(',');
  502. quoted:=false;
  503. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  504. end;
  505. end; { end for i:=0 to... }
  506. if quoted then
  507. AsmWrite('"');
  508. end;
  509. AsmLn;
  510. end;
  511. ait_label : begin
  512. if tai_label(hp).l.is_used then
  513. begin
  514. AsmWrite(tai_label(hp).l.name);
  515. if assigned(hp.next) and not(tai(hp.next).typ in
  516. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  517. ait_const_symbol,ait_const_rva,
  518. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  519. AsmWriteLn(':')
  520. else
  521. DoNotSplitLine:=true;
  522. end;
  523. end;
  524. ait_direct : begin
  525. AsmWritePChar(tai_direct(hp).str);
  526. AsmLn;
  527. end;
  528. ait_symbol : begin
  529. if tai_symbol(hp).is_global then
  530. AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name);
  531. AsmWrite(tai_symbol(hp).sym.name);
  532. if assigned(hp.next) and not(tai(hp.next).typ in
  533. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  534. ait_const_symbol,ait_const_rva,
  535. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  536. AsmWriteLn(':')
  537. end;
  538. ait_symbol_end : begin
  539. end;
  540. ait_instruction : begin
  541. { Must be done with args in ATT order }
  542. taicpu(hp).SetOperandOrder(op_att);
  543. taicpu(hp).CheckNonCommutativeOpcodes;
  544. { We need intel order, no At&t }
  545. taicpu(hp).SetOperandOrder(op_intel);
  546. { Reset }
  547. suffix:='';
  548. prefix:= '';
  549. s:='';
  550. { We need to explicitely set
  551. word prefix to get selectors
  552. to be pushed in 2 bytes PM }
  553. if (taicpu(hp).opsize=S_W) and
  554. ((taicpu(hp).opcode=A_PUSH) or
  555. (taicpu(hp).opcode=A_POP)) and
  556. (taicpu(hp).oper[0].typ=top_reg) and
  557. ((taicpu(hp).oper[0].reg>=firstsreg) and
  558. (taicpu(hp).oper[0].reg<=lastsreg)) then
  559. AsmWriteln(#9#9'DB'#9'066h');
  560. { added prefix instructions, must be on same line as opcode }
  561. if (taicpu(hp).ops = 0) and
  562. ((taicpu(hp).opcode = A_REP) or
  563. (taicpu(hp).opcode = A_LOCK) or
  564. (taicpu(hp).opcode = A_REPE) or
  565. (taicpu(hp).opcode = A_REPNZ) or
  566. (taicpu(hp).opcode = A_REPZ) or
  567. (taicpu(hp).opcode = A_REPNE)) then
  568. Begin
  569. prefix:=std_op2str[taicpu(hp).opcode]+#9;
  570. hp:=tai(hp.next);
  571. { this is theorically impossible... }
  572. if hp=nil then
  573. begin
  574. s:=#9#9+prefix;
  575. AsmWriteLn(s);
  576. break;
  577. end;
  578. { nasm prefers prefix on a line alone
  579. AsmWriteln(#9#9+prefix); but not masm PM
  580. prefix:=''; }
  581. if (aktoutputformat = as_i386_masm) then
  582. begin
  583. AsmWriteln(s);
  584. prefix:='';
  585. end;
  586. end
  587. else
  588. prefix:= '';
  589. if taicpu(hp).ops<>0 then
  590. begin
  591. if is_calljmp(taicpu(hp).opcode) then
  592. s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opsize)
  593. else
  594. begin
  595. for i:=0to taicpu(hp).ops-1 do
  596. begin
  597. if i=0 then
  598. sep:=#9
  599. else
  600. sep:=',';
  601. s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
  602. end;
  603. end;
  604. end;
  605. AsmWriteLn(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix+s);
  606. end;
  607. {$ifdef GDB}
  608. ait_stabn,
  609. ait_stabs,
  610. ait_force_line,
  611. ait_stab_function_name : ;
  612. {$endif GDB}
  613. ait_cut : begin
  614. { only reset buffer if nothing has changed }
  615. if AsmSize=AsmStartSize then
  616. AsmClear
  617. else
  618. begin
  619. if LasTSec<>sec_none then
  620. AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
  621. AsmLn;
  622. AsmWriteLn(#9'END');
  623. AsmClose;
  624. DoAssemble;
  625. AsmCreate(tai_cut(hp).place);
  626. end;
  627. { avoid empty files }
  628. while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
  629. begin
  630. if tai(hp.next).typ=ait_section then
  631. begin
  632. lasTSec:=tai_section(hp.next).sec;
  633. end;
  634. hp:=tai(hp.next);
  635. end;
  636. AsmWriteLn(#9'.386p');
  637. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  638. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  639. { I was told that this isn't necesarry because }
  640. { the labels generated by FPC are unique (FK) }
  641. { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
  642. if lasTSec<>sec_none then
  643. AsmWriteLn('_'+target_asm.secnames[lasTSec]+#9#9+
  644. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  645. target_asm.secnames[lasTSec]+'''');
  646. AsmStartSize:=AsmSize;
  647. end;
  648. ait_marker :
  649. begin
  650. if tai_marker(hp).kind=InlineStart then
  651. inc(InlineLevel)
  652. else if tai_marker(hp).kind=InlineEnd then
  653. dec(InlineLevel);
  654. end;
  655. else
  656. internalerror(10000);
  657. end;
  658. hp:=tai(hp.next);
  659. end;
  660. end;
  661. var
  662. currentasmlist : TExternalAssembler;
  663. procedure writeexternal(p:tnamedindexitem;arg:pointer);
  664. begin
  665. if tasmsymbol(p).defbind=AB_EXTERNAL then
  666. begin
  667. if (aktoutputformat = as_i386_masm) then
  668. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name
  669. +': NEAR')
  670. else
  671. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name);
  672. end;
  673. end;
  674. procedure T386IntelAssembler.WriteExternals;
  675. begin
  676. currentasmlist:=self;
  677. objectlibrary.symbolsearch.foreach_static({$ifdef fpcprocvar}@{$endif}writeexternal,nil);
  678. end;
  679. function t386intelassembler.DoAssemble : boolean;
  680. var f : file;
  681. begin
  682. DoAssemble:=Inherited DoAssemble;
  683. { masm does not seem to recognize specific extensions and uses .obj allways PM }
  684. if (aktoutputformat = as_i386_masm) then
  685. begin
  686. if not(cs_asm_extern in aktglobalswitches) then
  687. begin
  688. if Not FileExists(objfile) and
  689. FileExists(ForceExtension(objfile,'.obj')) then
  690. begin
  691. Assign(F,ForceExtension(objfile,'.obj'));
  692. Rename(F,objfile);
  693. end;
  694. end
  695. else
  696. AsmRes.AddAsmCommand('mv',ForceExtension(objfile,'.obj')+' '+objfile,objfile);
  697. end;
  698. end;
  699. procedure T386IntelAssembler.WriteAsmList;
  700. begin
  701. {$ifdef EXTDEBUG}
  702. if assigned(current_module.mainsource) then
  703. comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
  704. {$endif}
  705. LasTSec:=sec_none;
  706. AsmWriteLn(#9'.386p');
  707. { masm 6.11 does not seem to like LOCALS PM }
  708. if (aktoutputformat = as_i386_tasm) then
  709. begin
  710. AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
  711. end;
  712. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  713. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  714. AsmLn;
  715. WriteExternals;
  716. { INTEL ASM doesn't support stabs
  717. WriteTree(debuglist);}
  718. WriteTree(codesegment);
  719. WriteTree(datasegment);
  720. WriteTree(consts);
  721. WriteTree(rttilist);
  722. WriteTree(resourcestringlist);
  723. WriteTree(bsssegment);
  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 : system_any; { what should I write here ?? }
  742. outputbinary: false;
  743. allowdirect : true;
  744. needar : true;
  745. labelprefix_only_inside_procedure : true;
  746. labelprefix : '@@';
  747. comment : '; ';
  748. secnames : ('',
  749. 'CODE','DATA','BSS',
  750. '','','','','','',
  751. '','','')
  752. );
  753. as_i386_masm_info : tasminfo =
  754. (
  755. id : as_i386_masm;
  756. idtxt : 'MASM';
  757. asmbin : 'masm';
  758. asmcmd : '/c /Cp $ASM /Fo$OBJ';
  759. supported_target : system_any; { what should I write here ?? }
  760. outputbinary: false;
  761. allowdirect : true;
  762. needar : true;
  763. labelprefix_only_inside_procedure : false;
  764. labelprefix : '@@';
  765. comment : '; ';
  766. secnames : ('',
  767. 'CODE','DATA','BSS',
  768. '','','','','','',
  769. '','','')
  770. );
  771. initialization
  772. RegisterAssembler(as_i386_tasm_info,T386IntelAssembler);
  773. RegisterAssembler(as_i386_masm_info,T386IntelAssembler);
  774. end.
  775. {
  776. $Log$
  777. Revision 1.26 2002-08-12 15:08:41 carl
  778. + stab register indexes for powerpc (moved from gdb to cpubase)
  779. + tprocessor enumeration moved to cpuinfo
  780. + linker in target_info is now a class
  781. * many many updates for m68k (will soon start to compile)
  782. - removed some ifdef or correct them for correct cpu
  783. Revision 1.25 2002/08/11 14:32:29 peter
  784. * renamed current_library to objectlibrary
  785. Revision 1.24 2002/08/11 13:24:16 peter
  786. * saving of asmsymbols in ppu supported
  787. * asmsymbollist global is removed and moved into a new class
  788. tasmlibrarydata that will hold the info of a .a file which
  789. corresponds with a single module. Added librarydata to tmodule
  790. to keep the library info stored for the module. In the future the
  791. objectfiles will also be stored to the tasmlibrarydata class
  792. * all getlabel/newasmsymbol and friends are moved to the new class
  793. Revision 1.23 2002/07/26 21:15:43 florian
  794. * rewrote the system handling
  795. Revision 1.22 2002/07/01 18:46:29 peter
  796. * internal linker
  797. * reorganized aasm layer
  798. Revision 1.21 2002/05/18 13:34:21 peter
  799. * readded missing revisions
  800. Revision 1.20 2002/05/16 19:46:50 carl
  801. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  802. + try to fix temp allocation (still in ifdef)
  803. + generic constructor calls
  804. + start of tassembler / tmodulebase class cleanup
  805. Revision 1.18 2002/05/12 16:53:16 peter
  806. * moved entry and exitcode to ncgutil and cgobj
  807. * foreach gets extra argument for passing local data to the
  808. iterator function
  809. * -CR checks also class typecasts at runtime by changing them
  810. into as
  811. * fixed compiler to cycle with the -CR option
  812. * fixed stabs with elf writer, finally the global variables can
  813. be watched
  814. * removed a lot of routines from cga unit and replaced them by
  815. calls to cgobj
  816. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  817. u32bit then the other is typecasted also to u32bit without giving
  818. a rangecheck warning/error.
  819. * fixed pascal calling method with reversing also the high tree in
  820. the parast, detected by tcalcst3 test
  821. Revision 1.17 2002/04/15 19:12:09 carl
  822. + target_info.size_of_pointer -> pointer_size
  823. + some cleanup of unused types/variables
  824. * move several constants from cpubase to their specific units
  825. (where they are used)
  826. + att_Reg2str -> gas_reg2str
  827. + int_reg2str -> std_reg2str
  828. Revision 1.16 2002/04/04 19:06:07 peter
  829. * removed unused units
  830. * use tlocation.size in cg.a_*loc*() routines
  831. Revision 1.15 2002/04/02 17:11:33 peter
  832. * tlocation,treference update
  833. * LOC_CONSTANT added for better constant handling
  834. * secondadd splitted in multiple routines
  835. * location_force_reg added for loading a location to a register
  836. of a specified size
  837. * secondassignment parses now first the right and then the left node
  838. (this is compatible with Kylix). This saves a lot of push/pop especially
  839. with string operations
  840. * adapted some routines to use the new cg methods
  841. }