{ $Id$ Copyright (c) 1998-2002 by Peter Vreman This unit handles the assemblerfile write and assembler calls of FPC 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. **************************************************************************** } {# @abstract(This unit handles the assembler file write and assembler calls of FPC) Handles the calls to the actual external assemblers, as well as the generation of object files for smart linking. Also contains the base class for writing the assembler statements to file. } unit assemble; {$i fpcdefs.inc} interface uses {$ifdef Delphi} sysutils, dmisc, {$else Delphi} strings, dos, {$endif Delphi} systems,globtype,globals,aasmbase,aasmtai,ogbase; const { maximum of aasmoutput lists there will be } maxoutputlists = 10; { buffer size for writing the .s file } AsmOutSize=32768; type TAssembler=class(TAbstractAssembler) public {filenames} path : pathstr; name : namestr; asmfile, { current .s and .o file } objfile : string; ppufilename : string; asmprefix : string; SmartAsm : boolean; SmartFilesCount, SmartHeaderCount : longint; Constructor Create(smart:boolean);virtual; Destructor Destroy;override; procedure NextSmartName(place:tcutplace); procedure MakeObject;virtual;abstract; end; {# This is the base class which should be overriden for each each assembler writer. It is used to actually assembler a file, and write the output to the assembler file. } TExternalAssembler=class(TAssembler) private procedure CreateSmartLinkPath(const s:string); protected {outfile} AsmSize, AsmStartSize, outcnt : longint; outbuf : array[0..AsmOutSize-1] of char; outfile : file; public {# Returns the complete path and executable name of the assembler program. It first tries looking in the UTIL directory if specified, otherwise it searches in the free pascal binary directory, in the current working directory and then in the directories in the $PATH environment.} Function FindAssembler:string; {# Actually does the call to the assembler file. Returns false if the assembling of the file failed.} Function CallAssembler(const command,para:string):Boolean; Function DoAssemble:boolean;virtual; Procedure RemoveAsm; Procedure AsmFlush; Procedure AsmClear; {# Write a string to the assembler file } Procedure AsmWrite(const s:string); {# Write a string to the assembler file } Procedure AsmWritePChar(p:pchar); {# Write a string to the assembler file followed by a new line } Procedure AsmWriteLn(const s:string); {# Write a new line to the assembler file } Procedure AsmLn; procedure AsmCreate(Aplace:tcutplace); procedure AsmClose; {# This routine should be overriden for each assembler, it is used to actually write the abstract assembler stream to file.} procedure WriteTree(p:TAAsmoutput);virtual; {# This routine should be overriden for each assembler, it is used to actually write all the different abstract assembler streams by calling for each stream type, the @var(WriteTree) method.} procedure WriteAsmList;virtual; public Constructor Create(smart:boolean);override; procedure MakeObject;override; end; TInternalAssembler=class(TAssembler) public constructor create(smart:boolean);override; destructor destroy;override; procedure MakeObject;override; protected { object alloc and output } objectalloc : TAsmObjectAlloc; objectdata : TAsmObjectData; objectoutput : tobjectoutput; private { the aasmoutput lists that need to be processed } lists : byte; list : array[1..maxoutputlists] of TAAsmoutput; { current processing } currlistidx : byte; currlist : TAAsmoutput; currpass : byte; {$ifdef GDB} n_line : byte; { different types of source lines } linecount, includecount : longint; funcname : tasmsymbol; stabslastfileinfo : tfileposinfo; procedure convertstabs(p:pchar); procedure emitlineinfostabs(nidx,line : longint); procedure emitstabs(s:string); procedure WriteFileLineInfo(var fileinfo : tfileposinfo); procedure StartFileLineInfo; procedure EndFileLineInfo; {$endif} function MaybeNextList(var hp:Tai):boolean; function TreePass0(hp:Tai):Tai; function TreePass1(hp:Tai):Tai; function TreePass2(hp:Tai):Tai; procedure writetree; procedure writetreesmart; end; TAssemblerClass = class of TAssembler; Procedure GenerateAsm(smart:boolean); Procedure OnlyAsm; procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass); procedure InitAssembler; procedure DoneAssembler; Implementation uses {$ifdef hasunix} {$ifdef havelinuxrtl10} linux, {$else} unix, {$endif} {$endif} cutils,script,fmodule,verbose, {$ifdef memdebug} cclasses, {$endif memdebug} {$ifdef GDB} finput, gdb, {$endif GDB} {$ifdef m68k} cpuinfo, {$endif m68k} cpubase,aasmcpu ; var CAssembler : array[tasm] of TAssemblerClass; {***************************************************************************** TAssembler *****************************************************************************} Constructor TAssembler.Create(smart:boolean); begin { load start values } asmfile:=current_module.get_asmfilename; objfile:=current_module.objfilename^; name:=Lower(current_module.modulename^); path:=current_module.outputpath^; asmprefix := current_module.asmprefix^; if not assigned(current_module.outputpath) then ppufilename := '' else ppufilename := current_module.ppufilename^; SmartAsm:=smart; SmartFilesCount:=0; SmartHeaderCount:=0; SmartLinkOFiles.Clear; end; Destructor TAssembler.Destroy; begin end; procedure TAssembler.NextSmartName(place:tcutplace); var s : string; begin inc(SmartFilesCount); if SmartFilesCount>999999 then Message(asmw_f_too_many_asm_files); case place of cut_begin : begin inc(SmartHeaderCount); s:=asmprefix+tostr(SmartHeaderCount)+'h'; end; cut_normal : s:=asmprefix+tostr(SmartHeaderCount)+'s'; cut_end : s:=asmprefix+tostr(SmartHeaderCount)+'t'; end; AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext); ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext); { insert in container so it can be cleared after the linking } SmartLinkOFiles.Insert(Objfile); end; {***************************************************************************** TExternalAssembler *****************************************************************************} Function DoPipe:boolean; begin DoPipe:=(cs_asm_pipe in aktglobalswitches) and not(cs_asm_leave in aktglobalswitches) and ((aktoutputformat in [as_gas,as_darwin])); end; Constructor TExternalAssembler.Create(smart:boolean); begin inherited Create(smart); if SmartAsm then begin path:=FixPath(path+FixFileName(name)+target_info.smartext,false); CreateSmartLinkPath(path); end; Outcnt:=0; end; procedure TExternalAssembler.CreateSmartLinkPath(const s:string); var dir : searchrec; hs : string; begin if PathExists(s) then begin { the path exists, now we clean only all the .o and .s files } { .o files } findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir); while (doserror=0) do begin RemoveFile(s+source_info.dirsep+dir.name); findnext(dir); end; findclose(dir); { .s files } findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir); while (doserror=0) do begin RemoveFile(s+source_info.dirsep+dir.name); findnext(dir); end; findclose(dir); end else begin hs:=s; if hs[length(hs)] in ['/','\'] then delete(hs,length(hs),1); {$I-} mkdir(hs); {$I+} if ioresult<>0 then; end; end; const lastas : byte=255; var LastASBin : pathstr; Function TExternalAssembler.FindAssembler:string; var asfound : boolean; UtilExe : string; begin asfound:=false; if cs_link_on_target in aktglobalswitches then begin { If linking on target, don't add any path PM } FindAssembler:=utilsprefix+AddExtension(target_asm.asmbin,target_info.exeext); exit; end else UtilExe:=utilsprefix+AddExtension(target_asm.asmbin,source_info.exeext); if lastas<>ord(target_asm.id) then begin lastas:=ord(target_asm.id); { is an assembler passed ? } if utilsdirectory<>'' then asfound:=FindFile(UtilExe,utilsdirectory,LastASBin); if not AsFound then asfound:=FindExe(UtilExe,LastASBin); if (not asfound) and not(cs_asm_extern in aktglobalswitches) then begin Message1(exec_e_assembler_not_found,LastASBin); aktglobalswitches:=aktglobalswitches+[cs_asm_extern]; end; if asfound then Message1(exec_t_using_assembler,LastASBin); end; FindAssembler:=LastASBin; end; Function TExternalAssembler.CallAssembler(const command,para:string):Boolean; begin callassembler:=true; if not(cs_asm_extern in aktglobalswitches) then begin swapvectors; exec(command,para); swapvectors; if (doserror<>0) then begin Message1(exec_e_cant_call_assembler,tostr(doserror)); aktglobalswitches:=aktglobalswitches+[cs_asm_extern]; callassembler:=false; end else if (dosexitcode<>0) then begin Message1(exec_e_error_while_assembling,tostr(dosexitcode)); callassembler:=false; end; end else AsmRes.AddAsmCommand(command,para,name); end; procedure TExternalAssembler.RemoveAsm; var g : file; begin if cs_asm_leave in aktglobalswitches then exit; if cs_asm_extern in aktglobalswitches then AsmRes.AddDeleteCommand(AsmFile) else begin assign(g,AsmFile); {$I-} erase(g); {$I+} if ioresult<>0 then; end; end; Function TExternalAssembler.DoAssemble:boolean; var s : string; begin DoAssemble:=true; if DoPipe then exit; if not(cs_asm_extern in aktglobalswitches) then begin if SmartAsm then begin if (SmartFilesCount<=1) then Message1(exec_i_assembling_smart,name); end else Message1(exec_i_assembling,name); end; s:=target_asm.asmcmd; {$ifdef m68k} if aktoptprocessor = MC68020 then s:='-m68020 '+s else s:='-m68000 '+s; {$endif} if (cs_link_on_target in aktglobalswitches) then begin Replace(s,'$ASM',ScriptFixFileName(AsmFile)); Replace(s,'$OBJ',ScriptFixFileName(ObjFile)); end else begin Replace(s,'$ASM',AsmFile); Replace(s,'$OBJ',ObjFile); end; if CallAssembler(FindAssembler,s) then RemoveAsm else begin DoAssemble:=false; GenerateError; end; end; Procedure TExternalAssembler.AsmFlush; begin if outcnt>0 then begin BlockWrite(outfile,outbuf,outcnt); outcnt:=0; end; end; Procedure TExternalAssembler.AsmClear; begin outcnt:=0; end; Procedure TExternalAssembler.AsmWrite(const s:string); begin if OutCnt+length(s)>=AsmOutSize then AsmFlush; Move(s[1],OutBuf[OutCnt],length(s)); inc(OutCnt,length(s)); inc(AsmSize,length(s)); end; Procedure TExternalAssembler.AsmWriteLn(const s:string); begin AsmWrite(s); AsmLn; end; Procedure TExternalAssembler.AsmWritePChar(p:pchar); var i,j : longint; begin i:=StrLen(p); j:=i; while j>0 do begin i:=min(j,AsmOutSize); if OutCnt+i>=AsmOutSize then AsmFlush; Move(p[0],OutBuf[OutCnt],i); inc(OutCnt,i); inc(AsmSize,i); dec(j,i); p:=pchar(@p[i]); end; end; Procedure TExternalAssembler.AsmLn; begin if OutCnt>=AsmOutSize-2 then AsmFlush; if (cs_link_on_target in aktglobalswitches) then begin OutBuf[OutCnt]:=target_info.newline[1]; inc(OutCnt); inc(AsmSize); if length(target_info.newline)>1 then begin OutBuf[OutCnt]:=target_info.newline[2]; inc(OutCnt); inc(AsmSize); end; end else begin OutBuf[OutCnt]:=source_info.newline[1]; inc(OutCnt); inc(AsmSize); if length(source_info.newline)>1 then begin OutBuf[OutCnt]:=source_info.newline[2]; inc(OutCnt); inc(AsmSize); end; end; end; procedure TExternalAssembler.AsmCreate(Aplace:tcutplace); begin if SmartAsm then NextSmartName(Aplace); {$ifdef hasunix} if DoPipe then begin Message1(exec_i_assembling_pipe,asmfile); POpen(outfile,'as -o '+objfile,'W'); end else {$endif} begin Assign(outfile,asmfile); {$I-} Rewrite(outfile,1); {$I+} if ioresult<>0 then Message1(exec_d_cant_create_asmfile,asmfile); end; outcnt:=0; AsmSize:=0; AsmStartSize:=0; end; procedure TExternalAssembler.AsmClose; var f : file; l : longint; begin AsmFlush; {$ifdef hasunix} if DoPipe then PClose(outfile) else {$endif} begin {Touch Assembler time to ppu time is there is a ppufilename} if ppufilename<>'' then begin Assign(f,ppufilename); {$I-} reset(f,1); {$I+} if ioresult=0 then begin getftime(f,l); close(f); reset(outfile,1); setftime(outfile,l); end; end; close(outfile); end; end; procedure TExternalAssembler.WriteTree(p:TAAsmoutput); begin end; procedure TExternalAssembler.WriteAsmList; begin end; procedure TExternalAssembler.MakeObject; begin AsmCreate(cut_normal); WriteAsmList; AsmClose; DoAssemble; end; {***************************************************************************** TInternalAssembler *****************************************************************************} constructor TInternalAssembler.create(smart:boolean); begin inherited create(smart); objectoutput:=nil; objectdata:=nil; objectalloc:=TAsmObjectAlloc.create; SmartAsm:=smart; currpass:=0; end; destructor TInternalAssembler.destroy; {$ifdef MEMDEBUG} var d : tmemdebug; {$endif} begin {$ifdef MEMDEBUG} d := tmemdebug.create(name+' - agbin'); {$endif} objectdata.free; objectoutput.free; objectalloc.free; {$ifdef MEMDEBUG} d.free; {$endif} end; {$ifdef GDB} procedure TInternalAssembler.convertstabs(p:pchar); var ofs, nidx,nother,ii,i,line,j : longint; code : integer; hp : pchar; reloc : boolean; sec : TSection; ps : tasmsymbol; s : string; begin ofs:=0; reloc:=true; ps:=nil; sec:=sec_none; if p[0]='"' then begin i:=1; { we can have \" inside the string !! PM } while not ((p[i]='"') and (p[i-1]<>'\')) do inc(i); p[i]:=#0; ii:=i; hp:=@p[1]; s:=StrPas(@P[i+2]); end else begin hp:=nil; s:=StrPas(P); i:=-2; {needed below (PM) } end; { When in pass 1 then only alloc and leave } if currpass=1 then begin objectalloc.staballoc(hp); if assigned(hp) then p[i]:='"'; exit; end; { Parse the rest of the stabs } if s='' then internalerror(33000); j:=pos(',',s); if j=0 then internalerror(33001); Val(Copy(s,1,j-1),nidx,code); if code<>0 then internalerror(33002); i:=i+2+j; Delete(s,1,j); j:=pos(',',s); if (j=0) then internalerror(33003); Val(Copy(s,1,j-1),nother,code); if code<>0 then internalerror(33004); i:=i+j; Delete(s,1,j); j:=pos(',',s); if j=0 then begin j:=256; ofs:=-1; end; Val(Copy(s,1,j-1),line,code); if code<>0 then internalerror(33005); if ofs=0 then begin Delete(s,1,j); i:=i+j; Val(s,ofs,code); if code=0 then reloc:=false else begin ofs:=0; s:=strpas(@p[i]); { handle asmsymbol or asmsymbol - asmsymbol } j:=pos(' ',s); if j=0 then j:=pos('-',s); { also try to handle asmsymbol + constant or asmsymbol - constant } if j=0 then j:=pos('+',s); if j<>0 then begin Val(Copy(s,j+1,255),ofs,code); if code<>0 then ofs:=0 else { constant reading successful, avoid further treatment by setting s[j] to '+' } s[j]:='+'; end else { single asmsymbol } j:=256; { the symbol can be external so we must use newasmsymbol and not getasmsymbol !! PM } ps:=objectlibrary.newasmsymbol(copy(s,1,j-1),AB_EXTERNAL,AT_FUNCTION); if not assigned(ps) then internalerror(33006) else begin sec:=ps.section; ofs:=ofs+ps.address; reloc:=true; objectlibrary.UsedAsmSymbolListInsert(ps); end; if (j<256) and (s[j]<>'+') then begin i:=i+j; s:=strpas(@p[i]); if (s<>'') and (s[1]=' ') then begin j:=0; while (s[j+1]=' ') do inc(j); i:=i+j; s:=strpas(@p[i]); end; ps:=objectlibrary.getasmsymbol(s); if not assigned(ps) then internalerror(33007) else begin if ps.section<>sec then internalerror(33008); ofs:=ofs-ps.address; reloc:=false; objectlibrary.UsedAsmSymbolListInsert(ps); end; end; end; end; { external bss need speical handling (PM) } if assigned(ps) and (ps.section=sec_none) then begin if currpass=2 then begin objectdata.writesymbol(ps); objectoutput.exportsymbol(ps); end; objectdata.writeSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc) end else objectdata.writeStabs(sec,ofs,hp,nidx,nother,line,reloc); if assigned(hp) then p[ii]:='"'; end; procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint); var sec : TSection; begin if currpass=1 then begin objectalloc.staballoc(nil); exit; end; if (nidx=n_textline) and assigned(funcname) and (target_info.use_function_relative_addresses) then objectdata.writeStabs(sec_code,objectdata.sectionsize(sec_code)-funcname.address, nil,nidx,0,line,false) else begin if nidx=n_textline then sec:=sec_code else if nidx=n_dataline then sec:=sec_data else sec:=sec_bss; objectdata.writeStabs(sec,objectdata.sectionsize(sec), nil,nidx,0,line,true); end; end; procedure TInternalAssembler.emitstabs(s:string); begin s:=s+#0; ConvertStabs(@s[1]); end; procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo); var curr_n : byte; hp : tasmsymbol; infile : tinputfile; 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; { get symbol for this includefile } hp:=objectlibrary.newasmsymbol('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION); if currpass=1 then begin hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0); objectlibrary.UsedAsmSymbolListInsert(hp); end else objectdata.writesymbol(hp); { emit stabs } if (infile.path^<>'') then EmitStabs('"'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+tostr(curr_n)+ ',0,0,Ltext'+ToStr(IncludeCount)); EmitStabs('"'+lower(FixFileName(infile.name^))+'",'+tostr(curr_n)+ ',0,0,Ltext'+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 emitlineinfostabs(n_line,fileinfo.line); stabslastfileinfo:=fileinfo; end; procedure TInternalAssembler.StartFileLineInfo; var fileinfo : tfileposinfo; begin FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0); n_line:=n_bssline; funcname:=nil; linecount:=1; includecount:=0; fileinfo.fileindex:=1; fileinfo.line:=1; WriteFileLineInfo(fileinfo); end; procedure TInternalAssembler.EndFileLineInfo; var hp : tasmsymbol; store_sec : TSection; begin if not ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then exit; store_sec:=objectalloc.currsec; objectalloc.seTSection(sec_code); hp:=objectlibrary.newasmsymbol('Letext',AB_LOCAL,AT_FUNCTION); if currpass=1 then begin hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0); objectlibrary.UsedAsmSymbolListInsert(hp); end else objectdata.writesymbol(hp); EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext'); objectalloc.seTSection(store_sec); end; {$endif GDB} function TInternalAssembler.MaybeNextList(var hp:Tai):boolean; begin { maybe end of list } while not assigned(hp) do begin if currlistidx2 then objectalloc.sectionalign(4) else if l>1 then objectalloc.sectionalign(2); objectalloc.sectionalloc(Tai_datablock(hp).size); end; end else begin l:=Tai_datablock(hp).size; if l>2 then objectalloc.sectionalign(4) else if l>1 then objectalloc.sectionalign(2); objectalloc.sectionalloc(Tai_datablock(hp).size); end; end; ait_const_32bit : objectalloc.sectionalloc(4); ait_const_16bit : objectalloc.sectionalloc(2); ait_const_8bit : objectalloc.sectionalloc(1); ait_real_80bit : objectalloc.sectionalloc(10); ait_real_64bit : objectalloc.sectionalloc(8); ait_real_32bit : objectalloc.sectionalloc(4); ait_comp_64bit : objectalloc.sectionalloc(8); ait_const_rva, ait_const_symbol : objectalloc.sectionalloc(4); ait_section: objectalloc.seTSection(Tai_section(hp).sec); ait_symbol : Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0); ait_label : Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0); ait_string : objectalloc.sectionalloc(Tai_string(hp).len); ait_instruction : begin {$ifdef i386} {$ifndef NOAG386BIN} { reset instructions which could change in pass 2 } Taicpu(hp).resetpass2; objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize)); {$endif NOAG386BIN} {$endif i386} end; ait_cut : if SmartAsm then break; end; hp:=Tai(hp.next); end; TreePass0:=hp; end; function TInternalAssembler.TreePass1(hp:Tai):Tai; var InlineLevel, l : longint; {$ifdef i386} {$ifndef NOAG386BIN} i : longint; {$endif NOAG386BIN} {$endif i386} begin inlinelevel:=0; while assigned(hp) do begin {$ifdef GDB} { write stabs, no line info for inlined code } if (inlinelevel=0) and ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then begin if (objectalloc.currsec<>sec_none) and not(hp.typ in SkipLineInfo) then WriteFileLineInfo(tailineinfo(hp).fileinfo); end; {$endif GDB} case hp.typ of ait_align : begin { here we must determine the fillsize which is used in pass2 } Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)- objectalloc.sectionsize; objectalloc.sectionalloc(Tai_align(hp).fillsize); end; ait_datablock : begin if objectalloc.currsec<>sec_bss then Message(asmw_e_alloc_data_only_in_bss); if not SmartAsm then begin if Tai_datablock(hp).is_global then begin Tai_datablock(hp).sym.setaddress(currpass,sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size); { force to be common/external, must be after setaddress as that would set it to AS_GLOBAL } Tai_datablock(hp).sym.currbind:=AB_COMMON; end else begin l:=Tai_datablock(hp).size; if l>2 then objectalloc.sectionalign(4) else if l>1 then objectalloc.sectionalign(2); Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize, Tai_datablock(hp).size); objectalloc.sectionalloc(Tai_datablock(hp).size); end; end else begin l:=Tai_datablock(hp).size; if l>2 then objectalloc.sectionalign(4) else if l>1 then objectalloc.sectionalign(2); Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size); objectalloc.sectionalloc(Tai_datablock(hp).size); end; objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym); end; ait_const_32bit : objectalloc.sectionalloc(4); ait_const_16bit : objectalloc.sectionalloc(2); ait_const_8bit : objectalloc.sectionalloc(1); ait_real_80bit : objectalloc.sectionalloc(10); ait_real_64bit : objectalloc.sectionalloc(8); ait_real_32bit : objectalloc.sectionalloc(4); ait_comp_64bit : objectalloc.sectionalloc(8); ait_const_rva, ait_const_symbol : begin objectalloc.sectionalloc(4); objectlibrary.UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym); end; ait_section: begin objectalloc.seTSection(Tai_section(hp).sec); {$ifdef GDB} case Tai_section(hp).sec 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; stabslastfileinfo.line:=-1; {$endif GDB} end; {$ifdef GDB} ait_stabn : begin if assigned(Tai_stabn(hp).str) then convertstabs(Tai_stabn(hp).str); end; ait_stabs : begin if assigned(Tai_stabs(hp).str) then convertstabs(Tai_stabs(hp).str); end; ait_stab_function_name : begin if assigned(Tai_stab_function_name(hp).str) then begin funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str)); objectlibrary.UsedAsmSymbolListInsert(funcname); end else funcname:=nil; end; ait_force_line : stabslastfileinfo.line:=0; {$endif} ait_symbol : begin Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0); objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym); end; ait_symbol_end : begin if target_info.system in [system_i386_linux,system_i386_beos] then begin Tai_symbol_end(hp).sym.size:=objectalloc.sectionsize-Tai_symbol_end(hp).sym.address; objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym); end; end; ait_label : begin Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0); objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l); end; ait_string : objectalloc.sectionalloc(Tai_string(hp).len); ait_instruction : begin {$ifdef i386} {$ifndef NOAG386BIN} objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize)); { fixup the references } for i:=1 to Taicpu(hp).ops do begin with Taicpu(hp).oper[i-1]^ do begin case typ of top_ref : begin if assigned(ref^.symbol) then objectlibrary.UsedAsmSymbolListInsert(ref^.symbol); if assigned(ref^.relsymbol) then objectlibrary.UsedAsmSymbolListInsert(ref^.symbol); end; end; end; end; {$endif NOAG386BIN} {$endif i386} end; ait_direct : Message(asmw_f_direct_not_supported); ait_cut : if SmartAsm then break; ait_marker : if tai_marker(hp).kind=InlineStart then inc(InlineLevel) else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); end; hp:=Tai(hp.next); end; TreePass1:=hp; end; function TInternalAssembler.TreePass2(hp:Tai):Tai; var fillbuffer : tfillbuffer; InlineLevel, l : longint; {$ifdef x86} co : comp; {$endif x86} begin inlinelevel:=0; { main loop } while assigned(hp) do begin {$ifdef GDB} { write stabs, no line info for inlined code } if (inlinelevel=0) and ((cs_debuginfo in aktmoduleswitches) or (cs_gdb_lineinfo in aktglobalswitches)) then begin if (objectdata.currsec<>sec_none) and not(hp.typ in SkipLineInfo) then WriteFileLineInfo(tailineinfo(hp).fileinfo); end; {$endif GDB} case hp.typ of ait_align : begin if objectdata.currsec=sec_bss then objectdata.alloc(Tai_align(hp).fillsize) else objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize); end; ait_section : begin objectdata.defaulTSection(Tai_section(hp).sec); {$ifdef GDB} case Tai_section(hp).sec 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; stabslastfileinfo.line:=-1; {$endif GDB} end; ait_symbol : begin objectdata.writesymbol(Tai_symbol(hp).sym); objectoutput.exportsymbol(Tai_symbol(hp).sym); end; ait_datablock : begin objectdata.writesymbol(Tai_datablock(hp).sym); objectoutput.exportsymbol(Tai_datablock(hp).sym); if SmartAsm or (not Tai_datablock(hp).is_global) then begin l:=Tai_datablock(hp).size; if l>2 then objectdata.allocalign(4) else if l>1 then objectdata.allocalign(2); objectdata.alloc(Tai_datablock(hp).size); end; end; ait_const_32bit : objectdata.writebytes(Tai_const(hp).value,4); ait_const_16bit : objectdata.writebytes(Tai_const(hp).value,2); ait_const_8bit : objectdata.writebytes(Tai_const(hp).value,1); ait_real_80bit : objectdata.writebytes(Tai_real_80bit(hp).value,10); ait_real_64bit : objectdata.writebytes(Tai_real_64bit(hp).value,8); ait_real_32bit : objectdata.writebytes(Tai_real_32bit(hp).value,4); ait_comp_64bit : begin {$ifdef x86} {$ifdef FPC} co:=comp(Tai_comp_64bit(hp).value); {$else} co:=Tai_comp_64bit(hp).value; {$endif} objectdata.writebytes(co,8); {$endif x86} end; ait_string : objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len); ait_const_rva : objectdata.writereloc(Tai_const_symbol(hp).offset,4, Tai_const_symbol(hp).sym,RELOC_RVA); ait_const_symbol : objectdata.writereloc(Tai_const_symbol(hp).offset,4, Tai_const_symbol(hp).sym,RELOC_ABSOLUTE); ait_label : begin objectdata.writesymbol(Tai_label(hp).l); { exporting shouldn't be necessary as labels are local, but it's better to be on the safe side (PFV) } objectoutput.exportsymbol(Tai_label(hp).l); end; {$ifdef i386} {$ifndef NOAG386BIN} ait_instruction : Taicpu(hp).Pass2(objectdata); {$endif NOAG386BIN} {$endif i386} {$ifdef GDB} ait_stabn : convertstabs(Tai_stabn(hp).str); ait_stabs : convertstabs(Tai_stabs(hp).str); ait_stab_function_name : if assigned(Tai_stab_function_name(hp).str) then funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str)) else funcname:=nil; ait_force_line : stabslastfileinfo.line:=0; {$endif} ait_cut : if SmartAsm then break; ait_marker : if tai_marker(hp).kind=InlineStart then inc(InlineLevel) else if tai_marker(hp).kind=InlineEnd then dec(InlineLevel); end; hp:=Tai(hp.next); end; TreePass2:=hp; end; procedure TInternalAssembler.writetree; var hp : Tai; label doexit; begin objectalloc.reseTSections; objectalloc.seTSection(sec_code); objectdata:=objectoutput.newobjectdata(Objfile); objectdata.defaulTSection(sec_code); { reset the asmsymbol list } objectlibrary.CreateUsedAsmsymbolList; { Pass 0 } currpass:=0; objectalloc.seTSection(sec_code); { start with list 1 } currlistidx:=1; currlist:=list[currlistidx]; hp:=Tai(currList.first); while assigned(hp) do begin hp:=TreePass0(hp); MaybeNextList(hp); end; { leave if errors have occured } if errorcount>0 then goto doexit; { Pass 1 } currpass:=1; objectalloc.reseTSections; objectalloc.seTSection(sec_code); {$ifdef GDB} StartFileLineInfo; {$endif GDB} { start with list 1 } currlistidx:=1; currlist:=list[currlistidx]; hp:=Tai(currList.first); while assigned(hp) do begin hp:=TreePass1(hp); MaybeNextList(hp); end; {$ifdef GDB} EndFileLineInfo; {$endif GDB} { check for undefined labels and reset } objectlibrary.UsedAsmSymbolListCheckUndefined; { set section sizes } objectdata.seTSectionsizes(objectalloc.secsize); { leave if errors have occured } if errorcount>0 then goto doexit; { Pass 2 } currpass:=2; {$ifdef GDB} StartFileLineInfo; {$endif GDB} { start with list 1 } currlistidx:=1; currlist:=list[currlistidx]; hp:=Tai(currList.first); while assigned(hp) do begin hp:=TreePass2(hp); MaybeNextList(hp); end; {$ifdef GDB} EndFileLineInfo; {$endif GDB} { don't write the .o file if errors have occured } if errorcount=0 then begin { write objectfile } objectoutput.startobjectfile(ObjFile); objectoutput.writeobjectfile(objectdata); objectdata.free; objectdata:=nil; end; doexit: { reset the used symbols back, must be after the .o has been written } objectlibrary.UsedAsmsymbolListReset; objectlibrary.DestroyUsedAsmsymbolList; end; procedure TInternalAssembler.writetreesmart; var hp : Tai; starTSec : TSection; place: tcutplace; begin objectalloc.reseTSections; objectalloc.seTSection(sec_code); NextSmartName(cut_normal); objectdata:=objectoutput.newobjectdata(Objfile); objectdata.defaulTSection(sec_code); starTSec:=sec_code; { start with list 1 } currlistidx:=1; currlist:=list[currlistidx]; hp:=Tai(currList.first); while assigned(hp) do begin { reset the asmsymbol list } objectlibrary.CreateUsedAsmSymbolList; { Pass 0 } currpass:=0; objectalloc.reseTSections; objectalloc.seTSection(starTSec); TreePass0(hp); { leave if errors have occured } if errorcount>0 then exit; { Pass 1 } currpass:=1; objectalloc.reseTSections; objectalloc.seTSection(starTSec); {$ifdef GDB} StartFileLineInfo; {$endif GDB} TreePass1(hp); {$ifdef GDB} EndFileLineInfo; {$endif GDB} { check for undefined labels } objectlibrary.UsedAsmSymbolListCheckUndefined; { set section sizes } objectdata.seTSectionsizes(objectalloc.secsize); { leave if errors have occured } if errorcount>0 then exit; { Pass 2 } currpass:=2; objectoutput.startobjectfile(Objfile); objectdata.defaulTSection(starTSec); {$ifdef GDB} StartFileLineInfo; {$endif GDB} hp:=TreePass2(hp); {$ifdef GDB} EndFileLineInfo; {$endif GDB} { leave if errors have occured } if errorcount>0 then exit; { write the current objectfile } objectoutput.writeobjectfile(objectdata); objectdata.free; objectdata:=nil; { reset the used symbols back, must be after the .o has been written } objectlibrary.UsedAsmsymbolListReset; objectlibrary.DestroyUsedAsmsymbolList; { end of lists? } if not MaybeNextList(hp) then break; { save section for next loop } { this leads to a problem if starTSec is sec_none !! PM } starTSec:=objectalloc.currsec; { we will start a new objectfile so reset everything } { The place can still change in the next while loop, so don't init } { the writer yet (JM) } if (hp.typ=ait_cut) then place := Tai_cut(hp).place else place := cut_normal; { avoid empty files } while assigned(hp) and (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do begin if Tai(hp).typ=ait_section then starTSec:=Tai_section(hp).sec else if (Tai(hp).typ=ait_cut) then place := Tai_cut(hp).place; hp:=Tai(hp.next); end; if not MaybeNextList(hp) then break; { start next objectfile } NextSmartName(place); objectdata:=objectoutput.newobjectdata(Objfile); { there is a problem if starTSec is sec_none !! PM } if starTSec=sec_none then starTSec:=sec_code; end; end; procedure TInternalAssembler.MakeObject; procedure addlist(p:TAAsmoutput); begin inc(lists); list[lists]:=p; end; begin if cs_debuginfo in aktmoduleswitches then addlist(debuglist); addlist(codesegment); addlist(datasegment); addlist(consts); addlist(rttilist); addlist(picdata); if assigned(resourcestringlist) then addlist(resourcestringlist); addlist(bsssegment); if assigned(importssection) then addlist(importssection); if assigned(exportssection) and not UseDeffileForExport then addlist(exportssection); if assigned(resourcesection) then addlist(resourcesection); if SmartAsm then writetreesmart else writetree; end; {***************************************************************************** Generate Assembler Files Main Procedure *****************************************************************************} Procedure GenerateAsm(smart:boolean); var a : TAssembler; begin if not assigned(CAssembler[target_asm.id]) then Message(asmw_f_assembler_output_not_supported); a:=CAssembler[target_asm.id].Create(smart); a.MakeObject; a.Free; end; Procedure OnlyAsm; var a : TExternalAssembler; begin a:=TExternalAssembler.Create(false); a.DoAssemble; a.Free; end; {***************************************************************************** Init/Done *****************************************************************************} procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass); var t : tasm; begin t:=r.id; if assigned(asminfos[t]) then writeln('Warning: Assembler is already registered!') else Getmem(asminfos[t],sizeof(tasminfo)); asminfos[t]^:=r; CAssembler[t]:=c; end; procedure InitAssembler; begin { target_asm is already set by readarguments } initoutputformat:=target_asm.id; aktoutputformat:=target_asm.id; end; procedure DoneAssembler; begin end; end. { $Log$ Revision 1.65 2004-03-15 21:50:09 peter * start with bssline Revision 1.64 2004/03/02 17:32:12 florian * make cycle fixed + pic support for darwin + support of importing vars from shared libs on darwin implemented Revision 1.63 2004/03/02 00:36:33 olle * big transformation of Tai_[const_]Symbol.Create[data]name* Revision 1.62 2004/02/27 10:21:05 florian * top_symbol killed + refaddr to treference added + refsymbol to treference added * top_local stuff moved to an extra record to save memory + aint introduced * tppufile.get/putint64/aint implemented Revision 1.61 2004/01/31 17:45:17 peter * Change several $ifdef i386 to x86 * Change several OS_32 to OS_INT/OS_ADDR Revision 1.60 2004/01/30 15:44:23 jonas + support for piped assembling under Darwin Revision 1.59 2003/11/10 17:22:28 marco * havelinuxrtl10 fixes Revision 1.58 2003/10/21 15:15:36 peter * taicpu_abstract.oper[] changed to pointers Revision 1.57 2003/10/03 14:16:48 marco * -XP support Revision 1.56 2003/09/30 19:54:23 peter * better link on target support Revision 1.55 2003/09/23 17:56:05 peter * locals and paras are allocated in the code generation * tvarsym.localloc contains the location of para/local when generating code for the current procedure Revision 1.54 2003/09/03 15:55:00 peter * NEWRA branch merged Revision 1.53.2.1 2003/09/01 21:02:55 peter * sparc updates for new tregister Revision 1.53 2003/07/04 22:40:58 pierre * add support for constant offset in stabs address, needed by threadvar debugging support Revision 1.52 2003/04/23 13:48:07 peter * m68k fix Revision 1.51 2003/04/22 14:33:38 peter * removed some notes/hints Revision 1.50 2003/03/10 18:16:00 olle * niceified comments Revision 1.49 2003/01/10 21:49:00 marco * more hasunix fixes Revision 1.48 2002/11/24 18:21:49 carl - remove some unused defines Revision 1.47 2002/11/17 16:31:55 carl * memory optimization (3-4%) : cleanup of tai fields, cleanup of tdef and tsym fields. * make it work for m68k Revision 1.46 2002/11/15 01:58:46 peter * merged changes from 1.0.7 up to 04-11 - -V option for generating bug report tracing - more tracing for option parsing - errors for cdecl and high() - win32 import stabs - win32 records<=8 are returned in eax:edx (turned off by default) - heaptrc update - more info for temp management in .s file with EXTDEBUG Revision 1.45 2002/10/30 21:01:14 peter * always include lineno after fileswitch. valgrind requires this Revision 1.44 2002/09/05 19:29:42 peter * memdebug enhancements Revision 1.43 2002/08/20 16:55:38 peter * don't write (stabs)line info when inlining a procedure Revision 1.42 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class * many many updates for m68k (will soon start to compile) - removed some ifdef or correct them for correct cpu Revision 1.41 2002/08/11 14:32:26 peter * renamed current_library to objectlibrary Revision 1.40 2002/08/11 13:24:10 peter * saving of asmsymbols in ppu supported * asmsymbollist global is removed and moved into a new class tasmlibrarydata that will hold the info of a .a file which corresponds with a single module. Added librarydata to tmodule to keep the library info stored for the module. In the future the objectfiles will also be stored to the tasmlibrarydata class * all getlabel/newasmsymbol and friends are moved to the new class Revision 1.39 2002/07/26 21:15:37 florian * rewrote the system handling Revision 1.38 2002/07/10 07:24:40 jonas * memory leak fixes from Sergey Korshunoff Revision 1.37 2002/07/01 18:46:21 peter * internal linker * reorganized aasm layer Revision 1.36 2002/05/18 13:34:05 peter * readded missing revisions Revision 1.35 2002/05/16 19:46:35 carl + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand + try to fix temp allocation (still in ifdef) + generic constructor calls + start of tassembler / tmodulebase class cleanup Revision 1.33 2002/04/10 08:07:55 jonas * fix for the ie9999 under Linux (patch from Peter) Revision 1.32 2002/04/07 13:19:14 carl + more documentation Revision 1.31 2002/04/04 19:05:54 peter * removed unused units * use tlocation.size in cg.a_*loc*() routines Revision 1.30 2002/04/02 17:11:27 peter * tlocation,treference update * LOC_CONSTANT added for better constant handling * secondadd splitted in multiple routines * location_force_reg added for loading a location to a register of a specified size * secondassignment parses now first the right and then the left node (this is compatible with Kylix). This saves a lot of push/pop especially with string operations * adapted some routines to use the new cg methods }