ag386int.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808
  1. {
  2. $Id$
  3. Copyright (c) 1996,97 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. interface
  20. uses aasm,assemble;
  21. type
  22. pi386intasmlist=^ti386intasmlist;
  23. ti386intasmlist = object(tasmlist)
  24. procedure WriteTree(p:paasmoutput);virtual;
  25. procedure WriteAsmList;virtual;
  26. end;
  27. implementation
  28. uses
  29. dos,globals,systems,cobjects,i386,
  30. strings,files,verbose
  31. {$ifdef GDB}
  32. ,gdb
  33. {$endif GDB}
  34. ;
  35. const
  36. line_length = 70;
  37. extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
  38. ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
  39. 'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
  40. function getreferencestring(const ref : treference) : string;
  41. var
  42. s : string;
  43. first : boolean;
  44. begin
  45. if ref.isintvalue then
  46. s:= tostr(ref.offset)
  47. else
  48. {$ifdef ver0_6}
  49. begin
  50. first:=true;
  51. { have we a segment prefix ? }
  52. if ref.segment<>R_DEFAULT_SEG then
  53. begin
  54. if current_module^.output_format in [of_nasm,of_obj] then
  55. s:='['+_reg2str[ref.segment]+':'
  56. else
  57. s:=_reg2str[ref.segment]+':[';
  58. end
  59. else s:='[';
  60. if assigned(ref.symbol) then
  61. begin
  62. s:=s+ref.symbol^;
  63. first:=false;
  64. end;
  65. if (ref.base<>R_NO) then
  66. begin
  67. if not(first) then
  68. s:=s+'+'
  69. else
  70. first:=false;
  71. s:=s+_reg2str[ref.base];
  72. end;
  73. if (ref.index<>R_NO) then
  74. begin
  75. if not(first) then
  76. s:=s+'+'
  77. else
  78. first:=false;
  79. s:=s+_reg2str[ref.index];
  80. if ref.scalefactor<>0 then
  81. s:=s+'*'+tostr(ref.scalefactor);
  82. end;
  83. if ref.offset<0 then
  84. s:=s+tostr(ref.offset)
  85. else if (ref.offset>0) then
  86. s:=s+'+'+tostr(ref.offset);
  87. s:=s+']';
  88. end;
  89. {$else}
  90. with ref do
  91. begin
  92. first:=true;
  93. if ref.segment<>R_DEFAULT_SEG then
  94. begin
  95. if current_module^.output_format in [of_nasm,of_obj] then
  96. s:='['+int_reg2str[segment]+':'
  97. else
  98. s:=int_reg2str[segment]+':[';
  99. end
  100. else
  101. s:='[';
  102. if assigned(symbol) then
  103. begin
  104. s:=s+symbol^;
  105. first:=false;
  106. end;
  107. if (base<>R_NO) then
  108. begin
  109. if not(first) then
  110. s:=s+'+'
  111. else
  112. first:=false;
  113. s:=s+int_reg2str[base];
  114. end;
  115. if (index<>R_NO) then
  116. begin
  117. if not(first) then
  118. s:=s+'+'
  119. else
  120. first:=false;
  121. s:=s+int_reg2str[index];
  122. if scalefactor<>0 then
  123. s:=s+'*'+tostr(scalefactor);
  124. end;
  125. if offset<0 then
  126. s:=s+tostr(offset)
  127. else if (offset>0) then
  128. s:=s+'+'+tostr(offset);
  129. s:=s+']';
  130. end;
  131. {$endif}
  132. getreferencestring:=s;
  133. end;
  134. function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
  135. var
  136. hs : string;
  137. begin
  138. case t of
  139. top_reg : { a floating point register can be only a register operand }
  140. if current_module^.output_format in [of_nasm,of_obj] then
  141. getopstr:=int_nasmreg2str[tregister(o)]
  142. else
  143. getopstr:=int_reg2str[tregister(o)];
  144. top_const,
  145. top_ref : begin
  146. if t=top_const then
  147. hs := tostr(longint(o))
  148. else
  149. hs:=getreferencestring(preference(o)^);
  150. if current_module^.output_format in [of_nasm,of_obj] then
  151. if (_operator = A_LEA) or (_operator = A_LGS)
  152. or (_operator = A_LSS) or (_operator = A_LFS)
  153. or (_operator = A_LES) or (_operator = A_LDS)
  154. or (_operator = A_SHR) or (_operator = A_SHL)
  155. or (_operator = A_SAR) or (_operator = A_SAL)
  156. or (_operator = A_OUT) or (_operator = A_IN) then
  157. begin
  158. end
  159. else
  160. case s of
  161. S_B : hs:='byte '+hs;
  162. S_W : hs:='word '+hs;
  163. S_L : hs:='dword '+hs;
  164. S_S : hs:='dword '+hs;
  165. S_Q : hs:='qword '+hs;
  166. S_X : if current_module^.output_format in [of_nasm,of_obj] then
  167. hs:='tword '+hs
  168. else
  169. hs:='tbyte '+hs;
  170. S_BW : if dest then
  171. hs:='word '+hs
  172. else
  173. hs:='byte '+hs;
  174. S_BL : if dest then
  175. hs:='dword '+hs
  176. else
  177. hs:='byte '+hs;
  178. S_WL : if dest then
  179. hs:='dword '+hs
  180. else
  181. hs:='word '+hs;
  182. end
  183. else
  184. Begin
  185. { can possibly give a range check error under tp }
  186. { if using in... }
  187. if ((_operator <> A_LGS) and (_operator <> A_LSS) and
  188. (_operator <> A_LFS) and (_operator <> A_LDS) and
  189. (_operator <> A_LES)) then
  190. Begin
  191. case s of
  192. S_B : hs:='byte ptr '+hs;
  193. S_W : hs:='word ptr '+hs;
  194. S_L : hs:='dword 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. end;
  210. getopstr:=hs;
  211. end;
  212. top_symbol : begin
  213. hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  214. move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  215. if current_module^.output_format=of_masm then
  216. hs:='offset '+hs
  217. else
  218. hs:='dword '+hs;
  219. if pcsymbol(o)^.offset>0 then
  220. hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  221. else if pcsymbol(o)^.offset<0 then
  222. hs:=hs+tostr(pcsymbol(o)^.offset);
  223. getopstr:=hs;
  224. end;
  225. else internalerror(10001);
  226. end;
  227. end;
  228. function getopstr_jmp(t : byte;o : pointer) : string;
  229. var
  230. hs : string;
  231. begin
  232. case t of
  233. top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
  234. top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  235. top_const : getopstr_jmp:=tostr(longint(o));
  236. top_symbol : begin
  237. hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  238. move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  239. if pcsymbol(o)^.offset>0 then
  240. hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  241. else if pcsymbol(o)^.offset<0 then
  242. hs:=hs+tostr(pcsymbol(o)^.offset);
  243. getopstr_jmp:=hs;
  244. end;
  245. else internalerror(10001);
  246. end;
  247. end;
  248. {****************************************************************************
  249. TI386INTASMLIST
  250. ****************************************************************************}
  251. const
  252. ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  253. (#9'DD'#9,'',#9'DW'#9,#9'DB'#9);
  254. Function PadTabs(p:pchar;addch:char):string;
  255. var
  256. s : string;
  257. i : longint;
  258. begin
  259. i:=strlen(p);
  260. if addch<>#0 then
  261. begin
  262. inc(i);
  263. s:=StrPas(p)+addch;
  264. end
  265. else
  266. s:=StrPas(p);
  267. if i<8 then
  268. PadTabs:=s+#9#9
  269. else
  270. PadTabs:=s+#9;
  271. end;
  272. procedure ti386intasmlist.WriteTree(p:paasmoutput);
  273. type
  274. twowords=record
  275. word1,word2:word;
  276. end;
  277. var
  278. s,
  279. prefix,
  280. suffix : string;
  281. hp : pai;
  282. counter,
  283. lines,
  284. i,j,l : longint;
  285. consttyp : tait;
  286. found,
  287. quoted : boolean;
  288. begin
  289. hp:=pai(p^.first);
  290. while assigned(hp) do
  291. begin
  292. case hp^.typ of
  293. ait_comment : ;
  294. ait_align : begin
  295. { align not supported at all with nasm v095 }
  296. { align with specific value not supported by }
  297. { turbo assembler. }
  298. { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
  299. { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
  300. { HERE UNDER TASM! }
  301. { if current_module^.output_format<>of_nasm then
  302. AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));}
  303. end;
  304. ait_external : begin
  305. if current_module^.output_format in [of_nasm,of_obj] then
  306. AsmWriteLn('EXTERN '+StrPas(pai_external(hp)^.name))
  307. else
  308. AsmWriteLn(#9#9'EXTRN'#9+StrPas(pai_external(hp)^.name)+
  309. ' :'+extstr[pai_external(hp)^.exttyp]);
  310. end;
  311. ait_datablock : begin
  312. if current_module^.output_format in [of_nasm,of_obj] then
  313. begin
  314. if pai_datablock(hp)^.is_global then
  315. AsmWriteLn('GLOBAL '+StrPas(pai_datablock(hp)^.name));
  316. AsmWriteLn(PadTabs(pai_datablock(hp)^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
  317. end
  318. else
  319. begin
  320. if pai_datablock(hp)^.is_global then
  321. AsmWriteLn(#9#9'PUBLIC'#9+StrPas(pai_datablock(hp)^.name));
  322. AsmWriteLn(PadTabs(pai_datablock(hp)^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
  323. end;
  324. end;
  325. ait_const_32bit,
  326. ait_const_8bit,
  327. ait_const_16bit : begin
  328. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  329. consttyp:=hp^.typ;
  330. l:=0;
  331. repeat
  332. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  333. if found then
  334. begin
  335. hp:=Pai(hp^.next);
  336. s:=','+tostr(pai_const(hp)^.value);
  337. AsmWrite(s);
  338. inc(l,length(s));
  339. end;
  340. until (not found) or (l>line_length);
  341. AsmLn;
  342. end;
  343. ait_const_symbol : begin
  344. if current_module^.output_format<>of_nasm then
  345. AsmWrite(#9#9+'DD '#9'offset ')
  346. else
  347. AsmWrite(#9#9+'DD '#9);
  348. AsmWriteLn(StrPas(pchar(pai_const(hp)^.value)));
  349. end;
  350. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
  351. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
  352. ait_real_extended : begin
  353. { nasm v095 does not like DT with real constants }
  354. { therefore write as double. }
  355. { other possible solution: decode directly to hex}
  356. { value. }
  357. if current_module^.output_format<>of_nasm then
  358. AsmWriteLn(#9#9'DT'#9+double2str(pai_extended(hp)^.value))
  359. else
  360. begin
  361. {$ifdef EXTDEBUG}
  362. AsmLn;
  363. AsmWriteLn('; NASM bug work around for extended real');
  364. {$endif}
  365. AsmWriteLn(#9#9'DD'#9+double2str(pai_extended(hp)^.value))
  366. end;
  367. end;
  368. ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
  369. ait_string : begin
  370. counter := 0;
  371. lines := pai_string(hp)^.len div line_length;
  372. { separate lines in different parts }
  373. if pai_string(hp)^.len > 0 then
  374. Begin
  375. for j := 0 to lines-1 do
  376. begin
  377. AsmWrite(#9#9'DB'#9);
  378. quoted:=false;
  379. for i:=counter to counter+line_length do
  380. begin
  381. { it is an ascii character. }
  382. if (ord(pai_string(hp)^.str[i])>31) and
  383. (ord(pai_string(hp)^.str[i])<128) and
  384. (pai_string(hp)^.str[i]<>'"') then
  385. begin
  386. if not(quoted) then
  387. begin
  388. if i>counter then
  389. AsmWrite(',');
  390. AsmWrite('"');
  391. end;
  392. AsmWrite(pai_string(hp)^.str[i]);
  393. quoted:=true;
  394. end { if > 31 and < 128 and ord('"') }
  395. else
  396. begin
  397. if quoted then
  398. AsmWrite('"');
  399. if i>counter then
  400. AsmWrite(',');
  401. quoted:=false;
  402. AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  403. end;
  404. end; { end for i:=0 to... }
  405. if quoted then AsmWrite('"');
  406. AsmWrite(target_info.newline);
  407. counter := counter+line_length;
  408. end; { end for j:=0 ... }
  409. { do last line of lines }
  410. AsmWrite(#9#9'DB'#9);
  411. quoted:=false;
  412. for i:=counter to pai_string(hp)^.len-1 do
  413. begin
  414. { it is an ascii character. }
  415. if (ord(pai_string(hp)^.str[i])>31) and
  416. (ord(pai_string(hp)^.str[i])<128) and
  417. (pai_string(hp)^.str[i]<>'"') then
  418. begin
  419. if not(quoted) then
  420. begin
  421. if i>counter then
  422. AsmWrite(',');
  423. AsmWrite('"');
  424. end;
  425. AsmWrite(pai_string(hp)^.str[i]);
  426. quoted:=true;
  427. end { if > 31 and < 128 and " }
  428. else
  429. begin
  430. if quoted then
  431. AsmWrite('"');
  432. if i>counter then
  433. AsmWrite(',');
  434. quoted:=false;
  435. AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  436. end;
  437. end; { end for i:=0 to... }
  438. if quoted then
  439. AsmWrite('"');
  440. end;
  441. AsmLn;
  442. end;
  443. ait_label : begin
  444. AsmWrite(lab2str(pai_label(hp)^.l));
  445. if (current_module^.output_format in [of_obj,of_nasm]) or
  446. (assigned(hp^.next) and not(pai(hp^.next)^.typ in
  447. [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  448. ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then
  449. AsmWriteLn(':');
  450. end;
  451. ait_direct : begin
  452. AsmWritePChar(pai_direct(hp)^.str);
  453. AsmLn;
  454. end;
  455. ait_labeled_instruction :
  456. begin
  457. if (current_module^.output_format in [of_nasm,of_obj]) and
  458. not (pai_labeled(hp)^._operator in [A_JMP,A_LOOP,A_LOOPZ,A_LOOPE,
  459. A_LOOPNZ,A_LOOPNE,A_JCXZ,A_JECXZ]) then
  460. AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+'near '+lab2str(pai_labeled(hp)^.lab))
  461. else
  462. AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
  463. end;
  464. ait_symbol : begin
  465. if pai_symbol(hp)^.is_global then
  466. begin
  467. if current_module^.output_format in [of_nasm,of_obj] then
  468. AsmWriteLn('GLOBAL '+StrPas(pai_symbol(hp)^.name))
  469. else
  470. AsmWriteLn(#9#9'PUBLIC'#9+StrPas(pai_symbol(hp)^.name));
  471. end;
  472. AsmWritePChar(pai_symbol(hp)^.name);
  473. if assigned(hp^.next) and not(pai(hp^.next)^.typ in
  474. [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
  475. ait_real_64bit,ait_string]) then
  476. AsmWriteLn(':')
  477. end;
  478. ait_instruction : begin
  479. suffix:='';
  480. prefix:= '';
  481. { added prefix instructions, must be on same line as opcode }
  482. if (pai386(hp)^.op1t = top_none) and
  483. ((pai386(hp)^._operator = A_REP) or
  484. (pai386(hp)^._operator = A_LOCK) or
  485. (pai386(hp)^._operator = A_REPE) or
  486. (pai386(hp)^._operator = A_REPNE)) then
  487. Begin
  488. prefix:=int_op2str[pai386(hp)^._operator]+#9;
  489. hp:=Pai(hp^.next);
  490. { this is theorically impossible... }
  491. if hp=nil then
  492. begin
  493. s:=#9#9+prefix;
  494. AsmWriteLn(s);
  495. break;
  496. end;
  497. { nasm prefers prefix on a line alone }
  498. if (current_module^.output_format in [of_nasm,of_obj]) then
  499. begin
  500. AsmWriteln(#9#9+prefix);
  501. prefix:='';
  502. end;
  503. end
  504. else
  505. prefix:= '';
  506. { A_FNSTS need the w as suffix at least for nasm}
  507. if (current_module^.output_format in [of_nasm,of_obj]) then
  508. if (pai386(hp)^._operator = A_FNSTS) then
  509. pai386(hp)^._operator:=A_FNSTSW
  510. else if (pai386(hp)^._operator = A_FSTS) then
  511. pai386(hp)^._operator:=A_FSTSW;
  512. if pai386(hp)^.op1t<>top_none then
  513. begin
  514. if pai386(hp)^._operator in [A_CALL] then
  515. begin
  516. if output_format=of_nasm then
  517. s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
  518. else
  519. s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);
  520. end
  521. else
  522. begin
  523. s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
  524. if pai386(hp)^.op3t<>top_none then
  525. begin
  526. if pai386(hp)^.op2t<>top_none then
  527. s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
  528. pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
  529. s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
  530. pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
  531. end
  532. else
  533. if pai386(hp)^.op2t<>top_none then
  534. s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
  535. pai386(hp)^._operator,true)+','+s;
  536. end;
  537. s:=#9+s;
  538. end
  539. else
  540. begin
  541. { check if string instruction }
  542. { long form, otherwise may give range check errors }
  543. { in turbo pascal... }
  544. if ((pai386(hp)^._operator = A_CMPS) or
  545. (pai386(hp)^._operator = A_INS) or
  546. (pai386(hp)^._operator = A_OUTS) or
  547. (pai386(hp)^._operator = A_SCAS) or
  548. (pai386(hp)^._operator = A_STOS) or
  549. (pai386(hp)^._operator = A_MOVS) or
  550. (pai386(hp)^._operator = A_LODS) or
  551. (pai386(hp)^._operator = A_XLAT)) then
  552. Begin
  553. case pai386(hp)^.size of
  554. S_B: suffix:='b';
  555. S_W: suffix:='w';
  556. S_L: suffix:='d';
  557. else
  558. Message(assem_f_invalid_suffix_intel);
  559. end;
  560. end;
  561. s:='';
  562. end;
  563. AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^._operator]+suffix+s);
  564. end;
  565. {$ifdef GDB}
  566. ait_stabn,
  567. ait_stabs,
  568. ait_stab_function_name : ;
  569. {$endif GDB}
  570. else
  571. internalerror(10000);
  572. end;
  573. hp:=pai(hp^.next);
  574. end;
  575. end;
  576. procedure ti386intasmlist.WriteAsmList;
  577. begin
  578. {$ifdef EXTDEBUG}
  579. if assigned(current_module^.mainsource) then
  580. comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
  581. {$endif}
  582. if current_module^.output_format in [of_nasm,of_obj] then
  583. begin
  584. WriteTree(externals);
  585. { INTEL ASM doesn't support stabs
  586. WriteTree(debuglist);}
  587. AsmWriteLn('BITS 32');
  588. AsmWriteLn('SECTION .text');
  589. {
  590. AsmWriteLn(#9#9'ASSUME'#9'CS:_TEXT,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  591. }
  592. WriteTree(codesegment);
  593. AsmLn;
  594. AsmWriteLn('SECTION .data');
  595. {$ifdef EXTDEBUG}
  596. AsmWriteLn(#9#9'DB'#9'"compiled by FPC '+version_string+'\0"');
  597. AsmWriteLn(#9#9'DB'#9'"target: '+target_info.target_name+'\0"');
  598. {$endif EXTDEBUG}
  599. WriteTree(datasegment);
  600. WriteTree(consts);
  601. AsmLn;
  602. AsmWriteLn('SECTION .bss');
  603. WriteTree(bsssegment);
  604. end
  605. else
  606. begin
  607. AsmWriteLn('.386p');
  608. WriteTree(externals);
  609. { INTEL ASM doesn't support stabs
  610. WriteTree(debuglist);}
  611. AsmWriteLn('DGROUP'#9#9'GROUP'#9'_BSS,_DATA');
  612. AsmWriteLn('_TEXT'#9#9'SEGMENT'#9'BYTE PUBLIC USE32 ''CODE''');
  613. AsmWriteLn(#9#9'ASSUME'#9'CS:_TEXT,ES:DGROUP,DS:DGROUP,SS:DGROUP');
  614. AsmLn;
  615. WriteTree(codesegment);
  616. AsmWriteLn('_TEXT'#9#9'ENDS');
  617. AsmLn;
  618. AsmWriteLn('_DATA'#9#9'SEGMENT'#9'DWORD PUBLIC USE32 ''DATA''');
  619. {$ifdef EXTDEBUG}
  620. AsmWriteLn(#9#9'DB'#9'"compiled by FPC '+version_string+'\0"');
  621. AsmWriteLn(#9#9'DB'#9'"target: '+target_info.target_name+'\0"');
  622. {$endif EXTDEBUG}
  623. WriteTree(datasegment);
  624. WriteTree(consts);
  625. AsmWriteLn('_DATA'#9#9'ENDS');
  626. AsmLn;
  627. AsmWriteLn('_BSS'#9#9'SEGMENT'#9'DWORD PUBLIC USE32 ''BSS''');
  628. WriteTree(bsssegment);
  629. AsmWriteLn('_BSS'#9#9'ENDS');
  630. AsmLn;
  631. AsmWriteLn(#9#9'END');
  632. end;
  633. {$ifdef EXTDEBUG}
  634. if assigned(current_module^.mainsource) then
  635. comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
  636. {$endif EXTDEBUG}
  637. end;
  638. end.
  639. {
  640. $Log$
  641. Revision 1.3 1998-04-08 16:58:01 pierre
  642. * several bugfixes
  643. ADD ADC and AND are also sign extended
  644. nasm output OK (program still crashes at end
  645. and creates wrong assembler files !!)
  646. procsym types sym in tdef removed !!
  647. Revision 1.2 1998/04/08 11:34:17 peter
  648. * nasm works (linux only tested)
  649. Revision 1.1.1.1 1998/03/25 11:18:16 root
  650. * Restored version
  651. Revision 1.1 1998/03/10 01:26:09 peter
  652. + new uniform names
  653. Revision 1.18 1998/03/09 12:58:11 peter
  654. * FWait warning is only showed for Go32V2 and $E+
  655. * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
  656. for m68k the same tables are removed)
  657. + $E for i386
  658. Revision 1.17 1998/03/06 00:52:23 peter
  659. * replaced all old messages from errore.msg, only ExtDebug and some
  660. Comment() calls are left
  661. * fixed options.pas
  662. Revision 1.16 1998/03/02 01:48:41 peter
  663. * renamed target_DOS to target_GO32V1
  664. + new verbose system, merged old errors and verbose units into one new
  665. verbose.pas, so errors.pas is obsolete
  666. Revision 1.15 1998/02/23 02:57:41 carl
  667. * small bugfix when compiling $extdebug
  668. Revision 1.14 1998/02/15 21:16:20 peter
  669. * all assembler outputs supported by assemblerobject
  670. * cleanup with assembleroutputs, better .ascii generation
  671. * help_constructor/destructor are now added to the externals
  672. - generation of asmresponse is not outputformat depended
  673. Revision 1.13 1998/02/13 10:35:07 daniel
  674. * Made Motorola version compilable.
  675. * Fixed optimizer
  676. Revision 1.12 1998/02/12 17:19:07 florian
  677. * fixed to get remake3 work, but needs additional fixes (output, I don't like
  678. also that aktswitches isn't a pointer)
  679. Revision 1.11 1998/02/12 11:50:11 daniel
  680. Yes! Finally! After three retries, my patch!
  681. Changes:
  682. Complete rewrite of psub.pas.
  683. Added support for DLL's.
  684. Compiler requires less memory.
  685. Platform units for each platform.
  686. Revision 1.10 1997/12/13 18:59:48 florian
  687. + I/O streams are now also declared as external, if neccessary
  688. * -Aobj generates now a correct obj file via nasm
  689. Revision 1.9 1997/12/12 13:28:26 florian
  690. + version 0.99.0
  691. * all WASM options changed into MASM
  692. + -O2 for Pentium II optimizations
  693. Revision 1.8 1997/12/09 13:45:10 carl
  694. * bugfix of DT under nasm (not allowed if non integral - nasm v095)
  695. + added pai_align --> useless here see file for more info
  696. * bugfix of problems with in,out instructions under nasm
  697. * bugfix of call under nasm (not fully tested though -- not sure)
  698. * some range check errors removed (probably a few left though)
  699. * bugfix of checking for extended type when emitting ':'
  700. Revision 1.7 1997/12/04 15:20:47 carl
  701. * esthetic bugfix with extdebug on.
  702. Revision 1.6 1997/12/03 13:46:40 carl
  703. * bugfix of my bug with near, now near in nasm mode for all non-rel8
  704. instructions. (jcxz,jecxz still does not work thoug - assumed short now).
  705. Revision 1.5 1997/12/02 15:52:26 carl
  706. * bugfix of string (again...) - would be sometimes invalid.
  707. * bugfix of segment overrides under nasm.
  708. - removed near in labeled instructions (would cause errors).
  709. Revision 1.4 1997/12/01 17:42:51 pierre
  710. + added some more functionnality to the assembler parser
  711. Revision 1.3 1997/11/28 18:14:36 pierre
  712. working version with several bug fixes
  713. Revision 1.2 1997/11/28 14:54:50 carl
  714. + added popfd instruction.
  715. Revision 1.1.1.1 1997/11/27 08:32:57 michael
  716. FPC Compiler CVS start
  717. Pre-CVS log:
  718. CEC Carl-Eric Codere
  719. FK Florian Klaempfl
  720. PM Pierre Muller
  721. + feature added
  722. - removed
  723. * bug fixed or changed
  724. History:
  725. 9th october 1997:
  726. * bugfix of string write, closing quotes would never be written. (CEC)
  727. 23 october 1997:
  728. * fixed problem with writing strings of length = 0 (CEC).
  729. + added line separation of long string chains. (CEC).
  730. 31st october 1997:
  731. + completed the table of opcodes. (CEC)
  732. 3rd november 1997:
  733. + MMX instructions added (FK)
  734. 9th november 1997:
  735. * movsb represented the AT&T movsx - fixed, absolute values
  736. in getreferencestring would be preceded by $ - fixed (CEC).
  737. What's to do:
  738. o Fix problems regarding the segment names under NASM
  739. o generate extern entries for typed constants and variables
  740. o write lines numbers and file names to output file
  741. o comments
  742. }