ag68kmit.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724
  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[6]=
  234. ('','.text','.data','.bss','.idata','.edata');
  235. procedure tm68kmitasmlist.WriteTree(p:paasmoutput);
  236. var
  237. hp : pai;
  238. ch : char;
  239. consttyp : tait;
  240. s : string;
  241. pos,l,i : longint;
  242. found : boolean;
  243. {$ifdef GDB}
  244. curr_n : byte;
  245. infile : pinputfile;
  246. funcname : pchar;
  247. linecount : longint;
  248. {$endif GDB}
  249. begin
  250. if not assigned(p) then
  251. exit;
  252. {$ifdef GDB}
  253. funcname:=nil;
  254. linecount:=1;
  255. {$endif GDB}
  256. hp:=pai(p^.first);
  257. while assigned(hp) do
  258. begin
  259. { write debugger informations }
  260. {$ifdef GDB}
  261. if cs_debuginfo in aktmoduleswitches then
  262. begin
  263. if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,
  264. ait_label,ait_cut,ait_align,ait_stab_function_name]) then
  265. begin
  266. { file changed ? (must be before line info) }
  267. if lastfileindex<>hp^.fileinfo.fileindex then
  268. begin
  269. infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex);
  270. if includecount=0 then
  271. curr_n:=n_sourcefile
  272. else
  273. curr_n:=n_includefile;
  274. if (infile^.path^<>'') then
  275. begin
  276. AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+
  277. tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
  278. end;
  279. AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
  280. tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
  281. AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
  282. inc(includecount);
  283. lastfileindex:=hp^.fileinfo.fileindex;
  284. end;
  285. { line changed ? }
  286. if (hp^.fileinfo.line<>lastline) and (hp^.fileinfo.line<>0) then
  287. begin
  288. if (n_line=n_textline) and assigned(funcname) and
  289. (target_os.use_function_relative_addresses) then
  290. begin
  291. AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
  292. AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line)+','+
  293. target_asm.labelprefix+'l'+tostr(linecount)+' - ');
  294. AsmWritePChar(FuncName);
  295. AsmLn;
  296. inc(linecount);
  297. end
  298. else
  299. AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line));
  300. lastline:=hp^.fileinfo.line;
  301. end;
  302. end;
  303. end;
  304. {$endif GDB}
  305. case hp^.typ of
  306. ait_external : ; { external is ignored }
  307. ait_comment : Begin
  308. AsmWrite(target_asm.comment);
  309. AsmWritePChar(pai_asm_comment(hp)^.str);
  310. AsmLn;
  311. End;
  312. {$ifdef DREGALLOC}
  313. ait_regalloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' allocated');
  314. ait_regdealloc : AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+' released');
  315. {$endif DREGALLOC}
  316. ait_align : AsmWriteLn(#9'.align '+tostr(pai_align(hp)^.aligntype));
  317. ait_section : begin
  318. if pai_section(hp)^.sec<>sec_none then
  319. begin
  320. AsmLn;
  321. AsmWrite(ait_section2str[pai_section(hp)^.sec]);
  322. if pai_section(hp)^.idataidx>0 then
  323. AsmWrite('$'+tostr(pai_section(hp)^.idataidx));
  324. AsmLn;
  325. {$ifdef GDB}
  326. case pai_section(hp)^.sec of
  327. sec_code : n_line:=n_textline;
  328. sec_data : n_line:=n_dataline;
  329. sec_bss : n_line:=n_bssline;
  330. end;
  331. {$endif GDB}
  332. end;
  333. LastSec:=pai_section(hp)^.sec;
  334. end;
  335. ait_datablock : begin
  336. { ------------------------------------------------------- }
  337. { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
  338. { ------------- REQUIREMENT FOR 680x0 ------------------- }
  339. { ------------------------------------------------------- }
  340. if pai_datablock(hp)^.size <> 1 then
  341. begin
  342. if not(cs_littlesize in aktglobalswitches) then
  343. AsmWriteLn(#9#9'.align 4')
  344. else
  345. AsmWriteLn(#9#9'.align 2');
  346. end;
  347. if pai_datablock(hp)^.is_global then
  348. AsmWrite(#9'.comm'#9)
  349. else
  350. AsmWrite(#9'.lcomm'#9);
  351. AsmWriteLn(StrPas(pai_datablock(hp)^.name)+','+tostr(pai_datablock(hp)^.size));
  352. end;
  353. ait_const_32bit, { alignment is required for 16/32 bit data! }
  354. ait_const_16bit: begin
  355. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  356. consttyp:=hp^.typ;
  357. l:=0;
  358. repeat
  359. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  360. if found then
  361. begin
  362. hp:=Pai(hp^.next);
  363. s:=','+tostr(pai_const(hp)^.value);
  364. AsmWrite(s);
  365. inc(l,length(s));
  366. end;
  367. until (not found) or (l>line_length);
  368. AsmLn;
  369. end;
  370. ait_const_8bit : begin
  371. AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
  372. consttyp:=hp^.typ;
  373. l:=0;
  374. repeat
  375. found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
  376. if found then
  377. begin
  378. hp:=Pai(hp^.next);
  379. s:=','+tostr(pai_const(hp)^.value);
  380. AsmWrite(s);
  381. inc(l,length(s));
  382. end;
  383. until (not found) or (l>line_length);
  384. AsmLn;
  385. end;
  386. ait_const_symbol : Begin
  387. AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
  388. end;
  389. ait_const_symbol_offset :
  390. Begin
  391. AsmWrite(#9'.long'#9);
  392. AsmWritePChar(pai_const_symbol_offset(hp)^.name);
  393. if pai_const_symbol_offset(hp)^.offset>0 then
  394. AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
  395. else if pai_const_symbol_offset(hp)^.offset<0 then
  396. AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
  397. AsmLn;
  398. end;
  399. ait_real_64bit : Begin
  400. AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
  401. end;
  402. ait_real_32bit : Begin
  403. AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
  404. end;
  405. ait_real_extended : Begin
  406. AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
  407. { comp type is difficult to write so use double }
  408. end;
  409. { TO SUPPORT SOONER OR LATER!!!
  410. ait_comp : Begin
  411. AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
  412. end; }
  413. ait_direct : begin
  414. AsmWritePChar(pai_direct(hp)^.str);
  415. AsmLn;
  416. {$IfDef GDB}
  417. if strpos(pai_direct(hp)^.str,'.data')<>nil then
  418. n_line:=n_dataline
  419. else if strpos(pai_direct(hp)^.str,'.text')<>nil then
  420. n_line:=n_textline
  421. else if strpos(pai_direct(hp)^.str,'.bss')<>nil then
  422. n_line:=n_bssline;
  423. {$endif GDB}
  424. end;
  425. ait_string : begin
  426. pos:=0;
  427. for i:=1 to pai_string(hp)^.len do
  428. begin
  429. if pos=0 then
  430. begin
  431. AsmWrite(#9'.ascii'#9'"');
  432. pos:=20;
  433. end;
  434. ch:=pai_string(hp)^.str[i-1];
  435. case ch of
  436. #0, {This can't be done by range, because a bug in FPC}
  437. #1..#31,
  438. #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7);
  439. '"' : s:='\"';
  440. '\' : s:='\\';
  441. else
  442. s:=ch;
  443. end;
  444. AsmWrite(s);
  445. inc(pos,length(s));
  446. if (pos>line_length) or (i=pai_string(hp)^.len) then
  447. begin
  448. AsmWriteLn('"');
  449. pos:=0;
  450. end;
  451. end;
  452. end;
  453. ait_label : begin
  454. if assigned(hp^.next) and (pai(hp^.next)^.typ in
  455. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  456. ait_const_symbol,ait_const_symbol_offset,
  457. ait_real_64bit,ait_real_32bit,ait_string]) then
  458. begin
  459. if not(cs_littlesize in aktglobalswitches) then
  460. AsmWriteLn(#9#9'.align 4')
  461. else
  462. AsmWriteLn(#9#9'.align 2');
  463. end;
  464. if (pai_label(hp)^.l^.is_used) then
  465. AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
  466. end;
  467. ait_labeled_instruction : begin
  468. { labeled operand }
  469. if pai_labeled(hp)^._op1 = R_NO then
  470. AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab))
  471. else
  472. { labeled operand with register }
  473. AsmWriteLn(#9+mot_op2str[pai_labeled(hp)^._operator]+#9+
  474. mit_reg2str[pai_labeled(hp)^._op1]+','+lab2str(pai_labeled(hp)^.lab))
  475. end;
  476. ait_symbol : begin
  477. { ------------------------------------------------------- }
  478. { ----------- ALIGNMENT FOR ANY NON-BYTE VALUE ---------- }
  479. { ------------- REQUIREMENT FOR 680x0 ------------------- }
  480. { ------------------------------------------------------- }
  481. if assigned(hp^.next) and (pai(hp^.next)^.typ in
  482. [ait_const_32bit,ait_const_16bit,ait_const_8bit,
  483. ait_const_symbol,ait_const_symbol_offset,
  484. ait_real_64bit,ait_real_32bit,ait_string]) then
  485. begin
  486. if not(cs_littlesize in aktglobalswitches) then
  487. AsmWriteLn(#9#9'.align 4')
  488. else
  489. AsmWriteLn(#9#9'.align 2');
  490. end;
  491. if pai_symbol(hp)^.is_global then
  492. AsmWriteLn('.globl '+StrPas(pai_symbol(hp)^.name));
  493. AsmWriteLn(StrPas(pai_symbol(hp)^.name)+':');
  494. end;
  495. ait_instruction : begin
  496. { old versions of GAS don't like PEA.L and LEA.L }
  497. if (pai68k(hp)^._operator in [
  498. A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
  499. A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
  500. A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
  501. A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
  502. s:=#9+mot_op2str[pai68k(hp)^._operator]
  503. else
  504. s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
  505. if pai68k(hp)^.op1t<>top_none then
  506. begin
  507. { call and jmp need an extra handling }
  508. { this code is only callded if jmp isn't a labeled instruction }
  509. if pai68k(hp)^._operator in [A_JSR,A_JMP] then
  510. s:=s+#9+getopstr_jmp(pai68k(hp)^.op1t,pai68k(hp)^.op1)
  511. else
  512. if pai68k(hp)^.op1t = top_reglist then
  513. s:=s+#9+getopstr(pai68k(hp)^.op1t,@(pai68k(hp)^.reglist))
  514. else
  515. s:=s+#9+getopstr(pai68k(hp)^.op1t,pai68k(hp)^.op1);
  516. if pai68k(hp)^.op2t<>top_none then
  517. begin
  518. if pai68k(hp)^.op2t = top_reglist then
  519. s:=s+','+getopstr(pai68k(hp)^.op2t,@pai68k(hp)^.reglist)
  520. else
  521. s:=s+','+getopstr(pai68k(hp)^.op2t,pai68k(hp)^.op2);
  522. { three operands }
  523. if pai68k(hp)^.op3t<>top_none then
  524. begin
  525. if (pai68k(hp)^._operator = A_DIVSL) or
  526. (pai68k(hp)^._operator = A_DIVUL) or
  527. (pai68k(hp)^._operator = A_MULU) or
  528. (pai68k(hp)^._operator = A_MULS) or
  529. (pai68k(hp)^._operator = A_DIVS) or
  530. (pai68k(hp)^._operator = A_DIVU) then
  531. s:=s+':'+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3)
  532. else
  533. s:=s+','+getopstr(pai68k(hp)^.op3t,pai68k(hp)^.op3);
  534. end;
  535. end;
  536. end;
  537. AsmWriteLn(s);
  538. end;
  539. {$ifdef GDB}
  540. ait_stabs : begin
  541. AsmWrite(#9'.stabs ');
  542. AsmWritePChar(pai_stabs(hp)^.str);
  543. AsmLn;
  544. end;
  545. ait_stabn : begin
  546. AsmWrite(#9'.stabn ');
  547. AsmWritePChar(pai_stabn(hp)^.str);
  548. AsmLn;
  549. end;
  550. ait_force_line : begin
  551. stabslastfileinfo.line:=0;
  552. end;
  553. ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
  554. {$endif GDB}
  555. ait_cut : begin
  556. { create only a new file when the last is not empty }
  557. if AsmSize>0 then
  558. begin
  559. AsmClose;
  560. DoAssemble;
  561. AsmCreate;
  562. end;
  563. { avoid empty files }
  564. while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
  565. begin
  566. if pai(hp^.next)^.typ=ait_section then
  567. begin
  568. lastsec:=pai_section(hp^.next)^.sec;
  569. lastsecidx:=pai_section(hp^.next)^.idataidx;
  570. end;
  571. hp:=pai(hp^.next);
  572. end;
  573. if lastsec<>sec_none then
  574. AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
  575. end;
  576. ait_marker : ;
  577. else
  578. internalerror(10000);
  579. end;
  580. hp:=pai(hp^.next);
  581. end;
  582. end;
  583. procedure tm68kmitasmlist.WriteAsmList;
  584. var
  585. p:dirstr;
  586. n:namestr;
  587. e:extstr;
  588. begin
  589. {$ifdef EXTDEBUG}
  590. if assigned(current_module^.mainsource) then
  591. comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
  592. {$endif}
  593. lastline:=0;
  594. lastfileindex:=0;
  595. LastSec:=sec_none;
  596. {$ifdef GDB}
  597. includecount:=0;
  598. n_line:=n_bssline;
  599. {$endif GDB}
  600. if assigned(current_module^.mainsource) then
  601. fsplit(current_module^.mainsource^,p,n,e)
  602. else
  603. begin
  604. p:=inputdir;
  605. n:=inputfile;
  606. e:=inputextension;
  607. end;
  608. { to get symify to work }
  609. AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
  610. countlabelref:=false;
  611. { there should be nothing but externals so we don't need to process
  612. WriteTree(externals); }
  613. WriteTree(debuglist);
  614. WriteTree(codesegment);
  615. WriteTree(datasegment);
  616. WriteTree(consts);
  617. WriteTree(rttilist);
  618. WriteTree(bsssegment);
  619. Writetree(importssection);
  620. Writetree(exportssection);
  621. Writetree(resourcesection);
  622. countlabelref:=true;
  623. AsmLn;
  624. {$ifdef EXTDEBUG}
  625. if assigned(current_module^.mainsource) then
  626. comment(v_info,'Done writing gas-styled assembler output for '+current_module^.mainsource^);
  627. {$endif EXTDEBUG}
  628. end;
  629. end.
  630. {
  631. $Log$
  632. Revision 1.18 1998-12-11 00:02:40 peter
  633. + globtype,tokens,version unit splitted from globals
  634. Revision 1.17 1998/11/30 09:42:57 pierre
  635. * some range check bugs fixed (still not working !)
  636. + added DLL writing support for win32 (also accepts variables)
  637. + TempAnsi for code that could be used for Temporary ansi strings
  638. handling
  639. Revision 1.16 1998/11/12 11:19:36 pierre
  640. * fix for first line of function break
  641. Revision 1.15 1998/10/29 11:35:37 florian
  642. * some dll support for win32
  643. * fixed assembler writing for PalmOS
  644. Revision 1.14 1998/10/14 15:56:40 pierre
  645. * all references to comp suppressed for m68k
  646. Revision 1.13 1998/10/12 12:20:44 pierre
  647. + added tai_const_symbol_offset
  648. for r : pointer = @var.field;
  649. * better message for different arg names on implementation
  650. of function
  651. Revision 1.12 1998/10/06 17:16:37 pierre
  652. * some memory leaks fixed (thanks to Peter for heaptrc !)
  653. Revision 1.11 1998/10/01 20:19:09 jonas
  654. + ait_marker support
  655. Revision 1.10 1998/09/28 16:57:11 pierre
  656. * changed all length(p^.value_str^) into str_length(p)
  657. to get it work with and without ansistrings
  658. * changed sourcefiles field of tmodule to a pointer
  659. Revision 1.9 1998/09/16 01:07:43 carl
  660. * bugfix of byte alignment
  661. Revision 1.8 1998/08/10 14:49:37 peter
  662. + localswitches, moduleswitches, globalswitches splitting
  663. Revision 1.7 1998/07/14 14:46:39 peter
  664. * released NEWINPUT
  665. Revision 1.6 1998/07/10 10:50:55 peter
  666. * m68k updates
  667. Revision 1.5 1998/06/05 17:46:05 peter
  668. * tp doesn't like comp() typecast
  669. Revision 1.4 1998/06/04 23:51:29 peter
  670. * m68k compiles
  671. + .def file creation moved to gendef.pas so it could also be used
  672. for win32
  673. }