ag386int.pas 32 KB

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