fpc/compiler/assemble.pas
peter e24474d9ac * -Ur switch (merged)
* masm fixes (merged)
  * quoted filenames for go32v2 and win32
2001-06-18 20:36:23 +00:00

1590 lines
47 KiB
ObjectPascal

{
$Id$
Copyright (c) 1998-2000 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.
****************************************************************************
}
unit assemble;
{$i defines.inc}
interface
{ Use multiple passes in the internal assembler to optimize jumps }
{$define MULTIPASS}
uses
{$ifdef Delphi}
sysutils,
dmisc,
{$else Delphi}
strings,
dos,
{$endif Delphi}
systems,globtype,globals,aasm,ogbase;
const
AsmOutSize=32768;
type
TAssembler=class
public
{filenames}
path : pathstr;
name : namestr;
asmfile, { current .s and .o file }
objfile : string;
SmartAsm : boolean;
SmartFilesCount,
SmartHeaderCount : longint;
Constructor Create(smart:boolean);virtual;
Destructor Destroy;override;
procedure NextSmartName(place:tcutplace);
procedure MakeObject;virtual;abstract;
end;
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
Function FindAssembler:string;
Function CallAssembler(const command,para:string):Boolean;
Function DoAssemble:boolean;virtual;
Procedure RemoveAsm;
Procedure AsmFlush;
Procedure AsmClear;
Procedure AsmWrite(const s:string);
Procedure AsmWritePChar(p:pchar);
Procedure AsmWriteLn(const s:string);
Procedure AsmLn;
procedure AsmCreate(Aplace:tcutplace);
procedure AsmClose;
procedure WriteTree(p:TAAsmoutput);virtual;
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 : tobjectalloc;
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 unix}
{$ifdef ver1_0}
linux,
{$else}
unix,
{$endif}
{$endif}
cutils,script,finput,fmodule,verbose,
{$ifdef GDB}
gdb,
{$endif GDB}
cpubase,cpuasm
;
var
CAssembler : array[tasm] of TAssemblerClass;
{*****************************************************************************
TAssembler
*****************************************************************************}
Constructor TAssembler.Create(smart:boolean);
begin
{ load start values }
asmfile:=current_module.asmfilename^;
objfile:=current_module.objfilename^;
name:=Lower(current_module.modulename^);
path:=current_module.outputpath^;
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:=current_module.asmprefix^+tostr(SmartHeaderCount)+'h';
end;
cut_normal :
s:=current_module.asmprefix^+tostr(SmartHeaderCount)+'s';
cut_end :
s:=current_module.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)
{$ifdef i386}
and (aktoutputformat=as_i386_as)
{$endif i386}
{$ifdef m68k}
and (aktoutputformat=as_m68k_as);
{$endif m68k}
end;
Constructor TExternalAssembler.Create(smart:boolean);
begin
inherited Create(smart);
if SmartAsm then
begin
path:=FixPath(current_module.outputpath^+FixFileName(current_module.modulename^)+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+dirsep+'*'+target_info.objext,anyfile,dir);
while (doserror=0) do
begin
RemoveFile(s+dirsep+dir.name);
findnext(dir);
end;
findclose(dir);
{ .s files }
findfirst(s+dirsep+'*'+target_info.asmext,anyfile,dir);
while (doserror=0) do
begin
RemoveFile(s+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;
UtilExe:=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_w_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_w_cant_call_assembler,tostr(doserror));
aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
callassembler:=false;
end
else
if (dosexitcode<>0) then
begin
Message1(exec_w_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;
Replace(s,'$ASM',AsmFile);
Replace(s,'$OBJ',ObjFile);
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;
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;
procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
begin
if SmartAsm then
NextSmartName(Aplace);
{$ifdef unix}
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 unix}
if DoPipe then
PClose(outfile)
else
{$endif}
begin
{Touch Assembler time to ppu time is there is a ppufilename}
if Assigned(current_module.ppufilename) then
begin
Assign(f,current_module.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;
objectalloc:=tobjectalloc.create;
SmartAsm:=smart;
currpass:=0;
end;
destructor TInternalAssembler.destroy;
{$ifdef MEMDEBUG}
var
d : tmemdebug;
{$endif}
begin
{$ifdef MEMDEBUG}
d.init('agbin');
{$endif}
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);
{ single asmsymbol }
if j=0 then
j:=256;
{ the symbol can be external
so we must use newasmsymbol and
not getasmsymbol !! PM }
ps:=newasmsymbol(copy(s,1,j-1));
if not assigned(ps) then
internalerror(33006)
else
begin
sec:=ps.section;
ofs:=ps.address;
reloc:=true;
UsedAsmSymbolListInsert(ps);
end;
if j<256 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:=getasmsymbol(s);
if not assigned(ps) then
internalerror(33007)
else
begin
if ps.section<>sec then
internalerror(33008);
ofs:=ofs-ps.address;
reloc:=false;
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 includecount=0 then
curr_n:=n_sourcefile
else
curr_n:=n_includefile;
{ get symbol for this includefile }
hp:=newasmsymboltype('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
if currpass=1 then
begin
hp.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
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);
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_textline;
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:=newasmsymboltype('Letext',AB_LOCAL,AT_FUNCTION);
if currpass=1 then
begin
hp.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
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 currlistidx<lists then
begin
inc(currlistidx);
currlist:=list[currlistidx];
hp:=Tai(currList.first);
end
else
begin
MaybeNextList:=false;
exit;
end;
end;
MaybeNextList:=true;
end;
function TInternalAssembler.TreePass0(hp:Tai):Tai;
var
l : longint;
begin
while assigned(hp) do
begin
case hp.typ of
ait_align :
begin
{ always use the maximum fillsize in this pass to avoid possible
short jumps to become out of range }
Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
objectalloc.sectionalloc(Tai_align(hp).fillsize);
end;
ait_datablock :
begin
if not SmartAsm then
begin
if not Tai_datablock(hp).is_global then
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
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(objectalloc.currsec,objectalloc.sectionsize,0);
ait_label :
Tai_label(hp).l.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
ait_string :
objectalloc.sectionalloc(Tai_string(hp).len);
ait_instruction :
begin
{ reset instructions which could change in pass 2 }
Taicpu(hp).resetpass2;
objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
end;
ait_cut :
if SmartAsm then
break;
end;
hp:=Tai(hp.next);
end;
TreePass0:=hp;
end;
function TInternalAssembler.TreePass1(hp:Tai):Tai;
var
i,l : longint;
begin
while assigned(hp) do
begin
{$ifdef GDB}
{ write stabs }
if ((cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches)) then
begin
if (objectalloc.currsec<>sec_none) and
not(hp.typ in [
ait_label,
ait_regalloc,ait_tempalloc,
ait_stabn,ait_stabs,ait_section,
ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
WriteFileLineInfo(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(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.bind:=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(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(objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
objectalloc.sectionalloc(Tai_datablock(hp).size);
end;
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);
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 :
convertstabs(Tai_stabn(hp).str);
ait_stabs :
convertstabs(Tai_stabs(hp).str);
ait_stab_function_name :
begin
if assigned(Tai_stab_function_name(hp).str) then
begin
funcname:=getasmsymbol(strpas(Tai_stab_function_name(hp).str));
UsedAsmSymbolListInsert(funcname);
end
else
funcname:=nil;
end;
ait_force_line :
stabslastfileinfo.line:=0;
{$endif}
ait_symbol :
begin
Tai_symbol(hp).sym.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
end;
ait_symbol_end :
begin
if target_info.target=target_i386_linux then
begin
Tai_symbol(hp).sym.size:=objectalloc.sectionsize-Tai_symbol(hp).sym.address;
UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
end;
end;
ait_label :
begin
Tai_label(hp).l.setaddress(objectalloc.currsec,objectalloc.sectionsize,0);
UsedAsmSymbolListInsert(Tai_label(hp).l);
end;
ait_string :
objectalloc.sectionalloc(Tai_string(hp).len);
ait_instruction :
begin
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
UsedAsmSymbolListInsert(ref^.symbol);
end;
top_symbol :
begin
if sym=nil then
sym:=sym;
UsedAsmSymbolListInsert(sym);
end;
end;
end;
end;
end;
ait_direct :
Message(asmw_f_direct_not_supported);
ait_cut :
if SmartAsm then
break;
end;
hp:=Tai(hp.next);
end;
TreePass1:=hp;
end;
function TInternalAssembler.TreePass2(hp:Tai):Tai;
var
l : longint;
{$ifdef I386}
co : comp;
{$endif I386}
begin
{ main loop }
while assigned(hp) do
begin
{$ifdef GDB}
{ write stabs }
if ((cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches)) then
begin
if (objectdata.currsec<>sec_none) and
not(hp.typ in [
ait_label,
ait_regalloc,ait_tempalloc,
ait_stabn,ait_stabs,ait_section,
ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
WriteFileLineInfo(hp.fileinfo);
end;
{$endif GDB}
case hp.typ of
ait_align :
objectdata.writebytes(Tai_align(hp).getfillbuf^,Tai_align(hp).fillsize);
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 FPC}
co:=comp(Tai_comp_64bit(hp).value);
{$else}
co:=Tai_comp_64bit(hp).value;
{$endif}
objectdata.writebytes(co,8);
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,relative_rva);
ait_const_symbol :
objectdata.writereloc(Tai_const_symbol(hp).offset,4,
Tai_const_symbol(hp).sym,relative_false);
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;
ait_instruction :
Taicpu(hp).Pass2;
{$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:=getasmsymbol(strpas(Tai_stab_function_name(hp).str))
else
funcname:=nil;
ait_force_line :
stabslastfileinfo.line:=0;
{$endif}
ait_cut :
if SmartAsm then
break;
end;
hp:=Tai(hp.next);
end;
TreePass2:=hp;
end;
procedure TInternalAssembler.writetree;
var
hp : Tai;
label
doexit;
begin
objectalloc.resetsections;
objectalloc.setsection(sec_code);
objectoutput.initwriting(ObjFile);
objectdata:=objectoutput.data;
objectdata.defaultsection(sec_code);
{ reset the asmsymbol list }
CreateUsedAsmsymbolList;
{$ifdef MULTIPASS}
{ 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;
{$endif}
{ 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 }
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}
{ leave if errors have occured }
if errorcount>0 then
goto doexit;
{ write last objectfile }
objectoutput.donewriting;
objectdata:=nil;
doexit:
{ reset the used symbols back, must be after the .o has been
written }
UsedAsmsymbolListReset;
DestroyUsedAsmsymbolList;
end;
procedure TInternalAssembler.writetreesmart;
var
hp : Tai;
startsec : tsection;
place: tcutplace;
begin
objectalloc.resetsections;
objectalloc.setsection(sec_code);
NextSmartName(cut_normal);
objectoutput.initwriting(ObjFile);
objectdata:=objectoutput.data;
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 }
CreateUsedAsmSymbolList;
{$ifdef MULTIPASS}
{ Pass 0 }
currpass:=0;
objectalloc.resetsections;
objectalloc.setsection(startsec);
TreePass0(hp);
{ leave if errors have occured }
if errorcount>0 then
exit;
{$endif MULTIPASS}
{ 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 }
UsedAsmSymbolListCheckUndefined;
{ set section sizes }
objectdata.setsectionsizes(objectalloc.secsize);
{ leave if errors have occured }
if errorcount>0 then
exit;
{ Pass 2 }
currpass:=2;
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;
{ if not end then write the current objectfile }
objectoutput.donewriting;
objectdata:=nil;
{ reset the used symbols back, must be after the .o has been
written }
UsedAsmsymbolListReset;
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;
NextSmartName(place);
objectoutput.initwriting(ObjFile);
objectdata:=objectoutput.data;
{ there is a problem if startsec is sec_none !! PM }
if startsec=sec_none then
startsec:=sec_code;
if not MaybeNextList(hp) then
break;
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);
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.21 2001-06-18 20:36:23 peter
* -Ur switch (merged)
* masm fixes (merged)
* quoted filenames for go32v2 and win32
Revision 1.20 2001/06/13 18:31:57 peter
* smartlink with dll fixed (merged)
Revision 1.19 2001/04/21 15:34:49 peter
* used target_asm.id instead of target_info.assem
Revision 1.18 2001/04/18 22:01:53 peter
* registration of targets and assemblers
Revision 1.17 2001/04/13 01:22:06 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.16 2001/03/13 18:42:39 peter
* don't create temporary smartlink dir for internalassembler
Revision 1.15 2001/03/05 21:39:11 peter
* changed to class with common TAssembler also for internal assembler
Revision 1.14 2001/02/26 08:08:16 michael
* bug correction: pipes must be closed by pclose (not close);
There was too many not closed processes under Linux before patch.
Test this by making a compiler under Linux with command
OPT="-P" make
and check a list of processes in another shell with
ps -xa
Revision 1.13 2001/02/20 21:36:39 peter
* tasm/masm fixes merged
Revision 1.12 2001/02/09 23:06:17 peter
* fixed uninited var
Revision 1.11 2001/02/05 20:46:59 peter
* support linux unit for ver1_0 compilers
Revision 1.10 2001/01/21 20:32:45 marco
* Renamefest. Compiler part. Not that hard.
Revision 1.9 2001/01/12 19:19:44 peter
* fixed searching for utils
Revision 1.8 2000/12/25 00:07:25 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.7 2000/11/13 15:26:12 marco
* Renamefest
Revision 1.6 2000/10/01 19:48:23 peter
* lot of compile updates for cg11
Revision 1.5 2000/09/24 15:06:11 peter
* use defines.inc
Revision 1.4 2000/08/27 16:11:49 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
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:32 michael
+ removed logs
}