{ Copyright (c) 1998-2004 by the Free Pascal team This unit implements generic GNU assembler (v2.8 or later) 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. **************************************************************************** } { Base unit for writing GNU assembler output. } unit aggas; {$i fpcdefs.inc} interface uses {$IFDEF USE_SYSUTILS} SysUtils, {$ELSE USE_SYSUTILS} dos, {$ENDIF USE_SYSUTILS} cclasses, globals, aasmbase,aasmtai,aasmcpu, assemble; type {# This is a derived class which is used to write GAS styled assembler. The WriteInstruction() method must be overriden to write a single instruction to the assembler file. } TGNUAssembler=class(texternalassembler) protected function sectionname(atype:tasmsectiontype;const aname:string):string;virtual; procedure WriteSection(atype:tasmsectiontype;const aname:string); procedure WriteExtraHeader;virtual; {$ifdef GDB} procedure WriteFileLineInfo(var fileinfo : tfileposinfo); procedure WriteFileEndInfo; {$endif} procedure WriteInstruction(hp: tai); virtual; abstract; public procedure WriteTree(p:TAAsmoutput);override; procedure WriteAsmList;override; end; const regname_count=45; regname_count_bsstart=32; { Largest power of 2 out of regname_count. } implementation uses cutils,globtype,systems, fmodule,finput,verbose, itcpugas {$ifdef GDB} {$IFDEF USE_SYSUTILS} {$ELSE USE_SYSUTILS} ,strings {$ENDIF USE_SYSUTILS} ,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} CurrSecType : TAsmSectionType; { last section type written } lastfileinfo : tfileposinfo; infile, lastinfile : tinputfile; symendcount : longint; type {$ifdef cpuextended} t80bitarray = array[0..9] of byte; {$endif cpuextended} t64bitarray = array[0..7] of byte; t32bitarray = array[0..3] of byte; {****************************************************************************} { Support routines } {****************************************************************************} function fixline(s:string):string; { return s with all leading and ending spaces and tabs removed } var i,j,k : integer; begin i:=length(s); while (i>0) and (s[i] in [#9,' ']) do dec(i); j:=1; while (jsec_code) or 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 "'+BsToSlash(FixPath(infile.path^,false))+'",'+ tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); end; AsmWriteLn(#9'.stabs "'+FixFileName(infile.name^)+'",'+ tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':'); inc(includecount); { force new line info } stabslastfileinfo.line:=-1; 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_info.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 TGNUAssembler.WriteFileEndInfo; begin if (CurrSecType<>sec_code) or not ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then exit; if (stabslastfileinfo.fileindex<>0) then begin AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount)); AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':'); inc(includecount); end; { force writing all fileinfo } FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); end; {$endif GDB} function TGNUAssembler.sectionname(atype:tasmsectiontype;const aname:string):string; const secnames : array[tasmsectiontype] of string[12] = ('', {$warning TODO .rodata not yet working} '.text','.data','.data','.bss','.threadvar', 'common', '.note', '.stab','.stabstr', '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', '.eh_frame', '.debug_frame', 'fpc.resptrs' ); begin if use_smartlink_section and (aname<>'') then result:=secnames[atype]+'.'+aname else result:=secnames[atype]; end; procedure TGNUAssembler.WriteSection(atype:tasmsectiontype;const aname:string); var s : string; begin {$ifdef GDB} { Maybe write end of section } if currsectype<>sec_none then WriteFileEndInfo; {$endif GDB} AsmLn; case target_info.system of system_powerpc_darwin, system_i386_OS2, system_i386_EMX: ; else AsmWrite('.section '); end; s:=sectionname(atype,aname); AsmWrite(s); if atype=sec_fpc then AsmWrite(', "a", @progbits'); AsmLn; {$ifdef GDB} { this is needed for line info in data } funcname:=nil; case atype of sec_code : n_line:=n_textline; sec_rodata, sec_data : n_line:=n_dataline; sec_bss : n_line:=n_bssline; else n_line:=n_dataline; end; { force writing all fileinfo } FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); {$endif GDB} CurrSecType:=atype; end; procedure TGNUAssembler.WriteTree(p:TAAsmoutput); const regallocstr : array[tregalloctype] of string[10]=(' allocated',' released',' sync',' resized'); tempallocstr : array[boolean] of string[10]=(' released',' allocated'); var ch : char; hp : tai; hp1 : tailineinfo; consttyp : taitype; s : string; i,pos,l : longint; InlineLevel : longint; last_align : longint; co : comp; sin : single; d : double; {$ifdef cpuextended} e : extended; {$endif cpuextended} do_line : boolean; begin if not assigned(p) then exit; last_align := 2; InlineLevel:=0; { lineinfo is only needed for al_procedures (PFV) } do_line:=(cs_asm_source in aktglobalswitches) or ((cs_lineinfo in aktmoduleswitches) and (p=asmlist[al_procedures])); hp:=tai(p.first); while assigned(hp) do begin if not(hp.typ in SkipLineInfo) then begin hp1 := hp as tailineinfo; aktfilepos:=hp1.fileinfo; {$ifdef GDB} { maybe write stabs } WriteFileLineInfo(hp1.fileinfo); {$endif GDB} { no line info for inlined code } if do_line and (inlinelevel=0) then begin { load infile } if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then begin infile:=current_module.sourcefiles.get_file(hp1.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:=hp1.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 (hp1.fileinfo.line<>lastfileinfo.line) and ((hp1.fileinfo.line0)) then begin if (hp1.fileinfo.line<>0) and ((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+ fixline(infile.GetLineStr(hp1.fileinfo.line))); { set it to a negative value ! to make that is has been read already !! PM } if (infile.linebuf^[hp1.fileinfo.line]>=0) then infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1; end; end; lastfileinfo:=hp1.fileinfo; lastinfile:=infile; end; end; case hp.typ of ait_comment : Begin AsmWrite(target_asm.comment); AsmWritePChar(tai_comment(hp).str); AsmLn; End; ait_regalloc : begin if (cs_asm_regalloc in aktglobalswitches) then begin AsmWrite(#9+target_asm.comment+'Register '); repeat AsmWrite(gas_regname(Tai_regalloc(hp).reg)); if (hp.next=nil) or (tai(hp.next).typ<>ait_regalloc) or (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then break; hp:=tai(hp.next); AsmWrite(','); until false; AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]); end; end; ait_tempalloc : begin if (cs_asm_tempalloc in aktglobalswitches) then begin {$ifdef EXTDEBUG} if assigned(tai_tempalloc(hp).problem) then AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ tostr(tai_tempalloc(hp).tempsize)+' '+tai_tempalloc(hp).problem^) else {$endif EXTDEBUG} AsmWriteLn(target_asm.comment+'Temp '+tostr(tai_tempalloc(hp).temppos)+','+ tostr(tai_tempalloc(hp).tempsize)+tempallocstr[tai_tempalloc(hp).allocation]); end; end; ait_align : begin if tai_align(hp).aligntype>1 then begin if target_info.system <> system_powerpc_darwin then begin AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype)); if tai_align(hp).use_op then AsmWrite(','+tostr(tai_align(hp).fillop)) end else begin { darwin as only supports .align } if not ispowerof2(tai_align(hp).aligntype,i) then internalerror(2003010305); AsmWrite(#9'.align '+tostr(i)); last_align := i; end; AsmLn; end; end; ait_section : begin if tai_section(hp).sectype<>sec_none then begin WriteSection(tai_section(hp).sectype,tai_section(hp).name^); {$ifdef GDB} lastfileinfo.line:=-1; {$endif GDB} end else begin {$ifdef EXTDEBUG} AsmWrite(target_asm.comment); AsmWriteln(' sec_none'); {$endif EXTDEBUG} end; end; ait_datablock : begin if target_info.system=system_powerpc_darwin then begin {On Mac OS X you can't have common symbols in a shared library, since those are in the TEXT section and the text section is read-only in shared libraries (so it can be shared among different processes). The alternate code creates some kind of common symbols in the data segment. The generic code no longer uses common symbols, but this doesn't work on Mac OS X as well.} if tai_datablock(hp).is_global then begin asmwrite('.globl '); asmwriteln(tai_datablock(hp).sym.name); asmwriteln('.data'); asmwrite('.zerofill __DATA, __common, '); asmwrite(tai_datablock(hp).sym.name); asmwriteln(', '+tostr(tai_datablock(hp).size)+','+tostr(last_align)); if not(CurrSecType in [sec_data,sec_none]) then writesection(CurrSecType,''); end else begin asmwrite(#9'.lcomm'#9); asmwrite(tai_datablock(hp).sym.name); asmwrite(','+tostr(tai_datablock(hp).size)); asmwrite(','+tostr(last_align)); asmwriteln(''); end end else begin if Tai_datablock(hp).is_global then begin asmwrite(#9'.globl '); asmwriteln(Tai_datablock(hp).sym.name); end; asmwrite(Tai_datablock(hp).sym.name); asmwriteln(':'); asmwriteln(#9'.space '+tostr(Tai_datablock(hp).size)); end; end; {$ifndef cpu64bit} ait_const_128bit : begin internalerror(200404291); end; ait_const_64bit : begin if assigned(tai_const(hp).sym) then internalerror(200404292); AsmWrite(ait_const2str[ait_const_32bit]); if target_info.endian = endian_little then begin AsmWrite(tostr(longint(lo(tai_const(hp).value)))); AsmWrite(','); AsmWrite(tostr(longint(hi(tai_const(hp).value)))); end else begin AsmWrite(tostr(longint(hi(tai_const(hp).value)))); AsmWrite(','); AsmWrite(tostr(longint(lo(tai_const(hp).value)))); end; AsmLn; end; {$endif cpu64bit} ait_const_uleb128bit, ait_const_sleb128bit, {$ifdef cpu64bit} ait_const_128bit, ait_const_64bit, {$endif cpu64bit} ait_const_32bit, ait_const_16bit, ait_const_8bit, ait_const_rva_symbol, ait_const_indirect_symbol : begin AsmWrite(ait_const2str[hp.typ]); consttyp:=hp.typ; l:=0; repeat if assigned(tai_const(hp).sym) then begin if assigned(tai_const(hp).endsym) then s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name else s:=tai_const(hp).sym.name; if tai_const(hp).value<>0 then s:=s+tostr_with_plus(tai_const(hp).value); end else s:=tostr(tai_const(hp).value); AsmWrite(s); inc(l,length(s)); { Values with symbols are written on a single line to improve reading of the .s file (PFV) } if assigned(tai_const(hp).sym) or not(CurrSecType in [sec_data,sec_rodata]) or (l>line_length) or (hp.next=nil) or (tai(hp.next).typ<>consttyp) or assigned(tai_const(hp.next).sym) then break; hp:=tai(hp.next); AsmWrite(','); until false; AsmLn; end; {$ifdef cpuextended} ait_real_80bit : begin if do_line then AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_real_80bit(hp).value)); { Make sure e is a extended type, bestreal could be a different type (bestreal) !! (PFV) } e:=tai_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; {$endif cpuextended} ait_real_64bit : begin if do_line then AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value)); d:=tai_real_64bit(hp).value; { swap the values to correct endian if required } if source_info.endian <> target_info.endian then swap64bitarray(t64bitarray(d)); AsmWrite(#9'.byte'#9); {$ifdef arm} { on a real arm cpu, it's already hi/lo swapped } {$ifndef cpuarm} if tai_real_64bit(hp).formatoptions=fo_hiloswapped then begin for i:=4 to 7 do begin if i<>4 then AsmWrite(','); AsmWrite(tostr(t64bitarray(d)[i])); end; for i:=0 to 3 do begin AsmWrite(','); AsmWrite(tostr(t64bitarray(d)[i])); end; end else {$endif cpuarm} {$endif arm} begin for i:=0 to 7 do begin if i<>0 then AsmWrite(','); AsmWrite(tostr(t64bitarray(d)[i])); end; end; AsmLn; end; ait_real_32bit : begin if do_line then AsmWriteLn(target_asm.comment+'value: '+single2str(tai_real_32bit(hp).value)); sin:=tai_real_32bit(hp).value; { swap the values to correct endian if required } if source_info.endian <> target_info.endian then swap32bitarray(t32bitarray(sin)); 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+'value: '+extended2str(tai_comp_64bit(hp).value)); AsmWrite(#9'.byte'#9); {$ifdef FPC} co:=comp(tai_comp_64bit(hp).value); {$else} co:=tai_comp_64bit(hp).value; {$endif} { swap the values to correct endian if required } if source_info.endian <> target_info.endian then swap64bitarray(t64bitarray(co)); for i:=0 to 7 do begin if i<>0 then AsmWrite(','); AsmWrite(tostr(t64bitarray(co)[i])); end; AsmLn; end; ait_direct : begin AsmWritePChar(tai_direct(hp).str); AsmLn; {$IfDef GDB} if strpos(tai_direct(hp).str,'.data')<>nil then n_line:=n_dataline else if strpos(tai_direct(hp).str,'.text')<>nil then n_line:=n_textline else if strpos(tai_direct(hp).str,'.bss')<>nil then n_line:=n_bssline; {$endif GDB} end; ait_string : begin pos:=0; for i:=1 to tai_string(hp).len do begin if pos=0 then begin AsmWrite(#9'.ascii'#9'"'); pos:=20; end; ch:=tai_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=tai_string(hp).len) then begin AsmWriteLn('"'); pos:=0; end; end; end; ait_label : begin if (tai_label(hp).l.is_used) then begin if tai_label(hp).l.defbind=AB_GLOBAL then begin AsmWrite('.globl'#9); AsmWriteLn(tai_label(hp).l.name); end; AsmWrite(tai_label(hp).l.name); AsmWriteLn(':'); end; end; ait_symbol : begin if tai_symbol(hp).is_global then begin AsmWrite('.globl'#9); AsmWriteLn(tai_symbol(hp).sym.name); end; if target_info.system in [system_i386_linux,system_i386_beos, system_powerpc_linux,system_m68k_linux, system_sparc_linux,system_alpha_linux, system_x86_64_linux,system_arm_linux] then begin AsmWrite(#9'.type'#9); AsmWrite(tai_symbol(hp).sym.name); if assigned(tai(hp.next)) and (tai(hp.next).typ in [ait_const_rva_symbol, ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock, ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then begin if target_info.system = system_arm_linux then AsmWriteLn(',#object') else AsmWriteLn(',@object') end else begin if target_info.system = system_arm_linux then AsmWriteLn(',#function') else AsmWriteLn(',@function'); end; if tai_symbol(hp).sym.size>0 then begin AsmWrite(#9'.size'#9); AsmWrite(tai_symbol(hp).sym.name); AsmWrite(', '); AsmWriteLn(tostr(tai_symbol(hp).sym.size)); end; end; AsmWrite(tai_symbol(hp).sym.name); AsmWriteLn(':'); end; ait_symbol_end : begin if tf_needs_symbol_size in target_info.flags then begin s:=target_asm.labelprefix+'e'+tostr(symendcount); inc(symendcount); AsmWriteLn(s+':'); AsmWrite(#9'.size'#9); AsmWrite(tai_symbol_end(hp).sym.name); AsmWrite(', '+s+' - '); AsmWriteLn(tai_symbol_end(hp).sym.name); end; end; ait_instruction : begin WriteInstruction(hp); end; {$ifdef GDB} ait_stabs : begin if assigned(tai_stabs(hp).str) then begin AsmWrite(#9'.stabs '); AsmWritePChar(tai_stabs(hp).str); AsmLn; end; end; ait_stabn : begin if assigned(tai_stabn(hp).str) then begin AsmWrite(#9'.stabn '); AsmWritePChar(tai_stabn(hp).str); AsmLn; end; end; ait_force_line : stabslastfileinfo.line:=0; ait_stab_function_name: funcname:=tai_stab_function_name(hp).str; {$endif GDB} ait_cutobject : begin if SmartAsm then begin { only reset buffer if nothing has changed } if AsmSize=AsmStartSize then AsmClear else begin AsmClose; DoAssemble; AsmCreate(tai_cutobject(hp).place); end; { avoid empty files } while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do begin if tai(hp.next).typ=ait_section then CurrSecType:=tai_section(hp.next).sectype; hp:=tai(hp.next); end; {$ifdef GDB} { force write of filename } FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); includecount:=0; funcname:=nil; WriteFileLineInfo(aktfilepos); {$endif GDB} if CurrSecType<>sec_none then WriteSection(CurrSecType,''); AsmStartSize:=AsmSize; end; end; ait_marker : if tai_marker(hp).kind=InlineStart then inc(InlineLevel) else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); ait_non_lazy_symbol_pointer: AsmWriteLn('.non_lazy_symbol_pointer'); else internalerror(10000); end; hp:=tai(hp.next); end; end; procedure TGNUAssembler.WriteExtraHeader; begin end; procedure TGNUAssembler.WriteAsmList; var p:dirstr; n:namestr; e:extstr; hal : tasmlist; begin {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^); {$endif} CurrSecType:=sec_none; {$ifdef GDB} FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); {$endif GDB} FillChar(lastfileinfo,sizeof(lastfileinfo),0); LastInfile:=nil; if assigned(current_module.mainsource) then {$IFDEF USE_SYSUTILS} begin p := SplitPath(current_module.mainsource^); n := SplitName(current_module.mainsource^); e := SplitExtension(current_module.mainsource^); end {$ELSE USE_SYSUTILS} fsplit(current_module.mainsource^,p,n,e) {$ENDIF USE_SYSUTILS} else begin p:=inputdir; n:=inputfile; e:=inputextension; end; { to get symify to work } AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"'); WriteExtraHeader; {$ifdef GDB} n_line:=n_bssline; funcname:=nil; linecount:=1; includecount:=0; {$endif GDB} AsmStartSize:=AsmSize; symendcount:=0; for hal:=low(Tasmlist) to high(Tasmlist) do begin AsmWriteLn(target_asm.comment+'Begin asmlist '+TasmlistStr[hal]); writetree(asmlist[hal]); AsmWriteLn(target_asm.comment+'End asmlist '+TasmlistStr[hal]); end; {$ifdef GDB} if CurrSecType<>sec_none then WriteFileEndInfo; {$ENDIF} AsmLn; {$ifdef EXTDEBUG} if assigned(current_module.mainsource) then Comment(V_Debug,'Done writing gas-styled assembler output for '+current_module.mainsource^); {$endif EXTDEBUG} end; end.