ag68kmit.pas 27 KB

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