ag68kmit.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696
  1. {
  2. $Id$
  3. Copyright (c) 1998 by the FPC development team
  4. This unit implements an asmoutput class for MIT syntax with
  5. Motorola 68000 (for MIT syntax TEST WITH GAS v1.34)
  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. What's to do:
  19. o Verify if this actually work as indirect mode with name of variables
  20. o write lines numbers and file names to output file
  21. o generate debugging informations
  22. }
  23. unit ag68kmit;
  24. interface
  25. uses aasm,assemble;
  26. type
  27. pm68kmitasmlist=^tm68kmitasmlist;
  28. tm68kmitasmlist = object(tasmlist)
  29. procedure WriteTree(p:paasmoutput);virtual;
  30. procedure WriteAsmList;virtual;
  31. end;
  32. implementation
  33. uses
  34. dos,globals,systems,cobjects,m68k,
  35. strings,files,verbose
  36. {$ifdef GDB}
  37. ,gdb
  38. {$endif GDB}
  39. ;
  40. const
  41. line_length = 70;
  42. var
  43. {$ifdef GDB}
  44. n_line : byte; { different types of source lines }
  45. includecount : longint;
  46. {$endif}
  47. lastsec : tsection; { last section type written }
  48. lastsecidx,
  49. lastfileindex,
  50. lastline : longint;
  51. function double2str(d : double) : string;
  52. var
  53. hs : string;
  54. begin
  55. str(d,hs);
  56. { replace space with + }
  57. if hs[1]=' ' then
  58. hs[1]:='+';
  59. double2str:=hs;
  60. end;
  61. function comp2str(d : bestreal) : string;
  62. type
  63. pdouble = ^double;
  64. var
  65. c : comp;
  66. dd : pdouble;
  67. begin
  68. {$ifdef TP}
  69. c:=d;
  70. {$else}
  71. c:=comp(d);
  72. {$endif}
  73. dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
  74. comp2str:=double2str(dd^);
  75. end;
  76. function getreferencestring(const ref : treference) : string;
  77. var
  78. s : string;
  79. begin
  80. s:='';
  81. if ref.isintvalue then
  82. s:='#'+tostr(ref.offset)
  83. else
  84. with ref do
  85. begin
  86. { symbol and offset }
  87. if (assigned(symbol)) and (offset<>0) then
  88. Begin
  89. s:=s+'('+tostr(offset)+symbol^;
  90. end
  91. else
  92. { symbol only }
  93. if (assigned(symbol)) and (offset=0) then
  94. Begin
  95. s:=s+'('+symbol^;
  96. end
  97. else
  98. { offset only }
  99. if (symbol=nil) and (offset<>0) then
  100. Begin
  101. s:=s+'('+tostr(offset);
  102. end
  103. else
  104. { NOTHING - put zero as offset }
  105. if (symbol=nil) and (offset=0) then
  106. Begin
  107. s:=s+'('+'0';
  108. end
  109. else
  110. InternalError(10004);
  111. if (index<>R_NO) and (base=R_NO) and (direction=dir_none) then
  112. InternalError(10004)
  113. else if (index=R_NO) and (base<>R_NO) and (direction=dir_inc) then
  114. begin
  115. if (scalefactor = 1) or (scalefactor = 0) then
  116. Begin
  117. if offset<>0 then
  118. s:=mit_reg2str[base]+'@+'+s+')'
  119. else
  120. s:=mit_reg2str[base]+'@+';
  121. end
  122. else
  123. InternalError(10002);
  124. end
  125. else if (index=R_NO) and (base<>R_NO) and (direction=dir_dec) then
  126. begin
  127. if (scalefactor = 1) or (scalefactor = 0) then
  128. Begin
  129. if offset<>0 then
  130. s:=mit_reg2str[base]+'@-'+s+')'
  131. else
  132. s:=mit_reg2str[base]+'@-';
  133. end
  134. else
  135. InternalError(10003);
  136. end
  137. else if (index=R_NO) and (base<>R_NO) and (direction=dir_none) then
  138. begin
  139. if (offset=0) and (symbol=nil) then
  140. s:=mit_reg2str[base]+'@'
  141. else
  142. s:=mit_reg2str[base]+'@'+s+')';
  143. end
  144. else if (index<>R_NO) and (base<>R_NO) and (direction=dir_none) then
  145. begin
  146. s:=mit_reg2str[base]+'@'+s+','+mit_reg2str[index]+':L';
  147. if (scalefactor = 1) or (scalefactor = 0) then
  148. s:=s+')'
  149. else
  150. s:=s+':'+tostr(scalefactor)+')';
  151. end
  152. else
  153. if assigned(symbol) then
  154. Begin
  155. s:=symbol^;
  156. if offset<>0 then
  157. s:=s+'+'+tostr(offset);
  158. end
  159. { this must be a physical address }
  160. else
  161. s:=s+')';
  162. { else if NOT assigned(symbol) then
  163. InternalError(10004);}
  164. end; { end with }
  165. getreferencestring:=s;
  166. end;
  167. function getopstr(t : byte;o : pointer) : string;
  168. var
  169. hs : string;
  170. i: tregister;
  171. begin
  172. case t of
  173. top_reg : getopstr:=mit_reg2str[tregister(o)];
  174. top_ref : getopstr:=getreferencestring(preference(o)^);
  175. top_reglist: begin
  176. hs:='';
  177. for i:=R_NO to R_FPSR do
  178. begin
  179. if i in tregisterlist(o^) then
  180. hs:=hs+mit_reg2str[i]+'/';
  181. end;
  182. delete(hs,length(hs),1);
  183. getopstr := hs;
  184. end;
  185. top_const : getopstr:='#'+tostr(longint(o));
  186. top_symbol :
  187. { compare with i386, where a symbol is considered }
  188. { a constant. }
  189. begin
  190. hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  191. move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  192. { inc(byte(hs[0]));}
  193. if pcsymbol(o)^.offset>0 then
  194. hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  195. else if pcsymbol(o)^.offset<0 then
  196. hs:=hs+tostr(pcsymbol(o)^.offset);
  197. getopstr:=hs;
  198. end;
  199. else internalerror(10001);
  200. end;
  201. end;
  202. function getopstr_jmp(t : byte;o : pointer) : string;
  203. var
  204. hs : string;
  205. begin
  206. case t of
  207. top_reg : getopstr_jmp:=mit_reg2str[tregister(o)];
  208. top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
  209. top_const : getopstr_jmp:=tostr(longint(o));
  210. top_symbol : begin
  211. hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
  212. move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
  213. if pcsymbol(o)^.offset>0 then
  214. hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
  215. else if pcsymbol(o)^.offset<0 then
  216. hs:=hs+tostr(pcsymbol(o)^.offset);
  217. getopstr_jmp:=hs;
  218. end;
  219. else internalerror(10001);
  220. end;
  221. end;
  222. {****************************************************************************
  223. T68kGASASMOUTPUT
  224. ****************************************************************************}
  225. const
  226. ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
  227. (#9'.long'#9,#9'.short'#9,#9'.byte'#9);
  228. ait_section2str : array[tsection] of string[6]=
  229. ('','.text','.data','.bss','.idata');
  230. procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
  231. var
  232. hp : pai;
  233. ch : char;
  234. consttyp : tait;
  235. s : string;
  236. pos,l,i : longint;
  237. found : boolean;
  238. {$ifdef GDB}
  239. curr_n : byte;
  240. infile : pinputfile;
  241. funcname : pchar;
  242. linecount : longint;
  243. {$endif GDB}
  244. begin
  245. if not assigned(p) then
  246. exit;
  247. {$ifdef GDB}
  248. funcname:=nil;
  249. linecount:=1;
  250. {$endif GDB}
  251. hp:=pai(p^.first);
  252. while assigned(hp) do
  253. begin
  254. { write debugger informations }
  255. {$ifdef GDB}
  256. if cs_debuginfo in aktmoduleswitches then
  257. begin
  258. if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,
  259. ait_label,ait_cut,ait_align,ait_stab_function_name]) then
  260. begin
  261. { file changed ? (must be before line info) }
  262. if lastfileindex<>hp^.fileinfo.fileindex then
  263. begin
  264. infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
  265. if includecount=0 then
  266. curr_n:=n_sourcefile
  267. else
  268. curr_n:=n_includefile;
  269. if (infile^.path^<>'') then
  270. begin
  271. AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^)))+'",'+
  272. tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
  273. end;
  274. AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
  275. tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
  276. AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
  277. inc(includecount);
  278. lastfileindex:=hp^.fileinfo.fileindex;
  279. end;
  280. { line changed ? }
  281. if (hp^.fileinfo.line<>lastline) and (hp^.fileinfo.line<>0) then
  282. begin
  283. if (n_line=n_textline) and assigned(funcname) and
  284. (target_os.use_function_relative_addresses) then
  285. begin
  286. AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
  287. AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line)+','+
  288. target_asm.labelprefix+'l'+tostr(linecount)+' - ');
  289. AsmWritePChar(FuncName);
  290. AsmLn;
  291. inc(linecount);
  292. end
  293. else
  294. AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line));
  295. lastline:=hp^.fileinfo.line;
  296. end;
  297. end;
  298. end;
  299. {$endif GDB}
  300. case hp^.typ of
  301. ait_external : ; { external is ignored }
  302. ait_comment : Begin
  303. AsmWrite(target_asm.comment);
  304. AsmWritePChar(pai_asm_comment(hp)^.str);
  305. AsmLn;
  306. End;
  307. {$ifdef DREGALLOC}
  308. ait_regalloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' allocated');
  309. ait_regdealloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' released');
  310. {$endif DREGALLOC}
  311. ait_align : AsmWriteLn(#9'.align '+tostr(pai_align(hp)^.aligntype));
  312. ait_section : begin
  313. if pai_section(hp)^.sec<>sec_none then
  314. begin
  315. AsmLn;
  316. AsmWrite(ait_section2str[pai_section(hp)^.sec]);
  317. if pai_section(hp)^.idataidx>0 then
  318. AsmWrite('$'+tostr(pai_section(hp)^.idataidx));
  319. AsmLn;
  320. {$ifdef GDB}
  321. case pai_section(hp)^.sec of
  322. sec_code : n_line:=n_textline;
  323. sec_data : n_line:=n_dataline;
  324. sec_bss : n_line:=n_bssline;
  325. end;
  326. {$endif GDB}
  327. end;
  328. LastSec:=pai_section(hp)^.sec;
  329. end;
  330. ait_datablock : begin
  331. { ------------------------------------------------------- }
  332. { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
  333. { ------------- REQUIREMENT FOR 680x0 ------------------- }
  334. { ------------------------------------------------------- }
  335. if pai_datablock(hp)^.size <> 1 then
  336. begin
  337. if not(cs_littlesize in aktglobalswitches) then
  338. AsmWriteLn(#9#9'.align 4')
  339. else
  340. AsmWriteLn(#9#9'.align 2');
  341. end;
  342. if pai_datablock(hp)^.is_global then
  343. AsmWrite(#9'.comm'#9)
  344. else
  345. AsmWrite(#9'.lcomm'#9);
  346. AsmWriteLn(StrPas(pai_datablock(hp)^.name)+','+tostr(pai_datablock(hp)^.size));
  347. end;
  348. ait_const_32bit, { alignment is required for 16/32 bit data! }
  349. ait_const_16bit: begin
  350. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  351. consttyp:=hp^.typ;
  352. l:=0;
  353. repeat
  354. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  355. if found then
  356. begin
  357. hp:=Pai(hp^.next);
  358. s:=','+tostr(pai_const(hp)^.value);
  359. AsmWrite(s);
  360. inc(l,length(s));
  361. end;
  362. until (not found) or (l>line_length);
  363. AsmLn;
  364. end;
  365. ait_const_8bit : begin
  366. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  367. consttyp:=hp^.typ;
  368. l:=0;
  369. repeat
  370. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  371. if found then
  372. begin
  373. hp:=Pai(hp^.next);
  374. s:=','+tostr(pai_const(hp)^.value);
  375. AsmWrite(s);
  376. inc(l,length(s));
  377. end;
  378. until (not found) or (l>line_length);
  379. AsmLn;
  380. end;
  381. ait_const_symbol : Begin
  382. AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
  383. end;
  384. ait_const_symbol_offset :
  385. Begin
  386. AsmWrite(#9'.long'#9);
  387. AsmWritePChar(pai_const_symbol_offset(hp)^.name);
  388. if pai_const_symbol_offset(hp)^.offset>0 then
  389. AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
  390. else if pai_const_symbol_offset(hp)^.offset<0 then
  391. AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
  392. AsmLn;
  393. end;
  394. ait_real_64bit : Begin
  395. AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
  396. end;
  397. ait_real_32bit : Begin
  398. AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
  399. end;
  400. ait_real_extended : Begin
  401. AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
  402. { comp type is difficult to write so use double }
  403. end;
  404. ait_comp : Begin
  405. AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
  406. end;
  407. ait_direct : begin
  408. AsmWritePChar(pai_direct(hp)^.str);
  409. AsmLn;
  410. {$IfDef GDB}
  411. if strpos(pai_direct(hp)^.str,'.data')<>nil then
  412. n_line:=n_dataline
  413. else if strpos(pai_direct(hp)^.str,'.text')<>nil then
  414. n_line:=n_textline
  415. else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
  416. n_line:=n_bssline;
  417. {$endif GDB}
  418. end;
  419. ait_string : begin
  420. pos:=0;
  421. for i:=1 to pai_string(hp)^.len do
  422. begin
  423. if pos=0 then
  424. begin
  425. AsmWrite(#9'.ascii'#9'"');
  426. pos:=20;
  427. end;
  428. ch:=pai_string(hp)^.str[i-1];
  429. case ch of
  430. #0, {This can't be done by range, because a bug in FPC}
  431. #1..#31,
  432. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  433. '"' : s:='\"';
  434. '\' : s:='\\';
  435. else
  436. s:=ch;
  437. end;
  438. AsmWrite(s);
  439. inc(pos,length(s));
  440. if (pos>line_length) or (i=pai_string(hp)^.len) then
  441. begin
  442. AsmWriteLn('"');
  443. pos:=0;
  444. end;
  445. end;
  446. end;
  447. ait_label : begin
  448. if assigned(hp^.next) and (pai(hp^.next)^.typ in
  449. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  450. ait_const_symbol,ait_const_symbol_offset,
  451. ait_real_64bit,ait_real_32bit,ait_string]) then
  452. begin
  453. if not(cs_littlesize in aktglobalswitches) then
  454. AsmWriteLn(#9#9'.align 4')
  455. else
  456. AsmWriteLn(#9#9'.align 2');
  457. end;
  458. if (pai_label(hp)^.l^.is_used) then
  459. AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
  460. end;
  461. ait_labeled_instruction : begin
  462. { labeled operand }
  463. if pai_labeled(hp)^._op1 = R_NO then
  464. AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab))
  465. else
  466. { labeled operand with register }
  467. AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+
  468. reg2str(pai_labeled(hp)^._op1)+','+lab2str(pai_labeled(hp)^.lab))
  469. end;
  470. ait_symbol : begin
  471. { ------------------------------------------------------- }
  472. { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
  473. { ------------- REQUIREMENT FOR 680x0 ------------------- }
  474. { ------------------------------------------------------- }
  475. if assigned(hp^.next) and (pai(hp^.next)^.typ in
  476. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  477. ait_const_symbol,ait_const_symbol_offset,
  478. ait_real_64bit,ait_real_32bit,ait_string]) then
  479. begin
  480. if not(cs_littlesize in aktglobalswitches) then
  481. AsmWriteLn(#9#9'.align 4')
  482. else
  483. AsmWriteLn(#9#9'.align 2');
  484. end;
  485. if pai_symbol(hp)^.is_global then
  486. AsmWriteLn('.globl '+StrPas(pai_symbol(hp)^.name));
  487. AsmWriteLn(StrPas(pai_symbol(hp)^.name)+':');
  488. end;
  489. ait_instruction : begin
  490. { old versions of GAS don't like PEA.L and LEA.L }
  491. if (pai68k(hp)^._operator in [
  492. A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
  493. A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
  494. A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
  495. A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
  496. s:=#9+mot_op2str[pai68k(hp)^._operator]
  497. else
  498. s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
  499. if pai68k(hp)^.op1t<>top_none then
  500. begin
  501. { call and jmp need an extra handling }
  502. { this code is only callded if jmp isn't a labeled instruction }
  503. if pai68k(hp)^._operator in [A_JSR,A_JMP] then
  504. s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1)
  505. else
  506. if pai68k(hp)^.op1t = top_reglist then
  507. s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist))
  508. else
  509. s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1);
  510. if pai68k(hp)^.op2t<>top_none then
  511. begin
  512. if pai68k(hp)^.op2t = top_reglist then
  513. s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist)
  514. else
  515. s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2);
  516. { three operands }
  517. if pai68k(hp)^.op3t<>top_none then
  518. begin
  519. if (pai68k(hp)^._operator = A_DIVSL) or
  520. (pai68k(hp)^._operator = A_DIVUL) or
  521. (pai68k(hp)^._operator = A_MULU) or
  522. (pai68k(hp)^._operator = A_MULS) or
  523. (pai68k(hp)^._operator = A_DIVS) or
  524. (pai68k(hp)^._operator = A_DIVU) then
  525. s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3)
  526. else
  527. s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3);
  528. end;
  529. end;
  530. end;
  531. AsmWriteLn(s);
  532. end;
  533. {$ifdef GDB}
  534. ait_stabs : begin
  535. AsmWrite(#9'.stabs ');
  536. AsmWritePChar(pai_stabs(hp)^.str);
  537. AsmLn;
  538. end;
  539. ait_stabn : begin
  540. AsmWrite(#9'.stabn ');
  541. AsmWritePChar(pai_stabn(hp)^.str);
  542. AsmLn;
  543. end;
  544. ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
  545. {$endif GDB}
  546. ait_cut : begin
  547. { create only a new file when the last is not empty }
  548. if AsmSize>0 then
  549. begin
  550. AsmClose;
  551. DoAssemble;
  552. AsmCreate;
  553. end;
  554. { avoid empty files }
  555. while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
  556. begin
  557. if pai(hp^.next)^.typ=ait_section then
  558. begin
  559. lastsec:=pai_section(hp^.next)^.sec;
  560. lastsecidx:=pai_section(hp^.next)^.idataidx;
  561. end;
  562. hp:=pai(hp^.next);
  563. end;
  564. if lastsec<>sec_none then
  565. AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
  566. end;
  567. ait_marker : ;
  568. else
  569. internalerror(10000);
  570. end;
  571. hp:=pai(hp^.next);
  572. end;
  573. end;
  574. procedure tm68kmitasmlist.WriteAsmList;
  575. var
  576. p:dirstr;
  577. n:namestr;
  578. e:extstr;
  579. begin
  580. {$ifdef EXTDEBUG}
  581. if assigned(current_module^.mainsource) then
  582. comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
  583. {$endif}
  584. lastline:=0;
  585. lastfileindex:=0;
  586. LastSec:=sec_none;
  587. {$ifdef GDB}
  588. includecount:=0;
  589. n_line:=n_bssline;
  590. {$endif GDB}
  591. if assigned(current_module^.mainsource) then
  592. fsplit(current_module^.mainsource^,p,n,e)
  593. else
  594. begin
  595. p:=inputdir;
  596. n:=inputfile;
  597. e:=inputextension;
  598. end;
  599. { to get symify to work }
  600. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  601. countlabelref:=false;
  602. { there should be nothing but externals so we don't need to process
  603. WriteTree(externals); }
  604. WriteTree(debuglist);
  605. WriteTree(codesegment);
  606. WriteTree(datasegment);
  607. WriteTree(consts);
  608. WriteTree(rttilist);
  609. WriteTree(bsssegment);
  610. Writetree(importssection);
  611. Writetree(exportssection);
  612. Writetree(resourcesection);
  613. countlabelref:=true;
  614. AsmLn;
  615. {$ifdef EXTDEBUG}
  616. if assigned(current_module^.mainsource) then
  617. comment(v_info,'Done writing gas-styled assembler output for '+current_module^.mainsource^);
  618. {$endif EXTDEBUG}
  619. end;
  620. end.
  621. {
  622. $Log$
  623. Revision 1.13 1998-10-12 12:20:44 pierre
  624. + added tai_const_symbol_offset
  625. for r : pointer = @var.field;
  626. * better message for different arg names on implementation
  627. of function
  628. Revision 1.12 1998/10/06 17:16:37 pierre
  629. * some memory leaks fixed (thanks to Peter for heaptrc !)
  630. Revision 1.11 1998/10/01 20:19:09 jonas
  631. + ait_marker support
  632. Revision 1.10 1998/09/28 16:57:11 pierre
  633. * changed all length(p^.value_str^) into str_length(p)
  634. to get it work with and without ansistrings
  635. * changed sourcefiles field of tmodule to a pointer
  636. Revision 1.9 1998/09/16 01:07:43 carl
  637. * bugfix of byte alignment
  638. Revision 1.8 1998/08/10 14:49:37 peter
  639. + localswitches, moduleswitches, globalswitches splitting
  640. Revision 1.7 1998/07/14 14:46:39 peter
  641. * released NEWINPUT
  642. Revision 1.6 1998/07/10 10:50:55 peter
  643. * m68k updates
  644. Revision 1.5 1998/06/05 17:46:05 peter
  645. * tp doesn't like comp() typecast
  646. Revision 1.4 1998/06/04 23:51:29 peter
  647. * m68k compiles
  648. + .def file creation moved to gendef.pas so it could also be used
  649. for win32
  650. }