ag386int.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882
  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
  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. AsmSymbolList.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. 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 : system_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.23 2002-07-26 21:15:43 florian
  780. * rewrote the system handling
  781. Revision 1.22 2002/07/01 18:46:29 peter
  782. * internal linker
  783. * reorganized aasm layer
  784. Revision 1.21 2002/05/18 13:34:21 peter
  785. * readded missing revisions
  786. Revision 1.20 2002/05/16 19:46:50 carl
  787. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  788. + try to fix temp allocation (still in ifdef)
  789. + generic constructor calls
  790. + start of tassembler / tmodulebase class cleanup
  791. Revision 1.18 2002/05/12 16:53:16 peter
  792. * moved entry and exitcode to ncgutil and cgobj
  793. * foreach gets extra argument for passing local data to the
  794. iterator function
  795. * -CR checks also class typecasts at runtime by changing them
  796. into as
  797. * fixed compiler to cycle with the -CR option
  798. * fixed stabs with elf writer, finally the global variables can
  799. be watched
  800. * removed a lot of routines from cga unit and replaced them by
  801. calls to cgobj
  802. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  803. u32bit then the other is typecasted also to u32bit without giving
  804. a rangecheck warning/error.
  805. * fixed pascal calling method with reversing also the high tree in
  806. the parast, detected by tcalcst3 test
  807. Revision 1.17 2002/04/15 19:12:09 carl
  808. + target_info.size_of_pointer -> pointer_size
  809. + some cleanup of unused types/variables
  810. * move several constants from cpubase to their specific units
  811. (where they are used)
  812. + att_Reg2str -> gas_reg2str
  813. + int_reg2str -> std_reg2str
  814. Revision 1.16 2002/04/04 19:06:07 peter
  815. * removed unused units
  816. * use tlocation.size in cg.a_*loc*() routines
  817. Revision 1.15 2002/04/02 17:11:33 peter
  818. * tlocation,treference update
  819. * LOC_CONSTANT added for better constant handling
  820. * secondadd splitted in multiple routines
  821. * location_force_reg added for loading a location to a register
  822. of a specified size
  823. * secondassignment parses now first the right and then the left node
  824. (this is compatible with Kylix). This saves a lot of push/pop especially
  825. with string operations
  826. * adapted some routines to use the new cg methods
  827. }