ag386int.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847
  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. 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:=int_reg2str[o.reg];
  158. top_const :
  159. getopstr:=tostr(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:=int_reg2str[o.reg];
  220. top_const :
  221. getopstr_jmp:=tostr(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:='near 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. allocstr : array[boolean] of string[10]=(' released',' allocated');
  300. nolinetai =[ait_label,
  301. ait_regalloc,ait_tempalloc,
  302. ait_stabn,ait_stabs,ait_section,
  303. ait_cut,ait_marker,ait_align,ait_stab_function_name];
  304. var
  305. s,
  306. prefix,
  307. suffix : string;
  308. hp : tai;
  309. counter,
  310. lines,
  311. InlineLevel : longint;
  312. i,j,l : longint;
  313. consttyp : tait;
  314. found,
  315. do_line,
  316. quoted : boolean;
  317. sep : char;
  318. begin
  319. if not assigned(p) then
  320. exit;
  321. { lineinfo is only needed for codesegment (PFV) }
  322. do_line:=((cs_asm_source in aktglobalswitches) or
  323. (cs_lineinfo in aktmoduleswitches))
  324. and (p=codesegment);
  325. InlineLevel:=0;
  326. hp:=tai(p.first);
  327. while assigned(hp) do
  328. begin
  329. if do_line and not(hp.typ in nolinetai) 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. case hp.typ of
  373. ait_comment : Begin
  374. AsmWrite(target_asm.comment);
  375. AsmWritePChar(tai_asm_comment(hp).str);
  376. AsmLn;
  377. End;
  378. ait_regalloc,
  379. ait_tempalloc : ;
  380. ait_section : begin
  381. if LastSec<>sec_none then
  382. AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
  383. if tai_section(hp).sec<>sec_none then
  384. begin
  385. AsmLn;
  386. AsmWriteLn('_'+target_asm.secnames[tai_section(hp).sec]+#9#9+
  387. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  388. target_asm.secnames[tai_section(hp).sec]+'''');
  389. end;
  390. LastSec:=tai_section(hp).sec;
  391. end;
  392. ait_align : begin
  393. { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
  394. { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
  395. { HERE UNDER TASM! }
  396. AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
  397. end;
  398. ait_datablock : begin
  399. if tai_datablock(hp).is_global then
  400. AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name);
  401. AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
  402. end;
  403. ait_const_32bit,
  404. ait_const_8bit,
  405. ait_const_16bit : begin
  406. AsmWrite(ait_const2str[hp.typ]+tostr(tai_const(hp).value));
  407. consttyp:=hp.typ;
  408. l:=0;
  409. repeat
  410. found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
  411. if found then
  412. begin
  413. hp:=tai(hp.next);
  414. s:=','+tostr(tai_const(hp).value);
  415. AsmWrite(s);
  416. inc(l,length(s));
  417. end;
  418. until (not found) or (l>line_length);
  419. AsmLn;
  420. end;
  421. ait_const_symbol : begin
  422. AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym.name);
  423. if tai_const_symbol(hp).offset>0 then
  424. AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
  425. else if tai_const_symbol(hp).offset<0 then
  426. AsmWrite(tostr(tai_const_symbol(hp).offset));
  427. AsmLn;
  428. end;
  429. ait_const_rva : begin
  430. AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym.name);
  431. end;
  432. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
  433. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
  434. ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
  435. ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value));
  436. ait_string : begin
  437. counter := 0;
  438. lines := tai_string(hp).len div line_length;
  439. { separate lines in different parts }
  440. if tai_string(hp).len > 0 then
  441. Begin
  442. for j := 0 to lines-1 do
  443. begin
  444. AsmWrite(#9#9'DB'#9);
  445. quoted:=false;
  446. for i:=counter to counter+line_length do
  447. begin
  448. { it is an ascii character. }
  449. if (ord(tai_string(hp).str[i])>31) and
  450. (ord(tai_string(hp).str[i])<128) and
  451. (tai_string(hp).str[i]<>'"') then
  452. begin
  453. if not(quoted) then
  454. begin
  455. if i>counter then
  456. AsmWrite(',');
  457. AsmWrite('"');
  458. end;
  459. AsmWrite(tai_string(hp).str[i]);
  460. quoted:=true;
  461. end { if > 31 and < 128 and ord('"') }
  462. else
  463. begin
  464. if quoted then
  465. AsmWrite('"');
  466. if i>counter then
  467. AsmWrite(',');
  468. quoted:=false;
  469. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  470. end;
  471. end; { end for i:=0 to... }
  472. if quoted then AsmWrite('"');
  473. AsmWrite(target_info.newline);
  474. counter := counter+line_length;
  475. end; { end for j:=0 ... }
  476. { do last line of lines }
  477. AsmWrite(#9#9'DB'#9);
  478. quoted:=false;
  479. for i:=counter to tai_string(hp).len-1 do
  480. begin
  481. { it is an ascii character. }
  482. if (ord(tai_string(hp).str[i])>31) and
  483. (ord(tai_string(hp).str[i])<128) and
  484. (tai_string(hp).str[i]<>'"') then
  485. begin
  486. if not(quoted) then
  487. begin
  488. if i>counter then
  489. AsmWrite(',');
  490. AsmWrite('"');
  491. end;
  492. AsmWrite(tai_string(hp).str[i]);
  493. quoted:=true;
  494. end { if > 31 and < 128 and " }
  495. else
  496. begin
  497. if quoted then
  498. AsmWrite('"');
  499. if i>counter then
  500. AsmWrite(',');
  501. quoted:=false;
  502. AsmWrite(tostr(ord(tai_string(hp).str[i])));
  503. end;
  504. end; { end for i:=0 to... }
  505. if quoted then
  506. AsmWrite('"');
  507. end;
  508. AsmLn;
  509. end;
  510. ait_label : begin
  511. if tai_label(hp).l.is_used then
  512. begin
  513. AsmWrite(tai_label(hp).l.name);
  514. if assigned(hp.next) and not(tai(hp.next).typ in
  515. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  516. ait_const_symbol,ait_const_rva,
  517. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  518. AsmWriteLn(':');
  519. end;
  520. end;
  521. ait_direct : begin
  522. AsmWritePChar(tai_direct(hp).str);
  523. AsmLn;
  524. end;
  525. ait_symbol : begin
  526. if tai_symbol(hp).is_global then
  527. AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name);
  528. AsmWrite(tai_symbol(hp).sym.name);
  529. if assigned(hp.next) and not(tai(hp.next).typ in
  530. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  531. ait_const_symbol,ait_const_rva,
  532. ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
  533. AsmWriteLn(':')
  534. end;
  535. ait_symbol_end : begin
  536. end;
  537. ait_instruction : begin
  538. { Must be done with args in ATT order }
  539. taicpu(hp).SetOperandOrder(op_att);
  540. taicpu(hp).CheckNonCommutativeOpcodes;
  541. { We need intel order, no At&t }
  542. taicpu(hp).SetOperandOrder(op_intel);
  543. { Reset }
  544. suffix:='';
  545. prefix:= '';
  546. s:='';
  547. { We need to explicitely set
  548. word prefix to get selectors
  549. to be pushed in 2 bytes PM }
  550. if (taicpu(hp).opsize=S_W) and
  551. ((taicpu(hp).opcode=A_PUSH) or
  552. (taicpu(hp).opcode=A_POP)) and
  553. (taicpu(hp).oper[0].typ=top_reg) and
  554. ((taicpu(hp).oper[0].reg>=firstsreg) and
  555. (taicpu(hp).oper[0].reg<=lastsreg)) then
  556. AsmWriteln(#9#9'DB'#9'066h');
  557. { added prefix instructions, must be on same line as opcode }
  558. if (taicpu(hp).ops = 0) and
  559. ((taicpu(hp).opcode = A_REP) or
  560. (taicpu(hp).opcode = A_LOCK) or
  561. (taicpu(hp).opcode = A_REPE) or
  562. (taicpu(hp).opcode = A_REPNZ) or
  563. (taicpu(hp).opcode = A_REPZ) or
  564. (taicpu(hp).opcode = A_REPNE)) then
  565. Begin
  566. prefix:=int_op2str[taicpu(hp).opcode]+#9;
  567. hp:=tai(hp.next);
  568. { this is theorically impossible... }
  569. if hp=nil then
  570. begin
  571. s:=#9#9+prefix;
  572. AsmWriteLn(s);
  573. break;
  574. end;
  575. { nasm prefers prefix on a line alone
  576. AsmWriteln(#9#9+prefix); but not masm PM
  577. prefix:=''; }
  578. if (aktoutputformat = as_i386_masm) then
  579. begin
  580. AsmWriteln(s);
  581. prefix:='';
  582. end;
  583. end
  584. else
  585. prefix:= '';
  586. if taicpu(hp).ops<>0 then
  587. begin
  588. if is_calljmp(taicpu(hp).opcode) then
  589. s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opsize)
  590. else
  591. begin
  592. for i:=0to taicpu(hp).ops-1 do
  593. begin
  594. if i=0 then
  595. sep:=#9
  596. else
  597. sep:=',';
  598. s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
  599. end;
  600. end;
  601. end;
  602. AsmWriteLn(#9#9+prefix+int_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix+s);
  603. end;
  604. {$ifdef GDB}
  605. ait_stabn,
  606. ait_stabs,
  607. ait_force_line,
  608. ait_stab_function_name : ;
  609. {$endif GDB}
  610. ait_cut : begin
  611. { only reset buffer if nothing has changed }
  612. if AsmSize=AsmStartSize then
  613. AsmClear
  614. else
  615. begin
  616. if LastSec<>sec_none then
  617. AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
  618. AsmLn;
  619. AsmWriteLn(#9'END');
  620. AsmClose;
  621. DoAssemble;
  622. AsmCreate(tai_cut(hp).place);
  623. end;
  624. { avoid empty files }
  625. while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
  626. begin
  627. if tai(hp.next).typ=ait_section then
  628. begin
  629. lastsec:=tai_section(hp.next).sec;
  630. end;
  631. hp:=tai(hp.next);
  632. end;
  633. AsmWriteLn(#9'.386p');
  634. { I was told that this isn't necesarry because }
  635. { the labels generated by FPC are unique (FK) }
  636. { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
  637. if lastsec<>sec_none then
  638. AsmWriteLn('_'+target_asm.secnames[lastsec]+#9#9+
  639. 'SEGMENT'#9'PARA PUBLIC USE32 '''+
  640. target_asm.secnames[lastsec]+'''');
  641. AsmStartSize:=AsmSize;
  642. end;
  643. ait_marker :
  644. begin
  645. if tai_marker(hp).kind=InlineStart then
  646. inc(InlineLevel)
  647. else if tai_marker(hp).kind=InlineEnd then
  648. dec(InlineLevel);
  649. end;
  650. else
  651. internalerror(10000);
  652. end;
  653. hp:=tai(hp.next);
  654. end;
  655. end;
  656. var
  657. currentasmlist : TExternalAssembler;
  658. procedure writeexternal(p:tnamedindexitem);
  659. begin
  660. if tasmsymbol(p).defbind=AB_EXTERNAL then
  661. begin
  662. if (aktoutputformat = as_i386_masm) then
  663. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name
  664. +': NEAR')
  665. else
  666. currentasmlist.AsmWriteln(#9'EXTRN'#9+p.name);
  667. end;
  668. end;
  669. procedure T386IntelAssembler.WriteExternals;
  670. begin
  671. currentasmlist:=self;
  672. AsmSymbolList.foreach_static({$ifdef fpcprocvar}@{$endif}writeexternal);
  673. end;
  674. procedure T386IntelAssembler.WriteAsmList;
  675. begin
  676. {$ifdef EXTDEBUG}
  677. if assigned(current_module.mainsource) then
  678. comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
  679. {$endif}
  680. LastSec:=sec_none;
  681. AsmWriteLn(#9'.386p');
  682. { masm 6.11 does not seem to like LOCALS PM }
  683. if (aktoutputformat = as_i386_tasm) then
  684. begin
  685. AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
  686. end;
  687. AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
  688. AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  689. AsmLn;
  690. countlabelref:=false;
  691. WriteExternals;
  692. { INTEL ASM doesn't support stabs
  693. WriteTree(debuglist);}
  694. WriteTree(codesegment);
  695. WriteTree(datasegment);
  696. WriteTree(consts);
  697. WriteTree(rttilist);
  698. WriteTree(resourcestringlist);
  699. WriteTree(bsssegment);
  700. countlabelref:=true;
  701. AsmWriteLn(#9'END');
  702. AsmLn;
  703. {$ifdef EXTDEBUG}
  704. if assigned(current_module.mainsource) then
  705. comment(v_info,'Done writing intel-styled assembler output for '+current_module.mainsource^);
  706. {$endif EXTDEBUG}
  707. end;
  708. {*****************************************************************************
  709. Initialize
  710. *****************************************************************************}
  711. const
  712. as_i386_tasm_info : tasminfo =
  713. (
  714. id : as_i386_tasm;
  715. idtxt : 'TASM';
  716. asmbin : 'tasm';
  717. asmcmd : '/m2 /ml $ASM $OBJ';
  718. supported_target : target_any; { what should I write here ?? }
  719. allowdirect : true;
  720. externals : true;
  721. needar : true;
  722. labelprefix_only_inside_procedure : true;
  723. labelprefix : '@@';
  724. comment : '; ';
  725. secnames : ('',
  726. 'CODE','DATA','BSS',
  727. '','','','','','',
  728. '','')
  729. );
  730. as_i386_masm_info : tasminfo =
  731. (
  732. id : as_i386_masm;
  733. idtxt : 'MASM';
  734. asmbin : 'masm';
  735. asmcmd : '/c $ASM /Fo$OBJ';
  736. supported_target : target_any; { what should I write here ?? }
  737. allowdirect : true;
  738. externals : true;
  739. needar : true;
  740. labelprefix : '@@';
  741. comment : '; ';
  742. secnames : ('',
  743. 'CODE','DATA','BSS',
  744. '','','','','','',
  745. '','')
  746. );
  747. finalization
  748. RegisterAssembler(as_i386_tasm_info,T386IntelAssembler);
  749. RegisterAssembler(as_i386_masm_info,T386IntelAssembler);
  750. end.
  751. {
  752. $Log$
  753. Revision 1.10 2001-04-18 22:02:00 peter
  754. * registration of targets and assemblers
  755. Revision 1.9 2001/04/13 01:22:17 peter
  756. * symtable change to classes
  757. * range check generation and errors fixed, make cycle DEBUG=1 works
  758. * memory leaks fixed
  759. Revision 1.8 2001/03/25 12:30:17 peter
  760. * masm -al fix (merged)
  761. Revision 1.7 2001/03/05 21:39:11 peter
  762. * changed to class with common TAssembler also for internal assembler
  763. Revision 1.6 2001/02/20 21:36:39 peter
  764. * tasm/masm fixes merged
  765. Revision 1.5 2001/01/13 20:24:24 peter
  766. * fixed operand order that got mixed up for external writers after
  767. my previous assembler block valid instruction check
  768. Revision 1.4 2000/12/25 00:07:31 peter
  769. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  770. tlinkedlist objects)
  771. Revision 1.3 2000/12/18 21:56:52 peter
  772. * extdebug fixes
  773. Revision 1.2 2000/11/29 00:30:43 florian
  774. * unused units removed from uses clause
  775. * some changes for widestrings
  776. Revision 1.1 2000/10/15 09:47:42 peter
  777. * moved to i386/
  778. Revision 1.6 2000/09/24 15:06:10 peter
  779. * use defines.inc
  780. Revision 1.5 2000/08/27 16:11:49 peter
  781. * moved some util functions from globals,cobjects to cutils
  782. * splitted files into finput,fmodule
  783. Revision 1.4 2000/08/20 17:38:21 peter
  784. * smartlinking fixed for linux (merged)
  785. Revision 1.3 2000/07/13 12:08:24 michael
  786. + patched to 1.1.0 with former 1.09patch from peter
  787. Revision 1.2 2000/07/13 11:32:30 michael
  788. + removed logs
  789. }