{ $Id$ Copyright (c) 1998-2000 by Florian Klaempfl This unit implements an asmoutput class for i386 AT&T syntax This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. **************************************************************************** } {$ifdef TP} {$N+,E+} {$endif} unit ag386att; interface uses cobjects,aasm,assemble; type pi386attasmlist=^ti386attasmlist; ti386attasmlist=object(tasmlist) procedure WriteTree(p:paasmoutput);virtual; procedure WriteAsmList;virtual; {$ifdef GDB} procedure WriteFileLineInfo(var fileinfo : tfileposinfo); procedure WriteFileEndInfo; {$endif} end; implementation uses {$ifdef Delphi} dmisc, {$else Delphi} dos, {$endif Delphi} strings, globtype,globals,systems, files,verbose,cpubase,cpuasm {$ifdef GDB} ,gdb {$endif GDB} ; const line_length = 70; var {$ifdef GDB} n_line : byte; { different types of source lines } linecount, includecount : longint; funcname : pchar; stabslastfileinfo : tfileposinfo; {$endif} lastsec : tsection; { last section type written } lastfileinfo : tfileposinfo; infile, lastinfile : pinputfile; symendcount : longint; function fixline(s:string):string; { return s with all leading and ending spaces and tabs removed } var i,j,k : longint; begin i:=length(s); while (i>0) and (s[i] in [#9,' ']) do dec(i); j:=1; while (jR_NO then s:=att_reg2str[segment]+':' else s:=''; if assigned(symbol) then s:=s+symbol^.name; if offset<0 then s:=s+tostr(offset) else if (offset>0) then begin if assigned(symbol) then s:=s+'+'+tostr(offset) else s:=s+tostr(offset); end; if (index<>R_NO) and (base=R_NO) then Begin s:=s+'(,'+att_reg2str[index]; if scalefactor<>0 then s:=s+','+tostr(scalefactor)+')' else s:=s+')'; end else if (index=R_NO) and (base<>R_NO) then s:=s+'('+att_reg2str[base]+')' else if (index<>R_NO) and (base<>R_NO) then Begin s:=s+'('+att_reg2str[base]+','+att_reg2str[index]; if scalefactor<>0 then s:=s+','+tostr(scalefactor)+')' else s := s+')'; end; end; end; getreferencestring:=s; end; function getopstr(const o:toper) : string; var hs : string; begin case o.typ of top_reg : getopstr:=att_reg2str[o.reg]; top_ref : getopstr:=getreferencestring(o.ref^); top_const : getopstr:='$'+tostr(o.val); top_symbol : begin if assigned(o.sym) then hs:='$'+o.sym^.name else hs:='$'; if o.symofs>0 then hs:=hs+'+'+tostr(o.symofs) else if o.symofs<0 then hs:=hs+tostr(o.symofs) else if not(assigned(o.sym)) then hs:=hs+'0'; getopstr:=hs; end; else internalerror(10001); end; end; function getopstr_jmp(const o:toper) : string; var hs : string; begin case o.typ of top_reg : getopstr_jmp:='*'+att_reg2str[o.reg]; top_ref : getopstr_jmp:='*'+getreferencestring(o.ref^); top_const : getopstr_jmp:=tostr(o.val); top_symbol : begin hs:=o.sym^.name; if o.symofs>0 then hs:=hs+'+'+tostr(o.symofs) else if o.symofs<0 then hs:=hs+tostr(o.symofs); getopstr_jmp:=hs; end; else internalerror(10001); end; end; {**************************************************************************** TI386ATTASMOUTPUT ****************************************************************************} const ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]= (#9'.long'#9,#9'.short'#9,#9'.byte'#9); function ait_section2str(s:tsection):string; begin ait_section2str:=target_asm.secnames[s]; {$ifdef GDB} { this is needed for line info in data } funcname:=nil; case s of sec_code : n_line:=n_textline; sec_data : n_line:=n_dataline; sec_bss : n_line:=n_bssline; else n_line:=n_dataline; end; {$endif GDB} LastSec:=s; end; {$ifdef GDB} procedure ti386attasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo); var curr_n : byte; begin if not ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then exit; { file changed ? (must be before line info) } if (fileinfo.fileindex<>0) and (stabslastfileinfo.fileindex<>fileinfo.fileindex) then begin infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex); if assigned(infile) then begin if includecount=0 then curr_n:=n_sourcefile else curr_n:=n_includefile; if (infile^.path^<>'') then begin AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+ tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount)); end; AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+ tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount)); AsmWriteLn('Ltext'+ToStr(IncludeCount)+':'); inc(includecount); end; end; { line changed ? } if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then begin if (n_line=n_textline) and assigned(funcname) and (target_os.use_function_relative_addresses) then begin AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':'); AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+ target_asm.labelprefix+'l'+tostr(linecount)+' - '); AsmWritePChar(FuncName); AsmLn; inc(linecount); end else AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line)); end; stabslastfileinfo:=fileinfo; end; procedure ti386attasmlist.WriteFileEndInfo; begin if not ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then exit; AsmLn; AsmWriteLn(ait_section2str(sec_code)); AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,Letext'); AsmWriteLn('Letext:'); end; {$endif GDB} procedure ti386attasmlist.WriteTree(p:paasmoutput); const allocstr : array[boolean] of string[10]=(' released',' allocated'); nolinetai =[ait_label, ait_regalloc,ait_tempalloc, ait_stabn,ait_stabs,ait_section, ait_cut,ait_marker,ait_align,ait_stab_function_name]; type t80bitarray = array[0..9] of byte; t64bitarray = array[0..7] of byte; t32bitarray = array[0..3] of byte; var ch : char; hp : pai; consttyp : tait; s : string; found : boolean; i,pos,l : longint; InlineLevel : longint; co : comp; sin : single; d : double; e : extended; op : tasmop; calljmp, do_line : boolean; sep : char; begin if not assigned(p) then exit; InlineLevel:=0; { lineinfo is only needed for codesegment (PFV) } do_line:=(cs_asm_source in aktglobalswitches) or ((cs_lineinfo in aktmoduleswitches) and (p=codesegment)); hp:=pai(p^.first); while assigned(hp) do begin aktfilepos:=hp^.fileinfo; if not(hp^.typ in nolinetai) then begin {$ifdef GDB} { write stabs } if (cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches) then WriteFileLineInfo(hp^.fileinfo); {$endif GDB} if do_line then begin { load infile } if lastfileinfo.fileindex<>hp^.fileinfo.fileindex then begin infile:=current_module^.sourcefiles^.get_file(hp^.fileinfo.fileindex); if assigned(infile) then begin { open only if needed !! } if (cs_asm_source in aktglobalswitches) then infile^.open; end; { avoid unnecessary reopens of the same file !! } lastfileinfo.fileindex:=hp^.fileinfo.fileindex; { be sure to change line !! } lastfileinfo.line:=-1; end; { write source } if (cs_asm_source in aktglobalswitches) and assigned(infile) then begin if (infile<>lastinfile) then begin AsmWriteLn(target_asm.comment+'['+infile^.name^+']'); if assigned(lastinfile) then lastinfile^.close; end; if (hp^.fileinfo.line<>lastfileinfo.line) and ((hp^.fileinfo.line0)) then begin if (hp^.fileinfo.line<>0) and ((infile^.linebuf^[hp^.fileinfo.line]>=0) or (InlineLevel>0)) then AsmWriteLn(target_asm.comment+'['+tostr(hp^.fileinfo.line)+'] '+ fixline(infile^.GetLineStr(hp^.fileinfo.line))); { set it to a negative value ! to make that is has been read already !! PM } if (infile^.linebuf^[hp^.fileinfo.line]>=0) then infile^.linebuf^[hp^.fileinfo.line]:=-infile^.linebuf^[hp^.fileinfo.line]-1; end; end; {$ifdef LINEINFO} { lineinfo } if (cs_lineinfo in aktmoduleswitches) then begin if (infile<>lastinfile) then begin lineinfolist^.concat(new(pai_const(init_8bit end else begin end; end; {$endif LINEINFO} lastfileinfo:=hp^.fileinfo; lastinfile:=infile; end; end; case hp^.typ of ait_comment : Begin AsmWrite(target_asm.comment); AsmWritePChar(pai_asm_comment(hp)^.str); AsmLn; End; ait_regalloc : begin if (cs_asm_regalloc in aktglobalswitches) then AsmWriteLn(target_asm.comment+'Register '+att_reg2str[pairegalloc(hp)^.reg]+ allocstr[pairegalloc(hp)^.allocation]); end; ait_tempalloc : begin if (cs_asm_tempalloc in aktglobalswitches) then AsmWriteLn(target_asm.comment+'Temp '+tostr(paitempalloc(hp)^.temppos)+','+ tostr(paitempalloc(hp)^.tempsize)+allocstr[paitempalloc(hp)^.allocation]); end; ait_align : begin AsmWrite(#9'.balign '+tostr(pai_align(hp)^.aligntype)); if pai_align(hp)^.use_op then AsmWrite(','+tostr(pai_align(hp)^.fillop)); AsmLn; end; ait_section : begin if pai_section(hp)^.sec<>sec_none then begin AsmLn; AsmWriteLn(ait_section2str(pai_section(hp)^.sec)); {$ifdef GDB} lastfileinfo.line:=-1; {$endif GDB} end; end; ait_datablock : begin if pai_datablock(hp)^.is_global then AsmWrite(#9'.comm'#9) else AsmWrite(#9'.lcomm'#9); AsmWrite(pai_datablock(hp)^.sym^.name); AsmWriteLn(','+tostr(pai_datablock(hp)^.size)); end; ait_const_32bit, ait_const_16bit, ait_const_8bit : begin AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value)); consttyp:=hp^.typ; l:=0; repeat found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp); if found then begin hp:=Pai(hp^.next); s:=','+tostr(pai_const(hp)^.value); AsmWrite(s); inc(l,length(s)); end; until (not found) or (l>line_length); AsmLn; end; ait_const_symbol : begin AsmWrite(#9'.long'#9+pai_const_symbol(hp)^.sym^.name); if pai_const_symbol(hp)^.offset>0 then AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset)) else if pai_const_symbol(hp)^.offset<0 then AsmWrite(tostr(pai_const_symbol(hp)^.offset)); AsmLn; end; ait_const_rva : AsmWriteLn(#9'.rva'#9+pai_const_symbol(hp)^.sym^.name); ait_real_80bit : begin if do_line then AsmWriteLn(target_asm.comment+extended2str(pai_real_80bit(hp)^.value)); { Make sure e is a extended type, bestreal could be a different type (bestreal) !! (PFV) } e:=pai_real_80bit(hp)^.value; AsmWrite(#9'.byte'#9); for i:=0 to 9 do begin if i<>0 then AsmWrite(','); AsmWrite(tostr(t80bitarray(e)[i])); end; AsmLn; end; ait_real_64bit : begin if do_line then AsmWriteLn(target_asm.comment+double2str(pai_real_64bit(hp)^.value)); d:=pai_real_64bit(hp)^.value; AsmWrite(#9'.byte'#9); for i:=0 to 7 do begin if i<>0 then AsmWrite(','); AsmWrite(tostr(t64bitarray(d)[i])); end; AsmLn; end; ait_real_32bit : begin if do_line then AsmWriteLn(target_asm.comment+single2str(pai_real_32bit(hp)^.value)); sin:=pai_real_32bit(hp)^.value; AsmWrite(#9'.byte'#9); for i:=0 to 3 do begin if i<>0 then AsmWrite(','); AsmWrite(tostr(t32bitarray(sin)[i])); end; AsmLn; end; ait_comp_64bit : begin if do_line then AsmWriteLn(target_asm.comment+comp2str(pai_comp_64bit(hp)^.value)); AsmWrite(#9'.byte'#9); {$ifdef FPC} co:=comp(pai_comp_64bit(hp)^.value); {$else} co:=pai_comp_64bit(hp)^.value; {$endif} for i:=0 to 7 do begin if i<>0 then AsmWrite(','); AsmWrite(tostr(t64bitarray(co)[i])); end; AsmLn; end; ait_direct : begin AsmWritePChar(pai_direct(hp)^.str); AsmLn; {$IfDef GDB} if strpos(pai_direct(hp)^.str,'.data')<>nil then n_line:=n_dataline else if strpos(pai_direct(hp)^.str,'.text')<>nil then n_line:=n_textline else if strpos(pai_direct(hp)^.str,'.bss')<>nil then n_line:=n_bssline; {$endif GDB} end; ait_string : begin pos:=0; for i:=1 to pai_string(hp)^.len do begin if pos=0 then begin AsmWrite(#9'.ascii'#9'"'); pos:=20; end; ch:=pai_string(hp)^.str[i-1]; case ch of #0, {This can't be done by range, because a bug in FPC} #1..#31, #128..#255 : s:='\'+tostr(ord(ch) shr 6)+tostr((ord(ch) and 63) shr 3)+tostr(ord(ch) and 7); '"' : s:='\"'; '\' : s:='\\'; else s:=ch; end; AsmWrite(s); inc(pos,length(s)); if (pos>line_length) or (i=pai_string(hp)^.len) then begin AsmWriteLn('"'); pos:=0; end; end; end; ait_label : begin if (pai_label(hp)^.l^.is_used) then begin if pai_label(hp)^.l^.defbind=AB_GLOBAL then begin AsmWrite('.globl'#9); AsmWriteLn(pai_label(hp)^.l^.name); end; AsmWrite(pai_label(hp)^.l^.name); AsmWriteLn(':'); end; end; ait_symbol : begin if pai_symbol(hp)^.is_global then begin AsmWrite('.globl'#9); AsmWriteLn(pai_symbol(hp)^.sym^.name); end; if target_info.target=target_i386_linux then begin AsmWrite(#9'.type'#9); AsmWrite(pai_symbol(hp)^.sym^.name); if assigned(pai(hp^.next)) and (pai(hp^.next)^.typ in [ait_const_symbol,ait_const_rva, ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock, ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then AsmWriteLn(',@object') else AsmWriteLn(',@function'); if pai_symbol(hp)^.sym^.size>0 then begin AsmWrite(#9'.size'#9); AsmWrite(pai_symbol(hp)^.sym^.name); AsmWrite(', '); AsmWriteLn(tostr(pai_symbol(hp)^.sym^.size)); end; end; AsmWrite(pai_symbol(hp)^.sym^.name); AsmWriteLn(':'); end; ait_symbol_end : begin if target_info.target=target_i386_linux then begin s:=target_asm.labelprefix+'e'+tostr(symendcount); inc(symendcount); AsmWriteLn(s+':'); AsmWrite(#9'.size'#9); AsmWrite(pai_symbol(hp)^.sym^.name); AsmWrite(', '+s+' - '); AsmWriteLn(pai_symbol(hp)^.sym^.name); end; end; ait_instruction : begin op:=paicpu(hp)^.opcode; calljmp:=is_calljmp(op); { call maybe not translated to call } s:=#9+att_op2str[op]+cond2str[paicpu(hp)^.condition]; { suffix needed ? fnstsw,fldcw don't support suffixes with binutils 2.9.5 under linux } if (not calljmp) and (att_needsuffix[op]<>AttSufNONE) and (op<>A_FNSTSW) and (op<>A_FSTSW) and (op<>A_FNSTCW) and (op<>A_FSTCW) and (op<>A_FLDCW) and not( (paicpu(hp)^.oper[0].typ=top_reg) and (paicpu(hp)^.oper[0].reg in [R_ST..R_ST7]) ) then s:=s+att_opsize2str[paicpu(hp)^.opsize]; { process operands } if paicpu(hp)^.ops<>0 then begin { call and jmp need an extra handling } { this code is only called if jmp isn't a labeled instruction } { quick hack to overcome a problem with manglednames=255 chars } if calljmp then begin AsmWrite(s+#9); s:=getopstr_jmp(paicpu(hp)^.oper[0]); end else begin for i:=0 to paicpu(hp)^.ops-1 do begin if i=0 then sep:=#9 else sep:=','; s:=s+sep+getopstr(paicpu(hp)^.oper[i]) end; end; end; AsmWriteLn(s); end; {$ifdef GDB} ait_stabs : begin AsmWrite(#9'.stabs '); AsmWritePChar(pai_stabs(hp)^.str); AsmLn; end; ait_stabn : begin AsmWrite(#9'.stabn '); AsmWritePChar(pai_stabn(hp)^.str); AsmLn; end; ait_force_line : stabslastfileinfo.line:=0; ait_stab_function_name: funcname:=pai_stab_function_name(hp)^.str; {$endif GDB} ait_cut : begin if SmartAsm then begin { only reset buffer if nothing has changed } if AsmSize=AsmStartSize then AsmClear else begin AsmClose; DoAssemble; AsmCreate(pai_cut(hp)^.place); end; { avoid empty files } while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do begin if pai(hp^.next)^.typ=ait_section then lastsec:=pai_section(hp^.next)^.sec; hp:=pai(hp^.next); end; {$ifdef GDB} { force write of filename } FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); includecount:=0; funcname:=nil; WriteFileLineInfo(hp^.fileinfo); {$endif GDB} if lastsec<>sec_none then AsmWriteLn(ait_section2str(lastsec)); AsmStartSize:=AsmSize; end; end; ait_marker : if pai_marker(hp)^.kind=InlineStart then inc(InlineLevel) else if pai_marker(hp)^.kind=InlineEnd then dec(InlineLevel); else internalerror(10000); end; hp:=pai(hp^.next); end; end; procedure ti386attasmlist.WriteAsmList; var p:dirstr; n:namestr; e:extstr; {$ifdef GDB} fileinfo : tfileposinfo; {$endif GDB} begin {$ifdef EXTDEBUG} if assigned(current_module^.mainsource) then Comment(v_info,'Start writing att-styled assembler output for '+current_module^.mainsource^); {$endif} LastSec:=sec_none; {$ifdef GDB} FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); {$endif GDB} FillChar(lastfileinfo,sizeof(lastfileinfo),0); LastInfile:=nil; if assigned(current_module^.mainsource) then fsplit(current_module^.mainsource^,p,n,e) else begin p:=inputdir; n:=inputfile; e:=inputextension; end; { to get symify to work } AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"'); {$ifdef GDB} n_line:=n_bssline; funcname:=nil; linecount:=1; includecount:=0; fileinfo.fileindex:=1; fileinfo.line:=1; { Write main file } WriteFileLineInfo(fileinfo); {$endif GDB} AsmStartSize:=AsmSize; symendcount:=0; countlabelref:=false; If (cs_debuginfo in aktmoduleswitches) then WriteTree(debuglist); WriteTree(codesegment); WriteTree(datasegment); WriteTree(consts); WriteTree(rttilist); Writetree(resourcestringlist); WriteTree(bsssegment); Writetree(importssection); { exports are written by DLLTOOL if we use it so don't insert it twice (PM) } if not UseDeffileForExport and assigned(exportssection) then Writetree(exportssection); Writetree(resourcesection); {$ifdef GDB} WriteFileEndInfo; {$ENDIF} countlabelref:=true; AsmLn; {$ifdef EXTDEBUG} if assigned(current_module^.mainsource) then comment(v_info,'Done writing att-styled assembler output for '+current_module^.mainsource^); {$endif EXTDEBUG} end; end. { $Log$ Revision 1.4 2000-08-20 17:38:21 peter * smartlinking fixed for linux (merged) Revision 1.3 2000/07/13 12:08:24 michael + patched to 1.1.0 with former 1.09patch from peter Revision 1.2 2000/07/13 11:32:28 michael + removed logs }