ag386nsm.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867
  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. {$ifdef TP}
  20. {$N+,E+}
  21. {$endif}
  22. unit ag386nsm;
  23. interface
  24. uses aasm,assemble;
  25. type
  26. pi386nasmasmlist=^ti386nasmasmlist;
  27. ti386nasmasmlist = object(tasmlist)
  28. procedure WriteTree(p:paasmoutput);virtual;
  29. procedure WriteAsmList;virtual;
  30. end;
  31. implementation
  32. uses
  33. dos,globals,systems,cobjects,
  34. {$ifndef OLDASM}
  35. i386base,i386asm,
  36. {$else}
  37. i386,
  38. {$endif}
  39. strings,files,verbose
  40. {$ifdef GDB}
  41. ,gdb
  42. {$endif GDB}
  43. ;
  44. const
  45. line_length = 70;
  46. extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
  47. ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
  48. 'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
  49. function double2str(d : double) : string;
  50. var
  51. hs : string;
  52. p : byte;
  53. begin
  54. str(d,hs);
  55. { nasm expects a lowercase e }
  56. p:=pos('E',hs);
  57. if p>0 then
  58. hs[p]:='e';
  59. p:=pos('+',hs);
  60. if p>0 then
  61. delete(hs,p,1);
  62. double2str:=lower(hs);
  63. end;
  64. function extended2str(e : extended) : string;
  65. var
  66. hs : string;
  67. p : byte;
  68. begin
  69. str(e,hs);
  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 TP}
  89. {$ifdef Delphi}
  90. c:=d;
  91. {$else Delphi}
  92. c:=comp(d);
  93. {$endif Delphi}
  94. {$endif TP}
  95. dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
  96. comp2str:=double2str(dd^);
  97. end;
  98. function getreferencestring(const 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. if ref.segment<>R_DEFAULT_SEG then
  113. s:='['+int_reg2str[segment]+':'
  114. else
  115. s:='[';
  116. if assigned(symbol) then
  117. begin
  118. s:=s+symbol^.name;
  119. first:=false;
  120. end;
  121. if (base<>R_NO) then
  122. begin
  123. if not(first) then
  124. s:=s+'+'
  125. else
  126. first:=false;
  127. s:=s+int_reg2str[base];
  128. end;
  129. if (index<>R_NO) then
  130. begin
  131. if not(first) then
  132. s:=s+'+'
  133. else
  134. first:=false;
  135. s:=s+int_reg2str[index];
  136. if scalefactor<>0 then
  137. s:=s+'*'+tostr(scalefactor);
  138. end;
  139. if offset<0 then
  140. s:=s+tostr(offset)
  141. else if (offset>0) then
  142. s:=s+'+'+tostr(offset);
  143. s:=s+']';
  144. end;
  145. getreferencestring:=s;
  146. end;
  147. {$ifndef OLDASM}
  148. function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
  149. var
  150. hs : string;
  151. begin
  152. case o.typ of
  153. top_reg :
  154. getopstr:=int_nasmreg2str[o.reg];
  155. top_const :
  156. getopstr:=tostr(o.val);
  157. top_symbol :
  158. begin
  159. hs:='dword '+o.sym^.name;
  160. if o.symofs>0 then
  161. hs:=hs+'+'+tostr(o.symofs)
  162. else
  163. if o.symofs<0 then
  164. hs:=hs+tostr(o.symofs);
  165. getopstr:=hs;
  166. end;
  167. top_ref :
  168. begin
  169. hs:=getreferencestring(o.ref^);
  170. if not ((opcode = A_LEA) or (opcode = A_LGS) or
  171. (opcode = A_LSS) or (opcode = A_LFS) or
  172. (opcode = A_LES) or (opcode = A_LDS) or
  173. (opcode = A_SHR) or (opcode = A_SHL) or
  174. (opcode = A_SAR) or (opcode = A_SAL) or
  175. (opcode = A_OUT) or (opcode = A_IN)) then
  176. begin
  177. case s of
  178. S_B : hs:='byte '+hs;
  179. S_W : hs:='word '+hs;
  180. S_L : hs:='dword '+hs;
  181. S_IS : hs:='word '+hs;
  182. S_IL : hs:='dword '+hs;
  183. S_IQ : hs:='qword '+hs;
  184. S_FS : hs:='dword '+hs;
  185. S_FL : hs:='qword '+hs;
  186. S_FX : hs:='tword '+hs;
  187. S_BW : if dest then
  188. hs:='word '+hs
  189. else
  190. hs:='byte '+hs;
  191. S_BL : if dest then
  192. hs:='dword '+hs
  193. else
  194. hs:='byte '+hs;
  195. S_WL : if dest then
  196. hs:='dword '+hs
  197. else
  198. hs:='word '+hs;
  199. end
  200. end;
  201. getopstr:=hs;
  202. end;
  203. else
  204. internalerror(10001);
  205. end;
  206. end;
  207. function getopstr_jmp(const o:toper) : string;
  208. var
  209. hs : string;
  210. begin
  211. case o.typ of
  212. top_reg :
  213. getopstr_jmp:=int_nasmreg2str[o.reg];
  214. top_ref :
  215. getopstr_jmp:=getreferencestring(o.ref^);
  216. top_const :
  217. getopstr_jmp:=tostr(o.val);
  218. top_symbol :
  219. begin
  220. hs:=o.sym^.name;
  221. if o.symofs>0 then
  222. hs:=hs+'+'+tostr(o.symofs)
  223. else
  224. if o.symofs<0 then
  225. hs:=hs+tostr(o.symofs);
  226. getopstr_jmp:=hs;
  227. end;
  228. else
  229. internalerror(10001);
  230. end;
  231. end;
  232. {$else}
  233. function getopstr(t : byte;o : pointer;opofs:longint;s : topsize; opcode: tasmop;dest : boolean) : string;
  234. var
  235. hs : string;
  236. begin
  237. case t of
  238. top_reg : getopstr:=int_nasmreg2str[tregister(o)];
  239. top_const,
  240. top_ref : begin
  241. if t=top_const then
  242. hs := tostr(longint(o))
  243. else
  244. hs:=getreferencestring(preference(o)^);
  245. if not ((opcode = A_LEA) or (opcode = A_LGS) or
  246. (opcode = A_LSS) or (opcode = A_LFS) or
  247. (opcode = A_LES) or (opcode = A_LDS) or
  248. (opcode = A_SHR) or (opcode = A_SHL) or
  249. (opcode = A_SAR) or (opcode = A_SAL) or
  250. (opcode = A_OUT) or (opcode = A_IN)) then
  251. begin
  252. case s of
  253. S_B : hs:='byte '+hs;
  254. S_W : hs:='word '+hs;
  255. S_L : hs:='dword '+hs;
  256. S_IS : hs:='word '+hs;
  257. S_IL : hs:='dword '+hs;
  258. S_IQ : hs:='qword '+hs;
  259. S_FS : hs:='dword '+hs;
  260. S_FL : hs:='qword '+hs;
  261. S_FX : hs:='tword '+hs;
  262. S_BW : if dest then
  263. hs:='word '+hs
  264. else
  265. hs:='byte '+hs;
  266. S_BL : if dest then
  267. hs:='dword '+hs
  268. else
  269. hs:='byte '+hs;
  270. S_WL : if dest then
  271. hs:='dword '+hs
  272. else
  273. hs:='word '+hs;
  274. end
  275. end;
  276. getopstr:=hs;
  277. end;
  278. top_symbol : begin
  279. hs:='dword '+pasmsymbol(o)^.name;
  280. if opofs>0 then
  281. hs:=hs+'+'+tostr(opofs)
  282. else
  283. if opofs<0 then
  284. hs:=hs+tostr(opofs);
  285. getopstr:=hs;
  286. end;
  287. else
  288. internalerror(10001);
  289. end;
  290. end;
  291. function getopstr_jmp(t : byte;o : pointer;opofs:longint) : string;
  292. var
  293. hs : string;
  294. begin
  295. case t of
  296. top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
  297. top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  298. top_const : getopstr_jmp:=tostr(longint(o));
  299. top_symbol : begin
  300. hs:=pasmsymbol(o)^.name;
  301. if opofs>0 then
  302. hs:=hs+'+'+tostr(opofs)
  303. else
  304. if opofs<0 then
  305. hs:=hs+tostr(opofs);
  306. getopstr_jmp:=hs;
  307. end;
  308. else
  309. internalerror(10001);
  310. end;
  311. end;
  312. {$endif}
  313. {****************************************************************************
  314. Ti386nasmasmlist
  315. ****************************************************************************}
  316. var
  317. LastSec : tsection;
  318. const
  319. ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  320. (#9'DD'#9,#9'DW'#9,#9'DB'#9);
  321. Function PadTabs(const p:string;addch:char):string;
  322. var
  323. s : string;
  324. i : longint;
  325. begin
  326. i:=length(p);
  327. if addch<>#0 then
  328. begin
  329. inc(i);
  330. s:=p+addch;
  331. end
  332. else
  333. s:=p;
  334. if i<8 then
  335. PadTabs:=s+#9#9
  336. else
  337. PadTabs:=s+#9;
  338. end;
  339. procedure ti386nasmasmlist.WriteTree(p:paasmoutput);
  340. type
  341. twowords=record
  342. word1,word2:word;
  343. end;
  344. var
  345. s,
  346. prefix,
  347. suffix : string;
  348. hp : pai;
  349. counter,
  350. lines,
  351. i,j,l : longint;
  352. op : tasmop;
  353. consttyp : tait;
  354. found,
  355. quoted : boolean;
  356. {$ifndef OLDASM}
  357. sep : char;
  358. {$endif}
  359. begin
  360. if not assigned(p) then
  361. exit;
  362. hp:=pai(p^.first);
  363. while assigned(hp) do
  364. begin
  365. case hp^.typ of
  366. ait_comment : Begin
  367. AsmWrite(target_asm.comment);
  368. AsmWritePChar(pai_asm_comment(hp)^.str);
  369. AsmLn;
  370. End;
  371. ait_regalloc,
  372. ait_tempalloc : ;
  373. ait_section : begin
  374. if pai_section(hp)^.sec<>sec_none then
  375. begin
  376. AsmLn;
  377. AsmWriteLn('SECTION '+target_asm.secnames[pai_section(hp)^.sec]);
  378. end;
  379. LastSec:=pai_section(hp)^.sec;
  380. end;
  381. ait_align : AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
  382. ait_external : AsmWriteLn('EXTERN '+pai_external(hp)^.sym^.name);
  383. ait_datablock : begin
  384. if pai_datablock(hp)^.is_global then
  385. AsmWriteLn(#9'GLOBAL '+pai_datablock(hp)^.sym^.name);
  386. AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
  387. end;
  388. ait_const_32bit,
  389. ait_const_8bit,
  390. ait_const_16bit : begin
  391. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  392. consttyp:=hp^.typ;
  393. l:=0;
  394. repeat
  395. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  396. if found then
  397. begin
  398. hp:=Pai(hp^.next);
  399. s:=','+tostr(pai_const(hp)^.value);
  400. AsmWrite(s);
  401. inc(l,length(s));
  402. end;
  403. until (not found) or (l>line_length);
  404. AsmLn;
  405. end;
  406. ait_const_symbol : begin
  407. AsmWriteLn(#9#9'DD'#9+pai_const_symbol(hp)^.sym^.name);
  408. if pai_const_symbol(hp)^.offset>0 then
  409. AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
  410. else if pai_const_symbol(hp)^.offset<0 then
  411. AsmWrite(tostr(pai_const_symbol(hp)^.offset));
  412. AsmLn;
  413. end;
  414. ait_const_rva : begin
  415. AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
  416. end;
  417. ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
  418. ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
  419. ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
  420. ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
  421. ait_string : begin
  422. counter := 0;
  423. lines := pai_string(hp)^.len div line_length;
  424. { separate lines in different parts }
  425. if pai_string(hp)^.len > 0 then
  426. Begin
  427. for j := 0 to lines-1 do
  428. begin
  429. AsmWrite(#9#9'DB'#9);
  430. quoted:=false;
  431. for i:=counter to counter+line_length do
  432. begin
  433. { it is an ascii character. }
  434. if (ord(pai_string(hp)^.str[i])>31) and
  435. (ord(pai_string(hp)^.str[i])<128) and
  436. (pai_string(hp)^.str[i]<>'"') then
  437. begin
  438. if not(quoted) then
  439. begin
  440. if i>counter then
  441. AsmWrite(',');
  442. AsmWrite('"');
  443. end;
  444. AsmWrite(pai_string(hp)^.str[i]);
  445. quoted:=true;
  446. end { if > 31 and < 128 and ord('"') }
  447. else
  448. begin
  449. if quoted then
  450. AsmWrite('"');
  451. if i>counter then
  452. AsmWrite(',');
  453. quoted:=false;
  454. AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  455. end;
  456. end; { end for i:=0 to... }
  457. if quoted then AsmWrite('"');
  458. AsmWrite(target_os.newline);
  459. counter := counter+line_length;
  460. end; { end for j:=0 ... }
  461. { do last line of lines }
  462. AsmWrite(#9#9'DB'#9);
  463. quoted:=false;
  464. for i:=counter to pai_string(hp)^.len-1 do
  465. begin
  466. { it is an ascii character. }
  467. if (ord(pai_string(hp)^.str[i])>31) and
  468. (ord(pai_string(hp)^.str[i])<128) and
  469. (pai_string(hp)^.str[i]<>'"') then
  470. begin
  471. if not(quoted) then
  472. begin
  473. if i>counter then
  474. AsmWrite(',');
  475. AsmWrite('"');
  476. end;
  477. AsmWrite(pai_string(hp)^.str[i]);
  478. quoted:=true;
  479. end { if > 31 and < 128 and " }
  480. else
  481. begin
  482. if quoted then
  483. AsmWrite('"');
  484. if i>counter then
  485. AsmWrite(',');
  486. quoted:=false;
  487. AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
  488. end;
  489. end; { end for i:=0 to... }
  490. if quoted then
  491. AsmWrite('"');
  492. end;
  493. AsmLn;
  494. end;
  495. ait_label : begin
  496. if pai_label(hp)^.l^.is_used then
  497. AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
  498. end;
  499. ait_direct : begin
  500. AsmWritePChar(pai_direct(hp)^.str);
  501. AsmLn;
  502. end;
  503. ait_labeled_instruction :
  504. begin
  505. op:=pai386_labeled(hp)^.opcode;
  506. if not((op=A_JMP) or (op=A_LOOP) or (op=A_LOOPZ) or
  507. (op=A_LOOPE) or (op=A_LOOPNZ) or (op=A_LOOPNE) or
  508. (op=A_JCXZ) or (op=A_JECXZ)) then
  509. AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]+#9+'near '+lab2str(pai386_labeled(hp)^.lab))
  510. else
  511. AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]+#9+lab2str(pai386_labeled(hp)^.lab));
  512. end;
  513. ait_symbol : begin
  514. if pai_symbol(hp)^.is_global then
  515. AsmWriteLn(#9'GLOBAL '+pai_symbol(hp)^.sym^.name);
  516. AsmWrite(pai_symbol(hp)^.sym^.name);
  517. if assigned(hp^.next) and not(pai(hp^.next)^.typ in
  518. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  519. ait_const_symbol,ait_const_rva,
  520. ait_real_64bit,ait_string]) then
  521. AsmWriteLn(':')
  522. end;
  523. ait_instruction : begin
  524. suffix:='';
  525. prefix:='';
  526. s:='';
  527. {$ifndef OLDASM}
  528. if pai386(hp)^.ops<>0 then
  529. begin
  530. if pai386(hp)^.opcode=A_CALL then
  531. s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
  532. else
  533. begin
  534. for i:=0to pai386(hp)^.ops-1 do
  535. begin
  536. if i=0 then
  537. sep:=#9
  538. else
  539. sep:=',';
  540. s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
  541. end;
  542. end;
  543. end;
  544. if pai386(hp)^.opcode=A_FWAIT then
  545. AsmWriteln(#9#9'DB'#9'09bh')
  546. else
  547. AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^.opcode]+
  548. cond2str[pai386_labeled(hp)^.condition]+suffix+s);
  549. {$else}
  550. { added prefix instructions, must be on same line as opcode }
  551. if (pai386(hp)^.op1t = top_none) and
  552. ((pai386(hp)^.opcode = A_REP) or
  553. (pai386(hp)^.opcode = A_LOCK) or
  554. (pai386(hp)^.opcode = A_REPE) or
  555. (pai386(hp)^.opcode = A_REPNE)) then
  556. Begin
  557. prefix:=int_op2str[pai386(hp)^.opcode]+#9;
  558. hp:=Pai(hp^.next);
  559. { this is theorically impossible... }
  560. if hp=nil then
  561. begin
  562. s:=#9#9+prefix;
  563. AsmWriteLn(s);
  564. break;
  565. end;
  566. { nasm prefers prefix on a line alone }
  567. AsmWriteln(#9#9+prefix);
  568. prefix:='';
  569. end
  570. else
  571. prefix:= '';
  572. { A_FNSTS need the w as suffix at least for nasm}
  573. if (pai386(hp)^.opcode = A_FNSTS) then
  574. pai386(hp)^.opcode:=A_FNSTSW
  575. else
  576. if (pai386(hp)^.opcode = A_FSTS) then
  577. pai386(hp)^.opcode:=A_FSTSW;
  578. if pai386(hp)^.op1t<>top_none then
  579. begin
  580. if pai386(hp)^.opcode=A_CALL then
  581. s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs)
  582. else
  583. begin
  584. s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs,
  585. pai386(hp)^.opsize,pai386(hp)^.opcode,false);
  586. if pai386(hp)^.op3t<>top_none then
  587. begin
  588. if pai386(hp)^.op2t<>top_none then
  589. {$ifdef NO_OP3}
  590. s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),0,
  591. pai386(hp)^.opsize,pai386(hp)^.opcode,true)+','+s;
  592. s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),0,
  593. pai386(hp)^.opsize,pai386(hp)^.opcode,false)+','+s;
  594. {$else NO_OP3}
  595. s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,
  596. pai386(hp)^.opsize,pai386(hp)^.opcode,true)+','+s;
  597. s:=getopstr(pai386(hp)^.op3t,pai386(hp)^.op3,0,
  598. pai386(hp)^.opsize,pai386(hp)^.opcode,false)+','+s;
  599. {$endif NO_OP3}
  600. end
  601. else
  602. if pai386(hp)^.op2t<>top_none then
  603. s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,pai386(hp)^.opsize,
  604. pai386(hp)^.opcode,true)+','+s;
  605. end;
  606. s:=#9+s;
  607. end
  608. else
  609. begin
  610. { check if string instruction }
  611. { long form, otherwise may give range check errors }
  612. { in turbo pascal... }
  613. if ((pai386(hp)^.opcode = A_CMPS) or
  614. (pai386(hp)^.opcode = A_INS) or
  615. (pai386(hp)^.opcode = A_OUTS) or
  616. (pai386(hp)^.opcode = A_SCAS) or
  617. (pai386(hp)^.opcode = A_STOS) or
  618. (pai386(hp)^.opcode = A_MOVS) or
  619. (pai386(hp)^.opcode = A_LODS) or
  620. (pai386(hp)^.opcode = A_XLAT)) then
  621. Begin
  622. case pai386(hp)^.opsize of
  623. S_B: suffix:='b';
  624. S_W: suffix:='w';
  625. S_L: suffix:='d';
  626. else
  627. Message(assem_f_invalid_suffix_intel);
  628. end;
  629. end;
  630. s:='';
  631. end;
  632. if pai386(hp)^.opcode=A_FWAIT then
  633. AsmWriteln(#9#9'DB'#9'09bh')
  634. else
  635. AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^.opcode]+suffix+s);
  636. {$endif OLDASM}
  637. end;
  638. {$ifdef GDB}
  639. ait_stabn,
  640. ait_stabs,
  641. ait_force_line,
  642. ait_stab_function_name : ;
  643. {$endif GDB}
  644. ait_cut : begin
  645. { only reset buffer if nothing has changed }
  646. if AsmSize=AsmStartSize then
  647. AsmClear
  648. else
  649. begin
  650. AsmClose;
  651. DoAssemble;
  652. if pai_cut(hp)^.EndName then
  653. IsEndFile:=true;
  654. AsmCreate;
  655. end;
  656. { avoid empty files }
  657. while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
  658. begin
  659. if pai(hp^.next)^.typ=ait_section then
  660. lastsec:=pai_section(hp^.next)^.sec;
  661. hp:=pai(hp^.next);
  662. end;
  663. if lastsec<>sec_none then
  664. AsmWriteLn('SECTION '+target_asm.secnames[lastsec]);
  665. AsmStartSize:=AsmSize;
  666. end;
  667. ait_marker : ;
  668. else
  669. internalerror(10000);
  670. end;
  671. hp:=pai(hp^.next);
  672. end;
  673. end;
  674. procedure ti386nasmasmlist.WriteAsmList;
  675. begin
  676. {$ifdef EXTDEBUG}
  677. if assigned(current_module^.mainsource) then
  678. comment(v_info,'Start writing nasm-styled assembler output for '+current_module^.mainsource^);
  679. {$endif}
  680. LastSec:=sec_none;
  681. AsmWriteLn('BITS 32');
  682. AsmLn;
  683. countlabelref:=false;
  684. WriteTree(externals);
  685. { Nasm doesn't support stabs
  686. WriteTree(debuglist);}
  687. WriteTree(codesegment);
  688. WriteTree(datasegment);
  689. WriteTree(consts);
  690. WriteTree(rttilist);
  691. WriteTree(bsssegment);
  692. countlabelref:=true;
  693. AsmLn;
  694. {$ifdef EXTDEBUG}
  695. if assigned(current_module^.mainsource) then
  696. comment(v_info,'Done writing nasm-styled assembler output for '+current_module^.mainsource^);
  697. {$endif EXTDEBUG}
  698. end;
  699. end.
  700. {
  701. $Log$
  702. Revision 1.33 1999-05-07 00:08:48 pierre
  703. * AG386BIN cond -> OLDASM, only cosmetic
  704. Revision 1.32 1999/05/06 09:05:11 peter
  705. * generic write_float and str_float
  706. * fixed constant float conversions
  707. Revision 1.31 1999/05/04 21:44:32 florian
  708. * changes to compile it with Delphi 4.0
  709. Revision 1.30 1999/05/02 22:41:50 peter
  710. * moved section names to systems
  711. * fixed nasm,intel writer
  712. Revision 1.29 1999/05/01 13:23:59 peter
  713. * merged nasm compiler
  714. * old asm moved to oldasm/
  715. Revision 1.28 1999/04/17 22:17:06 pierre
  716. * ifdef USE_OP3 released (changed into ifndef NO_OP3)
  717. * SHRD and SHLD first operand (ATT syntax) can only be CL reg or immediate const
  718. Revision 1.27 1999/04/16 11:49:40 peter
  719. + tempalloc
  720. + -at to show temp alloc info in .s file
  721. Revision 1.26 1999/04/16 10:00:56 pierre
  722. + ifdef USE_OP3 code :
  723. added all missing op_... constructors for tai386 needed
  724. for SHRD,SHLD and IMUL code in assembler readers
  725. (check in tests/tbs0123.pp)
  726. Revision 1.25 1999/03/29 16:05:44 peter
  727. * optimizer working for ag386bin
  728. Revision 1.24 1999/03/10 13:25:44 pierre
  729. section order changed to get closer output from coff writer
  730. Revision 1.23 1999/03/04 13:55:39 pierre
  731. * some m68k fixes (still not compilable !)
  732. * new(tobj) does not give warning if tobj has no VMT !
  733. Revision 1.22 1999/03/02 02:56:11 peter
  734. + stabs support for binary writers
  735. * more fixes and missing updates from the previous commit :(
  736. Revision 1.21 1999/03/01 15:46:17 peter
  737. * ag386bin finally make cycles correct
  738. * prefixes are now also normal opcodes
  739. Revision 1.20 1999/02/26 00:48:14 peter
  740. * assembler writers fixed for ag386bin
  741. Revision 1.19 1999/02/25 21:02:19 peter
  742. * ag386bin updates
  743. + coff writer
  744. Revision 1.18 1999/02/22 02:15:00 peter
  745. * updates for ag386bin
  746. Revision 1.17 1998/12/20 16:21:23 peter
  747. * smartlinking doesn't crash anymore
  748. Revision 1.16 1998/12/16 00:27:18 peter
  749. * removed some obsolete version checks
  750. Revision 1.15 1998/12/01 11:19:39 peter
  751. * fixed range problem with in [tasmop]
  752. Revision 1.14 1998/11/30 09:42:56 pierre
  753. * some range check bugs fixed (still not working !)
  754. + added DLL writing support for win32 (also accepts variables)
  755. + TempAnsi for code that could be used for Temporary ansi strings
  756. handling
  757. Revision 1.13 1998/11/17 00:26:10 peter
  758. * fixed for $H+
  759. Revision 1.12 1998/11/12 11:19:34 pierre
  760. * fix for first line of function break
  761. Revision 1.11 1998/10/12 12:20:42 pierre
  762. + added tai_const_symbol_offset
  763. for r : pointer = @var.field;
  764. * better message for different arg names on implementation
  765. of function
  766. Revision 1.10 1998/10/06 17:16:34 pierre
  767. * some memory leaks fixed (thanks to Peter for heaptrc !)
  768. Revision 1.9 1998/10/01 20:19:07 jonas
  769. + ait_marker support
  770. Revision 1.8 1998/09/20 17:11:22 jonas
  771. * released REGALLOC
  772. Revision 1.7 1998/08/11 14:01:43 peter
  773. * fixed fwait bug using direct opcode
  774. Revision 1.6 1998/08/10 15:49:39 peter
  775. * small fixes for 0.99.5
  776. Revision 1.5 1998/08/08 10:19:18 florian
  777. * small fixes to write the extended type correct
  778. Revision 1.4 1998/06/05 17:46:03 peter
  779. * tp doesn't like comp() typecast
  780. Revision 1.3 1998/05/28 17:24:27 peter
  781. - $R- for tp to solve range errors with in[]
  782. Revision 1.2 1998/05/25 17:11:37 pierre
  783. * firstpasscount bug fixed
  784. now all is already set correctly the first time
  785. under EXTDEBUG try -gp to skip all other firstpasses
  786. it works !!
  787. * small bug fixes
  788. - for smallsets with -dTESTSMALLSET
  789. - some warnings removed (by correcting code !)
  790. Revision 1.1 1998/05/23 01:20:56 peter
  791. + aktasmmode, aktoptprocessor, aktoutputformat
  792. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  793. + $LIBNAME to set the library name where the unit will be put in
  794. * splitted cgi386 a bit (codeseg to large for bp7)
  795. * nasm, tasm works again. nasm moved to ag386nsm.pas
  796. }