ag386int.pas 30 KB

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