ag386nsm.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637
  1. {
  2. $Id$
  3. Copyright (c) 1996,97 by Florian Klaempfl
  4. This unit implements an asmoutput class for the Nasm assembler with
  5. Intel syntax for the i386+
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. { R- Necessary for the in [] }
  20. {$ifdef TP}
  21. {$N+,E+,R-}
  22. {$endif}
  23. unit ag386nsm;
  24. interface
  25. uses aasm,assemble;
  26. type
  27. pi386nasmasmlist=^ti386nasmasmlist;
  28. ti386nasmasmlist = object(tasmlist)
  29. procedure WriteTree(p:paasmoutput);virtual;
  30. procedure WriteAsmList;virtual;
  31. end;
  32. implementation
  33. uses
  34. dos,globals,systems,cobjects,i386,
  35. strings,files,verbose
  36. {$ifdef GDB}
  37. ,gdb
  38. {$endif GDB}
  39. ;
  40. const
  41. line_length = 70;
  42. extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
  43. ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
  44. 'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
  45. function double2str(d : double) : string;
  46. var
  47. hs : string;
  48. p : byte;
  49. begin
  50. str(d,hs);
  51. { nasm expects a lowercase e }
  52. p:=pos('E',hs);
  53. if p>0 then
  54. hs[p]:='e';
  55. p:=pos('+',hs);
  56. if p>0 then
  57. delete(hs,p,1);
  58. double2str:=lower(hs);
  59. end;
  60. function extended2str(e : extended) : string;
  61. var
  62. hs : string;
  63. p : byte;
  64. begin
  65. {$ifdef VER0_99_5}
  66. str(double(e),hs);
  67. {$else}
  68. str(e,hs);
  69. {$endif}
  70. { nasm expects a lowercase e }
  71. p:=pos('E',hs);
  72. if p>0 then
  73. hs[p]:='e';
  74. p:=pos('+',hs);
  75. if p>0 then
  76. delete(hs,p,1);
  77. extended2str:=lower(hs);
  78. end;
  79. function comp2str(d : bestreal) : string;
  80. type
  81. pdouble = ^double;
  82. var
  83. c : comp;
  84. dd : pdouble;
  85. begin
  86. {$ifdef TP}
  87. c:=d;
  88. {$else}
  89. c:=comp(d);
  90. {$endif}
  91. dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
  92. comp2str:=double2str(dd^);
  93. end;
  94. function getreferencestring(const ref : treference) : string;
  95. var
  96. s : string;
  97. first : boolean;
  98. begin
  99. if ref.isintvalue then
  100. s:= tostr(ref.offset)
  101. else
  102. with ref do
  103. begin
  104. first:=true;
  105. if ref.segment<>R_DEFAULT_SEG then
  106. s:='['+int_reg2str[segment]+':'
  107. else
  108. s:='[';
  109. if assigned(symbol) then
  110. begin
  111. s:=s+symbol^;
  112. first:=false;
  113. end;
  114. if (base<>R_NO) then
  115. begin
  116. if not(first) then
  117. s:=s+'+'
  118. else
  119. first:=false;
  120. s:=s+int_reg2str[base];
  121. end;
  122. if (index<>R_NO) then
  123. begin
  124. if not(first) then
  125. s:=s+'+'
  126. else
  127. first:=false;
  128. s:=s+int_reg2str[index];
  129. if scalefactor<>0 then
  130. s:=s+'*'+tostr(scalefactor);
  131. end;
  132. if offset<0 then
  133. s:=s+tostr(offset)
  134. else if (offset>0) then
  135. s:=s+'+'+tostr(offset);
  136. s:=s+']';
  137. end;
  138. getreferencestring:=s;
  139. end;
  140. function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
  141. var
  142. hs : string;
  143. begin
  144. case t of
  145. top_reg : getopstr:=int_nasmreg2str[tregister(o)];
  146. top_const,
  147. top_ref : begin
  148. if t=top_const then
  149. hs := tostr(longint(o))
  150. else
  151. hs:=getreferencestring(preference(o)^);
  152. if not ((_operator = A_LEA) or (_operator = A_LGS) or
  153. (_operator = A_LSS) or (_operator = A_LFS) or
  154. (_operator = A_LES) or (_operator = A_LDS) or
  155. (_operator = A_SHR) or (_operator = A_SHL) or
  156. (_operator = A_SAR) or (_operator = A_SAL) or
  157. (_operator = A_OUT) or (_operator = A_IN)) then
  158. begin
  159. case s of
  160. S_B : hs:='byte '+hs;
  161. S_W : hs:='word '+hs;
  162. S_L : hs:='dword '+hs;
  163. S_IS : hs:='word '+hs;
  164. S_IL : hs:='dword '+hs;
  165. S_IQ : hs:='qword '+hs;
  166. S_FS : hs:='dword '+hs;
  167. S_FL : hs:='qword '+hs;
  168. S_FX : hs:='tword '+hs;
  169. S_BW : if dest then
  170. hs:='word '+hs
  171. else
  172. hs:='byte '+hs;
  173. S_BL : if dest then
  174. hs:='dword '+hs
  175. else
  176. hs:='byte '+hs;
  177. S_WL : if dest then
  178. hs:='dword '+hs
  179. else
  180. hs:='word '+hs;
  181. end
  182. end;
  183. getopstr:=hs;
  184. end;
  185. top_symbol : begin
  186. hs:=strpas(pchar(pcsymbol(o)^.symbol));
  187. hs:='dword '+hs;
  188. if pcsymbol(o)^.offset>0 then
  189. hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  190. else
  191. if pcsymbol(o)^.offset<0 then
  192. hs:=hs+tostr(pcsymbol(o)^.offset);
  193. getopstr:=hs;
  194. end;
  195. else
  196. internalerror(10001);
  197. end;
  198. end;
  199. function getopstr_jmp(t : byte;o : pointer) : string;
  200. var
  201. hs : string;
  202. begin
  203. case t of
  204. top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
  205. top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  206. top_const : getopstr_jmp:=tostr(longint(o));
  207. top_symbol : begin
  208. hs:=strpas(pchar(pcsymbol(o)^.symbol));
  209. if pcsymbol(o)^.offset>0 then
  210. hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  211. else
  212. if pcsymbol(o)^.offset<0 then
  213. hs:=hs+tostr(pcsymbol(o)^.offset);
  214. getopstr_jmp:=hs;
  215. end;
  216. else
  217. internalerror(10001);
  218. end;
  219. end;
  220. {****************************************************************************
  221. Ti386nasmasmlist
  222. ****************************************************************************}
  223. var
  224. LastSec : tsection;
  225. const
  226. ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  227. (#9'DD'#9,#9'DW'#9,#9'DB'#9);
  228. ait_section2nasmstr : array[tsection] of string[6]=
  229. ('','.text','.data','.bss','.idata');
  230. Function PadTabs(p:pchar;addch:char):string;
  231. var
  232. s : string;
  233. i : longint;
  234. begin
  235. i:=strlen(p);
  236. if addch<>#0 then
  237. begin
  238. inc(i);
  239. s:=StrPas(p)+addch;
  240. end
  241. else
  242. s:=StrPas(p);
  243. if i<8 then
  244. PadTabs:=s+#9#9
  245. else
  246. PadTabs:=s+#9;
  247. end;
  248. procedure ti386nasmasmlist.WriteTree(p:paasmoutput);
  249. type
  250. twowords=record
  251. word1,word2:word;
  252. end;
  253. var
  254. s,
  255. prefix,
  256. suffix : string;
  257. hp : pai;
  258. counter,
  259. lines,
  260. i,j,l : longint;
  261. consttyp : tait;
  262. found,
  263. quoted : boolean;
  264. begin
  265. if not assigned(p) then
  266. exit;
  267. hp:=pai(p^.first);
  268. while assigned(hp) do
  269. begin
  270. case hp^.typ of
  271. ait_comment : Begin
  272. AsmWrite(target_asm.comment);
  273. AsmWritePChar(pai_asm_comment(hp)^.str);
  274. AsmLn;
  275. End;
  276. ait_regalloc,
  277. ait_regdealloc :;
  278. ait_section : begin
  279. if pai_section(hp)^.sec<>sec_none then
  280. begin
  281. AsmLn;
  282. AsmWriteLn('SECTION '+ait_section2nasmstr[pai_section(hp)^.sec]);
  283. end;
  284. LastSec:=pai_section(hp)^.sec;
  285. end;
  286. ait_align : AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
  287. ait_external : AsmWriteLn('EXTERN '+StrPas(pai_external(hp)^.name));
  288. ait_datablock : begin
  289. if pai_datablock(hp)^.is_global then
  290. AsmWriteLn(#9'GLOBAL '+StrPas(pai_datablock(hp)^.name));
  291. AsmWriteLn(PadTabs(pai_datablock(hp)^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
  292. end;
  293. ait_const_32bit,
  294. ait_const_8bit,
  295. ait_const_16bit : begin
  296. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  297. consttyp:=hp^.typ;
  298. l:=0;
  299. repeat
  300. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  301. if found then
  302. begin
  303. hp:=Pai(hp^.next);
  304. s:=','+tostr(pai_const(hp)^.value);
  305. AsmWrite(s);
  306. inc(l,length(s));
  307. end;
  308. until (not found) or (l>line_length);
  309. AsmLn;
  310. end;
  311. ait_const_symbol : begin
  312. AsmWrite(#9#9+'DD '#9);
  313. AsmWritePChar(pchar(pai_const(hp)^.value));
  314. AsmLn;
  315. end;
  316. ait_const_symbol_offset : begin
  317. AsmWrite(#9#9+'DD '#9);
  318. AsmWritePChar(pai_const_symbol_offset(hp)^.name);
  319. if pai_const_symbol_offset(hp)^.offset>0 then
  320. AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
  321. else if pai_const_symbol_offset(hp)^.offset<0 then
  322. AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
  323. AsmLn;
  324. end;
  325. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
  326. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
  327. ait_real_extended : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
  328. ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
  329. ait_string : begin
  330. counter := 0;
  331. lines := pai_string(hp)^.len div line_length;
  332. { separate lines in different parts }
  333. if pai_string(hp)^.len > 0 then
  334. Begin
  335. for j := 0 to lines-1 do
  336. begin
  337. AsmWrite(#9#9'DB'#9);
  338. quoted:=false;
  339. for i:=counter to counter+line_length do
  340. begin
  341. { it is an ascii character. }
  342. if (ord(pai_string(hp)^.str[i])>31) and
  343. (ord(pai_string(hp)^.str[i])<128) and
  344. (pai_string(hp)^.str[i]<>'"') then
  345. begin
  346. if not(quoted) then
  347. begin
  348. if i>counter then
  349. AsmWrite(',');
  350. AsmWrite('"');
  351. end;
  352. AsmWrite(pai_string(hp)^.str[i]);
  353. quoted:=true;
  354. end { if > 31 and < 128 and ord('"') }
  355. else
  356. begin
  357. if quoted then
  358. AsmWrite('"');
  359. if i>counter then
  360. AsmWrite(',');
  361. quoted:=false;
  362. AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  363. end;
  364. end; { end for i:=0 to... }
  365. if quoted then AsmWrite('"');
  366. AsmWrite(target_os.newline);
  367. counter := counter+line_length;
  368. end; { end for j:=0 ... }
  369. { do last line of lines }
  370. AsmWrite(#9#9'DB'#9);
  371. quoted:=false;
  372. for i:=counter to pai_string(hp)^.len-1 do
  373. begin
  374. { it is an ascii character. }
  375. if (ord(pai_string(hp)^.str[i])>31) and
  376. (ord(pai_string(hp)^.str[i])<128) and
  377. (pai_string(hp)^.str[i]<>'"') then
  378. begin
  379. if not(quoted) then
  380. begin
  381. if i>counter then
  382. AsmWrite(',');
  383. AsmWrite('"');
  384. end;
  385. AsmWrite(pai_string(hp)^.str[i]);
  386. quoted:=true;
  387. end { if > 31 and < 128 and " }
  388. else
  389. begin
  390. if quoted then
  391. AsmWrite('"');
  392. if i>counter then
  393. AsmWrite(',');
  394. quoted:=false;
  395. AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  396. end;
  397. end; { end for i:=0 to... }
  398. if quoted then
  399. AsmWrite('"');
  400. end;
  401. AsmLn;
  402. end;
  403. ait_label : begin
  404. if pai_label(hp)^.l^.is_used then
  405. AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
  406. end;
  407. ait_direct : begin
  408. AsmWritePChar(pai_direct(hp)^.str);
  409. AsmLn;
  410. end;
  411. ait_labeled_instruction :
  412. begin
  413. if not (pai_labeled(hp)^._operator in [A_JMP,A_LOOP,A_LOOPZ,A_LOOPE,
  414. A_LOOPNZ,A_LOOPNE,A_JCXZ,A_JECXZ]) then
  415. AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+'near '+lab2str(pai_labeled(hp)^.lab))
  416. else
  417. AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
  418. end;
  419. ait_symbol : begin
  420. if pai_symbol(hp)^.is_global then
  421. AsmWriteLn(#9'GLOBAL '+StrPas(pai_symbol(hp)^.name));
  422. AsmWritePChar(pai_symbol(hp)^.name);
  423. if assigned(hp^.next) and not(pai(hp^.next)^.typ in
  424. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  425. ait_const_symbol,ait_const_symbol_offset,
  426. ait_real_64bit,ait_string]) then
  427. AsmWriteLn(':')
  428. end;
  429. ait_instruction : begin
  430. suffix:='';
  431. prefix:= '';
  432. { added prefix instructions, must be on same line as opcode }
  433. if (pai386(hp)^.op1t = top_none) and
  434. ((pai386(hp)^._operator = A_REP) or
  435. (pai386(hp)^._operator = A_LOCK) or
  436. (pai386(hp)^._operator = A_REPE) or
  437. (pai386(hp)^._operator = A_REPNE)) then
  438. Begin
  439. prefix:=int_op2str[pai386(hp)^._operator]+#9;
  440. hp:=Pai(hp^.next);
  441. { this is theorically impossible... }
  442. if hp=nil then
  443. begin
  444. s:=#9#9+prefix;
  445. AsmWriteLn(s);
  446. break;
  447. end;
  448. { nasm prefers prefix on a line alone }
  449. AsmWriteln(#9#9+prefix);
  450. prefix:='';
  451. end
  452. else
  453. prefix:= '';
  454. { A_FNSTS need the w as suffix at least for nasm}
  455. if (pai386(hp)^._operator = A_FNSTS) then
  456. pai386(hp)^._operator:=A_FNSTSW
  457. else
  458. if (pai386(hp)^._operator = A_FSTS) then
  459. pai386(hp)^._operator:=A_FSTSW;
  460. if pai386(hp)^.op1t<>top_none then
  461. begin
  462. if pai386(hp)^._operator in [A_CALL] then
  463. s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
  464. else
  465. begin
  466. s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
  467. if pai386(hp)^.op3t<>top_none then
  468. begin
  469. if pai386(hp)^.op2t<>top_none then
  470. s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
  471. pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
  472. s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
  473. pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
  474. end
  475. else
  476. if pai386(hp)^.op2t<>top_none then
  477. s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
  478. pai386(hp)^._operator,true)+','+s;
  479. end;
  480. s:=#9+s;
  481. end
  482. else
  483. begin
  484. { check if string instruction }
  485. { long form, otherwise may give range check errors }
  486. { in turbo pascal... }
  487. if ((pai386(hp)^._operator = A_CMPS) or
  488. (pai386(hp)^._operator = A_INS) or
  489. (pai386(hp)^._operator = A_OUTS) or
  490. (pai386(hp)^._operator = A_SCAS) or
  491. (pai386(hp)^._operator = A_STOS) or
  492. (pai386(hp)^._operator = A_MOVS) or
  493. (pai386(hp)^._operator = A_LODS) or
  494. (pai386(hp)^._operator = A_XLAT)) then
  495. Begin
  496. case pai386(hp)^.size of
  497. S_B: suffix:='b';
  498. S_W: suffix:='w';
  499. S_L: suffix:='d';
  500. else
  501. Message(assem_f_invalid_suffix_intel);
  502. end;
  503. end;
  504. s:='';
  505. end;
  506. if pai386(hp)^._operator=A_FWAIT then
  507. AsmWriteln(#9#9'DB'#9'09bh')
  508. else
  509. AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^._operator]+suffix+s);
  510. end;
  511. {$ifdef GDB}
  512. ait_stabn,
  513. ait_stabs,
  514. ait_force_line,
  515. ait_stab_function_name : ;
  516. {$endif GDB}
  517. ait_marker : ;
  518. else
  519. internalerror(10000);
  520. end;
  521. hp:=pai(hp^.next);
  522. end;
  523. end;
  524. procedure ti386nasmasmlist.WriteAsmList;
  525. begin
  526. {$ifdef EXTDEBUG}
  527. if assigned(current_module^.mainsource) then
  528. comment(v_info,'Start writing nasm-styled assembler output for '+current_module^.mainsource^);
  529. {$endif}
  530. LastSec:=sec_none;
  531. AsmWriteLn('BITS 32');
  532. AsmLn;
  533. countlabelref:=false;
  534. WriteTree(externals);
  535. { Nasm doesn't support stabs
  536. WriteTree(debuglist);}
  537. WriteTree(codesegment);
  538. WriteTree(datasegment);
  539. WriteTree(consts);
  540. WriteTree(rttilist);
  541. WriteTree(bsssegment);
  542. countlabelref:=true;
  543. AsmLn;
  544. {$ifdef EXTDEBUG}
  545. if assigned(current_module^.mainsource) then
  546. comment(v_info,'Done writing nasm-styled assembler output for '+current_module^.mainsource^);
  547. {$endif EXTDEBUG}
  548. end;
  549. end.
  550. {
  551. $Log$
  552. Revision 1.13 1998-11-17 00:26:10 peter
  553. * fixed for $H+
  554. Revision 1.12 1998/11/12 11:19:34 pierre
  555. * fix for first line of function break
  556. Revision 1.11 1998/10/12 12:20:42 pierre
  557. + added tai_const_symbol_offset
  558. for r : pointer = @var.field;
  559. * better message for different arg names on implementation
  560. of function
  561. Revision 1.10 1998/10/06 17:16:34 pierre
  562. * some memory leaks fixed (thanks to Peter for heaptrc !)
  563. Revision 1.9 1998/10/01 20:19:07 jonas
  564. + ait_marker support
  565. Revision 1.8 1998/09/20 17:11:22 jonas
  566. * released REGALLOC
  567. Revision 1.7 1998/08/11 14:01:43 peter
  568. * fixed fwait bug using direct opcode
  569. Revision 1.6 1998/08/10 15:49:39 peter
  570. * small fixes for 0.99.5
  571. Revision 1.5 1998/08/08 10:19:18 florian
  572. * small fixes to write the extended type correct
  573. Revision 1.4 1998/06/05 17:46:03 peter
  574. * tp doesn't like comp() typecast
  575. Revision 1.3 1998/05/28 17:24:27 peter
  576. - $R- for tp to solve range errors with in[]
  577. Revision 1.2 1998/05/25 17:11:37 pierre
  578. * firstpasscount bug fixed
  579. now all is already set correctly the first time
  580. under EXTDEBUG try -gp to skip all other firstpasses
  581. it works !!
  582. * small bug fixes
  583. - for smallsets with -dTESTSMALLSET
  584. - some warnings removed (by correcting code !)
  585. Revision 1.1 1998/05/23 01:20:56 peter
  586. + aktasmmode, aktoptprocessor, aktoutputformat
  587. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  588. + $LIBNAME to set the library name where the unit will be put in
  589. * splitted cgi386 a bit (codeseg to large for bp7)
  590. * nasm, tasm works again. nasm moved to ag386nsm.pas
  591. }