ag68kmit.pas 28 KB

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