ag386int.pas 31 KB

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