mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-03 07:53:42 +02:00

* support for case aware filesystems (Windows), they do now only one lookup if a file exists * add -WI option to generate import section for DLL imports or let the linker handle it. Default is still import section until the Makefiles are fixed, then the generation can be left to the linker git-svn-id: trunk@2274 -
1482 lines
44 KiB
ObjectPascal
1482 lines
44 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2004 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 USE_SYSUTILS}
|
|
sysutils,
|
|
{$ELSE USE_SYSUTILS}
|
|
strings,
|
|
dos,
|
|
{$ENDIF USE_SYSUTILS}
|
|
systems,globtype,globals,aasmbase,aasmtai,ogbase;
|
|
|
|
const
|
|
{ maximum of aasmoutput lists there will be }
|
|
maxoutputlists = 20;
|
|
{ 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;
|
|
ioerror : boolean;
|
|
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:string; const para:TCmdStr):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
|
|
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;
|
|
procedure convertstab(p:pchar);
|
|
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 m68k}
|
|
cpuinfo,
|
|
{$endif m68k}
|
|
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 ((target_asm.id 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
|
|
{$IFDEF USE_SYSUTILS}
|
|
dir : TSearchRec;
|
|
{$ELSE USE_SYSUTILS}
|
|
dir : searchrec;
|
|
{$ENDIF USE_SYSUTILS}
|
|
hs : string;
|
|
begin
|
|
if PathExists(s) then
|
|
begin
|
|
{ the path exists, now we clean only all the .o and .s files }
|
|
{ .o files }
|
|
{$IFDEF USE_SYSUTILS}
|
|
if findfirst(s+source_info.dirsep+'*'+target_info.objext,faAnyFile,dir) = 0
|
|
then repeat
|
|
RemoveFile(s+source_info.dirsep+dir.name);
|
|
until findnext(dir) <> 0;
|
|
{$ELSE USE_SYSUTILS}
|
|
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;
|
|
{$ENDIF USE_SYSUTILS}
|
|
findclose(dir);
|
|
{ .s files }
|
|
{$IFDEF USE_SYSUTILS}
|
|
if findfirst(s+source_info.dirsep+'*'+target_info.asmext,faAnyFile,dir) = 0
|
|
then repeat
|
|
RemoveFile(s+source_info.dirsep+dir.name);
|
|
until findnext(dir) <> 0;
|
|
{$ELSE USE_SYSUTILS}
|
|
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;
|
|
{$ENDIF USE_SYSUTILS}
|
|
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:string; const para:TCmdStr):Boolean;
|
|
{$IFDEF USE_SYSUTILS}
|
|
var
|
|
DosExitCode:Integer;
|
|
{$ENDIF USE_SYSUTILS}
|
|
begin
|
|
callassembler:=true;
|
|
if not(cs_asm_extern in aktglobalswitches) then
|
|
{$IFDEF USE_SYSUTILS}
|
|
try
|
|
DosExitCode := ExecuteProcess(command,para);
|
|
if DosExitCode <>0
|
|
then begin
|
|
Message1(exec_e_error_while_assembling,tostr(dosexitcode));
|
|
callassembler:=false;
|
|
end;
|
|
except on E:EOSError do
|
|
begin
|
|
Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
|
|
aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
|
|
callassembler:=false;
|
|
end
|
|
end
|
|
{$ELSE USE_SYSUTILS}
|
|
begin
|
|
swapvectors;
|
|
exec(maybequoted(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
|
|
{$ENDIF USE_SYSUTILS}
|
|
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 : TCmdStr;
|
|
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',maybequoted(ScriptFixFileName(AsmFile)));
|
|
Replace(s,'$OBJ',maybequoted(ScriptFixFileName(ObjFile)));
|
|
end
|
|
else
|
|
begin
|
|
Replace(s,'$ASM',maybequoted(AsmFile));
|
|
Replace(s,'$OBJ',maybequoted(ObjFile));
|
|
end;
|
|
if CallAssembler(FindAssembler,s) then
|
|
RemoveAsm
|
|
else
|
|
begin
|
|
DoAssemble:=false;
|
|
GenerateError;
|
|
end;
|
|
end;
|
|
|
|
|
|
Procedure TExternalAssembler.AsmFlush;
|
|
begin
|
|
if outcnt>0 then
|
|
begin
|
|
{ suppress i/o error }
|
|
{$i-}
|
|
BlockWrite(outfile,outbuf,outcnt);
|
|
{$i+}
|
|
ioerror:=ioerror or (ioresult<>0);
|
|
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
|
|
begin
|
|
ioerror:=true;
|
|
Message1(exec_d_cant_create_asmfile,asmfile);
|
|
end;
|
|
end;
|
|
outcnt:=0;
|
|
AsmSize:=0;
|
|
AsmStartSize:=0;
|
|
end;
|
|
|
|
|
|
procedure TExternalAssembler.AsmClose;
|
|
var
|
|
f : file;
|
|
FileAge : longint;
|
|
begin
|
|
AsmFlush;
|
|
{$ifdef hasunix}
|
|
if DoPipe then
|
|
begin
|
|
if PClose(outfile) <> 0 then
|
|
GenerateError;
|
|
end
|
|
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
|
|
{$IFDEF USE_SYSUTILS}
|
|
FileAge := FileGetDate(GetFileHandle(f));
|
|
{$ELSE USE_SYSUTILS}
|
|
GetFTime(f, FileAge);
|
|
{$ENDIF USE_SYSUTILS}
|
|
close(f);
|
|
reset(outfile,1);
|
|
{$IFDEF USE_SYSUTILS}
|
|
FileSetDate(GetFileHandle(outFile),FileAge);
|
|
{$ELSE USE_SYSUTILS}
|
|
SetFTime(f, FileAge);
|
|
{$ENDIF USE_SYSUTILS}
|
|
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;
|
|
if not(ioerror) then
|
|
DoAssemble;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TInternalAssembler
|
|
*****************************************************************************}
|
|
|
|
constructor TInternalAssembler.create(smart:boolean);
|
|
begin
|
|
inherited create(smart);
|
|
objectoutput:=nil;
|
|
objectdata:=nil;
|
|
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;
|
|
{$ifdef MEMDEBUG}
|
|
d.free;
|
|
{$endif}
|
|
end;
|
|
|
|
|
|
procedure TInternalAssembler.convertstab(p:pchar);
|
|
|
|
function consumecomma(var p:pchar):boolean;
|
|
begin
|
|
while (p^=' ') do
|
|
inc(p);
|
|
result:=(p^=',');
|
|
inc(p);
|
|
end;
|
|
|
|
function consumenumber(var p:pchar;out value:longint):boolean;
|
|
var
|
|
hs : string;
|
|
len,
|
|
code : integer;
|
|
begin
|
|
value:=0;
|
|
while (p^=' ') do
|
|
inc(p);
|
|
len:=0;
|
|
while (p^ in ['0'..'9']) do
|
|
begin
|
|
inc(len);
|
|
hs[len]:=p^;
|
|
inc(p);
|
|
end;
|
|
if len>0 then
|
|
begin
|
|
hs[0]:=chr(len);
|
|
val(hs,value,code);
|
|
end
|
|
else
|
|
code:=-1;
|
|
result:=(code=0);
|
|
end;
|
|
|
|
function consumeoffset(var p:pchar;out relocsym:tasmsymbol;out value:longint):boolean;
|
|
var
|
|
hs : string;
|
|
len,
|
|
code : integer;
|
|
pstart : pchar;
|
|
sym : tasmsymbol;
|
|
exprvalue : longint;
|
|
gotmin,
|
|
dosub : boolean;
|
|
begin
|
|
result:=false;
|
|
value:=0;
|
|
relocsym:=nil;
|
|
gotmin:=false;
|
|
repeat
|
|
dosub:=false;
|
|
exprvalue:=0;
|
|
if gotmin then
|
|
begin
|
|
dosub:=true;
|
|
gotmin:=false;
|
|
end;
|
|
while (p^=' ') do
|
|
inc(p);
|
|
case p^ of
|
|
#0 :
|
|
break;
|
|
' ' :
|
|
inc(p);
|
|
'0'..'9' :
|
|
begin
|
|
len:=0;
|
|
while (p^ in ['0'..'9']) do
|
|
begin
|
|
inc(len);
|
|
hs[len]:=p^;
|
|
inc(p);
|
|
end;
|
|
hs[0]:=chr(len);
|
|
val(hs,exprvalue,code);
|
|
end;
|
|
'.','_',
|
|
'A'..'Z',
|
|
'a'..'z' :
|
|
begin
|
|
pstart:=p;
|
|
while not(p^ in [#0,' ','-','+']) do
|
|
inc(p);
|
|
len:=p-pstart;
|
|
if len>255 then
|
|
internalerror(200509187);
|
|
move(pstart^,hs[1],len);
|
|
hs[0]:=chr(len);
|
|
sym:=objectlibrary.newasmsymbol(hs,AB_EXTERNAL,AT_NONE);
|
|
if not assigned(sym) then
|
|
internalerror(200509188);
|
|
objectlibrary.UsedAsmSymbolListInsert(sym);
|
|
{ Second symbol? }
|
|
if assigned(relocsym) then
|
|
begin
|
|
if (relocsym.section<>sym.section) then
|
|
internalerror(2005091810);
|
|
relocsym:=nil;
|
|
end
|
|
else
|
|
begin
|
|
relocsym:=sym;
|
|
end;
|
|
exprvalue:=sym.address;
|
|
end;
|
|
'+' :
|
|
begin
|
|
{ nothing, by default addition is done }
|
|
inc(p);
|
|
end;
|
|
'-' :
|
|
begin
|
|
gotmin:=true;
|
|
inc(p);
|
|
end;
|
|
else
|
|
internalerror(200509189);
|
|
end;
|
|
if dosub then
|
|
dec(value,exprvalue)
|
|
else
|
|
inc(value,exprvalue);
|
|
until false;
|
|
result:=true;
|
|
end;
|
|
|
|
const
|
|
N_Function = $24; { function or const }
|
|
var
|
|
ofs,
|
|
nline,
|
|
nidx,
|
|
nother,
|
|
i : longint;
|
|
relocsym : tasmsymbol;
|
|
pstr,
|
|
pcurr,
|
|
pendquote : pchar;
|
|
begin
|
|
pcurr:=nil;
|
|
pstr:=nil;
|
|
pendquote:=nil;
|
|
|
|
{ Parse string part }
|
|
if p[0]='"' then
|
|
begin
|
|
pstr:=@p[1];
|
|
{ Ignore \" inside the string }
|
|
i:=1;
|
|
while not((p[i]='"') and (p[i-1]<>'\')) and
|
|
(p[i]<>#0) do
|
|
inc(i);
|
|
pendquote:=@p[i];
|
|
pendquote^:=#0;
|
|
pcurr:=@p[i+1];
|
|
if not consumecomma(pcurr) then
|
|
internalerror(200509181);
|
|
end
|
|
else
|
|
pcurr:=p;
|
|
|
|
{ When in pass 1 then only alloc and leave }
|
|
if currpass=1 then
|
|
objectdata.allocstab(pstr)
|
|
else
|
|
begin
|
|
{ Stabs format: nidx,nother,nline[,offset] }
|
|
if not consumenumber(pcurr,nidx) then
|
|
internalerror(200509182);
|
|
if not consumecomma(pcurr) then
|
|
internalerror(200509183);
|
|
if not consumenumber(pcurr,nother) then
|
|
internalerror(200509184);
|
|
if not consumecomma(pcurr) then
|
|
internalerror(200509185);
|
|
if not consumenumber(pcurr,nline) then
|
|
internalerror(200509186);
|
|
if consumecomma(pcurr) then
|
|
consumeoffset(pcurr,relocsym,ofs)
|
|
else
|
|
begin
|
|
ofs:=0;
|
|
relocsym:=nil;
|
|
end;
|
|
if (nidx=N_Function) and
|
|
(tf_use_function_relative_addresses in target_info.flags) then
|
|
ofs:=0;
|
|
objectdata.writestab(ofs,relocsym,nidx,nother,nline,pstr);
|
|
end;
|
|
if assigned(pendquote) then
|
|
pendquote^:='"';
|
|
end;
|
|
|
|
|
|
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;
|
|
objectdata.alloc(Tai_align(hp).fillsize);
|
|
end;
|
|
ait_datablock :
|
|
begin
|
|
l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
|
|
if SmartAsm or (not Tai_datablock(hp).is_global) then
|
|
begin
|
|
objectdata.allocalign(l);
|
|
objectdata.alloc(Tai_datablock(hp).size);
|
|
end;
|
|
end;
|
|
ait_real_80bit :
|
|
objectdata.alloc(10);
|
|
ait_real_64bit :
|
|
objectdata.alloc(8);
|
|
ait_real_32bit :
|
|
objectdata.alloc(4);
|
|
ait_comp_64bit :
|
|
objectdata.alloc(8);
|
|
ait_const_64bit,
|
|
ait_const_32bit,
|
|
ait_const_16bit,
|
|
ait_const_8bit,
|
|
ait_const_rva_symbol,
|
|
ait_const_indirect_symbol :
|
|
objectdata.alloc(tai_const(hp).size);
|
|
ait_section:
|
|
begin
|
|
objectdata.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secalign,[]);
|
|
Tai_section(hp).sec:=objectdata.CurrSec;
|
|
end;
|
|
ait_symbol :
|
|
objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
|
|
ait_label :
|
|
objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
|
|
ait_string :
|
|
objectdata.alloc(Tai_string(hp).len);
|
|
ait_instruction :
|
|
begin
|
|
{$ifdef i386}
|
|
{$ifndef NOAG386BIN}
|
|
{ reset instructions which could change in pass 2 }
|
|
Taicpu(hp).resetpass2;
|
|
objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
|
|
{$endif NOAG386BIN}
|
|
{$endif i386}
|
|
{$ifdef arm}
|
|
{ reset instructions which could change in pass 2 }
|
|
Taicpu(hp).resetpass2;
|
|
objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
|
|
{$endif arm}
|
|
end;
|
|
ait_cutobject :
|
|
if SmartAsm then
|
|
break;
|
|
end;
|
|
hp:=Tai(hp.next);
|
|
end;
|
|
TreePass0:=hp;
|
|
end;
|
|
|
|
|
|
function TInternalAssembler.TreePass1(hp:Tai):Tai;
|
|
var
|
|
InlineLevel,
|
|
l,
|
|
i : longint;
|
|
begin
|
|
inlinelevel:=0;
|
|
while assigned(hp) do
|
|
begin
|
|
case hp.typ of
|
|
ait_align :
|
|
begin
|
|
{ here we must determine the fillsize which is used in pass2 }
|
|
Tai_align(hp).fillsize:=align(objectdata.currsec.datasize,Tai_align(hp).aligntype)-
|
|
objectdata.currsec.datasize;
|
|
objectdata.alloc(Tai_align(hp).fillsize);
|
|
end;
|
|
ait_datablock :
|
|
begin
|
|
if not (objectdata.currsec.sectype in [sec_bss,sec_threadvar]) then
|
|
Message(asmw_e_alloc_data_only_in_bss);
|
|
l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
|
|
{ if Tai_datablock(hp).is_global and
|
|
not SmartAsm then
|
|
begin}
|
|
{ objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);}
|
|
{ force to be common/external, must be after setaddress as that would
|
|
set it to AB_GLOBAL }
|
|
{ Tai_datablock(hp).sym.currbind:=AB_COMMON;
|
|
end
|
|
else
|
|
begin}
|
|
objectdata.allocalign(l);
|
|
objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
|
|
objectdata.alloc(Tai_datablock(hp).size);
|
|
{ end;}
|
|
objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
|
|
end;
|
|
ait_real_80bit :
|
|
objectdata.alloc(10);
|
|
ait_real_64bit :
|
|
objectdata.alloc(8);
|
|
ait_real_32bit :
|
|
objectdata.alloc(4);
|
|
ait_comp_64bit :
|
|
objectdata.alloc(8);
|
|
ait_const_64bit,
|
|
ait_const_32bit,
|
|
ait_const_16bit,
|
|
ait_const_8bit,
|
|
ait_const_rva_symbol,
|
|
ait_const_indirect_symbol :
|
|
begin
|
|
objectdata.alloc(tai_const(hp).size);
|
|
if assigned(Tai_const(hp).sym) then
|
|
objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).sym);
|
|
if assigned(Tai_const(hp).endsym) then
|
|
objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).endsym);
|
|
end;
|
|
ait_section:
|
|
begin
|
|
{ use cached value }
|
|
objectdata.setsection(Tai_section(hp).sec);
|
|
end;
|
|
ait_stab :
|
|
begin
|
|
if assigned(Tai_stab(hp).str) then
|
|
convertstab(Tai_stab(hp).str);
|
|
end;
|
|
ait_function_name,
|
|
ait_force_line : ;
|
|
ait_symbol :
|
|
begin
|
|
objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,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:=objectdata.currsec.datasize-Tai_symbol_end(hp).sym.address;
|
|
objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
|
|
end;
|
|
end;
|
|
ait_label :
|
|
begin
|
|
objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
|
|
objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
|
|
end;
|
|
ait_string :
|
|
objectdata.alloc(Tai_string(hp).len);
|
|
ait_instruction :
|
|
begin
|
|
objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
|
|
{ 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;
|
|
end;
|
|
ait_cutobject :
|
|
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;
|
|
v : int64;
|
|
{$ifdef x86}
|
|
co : comp;
|
|
{$endif x86}
|
|
begin
|
|
inlinelevel:=0;
|
|
{ main loop }
|
|
while assigned(hp) do
|
|
begin
|
|
case hp.typ of
|
|
ait_align :
|
|
begin
|
|
if objectdata.currsec.sectype in [sec_bss,sec_threadvar] then
|
|
objectdata.alloc(Tai_align(hp).fillsize)
|
|
else
|
|
objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
|
|
end;
|
|
ait_section :
|
|
begin
|
|
{ use cached value }
|
|
objectdata.setsection(Tai_section(hp).sec);
|
|
end;
|
|
ait_symbol :
|
|
begin
|
|
objectdata.writesymbol(Tai_symbol(hp).sym);
|
|
objectoutput.exportsymbol(Tai_symbol(hp).sym);
|
|
end;
|
|
ait_datablock :
|
|
begin
|
|
l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
|
|
objectdata.writesymbol(Tai_datablock(hp).sym);
|
|
objectoutput.exportsymbol(Tai_datablock(hp).sym);
|
|
{ if SmartAsm or (not Tai_datablock(hp).is_global) then
|
|
begin}
|
|
objectdata.allocalign(l);
|
|
objectdata.alloc(Tai_datablock(hp).size);
|
|
{ end;}
|
|
end;
|
|
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}
|
|
co:=comp(Tai_comp_64bit(hp).value);
|
|
objectdata.writebytes(co,8);
|
|
{$endif x86}
|
|
end;
|
|
ait_string :
|
|
objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
|
|
ait_const_64bit,
|
|
ait_const_32bit,
|
|
ait_const_16bit,
|
|
ait_const_8bit :
|
|
begin
|
|
if assigned(tai_const(hp).sym) then
|
|
begin
|
|
if assigned(tai_const(hp).endsym) then
|
|
begin
|
|
if tai_const(hp).endsym.section<>tai_const(hp).sym.section then
|
|
internalerror(200404124);
|
|
v:=tai_const(hp).endsym.address-tai_const(hp).sym.address+Tai_const(hp).value;
|
|
objectdata.writebytes(v,tai_const(hp).size);
|
|
end
|
|
else
|
|
objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size,
|
|
Tai_const(hp).sym,RELOC_ABSOLUTE);
|
|
end
|
|
else
|
|
objectdata.writebytes(Tai_const(hp).value,tai_const(hp).size);
|
|
end;
|
|
ait_const_rva_symbol :
|
|
objectdata.writereloc(Tai_const(hp).value,sizeof(aint),Tai_const(hp).sym,RELOC_RVA);
|
|
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(objectdata);
|
|
ait_stab :
|
|
convertstab(Tai_stab(hp).str);
|
|
ait_function_name,
|
|
ait_force_line : ;
|
|
ait_cutobject :
|
|
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
|
|
objectdata:=objectoutput.newobjectdata(Objfile);
|
|
{ reset the asmsymbol list }
|
|
objectlibrary.CreateUsedAsmsymbolList;
|
|
|
|
{ Pass 0 }
|
|
currpass:=0;
|
|
objectdata.createsection(sec_code,'',0,[]);
|
|
objectdata.beforealloc;
|
|
{ start with list 1 }
|
|
currlistidx:=1;
|
|
currlist:=list[currlistidx];
|
|
hp:=Tai(currList.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp:=TreePass0(hp);
|
|
MaybeNextList(hp);
|
|
end;
|
|
objectdata.afteralloc;
|
|
{ leave if errors have occured }
|
|
if errorcount>0 then
|
|
goto doexit;
|
|
|
|
{ Pass 1 }
|
|
currpass:=1;
|
|
objectdata.resetsections;
|
|
objectdata.beforealloc;
|
|
objectdata.createsection(sec_code,'',0,[]);
|
|
{ start with list 1 }
|
|
currlistidx:=1;
|
|
currlist:=list[currlistidx];
|
|
hp:=Tai(currList.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp:=TreePass1(hp);
|
|
MaybeNextList(hp);
|
|
end;
|
|
objectdata.createsection(sec_code,'',0,[]);
|
|
objectdata.afteralloc;
|
|
{ check for undefined labels and reset }
|
|
objectlibrary.UsedAsmSymbolListCheckUndefined;
|
|
|
|
{ leave if errors have occured }
|
|
if errorcount>0 then
|
|
goto doexit;
|
|
|
|
{ Pass 2 }
|
|
currpass:=2;
|
|
objectdata.resetsections;
|
|
objectdata.beforewrite;
|
|
objectdata.createsection(sec_code,'',0,[]);
|
|
{ start with list 1 }
|
|
currlistidx:=1;
|
|
currlist:=list[currlistidx];
|
|
hp:=Tai(currList.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp:=TreePass2(hp);
|
|
MaybeNextList(hp);
|
|
end;
|
|
objectdata.createsection(sec_code,'',0,[]);
|
|
objectdata.afterwrite;
|
|
|
|
{ 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;
|
|
startsectype : TAsmSectionType;
|
|
place: tcutplace;
|
|
begin
|
|
NextSmartName(cut_normal);
|
|
objectdata:=objectoutput.newobjectdata(Objfile);
|
|
startsectype:=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;
|
|
objectdata.resetsections;
|
|
objectdata.beforealloc;
|
|
objectdata.createsection(startsectype,'',0,[]);
|
|
TreePass0(hp);
|
|
objectdata.afteralloc;
|
|
{ leave if errors have occured }
|
|
if errorcount>0 then
|
|
exit;
|
|
|
|
{ Pass 1 }
|
|
currpass:=1;
|
|
objectdata.resetsections;
|
|
objectdata.beforealloc;
|
|
objectdata.createsection(startsectype,'',0,[]);
|
|
TreePass1(hp);
|
|
objectdata.afteralloc;
|
|
{ check for undefined labels }
|
|
objectlibrary.UsedAsmSymbolListCheckUndefined;
|
|
|
|
{ leave if errors have occured }
|
|
if errorcount>0 then
|
|
exit;
|
|
|
|
{ Pass 2 }
|
|
currpass:=2;
|
|
objectoutput.startobjectfile(Objfile);
|
|
objectdata.resetsections;
|
|
objectdata.beforewrite;
|
|
objectdata.createsection(startsectype,'',0,[]);
|
|
hp:=TreePass2(hp);
|
|
{ save section type for next loop, must be done before EndFileLineInfo
|
|
because that changes the section to sec_code }
|
|
startsectype:=objectdata.currsec.sectype;
|
|
objectdata.afterwrite;
|
|
{ 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;
|
|
|
|
{ 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_cutobject) then
|
|
place := Tai_cutobject(hp).place
|
|
else
|
|
place := cut_normal;
|
|
|
|
{ avoid empty files }
|
|
while assigned(hp) and
|
|
(Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
|
|
begin
|
|
if Tai(hp).typ=ait_section then
|
|
startsectype:=Tai_section(hp).sectype
|
|
else if (Tai(hp).typ=ait_cutobject) then
|
|
place:=Tai_cutobject(hp).place;
|
|
hp:=Tai(hp.next);
|
|
end;
|
|
{ there is a problem if startsectype is sec_none !! PM }
|
|
if startsectype=sec_none then
|
|
startsectype:=sec_code;
|
|
|
|
if not MaybeNextList(hp) then
|
|
break;
|
|
|
|
{ start next objectfile }
|
|
NextSmartName(place);
|
|
objectdata:=objectoutput.newobjectdata(Objfile);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TInternalAssembler.MakeObject;
|
|
|
|
var to_do:set of Tasmlist;
|
|
i:Tasmlist;
|
|
|
|
procedure addlist(p:TAAsmoutput);
|
|
begin
|
|
inc(lists);
|
|
list[lists]:=p;
|
|
end;
|
|
|
|
begin
|
|
to_do:=[low(Tasmlist)..high(Tasmlist)];
|
|
if usedeffileforexports then
|
|
exclude(to_do,al_exports);
|
|
{$warning TODO internal writer support for dwarf}
|
|
exclude(to_do,al_dwarf);
|
|
if not(tf_section_threadvars in target_info.flags) then
|
|
exclude(to_do,al_threadvars);
|
|
for i:=low(Tasmlist) to high(Tasmlist) do
|
|
if (i in to_do) and (asmlist[i]<>nil) then
|
|
addlist(asmlist[i]);
|
|
|
|
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
|
|
end;
|
|
|
|
|
|
procedure DoneAssembler;
|
|
begin
|
|
end;
|
|
|
|
end.
|